Changeset 31304 in project


Ignore:
Timestamp:
08/28/14 22:24:45 (5 years ago)
Author:
sjamaan
Message:

numbers: (partially) convert multiplication of fixnums with fixnums and fixnums with bignums to core naming conventions

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

Legend:

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

    r31291 r31304  
    830830  assert(BIGNUM_LENGTH(bigy) > 1);
    831831  C_return_bignum(k, bignum_multiply_unsigned(bigx, bigy, neg_p));
    832 }
    833 
    834 static void
    835 fix_times_fix(C_word c, C_word self, C_word k, C_word x, C_word y)
    836 {
    837   bignum_type bigx, bigy, result;
    838   bignum_digit_type absx, absy;
    839   C_word neg_p;
    840 
    841   absx = C_unfix(x);
    842   absx = absx < 0 ? -absx : absx;
    843   absy = C_unfix(y);
    844   absy = absy < 0 ? -absy : absy;
    845   neg_p = ((x & C_INT_SIGN_BIT) ? !(y & C_INT_SIGN_BIT) : (y & C_INT_SIGN_BIT));
    846 
    847   if (absx < BIGNUM_RADIX_ROOT) {
    848      if (absx == 0 || absx == 1 || absy < BIGNUM_RADIX_ROOT) {
    849        C_kontinue(k, C_fix(neg_p ? -(absx * absy) : (absx * absy)));
    850      } else {
    851        bigy = bignum_allocate_from_fixnum(y);
    852        result = bignum_multiply_unsigned_small_factor(bigy, absx, neg_p ? 1 : 0);
    853        BIGNUM_DEALLOCATE(bigy);
    854        C_return_bignum(k, result);
    855      }
    856   } else if (absy < BIGNUM_RADIX_ROOT) {
    857      if (absy == 0 || absy == 1 /*|| absx < BIGNUM_RADIX_ROOT */) {
    858        C_kontinue(k, C_fix(neg_p ? -(absx * absy) : (absx * absy)));
    859      } else {
    860        bigx = bignum_allocate_from_fixnum(x);
    861        result = bignum_multiply_unsigned_small_factor(bigx, absy, neg_p ? 1 : 0);
    862        BIGNUM_DEALLOCATE(bigx);
    863        C_return_bignum(k, result);
    864      }
    865   } else {
    866     bigx = bignum_allocate_from_fixnum(x);
    867     bigy = bignum_allocate_from_fixnum(y);
    868     result = bignum_multiply_unsigned (bigx, bigy, neg_p ? 1 : 0);
    869     BIGNUM_DEALLOCATE(bigy);
    870     BIGNUM_DEALLOCATE(bigx);
    871     C_return_bignum(k, result);
    872   }
    873 }
    874 
    875 
    876 static void
    877 fix_times_big(C_word c, C_word self, C_word k, C_word x, C_word y)
    878 {
    879   bignum_type bigx, result, bigy;
    880   bignum_digit_type absx;
    881   C_word neg_p;
    882  
    883   bigy = big_of(y);
    884  
    885   if (x == C_fix(0))
    886     C_kontinue(k, C_fix(0));
    887   else if (x == C_fix(1))
    888     C_kontinue(k, y);
    889   else if (x == C_fix(-1))
    890     C_return_bignum(k, bignum_new_sign(bigy, !(BIGNUM_NEGATIVE_P(bigy))));
    891 
    892   absx = C_unfix(x);
    893   absx = absx < 0 ? -absx : absx; 
    894   neg_p = ((x & C_INT_SIGN_BIT)
    895            ? !(BIGNUM_NEGATIVE_P(bigy)) : (BIGNUM_NEGATIVE_P(bigy)));
    896  
    897   if (absx < BIGNUM_RADIX_ROOT) {
    898      C_return_bignum(k, bignum_multiply_unsigned_small_factor(bigy, absx, neg_p));
    899   } else {
    900     bigx = bignum_allocate_from_fixnum(x);
    901     result = bignum_multiply_unsigned (bigx, bigy, neg_p);
    902     BIGNUM_DEALLOCATE(bigx);
    903     C_return_bignum(k, result);
    904   }
    905832}
    906833
     
    977904}
    978905
    979 static bignum_type
    980 bignum_multiply_unsigned_small_factor(bignum_type x, bignum_digit_type y,
    981                                       int negative_p)
    982 {
    983   bignum_length_type length_x = (BIGNUM_LENGTH (x));
    984   bignum_type p = (bignum_allocate ((length_x + 1), negative_p));
    985   bignum_destructive_copy (x, p);
    986   (BIGNUM_REF (p, length_x)) = 0;
    987   bignum_destructive_scale_up (p, y);
    988   return (bignum_trim (p));
    989 }
    990 
    991906static void
    992907bignum_destructive_scale_up(bignum_type bignum, bignum_digit_type factor)
     
    23372252static void bignum_negate_2(C_word c, C_word self, C_word new_big);
    23382253static void allocate_bignum_2(C_word c, C_word self, C_word bigvec);
     2254static void bignum_times_halfdigit_fixnum(C_word k, C_word bigx, C_word fixy, C_word negp);
     2255static void bignum_times_halfdigit_fixnum_2(C_word c, C_word self, C_word new_big);
    23392256
    23402257/* Eventually this will probably need to be integrated into C_2_plus. */
     
    24182335            */
    24192336           C_header_size(C_internal_bignum(old_big))-C_wordstobytes(1));
    2420   C_kontinue(k, new_big);
     2337  C_kontinue(k, C_bignum_normalize(new_big));
    24212338}
    24222339
     
    24492366  C_kontinue(k, bignum);
    24502367}
     2368
     2369/* Normalization of the bignum's representation: remove trailing zeroes. */
     2370void C_ccall
     2371C_bignum_destructive_trim(C_word big)
     2372{
     2373  C_word *start = C_bignum_digits(big);
     2374  C_word *last_digit = start + C_unfix(C_u_i_bignum_size(big));
     2375  C_word *scan = last_digit;
     2376
     2377  while ((start <= scan) && ((*--scan) == 0))
     2378    ;
     2379  scan += 1;
     2380
     2381  if (scan < last_digit) {
     2382    C_word len = scan - start;
     2383    /* Mutate vector size of internal bignum vector. */
     2384    C_block_header(C_internal_bignum(big)) = (C_STRING_TYPE | C_wordstobytes(len+1));
     2385    /* Set internal header. */
     2386    C_bignum_header(big) = (C_bignum_header(big) & C_BIGNUM_HEADER_SIGN_BIT) | len;
     2387  }
     2388}
     2389
     2390/* Actual normalization: return a fixnum if the value fits. */
     2391C_word C_ccall
     2392C_bignum_normalize(C_word big)
     2393{
     2394  switch (C_u_i_bignum_size(big)) {
     2395  case C_fix(0):
     2396    return C_fix(0);
     2397  case C_fix(1):
     2398    return C_fix(C_truep(C_u_i_bignum_negativep(big)) ?
     2399                 -C_bignum_digits(big)[0] :
     2400                 C_bignum_digits(big)[0]);
     2401  case C_fix(2):
     2402    if (C_truep(C_u_i_bignum_negativep(big)) &&
     2403        C_bignum_digits(big)[1] == 1 && C_bignum_digits(big)[0] == 0)
     2404      return C_fix(C_MOST_NEGATIVE_FIXNUM);
     2405  }
     2406  return big;
     2407}
     2408
     2409C_inline void
     2410bignum_digits_destructive_scale_up(C_word big, C_word fix_factor)
     2411{
     2412  C_word digit, product_hi, product_lo, carry = 0;
     2413  C_word *scan = C_bignum_digits(big);
     2414  C_word *last_digit = scan + C_unfix(C_u_i_bignum_size(big));
     2415  C_word factor = C_unfix(fix_factor);
     2416
     2417  while (scan < last_digit) {
     2418    digit = (*scan);
     2419    product_lo = factor * C_BIGNUM_DIGIT_LO_HALF(digit) + carry;
     2420    product_hi = factor * C_BIGNUM_DIGIT_HI_HALF(digit) +
     2421            C_BIGNUM_DIGIT_HI_HALF(product_lo);
     2422    (*scan++) = C_BIGNUM_DIGIT_COMBINE(C_BIGNUM_DIGIT_LO_HALF(product_hi),
     2423                                       C_BIGNUM_DIGIT_LO_HALF(product_lo));
     2424    carry = C_BIGNUM_DIGIT_HI_HALF(product_hi);
     2425  }
     2426  assert(carry == 0);
     2427}
     2428
     2429static void
     2430bignum_times_halfdigit_fixnum(C_word k, C_word bigx, C_word fixy, C_word negp)
     2431{
     2432  C_word kab[C_SIZEOF_CLOSURE(4)], *ka = kab, k2, size;
     2433
     2434  k2 = C_closure(&ka, 4, (C_word)bignum_times_halfdigit_fixnum_2,
     2435                 k, bigx, fixy);
     2436
     2437  size = C_u_i_bignum_size(bigx) + 1; /* Needs _at most_ one more digit */
     2438  C_allocate_bignum(3, (C_word)NULL, k2, size, negp, C_SCHEME_FALSE);
     2439}
     2440
     2441static void
     2442bignum_times_halfdigit_fixnum_2(C_word c, C_word self, C_word new_big)
     2443{
     2444  C_word k = C_block_item(self, 1),
     2445         old_bigx = C_block_item(self, 2),
     2446         fixy = C_block_item(self, 3);
     2447
     2448  C_memcpy(C_bignum_digits(new_big), C_bignum_digits(old_bigx),
     2449           /* TODO: This is currently in bytes.  If we change the
     2450            * representation that needs to change!
     2451            * We subtract the size of the header, too.
     2452            */
     2453           C_header_size(C_internal_bignum(old_bigx))-C_wordstobytes(1));
     2454
     2455  /* Most significant digit is not initialised; set it to 0. */
     2456  C_bignum_digits(new_big)[C_unfix(C_u_i_bignum_size(old_bigx))] = 0;
     2457
     2458  /* Scale up, and sanitise the result. TODO: make normalization one op? */
     2459  bignum_digits_destructive_scale_up(new_big, fixy);
     2460  C_bignum_destructive_trim(new_big);
     2461  C_kontinue(k, C_bignum_normalize(new_big));
     2462}
     2463
     2464void C_ccall
     2465C_u_2_fixnum_times(C_word c, C_word self, C_word k, C_word x, C_word y)
     2466{
     2467  C_word absx, absy;
     2468  C_word negp;
     2469
     2470  /* We don't strictly need the abses and negp in all branches... */
     2471  absx = C_unfix(x);
     2472  absx = absx < 0 ? -absx : absx;
     2473  absy = C_unfix(y);
     2474  absy = absy < 0 ? -absy : absy;
     2475  negp = ((x & C_INT_SIGN_BIT) ? !(y & C_INT_SIGN_BIT) : (y & C_INT_SIGN_BIT));
     2476
     2477  if (C_fitsinbignumhalfdigitp(absx)) {
     2478     if (absx == 0 || absx == 1 || C_fitsinbignumhalfdigitp(absy)) {
     2479       C_kontinue(k, C_fix(negp ? -(absx * absy) : (absx * absy)));
     2480     } else {
     2481       C_word ab[C_SIZEOF_BIGNUM(1)], *a = ab, bigy;
     2482       bigy = C_a_u_i_fix_to_big(&a, y);
     2483       bignum_times_halfdigit_fixnum(k, bigy, C_fix(absx), C_mk_bool(negp));
     2484     }
     2485  } else if (C_fitsinbignumhalfdigitp(absy)) {
     2486     if (absy == 0 || absy == 1 /*|| C_fitsinbignumhalfdigitp(absx) */) {
     2487       C_kontinue(k, C_fix(negp ? -(absx * absy) : (absx * absy)));
     2488     } else {
     2489       C_word ab[C_SIZEOF_BIGNUM(1)], *a = ab, bigx;
     2490       bigx = C_a_u_i_fix_to_big(&a, x);
     2491       bignum_times_halfdigit_fixnum(k, bigx, C_fix(absy), C_mk_bool(negp));
     2492     }
     2493  } else {
     2494    C_word ab[C_SIZEOF_BIGNUM(1)*2], *a = ab, bigx, bigy;
     2495    bignum_type result;
     2496    bigx = C_a_u_i_fix_to_big(&a, x);
     2497    bigy = C_a_u_i_fix_to_big(&a, y);
     2498    /* XXX TODO */
     2499    result = bignum_multiply_unsigned(big_of(bigx), big_of(bigy), negp ? 1 : 0);
     2500    C_return_bignum(k, result);
     2501  }
     2502}
     2503
     2504void C_ccall
     2505C_u_fixnum_times_bignum(C_word c, C_word self, C_word k, C_word x, C_word y)
     2506{
     2507  C_word negp, absx;
     2508 
     2509  if (x == C_fix(0))
     2510    C_kontinue(k, C_fix(0));
     2511  else if (x == C_fix(1))
     2512    C_kontinue(k, y);
     2513  else if (x == C_fix(-1))
     2514    C_u_bignum_negate(1, (C_word)NULL, k, y);
     2515
     2516  absx = C_unfix(x);
     2517  absx = absx < 0 ? -absx : absx;
     2518  negp = (x & C_INT_SIGN_BIT) ?
     2519          !C_truep(C_u_i_bignum_negativep(y)) :
     2520          C_truep(C_u_i_bignum_negativep(y));
     2521 
     2522  if (C_fitsinbignumhalfdigitp(absx)) {
     2523     bignum_times_halfdigit_fixnum(k, y, C_fix(absx), C_mk_bool(negp));
     2524  } else {
     2525    C_word ab[C_SIZEOF_BIGNUM(1)*2], *a = ab, bigx, bigy;
     2526    bignum_type result;
     2527    bigx = C_a_u_i_fix_to_big(&a, x);
     2528    /* XXX TODO */
     2529    result = bignum_multiply_unsigned (big_of(bigx), big_of(y), negp);
     2530    C_return_bignum(k, result);
     2531  }
     2532}
  • release/4/numbers/trunk/numbers-c.h

    r31291 r31304  
    177177# define C_BIGNUM_HEADER_SIZE_MASK 0x3fffffffffffffffL
    178178# define C_BIGNUM_DIGIT_MASK       0x3fffffffffffffffL
     179# define C_BIGNUM_HALF_DIGIT_MASK  0x000000007fffffffL
     180# define C_BIGNUM_HALF_DIGIT_SHIFT 31
    179181#else
    180182# define C_BIGNUM_HEADER_SIGN_BIT  0x40000000
    181183# define C_BIGNUM_HEADER_SIZE_MASK 0x3fffffff
    182184# define C_BIGNUM_DIGIT_MASK       0x3fffffff
     185# define C_BIGNUM_HALF_DIGIT_MASK  0x00007fff
     186# define C_BIGNUM_HALF_DIGIT_SHIFT 15
    183187#endif
    184188
    185 #define C_a_i_bignum2(a,n,negp,d1,d2)   C_bignum2((a),(n),C_truep(negp),(C_uword)C_unfix(d1),(C_uword)C_unfix(d2))
    186 
     189#define C_BIGNUM_DIGIT_LO_HALF(d)       ((d) & C_BIGNUM_HALF_DIGIT_MASK)
     190#define C_BIGNUM_DIGIT_HI_HALF(d)       ((d) >> C_BIGNUM_HALF_DIGIT_SHIFT)
     191#define C_BIGNUM_DIGIT_COMBINE(h,l)     ((h) << C_BIGNUM_HALF_DIGIT_SHIFT|(l))
     192
     193#define C_fitsinbignumdigitp(n)         ((C_uword)(n) == ((C_uword)(n) & C_BIGNUM_DIGIT_MASK))
     194#define C_fitsinbignumhalfdigitp(n)     ((C_uword)(n) == ((C_uword)(n) & C_BIGNUM_HALF_DIGIT_MASK))
    187195#define C_bignum_header(b)              (*(C_word *)C_data_pointer(C_internal_bignum(b)))
    188196#define C_bignum_digits(b)              (((C_word *)C_data_pointer(C_internal_bignum(b)))+1)
     
    198206#define C_u_i_bignum_size(b)            (C_fix(C_bytestowords(C_header_size(C_internal_bignum(b)))-1))
    199207
     208void C_ccall C_allocate_bignum(C_word c, C_word self, C_word k, C_word size, C_word negp, C_word initp);
     209void C_ccall C_bignum_destructive_trim(C_word big);
     210
     211void C_ccall C_fixnum_gcd(C_word c, C_word self, C_word k, C_word x, C_word y);
     212void C_ccall C_u_fixnum_neg(C_word c, C_word self, C_word k, C_word x);
     213void C_ccall C_u_bignum_negate(C_word c, C_word self, C_word k, C_word x);
    200214void C_ccall C_u_2_fixnum_plus(C_word c, C_word self, C_word k, C_word x, C_word y);
    201 void C_ccall C_u_fixnum_neg(C_word c, C_word self, C_word k, C_word x);
    202 void C_ccall C_fixnum_gcd(C_word c, C_word self, C_word k, C_word x, C_word y);
    203 void C_ccall C_u_bignum_negate(C_word c, C_word self, C_word k, C_word x);
    204 void C_ccall C_allocate_bignum(C_word c, C_word self, C_word k, C_word size, C_word negp, C_word initp);
    205 
    206 /* TODO: low to high, or high to low? (ie, big or little endian?) */
    207 C_inline C_word C_bignum2(C_word **ptr, int negp, C_uword d1, C_uword d2)
     215C_word C_ccall C_bignum_normalize(C_word big);
     216void C_ccall C_u_2_fixnum_times(C_word c, C_word self, C_word k, C_word x, C_word y);
     217void C_ccall C_u_fixnum_times_bignum(C_word c, C_word self, C_word k, C_word x, C_word y);
     218
     219C_inline C_word C_bignum1(C_word **ptr, int negp, C_uword d1)
    208220{
    209221  C_word *p = *ptr, p0 = (C_word)p;
     
    216228
    217229  /* Not using C_a_i_vector2, to make it easier to rewrite later */
    218   *(p++) = C_STRING_TYPE | (3 * sizeof(C_word));
     230  *(p++) = C_STRING_TYPE | C_wordstobytes(2);
     231  *(p++) = negp ? C_BIGNUM_HEADER_SIGN_BIT | 1 : 1;
     232  *(p++) = d1;
     233  *ptr = p;
     234
     235  /* TODO: Maybe add C_a_i_structureN, like C_a_i_vectorN? */
     236  return C_structure(ptr, 2, C_block_item(tagvec, BIG_TAG), p0);
     237}
     238
     239/* TODO: d1/d2 low to high, or high to low? (ie, big or little endian?) */
     240C_inline C_word C_bignum2(C_word **ptr, int negp, C_uword d1, C_uword d2)
     241{
     242  C_word *p = *ptr, p0 = (C_word)p;
     243
     244  C_word tagvec = CHICKEN_gc_root_ref(tags);
     245
     246  /* Not using C_a_i_vector2, to make it easier to rewrite later */
     247  *(p++) = C_STRING_TYPE | C_wordstobytes(3);
    219248  *(p++) = negp ? C_BIGNUM_HEADER_SIGN_BIT | 2 : 2;
    220249  *(p++) = d1;
     
    225254  return C_structure(ptr, 2, C_block_item(tagvec, BIG_TAG), p0);
    226255}
     256
     257C_inline C_word C_a_u_i_fix_to_big(C_word **ptr, C_word x)
     258{
     259  x = C_unfix(x);
     260  if (x == C_MOST_NEGATIVE_FIXNUM)
     261    return C_bignum2(ptr, 1, 0, 1);
     262  else if (x < 0)
     263    return C_bignum1(ptr, 1, -x);
     264  else
     265    return C_bignum1(ptr, 0, x);
     266}
  • release/4/numbers/trunk/numbers.scm

    r31291 r31304  
    151151(define %big-big (##core#primitive "big_minus_big"))
    152152
    153 (define %fix*fix (##core#primitive "fix_times_fix"))
    154 (define %fix*big (##core#primitive "fix_times_big"))
     153(define %fix*fix (##core#primitive "C_u_2_fixnum_times"))
     154(define %fix*big (##core#primitive "C_u_fixnum_times_bignum"))
    155155(define %big*big (##core#primitive "big_times_big"))
    156156
Note: See TracChangeset for help on using the changeset viewer.