Changeset 31309 in project
 Timestamp:
 08/29/14 22:40:55 (6 years ago)
 Location:
 release/4/numbers/trunk
 Files:

 3 edited
Legend:
 Unmodified
 Added
 Removed

release/4/numbers/trunk/numbersc.c
r31308 r31309 818 818 } 819 819 820 821 static void822 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 /* Multiplication835 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_type841 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_high867 #define y_digit y_digit_high868 #define product_high carry869 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_digit901 #undef y_digit902 #undef product_high903 }904 }905 820 906 821 static void … … 2255 2170 static void bignum_times_halfdigit_fixnum(C_word k, C_word bigx, C_word fixy, C_word negp); 2256 2171 static void bignum_times_halfdigit_fixnum_2(C_word c, C_word self, C_word new_big); 2172 static void bignum_times_bignum_unsigned(C_word k, C_word x, C_word y, C_word negp); 2173 static void bignum_times_bignum_unsigned_2(C_word c, C_word self, C_word result); 2257 2174 2258 2175 /* Eventually this will probably need to be integrated into C_2_plus. */ … … 2270 2187 /* This code "knows" that both fixnums and bignums have 2 reserved bits */ 2271 2188 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. */ 2272 2191 C_kontinue(k, C_bignum2(&a, (z < 0), labs(z) & (C_uword)BIGNUM_DIGIT_MASK, 1)); 2273 2192 } else { … … 2481 2400 C_kontinue(k, C_fix(negp ? (absx * absy) : (absx * absy))); 2482 2401 } else { 2483 C_word ab[C_SIZEOF_ BIGNUM(1)], *a = ab, bigy;2402 C_word ab[C_SIZEOF_FIX_BIGNUM], *a = ab, bigy; 2484 2403 bigy = C_a_u_i_fix_to_big(&a, y); 2485 2404 bignum_times_halfdigit_fixnum(k, bigy, C_fix(absx), C_mk_bool(negp)); … … 2489 2408 C_kontinue(k, C_fix(negp ? (absx * absy) : (absx * absy))); 2490 2409 } else { 2491 C_word ab[C_SIZEOF_ BIGNUM(1)], *a = ab, bigx;2410 C_word ab[C_SIZEOF_FIX_BIGNUM], *a = ab, bigx; 2492 2411 bigx = C_a_u_i_fix_to_big(&a, x); 2493 2412 bignum_times_halfdigit_fixnum(k, bigx, C_fix(absy), C_mk_bool(negp)); 2494 2413 } 2495 2414 } 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; 2498 2416 bigx = C_a_u_i_fix_to_big(&a, x); 2499 2417 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)); 2503 2419 } 2504 2420 } … … 2523 2439 2524 2440 if (C_fitsinbignumhalfdigitp(absx)) { 2525 2441 bignum_times_halfdigit_fixnum(k, y, C_fix(absx), C_mk_bool(negp)); 2526 2442 } 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; 2529 2444 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 2449 void C_ccall 2450 C_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 */ 2463 static void 2464 bignum_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 2480 static void 2481 bignum_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/numbersc.h
r31308 r31309 169 169 170 170 #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) 171 173 172 174 /* CHAR_BIT is from <limits.h>, and it equals the number of bits in a char */ 
release/4/numbers/trunk/numbers.scm
r31304 r31309 153 153 (define %fix*fix (##core#primitive "C_u_2_fixnum_times")) 154 154 (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")) 156 156 157 157 (define %bigquotientfix (##core#primitive "big_quotient_fix"))
Note: See TracChangeset
for help on using the changeset viewer.