Changeset 31309 in project


Ignore:
Timestamp:
08/29/14 22:40:55 (5 years ago)
Author:
sjamaan
Message:

numbers: Convert remaining multiplication C functions to core naming conventions. This gets rid of another malloc() call.

Location:
release/4/numbers/trunk
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • release/4/numbers/trunk/numbers-c.c

    r31308 r31309  
    818818}
    819819
    820 
    821 static void
    822 big_times_big(C_word c, C_word self, C_word k, C_word x, C_word y)
    823 {
    824   bignum_type bigx = big_of(x), bigy = big_of(y);
    825   int neg_p = ((BIGNUM_NEGATIVE_P (bigx))
    826                ? (! (BIGNUM_NEGATIVE_P (bigy)))
    827                : (BIGNUM_NEGATIVE_P (bigy)));
    828   /* If length 1 or 0, it should be a fixnum */
    829   assert(BIGNUM_LENGTH(bigx) > 1);
    830   assert(BIGNUM_LENGTH(bigy) > 1);
    831   C_return_bignum(k, bignum_multiply_unsigned(bigx, bigy, neg_p));
    832 }
    833 
    834 /* Multiplication
    835    Maximum value for product_low or product_high:
    836         ((R * R) + (R * (R - 2)) + (R - 1))
    837    Maximum value for carry: ((R * (R - 1)) + (R - 1))
    838         where R == BIGNUM_RADIX_ROOT */
    839 
    840 static bignum_type
    841 bignum_multiply_unsigned(bignum_type x, bignum_type y, int negative_p)
    842 {
    843   if ((BIGNUM_LENGTH (y)) > (BIGNUM_LENGTH (x)))
    844     {
    845       bignum_type z = x;
    846       x = y;
    847       y = z;
    848     }
    849   {
    850     bignum_digit_type carry;
    851     bignum_digit_type y_digit_low;
    852     bignum_digit_type y_digit_high;
    853     bignum_digit_type x_digit_low;
    854     bignum_digit_type x_digit_high;
    855     bignum_digit_type product_low;
    856     bignum_digit_type * scan_r;
    857     bignum_digit_type * scan_y;
    858     bignum_length_type x_length = (BIGNUM_LENGTH (x));
    859     bignum_length_type y_length = (BIGNUM_LENGTH (y));
    860     bignum_type r = (bignum_allocate_zeroed ((x_length + y_length), negative_p));
    861     bignum_digit_type * scan_x = (BIGNUM_START_PTR (x));
    862     bignum_digit_type * end_x = (scan_x + x_length);
    863     bignum_digit_type * start_y = (BIGNUM_START_PTR (y));
    864     bignum_digit_type * end_y = (start_y + y_length);
    865     bignum_digit_type * start_r = (BIGNUM_START_PTR (r));
    866 #define x_digit x_digit_high
    867 #define y_digit y_digit_high
    868 #define product_high carry
    869     while (scan_x < end_x)
    870       {
    871         x_digit = (*scan_x++);
    872         x_digit_low = (HD_LOW (x_digit));
    873         x_digit_high = (HD_HIGH (x_digit));
    874         carry = 0;
    875         scan_y = start_y;
    876         scan_r = (start_r++);
    877         while (scan_y < end_y)
    878           {
    879             y_digit = (*scan_y++);
    880             y_digit_low = (HD_LOW (y_digit));
    881             y_digit_high = (HD_HIGH (y_digit));
    882             product_low =
    883               ((*scan_r) +
    884                (x_digit_low * y_digit_low) +
    885                (HD_LOW (carry)));
    886             product_high =
    887               ((x_digit_high * y_digit_low) +
    888                (x_digit_low * y_digit_high) +
    889                (HD_HIGH (product_low)) +
    890                (HD_HIGH (carry)));
    891             (*scan_r++) =
    892               (HD_CONS ((HD_LOW (product_high)), (HD_LOW (product_low))));
    893             carry =
    894               ((x_digit_high * y_digit_high) +
    895                (HD_HIGH (product_high)));
    896           }
    897         (*scan_r) += carry;
    898       }
    899     return (bignum_trim (r));
    900 #undef x_digit
    901 #undef y_digit
    902 #undef product_high
    903   }
    904 }
    905820
    906821static void
     
    22552170static void bignum_times_halfdigit_fixnum(C_word k, C_word bigx, C_word fixy, C_word negp);
    22562171static void bignum_times_halfdigit_fixnum_2(C_word c, C_word self, C_word new_big);
     2172static void bignum_times_bignum_unsigned(C_word k, C_word x, C_word y, C_word negp);
     2173static void bignum_times_bignum_unsigned_2(C_word c, C_word self, C_word result);
    22572174
    22582175/* Eventually this will probably need to be integrated into C_2_plus. */
     
    22702187    /* This code "knows" that both fixnums and bignums have 2 reserved bits */
    22712188    if(!C_fitsinfixnump(z)) {
     2189      /* TODO: function returning either a fixnum or a bignum from a C int */
     2190      /* This should help with the C API/FFI too. */
    22722191      C_kontinue(k, C_bignum2(&a, (z < 0), labs(z) & (C_uword)BIGNUM_DIGIT_MASK, 1));
    22732192    } else {
     
    24812400       C_kontinue(k, C_fix(negp ? -(absx * absy) : (absx * absy)));
    24822401     } else {
    2483        C_word ab[C_SIZEOF_BIGNUM(1)], *a = ab, bigy;
     2402       C_word ab[C_SIZEOF_FIX_BIGNUM], *a = ab, bigy;
    24842403       bigy = C_a_u_i_fix_to_big(&a, y);
    24852404       bignum_times_halfdigit_fixnum(k, bigy, C_fix(absx), C_mk_bool(negp));
     
    24892408       C_kontinue(k, C_fix(negp ? -(absx * absy) : (absx * absy)));
    24902409     } else {
    2491        C_word ab[C_SIZEOF_BIGNUM(1)], *a = ab, bigx;
     2410       C_word ab[C_SIZEOF_FIX_BIGNUM], *a = ab, bigx;
    24922411       bigx = C_a_u_i_fix_to_big(&a, x);
    24932412       bignum_times_halfdigit_fixnum(k, bigx, C_fix(absy), C_mk_bool(negp));
    24942413     }
    24952414  } else {
    2496     C_word ab[C_SIZEOF_BIGNUM(1)*2], *a = ab, bigx, bigy;
    2497     bignum_type result;
     2415    C_word ab[C_SIZEOF_FIX_BIGNUM*2], *a = ab, bigx, bigy;
    24982416    bigx = C_a_u_i_fix_to_big(&a, x);
    24992417    bigy = C_a_u_i_fix_to_big(&a, y);
    2500     /* XXX TODO */
    2501     result = bignum_multiply_unsigned(big_of(bigx), big_of(bigy), negp ? 1 : 0);
    2502     C_return_bignum(k, result);
     2418    bignum_times_bignum_unsigned(k, bigx, bigy, C_mk_bool(negp));
    25032419  }
    25042420}
     
    25232439 
    25242440  if (C_fitsinbignumhalfdigitp(absx)) {
    2525      bignum_times_halfdigit_fixnum(k, y, C_fix(absx), C_mk_bool(negp));
     2441    bignum_times_halfdigit_fixnum(k, y, C_fix(absx), C_mk_bool(negp));
    25262442  } else {
    2527     C_word ab[C_SIZEOF_BIGNUM(1)*2], *a = ab, bigx, bigy;
    2528     bignum_type result;
     2443    C_word ab[C_SIZEOF_FIX_BIGNUM], *a = ab, bigx, bigy;
    25292444    bigx = C_a_u_i_fix_to_big(&a, x);
    2530     /* XXX TODO */
    2531     result = bignum_multiply_unsigned (big_of(bigx), big_of(y), negp);
    2532     C_return_bignum(k, result);
    2533   }
    2534 }
     2445    bignum_times_bignum_unsigned(k, bigx, y, C_mk_bool(negp));
     2446  }
     2447}
     2448
     2449void C_ccall
     2450C_u_bignum_times_bignum(C_word c, C_word self, C_word k, C_word x, C_word y)
     2451{
     2452  C_word negp = C_truep(C_u_i_bignum_negativep(x)) ?
     2453                !C_truep(C_u_i_bignum_negativep(y)) :
     2454                C_truep(C_u_i_bignum_negativep(y));
     2455  bignum_times_bignum_unsigned(k, x, y, C_mk_bool(negp));
     2456}
     2457
     2458/* Multiplication
     2459   Maximum value for product_lo or product_hi:
     2460        ((R * R) + (R * (R - 2)) + (R - 1))
     2461   Maximum value for carry: ((R * (R - 1)) + (R - 1))
     2462        where R == 2^HALF_DIGIT_SHIFT */
     2463static void
     2464bignum_times_bignum_unsigned(C_word k, C_word x, C_word y, C_word negp)
     2465{
     2466  C_word kab[C_SIZEOF_CLOSURE(4)], *ka = kab, k2, size;
     2467 
     2468  if (C_bignum_size(y) > C_bignum_size(x)) { /* Ensure size(x) <= size(y) */
     2469    C_word z = x;
     2470    x = y;
     2471    y = z;
     2472  }
     2473
     2474  k2 = C_closure(&ka, 4, (C_word)bignum_times_bignum_unsigned_2, k, x, y);
     2475
     2476  size = C_fix(C_bignum_size(x) + C_bignum_size(y));
     2477  C_allocate_bignum(3, (C_word)NULL, k2, size, negp, C_SCHEME_TRUE);
     2478}
     2479
     2480static void
     2481bignum_times_bignum_unsigned_2(C_word c, C_word self, C_word result)
     2482{
     2483  C_word k = C_block_item(self, 1),
     2484         x = C_block_item(self, 2),
     2485         y = C_block_item(self, 3),
     2486
     2487         carry, y_digit_lo, y_digit_hi, x_digit_lo,
     2488         x_digit_hi, product_lo, *scan_r, *scan_y,
     2489         x_digit, y_digit, product_hi,
     2490         *scan_x = C_bignum_digits(x),
     2491         *end_x = scan_x + C_bignum_size(x),
     2492         *start_y = C_bignum_digits(y),
     2493         *end_y = start_y + C_bignum_size(y),
     2494         *start_r = C_bignum_digits(result);
     2495
     2496  while (scan_x < end_x) {
     2497    x_digit = (*scan_x++);
     2498    x_digit_lo = C_BIGNUM_DIGIT_LO_HALF(x_digit);
     2499    x_digit_hi = C_BIGNUM_DIGIT_HI_HALF(x_digit);
     2500    carry = 0;
     2501    scan_y = start_y;
     2502    scan_r = (start_r++);
     2503
     2504    while (scan_y < end_y) {
     2505      y_digit = (*scan_y++);
     2506      y_digit_lo = C_BIGNUM_DIGIT_LO_HALF(y_digit);
     2507      y_digit_hi = C_BIGNUM_DIGIT_HI_HALF(y_digit);
     2508
     2509      product_lo = (*scan_r) +
     2510                   x_digit_lo * y_digit_lo +
     2511                   C_BIGNUM_DIGIT_LO_HALF(carry);
     2512
     2513      product_hi = x_digit_hi * y_digit_lo +
     2514                   x_digit_lo * y_digit_hi +
     2515                   C_BIGNUM_DIGIT_HI_HALF(product_lo) +
     2516                   C_BIGNUM_DIGIT_HI_HALF(carry);
     2517
     2518      (*scan_r++) = C_BIGNUM_DIGIT_COMBINE(C_BIGNUM_DIGIT_LO_HALF(product_hi),
     2519                                           C_BIGNUM_DIGIT_LO_HALF(product_lo));
     2520
     2521      carry = x_digit_hi * y_digit_hi + C_BIGNUM_DIGIT_HI_HALF(product_hi);
     2522    }
     2523    (*scan_r) += carry;
     2524  }
     2525  C_bignum_destructive_trim(result);
     2526  C_kontinue(k, C_bignum_normalize(result));
     2527}
  • release/4/numbers/trunk/numbers-c.h

    r31308 r31309  
    169169
    170170#define C_SIZEOF_BIGNUM(n)              (C_SIZEOF_INTERNAL_BIGNUM(n)+C_SIZEOF_STRUCTURE(2))
     171/* This is convenience so you won't forget a fixnum may need 2 digits! */
     172#define C_SIZEOF_FIX_BIGNUM             C_SIZEOF_BIGNUM(2)
    171173
    172174/* CHAR_BIT is from <limits.h>, and it equals the number of bits in a char */
  • release/4/numbers/trunk/numbers.scm

    r31304 r31309  
    153153(define %fix*fix (##core#primitive "C_u_2_fixnum_times"))
    154154(define %fix*big (##core#primitive "C_u_fixnum_times_bignum"))
    155 (define %big*big (##core#primitive "big_times_big"))
     155(define %big*big (##core#primitive "C_u_bignum_times_bignum"))
    156156
    157157(define %big-quotient-fix (##core#primitive "big_quotient_fix"))
Note: See TracChangeset for help on using the changeset viewer.