1 2#ifdef MZ_PRECISE_GC 3START_XFORM_SKIP; 4#endif 5 6#ifndef FP_ZEROx 7# define FP_ZEROx 0.0 8# define FP_ONEx 1.0 9# define FP_TWOx 2.0 10# define FP_POWx pow 11# define FP_MZ_IS_POS_INFINITY(x) MZ_IS_POS_INFINITY(x) 12# define FP_scheme_floating_point_nzero scheme_floating_point_nzero 13#endif 14 15/* Optimization sometimes causes a problem? 16 See note in "ratfloat.inc". */ 17int IS_FLOAT_INF(FP_TYPE d) 18{ 19 return FP_MZ_IS_POS_INFINITY(d); 20} 21 22/* Must not trigger GC! (Required by xform in number.c) */ 23FP_TYPE SCHEME_BIGNUM_TO_FLOAT_INFO(const Scheme_Object *n, intptr_t skip, intptr_t *_skipped) 24{ 25 intptr_t nl, skipped; 26 bigdig *na; 27 FP_TYPE d; 28 29 nl = SCHEME_BIGLEN(n); 30 na = SCHEME_BIGDIG(n); 31 32 skipped = nl; 33 34 if (skip >= nl) { 35 if (SCHEME_BIGPOS(n)) 36 return FP_ZEROx; 37 else 38 return FP_scheme_floating_point_nzero; 39 } else 40 nl -= skip; 41 42 if (!nl) 43 d = FP_ZEROx; 44 else if (nl == 1) { 45 d = FP_TYPE_FROM_UINTPTR(*na); 46 skipped = 0; 47 } else { 48 /* We'll get all the bits that matter in the first word or two, 49 and we won't lose precision as long as we shift so that the 50 highest bit in a word is non-zero */ 51 bigdig b = na[nl-1]; 52 int delta; 53 54 delta = mz_clz(b); 55 if (delta) { 56 /* zero bits in the highest word => pull in bits from the 57 second-highest word */ 58 b = (b << delta) + (na[nl-2] >> (WORD_SIZE - delta)); 59 } 60 if (sizeof(FP_TYPE) <= sizeof(bigdig)) { 61 /* one bigdig is enough, and the last bit is certainly 62 not needed, but it needs to summarize whether there 63 are any more non-zero bits in the number */ 64 if (!(b & 0x1) && any_nonzero_digits(na, nl-1, delta)) 65 b |= 0x1; 66 d = FP_TYPE_FROM_UINTPTR(b); 67 } else { 68 /* Need to look at a second word, possibly pulling in bits from 69 a third word */ 70 d = FP_TYPE_FROM_UINTPTR(b); 71 d = FP_TYPE_MULT(d, FP_TYPE_FROM_DOUBLE(BIG_RADIX)); 72 b = (na[nl-2] << delta); 73 if ((nl > 2) && delta) 74 b += (na[nl-3] >> (WORD_SIZE - delta)); 75 if (!(b & 0x1) && (nl > 2) && any_nonzero_digits(na, nl-2, delta)) 76 b |= 0x1; 77 d = FP_TYPE_PLUS(d, FP_TYPE_FROM_UINTPTR(b)); 78 d = FP_TYPE_DIV(d, FP_TYPE_FROM_DOUBLE(BIG_RADIX)); 79 } 80 /* Shift `d` back down by delta: */ 81 if (delta) 82 d = FP_TYPE_DIV(d, FP_TYPE_POW(FP_TYPE_FROM_DOUBLE(2.0), 83 FP_TYPE_FROM_INT(delta))); 84 nl--; 85 86 /* Shift `d` up by remaining bignum words */ 87 if (_skipped) { 88 while (nl--) { 89 d = FP_TYPE_MULT(d, FP_TYPE_FROM_DOUBLE(BIG_RADIX)); 90 if (IS_FLOAT_INF(d)) 91 break; 92 --skipped; 93 } 94 } else { 95 d = FP_TYPE_MULT(d, FP_TYPE_POW(FP_TYPE_FROM_DOUBLE(2.0), 96 FP_TYPE_FROM_UINTPTR(nl * WORD_SIZE))); 97 } 98 } 99 100 if (_skipped) 101 *_skipped = skipped; 102 103 if (!SCHEME_BIGPOS(n)) 104 d = FP_TYPE_NEG(d); 105 106 return d; 107} 108 109FP_TYPE SCHEME_BIGNUM_TO_FLOAT(const Scheme_Object *n) 110{ 111 return SCHEME_BIGNUM_TO_FLOAT_INFO(n, 0, NULL); 112} 113 114#ifdef MZ_PRECISE_GC 115END_XFORM_SKIP; 116#endif 117 118Scheme_Object *SCHEME_BIGNUM_FROM_FLOAT(FP_TYPE d) 119{ 120 Small_Bignum s1; 121 int negate, log, times, i; 122 FP_TYPE r; 123 Scheme_Object *n, *m; 124 125 r = FP_ONEx; 126 127 SCHEME_CHECK_FLOAT("inexact->exact", d, "integer"); 128 129 if (FP_TYPE_LESS(d, FP_ZEROx)) { 130 negate = 1; 131 d = FP_TYPE_NEG(d); 132 } else 133 negate = 0; 134 135 if (FP_TYPE_LESS(d, FP_ONEx)) 136 return scheme_make_integer(0); 137 138 log = 0; 139 while (FP_TYPE_LESS(r, d)) { 140 log++; 141 r = FP_TYPE_MULT(r, FP_TWOx); 142 } 143 144 if (log > USE_FLOAT_BITS) { 145 times = log - USE_FLOAT_BITS; 146 log = USE_FLOAT_BITS; 147 for (i = 0; i < times; i++) { 148 d = FP_TYPE_DIV(d, FP_TWOx); 149 } 150 } else 151 times = 0; 152 153 r = FP_POWx(FP_TWOx, FP_TYPE_FROM_INT(log)); 154 155 n = scheme_make_small_bignum(0, &s1); 156 157 log++; 158 while (log--) { 159 bignum_double_inplace(&n); 160 if (FP_TYPE_GREATER_OR_EQV(d, r)) { 161 d = FP_TYPE_MINUS(d, r); 162 bignum_add1_inplace(&n); 163 } 164 r = FP_TYPE_DIV(r, FP_TWOx); 165 } 166 167 if (times) { 168 m = scheme_make_bignum(1); 169 while (times--) { 170 bignum_double_inplace(&m); 171 } 172 n = bignum_multiply(n, m, 0); 173 } 174 175 if (negate) 176 SCHEME_SET_BIGPOS(n, !SCHEME_BIGPOS(n)); 177 178 n = scheme_bignum_normalize(n); 179 180 return n; 181} 182 183#undef USE_FLOAT_BITS 184#undef FP_TYPE 185#undef IS_FLOAT_INF 186#undef SCHEME_BIGNUM_TO_FLOAT_INFO 187#undef SCHEME_BIGNUM_TO_FLOAT 188#undef SCHEME_CHECK_FLOAT 189#undef SCHEME_BIGNUM_FROM_FLOAT 190#undef FP_ZEROx 191#undef FP_ONEx 192#undef FP_TWOx 193#undef FP_POWx 194#undef FP_MZ_IS_POS_INFINITY 195#undef FP_scheme_floating_point_nzero 196 197#undef FP_TYPE_FROM_DOUBLE 198#undef FP_TYPE_NEG 199#undef FP_TYPE_LESS 200#undef FP_TYPE_MULT 201#undef FP_TYPE_PLUS 202#undef FP_TYPE_DIV 203#undef FP_TYPE_POW 204#undef FP_TYPE_FROM_INT 205#undef FP_TYPE_GREATER_OR_EQV 206#undef FP_TYPE_MINUS 207#undef FP_TYPE_FROM_UINTPTR 208