Changeset 31415 in project


Ignore:
Timestamp:
09/12/14 22:06:01 (5 years ago)
Author:
sjamaan
Message:

numbers: Rip out remaining bits of old-style code. Unfortunately, this means gcd on bignums is now twice as slow :( But then, who uses that anyway..? ;)

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

Legend:

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

    r31414 r31415  
    4545#include "numbers-c.h"
    4646
    47 #define big_of(v)                 ((bignum_type)C_data_pointer(C_block_item(v, 1)))
    48 
    49 static C_word
    50 init_tags(___scheme_value tagvec)
    51 {
    52   tags = CHICKEN_new_gc_root();
    53   CHICKEN_gc_root_set(tags, tagvec);
    54   return C_SCHEME_UNDEFINED;
    55 }
    56 
    57 static C_word
    58 check_number(C_word x)
    59 {
    60   C_word tagvec;
    61 
    62   if((x & C_FIXNUM_BIT) != 0) return C_fix(FIX);
    63   else if(C_immediatep(x)) return C_fix(NONE);
    64   else if(C_header_bits(x) == C_FLONUM_TYPE) return C_fix(FLO);
    65   else if(C_header_bits(x) == C_STRUCTURE_TYPE) {
    66     tagvec = CHICKEN_gc_root_ref(tags);
    67    
    68     if (C_block_item(x, 0) == C_block_item(tagvec, BIG_TAG))
    69       return C_fix(BIG);
    70     else if (C_block_item(x, 0) == C_block_item(tagvec, COMP_TAG))
    71       return C_fix(COMP);
    72     else if (C_block_item(x, 0) == C_block_item(tagvec, RAT_TAG))
    73       return C_fix(RAT);
    74     else
    75       return C_fix(NONE);
    76   } else
    77       return C_fix(NONE);
    78 }
    79 
    80 static void
    81 C_wrap_bignum(C_word c, C_word closure, C_word bigvec)
    82 {
    83   C_word ab[3], *a = ab;
    84   bignum_type src = (bignum_type)C_block_item(C_block_item(closure, 2), 0);
    85   bignum_digit_type *scan = BIGNUM_TO_POINTER(src);
    86   bignum_digit_type *end = BIGNUM_START_PTR(src) + BIGNUM_LENGTH(src);
    87   bignum_digit_type *tgt = C_data_pointer(bigvec);
    88   C_word tagvec = CHICKEN_gc_root_ref(tags);
    89   C_word result = C_structure(&a, 2, C_block_item(tagvec, BIG_TAG), bigvec);
    90   while (scan < end)
    91     (*tgt++) = (*scan++);
    92   BIGNUM_DEALLOCATE(src);
    93   C_kontinue(C_block_item(closure, 1), result);
    94 }
    95 
    96 static void
    97 C_return_bignum(C_word k, bignum_type b)
    98 {
    99   C_word result;
    100  
    101   assert(b != BIGNUM_OUT_OF_BAND);
    102 
    103   switch(BIGNUM_LENGTH(b)) {
    104   case 0:
    105     BIGNUM_DEALLOCATE(b);
    106     C_kontinue(k, C_fix(0));
    107   /* This code "knows" that bignums have 2 "reserved" bits, like fixnums */
    108   case 1:
    109     result = C_fix(BIGNUM_NEGATIVE_P(b) ? -BIGNUM_REF(b, 0) : BIGNUM_REF(b, 0));
    110     BIGNUM_DEALLOCATE(b);
    111     C_kontinue(k, result);
    112   case 2:
    113     /* Edge case: most negative fixnum */
    114     if (BIGNUM_NEGATIVE_P(b) && BIGNUM_REF(b, 0) == 0 && BIGNUM_REF(b, 1) == 1) {
    115       BIGNUM_DEALLOCATE(b);
    116       C_kontinue(k, C_fix(C_MOST_NEGATIVE_FIXNUM));
    117     }
    118     /* FALLTHROUGH */
    119   default:
    120     {
    121       C_word pab[2], *pa = pab, kab[4], *ka = kab, k2;
    122       /* Make result a wrapped pointer because C_closure wants scheme objects */
    123       result = C_mpointer(&pa, b);
    124       k2 = C_closure(&ka, 3, (C_word)C_wrap_bignum, k, result);
    125       /* Here we assume bignum digits are C words.. */
    126       C_allocate_vector(6, (C_word)NULL, k2,
    127                         C_fix(sizeof(C_word) * (BIGNUM_LENGTH(b) + 1)),
    128                         /* Byte vec, no initialization, align at 8 bytes */
    129                         C_SCHEME_TRUE, C_SCHEME_FALSE, C_SCHEME_FALSE);
    130     }
    131   }
    132 }
    133 
    134 static void
    135 C_bignum_wrapped_return_bigobj(C_word c, C_word closure, C_word wrapped_big)
    136 {
    137   C_word obj = C_block_item(closure, 2);
    138   C_values(4, C_SCHEME_UNDEFINED, C_block_item(closure, 1), wrapped_big, obj);
    139 }
    140 
    141 static void
    142 C_b2_wrapped(C_word c, C_word closure, C_word wrapped_b2)
    143 {
    144   C_word k = C_block_item(closure, 1); /* Original closure */
    145   C_word kab[4], *ka = kab, k2; /* Next continuation */
    146   k2 = C_closure(&ka, 3, (C_word)C_bignum_wrapped_return_bigobj, k, wrapped_b2);
    147   C_return_bignum(k2, (bignum_type)C_block_item(C_block_item(closure, 2), 0));
    148 }
    149 
    150 static void
    151 C_return_2_bignums(C_word k, bignum_type b1, bignum_type b2)
    152 {
    153   C_word bab[2], *ba = bab, kab[4], *ka = kab, k2, b1_ptr;
    154   /* Make b1 a wrapped pointer because C_closure wants scheme objects */
    155   b1_ptr = C_mpointer(&ba, b1);
    156   /* Wrap b2 first, then b1. Return them to k in the original (b1,b2) order */
    157   k2 = C_closure(&ka, 3, (C_word)C_b2_wrapped, k, b1_ptr);
    158   C_return_bignum(k2, b2);
    159 }
    160 
    161 
    162 static bignum_type
    163 bignum_allocate(bignum_length_type length, int negative_p)
    164 {
    165   bignum_type result;
    166   bignum_digit_type *digits;
    167 
    168   digits = (bignum_digit_type *)C_malloc(sizeof(bignum_digit_type)*(length + 1));
    169  
    170   if(digits == NULL) {
    171     fprintf(stderr, "out of memory - can not allocate number");
    172     exit(EXIT_FAILURE);
    173   }
    174 
    175   result = (bignum_type)digits;
    176   BIGNUM_SET_HEADER(result, length, negative_p);
    177   return result;
    178 }
    179 
    180 static bignum_type
    181 bignum_allocate_from_fixnum(C_word fix)
    182 {
    183   bignum_type ret;
    184 
    185   if (fix == C_fix(0)) {
    186     ret = bignum_allocate(0, 0);
    187   } else if (fix == C_fix(C_MOST_NEGATIVE_FIXNUM)) {
    188     ret = bignum_allocate(2, 1);
    189     BIGNUM_REF(ret, 0) = 0;
    190     BIGNUM_REF(ret, 1) = 1;
    191   } else {
    192     bignum_digit_type digit = C_unfix(fix);
    193     ret = bignum_allocate(1, digit < 0);
    194     BIGNUM_REF(ret, 0) = ((digit < 0) ? -digit : digit);
    195   }
    196   return ret;
    197 }
    198 
    199 static bignum_type
    200 bignum_digit_to_bignum(bignum_digit_type digit, int neg_p)
    201 {
    202   bignum_type ret;
    203   if (digit == 0)
    204     return bignum_allocate(0, 0);
    205 
    206   ret = bignum_allocate(1, neg_p);
    207   BIGNUM_REF(ret, 0) = digit;
    208   return ret;
    209 }
    210 
    211 static bignum_type
    212 shorten_bignum(bignum_type big, bignum_length_type newlength)
    213 {
    214   bignum_digit_type *digits, *newdigits;
    215   digits = BIGNUM_TO_POINTER(big);
    216   newdigits = (bignum_digit_type *)C_realloc(digits, sizeof(bignum_digit_type)*(newlength + 1));
    217   if (newdigits == NULL) {
    218     fprintf(stderr, "out of memory - can not reallocate number");
    219     exit(EXIT_FAILURE);
    220   }
    221   return (bignum_type)newdigits;
    222 }
    223 
    224 static bignum_type
    225 bignum_trim(bignum_type bignum)
    226 {
    227   bignum_digit_type * start = (BIGNUM_START_PTR (bignum));
    228   bignum_digit_type * end = (start + (BIGNUM_LENGTH (bignum)));
    229   bignum_digit_type * scan = end;
    230   while ((start <= scan) && ((*--scan) == 0))
    231     ;
    232   scan += 1;
    233   if (scan < end)
    234     {
    235       bignum_length_type length = (scan - start);
    236       BIGNUM_SET_HEADER
    237         (bignum, length, ((length != 0) && (BIGNUM_NEGATIVE_P (bignum))));
    238       BIGNUM_REDUCE_LENGTH (bignum, bignum, length);
    239     }
    240   return (bignum);
    241 }
    242 
    243 static void
    244 bignum_destructive_copy(bignum_type source, bignum_type target)
    245 {
    246   bignum_digit_type * scan_source = (BIGNUM_START_PTR (source));
    247   bignum_digit_type * end_source =
    248     (scan_source + (BIGNUM_LENGTH (source)));
    249   bignum_digit_type * scan_target = (BIGNUM_START_PTR (target));
    250   while (scan_source < end_source)
    251     (*scan_target++) = (*scan_source++);
    252   return;
    253 }
    254 
    255 static bignum_type
    256 bignum_new_sign(bignum_type bignum, int negative_p)
    257 {
    258   bignum_type result =
    259     (bignum_allocate ((BIGNUM_LENGTH (bignum)), negative_p));
    260   bignum_destructive_copy (bignum, result);
    261   return (result);
    262 }
    263 
    264 /*
    265  * Big_gcd is a huge function and it sucks that it needs to be in C.
    266  *
    267  * Why does it need to be in C?  Because if you have a very big bignum
    268  * that doesn't cleanly divide another big bignum, you end up calling
    269  * the remainder procedure a lot in Scheme.  This produces tons of
    270  * intermediate bignums, which means a lot of copies into GC'able memory
    271  * need to be made (and the GC will be triggered more often).
    272  * That's a major slowdown.  Doing the loop in C means the intermediate
    273  * results can be cleaned up right away each loop step, and returning
    274  * just one result to Scheme.
    275  * Once (if?) we find a way to avoid copying bignums (instead allocating
    276  * directly in GCable memory) this function can be cut out and replaced by
    277  * a recursive call to gcd-0 in Scheme.
    278  */
    279 static void
    280 big_gcd(C_word c, C_word self, C_word k, C_word x, C_word y)
    281 {
    282   bignum_type bigx = big_of(x), bigy = big_of(y), bigr;
    283 
    284   assert(BIGNUM_LENGTH(bigx) > 1);
    285   assert(BIGNUM_LENGTH(bigy) > 1);
    286  
    287   switch(bignum_compare_unsigned (bigx, bigy)) {
    288   case bignum_comparison_equal:
    289     C_kontinue(k, x);
    290   case bignum_comparison_less:
    291     /* Swap, since remainder of bigx, bigy would be bigx, causing an extra loop */
    292     bigr = bigy;
    293     bigy = bigx;
    294     bigx = bigr;
    295 
    296     /* Make x and y match for the special case where gcd(x, y) = y */
    297     {
    298       C_word tmp = y;
    299       y = x;
    300       x = tmp;
    301     }
    302     /* FALLTHROUGH */
    303   default: /* Continue below */
    304     break;
    305   }
    306  
    307   /*
    308    * Be careful! Don't deallocate live objects. We could start with a copy
    309    * or compare pointers with big_of(x) or y every time but that seems wasteful.
    310    */
    311   bignum_divide_unsigned_large_denominator
    312    (bigx, bigy, ((bignum_type *) 0), (&bigr), 0, 0);
    313   bigx = bigy;
    314   bigy = bigr;
    315   /* Original bigx is forgotten now */
    316   assert(bigx != big_of(x));
    317   assert(bigy != big_of(x));
    318   /* Only bigx points to y */
    319   assert(bigy != big_of(y));
    320   assert(bigx == big_of(y));
    321 
    322   switch (BIGNUM_LENGTH(bigy)) {
    323   case 0:  /* bigy = 0 */
    324     /* remainder(x, y) = 0 => y  |  x < y */
    325     BIGNUM_DEALLOCATE(bigy); /* Got allocated in previous step */
    326     C_kontinue(k, y);
    327   case 1:
    328     if (BIGNUM_REF(bigy, 0) == 1) { /* y = 1? Then 1 is the result */
    329       BIGNUM_DEALLOCATE(bigy); /* Got allocated in previous step */
    330       C_kontinue(k, C_fix(1));
    331     } else if (BIGNUM_REF(bigy, 0) < BIGNUM_RADIX_ROOT)
    332       bigr = bignum_remainder_unsigned_small_denominator
    333               (bigx, BIGNUM_REF(bigy, 0), 0);
    334     else
    335       bignum_divide_unsigned_medium_denominator
    336        (bigx, BIGNUM_REF(bigy, 0), (bignum_type *)0, (&bigr), 0, 0);
    337     break;
    338   default:
    339     bignum_divide_unsigned_large_denominator
    340      (bigx, bigy, ((bignum_type *) 0), (&bigr), 0, 0);
    341   }
    342   /* Swap, but don't deallocate x since it holds the original value of y */
    343   bigx = bigy;
    344   bigy = bigr;
    345  
    346   /* Original bigy is forgotten now, we can safely always deallocate bigx */
    347 
    348   /* Assume that bignums coming from outside are never length 1 */
    349   assert(bigx != big_of(y));
    350  
    351   while(BIGNUM_LENGTH(bigy) > 1) {
    352     bignum_divide_unsigned_large_denominator
    353      (bigx, bigy, ((bignum_type *) 0), (&bigr), 0, 0);
    354     BIGNUM_DEALLOCATE(bigx);
    355     bigx = bigy;
    356     bigy = bigr;
    357   }
    358 
    359   /* Finish up with a faster loop until y = 0 (ie, length(bigy) = 0) */
    360   while (BIGNUM_LENGTH(bigy) == 1) {
    361     if (BIGNUM_REF(bigy, 0) == 1) {
    362       BIGNUM_DEALLOCATE(bigx);
    363       BIGNUM_DEALLOCATE(bigy);
    364       C_kontinue(k, C_fix(1));
    365       break;
    366     } else if (BIGNUM_REF(bigy, 0) < BIGNUM_RADIX_ROOT) {
    367       bigr = bignum_remainder_unsigned_small_denominator
    368               (bigx, BIGNUM_REF(bigy, 0), 0);
    369     } else {
    370       bignum_divide_unsigned_medium_denominator
    371        (bigx, BIGNUM_REF(bigy, 0), (bignum_type *)0, (&bigr), 0, 0);
    372     }
    373     BIGNUM_DEALLOCATE(bigx);
    374     bigx = bigy;
    375     bigy = bigr;
    376   }
    377   BIGNUM_DEALLOCATE(bigy);
    378   C_return_bignum(k, bigx);
    379 }
    380 
    381 /* Division */
    382 
    383 /* For help understanding this algorithm, see:
    384    Knuth, Donald E., "The Art of Computer Programming",
    385    volume 2, "Seminumerical Algorithms"
    386    section 4.3.1, "Multiple-Precision Arithmetic". */
    387 
    388 static void
    389 bignum_divide_unsigned_large_denominator(bignum_type numerator,
    390                                          bignum_type denominator,
    391                                          bignum_type * quotient,
    392                                          bignum_type * remainder,
    393                                          int q_negative_p,
    394                                          int r_negative_p)
    395 {
    396   bignum_length_type length_n = ((BIGNUM_LENGTH (numerator)) + 1);
    397   bignum_length_type length_d = (BIGNUM_LENGTH (denominator));
    398   bignum_type q =
    399     ((quotient != ((bignum_type *) 0))
    400      ? (bignum_allocate ((length_n - length_d), q_negative_p))
    401      : BIGNUM_OUT_OF_BAND);
    402   bignum_type u = (bignum_allocate (length_n, r_negative_p));
    403   int shift = 0;
    404   assert(length_d > 1);
    405   {
    406     bignum_digit_type v1 = (BIGNUM_REF ((denominator), (length_d - 1)));
    407     while (v1 < (BIGNUM_RADIX / 2))
    408       {
    409         v1 <<= 1;
    410         shift += 1;
    411       }
    412   }
    413   if (shift == 0)
    414     {
    415       bignum_destructive_copy (numerator, u);
    416       (BIGNUM_REF (u, (length_n - 1))) = 0;
    417       bignum_divide_unsigned_normalized (u, denominator, q);
    418       if (remainder != ((bignum_type *) 0))
    419         (*remainder) = (bignum_trim (u));
    420       else
    421         BIGNUM_DEALLOCATE (u);
    422     }
    423   else
    424     {
    425       bignum_type v = (bignum_allocate (length_d, 0));
    426       bignum_destructive_normalization (numerator, u, shift);
    427       bignum_destructive_normalization (denominator, v, shift);
    428       bignum_divide_unsigned_normalized (u, v, q);
    429       BIGNUM_DEALLOCATE (v);
    430       if (remainder != ((bignum_type *) 0))
    431         (*remainder) = bignum_destructive_unnormalization (u, shift);
    432       else
    433         BIGNUM_DEALLOCATE(u);
    434     }
    435   if (quotient != ((bignum_type *) 0))
    436     (*quotient) = (bignum_trim (q));
    437   return;
    438 }
    439 
    440 static void
    441 bignum_divide_unsigned_normalized(bignum_type u, bignum_type v, bignum_type q)
    442 {
    443   bignum_length_type u_length = (BIGNUM_LENGTH (u));
    444   bignum_length_type v_length = (BIGNUM_LENGTH (v));
    445   bignum_digit_type * u_start = (BIGNUM_START_PTR (u));
    446   bignum_digit_type * u_scan = (u_start + u_length);
    447   bignum_digit_type * u_scan_limit = (u_start + v_length);
    448   bignum_digit_type * u_scan_start = (u_scan - v_length);
    449   bignum_digit_type * v_start = (BIGNUM_START_PTR (v));
    450   bignum_digit_type * v_end = (v_start + v_length);
    451   bignum_digit_type * q_scan;
    452   bignum_digit_type v1 = (v_end[-1]);
    453   bignum_digit_type v2 = (v_end[-2]);
    454   bignum_digit_type ph; /* high half of double-digit product */
    455   bignum_digit_type pl; /* low half of double-digit product */
    456   bignum_digit_type guess;
    457   bignum_digit_type gh; /* high half-digit of guess */
    458   bignum_digit_type ch; /* high half of double-digit comparand */
    459   bignum_digit_type v2l = (HD_LOW (v2));
    460   bignum_digit_type v2h = (HD_HIGH (v2));
    461   bignum_digit_type cl; /* low half of double-digit comparand */
    462 #define gl ph                   /* low half-digit of guess */
    463 #define uj pl
    464 #define qj ph
    465   bignum_digit_type gm;         /* memory loc for reference parameter */
    466   if (q != BIGNUM_OUT_OF_BAND)
    467     q_scan = ((BIGNUM_START_PTR (q)) + (BIGNUM_LENGTH (q)));
    468   while (u_scan_limit < u_scan)
    469     {
    470       uj = (*--u_scan);
    471       if (uj != v1)
    472         {
    473           /* comparand =
    474              (((((uj * BIGNUM_RADIX) + uj1) % v1) * BIGNUM_RADIX) + uj2);
    475              guess = (((uj * BIGNUM_RADIX) + uj1) / v1); */
    476           cl = (u_scan[-2]);
    477           ch = (bignum_digit_divide (uj, (u_scan[-1]), v1, (&gm)));
    478           guess = gm;
    479         }
    480       else
    481         {
    482           cl = (u_scan[-2]);
    483           ch = ((u_scan[-1]) + v1);
    484           guess = (BIGNUM_RADIX - 1);
    485         }
    486       while (1)
    487         {
    488           /* product = (guess * v2); */
    489           gl = (HD_LOW (guess));
    490           gh = (HD_HIGH (guess));
    491           pl = (v2l * gl);
    492           ph = ((v2l * gh) + (v2h * gl) + (HD_HIGH (pl)));
    493           pl = (HD_CONS ((HD_LOW (ph)), (HD_LOW (pl))));
    494           ph = ((v2h * gh) + (HD_HIGH (ph)));
    495           /* if (comparand >= product) */
    496           if ((ch > ph) || ((ch == ph) && (cl >= pl)))
    497             break;
    498           guess -= 1;
    499           /* comparand += (v1 << BIGNUM_DIGIT_LENGTH) */
    500           ch += v1;
    501           /* if (comparand >= (BIGNUM_RADIX * BIGNUM_RADIX)) */
    502           if (ch >= BIGNUM_RADIX)
    503             break;
    504         }
    505       qj = (bignum_divide_subtract (v_start, v_end, guess, (--u_scan_start)));
    506       if (q != BIGNUM_OUT_OF_BAND)
    507         (*--q_scan) = qj;
    508     }
    509   return;
    510 #undef gl
    511 #undef uj
    512 #undef qj
    513 }
    514 
    515 static bignum_digit_type
    516 bignum_divide_subtract(bignum_digit_type * v_start,
    517                        bignum_digit_type * v_end,
    518                        bignum_digit_type guess,
    519                        bignum_digit_type * u_start)
    520 {
    521   bignum_digit_type * v_scan = v_start;
    522   bignum_digit_type * u_scan = u_start;
    523   bignum_digit_type carry = 0;
    524   if (guess == 0) return (0);
    525   {
    526     bignum_digit_type gl = (HD_LOW (guess));
    527     bignum_digit_type gh = (HD_HIGH (guess));
    528     bignum_digit_type v;
    529     bignum_digit_type pl;
    530     bignum_digit_type vl;
    531 #define vh v
    532 #define ph carry
    533 #define diff pl
    534     while (v_scan < v_end)
    535       {
    536         v = (*v_scan++);
    537         vl = (HD_LOW (v));
    538         vh = (HD_HIGH (v));
    539         pl = ((vl * gl) + (HD_LOW (carry)));
    540         ph = ((vl * gh) + (vh * gl) + (HD_HIGH (pl)) + (HD_HIGH (carry)));
    541         diff = ((*u_scan) - (HD_CONS ((HD_LOW (ph)), (HD_LOW (pl)))));
    542         if (diff < 0)
    543           {
    544             (*u_scan++) = (diff + BIGNUM_RADIX);
    545             carry = ((vh * gh) + (HD_HIGH (ph)) + 1);
    546           }
    547         else
    548           {
    549             (*u_scan++) = diff;
    550             carry = ((vh * gh) + (HD_HIGH (ph)));
    551           }
    552       }
    553     if (carry == 0)
    554       return (guess);
    555     diff = ((*u_scan) - carry);
    556     if (diff < 0)
    557       (*u_scan) = (diff + BIGNUM_RADIX);
    558     else
    559       {
    560         (*u_scan) = diff;
    561         return (guess);
    562       }
    563 #undef vh
    564 #undef ph
    565 #undef diff
    566   }
    567   /* Subtraction generated carry, implying guess is one too large.
    568      Add v back in to bring it back down. */
    569   v_scan = v_start;
    570   u_scan = u_start;
    571   carry = 0;
    572   while (v_scan < v_end)
    573     {
    574       bignum_digit_type sum = ((*v_scan++) + (*u_scan) + carry);
    575       if (sum < BIGNUM_RADIX)
    576         {
    577           (*u_scan++) = sum;
    578           carry = 0;
    579         }
    580       else
    581         {
    582           (*u_scan++) = (sum - BIGNUM_RADIX);
    583           carry = 1;
    584         }
    585     }
    586   if (carry == 1)
    587     {
    588       bignum_digit_type sum = ((*u_scan) + carry);
    589       (*u_scan) = ((sum < BIGNUM_RADIX) ? sum : (sum - BIGNUM_RADIX));
    590     }
    591   return (guess - 1);
    592 }
    593 
    594 static void
    595 bignum_divide_unsigned_medium_denominator(bignum_type numerator,
    596                                           bignum_digit_type denominator,
    597                                           bignum_type * quotient,
    598                                           bignum_type * remainder,
    599                                           int q_negative_p,
    600                                           int r_negative_p)
    601 {
    602   bignum_length_type length_n = (BIGNUM_LENGTH (numerator));
    603   bignum_length_type length_q;
    604   bignum_type q;
    605   int shift = 0;
    606   /* Because `bignum_digit_divide' requires a normalized denominator. */
    607   while (denominator < (BIGNUM_RADIX / 2))
    608     {
    609       denominator <<= 1;
    610       shift += 1;
    611     }
    612   if (shift == 0)
    613     {
    614       length_q = length_n;
    615       q = (bignum_allocate (length_q, q_negative_p));
    616       bignum_destructive_copy (numerator, q);
    617     }
    618   else
    619     {
    620       length_q = (length_n + 1);
    621       q = (bignum_allocate (length_q, q_negative_p));
    622       bignum_destructive_normalization (numerator, q, shift);
    623     }
    624   {
    625     bignum_digit_type r = 0;
    626     bignum_digit_type * start = (BIGNUM_START_PTR (q));
    627     bignum_digit_type * scan = (start + length_q);
    628     bignum_digit_type qj;
    629     if (quotient != ((bignum_type *) 0))
    630       {
    631         while (start < scan)
    632           {
    633             r = (bignum_digit_divide (r, (*--scan), denominator, (&qj)));
    634             (*scan) = qj;
    635           }
    636         (*quotient) = (bignum_trim (q));
    637       }
    638     else
    639       {
    640         while (start < scan)
    641           r = (bignum_digit_divide (r, (*--scan), denominator, (&qj)));
    642         BIGNUM_DEALLOCATE (q);
    643       }
    644     if (remainder != ((bignum_type *) 0))
    645       {
    646         if (shift != 0)
    647           r >>= shift;
    648         (*remainder) = (bignum_digit_to_bignum (r, r_negative_p));
    649       }
    650   }
    651   return;
    652 }
    653 
    654 static void
    655 bignum_destructive_normalization(bignum_type source, bignum_type target,
    656                                  int shift_left)
    657 {
    658   bignum_digit_type digit;
    659   bignum_digit_type * scan_source = (BIGNUM_START_PTR (source));
    660   bignum_digit_type carry = 0;
    661   bignum_digit_type * scan_target = (BIGNUM_START_PTR (target));
    662   bignum_digit_type * end_source = (scan_source + (BIGNUM_LENGTH (source)));
    663   bignum_digit_type * end_target = (scan_target + (BIGNUM_LENGTH (target)));
    664   int shift_right = (BIGNUM_DIGIT_LENGTH - shift_left);
    665   bignum_digit_type mask = ((1L << shift_right) - 1);
    666   while (scan_source < end_source)
    667     {
    668       digit = (*scan_source++);
    669       (*scan_target++) = (((digit & mask) << shift_left) | carry);
    670       carry = (digit >> shift_right);
    671     }
    672   if (scan_target < end_target)
    673     (*scan_target) = carry;
    674   else
    675     assert(carry == 0);
    676   return;
    677 }
    678 
    679 /* This will also trim the number if necessary */
    680 static bignum_type
    681 bignum_destructive_unnormalization(bignum_type bignum, int shift_right)
    682 {
    683   bignum_length_type length = BIGNUM_LENGTH(bignum);
    684   bignum_digit_type * start = (BIGNUM_START_PTR (bignum));
    685   bignum_digit_type * scan = (start + length);
    686   bignum_digit_type digit;
    687   bignum_digit_type carry = 0;
    688   int shift_left = (BIGNUM_DIGIT_LENGTH - shift_right);
    689   bignum_digit_type mask = ((1L << shift_right) - 1);
    690  
    691   while (!(*--scan)) {
    692     if (start == scan) { /* Don't bother. */
    693       BIGNUM_SET_HEADER (bignum, 0, 0);
    694       BIGNUM_REDUCE_LENGTH (bignum, bignum, 0);
    695       return bignum;
    696     }
    697     --length;
    698   }
    699 
    700   digit = (*scan);
    701   (*scan) = (digit >> shift_right);
    702   length -= (*scan == 0); /* Add 1 or 0 */
    703   carry = ((digit & mask) << shift_left);
    704  
    705   while (start < scan)
    706     {
    707       digit = (*--scan);
    708       (*scan) = ((digit >> shift_right) | carry);
    709       carry = ((digit & mask) << shift_left);
    710     }
    711   assert(carry == 0);
    712   assert(BIGNUM_LENGTH(bignum) != length);
    713   assert(length != 1 || BIGNUM_REF(bignum, 0) != 0);
    714   BIGNUM_SET_HEADER
    715     (bignum, length, (BIGNUM_NEGATIVE_P (bignum)));
    716   BIGNUM_REDUCE_LENGTH (bignum, bignum, length);
    717 
    718   return bignum;
    719 }
    720 
    721 /* This is a reduced version of the division algorithm, applied to the
    722    case of dividing two bignum digits by one bignum digit.  It is
    723    assumed that the numerator, denominator are normalized. */
    724 
    725 #define BDD_STEP(qn, j)                                                 \
    726 {                                                                       \
    727   uj = (u[j]);                                                          \
    728   if (uj != v1)                                                         \
    729     {                                                                   \
    730       uj_uj1 = (HD_CONS (uj, (u[j + 1])));                              \
    731       guess = (uj_uj1 / v1);                                            \
    732       comparand = (HD_CONS ((uj_uj1 % v1), (u[j + 2])));                \
    733     }                                                                   \
    734   else                                                                  \
    735     {                                                                   \
    736       guess = (BIGNUM_RADIX_ROOT - 1);                                  \
    737       comparand = (HD_CONS (((u[j + 1]) + v1), (u[j + 2])));            \
    738     }                                                                   \
    739   while ((guess * v2) > comparand)                                      \
    740     {                                                                   \
    741       guess -= 1;                                                       \
    742       comparand += (v1 << BIGNUM_HALF_DIGIT_LENGTH);                    \
    743       if (comparand >= BIGNUM_RADIX)                                    \
    744         break;                                                          \
    745     }                                                                   \
    746   qn = (bignum_digit_divide_subtract (v1, v2, guess, (&u[j])));         \
    747 }
    748 
    749 static bignum_digit_type
    750 bignum_digit_divide(bignum_digit_type uh, bignum_digit_type ul,
    751                     bignum_digit_type v,
    752                     bignum_digit_type * q) /* return value */
    753 {
    754   bignum_digit_type guess;
    755   bignum_digit_type comparand;
    756   bignum_digit_type v1;
    757   bignum_digit_type v2;
    758   bignum_digit_type uj;
    759   bignum_digit_type uj_uj1;
    760   bignum_digit_type q1;
    761   bignum_digit_type q2;
    762   bignum_digit_type u [4];
    763   if (uh == 0)
    764     {
    765       if (ul < v)
    766         {
    767           (*q) = 0;
    768           return (ul);
    769         }
    770       else if (ul == v)
    771         {
    772           (*q) = 1;
    773           return (0);
    774         }
    775     }
    776   (u[0]) = (HD_HIGH (uh));
    777   (u[1]) = (HD_LOW (uh));
    778   (u[2]) = (HD_HIGH (ul));
    779   (u[3]) = (HD_LOW (ul));
    780   v1 = (HD_HIGH (v));
    781   v2 = (HD_LOW (v));
    782   BDD_STEP (q1, 0);
    783   BDD_STEP (q2, 1);
    784   (*q) = (HD_CONS (q1, q2));
    785   return (HD_CONS ((u[2]), (u[3])));
    786 }
    787 
    788 #undef BDD_STEP
    789 
    790 #define BDDS_MULSUB(vn, un, carry_in)                                   \
    791 {                                                                       \
    792   product = ((vn * guess) + carry_in);                                  \
    793   diff = (un - (HD_LOW (product)));                                     \
    794   if (diff < 0)                                                         \
    795     {                                                                   \
    796       un = (diff + BIGNUM_RADIX_ROOT);                                  \
    797       carry = ((HD_HIGH (product)) + 1);                                \
    798     }                                                                   \
    799   else                                                                  \
    800     {                                                                   \
    801       un = diff;                                                        \
    802       carry = (HD_HIGH (product));                                      \
    803     }                                                                   \
    804 }
    805 
    806 #define BDDS_ADD(vn, un, carry_in)                                      \
    807 {                                                                       \
    808   sum = (vn + un + carry_in);                                           \
    809   if (sum < BIGNUM_RADIX_ROOT)                                          \
    810     {                                                                   \
    811       un = sum;                                                         \
    812       carry = 0;                                                        \
    813     }                                                                   \
    814   else                                                                  \
    815     {                                                                   \
    816       un = (sum - BIGNUM_RADIX_ROOT);                                   \
    817       carry = 1;                                                        \
    818     }                                                                   \
    819 }
    820 
    821 static bignum_digit_type
    822 bignum_digit_divide_subtract(bignum_digit_type v1, bignum_digit_type v2,
    823                              bignum_digit_type guess, bignum_digit_type * u)
    824 {
    825   {
    826     bignum_digit_type product;
    827     bignum_digit_type diff;
    828     bignum_digit_type carry;
    829     BDDS_MULSUB (v2, (u[2]), 0);
    830     BDDS_MULSUB (v1, (u[1]), carry);
    831     if (carry == 0)
    832       return (guess);
    833     diff = ((u[0]) - carry);
    834     if (diff < 0)
    835       (u[0]) = (diff + BIGNUM_RADIX);
    836     else
    837       {
    838         (u[0]) = diff;
    839         return (guess);
    840       }
    841   }
    842   {
    843     bignum_digit_type sum;
    844     bignum_digit_type carry;
    845     BDDS_ADD(v2, (u[2]), 0);
    846     BDDS_ADD(v1, (u[1]), carry);
    847     if (carry == 1)
    848       (u[0]) += 1;
    849   }
    850   return (guess - 1);
    851 }
    852 
    853 #undef BDDS_MULSUB
    854 #undef BDDS_ADD
    855 
    856 static void
    857 bignum_divide_unsigned_small_denominator(bignum_type numerator,
    858                                          bignum_digit_type denominator,
    859                                          bignum_type * quotient,
    860                                          bignum_type * remainder,
    861                                          int q_negative_p,  int r_negative_p)
    862 {
    863   bignum_type q = (bignum_new_sign (numerator, q_negative_p));
    864   bignum_digit_type r = (bignum_destructive_scale_down (q, denominator));
    865   (*quotient) = (bignum_trim (q));
    866   if (remainder != ((bignum_type *) 0))
    867     (*remainder) = (bignum_digit_to_bignum (r, r_negative_p));
    868   return;
    869 }
    870 
    871 /* Given (denominator > 1), it is fairly easy to show that
    872    (quotient_high < BIGNUM_RADIX_ROOT), after which it is easy to see
    873    that all digits are < BIGNUM_RADIX. */
    874 
    875 static bignum_digit_type
    876 bignum_destructive_scale_down(bignum_type bignum, bignum_digit_type denominator)
    877 {
    878   bignum_digit_type numerator;
    879   bignum_digit_type remainder = 0;
    880   bignum_digit_type two_digits;
    881 #define quotient_high remainder
    882   bignum_digit_type * start = (BIGNUM_START_PTR (bignum));
    883   bignum_digit_type * scan = (start + (BIGNUM_LENGTH (bignum)));
    884   assert((denominator > 1) && (denominator < BIGNUM_RADIX_ROOT));
    885   while (start < scan)
    886     {
    887       two_digits = (*--scan);
    888       numerator = (HD_CONS (remainder, (HD_HIGH (two_digits))));
    889       quotient_high = (numerator / denominator);
    890       numerator = (HD_CONS ((numerator % denominator), (HD_LOW (two_digits))));
    891       (*scan) = (HD_CONS (quotient_high, (numerator / denominator)));
    892       remainder = (numerator % denominator);
    893     }
    894   return (remainder);
    895 #undef quotient_high
    896 }
    897 
    898 static bignum_type
    899 bignum_remainder_unsigned_small_denominator(bignum_type n, bignum_digit_type d,
    900                                             int negative_p)
    901 {
    902   bignum_digit_type two_digits;
    903   bignum_digit_type * start = (BIGNUM_START_PTR (n));
    904   bignum_digit_type * scan = (start + (BIGNUM_LENGTH (n)));
    905   bignum_digit_type r = 0;
    906   assert((d > 1) && (d < BIGNUM_RADIX_ROOT));
    907   while (start < scan)
    908     {
    909       two_digits = (*--scan);
    910       r =
    911         ((HD_CONS (((HD_CONS (r, (HD_HIGH (two_digits)))) % d),
    912                    (HD_LOW (two_digits))))
    913          % d);
    914     }
    915   return (bignum_digit_to_bignum (r, negative_p));
    916 }
    917 
    918 static enum bignum_comparison
    919 bignum_compare_unsigned(bignum_type x, bignum_type y)
    920 {
    921   bignum_length_type x_length;
    922   bignum_length_type y_length;
    923   if (x == y) /* Objects are the same? */
    924     return (bignum_comparison_equal);
    925 
    926   x_length = (BIGNUM_LENGTH (x));
    927   y_length = (BIGNUM_LENGTH (y));
    928   if (x_length < y_length)
    929     return (bignum_comparison_less);
    930   if (x_length > y_length)
    931     return (bignum_comparison_greater);
    932   {
    933     bignum_digit_type * start_x = (BIGNUM_START_PTR (x));
    934     bignum_digit_type * scan_x = (start_x + x_length);
    935     bignum_digit_type * scan_y = ((BIGNUM_START_PTR (y)) + y_length);
    936     while (start_x < scan_x)
    937       {
    938         bignum_digit_type digit_x = (*--scan_x);
    939         bignum_digit_type digit_y = (*--scan_y);
    940         if (digit_x < digit_y)
    941           return (bignum_comparison_less);
    942         if (digit_x > digit_y)
    943           return (bignum_comparison_greater);
    944       }
    945   }
    946   return (bignum_comparison_equal);
    947 }
    948 
    949 
    950 /**
    951  * Below you will find the functions that have been refactored to
    952  * match the "core" style.
    953  *
    954  * Naming convention idea: Maybe name these fixnum ops differently,
    955  * _p_ for "promoting"?  OTOH, it may be safer and cleaner to rename
    956  * the old fixnum ops to have _fx_ to indicate they run in fixnum mode.
    957  */
     47static C_word init_tags(___scheme_value tagvec);
     48static C_word check_number(C_word x);
    95849static void bignum_negate_2(C_word c, C_word self, C_word new_big);
    95950static void allocate_bignum_2(C_word c, C_word self, C_word bigvec);
     
    99889static C_word bignum_normalize_shifted(C_word bignum, C_word shift_right);
    99990
     91static C_word
     92init_tags(___scheme_value tagvec)
     93{
     94  tags = CHICKEN_new_gc_root();
     95  CHICKEN_gc_root_set(tags, tagvec);
     96  return C_SCHEME_UNDEFINED;
     97}
     98
     99static C_word
     100check_number(C_word x)
     101{
     102  C_word tagvec;
     103
     104  if((x & C_FIXNUM_BIT) != 0) return C_fix(FIX);
     105  else if(C_immediatep(x)) return C_fix(NONE);
     106  else if(C_header_bits(x) == C_FLONUM_TYPE) return C_fix(FLO);
     107  else if(C_header_bits(x) == C_STRUCTURE_TYPE) {
     108    tagvec = CHICKEN_gc_root_ref(tags);
     109   
     110    if (C_block_item(x, 0) == C_block_item(tagvec, BIG_TAG))
     111      return C_fix(BIG);
     112    else if (C_block_item(x, 0) == C_block_item(tagvec, COMP_TAG))
     113      return C_fix(COMP);
     114    else if (C_block_item(x, 0) == C_block_item(tagvec, RAT_TAG))
     115      return C_fix(RAT);
     116    else
     117      return C_fix(NONE);
     118  } else
     119      return C_fix(NONE);
     120}
     121
    1000122/* Copy all the digits from source to target, obliterating what was
    1001123 * there.  If target is larger than source, the most significant
     
    1028150      /* TODO: function returning either a fixnum or a bignum from a C int */
    1029151      /* This should help with the C API/FFI too. */
    1030       C_kontinue(k, C_bignum2(&a, (z < 0), labs(z) & (C_uword)BIGNUM_DIGIT_MASK, 1));
     152      C_kontinue(k, C_bignum2(&a, (z < 0), labs(z) & (C_uword)C_BIGNUM_DIGIT_MASK, 1));
    1031153    } else {
    1032154      C_kontinue(k, C_fix(z));
     
    19041026  } else { /* bignum */
    19051027    C_word len_1 = C_bignum_size(x) - 1,
    1906            result = len_1 * BIGNUM_DIGIT_LENGTH,
     1028           result = len_1 * C_BIGNUM_DIGIT_LENGTH,
    19071029           *startx = C_bignum_digits(x),
    19081030           *last_digit = C_bignum_digits(x) + len_1,
     
    19721094    C_kontinue(k, C_fix(0));
    19731095  } else {
    1974     digit_offset = -uy / BIGNUM_DIGIT_LENGTH;
    1975     bit_offset =   -uy % BIGNUM_DIGIT_LENGTH;
     1096    digit_offset = -uy / C_BIGNUM_DIGIT_LENGTH;
     1097    bit_offset =   -uy % C_BIGNUM_DIGIT_LENGTH;
    19761098   
    19771099    k2 = C_closure(&a, 6, (C_word)bignum_actual_shift, k,
     
    22741396
    22751397    while (scan < end) {
    2276       digit = (~*scan & BIGNUM_DIGIT_MASK) + carry;
     1398      digit = (~*scan & C_BIGNUM_DIGIT_MASK) + carry;
    22771399
    22781400      if (C_fitsinbignumdigitp(digit)) {
     
    24431565         r = 0;
    24441566
    2445   assert((d > 1) && (d < BIGNUM_RADIX_ROOT));
     1567  assert((d > 1) && (C_fitsinbignumhalfdigitp(d)));
    24461568  while (start < scan) {
    24471569    two_digits = (*--scan);
     
    27641886
    27651887  assert(length_d > 1);
    2766   while (d1 < (BIGNUM_RADIX / 2)) {
     1888  while (d1 < ((C_word)1 << (C_BIGNUM_DIGIT_LENGTH-1))) {
    27671889    d1 <<= 1;
    27681890    shift++;
     
    29372059    while (v_scan < v_end) {
    29382060      sum = ((*v_scan++) + (*u_scan) + carry);
    2939       if (sum < BIGNUM_RADIX) {
     2061      if (C_fitsinbignumdigitp(sum)) {
    29402062        (*u_scan++) = sum;
    29412063        carry = 0;
  • release/4/numbers/trunk/numbers-c.h

    r31413 r31415  
    1414#define COMP_TAG      2
    1515
    16 enum bignum_comparison
    17 {
    18   bignum_comparison_equal = 0,
    19   bignum_comparison_less = -1,
    20   bignum_comparison_greater = 1
    21 };
    22 
    23 typedef void * bignum_type;
    24 typedef C_word bignum_digit_type;
    25 typedef C_word bignum_length_type;
    26 
    27 /* Internal bignum interface */
    28 static bignum_type bignum_allocate(bignum_length_type, int);
    29 static bignum_type shorten_bignum(bignum_type, bignum_length_type);
    30 static bignum_type bignum_trim(bignum_type);
    31 static void bignum_destructive_copy(bignum_type, bignum_type);
    32 static bignum_type bignum_new_sign(bignum_type, int);
    33 static void bignum_divide_unsigned_large_denominator(bignum_type, bignum_type,
    34                                                      bignum_type *,
    35                                                      bignum_type *, int, int);
    36 static void bignum_divide_unsigned_normalized(bignum_type, bignum_type,
    37                                               bignum_type);
    38 static bignum_digit_type bignum_divide_subtract(bignum_digit_type *,
    39                                                 bignum_digit_type *,
    40                                                 bignum_digit_type,
    41                                                 bignum_digit_type *);
    42 static void bignum_divide_unsigned_medium_denominator(bignum_type,
    43                                                       bignum_digit_type,
    44                                                       bignum_type *,
    45                                                       bignum_type *,
    46                                                       int, int);
    47 static void bignum_destructive_normalization(bignum_type, bignum_type, int);
    48 static bignum_type bignum_destructive_unnormalization(bignum_type, int);
    49 static bignum_digit_type bignum_digit_divide(bignum_digit_type,
    50                                              bignum_digit_type,
    51                                              bignum_digit_type,
    52                                              bignum_digit_type *);
    53 static bignum_digit_type bignum_digit_divide_subtract(bignum_digit_type,
    54                                                       bignum_digit_type,
    55                                                       bignum_digit_type,
    56                                                       bignum_digit_type *);
    57 static void bignum_divide_unsigned_small_denominator(bignum_type,
    58                                                      bignum_digit_type,
    59                                                      bignum_type *,
    60                                                      bignum_type *,
    61                                                      int, int);
    62 static bignum_digit_type bignum_destructive_scale_down(bignum_type,
    63                                                        bignum_digit_type);
    64 static bignum_type bignum_remainder_unsigned_small_denominator(bignum_type,
    65                                                                bignum_digit_type,
    66                                                                int);
    67 static enum bignum_comparison bignum_compare_unsigned(bignum_type, bignum_type);
    68 
    69 #define BIGNUM_OUT_OF_BAND NULL
    70 
    71 /* BIGNUM_TO_POINTER casts a bignum object to a digit array pointer. */
    72 #define BIGNUM_TO_POINTER(bignum) ((bignum_digit_type *) (bignum))
    73 
    74 /* BIGNUM_REDUCE_LENGTH allows the memory system to reclaim some
    75    space when a bignum's length is reduced from its original value. */
    76 #define BIGNUM_REDUCE_LENGTH(target, source, length)                    \
    77      target = shorten_bignum(source, length)
    78 
    79 #define BIGNUM_DEALLOCATE(b) (C_free((void *)b))
    80 
    81 /* CHAR_BIT is from <limits.h>, and it equals the number of bits in a char */
    82 #define BIGNUM_DIGIT_LENGTH (((sizeof (bignum_digit_type)) * CHAR_BIT) - 2)
    83 #define BIGNUM_HALF_DIGIT_LENGTH (BIGNUM_DIGIT_LENGTH / 2)
    84 /* Radix = highest bit of header word: 1 if number negative, 0 if positive */
    85 #define BIGNUM_RADIX (((C_uword) 1) << BIGNUM_DIGIT_LENGTH)
    86 #define BIGNUM_RADIX_ROOT (((C_uword) 1) << BIGNUM_HALF_DIGIT_LENGTH)
    87 #define BIGNUM_DIGIT_MASK        (BIGNUM_RADIX - 1)
    88 #define BIGNUM_HALF_DIGIT_MASK   (BIGNUM_RADIX_ROOT - 1)
    89 
    90 #define BIGNUM_START_PTR(bignum)                                        \
    91   ((BIGNUM_TO_POINTER (bignum)) + 1)
    92 
    93 #define BIGNUM_SET_HEADER(bignum, length, negative_p)                   \
    94   (* (BIGNUM_TO_POINTER (bignum))) =                                    \
    95     ((length) | ((negative_p) ? BIGNUM_RADIX : 0))
    96 
    97 #define BIGNUM_LENGTH(bignum)                                           \
    98   ((* (BIGNUM_TO_POINTER (bignum))) & ((bignum_length_type) BIGNUM_DIGIT_MASK))
    99 
    100 #define BIGNUM_NEGATIVE_P(bignum)                                       \
    101   (((* (BIGNUM_TO_POINTER (bignum))) & BIGNUM_RADIX) != 0)
    102 
    103 #define BIGNUM_REF(bignum, index)                                       \
    104   (* ((BIGNUM_START_PTR (bignum)) + (index)))
    105 
    106 
    107 /* These definitions are here to facilitate caching of the constants
    108    0, 1, and -1. */
    109 /*
    110  * We don't cache because it complicates the conversion to fixnum code
    111  * since it would need additional checks before freeing the bignum.
    112  * Most cases where BIGNUM_ONE/ZERO are returned are removed anyway.
    113  */
    114 #define BIGNUM_ZERO() (bignum_digit_to_bignum(0, 0))
    115 #define BIGNUM_ONE(neg_p) (bignum_digit_to_bignum(1, neg_p))
    116 
    117 #define HD_LOW(digit) ((digit) & BIGNUM_HALF_DIGIT_MASK)
    118 #define HD_HIGH(digit) ((digit) >> BIGNUM_HALF_DIGIT_LENGTH)
    119 #define HD_CONS(high, low) (((high) << BIGNUM_HALF_DIGIT_LENGTH) | (low))
    120 
    121 
    122 /**
    123  * Below is a duplication of the above, as port of a refactoring to
    124  * fit CHICKEN naming conventions and general C style.  This should
    125  * bring additional performance (eventually) and make it easier to
    126  * integrate into core, if that day will ever arrive...
    127  */
    12816#define C_SIZEOF_STRUCTURE(n)           ((n)+2) /* missing from chicken.h */
    12917#define C_SIZEOF_CLOSURE(n)             ((n)+1) /* missing from chicken.h */
     
    15644
    15745#define C_BIGNUM_BITS_TO_DIGITS(n) \
    158         (((n) + (BIGNUM_DIGIT_LENGTH - 1)) / BIGNUM_DIGIT_LENGTH)
     46        (((n) + (C_BIGNUM_DIGIT_LENGTH - 1)) / C_BIGNUM_DIGIT_LENGTH)
    15947
    16048#define C_BIGNUM_DIGIT_LO_HALF(d)       ((d) & C_BIGNUM_HALF_DIGIT_MASK)
  • release/4/numbers/trunk/numbers.scm

    r31413 r31415  
    162162;; This one should really be part of Chicken, hence the name
    163163(define (fxgcd x y) (##core#inline "C_u_i_2_fixnum_gcd" x y))
    164 (define biggcd (##core#primitive "big_gcd"))
    165164(define (fpgcd x y) (##core#inline_allocate ("C_a_u_i_2_flonum_gcd" 4) x y))
    166165
     
    12971296           [FIX (if (eq? y 0) x (fxgcd y (%remainder loc x y)))]
    12981297           [FLO (if (fp= y 0.0) x (fpgcd y (%remainder loc x y)))]
    1299            [BIG (biggcd x y)]
     1298           [BIG (%gcd-0 loc y (%big-remainder-big x y))]
    13001299           [else (bad-integer loc y)])]
    13011300    [else (bad-integer loc x)]) )
Note: See TracChangeset for help on using the changeset viewer.