diff options
Diffstat (limited to 'libguile/numbers.c')
-rw-r--r-- | libguile/numbers.c | 193 |
1 files changed, 98 insertions, 95 deletions
diff --git a/libguile/numbers.c b/libguile/numbers.c index cb8afe536..05f26d342 100644 --- a/libguile/numbers.c +++ b/libguile/numbers.c @@ -151,6 +151,7 @@ SCM_GPROC (s_abs, "abs", 1, 0, 0, scm_abs, g_abs); SCM scm_abs (SCM x) { + long int cx; #ifdef SCM_BIGDIG if (SCM_NINUMP (x)) { @@ -164,14 +165,14 @@ scm_abs (SCM x) #endif if (SCM_INUM (x) >= 0) return x; - x = - SCM_INUM (x); - if (!SCM_POSFIXABLE (x)) + cx = - SCM_INUM (x); + if (!SCM_POSFIXABLE (cx)) #ifdef SCM_BIGDIG - return scm_long2big (x); + return scm_long2big (cx); #else - scm_num_overflow (s_abs); + scm_num_overflow (s_abs); #endif - return SCM_MAKINUM (x); + return SCM_MAKINUM (cx); } SCM_GPROC (s_quotient, "quotient", 2, 0, 0, scm_quotient, g_quotient); @@ -183,7 +184,6 @@ scm_quotient (SCM x, SCM y) #ifdef SCM_BIGDIG if (SCM_NINUMP (x)) { - long w; SCM_GASSERT2 (SCM_BIGP (x), g_quotient, x, y, SCM_ARG1, s_quotient); if (SCM_NINUMP (y)) @@ -201,24 +201,24 @@ scm_quotient (SCM x, SCM y) z = -z; if (z < SCM_BIGRAD) { - w = scm_copybig (x, SCM_BIGSIGN (x) ? (y > 0) : (y < 0)); - scm_divbigdig (SCM_BDIGITS (w), SCM_NUMDIGS (w), (SCM_BIGDIG) z); - return scm_normbig (w); + SCM sw = scm_copybig (x, SCM_BIGSIGN (x) ? (SCM_ASWORD (y) > 0) : (SCM_ASWORD (y) < 0)); + scm_divbigdig (SCM_BDIGITS (sw), SCM_NUMDIGS (sw), (SCM_BIGDIG) z); + return scm_normbig (sw); } + { /* scope */ #ifndef SCM_DIGSTOOBIG - w = scm_pseudolong (z); + long w = scm_pseudolong (z); return scm_divbigbig (SCM_BDIGITS (x), SCM_NUMDIGS (x), (SCM_BIGDIG *) & w, SCM_DIGSPERLONG, SCM_BIGSIGN (x) ? (y > 0) : (y < 0), 2); #else - { SCM_BIGDIG zdigs[SCM_DIGSPERLONG]; scm_longdigs (z, zdigs); return scm_divbigbig (SCM_BDIGITS (x), SCM_NUMDIGS (x), zdigs, SCM_DIGSPERLONG, SCM_BIGSIGN (x) ? (y > 0) : (y < 0), 2); - } #endif + } /* end scope */ } if (SCM_NINUMP (y)) { @@ -377,7 +377,7 @@ SCM_GPROC1 (s_gcd, "gcd", scm_tc7_asubr, scm_gcd, g_gcd); SCM scm_gcd (SCM x, SCM y) { - register long u, v, k, t; + long u, v, k, t; if (SCM_UNBNDP (y)) return SCM_UNBNDP (x) ? SCM_INUM0 : x; tailrec: @@ -400,9 +400,11 @@ scm_gcd (SCM x, SCM y) { case -1: swaprec: - t = scm_remainder (x, y); - x = y; - y = t; + { + SCM t = scm_remainder (x, y); + x = y; + y = t; + } goto tailrec; case 0: return x; @@ -419,7 +421,7 @@ scm_gcd (SCM x, SCM y) } if (SCM_NINUMP (y)) { - t = x; + SCM t = x; x = y; y = t; goto big_gcd; @@ -694,7 +696,7 @@ SCM_DEFINE (scm_ash, "ash", 2, 0, 0, #define FUNC_NAME s_scm_ash { /* GJB:FIXME:: what is going on here? */ - SCM res = SCM_INUM (n); + SCM res = SCM_ASSCM (SCM_INUM (n)); SCM_VALIDATE_INUM (2,cnt); #ifdef SCM_BIGDIG if (cnt < 0) @@ -862,10 +864,11 @@ static const char s_bignum[] = "bignum"; SCM scm_mkbig (scm_sizet nlen, int sign) { - SCM v = nlen; - /* Cast to SCM to avoid signed/unsigned comparison warnings. */ - if (((v << 16) >> 16) != (SCM) nlen) + SCM v; + /* Cast to long int to avoid signed/unsigned comparison warnings. */ + if ((( ((long int)nlen) << 16) >> 16) != (long int) nlen) scm_wta (SCM_MAKINUM (nlen), (char *) SCM_NALLOC, s_bignum); + SCM_NEWCELL (v); SCM_DEFER_INTS; SCM_SETCHARS (v, scm_must_malloc ((long) (nlen * sizeof (SCM_BIGDIG)), @@ -1168,7 +1171,7 @@ scm_addbig (SCM_BIGDIG *x, scm_sizet nx, int xsgn, SCM bigy, int sgny) { num = 1; i = 0; - SCM_SETCAR (z, SCM_CAR (z) ^ 0x0100); + SCM_SETCAR (z, SCM_CARW (z) ^ 0x0100); do { num += (SCM_BIGRAD - 1) - zds[i]; @@ -2864,7 +2867,7 @@ scm_positive_p (SCM x) SCM_GASSERT1 (SCM_INUMP (x), g_positive_p, x, SCM_ARG1, s_positive_p); #endif #endif - return SCM_BOOL(x > SCM_INUM0); + return SCM_BOOL(SCM_INUM(x) > 0); } @@ -2904,7 +2907,7 @@ scm_negative_p (SCM x) SCM_GASSERT1 (SCM_INUMP (x), g_negative_p, x, SCM_ARG1, s_negative_p); #endif #endif - return SCM_BOOL(x < SCM_INUM0); + return SCM_BOOL(SCM_INUM(x) < 0); } @@ -3015,6 +3018,8 @@ scm_max (SCM x, SCM y) } +#define SCM_SWAP(x,y) do { SCM t = x; x = y; y = t; } while (0) + SCM_GPROC1 (s_min, "min", scm_tc7_asubr, scm_min, g_min); @@ -3128,6 +3133,10 @@ scm_min (SCM x, SCM y) SCM_GPROC1 (s_sum, "+", scm_tc7_asubr, scm_sum, g_sum); +/* + This is sick, sick, sick code. + + */ SCM scm_sum (SCM x, SCM y) { @@ -3141,8 +3150,7 @@ scm_sum (SCM x, SCM y) #ifdef SCM_FLOATS if (SCM_NINUMP (x)) { - SCM t; -#ifdef SCM_BIGDIG +# ifdef SCM_BIGDIG if (!SCM_NIMP (x)) { badx2: @@ -3152,9 +3160,7 @@ scm_sum (SCM x, SCM y) { if (SCM_INUMP (y)) { - t = x; - x = y; - y = t; + SCM_SWAP(x,y); goto intbig; } SCM_ASRTGO (SCM_NIMP (y), bady); @@ -3162,9 +3168,7 @@ scm_sum (SCM x, SCM y) { if (SCM_NUMDIGS (x) > SCM_NUMDIGS (y)) { - t = x; - x = y; - y = t; + SCM_SWAP(x,y); } return scm_addbig (SCM_BDIGITS (x), SCM_NUMDIGS (x), SCM_BIGSIGN (x), @@ -3175,24 +3179,19 @@ scm_sum (SCM x, SCM y) return scm_makdbl (scm_big2dbl (x) + SCM_REALPART (y), SCM_CPLXP (y) ? SCM_IMAG (y) : 0.0); } +# endif /* SCM_BIGDIG */ SCM_ASRTGO (SCM_INEXP (x), badx2); -#else - SCM_ASRTGO (SCM_INEXP (x), badx2); -#endif + if (SCM_INUMP (y)) { - t = x; - x = y; - y = t; + SCM_SWAP(x,y); goto intreal; } -#ifdef SCM_BIGDIG +# ifdef SCM_BIGDIG SCM_ASRTGO (SCM_NIMP (y), bady); if (SCM_BIGP (y)) { - t = x; - x = y; - y = t; + SCM_SWAP(x,y); goto bigreal; } else if (!SCM_INEXP (y)) @@ -3200,13 +3199,13 @@ scm_sum (SCM x, SCM y) bady: SCM_WTA_DISPATCH_2 (g_sum, x, y, SCM_ARGn, s_sum); } -#else +# else /* SCM_BIGDIG */ if (!SCM_INEXP (y)) { bady: SCM_WTA_DISPATCH_2 (g_sum, x, y, SCM_ARGn, s_sum); } -#endif +# endif /* SCM_BIGDIG */ { double i = 0.0; if (SCM_CPLXP (x)) @@ -3218,54 +3217,46 @@ scm_sum (SCM x, SCM y) } if (SCM_NINUMP (y)) { -#ifdef SCM_BIGDIG +# ifdef SCM_BIGDIG SCM_ASRTGO (SCM_NIMP (y), bady); if (SCM_BIGP (y)) { intbig: { -#ifndef SCM_DIGSTOOBIG +# ifndef SCM_DIGSTOOBIG long z = scm_pseudolong (SCM_INUM (x)); return scm_addbig ((SCM_BIGDIG *) & z, SCM_DIGSPERLONG, (x < 0) ? 0x0100 : 0, y, 0); -#else +# else /* SCM_DIGSTOOBIG */ SCM_BIGDIG zdigs[SCM_DIGSPERLONG]; scm_longdigs (SCM_INUM (x), zdigs); return scm_addbig (zdigs, SCM_DIGSPERLONG, (x < 0) ? 0x0100 : 0, y, 0); -#endif +# endif /* SCM_DIGSTOOBIG */ } } +# endif /* SCM_BIGDIG */ SCM_ASRTGO (SCM_INEXP (y), bady); -#else - SCM_ASRTGO (SCM_INEXP (y), bady); -#endif intreal: return scm_makdbl (SCM_INUM (x) + SCM_REALPART (y), SCM_CPLXP (y) ? SCM_IMAG (y) : 0.0); } -#else -#ifdef SCM_BIGDIG +#else /* SCM_FLOATS */ +# ifdef SCM_BIGDIG if (SCM_NINUMP (x)) { SCM t; SCM_ASRTGO (SCM_BIGP (x), badx2); if (SCM_INUMP (y)) { - t = x; - x = y; - y = t; + SCM_SWAP(x,y); goto intbig; } SCM_ASRTGO (SCM_BIGP (y), bady); if (SCM_NUMDIGS (x) > SCM_NUMDIGS (y)) - { - t = x; - x = y; - y = t; - } + SCM_SWAP(x,y); return scm_addbig (SCM_BDIGITS (x), SCM_NUMDIGS (x), SCM_BIGSIGN (x), y, 0); } @@ -3278,34 +3269,38 @@ scm_sum (SCM x, SCM y) } intbig: { -#ifndef SCM_DIGSTOOBIG +# ifndef SCM_DIGSTOOBIG long z = scm_pseudolong (SCM_INUM (x)); return scm_addbig (&z, SCM_DIGSPERLONG, (x < 0) ? 0x0100 : 0, y, 0); -#else +# else SCM_BIGDIG zdigs[SCM_DIGSPERLONG]; scm_longdigs (SCM_INUM (x), zdigs); return scm_addbig (zdigs, SCM_DIGSPERLONG, (x < 0) ? 0x0100 : 0, y, 0); -#endif +# endif /* SCM_DIGSTOOBIG */ } } -#else +# else /* SCM_BIGDIG */ SCM_ASRTGO (SCM_INUMP (x), badx2); SCM_GASSERT2 (SCM_INUMP (y), g_sum, x, y, SCM_ARGn, s_sum); -#endif -#endif - x = SCM_INUM (x) + SCM_INUM (y); - if (SCM_FIXABLE (x)) - return SCM_MAKINUM (x); +# endif/* SCM_BIGDIG */ +#endif /* SCM_FLOATS */ + + { /* scope */ + long int i = SCM_INUM (x) + SCM_INUM (y); + if (SCM_FIXABLE (i)) + return SCM_MAKINUM (i); #ifdef SCM_BIGDIG - return scm_long2big (x); -#else -#ifdef SCM_FLOATS - return scm_makdbl ((double) x, 0.0); -#else - scm_num_overflow (s_sum); - return SCM_UNSPECIFIED; -#endif -#endif + return scm_long2big (i); +#else /* SCM_BIGDIG */ + +# ifdef SCM_FLOATS + return scm_makdbl ((double) i, 0.0); +# else + scm_num_overflow (s_sum); + return SCM_UNSPECIFIED; +# endif/* SCM_FLOATS */ +#endif /* SCM_BIGDIG */ + } /* end scope */ } @@ -3313,13 +3308,17 @@ scm_sum (SCM x, SCM y) SCM_GPROC1 (s_difference, "-", scm_tc7_asubr, scm_difference, g_difference); +/* + HWN:FIXME:: This is sick,sick, sick code. Rewrite me. +*/ SCM scm_difference (SCM x, SCM y) { + long int cx = 0; #ifdef SCM_FLOATS if (SCM_NINUMP (x)) { - if (!(SCM_NIMP (x))) + if (!SCM_NIMP (x)) { if (SCM_UNBNDP (y)) { @@ -3390,7 +3389,7 @@ scm_difference (SCM x, SCM y) } if (SCM_UNBNDP (y)) { - x = -SCM_INUM (x); + cx = -SCM_INUM (x); goto checkx; } if (SCM_NINUMP (y)) @@ -3488,21 +3487,21 @@ scm_difference (SCM x, SCM y) SCM_GASSERT2 (SCM_INUMP (x), g_difference, x, y, SCM_ARG1, s_difference); if (SCM_UNBNDP (y)) { - x = -SCM_INUM (x); + cx = -SCM_INUM (x); goto checkx; } SCM_GASSERT2 (SCM_INUMP (y), g_difference, x, y, SCM_ARGn, s_difference); #endif #endif - x = SCM_INUM (x) - SCM_INUM (y); + cx = SCM_INUM (x) - SCM_INUM (y); checkx: - if (SCM_FIXABLE (x)) - return SCM_MAKINUM (x); + if (SCM_FIXABLE (cx)) + return SCM_MAKINUM (cx); #ifdef SCM_BIGDIG - return scm_long2big (x); + return scm_long2big (cx); #else #ifdef SCM_FLOATS - return scm_makdbl ((double) x, 0.0); + return scm_makdbl ((double) cx, 0.0); #else scm_num_overflow (s_difference); return SCM_UNSPECIFIED; @@ -3742,7 +3741,11 @@ scm_num2dbl (SCM a, const char *why) return scm_big2dbl (a); #endif SCM_ASSERT (0, a, "wrong type argument", why); - return SCM_UNSPECIFIED; + /* + unreachable, hopefully. + */ + return (double) 0.0; /* ugh. */ + /* return SCM_UNSPECIFIED; */ } @@ -3787,10 +3790,9 @@ scm_divide (SCM x, SCM y) #ifdef SCM_BIGDIG if (SCM_BIGP (x)) { - SCM z; if (SCM_INUMP (y)) { - z = SCM_INUM (y); + long int z = SCM_INUM (y); #ifndef SCM_RECKLESS if (!z) scm_num_overflow (s_divide); @@ -3808,10 +3810,11 @@ scm_divide (SCM x, SCM y) : scm_normbig (w)); } #ifndef SCM_DIGSTOOBIG + /*ugh! Does anyone know what this is supposed to do?*/ z = scm_pseudolong (z); - z = scm_divbigbig (SCM_BDIGITS (x), SCM_NUMDIGS (x), - (SCM_BIGDIG *) & z, SCM_DIGSPERLONG, - SCM_BIGSIGN (x) ? (y > 0) : (y < 0), 3); + z = SCM_INUM(scm_divbigbig (SCM_BDIGITS (x), SCM_NUMDIGS (x), + (SCM_BIGDIG *) & z, SCM_DIGSPERLONG, + SCM_BIGSIGN (x) ? (y > 0) : (y < 0), 3)); #else { SCM_BIGDIG zdigs[SCM_DIGSPERLONG]; @@ -3821,12 +3824,12 @@ scm_divide (SCM x, SCM y) SCM_BIGSIGN (x) ? (y > 0) : (y < 0), 3); } #endif - return z ? z : scm_makdbl (scm_big2dbl (x) / SCM_INUM (y), 0.0); + return z ? SCM_ASSCM (z) : scm_makdbl (scm_big2dbl (x) / SCM_INUM (y), 0.0); } SCM_ASRTGO (SCM_NIMP (y), bady); if (SCM_BIGP (y)) { - z = scm_divbigbig (SCM_BDIGITS (x), SCM_NUMDIGS (x), + SCM z = scm_divbigbig (SCM_BDIGITS (x), SCM_NUMDIGS (x), SCM_BDIGITS (y), SCM_NUMDIGS (y), SCM_BIGSIGN (x) ^ SCM_BIGSIGN (y), 3); return z ? z : scm_makdbl (scm_big2dbl (x) / scm_big2dbl (y), |