Changeset 31346 in project


Ignore:
Timestamp:
09/09/14 12:19:12 (7 years ago)
Author:
sjamaan
Message:

numbers: Convert bignum<->flonum conversion and bignum comparison to core naming conventions

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

Legend:

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

    r31320 r31346  
    4444#include "numbers-c.h"
    4545
    46 #define fix_to_flo(p, n, f)       C_flonum(p, C_unfix(f))
    4746#define big_of(v)                 ((bignum_type)C_data_pointer(C_block_item(v, 1)))
    4847
     
    5453  return C_SCHEME_UNDEFINED;
    5554}
    56 
    57 /*
    58  * This is an odd one out. It doesn't accept a continuation.
    59  * I've put in the (more or less) verbatim code for s48_bignum_to_double.
    60  */
    61 static C_word
    62 big_to_flo(C_word **p, C_word n, C_word value)
    63 {
    64   bignum_type bignum = big_of(value);
    65   double accumulator = 0;
    66   bignum_digit_type * start = (BIGNUM_START_PTR (bignum));
    67   bignum_digit_type * scan = (start + (BIGNUM_LENGTH (bignum)));
    68   while (start < scan)
    69     accumulator = ((accumulator * BIGNUM_RADIX) + (*--scan));
    70   return C_flonum(p, (BIGNUM_NEGATIVE_P(bignum) ? -accumulator : accumulator));
    71 }
    72 
    7355
    7456static C_word
     
    12881270}
    12891271
    1290 static C_word
    1291 big_comp_big(C_word x, C_word y)
    1292 {
    1293   bignum_type bigx = big_of(x), bigy = big_of(y);
    1294   return C_fix((BIGNUM_NEGATIVE_P (bigx))
    1295                ? ((BIGNUM_NEGATIVE_P (bigy))
    1296                   ? (bignum_compare_unsigned (bigy, bigx))
    1297                   : (bignum_comparison_less))
    1298                : ((BIGNUM_NEGATIVE_P (bigy))
    1299                   ? (bignum_comparison_greater)
    1300                   : (bignum_compare_unsigned (bigx, bigy))));
    1301 }
    1302 
    13031272static enum bignum_comparison
    13041273bignum_compare_unsigned(bignum_type x, bignum_type y)
     
    19871956static void bignum_plus_unsigned(C_word k, C_word x, C_word y, C_word negp);
    19881957static void bignum_plus_unsigned_2(C_word c, C_word self, C_word result);
     1958static int bignum_cmp_unsigned(C_word x, C_word y);
    19891959static void bignum_minus_unsigned(C_word k, C_word x, C_word y);
    19901960static void bignum_minus_unsigned_2(C_word c, C_word self, C_word result);
     
    21532123}
    21542124
     2125static int
     2126bignum_cmp_unsigned(C_word x, C_word y)
     2127{
     2128  C_word xlen = C_bignum_size(x), ylen = C_bignum_size(y);
     2129
     2130  if (xlen < ylen) {
     2131    return -1;
     2132  } else if (xlen > ylen) {
     2133    return 1;
     2134  } else if (x == y) {
     2135    return 0;
     2136  } else {
     2137    C_word *startx = C_bignum_digits(x);
     2138    C_word *scanx = startx + xlen;
     2139    C_word *scany = C_bignum_digits(y) + ylen;
     2140
     2141    while (startx < scanx) {
     2142      C_word xdigit = (*--scanx);
     2143      C_word ydigit = (*--scany);
     2144      if (xdigit < ydigit)
     2145        return -1;
     2146      if (xdigit > ydigit)
     2147        return 1;
     2148    }
     2149    return 0;
     2150  }
     2151}
     2152
    21552153static void
    21562154bignum_minus_unsigned(C_word k, C_word x, C_word y)
     
    21582156  C_word kab[C_SIZEOF_CLOSURE(4)], *ka = kab, k2, size, negp;
    21592157
    2160   /* XXX TODO */
    2161   switch (bignum_compare_unsigned(big_of(x), big_of(y))) {
    2162   case bignum_comparison_equal:
     2158  switch (bignum_cmp_unsigned(x, y)) {
     2159  case 0:             /* x = y, return 0 */
    21632160    C_kontinue(k, C_fix(0));
    2164   case bignum_comparison_less:
    2165     {
    2166       C_word z = x;
    2167       x = y;
    2168       y = z;
    2169     }
    2170     negp = C_SCHEME_TRUE;
     2161  case -1:            /* abs(x) < abs(y), return -(abs(y) - abs(x)) */
     2162    k2 = C_closure(&ka, 4, (C_word)bignum_minus_unsigned_2, k, y, x);
     2163   
     2164    size = C_fix(C_bignum_size(y)); /* Maximum size of result is length of y. */
     2165    C_allocate_bignum(3, (C_word)NULL, k2, size, C_SCHEME_TRUE, C_SCHEME_FALSE);
     2166  case 1:             /* abs(x) > abs(y), return abs(x) - abs(y) */
     2167    k2 = C_closure(&ka, 4, (C_word)bignum_minus_unsigned_2, k, x, y);
     2168   
     2169    size = C_fix(C_bignum_size(x)); /* Maximum size of result is length of x. */
     2170    C_allocate_bignum(3, (C_word)NULL, k2, size, C_SCHEME_FALSE, C_SCHEME_FALSE);
    21712171    break;
    2172   case bignum_comparison_greater:
    2173     negp = C_SCHEME_FALSE;
    2174     break;
    2175   }
    2176 
    2177   k2 = C_closure(&ka, 4, (C_word)bignum_minus_unsigned_2, k, x, y);
    2178  
    2179   size = C_fix(C_bignum_size(x)); /* Maximum size of result is length of x. */
    2180   C_allocate_bignum(3, (C_word)NULL, k2, size, negp, C_SCHEME_FALSE);
     2172  }
    21812173}
    21822174
     
    22912283           C_header_size(C_internal_bignum(old_big))-C_wordstobytes(1));
    22922284  C_kontinue(k, C_bignum_normalize(new_big));
     2285}
     2286
     2287C_word
     2288C_u_i_bignum_cmp(C_word x, C_word y)
     2289{
     2290  if (C_bignum_negativep(x)) {
     2291    if (C_bignum_negativep(y)) { /* Largest negative number is smallest */
     2292      return C_fix(bignum_cmp_unsigned(y, x));
     2293    } else {
     2294      return C_fix(-1);
     2295    }
     2296  } else {
     2297    if (C_bignum_negativep(y)) {
     2298      return C_fix(1);
     2299    } else {
     2300      return C_fix(bignum_cmp_unsigned(x, y));
     2301    }
     2302  }
    22932303}
    22942304
     
    26412651  C_kontinue(k, C_bignum_normalize(result));
    26422652}
     2653
     2654C_word
     2655C_u_a_i_bignum_to_flonum(C_word **p, C_word n, C_word bignum)
     2656{
     2657  double accumulator = 0;
     2658  C_word *start = C_bignum_digits(bignum);
     2659  C_word *scan = start + C_bignum_size(bignum);
     2660  while (start < scan) {
     2661    accumulator *= (C_word)1 << C_BIGNUM_DIGIT_LENGTH;
     2662    accumulator += (*--scan);
     2663  }
     2664  return C_flonum(p, (C_bignum_negativep(bignum) ? -accumulator : accumulator));
     2665}
  • release/4/numbers/trunk/numbers-c.h

    r31320 r31346  
    205205#define C_u_i_bignum_negativep(b)       C_mk_bool(C_bignum_negativep(b))
    206206#define C_u_i_bignum_oddp(b)            C_mk_bool(C_bignum_digits(b)[0] & 1)
     207#define C_a_u_i_fixnum_to_flonum(p, n, f) C_flonum(p, C_unfix(f))
    207208/* The bytes->words conversion should be killed, but that can only be
    208209 * done when the representation is made part of core (otherwise the GC
     
    233234void C_ccall C_u_bignum_minus_fixnum(C_word c, C_word self, C_word k, C_word x, C_word y);
    234235void C_ccall C_u_2_bignum_minus(C_word c, C_word self, C_word k, C_word x, C_word y);
     236C_word C_u_i_bignum_cmp(C_word x, C_word y);
    235237
    236238void C_ccall C_digits_to_integer(C_word c, C_word self, C_word k, C_word n, C_word start, C_word end, C_word radix, C_word negp);
  • release/4/numbers/trunk/numbers.scm

    r31320 r31346  
    135135(define-inline (%make-rat r i) (##sys#make-structure 'ratnum r i))
    136136
    137 (define-inline (%fix->flo n) (##core#inline_allocate ("fix_to_flo" 4) n))
    138 (define-inline (%big->flo n) (##core#inline_allocate ("big_to_flo" 4) n))
     137(define-inline (%fix->flo n) (##core#inline_allocate ("C_a_u_i_fixnum_to_flonum" 4) n))
     138(define-inline (%big->flo n) (##core#inline_allocate ("C_u_a_i_bignum_to_flonum" 4) n))
    139139
    140140(define %fix+fix (##core#primitive "C_u_2_fixnum_plus"))
     
    169169(define (fpgcd x y) (##core#inline_allocate ("C_a_i_flonum_gcd" 4) x y))
    170170
    171 (define-inline (%big-comp-big x y) (##core#inline "big_comp_big" x y))
     171(define-inline (%big-cmp x y) (##core#inline "C_u_i_bignum_cmp" x y))
    172172
    173173(define %big-abs (##core#primitive "big_abs"))
     
    564564       [FIX #f]  ;; Needs bignum representation?  Can't be equal to a fixnum!
    565565       [FLO (and (%flo-integer? y) (= x (%flo->integer y)))]
    566        [BIG (fx= (%big-comp-big x y) 0)]
     566       [BIG (fx= (%big-cmp x y) 0)]
    567567       [RAT #f] ;; Rats are never x/1, because those are normalised to just x
    568568       [COMP #f] ;; Comps are only ever equal to other comps
     
    605605           (FLO  (fp= a b))
    606606           (FIX  (fx= a b))
    607            (BIG  (fx= (%big-comp-big a b) 0))
     607           (BIG  (fx= (%big-cmp a b) 0))
    608608           ;; TODO: Use integer= here, when we write it
    609609           (RAT  (and (%= (rat-numerator a) (rat-numerator b))
     
    669669                (and (not (fp= y +inf.0)) (fp= y y)
    670670                     (%> x (%flo->rat loc y) loc)))) ; Compare as ratnums
    671        (BIG (fx> (%big-comp-big x y) 0))
     671       (BIG (fx> (%big-cmp x y) 0))
    672672       ;; a/b > c/d  when  a*d > b*c  [with b = 1]
    673673       (RAT (%> (%* x (rat-denominator y))
     
    746746                (and (not (fp= y -inf.0)) (fp= y y)
    747747                     (%< x (%flo->rat loc y) loc)))) ; Compare as ratnums
    748        (BIG (fx< (%big-comp-big x y) 0))
     748       (BIG (fx< (%big-cmp x y) 0))
    749749       ;; a/b < c/d  when  a*d < b*c  [with b = 1]
    750750       (RAT (%< (%* x (rat-denominator y))
Note: See TracChangeset for help on using the changeset viewer.