diff options
Diffstat (limited to 'libguile/numbers.c')
| -rw-r--r-- | libguile/numbers.c | 548 |
1 files changed, 264 insertions, 284 deletions
diff --git a/libguile/numbers.c b/libguile/numbers.c index 38c28a4b7..b91f4c308 100644 --- a/libguile/numbers.c +++ b/libguile/numbers.c @@ -214,7 +214,7 @@ finalize_bignum (void *ptr, void *data) { SCM bignum; - bignum = PTR2SCM (ptr); + bignum = SCM_PACK_POINTER (ptr); mpz_clear (SCM_I_BIG_MPZ (bignum)); } @@ -651,7 +651,7 @@ scm_i_from_double (double val) { SCM z; - z = PTR2SCM (scm_gc_malloc_pointerless (sizeof (scm_t_double), "real")); + z = SCM_PACK_POINTER (scm_gc_malloc_pointerless (sizeof (scm_t_double), "real")); SCM_SET_CELL_TYPE (z, scm_tc16_real); SCM_REAL_VALUE (z) = val; @@ -670,7 +670,7 @@ SCM_PRIMITIVE_GENERIC (scm_exact_p, "exact?", 1, 0, 0, else if (SCM_NUMBERP (x)) return SCM_BOOL_T; else - SCM_WTA_DISPATCH_1 (g_scm_exact_p, x, 1, s_scm_exact_p); + return scm_wta_dispatch_1 (g_scm_exact_p, x, 1, s_scm_exact_p); } #undef FUNC_NAME @@ -691,7 +691,7 @@ SCM_PRIMITIVE_GENERIC (scm_inexact_p, "inexact?", 1, 0, 0, else if (SCM_NUMBERP (x)) return SCM_BOOL_F; else - SCM_WTA_DISPATCH_1 (g_scm_inexact_p, x, 1, s_scm_inexact_p); + return scm_wta_dispatch_1 (g_scm_inexact_p, x, 1, s_scm_inexact_p); } #undef FUNC_NAME @@ -730,7 +730,7 @@ SCM_PRIMITIVE_GENERIC (scm_odd_p, "odd?", 1, 0, 0, return SCM_BOOL_F; } } - SCM_WTA_DISPATCH_1 (g_scm_odd_p, n, 1, s_scm_odd_p); + return scm_wta_dispatch_1 (g_scm_odd_p, n, 1, s_scm_odd_p); } #undef FUNC_NAME @@ -764,7 +764,7 @@ SCM_PRIMITIVE_GENERIC (scm_even_p, "even?", 1, 0, 0, return SCM_BOOL_T; } } - SCM_WTA_DISPATCH_1 (g_scm_even_p, n, 1, s_scm_even_p); + return scm_wta_dispatch_1 (g_scm_even_p, n, 1, s_scm_even_p); } #undef FUNC_NAME @@ -779,7 +779,7 @@ SCM_PRIMITIVE_GENERIC (scm_finite_p, "finite?", 1, 0, 0, else if (scm_is_real (x)) return SCM_BOOL_T; else - SCM_WTA_DISPATCH_1 (g_scm_finite_p, x, 1, s_scm_finite_p); + return scm_wta_dispatch_1 (g_scm_finite_p, x, 1, s_scm_finite_p); } #undef FUNC_NAME @@ -794,7 +794,7 @@ SCM_PRIMITIVE_GENERIC (scm_inf_p, "inf?", 1, 0, 0, else if (scm_is_real (x)) return SCM_BOOL_F; else - SCM_WTA_DISPATCH_1 (g_scm_inf_p, x, 1, s_scm_inf_p); + return scm_wta_dispatch_1 (g_scm_inf_p, x, 1, s_scm_inf_p); } #undef FUNC_NAME @@ -809,7 +809,7 @@ SCM_PRIMITIVE_GENERIC (scm_nan_p, "nan?", 1, 0, 0, else if (scm_is_real (x)) return SCM_BOOL_F; else - SCM_WTA_DISPATCH_1 (g_scm_nan_p, x, 1, s_scm_nan_p); + return scm_wta_dispatch_1 (g_scm_nan_p, x, 1, s_scm_nan_p); } #undef FUNC_NAME @@ -937,7 +937,7 @@ SCM_PRIMITIVE_GENERIC (scm_abs, "abs", 1, 0, 0, SCM_FRACTION_DENOMINATOR (x)); } else - SCM_WTA_DISPATCH_1 (g_scm_abs, x, 1, s_scm_abs); + return scm_wta_dispatch_1 (g_scm_abs, x, 1, s_scm_abs); } #undef FUNC_NAME @@ -952,10 +952,10 @@ SCM_PRIMITIVE_GENERIC (scm_quotient, "quotient", 2, 0, 0, if (SCM_LIKELY (scm_is_integer (y))) return scm_truncate_quotient (x, y); else - SCM_WTA_DISPATCH_2 (g_scm_quotient, x, y, SCM_ARG2, s_scm_quotient); + return scm_wta_dispatch_2 (g_scm_quotient, x, y, SCM_ARG2, s_scm_quotient); } else - SCM_WTA_DISPATCH_2 (g_scm_quotient, x, y, SCM_ARG1, s_scm_quotient); + return scm_wta_dispatch_2 (g_scm_quotient, x, y, SCM_ARG1, s_scm_quotient); } #undef FUNC_NAME @@ -973,10 +973,10 @@ SCM_PRIMITIVE_GENERIC (scm_remainder, "remainder", 2, 0, 0, if (SCM_LIKELY (scm_is_integer (y))) return scm_truncate_remainder (x, y); else - SCM_WTA_DISPATCH_2 (g_scm_remainder, x, y, SCM_ARG2, s_scm_remainder); + return scm_wta_dispatch_2 (g_scm_remainder, x, y, SCM_ARG2, s_scm_remainder); } else - SCM_WTA_DISPATCH_2 (g_scm_remainder, x, y, SCM_ARG1, s_scm_remainder); + return scm_wta_dispatch_2 (g_scm_remainder, x, y, SCM_ARG1, s_scm_remainder); } #undef FUNC_NAME @@ -995,10 +995,10 @@ SCM_PRIMITIVE_GENERIC (scm_modulo, "modulo", 2, 0, 0, if (SCM_LIKELY (scm_is_integer (y))) return scm_floor_remainder (x, y); else - SCM_WTA_DISPATCH_2 (g_scm_modulo, x, y, SCM_ARG2, s_scm_modulo); + return scm_wta_dispatch_2 (g_scm_modulo, x, y, SCM_ARG2, s_scm_modulo); } else - SCM_WTA_DISPATCH_2 (g_scm_modulo, x, y, SCM_ARG1, s_scm_modulo); + return scm_wta_dispatch_2 (g_scm_modulo, x, y, SCM_ARG1, s_scm_modulo); } #undef FUNC_NAME @@ -1097,10 +1097,9 @@ static void two_valued_wta_dispatch_2 (SCM gf, SCM a1, SCM a2, int pos, const char *subr, SCM *rp1, SCM *rp2) { - if (SCM_UNPACK (gf)) - scm_i_extract_values_2 (scm_call_generic_2 (gf, a1, a2), rp1, rp2); - else - scm_wrong_type_arg (subr, pos, (pos == SCM_ARG1) ? a1 : a2); + SCM vals = scm_wta_dispatch_2 (gf, a1, a2, pos, subr); + + scm_i_extract_values_2 (vals, rp1, rp2); } SCM_DEFINE (scm_euclidean_quotient, "euclidean-quotient", 2, 0, 0, @@ -1232,8 +1231,8 @@ SCM_PRIMITIVE_GENERIC (scm_floor_quotient, "floor-quotient", 2, 0, 0, else if (SCM_FRACTIONP (y)) return scm_i_exact_rational_floor_quotient (x, y); else - SCM_WTA_DISPATCH_2 (g_scm_floor_quotient, x, y, SCM_ARG2, - s_scm_floor_quotient); + return scm_wta_dispatch_2 (g_scm_floor_quotient, x, y, SCM_ARG2, + s_scm_floor_quotient); } else if (SCM_BIGP (x)) { @@ -1273,8 +1272,8 @@ SCM_PRIMITIVE_GENERIC (scm_floor_quotient, "floor-quotient", 2, 0, 0, else if (SCM_FRACTIONP (y)) return scm_i_exact_rational_floor_quotient (x, y); else - SCM_WTA_DISPATCH_2 (g_scm_floor_quotient, x, y, SCM_ARG2, - s_scm_floor_quotient); + return scm_wta_dispatch_2 (g_scm_floor_quotient, x, y, SCM_ARG2, + s_scm_floor_quotient); } else if (SCM_REALP (x)) { @@ -1283,8 +1282,8 @@ SCM_PRIMITIVE_GENERIC (scm_floor_quotient, "floor-quotient", 2, 0, 0, return scm_i_inexact_floor_quotient (SCM_REAL_VALUE (x), scm_to_double (y)); else - SCM_WTA_DISPATCH_2 (g_scm_floor_quotient, x, y, SCM_ARG2, - s_scm_floor_quotient); + return scm_wta_dispatch_2 (g_scm_floor_quotient, x, y, SCM_ARG2, + s_scm_floor_quotient); } else if (SCM_FRACTIONP (x)) { @@ -1294,12 +1293,12 @@ SCM_PRIMITIVE_GENERIC (scm_floor_quotient, "floor-quotient", 2, 0, 0, else if (SCM_I_INUMP (y) || SCM_BIGP (y) || SCM_FRACTIONP (y)) return scm_i_exact_rational_floor_quotient (x, y); else - SCM_WTA_DISPATCH_2 (g_scm_floor_quotient, x, y, SCM_ARG2, - s_scm_floor_quotient); + return scm_wta_dispatch_2 (g_scm_floor_quotient, x, y, SCM_ARG2, + s_scm_floor_quotient); } else - SCM_WTA_DISPATCH_2 (g_scm_floor_quotient, x, y, SCM_ARG1, - s_scm_floor_quotient); + return scm_wta_dispatch_2 (g_scm_floor_quotient, x, y, SCM_ARG1, + s_scm_floor_quotient); } #undef FUNC_NAME @@ -1392,8 +1391,8 @@ SCM_PRIMITIVE_GENERIC (scm_floor_remainder, "floor-remainder", 2, 0, 0, else if (SCM_FRACTIONP (y)) return scm_i_exact_rational_floor_remainder (x, y); else - SCM_WTA_DISPATCH_2 (g_scm_floor_remainder, x, y, SCM_ARG2, - s_scm_floor_remainder); + return scm_wta_dispatch_2 (g_scm_floor_remainder, x, y, SCM_ARG2, + s_scm_floor_remainder); } else if (SCM_BIGP (x)) { @@ -1428,8 +1427,8 @@ SCM_PRIMITIVE_GENERIC (scm_floor_remainder, "floor-remainder", 2, 0, 0, else if (SCM_FRACTIONP (y)) return scm_i_exact_rational_floor_remainder (x, y); else - SCM_WTA_DISPATCH_2 (g_scm_floor_remainder, x, y, SCM_ARG2, - s_scm_floor_remainder); + return scm_wta_dispatch_2 (g_scm_floor_remainder, x, y, SCM_ARG2, + s_scm_floor_remainder); } else if (SCM_REALP (x)) { @@ -1438,8 +1437,8 @@ SCM_PRIMITIVE_GENERIC (scm_floor_remainder, "floor-remainder", 2, 0, 0, return scm_i_inexact_floor_remainder (SCM_REAL_VALUE (x), scm_to_double (y)); else - SCM_WTA_DISPATCH_2 (g_scm_floor_remainder, x, y, SCM_ARG2, - s_scm_floor_remainder); + return scm_wta_dispatch_2 (g_scm_floor_remainder, x, y, SCM_ARG2, + s_scm_floor_remainder); } else if (SCM_FRACTIONP (x)) { @@ -1449,12 +1448,12 @@ SCM_PRIMITIVE_GENERIC (scm_floor_remainder, "floor-remainder", 2, 0, 0, else if (SCM_I_INUMP (y) || SCM_BIGP (y) || SCM_FRACTIONP (y)) return scm_i_exact_rational_floor_remainder (x, y); else - SCM_WTA_DISPATCH_2 (g_scm_floor_remainder, x, y, SCM_ARG2, - s_scm_floor_remainder); + return scm_wta_dispatch_2 (g_scm_floor_remainder, x, y, SCM_ARG2, + s_scm_floor_remainder); } else - SCM_WTA_DISPATCH_2 (g_scm_floor_remainder, x, y, SCM_ARG1, - s_scm_floor_remainder); + return scm_wta_dispatch_2 (g_scm_floor_remainder, x, y, SCM_ARG1, + s_scm_floor_remainder); } #undef FUNC_NAME @@ -1765,8 +1764,8 @@ SCM_PRIMITIVE_GENERIC (scm_ceiling_quotient, "ceiling-quotient", 2, 0, 0, else if (SCM_FRACTIONP (y)) return scm_i_exact_rational_ceiling_quotient (x, y); else - SCM_WTA_DISPATCH_2 (g_scm_ceiling_quotient, x, y, SCM_ARG2, - s_scm_ceiling_quotient); + return scm_wta_dispatch_2 (g_scm_ceiling_quotient, x, y, SCM_ARG2, + s_scm_ceiling_quotient); } else if (SCM_BIGP (x)) { @@ -1806,8 +1805,8 @@ SCM_PRIMITIVE_GENERIC (scm_ceiling_quotient, "ceiling-quotient", 2, 0, 0, else if (SCM_FRACTIONP (y)) return scm_i_exact_rational_ceiling_quotient (x, y); else - SCM_WTA_DISPATCH_2 (g_scm_ceiling_quotient, x, y, SCM_ARG2, - s_scm_ceiling_quotient); + return scm_wta_dispatch_2 (g_scm_ceiling_quotient, x, y, SCM_ARG2, + s_scm_ceiling_quotient); } else if (SCM_REALP (x)) { @@ -1816,8 +1815,8 @@ SCM_PRIMITIVE_GENERIC (scm_ceiling_quotient, "ceiling-quotient", 2, 0, 0, return scm_i_inexact_ceiling_quotient (SCM_REAL_VALUE (x), scm_to_double (y)); else - SCM_WTA_DISPATCH_2 (g_scm_ceiling_quotient, x, y, SCM_ARG2, - s_scm_ceiling_quotient); + return scm_wta_dispatch_2 (g_scm_ceiling_quotient, x, y, SCM_ARG2, + s_scm_ceiling_quotient); } else if (SCM_FRACTIONP (x)) { @@ -1827,12 +1826,12 @@ SCM_PRIMITIVE_GENERIC (scm_ceiling_quotient, "ceiling-quotient", 2, 0, 0, else if (SCM_I_INUMP (y) || SCM_BIGP (y) || SCM_FRACTIONP (y)) return scm_i_exact_rational_ceiling_quotient (x, y); else - SCM_WTA_DISPATCH_2 (g_scm_ceiling_quotient, x, y, SCM_ARG2, - s_scm_ceiling_quotient); + return scm_wta_dispatch_2 (g_scm_ceiling_quotient, x, y, SCM_ARG2, + s_scm_ceiling_quotient); } else - SCM_WTA_DISPATCH_2 (g_scm_ceiling_quotient, x, y, SCM_ARG1, - s_scm_ceiling_quotient); + return scm_wta_dispatch_2 (g_scm_ceiling_quotient, x, y, SCM_ARG1, + s_scm_ceiling_quotient); } #undef FUNC_NAME @@ -1935,8 +1934,8 @@ SCM_PRIMITIVE_GENERIC (scm_ceiling_remainder, "ceiling-remainder", 2, 0, 0, else if (SCM_FRACTIONP (y)) return scm_i_exact_rational_ceiling_remainder (x, y); else - SCM_WTA_DISPATCH_2 (g_scm_ceiling_remainder, x, y, SCM_ARG2, - s_scm_ceiling_remainder); + return scm_wta_dispatch_2 (g_scm_ceiling_remainder, x, y, SCM_ARG2, + s_scm_ceiling_remainder); } else if (SCM_BIGP (x)) { @@ -1971,8 +1970,8 @@ SCM_PRIMITIVE_GENERIC (scm_ceiling_remainder, "ceiling-remainder", 2, 0, 0, else if (SCM_FRACTIONP (y)) return scm_i_exact_rational_ceiling_remainder (x, y); else - SCM_WTA_DISPATCH_2 (g_scm_ceiling_remainder, x, y, SCM_ARG2, - s_scm_ceiling_remainder); + return scm_wta_dispatch_2 (g_scm_ceiling_remainder, x, y, SCM_ARG2, + s_scm_ceiling_remainder); } else if (SCM_REALP (x)) { @@ -1981,8 +1980,8 @@ SCM_PRIMITIVE_GENERIC (scm_ceiling_remainder, "ceiling-remainder", 2, 0, 0, return scm_i_inexact_ceiling_remainder (SCM_REAL_VALUE (x), scm_to_double (y)); else - SCM_WTA_DISPATCH_2 (g_scm_ceiling_remainder, x, y, SCM_ARG2, - s_scm_ceiling_remainder); + return scm_wta_dispatch_2 (g_scm_ceiling_remainder, x, y, SCM_ARG2, + s_scm_ceiling_remainder); } else if (SCM_FRACTIONP (x)) { @@ -1992,12 +1991,12 @@ SCM_PRIMITIVE_GENERIC (scm_ceiling_remainder, "ceiling-remainder", 2, 0, 0, else if (SCM_I_INUMP (y) || SCM_BIGP (y) || SCM_FRACTIONP (y)) return scm_i_exact_rational_ceiling_remainder (x, y); else - SCM_WTA_DISPATCH_2 (g_scm_ceiling_remainder, x, y, SCM_ARG2, - s_scm_ceiling_remainder); + return scm_wta_dispatch_2 (g_scm_ceiling_remainder, x, y, SCM_ARG2, + s_scm_ceiling_remainder); } else - SCM_WTA_DISPATCH_2 (g_scm_ceiling_remainder, x, y, SCM_ARG1, - s_scm_ceiling_remainder); + return scm_wta_dispatch_2 (g_scm_ceiling_remainder, x, y, SCM_ARG1, + s_scm_ceiling_remainder); } #undef FUNC_NAME @@ -2297,8 +2296,8 @@ SCM_PRIMITIVE_GENERIC (scm_truncate_quotient, "truncate-quotient", 2, 0, 0, else if (SCM_FRACTIONP (y)) return scm_i_exact_rational_truncate_quotient (x, y); else - SCM_WTA_DISPATCH_2 (g_scm_truncate_quotient, x, y, SCM_ARG2, - s_scm_truncate_quotient); + return scm_wta_dispatch_2 (g_scm_truncate_quotient, x, y, SCM_ARG2, + s_scm_truncate_quotient); } else if (SCM_BIGP (x)) { @@ -2338,8 +2337,8 @@ SCM_PRIMITIVE_GENERIC (scm_truncate_quotient, "truncate-quotient", 2, 0, 0, else if (SCM_FRACTIONP (y)) return scm_i_exact_rational_truncate_quotient (x, y); else - SCM_WTA_DISPATCH_2 (g_scm_truncate_quotient, x, y, SCM_ARG2, - s_scm_truncate_quotient); + return scm_wta_dispatch_2 (g_scm_truncate_quotient, x, y, SCM_ARG2, + s_scm_truncate_quotient); } else if (SCM_REALP (x)) { @@ -2348,8 +2347,8 @@ SCM_PRIMITIVE_GENERIC (scm_truncate_quotient, "truncate-quotient", 2, 0, 0, return scm_i_inexact_truncate_quotient (SCM_REAL_VALUE (x), scm_to_double (y)); else - SCM_WTA_DISPATCH_2 (g_scm_truncate_quotient, x, y, SCM_ARG2, - s_scm_truncate_quotient); + return scm_wta_dispatch_2 (g_scm_truncate_quotient, x, y, SCM_ARG2, + s_scm_truncate_quotient); } else if (SCM_FRACTIONP (x)) { @@ -2359,12 +2358,12 @@ SCM_PRIMITIVE_GENERIC (scm_truncate_quotient, "truncate-quotient", 2, 0, 0, else if (SCM_I_INUMP (y) || SCM_BIGP (y) || SCM_FRACTIONP (y)) return scm_i_exact_rational_truncate_quotient (x, y); else - SCM_WTA_DISPATCH_2 (g_scm_truncate_quotient, x, y, SCM_ARG2, - s_scm_truncate_quotient); + return scm_wta_dispatch_2 (g_scm_truncate_quotient, x, y, SCM_ARG2, + s_scm_truncate_quotient); } else - SCM_WTA_DISPATCH_2 (g_scm_truncate_quotient, x, y, SCM_ARG1, - s_scm_truncate_quotient); + return scm_wta_dispatch_2 (g_scm_truncate_quotient, x, y, SCM_ARG1, + s_scm_truncate_quotient); } #undef FUNC_NAME @@ -2432,8 +2431,8 @@ SCM_PRIMITIVE_GENERIC (scm_truncate_remainder, "truncate-remainder", 2, 0, 0, else if (SCM_FRACTIONP (y)) return scm_i_exact_rational_truncate_remainder (x, y); else - SCM_WTA_DISPATCH_2 (g_scm_truncate_remainder, x, y, SCM_ARG2, - s_scm_truncate_remainder); + return scm_wta_dispatch_2 (g_scm_truncate_remainder, x, y, SCM_ARG2, + s_scm_truncate_remainder); } else if (SCM_BIGP (x)) { @@ -2466,8 +2465,8 @@ SCM_PRIMITIVE_GENERIC (scm_truncate_remainder, "truncate-remainder", 2, 0, 0, else if (SCM_FRACTIONP (y)) return scm_i_exact_rational_truncate_remainder (x, y); else - SCM_WTA_DISPATCH_2 (g_scm_truncate_remainder, x, y, SCM_ARG2, - s_scm_truncate_remainder); + return scm_wta_dispatch_2 (g_scm_truncate_remainder, x, y, SCM_ARG2, + s_scm_truncate_remainder); } else if (SCM_REALP (x)) { @@ -2476,8 +2475,8 @@ SCM_PRIMITIVE_GENERIC (scm_truncate_remainder, "truncate-remainder", 2, 0, 0, return scm_i_inexact_truncate_remainder (SCM_REAL_VALUE (x), scm_to_double (y)); else - SCM_WTA_DISPATCH_2 (g_scm_truncate_remainder, x, y, SCM_ARG2, - s_scm_truncate_remainder); + return scm_wta_dispatch_2 (g_scm_truncate_remainder, x, y, SCM_ARG2, + s_scm_truncate_remainder); } else if (SCM_FRACTIONP (x)) { @@ -2487,12 +2486,12 @@ SCM_PRIMITIVE_GENERIC (scm_truncate_remainder, "truncate-remainder", 2, 0, 0, else if (SCM_I_INUMP (y) || SCM_BIGP (y) || SCM_FRACTIONP (y)) return scm_i_exact_rational_truncate_remainder (x, y); else - SCM_WTA_DISPATCH_2 (g_scm_truncate_remainder, x, y, SCM_ARG2, - s_scm_truncate_remainder); + return scm_wta_dispatch_2 (g_scm_truncate_remainder, x, y, SCM_ARG2, + s_scm_truncate_remainder); } else - SCM_WTA_DISPATCH_2 (g_scm_truncate_remainder, x, y, SCM_ARG1, - s_scm_truncate_remainder); + return scm_wta_dispatch_2 (g_scm_truncate_remainder, x, y, SCM_ARG1, + s_scm_truncate_remainder); } #undef FUNC_NAME @@ -2779,8 +2778,8 @@ SCM_PRIMITIVE_GENERIC (scm_centered_quotient, "centered-quotient", 2, 0, 0, else if (SCM_FRACTIONP (y)) return scm_i_exact_rational_centered_quotient (x, y); else - SCM_WTA_DISPATCH_2 (g_scm_centered_quotient, x, y, SCM_ARG2, - s_scm_centered_quotient); + return scm_wta_dispatch_2 (g_scm_centered_quotient, x, y, SCM_ARG2, + s_scm_centered_quotient); } else if (SCM_BIGP (x)) { @@ -2828,8 +2827,8 @@ SCM_PRIMITIVE_GENERIC (scm_centered_quotient, "centered-quotient", 2, 0, 0, else if (SCM_FRACTIONP (y)) return scm_i_exact_rational_centered_quotient (x, y); else - SCM_WTA_DISPATCH_2 (g_scm_centered_quotient, x, y, SCM_ARG2, - s_scm_centered_quotient); + return scm_wta_dispatch_2 (g_scm_centered_quotient, x, y, SCM_ARG2, + s_scm_centered_quotient); } else if (SCM_REALP (x)) { @@ -2838,8 +2837,8 @@ SCM_PRIMITIVE_GENERIC (scm_centered_quotient, "centered-quotient", 2, 0, 0, return scm_i_inexact_centered_quotient (SCM_REAL_VALUE (x), scm_to_double (y)); else - SCM_WTA_DISPATCH_2 (g_scm_centered_quotient, x, y, SCM_ARG2, - s_scm_centered_quotient); + return scm_wta_dispatch_2 (g_scm_centered_quotient, x, y, SCM_ARG2, + s_scm_centered_quotient); } else if (SCM_FRACTIONP (x)) { @@ -2849,12 +2848,12 @@ SCM_PRIMITIVE_GENERIC (scm_centered_quotient, "centered-quotient", 2, 0, 0, else if (SCM_I_INUMP (y) || SCM_BIGP (y) || SCM_FRACTIONP (y)) return scm_i_exact_rational_centered_quotient (x, y); else - SCM_WTA_DISPATCH_2 (g_scm_centered_quotient, x, y, SCM_ARG2, - s_scm_centered_quotient); + return scm_wta_dispatch_2 (g_scm_centered_quotient, x, y, SCM_ARG2, + s_scm_centered_quotient); } else - SCM_WTA_DISPATCH_2 (g_scm_centered_quotient, x, y, SCM_ARG1, - s_scm_centered_quotient); + return scm_wta_dispatch_2 (g_scm_centered_quotient, x, y, SCM_ARG1, + s_scm_centered_quotient); } #undef FUNC_NAME @@ -2993,8 +2992,8 @@ SCM_PRIMITIVE_GENERIC (scm_centered_remainder, "centered-remainder", 2, 0, 0, else if (SCM_FRACTIONP (y)) return scm_i_exact_rational_centered_remainder (x, y); else - SCM_WTA_DISPATCH_2 (g_scm_centered_remainder, x, y, SCM_ARG2, - s_scm_centered_remainder); + return scm_wta_dispatch_2 (g_scm_centered_remainder, x, y, SCM_ARG2, + s_scm_centered_remainder); } else if (SCM_BIGP (x)) { @@ -3034,8 +3033,8 @@ SCM_PRIMITIVE_GENERIC (scm_centered_remainder, "centered-remainder", 2, 0, 0, else if (SCM_FRACTIONP (y)) return scm_i_exact_rational_centered_remainder (x, y); else - SCM_WTA_DISPATCH_2 (g_scm_centered_remainder, x, y, SCM_ARG2, - s_scm_centered_remainder); + return scm_wta_dispatch_2 (g_scm_centered_remainder, x, y, SCM_ARG2, + s_scm_centered_remainder); } else if (SCM_REALP (x)) { @@ -3044,8 +3043,8 @@ SCM_PRIMITIVE_GENERIC (scm_centered_remainder, "centered-remainder", 2, 0, 0, return scm_i_inexact_centered_remainder (SCM_REAL_VALUE (x), scm_to_double (y)); else - SCM_WTA_DISPATCH_2 (g_scm_centered_remainder, x, y, SCM_ARG2, - s_scm_centered_remainder); + return scm_wta_dispatch_2 (g_scm_centered_remainder, x, y, SCM_ARG2, + s_scm_centered_remainder); } else if (SCM_FRACTIONP (x)) { @@ -3055,12 +3054,12 @@ SCM_PRIMITIVE_GENERIC (scm_centered_remainder, "centered-remainder", 2, 0, 0, else if (SCM_I_INUMP (y) || SCM_BIGP (y) || SCM_FRACTIONP (y)) return scm_i_exact_rational_centered_remainder (x, y); else - SCM_WTA_DISPATCH_2 (g_scm_centered_remainder, x, y, SCM_ARG2, - s_scm_centered_remainder); + return scm_wta_dispatch_2 (g_scm_centered_remainder, x, y, SCM_ARG2, + s_scm_centered_remainder); } else - SCM_WTA_DISPATCH_2 (g_scm_centered_remainder, x, y, SCM_ARG1, - s_scm_centered_remainder); + return scm_wta_dispatch_2 (g_scm_centered_remainder, x, y, SCM_ARG1, + s_scm_centered_remainder); } #undef FUNC_NAME @@ -3475,8 +3474,8 @@ SCM_PRIMITIVE_GENERIC (scm_round_quotient, "round-quotient", 2, 0, 0, else if (SCM_FRACTIONP (y)) return scm_i_exact_rational_round_quotient (x, y); else - SCM_WTA_DISPATCH_2 (g_scm_round_quotient, x, y, SCM_ARG2, - s_scm_round_quotient); + return scm_wta_dispatch_2 (g_scm_round_quotient, x, y, SCM_ARG2, + s_scm_round_quotient); } else if (SCM_BIGP (x)) { @@ -3526,8 +3525,8 @@ SCM_PRIMITIVE_GENERIC (scm_round_quotient, "round-quotient", 2, 0, 0, else if (SCM_FRACTIONP (y)) return scm_i_exact_rational_round_quotient (x, y); else - SCM_WTA_DISPATCH_2 (g_scm_round_quotient, x, y, SCM_ARG2, - s_scm_round_quotient); + return scm_wta_dispatch_2 (g_scm_round_quotient, x, y, SCM_ARG2, + s_scm_round_quotient); } else if (SCM_REALP (x)) { @@ -3536,8 +3535,8 @@ SCM_PRIMITIVE_GENERIC (scm_round_quotient, "round-quotient", 2, 0, 0, return scm_i_inexact_round_quotient (SCM_REAL_VALUE (x), scm_to_double (y)); else - SCM_WTA_DISPATCH_2 (g_scm_round_quotient, x, y, SCM_ARG2, - s_scm_round_quotient); + return scm_wta_dispatch_2 (g_scm_round_quotient, x, y, SCM_ARG2, + s_scm_round_quotient); } else if (SCM_FRACTIONP (x)) { @@ -3547,12 +3546,12 @@ SCM_PRIMITIVE_GENERIC (scm_round_quotient, "round-quotient", 2, 0, 0, else if (SCM_I_INUMP (y) || SCM_BIGP (y) || SCM_FRACTIONP (y)) return scm_i_exact_rational_round_quotient (x, y); else - SCM_WTA_DISPATCH_2 (g_scm_round_quotient, x, y, SCM_ARG2, - s_scm_round_quotient); + return scm_wta_dispatch_2 (g_scm_round_quotient, x, y, SCM_ARG2, + s_scm_round_quotient); } else - SCM_WTA_DISPATCH_2 (g_scm_round_quotient, x, y, SCM_ARG1, - s_scm_round_quotient); + return scm_wta_dispatch_2 (g_scm_round_quotient, x, y, SCM_ARG1, + s_scm_round_quotient); } #undef FUNC_NAME @@ -3679,8 +3678,8 @@ SCM_PRIMITIVE_GENERIC (scm_round_remainder, "round-remainder", 2, 0, 0, else if (SCM_FRACTIONP (y)) return scm_i_exact_rational_round_remainder (x, y); else - SCM_WTA_DISPATCH_2 (g_scm_round_remainder, x, y, SCM_ARG2, - s_scm_round_remainder); + return scm_wta_dispatch_2 (g_scm_round_remainder, x, y, SCM_ARG2, + s_scm_round_remainder); } else if (SCM_BIGP (x)) { @@ -3727,8 +3726,8 @@ SCM_PRIMITIVE_GENERIC (scm_round_remainder, "round-remainder", 2, 0, 0, else if (SCM_FRACTIONP (y)) return scm_i_exact_rational_round_remainder (x, y); else - SCM_WTA_DISPATCH_2 (g_scm_round_remainder, x, y, SCM_ARG2, - s_scm_round_remainder); + return scm_wta_dispatch_2 (g_scm_round_remainder, x, y, SCM_ARG2, + s_scm_round_remainder); } else if (SCM_REALP (x)) { @@ -3737,8 +3736,8 @@ SCM_PRIMITIVE_GENERIC (scm_round_remainder, "round-remainder", 2, 0, 0, return scm_i_inexact_round_remainder (SCM_REAL_VALUE (x), scm_to_double (y)); else - SCM_WTA_DISPATCH_2 (g_scm_round_remainder, x, y, SCM_ARG2, - s_scm_round_remainder); + return scm_wta_dispatch_2 (g_scm_round_remainder, x, y, SCM_ARG2, + s_scm_round_remainder); } else if (SCM_FRACTIONP (x)) { @@ -3748,12 +3747,12 @@ SCM_PRIMITIVE_GENERIC (scm_round_remainder, "round-remainder", 2, 0, 0, else if (SCM_I_INUMP (y) || SCM_BIGP (y) || SCM_FRACTIONP (y)) return scm_i_exact_rational_round_remainder (x, y); else - SCM_WTA_DISPATCH_2 (g_scm_round_remainder, x, y, SCM_ARG2, - s_scm_round_remainder); + return scm_wta_dispatch_2 (g_scm_round_remainder, x, y, SCM_ARG2, + s_scm_round_remainder); } else - SCM_WTA_DISPATCH_2 (g_scm_round_remainder, x, y, SCM_ARG1, - s_scm_round_remainder); + return scm_wta_dispatch_2 (g_scm_round_remainder, x, y, SCM_ARG1, + s_scm_round_remainder); } #undef FUNC_NAME @@ -4145,7 +4144,7 @@ scm_gcd (SCM x, SCM y) else if (SCM_REALP (y) && scm_is_integer (y)) goto handle_inexacts; else - SCM_WTA_DISPATCH_2 (g_gcd, x, y, SCM_ARG2, s_gcd); + return scm_wta_dispatch_2 (g_gcd, x, y, SCM_ARG2, s_gcd); } else if (SCM_BIGP (x)) { @@ -4177,7 +4176,7 @@ scm_gcd (SCM x, SCM y) else if (SCM_REALP (y) && scm_is_integer (y)) goto handle_inexacts; else - SCM_WTA_DISPATCH_2 (g_gcd, x, y, SCM_ARG2, s_gcd); + return scm_wta_dispatch_2 (g_gcd, x, y, SCM_ARG2, s_gcd); } else if (SCM_REALP (x) && scm_is_integer (x)) { @@ -4189,10 +4188,10 @@ scm_gcd (SCM x, SCM y) scm_inexact_to_exact (y))); } else - SCM_WTA_DISPATCH_2 (g_gcd, x, y, SCM_ARG2, s_gcd); + return scm_wta_dispatch_2 (g_gcd, x, y, SCM_ARG2, s_gcd); } else - SCM_WTA_DISPATCH_2 (g_gcd, x, y, SCM_ARG1, s_gcd); + return scm_wta_dispatch_2 (g_gcd, x, y, SCM_ARG1, s_gcd); } SCM_PRIMITIVE_GENERIC (scm_i_lcm, "lcm", 0, 2, 1, @@ -4246,7 +4245,7 @@ scm_lcm (SCM n1, SCM n2) else if (SCM_REALP (n2) && scm_is_integer (n2)) goto handle_inexacts; else - SCM_WTA_DISPATCH_2 (g_lcm, n1, n2, SCM_ARG2, s_lcm); + return scm_wta_dispatch_2 (g_lcm, n1, n2, SCM_ARG2, s_lcm); } else if (SCM_LIKELY (SCM_BIGP (n1))) { @@ -4269,7 +4268,7 @@ scm_lcm (SCM n1, SCM n2) else if (SCM_REALP (n2) && scm_is_integer (n2)) goto handle_inexacts; else - SCM_WTA_DISPATCH_2 (g_lcm, n1, n2, SCM_ARG2, s_lcm); + return scm_wta_dispatch_2 (g_lcm, n1, n2, SCM_ARG2, s_lcm); } else if (SCM_REALP (n1) && scm_is_integer (n1)) { @@ -4281,10 +4280,10 @@ scm_lcm (SCM n1, SCM n2) scm_inexact_to_exact (n2))); } else - SCM_WTA_DISPATCH_2 (g_lcm, n1, n2, SCM_ARG2, s_lcm); + return scm_wta_dispatch_2 (g_lcm, n1, n2, SCM_ARG2, s_lcm); } else - SCM_WTA_DISPATCH_2 (g_lcm, n1, n2, SCM_ARG1, s_lcm); + return scm_wta_dispatch_2 (g_lcm, n1, n2, SCM_ARG1, s_lcm); } /* Emulating 2's complement bignums with sign magnitude arithmetic: @@ -5687,7 +5686,7 @@ int scm_print_real (SCM sexp, SCM port, scm_print_state *pstate SCM_UNUSED) { char num_buf[FLOBUFLEN]; - scm_lfwrite (num_buf, iflo2str (sexp, num_buf, 10), port); + scm_lfwrite_unlocked (num_buf, iflo2str (sexp, num_buf, 10), port); return !0; } @@ -5695,7 +5694,7 @@ void scm_i_print_double (double val, SCM port) { char num_buf[FLOBUFLEN]; - scm_lfwrite (num_buf, idbl2str (val, num_buf, 10), port); + scm_lfwrite_unlocked (num_buf, idbl2str (val, num_buf, 10), port); } int @@ -5703,7 +5702,7 @@ scm_print_complex (SCM sexp, SCM port, scm_print_state *pstate SCM_UNUSED) { char num_buf[FLOBUFLEN]; - scm_lfwrite (num_buf, iflo2str (sexp, num_buf, 10), port); + scm_lfwrite_unlocked (num_buf, iflo2str (sexp, num_buf, 10), port); return !0; } @@ -5711,7 +5710,7 @@ void scm_i_print_complex (double real, double imag, SCM port) { char num_buf[FLOBUFLEN]; - scm_lfwrite (num_buf, icmplx2str (real, imag, num_buf, 10), port); + scm_lfwrite_unlocked (num_buf, icmplx2str (real, imag, num_buf, 10), port); } int @@ -5732,7 +5731,7 @@ scm_bigprint (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED) void (*freefunc) (void *, size_t); mp_get_memory_functions (NULL, NULL, &freefunc); scm_remember_upto_here_1 (exp); - scm_lfwrite (str, len, port); + scm_lfwrite_unlocked (str, len, port); freefunc (str, len + 1); return !0; } @@ -5802,20 +5801,25 @@ enum t_exactness {NO_EXACTNESS, INEXACT, EXACT}; static unsigned int char_decimal_value (scm_t_uint32 c) { - /* uc_decimal_value returns -1 on error. When cast to an unsigned int, - that's certainly above any valid decimal, so we take advantage of - that to elide some tests. */ - unsigned int d = (unsigned int) uc_decimal_value (c); - - /* If that failed, try extended hexadecimals, then. Only accept ascii - hexadecimals. */ - if (d >= 10U) + if (c >= (scm_t_uint32) '0' && c <= (scm_t_uint32) '9') + return c - (scm_t_uint32) '0'; + else { - c = uc_tolower (c); - if (c >= (scm_t_uint32) 'a') - d = c - (scm_t_uint32)'a' + 10U; + /* uc_decimal_value returns -1 on error. When cast to an unsigned int, + that's certainly above any valid decimal, so we take advantage of + that to elide some tests. */ + unsigned int d = (unsigned int) uc_decimal_value (c); + + /* If that failed, try extended hexadecimals, then. Only accept ascii + hexadecimals. */ + if (d >= 10U) + { + c = uc_tolower (c); + if (c >= (scm_t_uint32) 'a') + d = c - (scm_t_uint32)'a' + 10U; + } + return d; } - return d; } /* Parse the substring of MEM starting at *P_IDX for an unsigned integer @@ -6601,7 +6605,8 @@ scm_num_eq_p (SCM x, SCM y) else if (SCM_FRACTIONP (y)) return SCM_BOOL_F; else - SCM_WTA_DISPATCH_2 (g_scm_i_num_eq_p, x, y, SCM_ARGn, s_scm_i_num_eq_p); + return scm_wta_dispatch_2 (g_scm_i_num_eq_p, x, y, SCM_ARGn, + s_scm_i_num_eq_p); } else if (SCM_BIGP (x)) { @@ -6636,7 +6641,8 @@ scm_num_eq_p (SCM x, SCM y) else if (SCM_FRACTIONP (y)) return SCM_BOOL_F; else - SCM_WTA_DISPATCH_2 (g_scm_i_num_eq_p, x, y, SCM_ARGn, s_scm_i_num_eq_p); + return scm_wta_dispatch_2 (g_scm_i_num_eq_p, x, y, SCM_ARGn, + s_scm_i_num_eq_p); } else if (SCM_REALP (x)) { @@ -6671,7 +6677,8 @@ scm_num_eq_p (SCM x, SCM y) goto again; } else - SCM_WTA_DISPATCH_2 (g_scm_i_num_eq_p, x, y, SCM_ARGn, s_scm_i_num_eq_p); + return scm_wta_dispatch_2 (g_scm_i_num_eq_p, x, y, SCM_ARGn, + s_scm_i_num_eq_p); } else if (SCM_COMPLEXP (x)) { @@ -6714,7 +6721,8 @@ scm_num_eq_p (SCM x, SCM y) goto again; } else - SCM_WTA_DISPATCH_2 (g_scm_i_num_eq_p, x, y, SCM_ARGn, s_scm_i_num_eq_p); + return scm_wta_dispatch_2 (g_scm_i_num_eq_p, x, y, SCM_ARGn, + s_scm_i_num_eq_p); } else if (SCM_FRACTIONP (x)) { @@ -6744,10 +6752,12 @@ scm_num_eq_p (SCM x, SCM y) else if (SCM_FRACTIONP (y)) return scm_i_fraction_equalp (x, y); else - SCM_WTA_DISPATCH_2 (g_scm_i_num_eq_p, x, y, SCM_ARGn, s_scm_i_num_eq_p); + return scm_wta_dispatch_2 (g_scm_i_num_eq_p, x, y, SCM_ARGn, + s_scm_i_num_eq_p); } else - SCM_WTA_DISPATCH_2 (g_scm_i_num_eq_p, x, y, SCM_ARG1, s_scm_i_num_eq_p); + return scm_wta_dispatch_2 (g_scm_i_num_eq_p, x, y, SCM_ARG1, + s_scm_i_num_eq_p); } @@ -6824,7 +6834,8 @@ scm_less_p (SCM x, SCM y) goto again; } else - SCM_WTA_DISPATCH_2 (g_scm_i_num_less_p, x, y, SCM_ARGn, s_scm_i_num_less_p); + return scm_wta_dispatch_2 (g_scm_i_num_less_p, x, y, SCM_ARGn, + s_scm_i_num_less_p); } else if (SCM_BIGP (x)) { @@ -6852,7 +6863,8 @@ scm_less_p (SCM x, SCM y) else if (SCM_FRACTIONP (y)) goto int_frac; else - SCM_WTA_DISPATCH_2 (g_scm_i_num_less_p, x, y, SCM_ARGn, s_scm_i_num_less_p); + return scm_wta_dispatch_2 (g_scm_i_num_less_p, x, y, SCM_ARGn, + s_scm_i_num_less_p); } else if (SCM_REALP (x)) { @@ -6898,7 +6910,8 @@ scm_less_p (SCM x, SCM y) goto again; } else - SCM_WTA_DISPATCH_2 (g_scm_i_num_less_p, x, y, SCM_ARGn, s_scm_i_num_less_p); + return scm_wta_dispatch_2 (g_scm_i_num_less_p, x, y, SCM_ARGn, + s_scm_i_num_less_p); } else if (SCM_FRACTIONP (x)) { @@ -6931,10 +6944,12 @@ scm_less_p (SCM x, SCM y) goto again; } else - SCM_WTA_DISPATCH_2 (g_scm_i_num_less_p, x, y, SCM_ARGn, s_scm_i_num_less_p); + return scm_wta_dispatch_2 (g_scm_i_num_less_p, x, y, SCM_ARGn, + s_scm_i_num_less_p); } else - SCM_WTA_DISPATCH_2 (g_scm_i_num_less_p, x, y, SCM_ARG1, s_scm_i_num_less_p); + return scm_wta_dispatch_2 (g_scm_i_num_less_p, x, y, SCM_ARG1, + s_scm_i_num_less_p); } @@ -6963,9 +6978,9 @@ SCM scm_gr_p (SCM x, SCM y) { if (!SCM_NUMBERP (x)) - SCM_WTA_DISPATCH_2 (g_scm_i_num_gr_p, x, y, SCM_ARG1, FUNC_NAME); + return scm_wta_dispatch_2 (g_scm_i_num_gr_p, x, y, SCM_ARG1, FUNC_NAME); else if (!SCM_NUMBERP (y)) - SCM_WTA_DISPATCH_2 (g_scm_i_num_gr_p, x, y, SCM_ARG2, FUNC_NAME); + return scm_wta_dispatch_2 (g_scm_i_num_gr_p, x, y, SCM_ARG2, FUNC_NAME); else return scm_less_p (y, x); } @@ -6997,9 +7012,9 @@ SCM scm_leq_p (SCM x, SCM y) { if (!SCM_NUMBERP (x)) - SCM_WTA_DISPATCH_2 (g_scm_i_num_leq_p, x, y, SCM_ARG1, FUNC_NAME); + return scm_wta_dispatch_2 (g_scm_i_num_leq_p, x, y, SCM_ARG1, FUNC_NAME); else if (!SCM_NUMBERP (y)) - SCM_WTA_DISPATCH_2 (g_scm_i_num_leq_p, x, y, SCM_ARG2, FUNC_NAME); + return scm_wta_dispatch_2 (g_scm_i_num_leq_p, x, y, SCM_ARG2, FUNC_NAME); else if (scm_is_true (scm_nan_p (x)) || scm_is_true (scm_nan_p (y))) return SCM_BOOL_F; else @@ -7033,9 +7048,9 @@ SCM scm_geq_p (SCM x, SCM y) { if (!SCM_NUMBERP (x)) - SCM_WTA_DISPATCH_2 (g_scm_i_num_geq_p, x, y, SCM_ARG1, FUNC_NAME); + return scm_wta_dispatch_2 (g_scm_i_num_geq_p, x, y, SCM_ARG1, FUNC_NAME); else if (!SCM_NUMBERP (y)) - SCM_WTA_DISPATCH_2 (g_scm_i_num_geq_p, x, y, SCM_ARG2, FUNC_NAME); + return scm_wta_dispatch_2 (g_scm_i_num_geq_p, x, y, SCM_ARG2, FUNC_NAME); else if (scm_is_true (scm_nan_p (x)) || scm_is_true (scm_nan_p (y))) return SCM_BOOL_F; else @@ -7062,7 +7077,7 @@ SCM_PRIMITIVE_GENERIC (scm_zero_p, "zero?", 1, 0, 0, else if (SCM_FRACTIONP (z)) return SCM_BOOL_F; else - SCM_WTA_DISPATCH_1 (g_scm_zero_p, z, SCM_ARG1, s_scm_zero_p); + return scm_wta_dispatch_1 (g_scm_zero_p, z, SCM_ARG1, s_scm_zero_p); } #undef FUNC_NAME @@ -7086,7 +7101,7 @@ SCM_PRIMITIVE_GENERIC (scm_positive_p, "positive?", 1, 0, 0, else if (SCM_FRACTIONP (x)) return scm_positive_p (SCM_FRACTION_NUMERATOR (x)); else - SCM_WTA_DISPATCH_1 (g_scm_positive_p, x, SCM_ARG1, s_scm_positive_p); + return scm_wta_dispatch_1 (g_scm_positive_p, x, SCM_ARG1, s_scm_positive_p); } #undef FUNC_NAME @@ -7110,7 +7125,7 @@ SCM_PRIMITIVE_GENERIC (scm_negative_p, "negative?", 1, 0, 0, else if (SCM_FRACTIONP (x)) return scm_negative_p (SCM_FRACTION_NUMERATOR (x)); else - SCM_WTA_DISPATCH_1 (g_scm_negative_p, x, SCM_ARG1, s_scm_negative_p); + return scm_wta_dispatch_1 (g_scm_negative_p, x, SCM_ARG1, s_scm_negative_p); } #undef FUNC_NAME @@ -7144,11 +7159,11 @@ scm_max (SCM x, SCM y) if (SCM_UNBNDP (y)) { if (SCM_UNBNDP (x)) - SCM_WTA_DISPATCH_0 (g_max, s_max); + return scm_wta_dispatch_0 (g_max, s_max); else if (SCM_I_INUMP(x) || SCM_BIGP(x) || SCM_REALP(x) || SCM_FRACTIONP(x)) return x; else - SCM_WTA_DISPATCH_1 (g_max, x, SCM_ARG1, s_max); + return scm_wta_dispatch_1 (g_max, x, SCM_ARG1, s_max); } if (SCM_I_INUMP (x)) @@ -7187,7 +7202,7 @@ scm_max (SCM x, SCM y) return (scm_is_false (scm_less_p (x, y)) ? x : y); } else - SCM_WTA_DISPATCH_2 (g_max, x, y, SCM_ARGn, s_max); + return scm_wta_dispatch_2 (g_max, x, y, SCM_ARGn, s_max); } else if (SCM_BIGP (x)) { @@ -7217,7 +7232,7 @@ scm_max (SCM x, SCM y) goto use_less; } else - SCM_WTA_DISPATCH_2 (g_max, x, y, SCM_ARGn, s_max); + return scm_wta_dispatch_2 (g_max, x, y, SCM_ARGn, s_max); } else if (SCM_REALP (x)) { @@ -7271,7 +7286,7 @@ scm_max (SCM x, SCM y) return (xx < yy) ? scm_i_from_double (yy) : x; } else - SCM_WTA_DISPATCH_2 (g_max, x, y, SCM_ARGn, s_max); + return scm_wta_dispatch_2 (g_max, x, y, SCM_ARGn, s_max); } else if (SCM_FRACTIONP (x)) { @@ -7294,10 +7309,10 @@ scm_max (SCM x, SCM y) goto use_less; } else - SCM_WTA_DISPATCH_2 (g_max, x, y, SCM_ARGn, s_max); + return scm_wta_dispatch_2 (g_max, x, y, SCM_ARGn, s_max); } else - SCM_WTA_DISPATCH_2 (g_max, x, y, SCM_ARG1, s_max); + return scm_wta_dispatch_2 (g_max, x, y, SCM_ARG1, s_max); } @@ -7324,11 +7339,11 @@ scm_min (SCM x, SCM y) if (SCM_UNBNDP (y)) { if (SCM_UNBNDP (x)) - SCM_WTA_DISPATCH_0 (g_min, s_min); + return scm_wta_dispatch_0 (g_min, s_min); else if (SCM_I_INUMP(x) || SCM_BIGP(x) || SCM_REALP(x) || SCM_FRACTIONP(x)) return x; else - SCM_WTA_DISPATCH_1 (g_min, x, SCM_ARG1, s_min); + return scm_wta_dispatch_1 (g_min, x, SCM_ARG1, s_min); } if (SCM_I_INUMP (x)) @@ -7357,7 +7372,7 @@ scm_min (SCM x, SCM y) return (scm_is_false (scm_less_p (x, y)) ? y : x); } else - SCM_WTA_DISPATCH_2 (g_min, x, y, SCM_ARGn, s_min); + return scm_wta_dispatch_2 (g_min, x, y, SCM_ARGn, s_min); } else if (SCM_BIGP (x)) { @@ -7387,7 +7402,7 @@ scm_min (SCM x, SCM y) goto use_less; } else - SCM_WTA_DISPATCH_2 (g_min, x, y, SCM_ARGn, s_min); + return scm_wta_dispatch_2 (g_min, x, y, SCM_ARGn, s_min); } else if (SCM_REALP (x)) { @@ -7430,7 +7445,7 @@ scm_min (SCM x, SCM y) return (yy < xx) ? scm_i_from_double (yy) : x; } else - SCM_WTA_DISPATCH_2 (g_min, x, y, SCM_ARGn, s_min); + return scm_wta_dispatch_2 (g_min, x, y, SCM_ARGn, s_min); } else if (SCM_FRACTIONP (x)) { @@ -7453,10 +7468,10 @@ scm_min (SCM x, SCM y) goto use_less; } else - SCM_WTA_DISPATCH_2 (g_min, x, y, SCM_ARGn, s_min); + return scm_wta_dispatch_2 (g_min, x, y, SCM_ARGn, s_min); } else - SCM_WTA_DISPATCH_2 (g_min, x, y, SCM_ARG1, s_min); + return scm_wta_dispatch_2 (g_min, x, y, SCM_ARG1, s_min); } @@ -7485,7 +7500,7 @@ scm_sum (SCM x, SCM y) { if (SCM_NUMBERP (x)) return x; if (SCM_UNBNDP (x)) return SCM_INUM0; - SCM_WTA_DISPATCH_1 (g_sum, x, SCM_ARG1, s_sum); + return scm_wta_dispatch_1 (g_sum, x, SCM_ARG1, s_sum); } if (SCM_LIKELY (SCM_I_INUMP (x))) @@ -7518,7 +7533,7 @@ scm_sum (SCM x, SCM y) scm_product (x, SCM_FRACTION_DENOMINATOR (y))), SCM_FRACTION_DENOMINATOR (y)); else - SCM_WTA_DISPATCH_2 (g_sum, x, y, SCM_ARGn, s_sum); + return scm_wta_dispatch_2 (g_sum, x, y, SCM_ARGn, s_sum); } else if (SCM_BIGP (x)) { if (SCM_I_INUMP (y)) @@ -7583,7 +7598,7 @@ scm_sum (SCM x, SCM y) scm_product (x, SCM_FRACTION_DENOMINATOR (y))), SCM_FRACTION_DENOMINATOR (y)); else - SCM_WTA_DISPATCH_2 (g_sum, x, y, SCM_ARGn, s_sum); + return scm_wta_dispatch_2 (g_sum, x, y, SCM_ARGn, s_sum); } else if (SCM_REALP (x)) { @@ -7603,7 +7618,7 @@ scm_sum (SCM x, SCM y) else if (SCM_FRACTIONP (y)) return scm_i_from_double (SCM_REAL_VALUE (x) + scm_i_fraction2double (y)); else - SCM_WTA_DISPATCH_2 (g_sum, x, y, SCM_ARGn, s_sum); + return scm_wta_dispatch_2 (g_sum, x, y, SCM_ARGn, s_sum); } else if (SCM_COMPLEXP (x)) { @@ -7627,7 +7642,7 @@ scm_sum (SCM x, SCM y) return scm_c_make_rectangular (SCM_COMPLEX_REAL (x) + scm_i_fraction2double (y), SCM_COMPLEX_IMAG (x)); else - SCM_WTA_DISPATCH_2 (g_sum, x, y, SCM_ARGn, s_sum); + return scm_wta_dispatch_2 (g_sum, x, y, SCM_ARGn, s_sum); } else if (SCM_FRACTIONP (x)) { @@ -7650,10 +7665,10 @@ scm_sum (SCM x, SCM y) scm_product (SCM_FRACTION_NUMERATOR (y), SCM_FRACTION_DENOMINATOR (x))), scm_product (SCM_FRACTION_DENOMINATOR (x), SCM_FRACTION_DENOMINATOR (y))); else - SCM_WTA_DISPATCH_2 (g_sum, x, y, SCM_ARGn, s_sum); + return scm_wta_dispatch_2 (g_sum, x, y, SCM_ARGn, s_sum); } else - SCM_WTA_DISPATCH_2 (g_sum, x, y, SCM_ARG1, s_sum); + return scm_wta_dispatch_2 (g_sum, x, y, SCM_ARG1, s_sum); } @@ -7693,7 +7708,7 @@ scm_difference (SCM x, SCM y) if (SCM_UNLIKELY (SCM_UNBNDP (y))) { if (SCM_UNBNDP (x)) - SCM_WTA_DISPATCH_0 (g_difference, s_difference); + return scm_wta_dispatch_0 (g_difference, s_difference); else if (SCM_I_INUMP (x)) { @@ -7717,7 +7732,7 @@ scm_difference (SCM x, SCM y) (scm_difference (SCM_FRACTION_NUMERATOR (x), SCM_UNDEFINED), SCM_FRACTION_DENOMINATOR (x)); else - SCM_WTA_DISPATCH_1 (g_difference, x, SCM_ARG1, s_difference); + return scm_wta_dispatch_1 (g_difference, x, SCM_ARG1, s_difference); } if (SCM_LIKELY (SCM_I_INUMP (x))) @@ -7804,7 +7819,7 @@ scm_difference (SCM x, SCM y) SCM_FRACTION_NUMERATOR (y)), SCM_FRACTION_DENOMINATOR (y)); else - SCM_WTA_DISPATCH_2 (g_difference, x, y, SCM_ARGn, s_difference); + return scm_wta_dispatch_2 (g_difference, x, y, SCM_ARGn, s_difference); } else if (SCM_BIGP (x)) { @@ -7868,7 +7883,8 @@ scm_difference (SCM x, SCM y) return scm_i_make_ratio (scm_difference (scm_product (x, SCM_FRACTION_DENOMINATOR (y)), SCM_FRACTION_NUMERATOR (y)), SCM_FRACTION_DENOMINATOR (y)); - else SCM_WTA_DISPATCH_2 (g_difference, x, y, SCM_ARGn, s_difference); + else + return scm_wta_dispatch_2 (g_difference, x, y, SCM_ARGn, s_difference); } else if (SCM_REALP (x)) { @@ -7888,7 +7904,7 @@ scm_difference (SCM x, SCM y) else if (SCM_FRACTIONP (y)) return scm_i_from_double (SCM_REAL_VALUE (x) - scm_i_fraction2double (y)); else - SCM_WTA_DISPATCH_2 (g_difference, x, y, SCM_ARGn, s_difference); + return scm_wta_dispatch_2 (g_difference, x, y, SCM_ARGn, s_difference); } else if (SCM_COMPLEXP (x)) { @@ -7912,7 +7928,7 @@ scm_difference (SCM x, SCM y) return scm_c_make_rectangular (SCM_COMPLEX_REAL (x) - scm_i_fraction2double (y), SCM_COMPLEX_IMAG (x)); else - SCM_WTA_DISPATCH_2 (g_difference, x, y, SCM_ARGn, s_difference); + return scm_wta_dispatch_2 (g_difference, x, y, SCM_ARGn, s_difference); } else if (SCM_FRACTIONP (x)) { @@ -7936,10 +7952,10 @@ scm_difference (SCM x, SCM y) scm_product (SCM_FRACTION_NUMERATOR (y), SCM_FRACTION_DENOMINATOR (x))), scm_product (SCM_FRACTION_DENOMINATOR (x), SCM_FRACTION_DENOMINATOR (y))); else - SCM_WTA_DISPATCH_2 (g_difference, x, y, SCM_ARGn, s_difference); + return scm_wta_dispatch_2 (g_difference, x, y, SCM_ARGn, s_difference); } else - SCM_WTA_DISPATCH_2 (g_difference, x, y, SCM_ARG1, s_difference); + return scm_wta_dispatch_2 (g_difference, x, y, SCM_ARG1, s_difference); } #undef FUNC_NAME @@ -7982,7 +7998,7 @@ scm_product (SCM x, SCM y) else if (SCM_NUMBERP (x)) return x; else - SCM_WTA_DISPATCH_1 (g_product, x, SCM_ARG1, s_product); + return scm_wta_dispatch_1 (g_product, x, SCM_ARG1, s_product); } if (SCM_LIKELY (SCM_I_INUMP (x))) @@ -8015,7 +8031,7 @@ scm_product (SCM x, SCM y) else if (SCM_NUMP (y)) return SCM_INUM0; else - SCM_WTA_DISPATCH_2 (g_product, x, y, SCM_ARGn, s_product); + return scm_wta_dispatch_2 (g_product, x, y, SCM_ARGn, s_product); break; case -1: /* @@ -8066,7 +8082,7 @@ scm_product (SCM x, SCM y) return scm_i_make_ratio (scm_product (x, SCM_FRACTION_NUMERATOR (y)), SCM_FRACTION_DENOMINATOR (y)); else - SCM_WTA_DISPATCH_2 (g_product, x, y, SCM_ARGn, s_product); + return scm_wta_dispatch_2 (g_product, x, y, SCM_ARGn, s_product); } else if (SCM_BIGP (x)) { @@ -8101,7 +8117,7 @@ scm_product (SCM x, SCM y) return scm_i_make_ratio (scm_product (x, SCM_FRACTION_NUMERATOR (y)), SCM_FRACTION_DENOMINATOR (y)); else - SCM_WTA_DISPATCH_2 (g_product, x, y, SCM_ARGn, s_product); + return scm_wta_dispatch_2 (g_product, x, y, SCM_ARGn, s_product); } else if (SCM_REALP (x)) { @@ -8124,7 +8140,7 @@ scm_product (SCM x, SCM y) else if (SCM_FRACTIONP (y)) return scm_i_from_double (SCM_REAL_VALUE (x) * scm_i_fraction2double (y)); else - SCM_WTA_DISPATCH_2 (g_product, x, y, SCM_ARGn, s_product); + return scm_wta_dispatch_2 (g_product, x, y, SCM_ARGn, s_product); } else if (SCM_COMPLEXP (x)) { @@ -8157,7 +8173,7 @@ scm_product (SCM x, SCM y) yy * SCM_COMPLEX_IMAG (x)); } else - SCM_WTA_DISPATCH_2 (g_product, x, y, SCM_ARGn, s_product); + return scm_wta_dispatch_2 (g_product, x, y, SCM_ARGn, s_product); } else if (SCM_FRACTIONP (x)) { @@ -8182,10 +8198,10 @@ scm_product (SCM x, SCM y) scm_product (SCM_FRACTION_DENOMINATOR (x), SCM_FRACTION_DENOMINATOR (y))); else - SCM_WTA_DISPATCH_2 (g_product, x, y, SCM_ARGn, s_product); + return scm_wta_dispatch_2 (g_product, x, y, SCM_ARGn, s_product); } else - SCM_WTA_DISPATCH_2 (g_product, x, y, SCM_ARG1, s_product); + return scm_wta_dispatch_2 (g_product, x, y, SCM_ARG1, s_product); } #if ((defined (HAVE_ISINF) && defined (HAVE_ISNAN)) \ @@ -8249,7 +8265,7 @@ scm_divide (SCM x, SCM y) if (SCM_UNLIKELY (SCM_UNBNDP (y))) { if (SCM_UNBNDP (x)) - SCM_WTA_DISPATCH_0 (g_divide, s_divide); + return scm_wta_dispatch_0 (g_divide, s_divide); else if (SCM_I_INUMP (x)) { scm_t_inum xx = SCM_I_INUM (x); @@ -8295,7 +8311,7 @@ scm_divide (SCM x, SCM y) return scm_i_make_ratio_already_reduced (SCM_FRACTION_DENOMINATOR (x), SCM_FRACTION_NUMERATOR (x)); else - SCM_WTA_DISPATCH_1 (g_divide, x, SCM_ARG1, s_divide); + return scm_wta_dispatch_1 (g_divide, x, SCM_ARG1, s_divide); } if (SCM_LIKELY (SCM_I_INUMP (x))) @@ -8364,7 +8380,7 @@ scm_divide (SCM x, SCM y) return scm_i_make_ratio (scm_product (x, SCM_FRACTION_DENOMINATOR (y)), SCM_FRACTION_NUMERATOR (y)); else - SCM_WTA_DISPATCH_2 (g_divide, x, y, SCM_ARGn, s_divide); + return scm_wta_dispatch_2 (g_divide, x, y, SCM_ARGn, s_divide); } else if (SCM_BIGP (x)) { @@ -8446,7 +8462,7 @@ scm_divide (SCM x, SCM y) return scm_i_make_ratio (scm_product (x, SCM_FRACTION_DENOMINATOR (y)), SCM_FRACTION_NUMERATOR (y)); else - SCM_WTA_DISPATCH_2 (g_divide, x, y, SCM_ARGn, s_divide); + return scm_wta_dispatch_2 (g_divide, x, y, SCM_ARGn, s_divide); } else if (SCM_REALP (x)) { @@ -8491,7 +8507,7 @@ scm_divide (SCM x, SCM y) else if (SCM_FRACTIONP (y)) return scm_i_from_double (rx / scm_i_fraction2double (y)); else - SCM_WTA_DISPATCH_2 (g_divide, x, y, SCM_ARGn, s_divide); + return scm_wta_dispatch_2 (g_divide, x, y, SCM_ARGn, s_divide); } else if (SCM_COMPLEXP (x)) { @@ -8558,7 +8574,7 @@ scm_divide (SCM x, SCM y) return scm_c_make_rectangular (rx / yy, ix / yy); } else - SCM_WTA_DISPATCH_2 (g_divide, x, y, SCM_ARGn, s_divide); + return scm_wta_dispatch_2 (g_divide, x, y, SCM_ARGn, s_divide); } else if (SCM_FRACTIONP (x)) { @@ -8603,10 +8619,10 @@ scm_divide (SCM x, SCM y) return scm_i_make_ratio (scm_product (SCM_FRACTION_NUMERATOR (x), SCM_FRACTION_DENOMINATOR (y)), scm_product (SCM_FRACTION_NUMERATOR (y), SCM_FRACTION_DENOMINATOR (x))); else - SCM_WTA_DISPATCH_2 (g_divide, x, y, SCM_ARGn, s_divide); + return scm_wta_dispatch_2 (g_divide, x, y, SCM_ARGn, s_divide); } else - SCM_WTA_DISPATCH_2 (g_divide, x, y, SCM_ARG1, s_divide); + return scm_wta_dispatch_2 (g_divide, x, y, SCM_ARG1, s_divide); } #undef FUNC_NAME @@ -8672,7 +8688,7 @@ SCM_PRIMITIVE_GENERIC (scm_truncate_number, "truncate", 1, 0, 0, return scm_truncate_quotient (SCM_FRACTION_NUMERATOR (x), SCM_FRACTION_DENOMINATOR (x)); else - SCM_WTA_DISPATCH_1 (g_scm_truncate_number, x, SCM_ARG1, + return scm_wta_dispatch_1 (g_scm_truncate_number, x, SCM_ARG1, s_scm_truncate_number); } #undef FUNC_NAME @@ -8692,8 +8708,8 @@ SCM_PRIMITIVE_GENERIC (scm_round_number, "round", 1, 0, 0, return scm_round_quotient (SCM_FRACTION_NUMERATOR (x), SCM_FRACTION_DENOMINATOR (x)); else - SCM_WTA_DISPATCH_1 (g_scm_round_number, x, SCM_ARG1, - s_scm_round_number); + return scm_wta_dispatch_1 (g_scm_round_number, x, SCM_ARG1, + s_scm_round_number); } #undef FUNC_NAME @@ -8710,7 +8726,7 @@ SCM_PRIMITIVE_GENERIC (scm_floor, "floor", 1, 0, 0, return scm_floor_quotient (SCM_FRACTION_NUMERATOR (x), SCM_FRACTION_DENOMINATOR (x)); else - SCM_WTA_DISPATCH_1 (g_scm_floor, x, 1, s_scm_floor); + return scm_wta_dispatch_1 (g_scm_floor, x, 1, s_scm_floor); } #undef FUNC_NAME @@ -8727,7 +8743,7 @@ SCM_PRIMITIVE_GENERIC (scm_ceiling, "ceiling", 1, 0, 0, return scm_ceiling_quotient (SCM_FRACTION_NUMERATOR (x), SCM_FRACTION_DENOMINATOR (x)); else - SCM_WTA_DISPATCH_1 (g_scm_ceiling, x, 1, s_scm_ceiling); + return scm_wta_dispatch_1 (g_scm_ceiling, x, 1, s_scm_ceiling); } #undef FUNC_NAME @@ -8766,9 +8782,9 @@ SCM_PRIMITIVE_GENERIC (scm_expt, "expt", 2, 0, 0, else if (scm_is_complex (x) && scm_is_complex (y)) return scm_exp (scm_product (scm_log (x), y)); else if (scm_is_complex (x)) - SCM_WTA_DISPATCH_2 (g_scm_expt, x, y, SCM_ARG2, s_scm_expt); + return scm_wta_dispatch_2 (g_scm_expt, x, y, SCM_ARG2, s_scm_expt); else - SCM_WTA_DISPATCH_2 (g_scm_expt, x, y, SCM_ARG1, s_scm_expt); + return scm_wta_dispatch_2 (g_scm_expt, x, y, SCM_ARG1, s_scm_expt); } #undef FUNC_NAME @@ -8795,7 +8811,7 @@ SCM_PRIMITIVE_GENERIC (scm_sin, "sin", 1, 0, 0, cos (x) * sinh (y)); } else - SCM_WTA_DISPATCH_1 (g_scm_sin, z, 1, s_scm_sin); + return scm_wta_dispatch_1 (g_scm_sin, z, 1, s_scm_sin); } #undef FUNC_NAME @@ -8816,7 +8832,7 @@ SCM_PRIMITIVE_GENERIC (scm_cos, "cos", 1, 0, 0, -sin (x) * sinh (y)); } else - SCM_WTA_DISPATCH_1 (g_scm_cos, z, 1, s_scm_cos); + return scm_wta_dispatch_1 (g_scm_cos, z, 1, s_scm_cos); } #undef FUNC_NAME @@ -8841,7 +8857,7 @@ SCM_PRIMITIVE_GENERIC (scm_tan, "tan", 1, 0, 0, return scm_c_make_rectangular (sin (x) / w, sinh (y) / w); } else - SCM_WTA_DISPATCH_1 (g_scm_tan, z, 1, s_scm_tan); + return scm_wta_dispatch_1 (g_scm_tan, z, 1, s_scm_tan); } #undef FUNC_NAME @@ -8862,7 +8878,7 @@ SCM_PRIMITIVE_GENERIC (scm_sinh, "sinh", 1, 0, 0, cosh (x) * sin (y)); } else - SCM_WTA_DISPATCH_1 (g_scm_sinh, z, 1, s_scm_sinh); + return scm_wta_dispatch_1 (g_scm_sinh, z, 1, s_scm_sinh); } #undef FUNC_NAME @@ -8883,7 +8899,7 @@ SCM_PRIMITIVE_GENERIC (scm_cosh, "cosh", 1, 0, 0, sinh (x) * sin (y)); } else - SCM_WTA_DISPATCH_1 (g_scm_cosh, z, 1, s_scm_cosh); + return scm_wta_dispatch_1 (g_scm_cosh, z, 1, s_scm_cosh); } #undef FUNC_NAME @@ -8908,7 +8924,7 @@ SCM_PRIMITIVE_GENERIC (scm_tanh, "tanh", 1, 0, 0, return scm_c_make_rectangular (sinh (x) / w, sin (y) / w); } else - SCM_WTA_DISPATCH_1 (g_scm_tanh, z, 1, s_scm_tanh); + return scm_wta_dispatch_1 (g_scm_tanh, z, 1, s_scm_tanh); } #undef FUNC_NAME @@ -8936,7 +8952,7 @@ SCM_PRIMITIVE_GENERIC (scm_asin, "asin", 1, 0, 0, scm_sys_asinh (scm_c_make_rectangular (-y, x))); } else - SCM_WTA_DISPATCH_1 (g_scm_asin, z, 1, s_scm_asin); + return scm_wta_dispatch_1 (g_scm_asin, z, 1, s_scm_asin); } #undef FUNC_NAME @@ -8966,7 +8982,7 @@ SCM_PRIMITIVE_GENERIC (scm_acos, "acos", 1, 0, 0, scm_sys_asinh (scm_c_make_rectangular (-y, x)))); } else - SCM_WTA_DISPATCH_1 (g_scm_acos, z, 1, s_scm_acos); + return scm_wta_dispatch_1 (g_scm_acos, z, 1, s_scm_acos); } #undef FUNC_NAME @@ -8993,17 +9009,17 @@ SCM_PRIMITIVE_GENERIC (scm_atan, "atan", 1, 1, 0, scm_c_make_rectangular (0, 2)); } else - SCM_WTA_DISPATCH_1 (g_scm_atan, z, SCM_ARG1, s_scm_atan); + return scm_wta_dispatch_1 (g_scm_atan, z, SCM_ARG1, s_scm_atan); } else if (scm_is_real (z)) { if (scm_is_real (y)) return scm_i_from_double (atan2 (scm_to_double (z), scm_to_double (y))); else - SCM_WTA_DISPATCH_2 (g_scm_atan, z, y, SCM_ARG2, s_scm_atan); + return scm_wta_dispatch_2 (g_scm_atan, z, y, SCM_ARG2, s_scm_atan); } else - SCM_WTA_DISPATCH_2 (g_scm_atan, z, y, SCM_ARG1, s_scm_atan); + return scm_wta_dispatch_2 (g_scm_atan, z, y, SCM_ARG1, s_scm_atan); } #undef FUNC_NAME @@ -9021,7 +9037,7 @@ SCM_PRIMITIVE_GENERIC (scm_sys_asinh, "asinh", 1, 0, 0, scm_sqrt (scm_sum (scm_product (z, z), SCM_INUM1)))); else - SCM_WTA_DISPATCH_1 (g_scm_sys_asinh, z, 1, s_scm_sys_asinh); + return scm_wta_dispatch_1 (g_scm_sys_asinh, z, 1, s_scm_sys_asinh); } #undef FUNC_NAME @@ -9039,7 +9055,7 @@ SCM_PRIMITIVE_GENERIC (scm_sys_acosh, "acosh", 1, 0, 0, scm_sqrt (scm_difference (scm_product (z, z), SCM_INUM1)))); else - SCM_WTA_DISPATCH_1 (g_scm_sys_acosh, z, 1, s_scm_sys_acosh); + return scm_wta_dispatch_1 (g_scm_sys_acosh, z, 1, s_scm_sys_acosh); } #undef FUNC_NAME @@ -9057,7 +9073,7 @@ SCM_PRIMITIVE_GENERIC (scm_sys_atanh, "atanh", 1, 0, 0, scm_difference (SCM_INUM1, z))), SCM_I_MAKINUM (2)); else - SCM_WTA_DISPATCH_1 (g_scm_sys_atanh, z, 1, s_scm_sys_atanh); + return scm_wta_dispatch_1 (g_scm_sys_atanh, z, 1, s_scm_sys_atanh); } #undef FUNC_NAME @@ -9066,7 +9082,7 @@ scm_c_make_rectangular (double re, double im) { SCM z; - z = PTR2SCM (scm_gc_malloc_pointerless (sizeof (scm_t_complex), + z = SCM_PACK_POINTER (scm_gc_malloc_pointerless (sizeof (scm_t_complex), "complex")); SCM_SET_CELL_TYPE (z, scm_tc16_complex); SCM_COMPLEX_REAL (z) = re; @@ -9158,7 +9174,7 @@ SCM_PRIMITIVE_GENERIC (scm_real_part, "real-part", 1, 0, 0, else if (SCM_I_INUMP (z) || SCM_BIGP (z) || SCM_REALP (z) || SCM_FRACTIONP (z)) return z; else - SCM_WTA_DISPATCH_1 (g_scm_real_part, z, SCM_ARG1, s_scm_real_part); + return scm_wta_dispatch_1 (g_scm_real_part, z, SCM_ARG1, s_scm_real_part); } #undef FUNC_NAME @@ -9173,7 +9189,7 @@ SCM_PRIMITIVE_GENERIC (scm_imag_part, "imag-part", 1, 0, 0, else if (SCM_I_INUMP (z) || SCM_REALP (z) || SCM_BIGP (z) || SCM_FRACTIONP (z)) return SCM_INUM0; else - SCM_WTA_DISPATCH_1 (g_scm_imag_part, z, SCM_ARG1, s_scm_imag_part); + return scm_wta_dispatch_1 (g_scm_imag_part, z, SCM_ARG1, s_scm_imag_part); } #undef FUNC_NAME @@ -9197,7 +9213,7 @@ SCM_PRIMITIVE_GENERIC (scm_numerator, "numerator", 1, 0, 0, return scm_exact_to_inexact (scm_numerator (scm_inexact_to_exact (z))); } else - SCM_WTA_DISPATCH_1 (g_scm_numerator, z, SCM_ARG1, s_scm_numerator); + return scm_wta_dispatch_1 (g_scm_numerator, z, SCM_ARG1, s_scm_numerator); } #undef FUNC_NAME @@ -9222,7 +9238,8 @@ SCM_PRIMITIVE_GENERIC (scm_denominator, "denominator", 1, 0, 0, return scm_exact_to_inexact (scm_denominator (scm_inexact_to_exact (z))); } else - SCM_WTA_DISPATCH_1 (g_scm_denominator, z, SCM_ARG1, s_scm_denominator); + return scm_wta_dispatch_1 (g_scm_denominator, z, SCM_ARG1, + s_scm_denominator); } #undef FUNC_NAME @@ -9265,7 +9282,8 @@ SCM_PRIMITIVE_GENERIC (scm_magnitude, "magnitude", 1, 0, 0, SCM_FRACTION_DENOMINATOR (z)); } else - SCM_WTA_DISPATCH_1 (g_scm_magnitude, z, SCM_ARG1, s_scm_magnitude); + return scm_wta_dispatch_1 (g_scm_magnitude, z, SCM_ARG1, + s_scm_magnitude); } #undef FUNC_NAME @@ -9312,7 +9330,7 @@ SCM_PRIMITIVE_GENERIC (scm_angle, "angle", 1, 0, 0, else return scm_i_from_double (atan2 (0.0, -1.0)); } else - SCM_WTA_DISPATCH_1 (g_scm_angle, z, SCM_ARG1, s_scm_angle); + return scm_wta_dispatch_1 (g_scm_angle, z, SCM_ARG1, s_scm_angle); } #undef FUNC_NAME @@ -9331,7 +9349,8 @@ SCM_PRIMITIVE_GENERIC (scm_exact_to_inexact, "exact->inexact", 1, 0, 0, else if (SCM_INEXACTP (z)) return z; else - SCM_WTA_DISPATCH_1 (g_scm_exact_to_inexact, z, 1, s_scm_exact_to_inexact); + return scm_wta_dispatch_1 (g_scm_exact_to_inexact, z, 1, + s_scm_exact_to_inexact); } #undef FUNC_NAME @@ -9352,7 +9371,8 @@ SCM_PRIMITIVE_GENERIC (scm_inexact_to_exact, "inexact->exact", 1, 0, 0, else if (SCM_COMPLEXP (z) && SCM_COMPLEX_IMAG (z) == 0.0) val = SCM_COMPLEX_REAL (z); else - SCM_WTA_DISPATCH_1 (g_scm_inexact_to_exact, z, 1, s_scm_inexact_to_exact); + return scm_wta_dispatch_1 (g_scm_inexact_to_exact, z, 1, + s_scm_inexact_to_exact); if (!SCM_LIKELY (isfinite (val))) SCM_OUT_OF_RANGE (1, z); @@ -9848,46 +9868,6 @@ scm_from_double (double val) return scm_i_from_double (val); } -#if SCM_ENABLE_DEPRECATED == 1 - -float -scm_num2float (SCM num, unsigned long pos, const char *s_caller) -{ - scm_c_issue_deprecation_warning - ("`scm_num2float' is deprecated. Use scm_to_double instead."); - - if (SCM_BIGP (num)) - { - float res = mpz_get_d (SCM_I_BIG_MPZ (num)); - if (!isinf (res)) - return res; - else - scm_out_of_range (NULL, num); - } - else - return scm_to_double (num); -} - -double -scm_num2double (SCM num, unsigned long pos, const char *s_caller) -{ - scm_c_issue_deprecation_warning - ("`scm_num2double' is deprecated. Use scm_to_double instead."); - - if (SCM_BIGP (num)) - { - double res = mpz_get_d (SCM_I_BIG_MPZ (num)); - if (!isinf (res)) - return res; - else - scm_out_of_range (NULL, num); - } - else - return scm_to_double (num); -} - -#endif - int scm_is_complex (SCM val) { @@ -10030,7 +10010,7 @@ SCM_PRIMITIVE_GENERIC (scm_log, "log", 1, 0, 0, return log_of_fraction (SCM_FRACTION_NUMERATOR (z), SCM_FRACTION_DENOMINATOR (z)); else - SCM_WTA_DISPATCH_1 (g_scm_log, z, 1, s_scm_log); + return scm_wta_dispatch_1 (g_scm_log, z, 1, s_scm_log); } #undef FUNC_NAME @@ -10077,7 +10057,7 @@ SCM_PRIMITIVE_GENERIC (scm_log10, "log10", 1, 0, 0, log_of_fraction (SCM_FRACTION_NUMERATOR (z), SCM_FRACTION_DENOMINATOR (z))); else - SCM_WTA_DISPATCH_1 (g_scm_log10, z, 1, s_scm_log10); + return scm_wta_dispatch_1 (g_scm_log10, z, 1, s_scm_log10); } #undef FUNC_NAME @@ -10105,7 +10085,7 @@ SCM_PRIMITIVE_GENERIC (scm_exp, "exp", 1, 0, 0, return scm_i_from_double (exp (scm_to_double (z))); } else - SCM_WTA_DISPATCH_1 (g_scm_exp, z, 1, s_scm_exp); + return scm_wta_dispatch_1 (g_scm_exp, z, 1, s_scm_exp); } #undef FUNC_NAME @@ -10352,7 +10332,7 @@ SCM_PRIMITIVE_GENERIC (scm_sqrt, "sqrt", 1, 0, 0, } } else - SCM_WTA_DISPATCH_1 (g_scm_sqrt, z, 1, s_scm_sqrt); + return scm_wta_dispatch_1 (g_scm_sqrt, z, 1, s_scm_sqrt); } #undef FUNC_NAME |