Changeset 31412 in project


Ignore:
Timestamp:
09/12/14 20:08:54 (7 years ago)
Author:
sjamaan
Message:

numbers: Convert remainder procedures to core naming conventions

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

Legend:

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

    r31411 r31412  
    10331033}
    10341034
    1035 static void
    1036 big_remainder_fix(C_word c, C_word self, C_word k, C_word x, C_word y)
    1037 {
    1038    bignum_type remainder, bigy, bigx;
    1039    int x_neg, y_neg;
    1040    C_word abs_y;
    1041 
    1042    switch (y) {
    1043    /* case 0:  SHOULD NOT HAPPEN (checked in Scheme)
    1044      C_kontinue(k, C_SCHEME_FALSE); */
    1045    case C_fix(1):
    1046    case C_fix(-1):
    1047      C_kontinue(k, C_fix(0));
    1048    case C_fix(C_MOST_NEGATIVE_FIXNUM):
    1049      bigx = big_of(x);
    1050      if (BIGNUM_LENGTH(bigx) == 2 && BIGNUM_REF(bigx, 0) == 0 && BIGNUM_REF(bigx, 0))
    1051        C_kontinue(k, C_fix(0));
    1052      /* Don't handle 0 <= length(bigx) <= 1 since then it should be a fixnum */
    1053      assert(BIGNUM_LENGTH(bigx) >= 2);
    1054      
    1055      bigy = bignum_allocate_from_fixnum(y);
    1056      bignum_divide_unsigned_large_denominator
    1057       (bigx, bigy, (bignum_type *)0, &remainder, 0, BIGNUM_NEGATIVE_P(bigx));
    1058      BIGNUM_DEALLOCATE(bigy);
    1059      
    1060      C_return_bignum(k, remainder);
    1061    default:
    1062      bigx = big_of(x);
    1063      y = C_unfix(y);
    1064      y_neg = (y < 0);
    1065      abs_y = y_neg ? -y : y;
    1066      x_neg = BIGNUM_NEGATIVE_P(bigx);
    1067      
    1068      if (abs_y < BIGNUM_RADIX_ROOT)
    1069        remainder =
    1070          bignum_remainder_unsigned_small_denominator(bigx, abs_y, x_neg);
    1071      else
    1072        bignum_divide_unsigned_medium_denominator(bigx, abs_y,
    1073                                                  (bignum_type *) 0, &remainder,
    1074                                                  x_neg, x_neg);
    1075      C_return_bignum(k, remainder);
    1076    }
    1077 }
    1078 
    1079 static void
    1080 big_remainder_big(C_word c, C_word self, C_word k, C_word x, C_word y)
    1081 {
    1082   bignum_type numerator = big_of(x), denominator = big_of(y);
    1083  
    1084   switch (bignum_compare_unsigned (numerator, denominator))
    1085     {
    1086       case bignum_comparison_equal:
    1087         C_kontinue(k, C_fix(0));
    1088       case bignum_comparison_less:
    1089         C_kontinue(k, x);
    1090       case bignum_comparison_greater:
    1091       default:                                  /* to appease gcc -Wall */
    1092         {
    1093           bignum_type remainder;
    1094           bignum_divide_unsigned_large_denominator
    1095             (numerator, denominator,
    1096              ((bignum_type *) 0), (&remainder),
    1097              0, BIGNUM_NEGATIVE_P(numerator));
    1098           C_return_bignum(k, remainder);
    1099         }
    1100     }
    1101 }
    11021035
    11031036/**
     
    11381071static void bignum_pospos_bitwise_op(C_word c, C_word self, C_word result);
    11391072static void bignum_destructive_normalize(C_word target, C_word source, C_word shift_left);
     1073static void bignum_destructive_remainder_unsigned_halfdigit(C_word k, C_word n, C_word d, C_word negp);
    11401074static void bignum_destructive_divide_unsigned_halfdigit(C_word c, C_word self, C_word quotient);
    11411075static void bignum_destructive_divide_unsigned_digit(C_word c, C_word self, C_word quotient);
     
    13521286  C_word kab[C_SIZEOF_CLOSURE(4)], *ka = kab, k2, size, negp;
    13531287
    1354   switch (bignum_cmp_unsigned(x, y)) {
     1288  switch(bignum_cmp_unsigned(x, y)) {
    13551289  case 0:             /* x = y, return 0 */
    13561290    C_kontinue(k, C_fix(0));
     
    15551489  length = scan - start + 1;
    15561490 
    1557   switch (length) {
     1491  switch(length) {
    15581492  case 0:
    15591493    return C_fix(0);
     
    24422376
    24432377void C_ccall
     2378C_u_bignum_remainder_fixnum(C_word c, C_word self, C_word k, C_word x, C_word y)
     2379{
     2380  C_word negp = C_mk_bool(C_bignum_negativep(x));
     2381   
     2382  y = C_unfix(y);
     2383
     2384  if (y == 1 || y == -1) {
     2385    C_kontinue(k, C_fix(0));
     2386  } else if (y == C_MOST_NEGATIVE_FIXNUM) {
     2387    /* This is the only case we need to go allocate a bignum for */
     2388    C_word ab[C_SIZEOF_FIX_BIGNUM+C_SIZEOF_CLOSURE(9)], *a = ab, k2, size;
     2389
     2390    y = C_a_u_i_fix_to_big(&a, C_fix(C_MOST_NEGATIVE_FIXNUM));
     2391
     2392    /* We can skip bignum_divide_2_unsigned because we need no quotient */
     2393    k2 = C_closure(&a, 9, (C_word)bignum_divide_2_unsigned_2, k, x, y,
     2394                   /* Do not return quotient, do return remainder */
     2395                   C_SCHEME_FALSE, C_SCHEME_TRUE, negp,
     2396                   C_SCHEME_UNDEFINED, C_SCHEME_UNDEFINED);
     2397    size = C_fix(C_bignum_size(x) + 1);
     2398    C_allocate_bignum(3, (C_word)NULL, k2, size, negp, C_SCHEME_FALSE);
     2399  } else {
     2400    C_word absy = (y < 0) ? -y : y;
     2401     
     2402    if (C_fitsinbignumhalfdigitp(absy)) {
     2403      bignum_destructive_remainder_unsigned_halfdigit(k, x, absy, negp);
     2404    } else {
     2405      C_word kab[C_SIZEOF_CLOSURE(7)], *ka = kab, k2,
     2406             size = C_fix(C_bignum_size(x)) + 1; /* Due to normalization */
     2407     
     2408      k2 = C_closure(&ka, 7, (C_word)bignum_destructive_divide_unsigned_digit,
     2409                     k, x, C_fix(absy),
     2410                     /* Do not return quotient, do return remainder */
     2411                     C_SCHEME_FALSE, C_SCHEME_TRUE, negp);
     2412      C_allocate_bignum(3, (C_word)NULL, k2, size, negp, C_SCHEME_FALSE);
     2413    }
     2414  }
     2415}
     2416
     2417void C_ccall
     2418C_u_bignum_remainder_bignum(C_word c, C_word self, C_word k, C_word x, C_word y)
     2419{
     2420  C_word ab[C_SIZEOF_FIX_BIGNUM+C_SIZEOF_CLOSURE(9)], *a = ab, k2, size, negp;
     2421
     2422  switch(bignum_cmp_unsigned(x, y)) {
     2423  case 0:
     2424    C_kontinue(k, C_fix(0));
     2425  case -1:
     2426    C_kontinue(k, x);
     2427  case 1:
     2428    negp = C_bignum_negativep(x);
     2429
     2430    /* We can skip bignum_divide_2_unsigned because we need no quotient */
     2431    k2 = C_closure(&a, 9, (C_word)bignum_divide_2_unsigned_2, k, x, y,
     2432                   /* Do not return quotient, do return remainder */
     2433                   C_SCHEME_FALSE, C_SCHEME_TRUE, negp,
     2434                   C_SCHEME_UNDEFINED, C_SCHEME_UNDEFINED);
     2435    size = C_fix(C_bignum_size(x) + 1); /* May need to be normalized */
     2436    C_allocate_bignum(3, (C_word)NULL, k2, size, negp, C_SCHEME_FALSE);
     2437  }
     2438}
     2439
     2440static void
     2441bignum_destructive_remainder_unsigned_halfdigit(C_word k, C_word n, C_word d, C_word negp)
     2442{
     2443  C_word two_digits,
     2444         *start = C_bignum_digits(n),
     2445         *scan = start + C_bignum_size(n),
     2446         r = 0;
     2447
     2448  assert((d > 1) && (d < BIGNUM_RADIX_ROOT));
     2449  while (start < scan) {
     2450    two_digits = (*--scan);
     2451    r = C_BIGNUM_DIGIT_COMBINE(r, C_BIGNUM_DIGIT_HI_HALF(two_digits)) % d;
     2452    r = C_BIGNUM_DIGIT_COMBINE(r, C_BIGNUM_DIGIT_LO_HALF(two_digits)) % d;
     2453  }
     2454  C_kontinue(k, C_truep(negp) ? C_fix(-r) : C_fix(r));
     2455}
     2456
     2457void C_ccall
    24442458C_u_bignum_quotient_fixnum(C_word c, C_word self, C_word k, C_word x, C_word y)
    24452459{
     
    24942508                         C_bignum_negativep(y));
    24952509
    2496   switch (bignum_cmp_unsigned(x, y)) {
     2510  switch(bignum_cmp_unsigned(x, y)) {
    24972511  case 0:
    24982512    C_kontinue(k, C_truep(negp) ? C_fix(-1) : C_fix(1));
     
    29742988  assert(length != 1 || *C_bignum_digits(big) != 0);
    29752989
    2976   switch (length) {
     2990  switch(length) {
    29772991  case 0:
    29782992    return C_fix(0);
  • release/4/numbers/trunk/numbers-c.h

    r31411 r31412  
    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_remainder_fixnum(C_word c, C_word self, C_word k, C_word x, C_word y);
     198void C_ccall C_u_bignum_remainder_bignum(C_word c, C_word self, C_word k, C_word x, C_word y);
    197199void C_ccall C_u_bignum_quotient_fixnum(C_word c, C_word self, C_word k, C_word x, C_word y);
    198200void C_ccall C_u_bignum_quotient_bignum(C_word c, C_word self, C_word k, C_word x, C_word y);
     201
    199202
    200203void C_ccall C_u_fixnum_minus_bignum(C_word c, C_word self, C_word k, C_word x, C_word y);
  • release/4/numbers/trunk/numbers.scm

    r31411 r31412  
    154154(define %big-quotient-big (##core#primitive "C_u_bignum_quotient_bignum"))
    155155
    156 (define %big-remainder-fix (##core#primitive "big_remainder_fix"))
    157 (define %big-remainder-big (##core#primitive "big_remainder_big"))
     156(define %big-remainder-fix (##core#primitive "C_u_bignum_remainder_fixnum"))
     157(define %big-remainder-big (##core#primitive "C_u_bignum_remainder_bignum"))
    158158
    159159(define %big-divrem-fix (##core#primitive "big_divrem_fix"))
Note: See TracChangeset for help on using the changeset viewer.