Changeset 31347 in project


Ignore:
Timestamp:
09/09/14 13:24:24 (5 years ago)
Author:
sjamaan
Message:

numbers: Also convert inexact->exact for flonums to bignum conversion to core naming convention

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

Legend:

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

    r31346 r31347  
    14521452}
    14531453
    1454 static void
    1455 flo_to_int(C_word c, C_word self, C_word k, C_word x)
    1456 {
    1457   C_return_bignum(k, double_to_bignum(C_flonum_magnitude(x)));
    1458 }
    1459 
    1460 #define DTB_WRITE_DIGIT(factor)                                         \
    1461 {                                                                       \
    1462   significand *= (factor);                                              \
    1463   digit = ((bignum_digit_type) significand);                            \
    1464   (*--scan) = digit;                                                    \
    1465   significand -= ((double) digit);                                      \
    1466 }
    1467 
    1468 static bignum_type
    1469 double_to_bignum(double x)
    1470 {
    1471   int exponent;
    1472   double significand = (frexp (x, (&exponent)));
    1473   if (exponent <= 0) return (BIGNUM_ZERO ());
    1474   if (exponent == 1) return (BIGNUM_ONE (x < 0));
    1475   if (significand < 0) significand = (-significand);
    1476   {
    1477     bignum_length_type length = (BIGNUM_BITS_TO_DIGITS (exponent));
    1478     bignum_type result = (bignum_allocate (length, (x < 0)));
    1479     bignum_digit_type * start = (BIGNUM_START_PTR (result));
    1480     bignum_digit_type * scan = (start + length);
    1481     bignum_digit_type digit;
    1482     int odd_bits = (exponent % BIGNUM_DIGIT_LENGTH);
    1483     if (odd_bits > 0)
    1484       DTB_WRITE_DIGIT (1L << odd_bits);
    1485     while (start < scan)
    1486       {
    1487         if (significand == 0)
    1488           {
    1489             while (start < scan)
    1490               (*--scan) = 0;
    1491             break;
    1492           }
    1493         DTB_WRITE_DIGIT (BIGNUM_RADIX);
    1494       }
    1495     return (result);
    1496   }
    1497 }
    1498 
    1499 #undef DTB_WRITE_DIGIT
    1500 
    15011454static void
    15021455int_bitwise_int(C_word c, C_word self, C_word k, C_word op, C_word x, C_word y)
     
    19651918static void bignum_times_bignum_unsigned_2(C_word c, C_word self, C_word result);
    19661919static void digits_to_integer_2(C_word c, C_word self, C_word result);
     1920static void flo_to_int_2(C_word c, C_word self, C_word result);
    19671921
    19681922/* Eventually this will probably need to be integrated into C_2_plus. */
     
    25842538    nbits = (C_unfix(end) - C_unfix(start)) * ilen(C_unfix(radix));
    25852539    size = C_fix(C_BIGNUM_BITS_TO_DIGITS(nbits));
     2540    /* XXX: Why initialize? */
    25862541    C_allocate_bignum(3, (C_word)NULL, k2, size, negp, C_SCHEME_TRUE);
    25872542  }
     
    26532608
    26542609C_word
    2655 C_u_a_i_bignum_to_flonum(C_word **p, C_word n, C_word bignum)
     2610C_a_u_i_big_to_flo(C_word **p, C_word n, C_word bignum)
    26562611{
    26572612  double accumulator = 0;
     
    26642619  return C_flonum(p, (C_bignum_negativep(bignum) ? -accumulator : accumulator));
    26652620}
     2621
     2622void C_ccall
     2623C_u_flo_to_int(C_word c, C_word self, C_word k, C_word x)
     2624{
     2625  int exponent;
     2626  double significand = frexp(C_flonum_magnitude(x), &exponent);
     2627
     2628  if (exponent <= 0) {
     2629    C_kontinue(k, C_fix(0));
     2630  } else if (exponent == 1) { /* TODO: check significand * 2^exp fits fixnum? */
     2631    C_kontinue(k, significand < 0.0 ? C_fix(-1) : C_fix(1));
     2632  } else {
     2633    C_word kab[C_SIZEOF_CLOSURE(4) + C_SIZEOF_FLONUM], *ka = kab, k2, size,
     2634           negp = C_mk_bool(C_flonum_magnitude(x) < 0.0),
     2635           sign = C_flonum(&ka, fabs(significand));
     2636
     2637    k2 = C_closure(&ka, 4, (C_word)flo_to_int_2, k, C_fix(exponent), sign);
     2638
     2639    size = C_fix(C_BIGNUM_BITS_TO_DIGITS(exponent));
     2640    C_allocate_bignum(3, (C_word)NULL, k2, size, negp, C_SCHEME_FALSE);
     2641  }
     2642}
     2643
     2644#define DTB_WRITE_DIGIT(factor)                                         \
     2645{                                                                       \
     2646  significand *= (factor);                                              \
     2647  digit = ((C_word)significand);                                        \
     2648  (*--scan) = digit;                                                    \
     2649  significand -= ((double)digit);                                       \
     2650}
     2651
     2652static void
     2653flo_to_int_2(C_word c, C_word self, C_word result)
     2654{
     2655  C_word digit, k = C_block_item(self, 1),
     2656         exponent = C_unfix(C_block_item(self, 2)),
     2657         *start = C_bignum_digits(result),
     2658         *scan = start + C_bignum_size(result);
     2659  double significand = C_flonum_magnitude(C_block_item(self, 3));
     2660  int odd_bits = exponent % C_BIGNUM_DIGIT_LENGTH;
     2661
     2662  if (odd_bits > 0)
     2663    DTB_WRITE_DIGIT (1L << odd_bits);
     2664
     2665  while (start < scan && significand > 0)
     2666    DTB_WRITE_DIGIT(BIGNUM_RADIX);
     2667
     2668  /* Finish up by clearing any remaining, higher, digits */
     2669  while (start < scan)
     2670    (*--scan) = 0;
     2671
     2672  C_bignum_destructive_trim(result);
     2673  C_kontinue(k, C_bignum_normalize(result));
     2674}
     2675#undef DTB_WRITE_DIGIT
  • release/4/numbers/trunk/numbers-c.h

    r31346 r31347  
    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))
    208207/* The bytes->words conversion should be killed, but that can only be
    209208 * done when the representation is made part of core (otherwise the GC
     
    237236
    238237void 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);
     238C_word C_a_u_i_big_to_flo(C_word **p, C_word n, C_word bignum);
     239void C_ccall C_u_flo_to_int(C_word c, C_word self, C_word k, C_word x);
    239240
    240241C_inline C_word C_bignum1(C_word **ptr, int negp, C_uword d1)
  • release/4/numbers/trunk/numbers.scm

    r31346 r31347  
    135135(define-inline (%make-rat r i) (##sys#make-structure 'ratnum r i))
    136136
    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))
     137(define-inline (%fix->flo n) (##core#inline_allocate ("C_a_i_fix_to_flo" 4) n))
     138(define-inline (%big->flo n) (##core#inline_allocate ("C_a_u_i_big_to_flo" 4) n))
    139139
    140140(define %fix+fix (##core#primitive "C_u_2_fixnum_plus"))
     
    185185(define %quotient-0 (##core#primitive "C_quotient"))
    186186
    187 (define %flo->integer (##core#primitive "flo_to_int"))
     187(define %flo->integer (##core#primitive "C_u_flo_to_int"))
    188188
    189189(define %int-bitwise-int (##core#primitive "int_bitwise_int"))
Note: See TracChangeset for help on using the changeset viewer.