Changeset 31311 in project


Ignore:
Timestamp:
08/30/14 17:20:13 (5 years ago)
Author:
sjamaan
Message:

numbers: Convert digits_to_big to core naming convention, and kill old bignum_desctructive_scale_up. Add a benchmark for reading bignums as string.

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

Legend:

Unmodified
Added
Removed
  • release/4/numbers/trunk/benchmarks/read-write.scm

    r24767 r31311  
    1010;; Gauche
    1111;; (use srfi-27)
    12      
     12;;
    1313;; (define most-positive-fixnum (greatest-fixnum))
    1414;; (define random random-integer)
     
    3636(time (t (+ most-positive-fixnum (random most-positive-fixnum))))
    3737
     38(display "Reading a large bignum:\n")
     39
     40(time (let lp ((s (make-string 100000 #\9))
     41               (i 0))
     42        (string->number s)
     43        (when (< i 100)
     44          (lp s (+ i 1)))))
     45
    3846(display "Testing fixnum ratnums:\n")
    3947
  • release/4/numbers/trunk/numbers-c.c

    r31309 r31311  
    818818}
    819819
    820 
    821 static void
    822 bignum_destructive_scale_up(bignum_type bignum, bignum_digit_type factor)
    823 {
    824   bignum_digit_type carry = 0;
    825   bignum_digit_type * scan = (BIGNUM_START_PTR (bignum));
    826   bignum_digit_type two_digits;
    827   bignum_digit_type product_low;
    828 #define product_high carry
    829   bignum_digit_type * end = (scan + (BIGNUM_LENGTH (bignum)));
    830   assert((factor > 1) && (factor < BIGNUM_RADIX_ROOT));
    831   while (scan < end)
    832     {
    833       two_digits = (*scan);
    834       product_low = ((factor * (HD_LOW (two_digits))) + (HD_LOW (carry)));
    835       product_high =
    836         ((factor * (HD_HIGH (two_digits))) +
    837          (HD_HIGH (product_low)) +
    838          (HD_HIGH (carry)));
    839       (*scan++) = (HD_CONS ((HD_LOW (product_high)), (HD_LOW (product_low))));
    840       carry = (HD_HIGH (product_high));
    841     }
    842   /* A carry here would be an overflow, i.e. it would not fit.
    843      Hopefully the callers allocate enough space that this will
    844      never happen.
    845    */
    846   assert(carry == 0);
    847   return;
    848 #undef product_high
    849 }
    850 
    851 static void
    852 bignum_destructive_add(bignum_type bignum, bignum_digit_type n)
    853 {
    854   bignum_digit_type * scan = (BIGNUM_START_PTR (bignum));
    855   bignum_digit_type digit;
    856   digit = ((*scan) + n);
    857   if (digit < BIGNUM_RADIX)
    858     {
    859       (*scan) = digit;
    860       return;
    861     }
    862   (*scan++) = (digit - BIGNUM_RADIX);
    863   while (1)
    864     {
    865       digit = ((*scan) + 1);
    866       if (digit < BIGNUM_RADIX)
    867         {
    868           (*scan) = digit;
    869           return;
    870         }
    871       (*scan++) = (digit - BIGNUM_RADIX);
    872     }
    873 }
    874820
    875821/* Division */
     
    17091655
    17101656/*
    1711  * From Hacker's Delight by Frank Warren
     1657 * From Hacker's Delight by Henry S. Warren
    17121658 * based on a modified nlz() from section 5-3 (fig. 5-7)
    17131659 */
     
    20952041}
    20962042
    2097 static void
    2098 digits_to_big(C_word c, C_word self, C_word k, C_word n,
    2099               C_word start, C_word end, C_word radix, C_word negp)
    2100 {
    2101   char *str;
    2102   size_t n_digits;
    2103   int negative_p = (negp != C_SCHEME_FALSE);
    2104   int digit;
    2105   int hash = 0;
    2106 
    2107   str = C_c_string(n) + C_unfix(start);
    2108   n_digits = C_unfix(end)-C_unfix(start);
    2109   radix = C_unfix(radix);
    2110   hash = /* abs(radix / 2) */ 0;
    2111  
    2112 #define DIGIT_TO_INT(x)         \
    2113   (((x) == '#') ? hash :        \
    2114    (((x) >= (int)'a') ?((x) - (int)'a' + 10) : ((x) - (int)'0')))
    2115 
    2116   assert((radix > 1) && (radix < BIGNUM_RADIX_ROOT));
    2117   if (n_digits == 0)
    2118     C_kontinue(k, C_SCHEME_FALSE);
    2119   if (n_digits == 1)
    2120     {
    2121       digit = DIGIT_TO_INT(C_tolower((int)*str));
    2122       if (digit >= radix || digit < 0)
    2123         C_kontinue(k, C_SCHEME_FALSE);
    2124       else
    2125         C_return_bignum(k, bignum_digit_to_bignum(digit, negative_p));
    2126     }
    2127   {
    2128     bignum_length_type length;
    2129     {
    2130       unsigned int radix_copy = radix;
    2131       unsigned int log_radix = 0;
    2132       while (radix_copy > 0)
    2133         {
    2134           radix_copy >>= 1;
    2135           log_radix += 1;
    2136         }
    2137       /* This length will be at least as large as needed. */
    2138       length = (BIGNUM_BITS_TO_DIGITS (n_digits * log_radix));
    2139     }
    2140     {
    2141       bignum_type result = (bignum_allocate_zeroed (length, negative_p));
    2142       while ((n_digits--) > 0)
    2143         {
    2144           digit = DIGIT_TO_INT(C_tolower((int)*str));
    2145           str++;
    2146           if (digit >= radix || digit < 0) {
    2147             BIGNUM_DEALLOCATE(result);
    2148             C_kontinue(k, C_SCHEME_FALSE);
    2149           }
    2150        
    2151           bignum_destructive_scale_up (result, ((bignum_digit_type) radix));
    2152           bignum_destructive_add (result, digit);
    2153         }
    2154       C_return_bignum (k, bignum_trim (result));
    2155     }
    2156   }
    2157 }
    2158 
    21592043/**
    21602044 * Below you will find the functions that have been refactored to
     
    21722056static void bignum_times_bignum_unsigned(C_word k, C_word x, C_word y, C_word negp);
    21732057static void bignum_times_bignum_unsigned_2(C_word c, C_word self, C_word result);
     2058static void digits_to_integer_2(C_word c, C_word self, C_word result);
    21742059
    21752060/* Eventually this will probably need to be integrated into C_2_plus. */
     
    23292214
    23302215static void
    2331 bignum_digits_destructive_scale_up(C_word big, C_word fix_factor)
     2216bignum_digits_destructive_scale_up(C_word big, C_word factor)
    23322217{
    23332218  C_word digit, product_hi, product_lo, carry = 0;
    23342219  C_word *scan = C_bignum_digits(big);
    23352220  C_word *last_digit = scan + C_bignum_size(big);
    2336   C_word factor = C_unfix(fix_factor);
    23372221
    23382222  while (scan < last_digit) {
     
    23492233
    23502234static void
     2235bignum_digits_destructive_add(C_word big, C_word value)
     2236{
     2237  C_word *scan = C_bignum_digits(big);
     2238  C_word digit = (*scan) + value;
     2239
     2240  while(!C_fitsinbignumdigitp(digit)) {
     2241    (*scan++) = digit & C_BIGNUM_DIGIT_MASK;
     2242    digit = ((*scan) + 1);
     2243  }
     2244  (*scan) = digit;
     2245}
     2246
     2247static void
    23512248bignum_times_halfdigit_fixnum(C_word k, C_word bigx, C_word fixy, C_word negp)
    23522249{
     
    23782275
    23792276  /* Scale up, and sanitise the result. TODO: make normalization one op? */
    2380   bignum_digits_destructive_scale_up(new_big, fixy);
     2277  bignum_digits_destructive_scale_up(new_big, C_unfix(fixy));
    23812278  C_bignum_destructive_trim(new_big);
    23822279  C_kontinue(k, C_bignum_normalize(new_big));
     
    25262423  C_kontinue(k, C_bignum_normalize(result));
    25272424}
     2425
     2426/* Hashes are mapped to 0 */
     2427#define HEXDIGIT_CHAR_TO_INT(x)                                         \
     2428  (((x) == '#') ? 0 :                                                   \
     2429   (((x) >= (int)'a') ? ((x) - (int)'a' + 10) : ((x) - (int)'0')))
     2430
     2431void C_ccall
     2432C_digits_to_integer(C_word c, C_word self, C_word k, C_word str,
     2433                    C_word start, C_word end, C_word radix, C_word negp)
     2434{
     2435  char *buf;
     2436  C_word n_digits;
     2437  C_word digit;
     2438  C_word kab[C_SIZEOF_CLOSURE(6)], *ka = kab, k2, size;
     2439  size_t nbits;
     2440
     2441  buf = C_c_string(str) + C_unfix(start);
     2442  n_digits = C_unfix(end)-C_unfix(start);
     2443
     2444  /* TODO: Make a loop that processes as much as possible to fill a
     2445   * fixnum, or at least a halfdigit!
     2446   */
     2447  assert((C_unfix(radix) > 1) && C_fitsinbignumhalfdigitp(C_unfix(radix)));
     2448  if (n_digits == 0) {
     2449    C_kontinue(k, C_SCHEME_FALSE);
     2450  } else if (n_digits == 1) {
     2451    digit = HEXDIGIT_CHAR_TO_INT(C_tolower((int)*buf));
     2452    if (digit >= C_unfix(radix) || digit < 0)
     2453      C_kontinue(k, C_SCHEME_FALSE);
     2454    else
     2455      C_kontinue(k, C_truep(negp) ? C_fix(-digit) : C_fix(digit));
     2456  }
     2457
     2458  k2 = C_closure(&ka, 6, (C_word)digits_to_integer_2, k, str, start, end, radix);
     2459
     2460  nbits = n_digits * ilen(C_unfix(radix));
     2461  size = C_fix(C_BIGNUM_BITS_TO_DIGITS(nbits));
     2462  C_allocate_bignum(3, (C_word)NULL, k2, size, negp, C_SCHEME_TRUE);
     2463}
     2464
     2465static void
     2466digits_to_integer_2(C_word c, C_word self, C_word result)
     2467{
     2468  C_word k = C_block_item(self, 1),
     2469         str = C_block_item(self, 2),
     2470         start = C_unfix(C_block_item(self, 3)),
     2471         end = C_unfix(C_block_item(self, 4)),
     2472         radix = C_unfix(C_block_item(self, 5)),
     2473         digit;
     2474
     2475  char *str_scan = C_c_string(str) + start;
     2476  char *str_end = C_c_string(str) + end;
     2477
     2478  while (str_scan < str_end) {
     2479    digit = HEXDIGIT_CHAR_TO_INT(C_tolower((int)*str_scan));
     2480    str_scan++; /* Can't do it inline: See HEXDIGIT_CHAR_TO_INT's expansion */
     2481
     2482    if (digit >= radix || digit < 0) {
     2483      C_kontinue(k, C_SCHEME_FALSE);
     2484    } else {
     2485      bignum_digits_destructive_scale_up(result, radix);
     2486      bignum_digits_destructive_add(result, digit);
     2487    }
     2488  }
     2489  C_bignum_destructive_trim(result);
     2490  C_kontinue(k, C_bignum_normalize(result));
     2491}
     2492#undef HEXDIGIT_CHAR_TO_INT
  • release/4/numbers/trunk/numbers-c.h

    r31309 r31311  
    176176
    177177#ifdef C_SIXTY_FOUR
     178# define C_BIGNUM_DIGIT_LENGTH     62
    178179# define C_BIGNUM_HEADER_SIGN_BIT  0x4000000000000000L
    179180# define C_BIGNUM_HEADER_SIZE_MASK 0x3fffffffffffffffL
     
    182183# define C_BIGNUM_HALF_DIGIT_SHIFT 31
    183184#else
     185# define C_BIGNUM_DIGIT_LENGTH     30
    184186# define C_BIGNUM_HEADER_SIGN_BIT  0x40000000
    185187# define C_BIGNUM_HEADER_SIZE_MASK 0x3fffffff
     
    188190# define C_BIGNUM_HALF_DIGIT_SHIFT 15
    189191#endif
     192
     193#define C_BIGNUM_BITS_TO_DIGITS(n) \
     194        (((n) + (BIGNUM_DIGIT_LENGTH - 1)) / BIGNUM_DIGIT_LENGTH)
    190195
    191196#define C_BIGNUM_DIGIT_LO_HALF(d)       ((d) & C_BIGNUM_HALF_DIGIT_MASK)
     
    210215void C_ccall C_allocate_bignum(C_word c, C_word self, C_word k, C_word size, C_word negp, C_word initp);
    211216void C_ccall C_bignum_destructive_trim(C_word big);
     217C_word C_ccall C_bignum_normalize(C_word big);
    212218
    213219void C_ccall C_fixnum_gcd(C_word c, C_word self, C_word k, C_word x, C_word y);
     
    215221void C_ccall C_u_bignum_negate(C_word c, C_word self, C_word k, C_word x);
    216222void C_ccall C_u_2_fixnum_plus(C_word c, C_word self, C_word k, C_word x, C_word y);
    217 C_word C_ccall C_bignum_normalize(C_word big);
    218223void C_ccall C_u_2_fixnum_times(C_word c, C_word self, C_word k, C_word x, C_word y);
    219224void C_ccall C_u_fixnum_times_bignum(C_word c, C_word self, C_word k, C_word x, C_word y);
     225
     226void 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);
    220227
    221228C_inline C_word C_bignum1(C_word **ptr, int negp, C_uword d1)
  • release/4/numbers/trunk/numbers.scm

    r31309 r31311  
    195195
    196196(define %big->string (##core#primitive "big_to_string"))
    197 (define %digits->number (##core#primitive "digits_to_big"))
     197(define %digits->integer (##core#primitive "C_digits_to_integer"))
    198198
    199199(define-inline (%subchar s i) (##core#inline "C_subchar" s i))
     
    18201820                   (end (or hashes digits)))
    18211821              (and-let* ((end)
    1822                          (num (%digits->number str start (car end) radix neg?)))
     1822                         (num (%digits->integer str start (car end) radix neg?)))
    18231823                (when hashes            ; Eeewww. Feeling dirty yet?
    18241824                  (set! seen-hashes? #t)
     
    18331833                              (end (scan-digits start)))
    18341834                     (go-inexact!)
    1835                      (cons (%digits->number
     1835                     (cons (%digits->integer
    18361836                            str start (car end) radix (eq? sign 'neg))
    18371837                           (cdr end)))))))
Note: See TracChangeset for help on using the changeset viewer.