Changeset 31350 in project


Ignore:
Timestamp:
09/09/14 17:22:30 (5 years ago)
Author:
sjamaan
Message:

numbers: Convert shift functions to core naming conventions, kill old subtraction, negation, and addition functions which are no longer needed.

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

Legend:

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

    r31349 r31350  
    584584   C_return(C_flonum(p, xub));
    585585}
    586 
    587 static bignum_type
    588 bignum_add_unsigned(bignum_type x, bignum_type y, int negative_p)
    589 {
    590   if ((BIGNUM_LENGTH (y)) > (BIGNUM_LENGTH (x)))
    591     {
    592       bignum_type z = x;
    593       x = y;
    594       y = z;
    595     }
    596   {
    597     bignum_length_type x_length = (BIGNUM_LENGTH (x));
    598     bignum_type r = (bignum_allocate ((x_length + 1), negative_p));
    599     bignum_digit_type sum;
    600     bignum_digit_type carry = 0;
    601     bignum_digit_type * scan_x = (BIGNUM_START_PTR (x));
    602     bignum_digit_type * scan_r = (BIGNUM_START_PTR (r));
    603     {
    604       bignum_digit_type * scan_y = (BIGNUM_START_PTR (y));
    605       bignum_digit_type * end_y = (scan_y + (BIGNUM_LENGTH (y)));
    606       while (scan_y < end_y)
    607         {
    608           sum = ((*scan_x++) + (*scan_y++) + carry);
    609           if (sum < BIGNUM_RADIX)
    610             {
    611               (*scan_r++) = sum;
    612               carry = 0;
    613             }
    614           else
    615             {
    616               (*scan_r++) = (sum - BIGNUM_RADIX);
    617               carry = 1;
    618             }
    619         }
    620     }
    621     {
    622       bignum_digit_type * end_x = ((BIGNUM_START_PTR (x)) + x_length);
    623       if (carry != 0)
    624         while (scan_x < end_x)
    625           {
    626             sum = ((*scan_x++) + 1);
    627             if (sum < BIGNUM_RADIX)
    628               {
    629                 (*scan_r++) = sum;
    630                 carry = 0;
    631                 break;
    632               }
    633             else
    634               (*scan_r++) = (sum - BIGNUM_RADIX);
    635           }
    636       while (scan_x < end_x)
    637         (*scan_r++) = (*scan_x++);
    638     }
    639     if (carry != 0) {
    640       (*scan_r) = 1;
    641     } else { /* r is one word too big (to hold a possible carry), readjust */
    642       BIGNUM_SET_HEADER(r, x_length, negative_p);
    643       BIGNUM_REDUCE_LENGTH(r, r, x_length);
    644     }
    645     return (r);
    646   }
    647 }
    648 
    649 /*
    650  * This now makes the assumption it is never passed a bignum of LENGTH 0.
    651  * This should always be valid in Chicken.
    652  */
    653 static bignum_type
    654 bignum_subtract(bignum_type x, bignum_type y)
    655 {
    656   return
    657     (((BIGNUM_NEGATIVE_P (x))
    658        ? ((BIGNUM_NEGATIVE_P (y))
    659           ? (bignum_subtract_unsigned (y, x))
    660           : (bignum_add_unsigned (x, y, 1)))
    661        : ((BIGNUM_NEGATIVE_P (y))
    662           ? (bignum_add_unsigned (x, y, 0))
    663           : (bignum_subtract_unsigned (x, y)))));
    664 }
    665 
    666 static bignum_type
    667 bignum_subtract_unsigned(bignum_type x, bignum_type y)
    668 {
    669   int negative_p;
    670   switch (bignum_compare_unsigned (x, y))
    671     {
    672     case bignum_comparison_equal:
    673       return (BIGNUM_ZERO ());
    674     case bignum_comparison_less:
    675       {
    676         bignum_type z = x;
    677         x = y;
    678         y = z;
    679       }
    680       negative_p = 1;
    681       break;
    682     case bignum_comparison_greater:
    683       negative_p = 0;
    684       break;
    685     }
    686   {
    687     bignum_length_type x_length = (BIGNUM_LENGTH (x));
    688     bignum_type r = (bignum_allocate (x_length, negative_p));
    689     bignum_digit_type difference;
    690     bignum_digit_type borrow = 0;
    691     bignum_digit_type * scan_x = (BIGNUM_START_PTR (x));
    692     bignum_digit_type * scan_r = (BIGNUM_START_PTR (r));
    693     {
    694       bignum_digit_type * scan_y = (BIGNUM_START_PTR (y));
    695       bignum_digit_type * end_y = (scan_y + (BIGNUM_LENGTH (y)));
    696       while (scan_y < end_y)
    697         {
    698           difference = (((*scan_x++) - (*scan_y++)) - borrow);
    699           if (difference < 0)
    700             {
    701               (*scan_r++) = (difference + BIGNUM_RADIX);
    702               borrow = 1;
    703             }
    704           else
    705             {
    706               (*scan_r++) = difference;
    707               borrow = 0;
    708             }
    709         }
    710     }
    711     {
    712       bignum_digit_type * end_x = ((BIGNUM_START_PTR (x)) + x_length);
    713       if (borrow != 0)
    714         while (scan_x < end_x)
    715           {
    716             difference = ((*scan_x++) - borrow);
    717             if (difference < 0)
    718               (*scan_r++) = (difference + BIGNUM_RADIX);
    719             else
    720               {
    721                 (*scan_r++) = difference;
    722                 borrow = 0;
    723                 break;
    724               }
    725           }
    726       assert(borrow == 0);
    727       while (scan_x < end_x)
    728         (*scan_r++) = (*scan_x++);
    729     }
    730     return (bignum_trim (r));
    731   }
    732 }
    733 
    734586
    735587/* Division */
     
    14831335}
    14841336
    1485 static void
    1486 int_not(C_word c, C_word self, C_word k, C_word x)
    1487 {
    1488   bignum_type bigx, result;
    1489  
    1490   if((x & C_FIXNUM_BIT) != 0)
    1491     bigx = bignum_allocate_from_fixnum(x);
    1492   else
    1493     bigx = big_of(x);
    1494 
    1495   result = bignum_bitwise_not(bigx);
    1496 
    1497   if((x & C_FIXNUM_BIT) != 0)
    1498     BIGNUM_DEALLOCATE(bigx);
    1499 
    1500   C_return_bignum(k, result);
    1501 }
    1502 
    1503 bignum_type
    1504 bignum_bitwise_not(bignum_type x)
    1505 {
    1506   static C_word invbits[] = { BIGNUM_RADIX | 1, 1 }; /* bignum representing -1 */
    1507   return bignum_subtract((bignum_type)invbits, x);
    1508 }
    1509 
    1510 static void
    1511 int_shift_fix(C_word c, C_word self, C_word k, C_word x, C_word y)
    1512 {
    1513   bignum_type bigx, result;
    1514 
    1515   if (y == C_fix(0)) C_kontinue(k, x); /* Done too (no shift) */
    1516  
    1517   /* Ensure x is a bignum */
    1518   if((x & C_FIXNUM_BIT) != 0) {
    1519     if (x == C_fix(0)) /* Skip everything else */
    1520       C_kontinue(k, x);
    1521    
    1522     bigx = bignum_allocate_from_fixnum(x);
    1523   } else {
    1524     bigx = big_of(x);
    1525   }
    1526    
    1527   result = bignum_arithmetic_shift(bigx, C_unfix(y));
    1528   if ((x & C_FIXNUM_BIT) != 0)
    1529     BIGNUM_DEALLOCATE(bigx);
    1530   C_return_bignum(k, result);
    1531 }
    1532 
    1533 static bignum_type
    1534 bignum_arithmetic_shift(bignum_type arg1, C_word n)
    1535 {
    1536   bignum_type tmp1, tmp2, result;
    1537   if (BIGNUM_NEGATIVE_P(arg1) && n < 0) {
    1538     tmp1 = bignum_bitwise_not(arg1);
    1539     tmp2 = bignum_magnitude_ash(tmp1, n);
    1540     BIGNUM_DEALLOCATE(tmp1);
    1541     result = bignum_bitwise_not(tmp2);
    1542     BIGNUM_DEALLOCATE(tmp2);
    1543     return result;
    1544   } else {
    1545     return bignum_magnitude_ash(arg1, n);
    1546   }
    1547 }
    1548 
    1549 static bignum_type
    1550 bignum_magnitude_ash(bignum_type arg1, C_word n)
    1551 {
    1552   bignum_type result;
    1553   bignum_digit_type *scan1;
    1554   bignum_digit_type *scanr;
    1555   bignum_digit_type *end;
    1556 
    1557   C_word digit_offset,bit_offset;
    1558   assert(n != 0); /* int_shift_fix checks this */
    1559 
    1560   if (n > 0) {
    1561     digit_offset = n / BIGNUM_DIGIT_LENGTH;
    1562     bit_offset =   n % BIGNUM_DIGIT_LENGTH;
    1563    
    1564     result = bignum_allocate_zeroed (BIGNUM_LENGTH (arg1) + digit_offset + 1,
    1565                                      BIGNUM_NEGATIVE_P(arg1));
    1566 
    1567     scanr = BIGNUM_START_PTR (result) + digit_offset;
    1568     scan1 = BIGNUM_START_PTR (arg1);
    1569     end = scan1 + BIGNUM_LENGTH (arg1);
    1570    
    1571     while (scan1 < end) {
    1572       *scanr = *scanr | (*scan1 & BIGNUM_DIGIT_MASK) << bit_offset;
    1573       *scanr = *scanr & BIGNUM_DIGIT_MASK;
    1574       scanr++;
    1575       *scanr = *scan1++ >> (BIGNUM_DIGIT_LENGTH - bit_offset);
    1576       *scanr = *scanr & BIGNUM_DIGIT_MASK;
    1577     }
    1578   }
    1579   else if (n < 0
    1580            && (-n >= (BIGNUM_LENGTH (arg1) * (bignum_length_type) BIGNUM_DIGIT_LENGTH)))
    1581     result = BIGNUM_ZERO ();
    1582 
    1583   else /* if (n < 0) */ {
    1584     digit_offset = -n / BIGNUM_DIGIT_LENGTH;
    1585     bit_offset =   -n % BIGNUM_DIGIT_LENGTH;
    1586    
    1587     result = bignum_allocate_zeroed (BIGNUM_LENGTH (arg1) - digit_offset,
    1588                                      BIGNUM_NEGATIVE_P(arg1));
    1589    
    1590     scanr = BIGNUM_START_PTR (result);
    1591     scan1 = BIGNUM_START_PTR (arg1) + digit_offset;
    1592     end = scanr + BIGNUM_LENGTH (result) - 1;
    1593    
    1594     while (scanr < end) {
    1595       *scanr =  (*scan1++ & BIGNUM_DIGIT_MASK) >> bit_offset ;
    1596       *scanr = (*scanr |
    1597         *scan1 << (BIGNUM_DIGIT_LENGTH - bit_offset)) & BIGNUM_DIGIT_MASK;
    1598       scanr++;
    1599     }
    1600     *scanr =  (*scan1++ & BIGNUM_DIGIT_MASK) >> bit_offset ;
    1601   }
    1602  
    1603   return (bignum_trim (result));
    1604 }
    1605 
    16061337static bignum_type
    16071338bignum_pospos_bitwise_op(int op, bignum_type arg1, bignum_type arg2)
     
    18741605static void flo_to_int_2(C_word c, C_word self, C_word result);
    18751606static C_word ilen(C_uword x);
     1607static void bignum_allocate_for_shift(C_word c, C_word self, C_word x);
     1608static void bignum_negate_after_shift(C_word c, C_word self, C_word result);
     1609static void bignum_actual_shift(C_word c, C_word self, C_word result);
    18761610
    18771611/* Eventually this will probably need to be integrated into C_2_plus. */
     
    26722406  }
    26732407}
     2408
     2409void C_ccall
     2410C_u_int_shift_fix(C_word c, C_word self, C_word k, C_word x, C_word y)
     2411{
     2412  C_word kab[C_SIZEOF_FIX_BIGNUM + C_SIZEOF_CLOSURE(3) + C_SIZEOF_CLOSURE(2)],
     2413         *ka = kab, k2, k3, size;
     2414
     2415  if (y == C_fix(0) || x == C_fix(0)) { /* Done (no shift) */
     2416    C_kontinue(k, x);
     2417  } else if (x & C_FIXNUM_BIT) {
     2418    /* TODO: This should probably see if shifting fits a fixnum, first */
     2419    x = C_a_u_i_fix_to_big(&ka, x);
     2420  }
     2421
     2422  /* Invert all the bits before shifting right a negative value */
     2423  if (C_bignum_negativep(x) && C_unfix(y) < 0) {
     2424    /* When done shifting, invert again */
     2425    k3 = C_closure(&ka, 2, (C_word)bignum_negate_after_shift, k);
     2426    /* Before shifting, allocate the bignum */
     2427    k2 = C_closure(&ka, 3, (C_word)bignum_allocate_for_shift, k3, y);
     2428    /* Actually invert by subtracting: -1 - x */
     2429    C_u_fixnum_minus_bignum(2, (C_word)NULL, k2, C_fix(-1), x);
     2430  } else {
     2431    k2 = C_closure(&ka, 3, (C_word)bignum_allocate_for_shift, k, y);
     2432    C_kontinue(k2, x);
     2433  }
     2434}
     2435
     2436static void
     2437bignum_allocate_for_shift(C_word c, C_word self, C_word x)
     2438{
     2439  C_word k = C_block_item(self, 1),
     2440         y = C_block_item(self, 2),
     2441         uy = C_unfix(y),
     2442         negp, digit_offset, bit_offset,
     2443         ab[C_SIZEOF_FIX_BIGNUM + C_SIZEOF_CLOSURE(6)], *a = ab, k2, size;
     2444
     2445  if (x & C_FIXNUM_BIT) /* Normalisation may happen after negation */
     2446    x = C_a_u_i_fix_to_big(&a, x);
     2447
     2448  negp = C_mk_bool(C_bignum_negativep(x));
     2449 
     2450  /* uy is guaranteed not to be 0 here */
     2451  if (uy > 0) {
     2452    digit_offset = uy / C_BIGNUM_DIGIT_LENGTH;
     2453    bit_offset =   uy % C_BIGNUM_DIGIT_LENGTH;
     2454
     2455    k2 = C_closure(&a, 6, (C_word)bignum_actual_shift, k,
     2456                   x, C_SCHEME_TRUE, C_fix(digit_offset), C_fix(bit_offset));
     2457    size = C_fix(C_bignum_size(x) + digit_offset + 1);
     2458    C_allocate_bignum(3, (C_word)NULL, k2, size, negp, C_SCHEME_TRUE);
     2459  } else if (-uy >= C_bignum_size(x) * (C_word)C_BIGNUM_DIGIT_LENGTH) {
     2460    /* All bits are shifted out, just return 0 */
     2461    C_kontinue(k, C_fix(0));
     2462  } else {
     2463    digit_offset = -uy / BIGNUM_DIGIT_LENGTH;
     2464    bit_offset =   -uy % BIGNUM_DIGIT_LENGTH;
     2465   
     2466    k2 = C_closure(&a, 6, (C_word)bignum_actual_shift, k,
     2467                   x, C_SCHEME_FALSE, C_fix(digit_offset), C_fix(bit_offset));
     2468    size = C_fix(C_bignum_size(x) - digit_offset);
     2469    C_allocate_bignum(3, (C_word)NULL, k2, size, negp, C_SCHEME_TRUE);
     2470  }
     2471}
     2472
     2473static void
     2474bignum_negate_after_shift(C_word c, C_word self, C_word result)
     2475{
     2476  C_word k = C_block_item(self, 1),
     2477         ab[C_SIZEOF_FIX_BIGNUM], *a = ab;
     2478  if (result & C_FIXNUM_BIT) /* Normalisation may happen after shift */
     2479    C_kontinue(k, C_fix(-1 - C_unfix(result)));
     2480  else
     2481    C_u_fixnum_minus_bignum(2, (C_word)NULL, k, C_fix(-1), result);
     2482}
     2483
     2484static void
     2485bignum_actual_shift(C_word c, C_word self, C_word result)
     2486{
     2487  C_word k = C_block_item(self, 1),
     2488         x = C_block_item(self, 2),
     2489         shift_left = C_truep(C_block_item(self, 3)),
     2490         digit_offset = C_unfix(C_block_item(self, 4)),
     2491         bit_offset = C_unfix(C_block_item(self, 5)),
     2492         *scanx, *scanr, *end;
     2493
     2494  if (shift_left) {
     2495    scanr = C_bignum_digits(result) + digit_offset;
     2496    scanx = C_bignum_digits(x);
     2497    end = scanx + C_bignum_size(x);
     2498   
     2499    while (scanx < end) {
     2500      *scanr = *scanr | (*scanx & C_BIGNUM_DIGIT_MASK) << bit_offset;
     2501      *scanr = *scanr & C_BIGNUM_DIGIT_MASK;
     2502      scanr++;
     2503      *scanr = *scanx++ >> (C_BIGNUM_DIGIT_LENGTH - bit_offset);
     2504      *scanr = *scanr & C_BIGNUM_DIGIT_MASK;
     2505    }
     2506  } else {
     2507    scanr = C_bignum_digits(result);
     2508    scanx = C_bignum_digits(x) + digit_offset;
     2509    end = scanr + C_bignum_size(result) - 1;
     2510   
     2511    while (scanr < end) {
     2512      *scanr =  (*scanx++ & C_BIGNUM_DIGIT_MASK) >> bit_offset;
     2513      *scanr = (*scanr |
     2514        *scanx << (C_BIGNUM_DIGIT_LENGTH - bit_offset)) & C_BIGNUM_DIGIT_MASK;
     2515      scanr++;
     2516    }
     2517    *scanr =  (*scanx++ & C_BIGNUM_DIGIT_MASK) >> bit_offset;
     2518  }
     2519  C_bignum_destructive_trim(result);
     2520  C_kontinue(k, C_bignum_normalize(result));
     2521}
  • release/4/numbers/trunk/numbers-c.h

    r31349 r31350  
    240240C_word C_u_i_int_length(C_word x);
    241241
     242void C_ccall C_u_int_shift_fix(C_word c, C_word self, C_word k, C_word x, C_word y);
     243
    242244C_inline C_word C_bignum1(C_word **ptr, int negp, C_uword d1)
    243245{
  • release/4/numbers/trunk/numbers.scm

    r31349 r31350  
    188188
    189189(define %int-bitwise-int (##core#primitive "int_bitwise_int"))
    190 (define %int-shift-fix (##core#primitive "int_shift_fix"))
     190(define %int-shift-fix (##core#primitive "C_u_int_shift_fix"))
    191191(define-inline (%int-length i) (##core#inline "C_u_i_int_length" i))
    192192
Note: See TracChangeset for help on using the changeset viewer.