Changeset 31878 in project
 Timestamp:
 11/21/14 15:06:16 (5 years ago)
 Location:
 release/4/numbers/trunk
 Files:

 3 edited
Legend:
 Unmodified
 Added
 Removed

release/4/numbers/trunk/numbersc.c
r31860 r31878 47 47 48 48 #include "numbersc.h" 49 50 #ifdef C_LITTLE_ENDIAN 51 #define HALF_DIGIT_AT(x, p) (C_uword)((C_uhword *)(x))[(p)] 52 #define STORE_HALF_DIGIT_AT(x, p, d) (((C_uhword *)(x))[(p)] = (C_uhword)(d)) 53 #else 54 /* Access the halfdigit in number x at position p (counting in halfdigits) 55 * This is a bit of a mindfuck, because it's little endian all the way: 56 * n[0] is really the low half of digit 0, n[1] the high half of digit 0, 57 * n[2] is the low half of digit 1, etc. 58 */ 59 #define HALF_DIGIT_AT(x, p) \ 60 ((p) & 1 ? C_BIGNUM_DIGIT_HI_HALF((x)[(p)>>1]) \ 61 : C_BIGNUM_DIGIT_LO_HALF((x)[(p)>>1])) 62 63 /* Store a halfdigit in x at position p (counting in halfdigits) */ 64 #define STORE_HALF_DIGIT_AT(x, p, d) \ 65 (x)[(p)>>1] = ((p) & 1 ? \ 66 C_BIGNUM_DIGIT_COMBINE(((d) & C_BIGNUM_HALF_DIGIT_MASK), \ 67 C_BIGNUM_DIGIT_LO_HALF((x)[(p)>>1])) \ 68 : C_BIGNUM_DIGIT_COMBINE(C_BIGNUM_DIGIT_HI_HALF((x)[(p)>>1]), \ 69 ((d) & C_BIGNUM_HALF_DIGIT_MASK))) 70 #endif 49 71 50 72 static C_word init_tags(___scheme_value tagvec); … … 448 470 C_a_u_i_2_fixnum_plus(C_word **ptr, C_word n, C_word x, C_word y) 449 471 { 450 /* Exceptional situation: this will cause a real overflow */472 /* Exceptional situation: this will cause a real underflow */ 451 473 if (x == C_fix(C_MOST_NEGATIVE_FIXNUM) && y == C_fix(C_MOST_NEGATIVE_FIXNUM)) { 452 return C_bignum 2(ptr, 1, 0, 2);474 return C_bignum1(ptr, 1, ((C_uword)C_MOST_NEGATIVE_FIXNUM) << 1); 453 475 } else { 454 476 C_word z = C_unfix(x) + C_unfix(y); … … 457 479 /* TODO: function/macro returning either fixnum or bignum from a C int */ 458 480 /* This should help with the C API/FFI too. */ 459 return C_bignum 2(ptr, (z < 0), labs(z) & (C_uword)C_BIGNUM_DIGIT_MASK, 1);481 return C_bignum1(ptr, z < 0, labs(z)); 460 482 } else { 461 483 return C_fix(z); … … 555 577 /* TODO: function/macro returning either fixnum or bignum from a C int */ 556 578 /* This should help with the C API/FFI too. */ 557 return C_bignum 2(ptr, (z < 0), labs(z) & (C_uword)C_BIGNUM_DIGIT_MASK, 1);579 return C_bignum1(ptr, z < 0, labs(z)); 558 580 } else { 559 581 return C_fix(z); … … 606 628 *scan_r = C_bignum_digits(result), 607 629 *end_r = scan_r + C_bignum_size(result), 608 sum ;630 sum, digit; 609 631 int carry = 0; 610 632 … … 618 640 /* Move over x and y simultaneously, destructively adding digits w/ carry. */ 619 641 while (scan_y < end_y) { 620 sum = *scan_r + (*scan_y++) + carry; 621 carry = sum >> C_BIGNUM_DIGIT_LENGTH; 622 (*scan_r++) = sum & C_BIGNUM_DIGIT_MASK; 642 digit = *scan_r; 643 if (carry) { 644 sum = digit + *scan_y++ + 1; 645 carry = sum <= digit; 646 } else { 647 sum = digit + *scan_y++; 648 carry = sum < digit; 649 } 650 (*scan_r++) = sum; 623 651 } 624 652 … … 626 654 while (carry) { 627 655 sum = (*scan_r) + 1; 628 carry = sum >> C_BIGNUM_DIGIT_LENGTH;629 (*scan_r++) = sum & C_BIGNUM_DIGIT_MASK;656 carry = (sum == 0); 657 (*scan_r++) = sum; 630 658 } 631 659 assert(scan_r <= end_r); … … 689 717 C_word k = C_block_item(self, 1), 690 718 x = C_block_item(self, 2), 691 y = C_block_item(self, 3), 692 difference; 719 y = C_block_item(self, 3); 693 720 C_uword *scan_r = C_bignum_digits(result), 694 721 *end_r = scan_r + C_bignum_size(result), 695 722 *scan_y = C_bignum_digits(y), 696 *end_y = scan_y + C_bignum_size(y); 723 *end_y = scan_y + C_bignum_size(y), 724 difference, digit; 697 725 int borrow = 0; 698 726 … … 701 729 /* Destructively subtract y's digits w/ borrow from and back into r. */ 702 730 while (scan_y < end_y) { 703 difference = *scan_r  (*scan_y++)  borrow; 704 borrow = difference < 0; 705 (*scan_r++) = difference + ((C_uword)borrow << C_BIGNUM_DIGIT_LENGTH); 731 digit = *scan_r; 732 if (borrow) { 733 difference = digit  *scan_y++  1; 734 borrow = difference >= digit; 735 } else { 736 difference = digit  *scan_y++; 737 borrow = difference > digit; 738 } 739 (*scan_r++) = difference; 706 740 } 707 741 708 742 /* The end of y, the smaller number. Propagate borrow into the rest of x. */ 709 743 while (borrow) { 710 difference = *scan_r  borrow; 711 borrow = difference < 0; 712 (*scan_r++) = difference + ((C_uword)borrow << C_BIGNUM_DIGIT_LENGTH); 744 digit = *scan_r; 745 difference = digit  borrow; 746 borrow = difference >= digit; 747 (*scan_r++) = difference; 713 748 } 714 749 … … 909 944 /* Exceptional situation: this will cause an overflow to itself */ 910 945 if (x == C_fix(C_MOST_NEGATIVE_FIXNUM)) /* C_fitsinfixnump(x) */ 911 return C_bignum 2(ptr, 0, 0, 1);946 return C_bignum1(ptr, 0, C_MOST_NEGATIVE_FIXNUM); 912 947 else 913 948 return C_fix(C_unfix(x)); … … 1251 1286 C_uword *start = C_bignum_digits(big), 1252 1287 *last_digit = start + C_bignum_size(big)  1, 1253 *scan = last_digit ;1288 *scan = last_digit, tmp; 1254 1289 int length; 1255 1290 … … 1262 1297 return C_fix(0); 1263 1298 case 1: 1264 return C_fix(C_bignum_negativep(big) ? *start : *start); 1265 case 2: 1266 if (C_bignum_negativep(big) && *scan == 1 && *start == 0) 1267 return C_fix(C_MOST_NEGATIVE_FIXNUM); 1299 tmp = *start; 1300 if (C_bignum_negativep(big) ? 1301 !(tmp & C_INT_SIGN_BIT) && C_fitsinfixnump((C_word)tmp) : 1302 C_ufitsinfixnump(tmp)) 1303 return C_bignum_negativep(big) ? C_fix((C_word)tmp) : C_fix(tmp); 1268 1304 /* FALLTHROUGH */ 1269 1305 default: … … 1285 1321 product_lo = factor * C_BIGNUM_DIGIT_LO_HALF(digit) + carry; 1286 1322 product_hi = factor * C_BIGNUM_DIGIT_HI_HALF(digit) + 1287 1323 C_BIGNUM_DIGIT_HI_HALF(product_lo); 1288 1324 (*scan++) = C_BIGNUM_DIGIT_COMBINE(C_BIGNUM_DIGIT_LO_HALF(product_hi), 1289 1325 C_BIGNUM_DIGIT_LO_HALF(product_lo)); 1290 1326 carry = C_BIGNUM_DIGIT_HI_HALF(product_hi); 1291 1327 } … … 1348 1384 while (start < end) { 1349 1385 digit = *start; 1350 (*start++) = ( (digit << shift_left) & C_BIGNUM_DIGIT_MASK)  carry;1386 (*start++) = (digit << shift_left)  carry; 1351 1387 carry = digit >> shift_right; 1352 1388 } … … 1409 1445 C_a_u_i_2_fixnum_times(C_word **ptr, C_word n, C_word x, C_word y) 1410 1446 { 1411 C_word absx, absy, negp; 1412 C_uword *d, r; 1413 1414 /* We don't strictly need the abses in all branches... */ 1415 absx = C_unfix(x); 1416 absx = absx < 0 ? absx : absx; 1417 absy = C_unfix(y); 1418 absy = absy < 0 ? absy : absy; 1447 C_word negp, r; 1448 1419 1449 negp = ((x & C_INT_SIGN_BIT) ? !(y & C_INT_SIGN_BIT) : (y & C_INT_SIGN_BIT)); 1420 1450 1421 /* TODO: Figure out if it's worthwhile to shift left powers of 2. 1422 * Perhaps get rid of the rest of the nasty complexity below. 1423 */ 1424 if (C_fitsinbignumhalfdigitp(absx)) { 1425 if (x == C_fix(0)  x == C_fix(1)  C_fitsinbignumhalfdigitp(absy)) { 1426 return C_fix(negp ? (absx * absy) : (absx * absy)); 1427 } else { 1428 if (y == C_fix(C_MOST_NEGATIVE_FIXNUM)) { 1429 y = C_bignum2(ptr, negp != 0, 0, 1); /* Two is always enough */ 1430 } else { 1431 y = C_bignum2(ptr, negp != 0, absy, 0); /* May need one for carry */ 1432 } 1433 d = C_bignum_digits(y); 1434 r = bignum_digits_destructive_scale_up_with_carry(d, d+2, absx, 0); 1435 assert(r == 0); /* Should never result in a carry; y is big enough */ 1436 return C_bignum_simplify(y); 1437 } 1438 } else if (C_fitsinbignumhalfdigitp(absy)) { 1439 if (absy == 0  y == C_fix(1) /* C_fitsinbignumhalfdigitp(absx) */) { 1440 return C_fix(negp ? (absx * absy) : (absx * absy)); 1441 } else { 1442 if (x == C_fix(C_MOST_NEGATIVE_FIXNUM)) { 1443 x = C_bignum2(ptr, negp != 0, 0, 1); /* Two is always enough */ 1444 } else { 1445 x = C_bignum2(ptr, negp != 0, absx, 0); /* May need one for carry */ 1446 } 1447 d = C_bignum_digits(x); 1448 r = bignum_digits_destructive_scale_up_with_carry(d, d+2, absy, 0); 1449 assert(r == 0); /* Should never result in a carry; x is big enough */ 1450 return C_bignum_simplify(x); 1451 } 1452 } else { 1453 x = C_a_u_i_fix_to_big(ptr, x); 1454 y = C_a_u_i_fix_to_big(ptr, y); 1455 r = C_bignum4(ptr, negp != 0, 0, 0, 0, 0); 1456 bignum_digits_multiply(x, y, r); 1457 return C_bignum_simplify(r); 1458 } 1451 x = C_a_u_i_fix_to_big(ptr, x); 1452 y = C_a_u_i_fix_to_big(ptr, y); 1453 r = C_bignum4(ptr, negp != 0, 0, 0, 0, 0); 1454 bignum_digits_multiply(x, y, r); 1455 return C_bignum_simplify(r); 1459 1456 } 1460 1457 … … 1490 1487 1491 1488 if (C_fitsinbignumhalfdigitp(absy)  1492 ((ylen < C_BIGNUM_DIGIT_LENGTH) && 1493 (((C_uword)1 << (ylen1)) == absy))) { 1489 (C_fitsinfixnump(absy) && (((C_uword)1 << (ylen1)) == absy))) { 1494 1490 k2 = C_closure(&a, 4, (C_word)integer_times_2, k, x, C_fix(absy)); 1495 1491 size = C_fix(C_bignum_size(x) + 1); /* Needs _at most_ one more digit */ … … 1557 1553 } 1558 1554 1559 /* Multiplication1560 Maximum value for product_lo or product_hi:1561 ((R * R) + (R * (R  2)) + (R  1))1562 Maximum value for carry: ((R * (R  1)) + (R  1))1563 where R == 2^HALF_DIGIT_LENGTH */1564 1555 static C_regparm void 1565 1556 bignum_digits_multiply(C_word x, C_word y, C_word result) 1566 1557 { 1567 C_uword carry, y_digit_lo, y_digit_hi, x_digit_lo, 1568 x_digit_hi, product_lo, *scan_r, *scan_y, 1569 x_digit, y_digit, product_hi, 1570 *scan_x = C_bignum_digits(x), 1571 *end_x = scan_x + C_bignum_size(x), 1572 *start_y = C_bignum_digits(y), 1573 *end_y = start_y + C_bignum_size(y), 1574 *start_r = C_bignum_digits(result); 1575 1576 while (scan_x < end_x) { 1577 x_digit = (*scan_x++); 1578 x_digit_lo = C_BIGNUM_DIGIT_LO_HALF(x_digit); 1579 x_digit_hi = C_BIGNUM_DIGIT_HI_HALF(x_digit); 1558 C_uword product, carry = 0, 1559 *xd = C_bignum_digits(x), 1560 *yd = C_bignum_digits(y), 1561 *rd = C_bignum_digits(result); 1562 /* Lengths in halfwords */ 1563 int i, j, length_x = C_bignum_size(x) * 2, length_y = C_bignum_size(y) * 2; 1564 1565 /* From Hacker's Delight, Figure 81 (top part) */ 1566 for (j = 0; j < length_y; ++j) { 1580 1567 carry = 0; 1581 scan_y = start_y; 1582 scan_r = (start_r++); 1583 1584 while (scan_y < end_y) { 1585 y_digit = (*scan_y++); 1586 y_digit_lo = C_BIGNUM_DIGIT_LO_HALF(y_digit); 1587 y_digit_hi = C_BIGNUM_DIGIT_HI_HALF(y_digit); 1588 1589 product_lo = (*scan_r) + 1590 x_digit_lo * y_digit_lo + 1591 C_BIGNUM_DIGIT_LO_HALF(carry); 1592 1593 product_hi = x_digit_hi * y_digit_lo + 1594 x_digit_lo * y_digit_hi + 1595 C_BIGNUM_DIGIT_HI_HALF(product_lo) + 1596 C_BIGNUM_DIGIT_HI_HALF(carry); 1597 1598 (*scan_r++) = C_BIGNUM_DIGIT_COMBINE(C_BIGNUM_DIGIT_LO_HALF(product_hi), 1599 C_BIGNUM_DIGIT_LO_HALF(product_lo)); 1600 1601 carry = x_digit_hi * y_digit_hi + C_BIGNUM_DIGIT_HI_HALF(product_hi); 1602 } 1603 (*scan_r) += carry; 1568 for (i = 0; i < length_x; ++i) { 1569 product = HALF_DIGIT_AT(xd, i) * HALF_DIGIT_AT(yd, j) + 1570 HALF_DIGIT_AT(rd, i + j) + carry; 1571 STORE_HALF_DIGIT_AT(rd, i + j, product); 1572 carry = product >> C_BIGNUM_HALF_DIGIT_LENGTH; 1573 } 1574 STORE_HALF_DIGIT_AT(rd, j + length_x, carry); 1604 1575 } 1605 1576 } … … 2040 2011 *scan = start + C_bignum_size(bignum); 2041 2012 while (start < scan) { 2042 accumulator *= (C_word)1 << C_BIGNUM_DIGIT_LENGTH; 2013 accumulator *= (C_word)1 << C_BIGNUM_HALF_DIGIT_LENGTH; 2014 accumulator *= (C_word)1 << C_BIGNUM_HALF_DIGIT_LENGTH; 2043 2015 accumulator += (*scan); 2044 2016 } … … 2063 2035 2064 2036 while (start < scan && sign > 0) { 2065 sign *= (C_uword)1 << C_BIGNUM_DIGIT_LENGTH;2037 sign *= pow(2.0, C_BIGNUM_DIGIT_LENGTH); 2066 2038 digit = (C_uword)sign; 2067 2039 (*scan) = digit; … … 2163 2135 2164 2136 /* If *only* the highest bit is set, negating results in one less bit */ 2165 if (C_bignum_negativep(x) && *last_digit == (1 << (last_digit_length1))) { 2137 if (C_bignum_negativep(x) && 2138 *last_digit == ((C_uword)1 << (last_digit_length1))) { 2166 2139 while(startx < last_digit && *startx == 0) ++startx; 2167 2140 if (startx == last_digit) result; … … 2279 2252 */ 2280 2253 C_memcpy(startr, startx, C_wordstobytes(endxstartx)); 2281 bignum_digits_destructive_shift_left(startr, endr, bit_offset); 2254 if(bit_offset > 0) 2255 bignum_digits_destructive_shift_left(startr, endr, bit_offset); 2282 2256 } else { 2283 2257 startx += digit_offset; … … 2286 2260 */ 2287 2261 C_memcpy(startr, startx, C_wordstobytes(endrstartr)); 2288 bignum_digits_destructive_shift_right(startr, endr, bit_offset); 2262 if(bit_offset > 0) 2263 bignum_digits_destructive_shift_right(startr, endr, bit_offset); 2289 2264 } 2290 2265 C_kontinue(k, C_bignum_simplify(result)); … … 2406 2381 2407 2382 while(scan < end) 2408 *scan++ = ((double)rand())/(RAND_MAX + 1.0) * (double)((C_word)1 <<C_BIGNUM_DIGIT_LENGTH);2383 *scan++ = ((double)rand())/(RAND_MAX + 1.0) * pow(2.0, C_BIGNUM_DIGIT_LENGTH); 2409 2384 /* 2410 2385 * Last word is special when length is max_len: It must be less than … … 2414 2389 *scan = ((double)rand())/(RAND_MAX + 1.0) * (double)max_top_digit; 2415 2390 else 2416 *scan = ((double)rand())/(RAND_MAX + 1.0) * (double)((C_word)1 <<C_BIGNUM_DIGIT_LENGTH);2391 *scan = ((double)rand())/(RAND_MAX + 1.0) * pow(2.0, C_BIGNUM_DIGIT_LENGTH); 2417 2392 2418 2393 C_kontinue(k, C_bignum_simplify(result)); … … 2540 2515 *scan2 = C_bignum_digits(arg2), 2541 2516 *end2 = scan2 + C_bignum_size(arg2), 2542 digit1, digit2, carry2 = 1; 2517 digit1, digit2; 2518 int carry2 = 1; 2543 2519 2544 2520 while (scanr < endr) { 2545 2521 digit1 = (scan1 < end1) ? *scan1++ : 0; 2546 digit2 = (~((scan2 < end2) ? *scan2++ : 0) & C_BIGNUM_DIGIT_MASK) + carry2;2547 2548 carry2 = digit2 >> C_BIGNUM_DIGIT_LENGTH;2522 digit2 = ~((scan2 < end2) ? *scan2++ : (C_uword)0) + carry2; 2523 2524 carry2 = carry2 && (digit2 == (C_uword)0); 2549 2525 2550 *scanr++ = ( (op == C_fix(0)) ? digit1 & digit2 :2551 2552 digit1 ^ digit2) & C_BIGNUM_DIGIT_MASK;2526 *scanr++ = (op == C_fix(0)) ? digit1 & digit2 : 2527 (op == C_fix(1)) ? digit1  digit2 : 2528 digit1 ^ digit2; 2553 2529 } 2554 2530 … … 2569 2545 *scan2 = C_bignum_digits(arg2), 2570 2546 *end2 = scan2 + C_bignum_size(arg2), 2571 digit1, digit2, carry1 = 1, carry2 = 1; 2547 digit1, digit2; 2548 int carry1 = 1, carry2 = 1; 2572 2549 2573 2550 while (scanr < endr) { 2574 digit1 = (~((scan1 < end1) ? *scan1++ : 0) & C_BIGNUM_DIGIT_MASK) + carry1;2575 digit2 = (~((scan2 < end2) ? *scan2++ : 0) & C_BIGNUM_DIGIT_MASK) + carry2;2576 2577 carry1 = digit1 >> C_BIGNUM_DIGIT_LENGTH;2578 carry2 = digit2 >> C_BIGNUM_DIGIT_LENGTH;2579 2580 *scanr++ = ( (op == C_fix(0)) ? digit1 & digit2 :2581 2582 digit1 ^ digit2) & C_BIGNUM_DIGIT_MASK;2551 digit1 = ~((scan1 < end1) ? *scan1++ : (C_uword)0) + carry1; 2552 digit2 = ~((scan2 < end2) ? *scan2++ : (C_uword)0) + carry2; 2553 2554 carry1 = carry1 && (digit1 == (C_uword)0); 2555 carry2 = carry2 && (digit2 == (C_uword)0); 2556 2557 *scanr++ = (op == C_fix(0)) ? digit1 & digit2 : 2558 (op == C_fix(1)) ? digit1  digit2 : 2559 digit1 ^ digit2; 2583 2560 } 2584 2561 … … 2591 2568 /* XXX TODO: Use bignum_minus or bignum_negate_after_shift */ 2592 2569 if (C_bignum_negativep(result)) { 2593 C_uword *scan, *end, digit, carry;2570 C_uword *scan, *end, digit, sum; 2594 2571 2595 2572 scan = C_bignum_digits(result); 2596 2573 end = scan + C_bignum_size(result); 2597 carry = 1; 2574 2575 do { 2576 digit = ~*scan; 2577 sum = digit + 1; 2578 *scan++ = sum; 2579 } while (sum == 0 && scan < end); 2598 2580 2599 2581 while (scan < end) { 2600 digit = (~*scan & C_BIGNUM_DIGIT_MASK) + carry; 2601 carry = digit >> C_BIGNUM_DIGIT_LENGTH; 2602 *scan++ = digit & C_BIGNUM_DIGIT_MASK; 2582 *scan = ~*scan; 2583 *scan++; 2603 2584 } 2604 2585 } … … 2764 2745 C_u_bignum_negate(3, (C_word)NULL, k2, x); 2765 2746 } else if (C_fitsinbignumhalfdigitp(absy)  2766 ((ylen < C_BIGNUM_DIGIT_LENGTH) && 2767 (((C_uword)1 << (ylen1)) == absy))) { 2747 (C_fitsinfixnump(absy) && (((C_uword)1 << (ylen1)) == absy))) { 2768 2748 if (C_truep(return_q)) { 2769 2749 C_word q_negp = C_mk_bool((y < 0) ? … … 3074 3054 int i, j; /* loop vars */ 3075 3055 3076 /* TODO: If C_LITTLE_ENDIAN, we can just access the halfdigit directly,3077 after we've changed the representation of digits to use the full word */3078 3079 /* Access the halfdigit in number x at position p (counting in halfdigits)3080 * This is a bit of a mindfuck, because it's little endian all the way:3081 * n[0] is really the low half of digit 0, n[1] the high half of digit 0,3082 * n[2] is the low half of digit 1, etc.3083 */3084 #define HALF_DIGIT_AT(x, p) \3085 ((p) & 1 ? C_BIGNUM_DIGIT_HI_HALF((x)[(p)>>1]) \3086 : C_BIGNUM_DIGIT_LO_HALF((x)[(p)>>1]))3087 3088 /* Store a halfdigit in x at position p (counting in halfdigits) */3089 #define STORE_HALF_DIGIT_AT(x, p, d) \3090 (x)[(p)>>1] = ((p) & 1 ? \3091 C_BIGNUM_DIGIT_COMBINE(((d) & C_BIGNUM_HALF_DIGIT_MASK), \3092 C_BIGNUM_DIGIT_LO_HALF((x)[(p)>>1])) \3093 : C_BIGNUM_DIGIT_COMBINE(C_BIGNUM_DIGIT_HI_HALF((x)[(p)>>1]), \3094 ((d) & C_BIGNUM_HALF_DIGIT_MASK)))3095 3096 3056 /* Part 2 of Gauche's aforementioned trick: */ 3097 3057 if (HALF_DIGIT_AT(v, n1) == 0) n; … … 3138 3098 if (q != NULL) STORE_HALF_DIGIT_AT(q, j, qhat); 3139 3099 } /* end j */ 3140 #undef STORE_HALF_DIGIT_AT 3141 #undef HALF_DIGIT_AT 3142 } 3100 } 
release/4/numbers/trunk/numbersc.h
r31844 r31878 18 18 19 19 #ifdef C_SIXTY_FOUR 20 # define C_BIGNUM_DIGIT_LENGTH 6 221 # define C_BIGNUM_ DIGIT_MASK 0x3fffffffffffffffL22 # define C_BIGNUM_HALF_DIGIT_ MASK 0x000000007fffffffL23 # define C_ BIGNUM_HALF_DIGIT_LENGTH 3120 # define C_BIGNUM_DIGIT_LENGTH 64 21 # define C_BIGNUM_HALF_DIGIT_MASK 0x00000000ffffffffL 22 # define C_BIGNUM_HALF_DIGIT_LENGTH 32 23 # define C_hword int 24 24 #else 25 # define C_BIGNUM_DIGIT_LENGTH 3 026 # define C_BIGNUM_ DIGIT_MASK 0x3fffffff27 # define C_BIGNUM_HALF_DIGIT_ MASK 0x00007fff28 # define C_ BIGNUM_HALF_DIGIT_LENGTH 1525 # define C_BIGNUM_DIGIT_LENGTH 32 26 # define C_BIGNUM_HALF_DIGIT_MASK 0x0000ffff 27 # define C_BIGNUM_HALF_DIGIT_LENGTH 16 28 # define C_hword short 29 29 #endif 30 31 #define C_uhword unsigned C_hword 30 32 31 33 /* This defines when we'll switch from schoolbook to Karatsuba multiplication. … … 40 42 #define C_BIGNUM_DIGIT_LO_HALF(d) ((d) & C_BIGNUM_HALF_DIGIT_MASK) 41 43 #define C_BIGNUM_DIGIT_HI_HALF(d) ((d) >> C_BIGNUM_HALF_DIGIT_LENGTH) 42 #define C_BIGNUM_DIGIT_COMBINE(h,l) (( h) << C_BIGNUM_HALF_DIGIT_LENGTH(l))44 #define C_BIGNUM_DIGIT_COMBINE(h,l) ((C_uword)(h) << C_BIGNUM_HALF_DIGIT_LENGTH(l)) 43 45 44 46 /* This should be replaced by C_header_bits(x) == C_BIGNUM_TYPE in core */ … … 46 48 47 49 #define C_i_bignump(x) C_mk_bool(!C_immediatep(x) && C_IS_BIGNUM_TYPE(x)) 48 #define C_fitsinbignumdigitp(n) ((C_uword)(n) == ((C_uword)(n) & C_BIGNUM_DIGIT_MASK)) 49 #define C_fitsinbignumhalfdigitp(n) ((C_uword)(n) == ((C_uword)(n) & C_BIGNUM_HALF_DIGIT_MASK)) 50 /* Only one bignum fits a fixnum when negated: (C_MOST_NEGATIVE_FIXNUM) */ 51 #define C_bignum_negated_fitsinfixnump(b) (C_bignum_size(b) == 2 && !C_bignum_negativep(b) && C_bignum_digits(b)[0] == 0 && C_bignum_digits(b)[1] == 1) 50 #define C_fitsinbignumhalfdigitp(n) (C_BIGNUM_DIGIT_HI_HALF(n) == 0) 51 #define C_bignum_negated_fitsinfixnump(b) (C_bignum_size(b) == 1 && (C_bignum_negativep(b) ? C_ufitsinfixnump(*C_bignum_digits(b)) : !(*C_bignum_digits(b) & C_INT_SIGN_BIT) && C_fitsinfixnump((C_word)*C_bignum_digits(b)))) 52 52 #define C_bignum_header(b) (*(C_word *)C_data_pointer(C_internal_bignum(b))) 53 53 #define C_bignum_digits(b) (((C_uword *)C_data_pointer(C_internal_bignum(b)))+1) … … 286 286 { 287 287 x = C_unfix(x); 288 if (x == C_MOST_NEGATIVE_FIXNUM) 289 return C_bignum2(ptr, 1, 0, 1); 290 else if (x < 0) 288 if (x < 0) 291 289 return C_bignum1(ptr, 1, x); 292 290 else if (x == 0) … … 304 302 C_div_by_zero_error(C_strloc(loc)); 305 303 } else if (x == C_fix(C_MOST_NEGATIVE_FIXNUM) && y == C_fix(1)) { 306 return C_bignum 2(ptr, 0, 0, 1); /* Yet another annoying special case */304 return C_bignum1(ptr, 0, C_MOST_NEGATIVE_FIXNUM); /* Special case */ 307 305 } else { 308 306 return C_u_fixnum_divide(x, y); /* Inconsistent, too: missing _i_ */ 
release/4/numbers/trunk/numbers.scm
r31838 r31878 1024 1024 ((fx< (fx (len a) (len b)) k/2) 1025 1025 (receive (a b) (lehmergcd a b) 1026 (lp b ((##core#primitive "C_u_integer_remainder") 'gcd a b)))) 1026 (if (eq? b 0) 1027 a 1028 (lp b ((##core#primitive "C_u_integer_remainder") 'gcd a b))))) 1027 1029 ((fixnum? a) ; b MUST be fixnum due to loop invariant 1028 1030 (##core#inline "C_u_i_2_fixnum_gcd" a b)) … … 1234 1236 (let lp ((g0 g0) 1235 1237 (g1 (arithmeticshift 1238 ;; XXX THIS IS NEEDLESSLY SLOW! 1236 1239 (%+ g0 (arithmeticshift k (fxneg len))) 1))) 1237 1240 (if (%< loc g1 g0)
Note: See TracChangeset
for help on using the changeset viewer.