Back to index

plt-scheme  4.2.1
bgnfloat.inc
Go to the documentation of this file.
00001 
00002 #ifdef MZ_PRECISE_GC
00003 START_XFORM_SKIP;
00004 #endif
00005 
00006 /* Optimization someimtes causes a problem: d is represented in an
00007    extended format instead of a `double'. We don't want to turn off
00008    floatng-point optimizations in the rest of the program, so we use a
00009    little function to defeat the optimization: */
00010 int IS_FLOAT_INF(FP_TYPE d)
00011 {
00012   return MZ_IS_POS_INFINITY(d);
00013 }
00014 
00015 /* Must not trigger GC! (Required by xform in number.c) */
00016 FP_TYPE SCHEME_BIGNUM_TO_FLOAT_INFO(const Scheme_Object *n, int skip, int *_skipped)
00017 {
00018   int nl, skipped;
00019   bigdig *na;
00020   FP_TYPE d;
00021 
00022   nl = SCHEME_BIGLEN(n);
00023   na = SCHEME_BIGDIG(n) + nl;
00024 
00025   skipped = nl;
00026 
00027   if (skip >= nl) {
00028     if (SCHEME_BIGPOS(n))
00029       return 0.0;
00030     else
00031       return scheme_floating_point_nzero;
00032   } else
00033     nl -= skip;
00034        
00035   d = 0;
00036   while (nl--) {
00037     d *= (FP_TYPE)BIG_RADIX;
00038     d += *(--na);
00039     if (IS_FLOAT_INF(d))
00040       break;
00041     --skipped;
00042   }
00043 
00044   if (_skipped)
00045     *_skipped = skipped;
00046   
00047   if (!SCHEME_BIGPOS(n))
00048     d = -d;
00049 
00050   return d;
00051 }
00052 
00053 FP_TYPE SCHEME_BIGNUM_TO_FLOAT(const Scheme_Object *n)
00054 {
00055   return SCHEME_BIGNUM_TO_FLOAT_INFO(n, 0, NULL);
00056 }
00057 
00058 #ifdef MZ_PRECISE_GC
00059 END_XFORM_SKIP;
00060 #endif
00061 
00062 Scheme_Object *SCHEME_BIGNUM_FROM_FLOAT(FP_TYPE d)
00063 {
00064   Small_Bignum s1;
00065   int negate, log, times, i;
00066   FP_TYPE r;
00067   Scheme_Object *n, *m;
00068 
00069   r = 1;
00070 
00071   SCHEME_CHECK_FLOAT("inexact->exact", d, "integer");
00072 
00073   if (d < 0) {
00074     negate = 1;
00075     d = -d;
00076   } else
00077     negate = 0;
00078 
00079   if (d < 1.0)
00080     return scheme_make_integer(0);
00081 
00082   log = 0;
00083   while (r < d) {
00084     log++;
00085     r *= 2.0;
00086   }
00087 
00088   if (log > USE_FLOAT_BITS) {
00089     times = log - USE_FLOAT_BITS;
00090     log = USE_FLOAT_BITS;
00091     for (i = 0; i < times; i++) {
00092       d /= 2;
00093     }
00094   } else
00095     times = 0;
00096 
00097   r = pow(2.0, (FP_TYPE)log);
00098 
00099   n = scheme_make_small_bignum(0, &s1);
00100 
00101   log++;
00102   while (log--) {
00103     bignum_double_inplace(&n);
00104     if (d >= r) {
00105       d -= r;
00106       bignum_add1_inplace(&n);
00107     }
00108     r /= 2;
00109   }
00110 
00111   if (times) {
00112     m = scheme_make_bignum(1);
00113     while (times--) {
00114       bignum_double_inplace(&m);      
00115     }
00116     n = bignum_multiply(n, m, 0);
00117   }
00118 
00119   if (negate)
00120     SCHEME_SET_BIGPOS(n, !SCHEME_BIGPOS(n));
00121 
00122   n = scheme_bignum_normalize(n);
00123 
00124   return n;
00125 }