Changeset 31413 in project


Ignore:
Timestamp:
09/12/14 20:51:17 (5 years ago)
Author:
sjamaan
Message:

numbers: Convert divrem operations to core naming conventions

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

Legend:

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

    r31412 r31413  
    140140
    141141static void
    142 C_return_big_fix(C_word k, bignum_type big, C_word fix)
    143 {
    144   C_word kab[4], *ka = kab, k2;
    145   k2 = C_closure(&ka, 3, (C_word)C_bignum_wrapped_return_bigobj, k, fix);
    146   C_return_bignum(k2, big);
    147 }
    148 
    149 static void
    150142C_b2_wrapped(C_word c, C_word closure, C_word wrapped_b2)
    151143{
     
    268260  bignum_destructive_copy (bignum, result);
    269261  return (result);
    270 }
    271 
    272 static void
    273 big_divrem_big(C_word c, C_word self, C_word k, C_word x, C_word y)
    274 {
    275   bignum_type numerator = big_of(x);
    276   bignum_type denominator = big_of(y);
    277   int q_neg_p = ((BIGNUM_NEGATIVE_P (denominator))
    278                  ? (! (BIGNUM_NEGATIVE_P (numerator)))
    279                  : (BIGNUM_NEGATIVE_P (numerator)));
    280 
    281   switch (bignum_compare_unsigned (numerator, denominator))
    282     {
    283     case bignum_comparison_equal:
    284       C_values(4, C_SCHEME_UNDEFINED, k,
    285                q_neg_p ? C_fix(-1) : C_fix(1), C_fix(0));
    286     case bignum_comparison_less:
    287       C_values(4, C_SCHEME_UNDEFINED, k, C_fix(0), x);
    288     case bignum_comparison_greater:
    289     default:                                  /* to appease gcc -Wall */
    290       {
    291         bignum_type quotient, remainder;
    292         int r_neg_p = BIGNUM_NEGATIVE_P (numerator) ? 1 : 0;
    293        
    294         assert(BIGNUM_LENGTH(denominator) > 1);
    295         bignum_divide_unsigned_large_denominator
    296           (numerator, denominator, (&quotient), (&remainder), q_neg_p, r_neg_p);
    297         C_return_2_bignums(k, quotient, remainder);
    298       }
    299     }
    300 }
    301 
    302 static void
    303 big_divrem_fix(C_word c, C_word self, C_word k, C_word x, C_word y)
    304 {
    305   bignum_type bigx = big_of(x);
    306   y = C_unfix(y);
    307 
    308   if (y == 1)
    309     C_values(4, C_SCHEME_UNDEFINED, k, x, C_fix(0));
    310   else if (y == -1)
    311     C_return_big_fix(k, bignum_new_sign(bigx, !(BIGNUM_NEGATIVE_P(bigx))), C_fix(0));
    312 
    313   /* Too bad, we really need to do some work... */
    314   {
    315     int q_neg_p = (y < 0) ? !(BIGNUM_NEGATIVE_P(bigx)) : BIGNUM_NEGATIVE_P(bigx);
    316     int r_neg_p = BIGNUM_NEGATIVE_P(bigx);
    317     bignum_digit_type abs_y = (y < 0) ? -y : y;
    318     bignum_type quotient, remainder;
    319    
    320     if (y == C_MOST_NEGATIVE_FIXNUM) {
    321       if (!BIGNUM_NEGATIVE_P(bigx) && BIGNUM_LENGTH(bigx) == 1
    322           && BIGNUM_REF(bigx, 1) == 1 && BIGNUM_REF(bigx, 0) == 0) {
    323         /*
    324          * Very very special case:
    325          * quotient(MOST_NEGATIVE_FIXNUM, -(MOST_NEGATIVE_FIXNUM)) => -1
    326          */
    327         C_values(4, C_SCHEME_UNDEFINED, k, C_fix(-1), C_fix(0));
    328       } else {
    329         /* This is the only case we need to go allocate a bignum for */
    330         bignum_type bigy =
    331           bignum_allocate_from_fixnum(C_fix(C_MOST_NEGATIVE_FIXNUM));
    332 
    333         bignum_divide_unsigned_large_denominator
    334           (bigx, bigy, (&quotient), (&remainder), q_neg_p, r_neg_p);
    335         BIGNUM_DEALLOCATE(bigy);
    336         C_return_2_bignums(k, quotient, remainder);
    337       }
    338     } else if (abs_y < BIGNUM_RADIX_ROOT) {
    339       bignum_divide_unsigned_small_denominator
    340         (bigx, abs_y, (&quotient), (&remainder), q_neg_p, r_neg_p);
    341       C_return_2_bignums(k, quotient, remainder);
    342     } else {
    343       bignum_divide_unsigned_medium_denominator
    344         (bigx, abs_y, (&quotient), (&remainder), q_neg_p, r_neg_p);
    345       C_return_2_bignums(k, quotient, remainder);
    346     }
    347   }
    348262}
    349263
     
    1067981static void bignum_random_2(C_word c, C_word self, C_word result);
    1068982static void bignum_maybe_negate_magnitude(C_word k, C_word result);
     983static void bignum_divrem_fixnum_2(C_word c, C_word self, C_word negated_big);
    1069984static void bignum_negneg_bitwise_op(C_word c, C_word self, C_word result);
    1070985static void bignum_posneg_bitwise_op(C_word c, C_word self, C_word result);
     
    13331248      difference = ((*scan_x++) - borrow);
    13341249      if (difference < 0) {
    1335         /* TODO: Define something like BIGNUM_RADIX if we need it elsewhere */
    13361250        (*scan_r++) = ((C_word)1 << C_BIGNUM_DIGIT_LENGTH) + difference;
    13371251      } else {
     
    15751489  bignum_digits_destructive_copy(new_big, old_bigx);
    15761490
    1577   /* Scale up, and sanitise the result. TODO: make normalization one op? */
     1491  /* Scale up, and sanitise the result. */
    15781492  *end_digit = bignum_digits_destructive_scale_up_with_carry(digits, end_digit,
    15791493                                                             C_unfix(fixy), 0);
     
    23732287  }
    23742288  C_kontinue(k, C_bignum_normalize(result));
     2289}
     2290
     2291void C_ccall
     2292C_u_bignum_divrem_fixnum(C_word c, C_word self, C_word k, C_word x, C_word y)
     2293{
     2294  y = C_unfix(y);
     2295
     2296  if (y == 1) {
     2297    C_values(4, C_SCHEME_UNDEFINED, k, x, C_fix(0));
     2298  } else if (y == -1) {
     2299    C_word kab[C_SIZEOF_CLOSURE(2)], *ka = kab, k2;
     2300    k2 = C_closure(&ka, 2, (C_word)bignum_divrem_fixnum_2, k);
     2301    C_u_bignum_negate(1, (C_word)NULL, k2, x);
     2302  } else if (y == C_MOST_NEGATIVE_FIXNUM) {
     2303    /* This is the only case we need to go allocate a bignum for */
     2304    C_word kab[C_SIZEOF_FIX_BIGNUM+C_SIZEOF_CLOSURE(9)], *ka = kab, k2, size,
     2305           q_negp = !(C_bignum_negativep(x)), /* We already know y < 0 */
     2306           r_negp = C_bignum_negativep(x);
     2307
     2308    y = C_a_u_i_fix_to_big(&ka, C_fix(C_MOST_NEGATIVE_FIXNUM));
     2309
     2310    k2 = C_closure(&ka, 9, (C_word)bignum_divide_2_unsigned, k, x, y,
     2311                   /* Return quotient *and* remainder */
     2312                   C_SCHEME_TRUE, C_SCHEME_TRUE, r_negp,
     2313                   /* Will be filled in later */
     2314                   C_SCHEME_UNDEFINED, C_SCHEME_UNDEFINED);
     2315    size = C_fix(C_bignum_size(x) + 1 - C_bignum_size(y));
     2316    C_allocate_bignum(3, (C_word)NULL, k2, size, q_negp, C_SCHEME_FALSE);
     2317  } else {
     2318    C_word kab[C_SIZEOF_FIX_BIGNUM+C_SIZEOF_CLOSURE(7)], *ka = kab, k2,
     2319           q_negp = (y < 0) ? !(C_bignum_negativep(x)) : C_bignum_negativep(x),
     2320           r_negp = C_bignum_negativep(x),
     2321           absy = (y < 0) ? -y : y,
     2322           size, func;
     2323
     2324    if (C_fitsinbignumhalfdigitp(absy)) {
     2325      size = C_fix(C_bignum_size(x));
     2326      func = (C_word)bignum_destructive_divide_unsigned_halfdigit;
     2327    } else {
     2328      size = C_fix(C_bignum_size(x)) + 1; /* Due to normalization */
     2329      func = (C_word)bignum_destructive_divide_unsigned_digit;
     2330    }
     2331
     2332    k2 = C_closure(&ka, 7, func, k, x, C_fix(absy),
     2333                   /* Return quotient *and* remainder */
     2334                   C_SCHEME_TRUE, C_SCHEME_FALSE, C_SCHEME_FALSE);
     2335    C_allocate_bignum(3, (C_word)NULL, k2, size, q_negp, r_negp);
     2336  }
     2337}
     2338
     2339static void
     2340bignum_divrem_fixnum_2(C_word c, C_word self, C_word negated_big)
     2341{
     2342   C_word k = C_block_item(self, 1);
     2343   C_values(4, C_SCHEME_UNDEFINED, k, negated_big, C_fix(0));
     2344}
     2345
     2346void C_ccall
     2347C_u_bignum_divrem_bignum(C_word c, C_word self, C_word k, C_word x, C_word y)
     2348{
     2349  C_word kab[C_SIZEOF_FIX_BIGNUM+C_SIZEOF_CLOSURE(9)], *ka = kab, k2, size,
     2350         q_negp = C_bignum_negativep(y)
     2351                  ? !C_bignum_negativep(x)
     2352                  : C_bignum_negativep(x),
     2353         r_negp = C_bignum_negativep(x);
     2354
     2355  switch(bignum_cmp_unsigned(x, y)) {
     2356  case 0:
     2357    C_values(4, C_SCHEME_UNDEFINED, k,
     2358             C_truep(q_negp) ? C_fix(-1) : C_fix(1), C_fix(0));
     2359  case -1:
     2360    C_values(4, C_SCHEME_UNDEFINED, k, C_fix(0), x);
     2361  case 1:
     2362    k2 = C_closure(&ka, 9, (C_word)bignum_divide_2_unsigned, k, x, y,
     2363                   /* Return quotient *and* remainder */
     2364                   C_SCHEME_TRUE, C_SCHEME_TRUE, r_negp,
     2365                   /* Will be filled in later */
     2366                   C_SCHEME_UNDEFINED, C_SCHEME_UNDEFINED);
     2367    size = C_fix(C_bignum_size(x) + 1 - C_bignum_size(y));
     2368    C_allocate_bignum(3, (C_word)NULL, k2, size, q_negp, C_SCHEME_FALSE);
     2369  }
    23752370}
    23762371
  • release/4/numbers/trunk/numbers-c.h

    r31412 r31413  
    195195void C_ccall C_u_2_bignum_times(C_word c, C_word self, C_word k, C_word x, C_word y);
    196196
     197void C_ccall C_u_bignum_divrem_fixnum(C_word c, C_word self, C_word k, C_word x, C_word y);
     198void C_ccall C_u_bignum_divrem_bignum(C_word c, C_word self, C_word k, C_word x, C_word y);
    197199void C_ccall C_u_bignum_remainder_fixnum(C_word c, C_word self, C_word k, C_word x, C_word y);
    198200void C_ccall C_u_bignum_remainder_bignum(C_word c, C_word self, C_word k, C_word x, C_word y);
  • release/4/numbers/trunk/numbers.scm

    r31412 r31413  
    157157(define %big-remainder-big (##core#primitive "C_u_bignum_remainder_bignum"))
    158158
    159 (define %big-divrem-fix (##core#primitive "big_divrem_fix"))
    160 (define %big-divrem-big (##core#primitive "big_divrem_big"))
     159(define %big-divrem-fix (##core#primitive "C_u_bignum_divrem_fixnum"))
     160(define %big-divrem-big (##core#primitive "C_u_bignum_divrem_bignum"))
    161161
    162162;; This one should really be part of Chicken, hence the name
Note: See TracChangeset for help on using the changeset viewer.