diff options
Diffstat (limited to 'libguile/numbers.c')
-rw-r--r-- | libguile/numbers.c | 220 |
1 files changed, 121 insertions, 99 deletions
diff --git a/libguile/numbers.c b/libguile/numbers.c index 34aaf411e..3219d7821 100644 --- a/libguile/numbers.c +++ b/libguile/numbers.c @@ -141,7 +141,7 @@ scm_even_p (n) return (4 & (int) n) ? SCM_BOOL_F : SCM_BOOL_T; } -SCM_PROC (s_abs, "abs", 1, 0, 0, scm_abs); +SCM_GPROC (s_abs, "abs", 1, 0, 0, scm_abs, g_abs); SCM scm_abs (x) @@ -150,13 +150,13 @@ scm_abs (x) #ifdef SCM_BIGDIG if (SCM_NINUMP (x)) { - SCM_ASSERT (SCM_NIMP (x) && SCM_BIGP (x), x, SCM_ARG1, s_abs); + SCM_GASSERT1 (SCM_NIMP (x) && SCM_BIGP (x), g_abs, x, SCM_ARG1, s_abs); if (SCM_TYP16 (x) == scm_tc16_bigpos) return x; return scm_copybig (x, 0); } #else - SCM_ASSERT (SCM_INUMP (x), x, SCM_ARG1, s_abs); + SCM_GASSERT1 (SCM_INUMP (x), g_abs, x, SCM_ARG1, s_abs); #endif if (SCM_INUM (x) >= 0) return x; @@ -170,7 +170,7 @@ scm_abs (x) return SCM_MAKINUM (x); } -SCM_PROC (s_quotient, "quotient", 2, 0, 0, scm_quotient); +SCM_GPROC (s_quotient, "quotient", 2, 0, 0, scm_quotient, g_quotient); SCM scm_quotient (x, y) @@ -182,7 +182,8 @@ scm_quotient (x, y) if (SCM_NINUMP (x)) { long w; - SCM_ASSERT (SCM_NIMP (x) && SCM_BIGP (x), x, SCM_ARG1, s_quotient); + SCM_GASSERT2 (SCM_NIMP (x) && SCM_BIGP (x), + g_quotient, x, y, SCM_ARG1, s_quotient); if (SCM_NINUMP (y)) { SCM_ASRTGO (SCM_NIMP (y) && SCM_BIGP (y), bady); @@ -223,14 +224,14 @@ scm_quotient (x, y) if (!(SCM_NIMP (y) && SCM_BIGP (y))) { bady: - scm_wta (y, (char *) SCM_ARG2, s_quotient); + SCM_WTA_DISPATCH_2 (g_quotient, x, y, SCM_ARG2, s_quotient); } #endif return SCM_INUM0; } #else - SCM_ASSERT (SCM_INUMP (x), x, SCM_ARG1, s_quotient); - SCM_ASSERT (SCM_INUMP (y), y, SCM_ARG2, s_quotient); + SCM_GASSERT2 (SCM_INUMP (x), g_quotient, x, y, SCM_ARG1, s_quotient); + SCM_GASSERT2 (SCM_INUMP (y), g_quotient, x, y, SCM_ARG2, s_quotient); #endif if ((z = SCM_INUM (y)) == 0) { @@ -263,7 +264,7 @@ scm_quotient (x, y) return SCM_MAKINUM (z); } -SCM_PROC (s_remainder, "remainder", 2, 0, 0, scm_remainder); +SCM_GPROC (s_remainder, "remainder", 2, 0, 0, scm_remainder, g_remainder); SCM scm_remainder (x, y) @@ -274,7 +275,8 @@ scm_remainder (x, y) #ifdef SCM_BIGDIG if (SCM_NINUMP (x)) { - SCM_ASSERT (SCM_NIMP (x) && SCM_BIGP (x), x, SCM_ARG1, s_remainder); + SCM_GASSERT2 (SCM_NIMP (x) && SCM_BIGP (x), + g_remainder, x, y, SCM_ARG1, s_remainder); if (SCM_NINUMP (y)) { SCM_ASRTGO (SCM_NIMP (y) && SCM_BIGP (y), bady); @@ -292,14 +294,14 @@ scm_remainder (x, y) if (!(SCM_NIMP (y) && SCM_BIGP (y))) { bady: - scm_wta (y, (char *) SCM_ARG2, s_remainder); + SCM_WTA_DISPATCH_2 (g_remainder, x, y, SCM_ARG2, s_remainder); } #endif return x; } #else - SCM_ASSERT (SCM_INUMP (x), x, SCM_ARG1, s_remainder); - SCM_ASSERT (SCM_INUMP (y), y, SCM_ARG2, s_remainder); + SCM_GASSERT2 (SCM_INUMP (x), g_remainder, x, y, SCM_ARG1, s_remainder); + SCM_GASSERT2 (SCM_INUMP (y), g_remainder, x, y, SCM_ARG2, s_remainder); #endif if (!(z = SCM_INUM (y))) { @@ -323,7 +325,7 @@ scm_remainder (x, y) return SCM_MAKINUM (z); } -SCM_PROC (s_modulo, "modulo", 2, 0, 0, scm_modulo); +SCM_GPROC (s_modulo, "modulo", 2, 0, 0, scm_modulo, g_modulo); SCM scm_modulo (x, y) @@ -334,7 +336,8 @@ scm_modulo (x, y) #ifdef SCM_BIGDIG if (SCM_NINUMP (x)) { - SCM_ASSERT (SCM_NIMP (x) && SCM_BIGP (x), x, SCM_ARG1, s_modulo); + SCM_GASSERT2 (SCM_NIMP (x) && SCM_BIGP (x), + g_modulo, x, y, SCM_ARG1, s_modulo); if (SCM_NINUMP (y)) { SCM_ASRTGO (SCM_NIMP (y) && SCM_BIGP (y), bady); @@ -354,14 +357,14 @@ scm_modulo (x, y) if (!(SCM_NIMP (y) && SCM_BIGP (y))) { bady: - scm_wta (y, (char *) SCM_ARG2, s_modulo); + SCM_WTA_DISPATCH_2 (g_modulo, x, y, SCM_ARG2, s_modulo); } #endif return (SCM_BIGSIGN (y) ? (x > 0) : (x < 0)) ? scm_sum (x, y) : x; } #else - SCM_ASSERT (SCM_INUMP (x), x, SCM_ARG1, s_modulo); - SCM_ASSERT (SCM_INUMP (y), y, SCM_ARG2, s_modulo); + SCM_GASSERT1 (SCM_INUMP (x), g_modulo, x, y, SCM_ARG1, s_modulo); + SCM_GASSERT2 (SCM_INUMP (y), g_modulo, x, y, SCM_ARG2, s_modulo); #endif if (!(yy = SCM_INUM (y))) { @@ -377,7 +380,7 @@ scm_modulo (x, y) return SCM_MAKINUM (((yy < 0) ? (z > 0) : (z < 0)) ? z + yy : z); } -SCM_PROC1 (s_gcd, "gcd", scm_tc7_asubr, scm_gcd); +SCM_GPROC1 (s_gcd, "gcd", scm_tc7_asubr, scm_gcd, g_gcd); SCM scm_gcd (x, y) @@ -392,13 +395,15 @@ scm_gcd (x, y) if (SCM_NINUMP (x)) { big_gcd: - SCM_ASSERT (SCM_NIMP (x) && SCM_BIGP (x), x, SCM_ARG1, s_gcd); + SCM_GASSERT2 (SCM_NIMP (x) && SCM_BIGP (x), + g_gcd, x, y, SCM_ARG1, s_gcd); if (SCM_BIGSIGN (x)) x = scm_copybig (x, 0); newy: if (SCM_NINUMP (y)) { - SCM_ASSERT (SCM_NIMP (y) && SCM_BIGP (y), y, SCM_ARG2, s_gcd); + SCM_GASSERT2 (SCM_NIMP (y) && SCM_BIGP (y), + g_gcd, x, y, SCM_ARGn, s_gcd); if (SCM_BIGSIGN (y)) y = scm_copybig (y, 0); switch (scm_bigcomp (x, y)) @@ -430,8 +435,8 @@ scm_gcd (x, y) goto big_gcd; } #else - SCM_ASSERT (SCM_INUMP (x), x, SCM_ARG1, s_gcd); - SCM_ASSERT (SCM_INUMP (y), y, SCM_ARG2, s_gcd); + SCM_GASSERT2 (SCM_INUMP (x), g_gcd, x, y, SCM_ARG1, s_gcd); + SCM_GASSERT2 (SCM_INUMP (y), g_gcd, x, y, SCM_ARGn, s_gcd); #endif u = SCM_INUM (x); if (u < 0) @@ -474,7 +479,7 @@ scm_gcd (x, y) return SCM_MAKINUM (u); } -SCM_PROC1 (s_lcm, "lcm", scm_tc7_asubr, scm_lcm); +SCM_GPROC1 (s_lcm, "lcm", scm_tc7_asubr, scm_lcm, g_lcm); SCM scm_lcm (n1, n2) @@ -482,12 +487,22 @@ scm_lcm (n1, n2) SCM n2; { SCM d; +#ifndef BIGDIG + SCM_GASSERT2 (SCM_INUMP (n1), g_lcm, n1, n2, SCM_ARG1, s_lcm); + SCM_GASSERT2 (SCM_INUMP (n2), g_lcm, n1, n2, SCM_ARGn, s_lcm); +#else + SCM_GASSERT2 (SCM_INUMP (n1) || SCM_NIMP (n1) && SCM_BIGP (n1), + g_lcm, n1, n2, SCM_ARG1, s_lcm); + SCM_GASSERT2 (SCM_INUMP (n2) || SCM_NIMP (n2) && SCM_BIGP (n2), + g_lcm, n1, n2, SCM_ARGn, s_lcm); +#endif if (SCM_UNBNDP (n2)) { n2 = SCM_MAKINUM (1L); if (SCM_UNBNDP (n1)) return n2; } + d = scm_gcd (n1, n2); if (SCM_INUM0 == d) return d; @@ -2987,7 +3002,7 @@ scm_negative_p (x) } -SCM_PROC1 (s_max, "max", scm_tc7_asubr, scm_max); +SCM_GPROC1 (s_max, "max", scm_tc7_asubr, scm_max, g_max); SCM scm_max (x, y) @@ -3003,7 +3018,7 @@ scm_max (x, y) if (!(SCM_NUMBERP (x))) { badx: - scm_wta (x, (char *) SCM_ARG1, s_max); + SCM_WTA_DISPATCH_2 (g_max, x, y, SCM_ARG1, s_max); } #endif return x; @@ -3026,7 +3041,8 @@ scm_max (x, y) } SCM_ASRTGO (SCM_REALP (x), badx); #else - SCM_ASSERT (SCM_NIMP (x) && SCM_REALP (x), x, SCM_ARG1, s_max); + SCM_GASSERT2 (SCM_NIMP (x) && SCM_REALP (x), + g_max, x, y, SCM_ARG1, s_max); #endif if (SCM_INUMP (y)) return ((SCM_REALPART (x) < (z = SCM_INUM (y))) @@ -3054,7 +3070,7 @@ scm_max (x, y) if (!(SCM_REALP (y))) { bady: - scm_wta (y, (char *) SCM_ARG2, s_max); + SCM_WTA_DISPATCH_2 (g_max, x, y, SCM_ARGn, s_max); } #endif #else @@ -3062,7 +3078,7 @@ scm_max (x, y) if (!(SCM_NIMP (y) && SCM_REALP (y))) { bady: - scm_wta (y, (char *) SCM_ARG2, s_max); + SCM_WTA_DISPATCH_2 (g_max, x, y, SCM_ARGn, s_max); } #endif #endif @@ -3074,7 +3090,8 @@ scm_max (x, y) #ifdef SCM_BIGDIG if (SCM_NINUMP (x)) { - SCM_ASSERT (SCM_NIMP (x) && SCM_BIGP (x), x, SCM_ARG1, s_max); + SCM_GASSERT2 (SCM_NIMP (x) && SCM_BIGP (x), + g_max, x, y, SCM_ARG1, s_max); if (SCM_INUMP (y)) return SCM_BIGSIGN (x) ? y : x; SCM_ASRTGO (SCM_NIMP (y) && SCM_BIGP (y), bady); @@ -3086,14 +3103,14 @@ scm_max (x, y) if (!(SCM_NIMP (y) && SCM_BIGP (y))) { bady: - scm_wta (y, (char *) SCM_ARG2, s_max); + SCM_WTA_DISPATCH_2 (g_max, x, y, SCM_ARGn, s_max); } #endif return SCM_BIGSIGN (y) ? x : y; } #else - SCM_ASSERT (SCM_INUMP (x), x, SCM_ARG1, s_max); - SCM_ASSERT (SCM_INUMP (y), y, SCM_ARG2, s_max); + SCM_GASSERT2 (SCM_INUMP (x), g_max, x, y, SCM_ARG1, s_max); + SCM_GASSERT2 (SCM_INUMP (y), g_max, x, y, SCM_ARGn, s_max); #endif #endif return ((long) x < (long) y) ? y : x; @@ -3102,7 +3119,7 @@ scm_max (x, y) -SCM_PROC1 (s_min, "min", scm_tc7_asubr, scm_min); +SCM_GPROC1 (s_min, "min", scm_tc7_asubr, scm_min, g_min); SCM scm_min (x, y) @@ -3118,7 +3135,7 @@ scm_min (x, y) if (!(SCM_NUMBERP (x))) { badx: - scm_wta (x, (char *) SCM_ARG1, s_min); + SCM_WTA_DISPATCH_2 (g_min, x, y, SCM_ARG1, s_min); } #endif return x; @@ -3141,7 +3158,8 @@ scm_min (x, y) } SCM_ASRTGO (SCM_REALP (x), badx); #else - SCM_ASSERT (SCM_NIMP (x) && SCM_REALP (x), x, SCM_ARG1, s_min); + SCM_GASSERT2 (SCM_NIMP (x) && SCM_REALP (x), + g_min, x, y, SCM_ARG1, s_min); #endif if (SCM_INUMP (y)) return ((SCM_REALPART (x) > (z = SCM_INUM (y))) @@ -3169,7 +3187,7 @@ scm_min (x, y) if (!(SCM_REALP (y))) { bady: - scm_wta (y, (char *) SCM_ARG2, s_min); + SCM_WTA_DISPATCH_2 (g_min, x, y, SCM_ARGn, s_min); } #endif #else @@ -3177,7 +3195,7 @@ scm_min (x, y) if (!(SCM_NIMP (y) && SCM_REALP (y))) { bady: - scm_wta (y, (char *) SCM_ARG2, s_min); + SCM_WTA_DISPATCH_2 (g_min, x, y, SCM_ARGn, s_min); } #endif #endif @@ -3189,7 +3207,8 @@ scm_min (x, y) #ifdef SCM_BIGDIG if (SCM_NINUMP (x)) { - SCM_ASSERT (SCM_NIMP (x) && SCM_BIGP (x), x, SCM_ARG1, s_min); + SCM_GASSERT2 (SCM_NIMP (x) && SCM_BIGP (x), + g_min, x, y, SCM_ARG1, s_min); if (SCM_INUMP (y)) return SCM_BIGSIGN (x) ? x : y; SCM_ASRTGO (SCM_NIMP (y) && SCM_BIGP (y), bady); @@ -3201,14 +3220,14 @@ scm_min (x, y) if (!(SCM_NIMP (y) && SCM_BIGP (y))) { bady: - scm_wta (y, (char *) SCM_ARG2, s_min); + SCM_WTA_DISPATCH_2 (g_min, x, y, SCM_ARGn, s_min); } #endif return SCM_BIGSIGN (y) ? y : x; } #else - SCM_ASSERT (SCM_INUMP (x), x, SCM_ARG1, s_min); - SCM_ASSERT (SCM_INUMP (y), y, SCM_ARG2, s_min); + SCM_GASSERT2 (SCM_INUMP (x), g_min, x, y, SCM_ARG1, s_min); + SCM_GASSERT2 (SCM_INUMP (y), g_min, x, y, SCM_ARGn, s_min); #endif #endif return ((long) x > (long) y) ? y : x; @@ -3217,7 +3236,7 @@ scm_min (x, y) -SCM_PROC1 (s_sum, "+", scm_tc7_asubr, scm_sum); +SCM_GPROC1 (s_sum, "+", scm_tc7_asubr, scm_sum, g_sum); SCM scm_sum (x, y) @@ -3232,7 +3251,7 @@ scm_sum (x, y) if (!(SCM_NUMBERP (x))) { badx: - scm_wta (x, (char *) SCM_ARG1, s_sum); + SCM_WTA_DISPATCH_2 (g_sum, x, y, SCM_ARG1, s_sum); } #endif return x; @@ -3294,7 +3313,7 @@ scm_sum (x, y) else if (!(SCM_INEXP (y))) { bady: - scm_wta (y, (char *) SCM_ARG2, s_sum); + SCM_WTA_DISPATCH_2 (g_sum, x, y, SCM_ARGn, s_sum); } #endif #else @@ -3302,7 +3321,7 @@ scm_sum (x, y) if (!(SCM_NIMP (y) && SCM_INEXP (y))) { bady: - scm_wta (y, (char *) SCM_ARG2, s_sum); + SCM_WTA_DISPATCH_2 (g_sum, x, y, SCM_ARGn, s_sum); } #endif #endif @@ -3374,7 +3393,7 @@ scm_sum (x, y) if (!(SCM_NIMP (y) && SCM_BIGP (y))) { bady: - scm_wta (y, (char *) SCM_ARG2, s_sum); + SCM_WTA_DISPATCH_2 (g_sum, x, y, SCM_ARGn, s_sum); } #endif intbig: @@ -3391,7 +3410,7 @@ scm_sum (x, y) } #else SCM_ASRTGO (SCM_INUMP (x), badx); - SCM_ASSERT (SCM_INUMP (y), y, SCM_ARG2, s_sum); + SCM_GASSERT2 (SCM_INUMP (y), g_sum, x, y, SCM_ARGn, s_sum); #endif #endif x = SCM_INUM (x) + SCM_INUM (y); @@ -3412,7 +3431,7 @@ scm_sum (x, y) -SCM_PROC1 (s_difference, "-", scm_tc7_asubr, scm_difference); +SCM_GPROC1 (s_difference, "-", scm_tc7_asubr, scm_difference, g_difference); SCM scm_difference (x, y) @@ -3426,7 +3445,7 @@ scm_difference (x, y) if (!(SCM_NIMP (x))) { badx: - scm_wta (x, (char *) SCM_ARG1, s_difference); + SCM_WTA_DISPATCH_2 (g_difference, x, y, SCM_ARG1, s_difference); } #endif if (SCM_UNBNDP (y)) @@ -3510,7 +3529,7 @@ scm_difference (x, y) if (!(SCM_INEXP (y))) { bady: - scm_wta (y, (char *) SCM_ARG2, s_difference); + SCM_WTA_DISPATCH_2 (g_difference, x, y, SCM_ARGn, s_difference); } #endif #else @@ -3518,7 +3537,7 @@ scm_difference (x, y) if (!(SCM_NIMP (y) && SCM_INEXP (y))) { bady: - scm_wta (y, (char *) SCM_ARG2, s_difference); + SCM_WTA_DISPATCH_2 (g_difference, x, y, SCM_ARGn, s_difference); } #endif #endif @@ -3529,7 +3548,8 @@ scm_difference (x, y) #ifdef SCM_BIGDIG if (SCM_NINUMP (x)) { - SCM_ASSERT (SCM_NIMP (x) && SCM_BIGP (x), x, SCM_ARG1, s_difference); + SCM_GASSERT2 (SCM_NIMP (x) && SCM_BIGP (x), + g_difference, x, y, SCM_ARG1, s_difference); if (SCM_UNBNDP (y)) { x = scm_copybig (x, !SCM_BIGSIGN (x)); @@ -3568,7 +3588,7 @@ scm_difference (x, y) if (!(SCM_NIMP (y) && SCM_BIGP (y))) { bady: - scm_wta (y, (char *) SCM_ARG2, s_difference); + SCM_WTA_DISPATCH_2 (g_difference, x, y, SCM_ARGn, s_difference); } #endif { @@ -3585,13 +3605,13 @@ scm_difference (x, y) } } #else - SCM_ASSERT (SCM_INUMP (x), x, SCM_ARG1, s_difference); + SCM_GASSERT2 (SCM_INUMP (x), g_difference, x, y, SCM_ARG1, s_difference); if (SCM_UNBNDP (y)) { x = -SCM_INUM (x); goto checkx; } - SCM_ASSERT (SCM_INUMP (y), y, SCM_ARG2, s_difference); + SCM_GASSERT2 (SCM_INUMP (y), g_difference, x, y, SCM_ARGn, s_difference); #endif #endif x = SCM_INUM (x) - SCM_INUM (y); @@ -3613,7 +3633,7 @@ scm_difference (x, y) -SCM_PROC1 (s_product, "*", scm_tc7_asubr, scm_product); +SCM_GPROC1 (s_product, "*", scm_tc7_asubr, scm_product, g_product); SCM scm_product (x, y) @@ -3628,7 +3648,7 @@ scm_product (x, y) if (!(SCM_NUMBERP (x))) { badx: - scm_wta (x, (char *) SCM_ARG1, s_product); + SCM_WTA_DISPATCH_2 (g_product, x, y, SCM_ARG1, s_product); } #endif return x; @@ -3685,7 +3705,7 @@ scm_product (x, y) else if (!(SCM_INEXP (y))) { bady: - scm_wta (y, (char *) SCM_ARG2, s_product); + SCM_WTA_DISPATCH_2 (g_product, x, y, SCM_ARGn, s_product); } #endif #else @@ -3693,7 +3713,7 @@ scm_product (x, y) if (!(SCM_NIMP (y) && SCM_INEXP (y))) { bady: - scm_wta (y, (char *) SCM_ARG2, s_product); + SCM_WTA_DISPATCH_2 (g_product, x, y, SCM_ARGn, s_product); } #endif #endif @@ -3770,7 +3790,7 @@ scm_product (x, y) if (!(SCM_NIMP (y) && SCM_BIGP (y))) { bady: - scm_wta (y, (char *) SCM_ARG2, s_product); + SCM_WTA_DISPATCH_2 (g_product, x, y, SCM_ARGn, s_product); } #endif intbig: @@ -3795,7 +3815,7 @@ scm_product (x, y) } #else SCM_ASRTGO (SCM_INUMP (x), badx); - SCM_ASSERT (SCM_INUMP (y), y, SCM_ARG2, s_product); + SCM_GASSERT (SCM_INUMP (y), g_product, x, y, SCM_ARGn, s_product); #endif #endif { @@ -3858,7 +3878,7 @@ scm_num2dbl (a, why) } -SCM_PROC1 (s_divide, "/", scm_tc7_asubr, scm_divide); +SCM_GPROC1 (s_divide, "/", scm_tc7_asubr, scm_divide, g_divide); SCM scm_divide (x, y) @@ -3873,7 +3893,7 @@ scm_divide (x, y) if (!(SCM_NIMP (x))) { badx: - scm_wta (x, (char *) SCM_ARG1, s_divide); + SCM_WTA_DISPATCH_2 (g_divide, x, y, SCM_ARG1, s_divide); } #endif if (SCM_UNBNDP (y)) @@ -3994,7 +4014,7 @@ scm_divide (x, y) if (!(SCM_INEXP (y))) { bady: - scm_wta (y, (char *) SCM_ARG2, s_divide); + SCM_WTA_DISPATCH_2 (g_divide, x, y, SCM_ARGn, s_divide); } #endif #else @@ -4002,7 +4022,7 @@ scm_divide (x, y) if (!(SCM_NIMP (y) && SCM_INEXP (y))) { bady: - scm_wta (y, (char *) SCM_ARG2, s_divide); + SCM_WTA_DISPATCH_2 (g_divide, x, y, SCM_ARGn, s_divide); } #endif #endif @@ -4020,7 +4040,8 @@ scm_divide (x, y) if (SCM_NINUMP (x)) { SCM z; - SCM_ASSERT (SCM_NIMP (x) && SCM_BIGP (x), x, SCM_ARG1, s_divide); + SCM_GASSERT2 (SCM_NIMP (x) && SCM_BIGP (x), + g_divide, x, y, SCM_ARG1, s_divide); if (SCM_UNBNDP (y)) goto ov; if (SCM_INUMP (y)) @@ -4078,20 +4099,20 @@ scm_divide (x, y) if (!(SCM_NIMP (y) && SCM_BIGP (y))) { bady: - scm_wta (y, (char *) SCM_ARG2, s_divide); + SCM_WTA_DISPATCH_2 (g_divide, x, y, SCM_ARGn, s_divide); } #endif goto ov; } #else - SCM_ASSERT (SCM_INUMP (x), x, SCM_ARG1, s_divide); + SCM_GASSERT2 (SCM_INUMP (x), g_divide, x, y, SCM_ARG1, s_divide); if (SCM_UNBNDP (y)) { if ((SCM_MAKINUM (1L) == x) || (SCM_MAKINUM (-1L) == x)) return x; goto ov; } - SCM_ASSERT (SCM_INUMP (y), y, SCM_ARG2, s_divide); + SCM_GASSERT2 (SCM_INUMP (y), g_divide, x, y, SCM_ARGn, s_divide); #endif #endif { @@ -4119,7 +4140,7 @@ scm_divide (x, y) #ifdef SCM_FLOATS -SCM_PROC1 (s_asinh, "$asinh", scm_tc7_cxr, (SCM (*)()) scm_asinh); +SCM_GPROC1 (s_asinh, "$asinh", scm_tc7_cxr, (SCM (*)()) scm_asinh, g_asinh); double scm_asinh (x) @@ -4131,7 +4152,7 @@ scm_asinh (x) -SCM_PROC1 (s_acosh, "$acosh", scm_tc7_cxr, (SCM (*)()) scm_acosh); +SCM_GPROC1 (s_acosh, "$acosh", scm_tc7_cxr, (SCM (*)()) scm_acosh, g_acosh); double scm_acosh (x) @@ -4143,7 +4164,7 @@ scm_acosh (x) -SCM_PROC1 (s_atanh, "$atanh", scm_tc7_cxr, (SCM (*)()) scm_atanh); +SCM_GPROC1 (s_atanh, "$atanh", scm_tc7_cxr, (SCM (*)()) scm_atanh, g_atanh); double scm_atanh (x) @@ -4155,7 +4176,7 @@ scm_atanh (x) -SCM_PROC1 (s_truncate, "truncate", scm_tc7_cxr, (SCM (*)()) scm_truncate); +SCM_GPROC1 (s_truncate, "truncate", scm_tc7_cxr, (SCM (*)()) scm_truncate, g_truncate); double scm_truncate (x) @@ -4168,7 +4189,7 @@ scm_truncate (x) -SCM_PROC1 (s_round, "round", scm_tc7_cxr, (SCM (*)()) scm_round); +SCM_GPROC1 (s_round, "round", scm_tc7_cxr, (SCM (*)()) scm_round, g_round); double scm_round (x) @@ -4183,7 +4204,7 @@ scm_round (x) -SCM_PROC1 (s_exact_to_inexact, "exact->inexact", scm_tc7_cxr, (SCM (*)()) scm_exact_to_inexact); +SCM_GPROC1 (s_exact_to_inexact, "exact->inexact", scm_tc7_cxr, (SCM (*)()) scm_exact_to_inexact, g_exact_to_inexact); double scm_exact_to_inexact (z) @@ -4193,21 +4214,21 @@ scm_exact_to_inexact (z) } -SCM_PROC1 (s_i_floor, "floor", scm_tc7_cxr, (SCM (*)()) floor); -SCM_PROC1 (s_i_ceil, "ceiling", scm_tc7_cxr, (SCM (*)()) ceil); -SCM_PROC1 (s_i_sqrt, "$sqrt", scm_tc7_cxr, (SCM (*)()) sqrt); -SCM_PROC1 (s_i_abs, "$abs", scm_tc7_cxr, (SCM (*)()) fabs); -SCM_PROC1 (s_i_exp, "$exp", scm_tc7_cxr, (SCM (*)()) exp); -SCM_PROC1 (s_i_log, "$log", scm_tc7_cxr, (SCM (*)()) log); -SCM_PROC1 (s_i_sin, "$sin", scm_tc7_cxr, (SCM (*)()) sin); -SCM_PROC1 (s_i_cos, "$cos", scm_tc7_cxr, (SCM (*)()) cos); -SCM_PROC1 (s_i_tan, "$tan", scm_tc7_cxr, (SCM (*)()) tan); -SCM_PROC1 (s_i_asin, "$asin", scm_tc7_cxr, (SCM (*)()) asin); -SCM_PROC1 (s_i_acos, "$acos", scm_tc7_cxr, (SCM (*)()) acos); -SCM_PROC1 (s_i_atan, "$atan", scm_tc7_cxr, (SCM (*)()) atan); -SCM_PROC1 (s_i_sinh, "$sinh", scm_tc7_cxr, (SCM (*)()) sinh); -SCM_PROC1 (s_i_cosh, "$cosh", scm_tc7_cxr, (SCM (*)()) cosh); -SCM_PROC1 (s_i_tanh, "$tanh", scm_tc7_cxr, (SCM (*)()) tanh); +SCM_GPROC1 (s_i_floor, "floor", scm_tc7_cxr, (SCM (*)()) floor, g_i_floor); +SCM_GPROC1 (s_i_ceil, "ceiling", scm_tc7_cxr, (SCM (*)()) ceil, g_i_ceil); +SCM_GPROC1 (s_i_sqrt, "$sqrt", scm_tc7_cxr, (SCM (*)()) sqrt, g_i_sqrt); +SCM_GPROC1 (s_i_abs, "$abs", scm_tc7_cxr, (SCM (*)()) fabs, g_i_abs); +SCM_GPROC1 (s_i_exp, "$exp", scm_tc7_cxr, (SCM (*)()) exp, g_i_exp); +SCM_GPROC1 (s_i_log, "$log", scm_tc7_cxr, (SCM (*)()) log, g_i_log); +SCM_GPROC1 (s_i_sin, "$sin", scm_tc7_cxr, (SCM (*)()) sin, g_i_sin); +SCM_GPROC1 (s_i_cos, "$cos", scm_tc7_cxr, (SCM (*)()) cos, g_i_cos); +SCM_GPROC1 (s_i_tan, "$tan", scm_tc7_cxr, (SCM (*)()) tan, g_i_tan); +SCM_GPROC1 (s_i_asin, "$asin", scm_tc7_cxr, (SCM (*)()) asin, g_i_asin); +SCM_GPROC1 (s_i_acos, "$acos", scm_tc7_cxr, (SCM (*)()) acos, g_i_acos); +SCM_GPROC1 (s_i_atan, "$atan", scm_tc7_cxr, (SCM (*)()) atan, g_i_atan); +SCM_GPROC1 (s_i_sinh, "$sinh", scm_tc7_cxr, (SCM (*)()) sinh, g_i_sinh); +SCM_GPROC1 (s_i_cosh, "$cosh", scm_tc7_cxr, (SCM (*)()) cosh, g_i_cosh); +SCM_GPROC1 (s_i_tanh, "$tanh", scm_tc7_cxr, (SCM (*)()) tanh, g_i_tanh); struct dpair { @@ -4392,7 +4413,7 @@ scm_imag_part (z) -SCM_PROC (s_magnitude, "magnitude", 1, 0, 0, scm_magnitude); +SCM_GPROC (s_magnitude, "magnitude", 1, 0, 0, scm_magnitude, g_magnitude); SCM scm_magnitude (z) @@ -4408,11 +4429,12 @@ scm_magnitude (z) if (!(SCM_INEXP (z))) { badz: - scm_wta (z, (char *) SCM_ARG1, s_magnitude); + SCM_WTA_DISPATCH_1 (g_magnitude, z, SCM_ARG1, s_magnitude); } #endif #else - SCM_ASSERT (SCM_NIMP (z) && SCM_INEXP (z), z, SCM_ARG1, s_magnitude); + SCM_GASSERT1 (SCM_NIMP (z) && SCM_INEXP (z), + g_magnitude, z, SCM_ARG1, s_magnitude); #endif if (SCM_CPLXP (z)) { @@ -4425,7 +4447,7 @@ scm_magnitude (z) -SCM_PROC (s_angle, "angle", 1, 0, 0, scm_angle); +SCM_GPROC (s_angle, "angle", 1, 0, 0, scm_angle, g_angle); SCM scm_angle (z) @@ -4448,11 +4470,11 @@ scm_angle (z) if (!(SCM_INEXP (z))) { badz: - scm_wta (z, (char *) SCM_ARG1, s_angle); + SCM_WTA_DISPATCH_1 (g_angle, z, SCM_ARG1, s_angle); } #endif #else - SCM_ASSERT (SCM_NIMP (z) && SCM_INEXP (z), z, SCM_ARG1, s_angle); + SCM_GASSERT1 (SCM_NIMP (z) && SCM_INEXP (z), g_angle, z, SCM_ARG1, s_angle); #endif if (SCM_REALP (z)) { @@ -4509,13 +4531,13 @@ scm_inexact_to_exact (z) #else /* ~SCM_FLOATS */ -SCM_PROC (s_trunc, "truncate", 1, 0, 0, scm_trunc); +SCM_GPROC (s_trunc, "truncate", 1, 0, 0, scm_trunc, g_trunc); SCM scm_trunc (x) SCM x; { - SCM_ASSERT (SCM_INUMP (x), x, SCM_ARG1, s_truncate); + SCM_GASSERT2 (SCM_INUMP (x), g_trunc, x, y, SCM_ARG1, s_truncate); return x; } |