>From 9684a9503435970590e3d3af1b97b15fbcd23f8e Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Sun, 13 Feb 2011 05:47:33 -0500 Subject: [PATCH 2/9] Make divide functions return values via (SCM *) output arguments * libguile/numbers.c (scm_euclidean_divide, scm_centered_divide): Change API to return two values via output arguments of type (SCM *), instead of packing into a values object. (scm_i_euclidean_divide, scm_i_centered_divide): New internal wrappers that call the above functions and pack the result into a values object. * libguile/numbers.h: Change prototypes to reflect new API. * doc/ref/api-data.h (Arithmetic): Update manual. --- doc/ref/api-data.texi | 35 ++++---- libguile/numbers.c | 247 ++++++++++++++++++++++++++++++------------------ libguile/numbers.h | 7 +- 3 files changed, 177 insertions(+), 112 deletions(-) diff --git a/doc/ref/api-data.texi b/doc/ref/api-data.texi index fd2e7ee..6e37e9e 100644 --- a/doc/ref/api-data.texi +++ b/doc/ref/api-data.texi @@ -1250,17 +1250,17 @@ respectively, but these functions take and return @code{double} values. @end deftypefn address@hidden {Scheme Procedure} euclidean/ x y address@hidden {Scheme Procedure} euclidean-quotient x y address@hidden {Scheme Procedure} euclidean-remainder x y address@hidden {C Function} scm_euclidean_divide (x y) address@hidden {C Function} scm_euclidean_quotient (x y) address@hidden {C Function} scm_euclidean_remainder (x y) address@hidden {Scheme Procedure} {} euclidean/ @var{x} @var{y} address@hidden {Scheme Procedure} {} euclidean-quotient @var{x} @var{y} address@hidden {Scheme Procedure} {} euclidean-remainder @var{x} @var{y} address@hidden {C Function} void scm_euclidean_divide (SCM @var{x}, SCM @var{y}, SCM address@hidden, SCM address@hidden) address@hidden {C Function} SCM scm_euclidean_quotient (SCM @var{x}, SCM @var{y}) address@hidden {C Function} SCM scm_euclidean_remainder (SCM @var{x}, SCM @var{y}) These procedures accept two real numbers @var{x} and @var{y}, where the divisor @var{y} must be non-zero. @code{euclidean-quotient} returns the integer @var{q} and @code{euclidean-remainder} returns the real number @var{r} such that @address@hidden = @address@hidden + @var{r}} and address@hidden <= @var{r} < abs(@var{y})}. @code{euclidean/} returns both @var{q} and address@hidden <= @var{r} < |@var{y}|}. @code{euclidean/} returns both @var{q} and @var{r}, and is more efficient than computing each separately. Note that when @address@hidden > 0}, @code{euclidean-quotient} returns @math{floor(@var{x}/@var{y})}, otherwise it returns @@ -1279,19 +1279,19 @@ Note that these operators are equivalent to the R6RS operators (euclidean/ -123.2 -63.5) @result{} 2.0 and 3.8 (euclidean/ 16/3 -10/7) @result{} -3 and 22/21 @end lisp address@hidden deffn address@hidden deftypefn address@hidden {Scheme Procedure} centered/ x y address@hidden {Scheme Procedure} centered-quotient x y address@hidden {Scheme Procedure} centered-remainder x y address@hidden {C Function} scm_centered_divide (x y) address@hidden {C Function} scm_centered_quotient (x y) address@hidden {C Function} scm_centered_remainder (x y) address@hidden {Scheme Procedure} {} centered/ @var{x} @var{y} address@hidden {Scheme Procedure} {} centered-quotient @var{x} @var{y} address@hidden {Scheme Procedure} {} centered-remainder @var{x} @var{y} address@hidden {C Function} void scm_centered_divide (SCM @var{x}, SCM @var{y}, SCM address@hidden, SCM address@hidden) address@hidden {C Function} SCM scm_centered_quotient (SCM @var{x}, SCM @var{y}) address@hidden {C Function} SCM scm_centered_remainder (SCM @var{x}, SCM @var{y}) These procedures accept two real numbers @var{x} and @var{y}, where the divisor @var{y} must be non-zero. @code{centered-quotient} returns the integer @var{q} and @code{centered-remainder} returns the real number @var{r} such that @address@hidden = @address@hidden + @var{r}} and address@hidden(@var{y}/2) <= @var{r} < abs(@var{y}/2)}. @code{centered/} address@hidden|@var{y}/2| <= @var{r} < |@var{y}/2|}. @code{centered/} returns both @var{q} and @var{r}, and is more efficient than computing each separately. @@ -1300,7 +1300,8 @@ rounded to the nearest integer. When @address@hidden/@var{y}} lies exactly half-way between two integers, the tie is broken according to the sign of @var{y}. If @address@hidden > 0}, ties are rounded toward positive infinity, otherwise they are rounded toward negative infinity. -This is a consequence of the requirement that @math{-abs(@var{y}/2) <= @var{r} < abs(@var{y}/2)}. +This is a consequence of the requirement that address@hidden|@var{y}/2| <= @var{r} < |@var{y}/2|}. Note that these operators are equivalent to the R6RS operators @code{div0}, @code{mod0}, and @code{div0-and-mod0}. @@ -1315,7 +1316,7 @@ Note that these operators are equivalent to the R6RS operators (centered/ -123.2 -63.5) @result{} 2.0 and 3.8 (centered/ 16/3 -10/7) @result{} -4 and -8/21 @end lisp address@hidden deffn address@hidden deftypefn @node Scientific @subsubsection Scientific Functions diff --git a/libguile/numbers.c b/libguile/numbers.c index 05840ef..8ac6412 100644 --- a/libguile/numbers.c +++ b/libguile/numbers.c @@ -1069,6 +1069,29 @@ SCM_PRIMITIVE_GENERIC (scm_modulo, "modulo", 2, 0, 0, } #undef FUNC_NAME +/* two_valued_wta_dispatch_2 is a version of SCM_WTA_DISPATCH_2 for + two-valued functions. It is called from primitive generics that take + two arguments and return two values, when the core procedure is + unable to handle the given argument types. If there are GOOPS + methods for this primitive generic, it dispatches to GOOPS and, if + successful, expects two values to be returned, which are placed in + *rp1 and *rp2. If there are no GOOPS methods, it throws a + wrong-type-arg exception. + + FIXME: This obviously belongs somewhere else, but until we decide on + the right API, it is here as a static function, because it is needed + by the *_divide functions below. +*/ +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); +} + static SCM scm_i_inexact_euclidean_quotient (double x, double y); static SCM scm_i_slow_exact_euclidean_quotient (SCM x, SCM y); @@ -1407,10 +1430,11 @@ scm_i_slow_exact_euclidean_remainder (SCM x, SCM y) } -static SCM scm_i_inexact_euclidean_divide (double x, double y); -static SCM scm_i_slow_exact_euclidean_divide (SCM x, SCM y); +static void scm_i_inexact_euclidean_divide (double x, double y, + SCM *qp, SCM *rp); +static void scm_i_slow_exact_euclidean_divide (SCM x, SCM y, SCM *qp, SCM *rp); -SCM_PRIMITIVE_GENERIC (scm_euclidean_divide, "euclidean/", 2, 0, 0, +SCM_PRIMITIVE_GENERIC (scm_i_euclidean_divide, "euclidean/", 2, 0, 0, (SCM x, SCM y), "Return the integer @var{q} and the real number @var{r}\n" "such that @address@hidden = @address@hidden + @var{r}}\n" @@ -1423,7 +1447,20 @@ SCM_PRIMITIVE_GENERIC (scm_euclidean_divide, "euclidean/", 2, 0, 0, "(euclidean/ -123.2 -63.5) @result{} 2.0 and 3.8\n" "(euclidean/ 16/3 -10/7) @result{} -3 and 22/21\n" "@end lisp") -#define FUNC_NAME s_scm_euclidean_divide +#define FUNC_NAME s_scm_i_euclidean_divide +{ + SCM q, r; + + scm_euclidean_divide(x, y, &q, &r); + return scm_values (scm_list_2 (q, r)); +} +#undef FUNC_NAME + +#define s_scm_euclidean_divide s_scm_i_euclidean_divide +#define g_scm_euclidean_divide g_scm_i_euclidean_divide + +void +scm_euclidean_divide (SCM x, SCM y, SCM *qp, SCM *rp) { if (SCM_LIKELY (SCM_I_INUMP (x))) { @@ -1437,8 +1474,6 @@ SCM_PRIMITIVE_GENERIC (scm_euclidean_divide, "euclidean/", 2, 0, 0, { scm_t_inum qq = xx / yy; scm_t_inum rr = xx % yy; - SCM q; - if (rr < 0) { if (yy > 0) @@ -1447,23 +1482,27 @@ SCM_PRIMITIVE_GENERIC (scm_euclidean_divide, "euclidean/", 2, 0, 0, { rr -= yy; qq++; } } if (SCM_LIKELY (SCM_FIXABLE (qq))) - q = SCM_I_MAKINUM (qq); + *qp = SCM_I_MAKINUM (qq); else - q = scm_i_inum2big (qq); - return scm_values (scm_list_2 (q, SCM_I_MAKINUM (rr))); + *qp = scm_i_inum2big (qq); + *rp = SCM_I_MAKINUM (rr); } + return; } else if (SCM_BIGP (y)) { if (xx >= 0) - return scm_values (scm_list_2 (SCM_INUM0, x)); + { + *qp = SCM_INUM0; + *rp = x; + } else if (mpz_sgn (SCM_I_BIG_MPZ (y)) > 0) { SCM r = scm_i_mkbig (); mpz_sub_ui (SCM_I_BIG_MPZ (r), SCM_I_BIG_MPZ (y), -xx); scm_remember_upto_here_1 (y); - return scm_values - (scm_list_2 (SCM_I_MAKINUM (-1), scm_i_normbig (r))); + *qp = SCM_I_MAKINUM (-1); + *rp = scm_i_normbig (r); } else { @@ -1471,16 +1510,19 @@ SCM_PRIMITIVE_GENERIC (scm_euclidean_divide, "euclidean/", 2, 0, 0, mpz_add_ui (SCM_I_BIG_MPZ (r), SCM_I_BIG_MPZ (y), -xx); scm_remember_upto_here_1 (y); mpz_neg (SCM_I_BIG_MPZ (r), SCM_I_BIG_MPZ (r)); - return scm_values (scm_list_2 (SCM_INUM1, scm_i_normbig (r))); + *qp = SCM_INUM1; + *rp = scm_i_normbig (r); } + return; } else if (SCM_REALP (y)) - return scm_i_inexact_euclidean_divide (xx, SCM_REAL_VALUE (y)); + return scm_i_inexact_euclidean_divide (xx, SCM_REAL_VALUE (y), qp, rp); else if (SCM_FRACTIONP (y)) - return scm_i_slow_exact_euclidean_divide (x, y); + return scm_i_slow_exact_euclidean_divide (x, y, qp, rp); else - SCM_WTA_DISPATCH_2 (g_scm_euclidean_divide, x, y, SCM_ARG2, - s_scm_euclidean_divide); + return two_valued_wta_dispatch_2 + (g_scm_euclidean_divide, x, y, SCM_ARG2, + s_scm_euclidean_divide, qp, rp); } else if (SCM_BIGP (x)) { @@ -1503,9 +1545,10 @@ SCM_PRIMITIVE_GENERIC (scm_euclidean_divide, "euclidean/", 2, 0, 0, mpz_neg (SCM_I_BIG_MPZ (q), SCM_I_BIG_MPZ (q)); } scm_remember_upto_here_1 (x); - return scm_values (scm_list_2 (scm_i_normbig (q), - SCM_I_MAKINUM (rr))); + *qp = scm_i_normbig (q); + *rp = SCM_I_MAKINUM (rr); } + return; } else if (SCM_BIGP (y)) { @@ -1518,44 +1561,46 @@ SCM_PRIMITIVE_GENERIC (scm_euclidean_divide, "euclidean/", 2, 0, 0, mpz_cdiv_qr (SCM_I_BIG_MPZ (q), SCM_I_BIG_MPZ (r), SCM_I_BIG_MPZ (x), SCM_I_BIG_MPZ (y)); scm_remember_upto_here_2 (x, y); - return scm_values (scm_list_2 (scm_i_normbig (q), - scm_i_normbig (r))); + *qp = scm_i_normbig (q); + *rp = scm_i_normbig (r); + return; } else if (SCM_REALP (y)) return scm_i_inexact_euclidean_divide - (scm_i_big2dbl (x), SCM_REAL_VALUE (y)); + (scm_i_big2dbl (x), SCM_REAL_VALUE (y), qp, rp); else if (SCM_FRACTIONP (y)) - return scm_i_slow_exact_euclidean_divide (x, y); + return scm_i_slow_exact_euclidean_divide (x, y, qp, rp); else - SCM_WTA_DISPATCH_2 (g_scm_euclidean_divide, x, y, SCM_ARG2, - s_scm_euclidean_divide); + return two_valued_wta_dispatch_2 + (g_scm_euclidean_divide, x, y, SCM_ARG2, + s_scm_euclidean_divide, qp, rp); } else if (SCM_REALP (x)) { if (SCM_REALP (y) || SCM_I_INUMP (y) || SCM_BIGP (y) || SCM_FRACTIONP (y)) return scm_i_inexact_euclidean_divide - (SCM_REAL_VALUE (x), scm_to_double (y)); + (SCM_REAL_VALUE (x), scm_to_double (y), qp, rp); else - SCM_WTA_DISPATCH_2 (g_scm_euclidean_divide, x, y, SCM_ARG2, - s_scm_euclidean_divide); + return two_valued_wta_dispatch_2 + (g_scm_euclidean_divide, x, y, SCM_ARG2, + s_scm_euclidean_divide, qp, rp); } else if (SCM_FRACTIONP (x)) { if (SCM_REALP (y)) return scm_i_inexact_euclidean_divide - (scm_i_fraction2double (x), SCM_REAL_VALUE (y)); + (scm_i_fraction2double (x), SCM_REAL_VALUE (y), qp, rp); else - return scm_i_slow_exact_euclidean_divide (x, y); + return scm_i_slow_exact_euclidean_divide (x, y, qp, rp); } else - SCM_WTA_DISPATCH_2 (g_scm_euclidean_divide, x, y, SCM_ARG1, - s_scm_euclidean_divide); + return two_valued_wta_dispatch_2 (g_scm_euclidean_divide, x, y, SCM_ARG1, + s_scm_euclidean_divide, qp, rp); } -#undef FUNC_NAME -static SCM -scm_i_inexact_euclidean_divide (double x, double y) +static void +scm_i_inexact_euclidean_divide (double x, double y, SCM *qp, SCM *rp) { double q, r; @@ -1568,32 +1613,32 @@ scm_i_inexact_euclidean_divide (double x, double y) else q = guile_NaN; r = x - q * y; - return scm_values (scm_list_2 (scm_from_double (q), - scm_from_double (r))); + *qp = scm_from_double (q); + *rp = scm_from_double (r); } /* Compute exact euclidean quotient and remainder the slow way. We use this only if both arguments are exact, and at least one of them is a fraction */ -static SCM -scm_i_slow_exact_euclidean_divide (SCM x, SCM y) +static void +scm_i_slow_exact_euclidean_divide (SCM x, SCM y, SCM *qp, SCM *rp) { - SCM q, r; + SCM q; if (!(SCM_I_INUMP (x) || SCM_BIGP (x) || SCM_FRACTIONP (x))) - SCM_WTA_DISPATCH_2 (g_scm_euclidean_divide, x, y, SCM_ARG1, - s_scm_euclidean_divide); + return two_valued_wta_dispatch_2 (g_scm_euclidean_divide, x, y, SCM_ARG1, + s_scm_euclidean_divide, qp, rp); else if (!(SCM_I_INUMP (y) || SCM_BIGP (y) || SCM_FRACTIONP (y))) - SCM_WTA_DISPATCH_2 (g_scm_euclidean_divide, x, y, SCM_ARG2, - s_scm_euclidean_divide); + return two_valued_wta_dispatch_2 (g_scm_euclidean_divide, x, y, SCM_ARG2, + s_scm_euclidean_divide, qp, rp); else if (scm_is_true (scm_positive_p (y))) q = scm_floor (scm_divide (x, y)); else if (scm_is_true (scm_negative_p (y))) q = scm_ceiling (scm_divide (x, y)); else scm_num_overflow (s_scm_euclidean_divide); - r = scm_difference (x, scm_product (q, y)); - return scm_values (scm_list_2 (q, r)); + *qp = q; + *rp = scm_difference (x, scm_product (q, y)); } static SCM scm_i_inexact_centered_quotient (double x, double y); @@ -2052,11 +2097,12 @@ scm_i_slow_exact_centered_remainder (SCM x, SCM y) } -static SCM scm_i_inexact_centered_divide (double x, double y); -static SCM scm_i_bigint_centered_divide (SCM x, SCM y); -static SCM scm_i_slow_exact_centered_divide (SCM x, SCM y); +static void scm_i_inexact_centered_divide (double x, double y, + SCM *qp, SCM *rp); +static void scm_i_bigint_centered_divide (SCM x, SCM y, SCM *qp, SCM *rp); +static void scm_i_slow_exact_centered_divide (SCM x, SCM y, SCM *qp, SCM *rp); -SCM_PRIMITIVE_GENERIC (scm_centered_divide, "centered/", 2, 0, 0, +SCM_PRIMITIVE_GENERIC (scm_i_centered_divide, "centered/", 2, 0, 0, (SCM x, SCM y), "Return the integer @var{q} and the real number @var{r}\n" "such that @address@hidden = @address@hidden + @var{r}}\n" @@ -2069,7 +2115,20 @@ SCM_PRIMITIVE_GENERIC (scm_centered_divide, "centered/", 2, 0, 0, "(centered/ -123.2 -63.5) @result{} 2.0 and 3.8\n" "(centered/ 16/3 -10/7) @result{} -4 and -8/21\n" "@end lisp") -#define FUNC_NAME s_scm_centered_divide +#define FUNC_NAME s_scm_i_centered_divide +{ + SCM q, r; + + scm_centered_divide(x, y, &q, &r); + return scm_values (scm_list_2 (q, r)); +} +#undef FUNC_NAME + +#define s_scm_centered_divide s_scm_i_centered_divide +#define g_scm_centered_divide g_scm_i_centered_divide + +void +scm_centered_divide (SCM x, SCM y, SCM *qp, SCM *rp) { if (SCM_LIKELY (SCM_I_INUMP (x))) { @@ -2083,8 +2142,6 @@ SCM_PRIMITIVE_GENERIC (scm_centered_divide, "centered/", 2, 0, 0, { scm_t_inum qq = xx / yy; scm_t_inum rr = xx % yy; - SCM q; - if (SCM_LIKELY (xx > 0)) { if (SCM_LIKELY (yy > 0)) @@ -2112,25 +2169,27 @@ SCM_PRIMITIVE_GENERIC (scm_centered_divide, "centered/", 2, 0, 0, } } if (SCM_LIKELY (SCM_FIXABLE (qq))) - q = SCM_I_MAKINUM (qq); + *qp = SCM_I_MAKINUM (qq); else - q = scm_i_inum2big (qq); - return scm_values (scm_list_2 (q, SCM_I_MAKINUM (rr))); + *qp = scm_i_inum2big (qq); + *rp = SCM_I_MAKINUM (rr); } + return; } else if (SCM_BIGP (y)) { /* Pass a denormalized bignum version of x (even though it can fit in a fixnum) to scm_i_bigint_centered_divide */ - return scm_i_bigint_centered_divide (scm_i_long2big (xx), y); + return scm_i_bigint_centered_divide (scm_i_long2big (xx), y, qp, rp); } else if (SCM_REALP (y)) - return scm_i_inexact_centered_divide (xx, SCM_REAL_VALUE (y)); + return scm_i_inexact_centered_divide (xx, SCM_REAL_VALUE (y), qp, rp); else if (SCM_FRACTIONP (y)) - return scm_i_slow_exact_centered_divide (x, y); + return scm_i_slow_exact_centered_divide (x, y, qp, rp); else - SCM_WTA_DISPATCH_2 (g_scm_centered_divide, x, y, SCM_ARG2, - s_scm_centered_divide); + return two_valued_wta_dispatch_2 + (g_scm_centered_divide, x, y, SCM_ARG2, + s_scm_centered_divide, qp, rp); } else if (SCM_BIGP (x)) { @@ -2171,47 +2230,49 @@ SCM_PRIMITIVE_GENERIC (scm_centered_divide, "centered/", 2, 0, 0, rr -= yy; } } - return scm_values (scm_list_2 (scm_i_normbig (q), - SCM_I_MAKINUM (rr))); + *qp = scm_i_normbig (q); + *rp = SCM_I_MAKINUM (rr); } + return; } else if (SCM_BIGP (y)) - return scm_i_bigint_centered_divide (x, y); + return scm_i_bigint_centered_divide (x, y, qp, rp); else if (SCM_REALP (y)) return scm_i_inexact_centered_divide - (scm_i_big2dbl (x), SCM_REAL_VALUE (y)); + (scm_i_big2dbl (x), SCM_REAL_VALUE (y), qp, rp); else if (SCM_FRACTIONP (y)) - return scm_i_slow_exact_centered_divide (x, y); + return scm_i_slow_exact_centered_divide (x, y, qp, rp); else - SCM_WTA_DISPATCH_2 (g_scm_centered_divide, x, y, SCM_ARG2, - s_scm_centered_divide); + return two_valued_wta_dispatch_2 + (g_scm_centered_divide, x, y, SCM_ARG2, + s_scm_centered_divide, qp, rp); } else if (SCM_REALP (x)) { if (SCM_REALP (y) || SCM_I_INUMP (y) || SCM_BIGP (y) || SCM_FRACTIONP (y)) return scm_i_inexact_centered_divide - (SCM_REAL_VALUE (x), scm_to_double (y)); + (SCM_REAL_VALUE (x), scm_to_double (y), qp, rp); else - SCM_WTA_DISPATCH_2 (g_scm_centered_divide, x, y, SCM_ARG2, - s_scm_centered_divide); + return two_valued_wta_dispatch_2 + (g_scm_centered_divide, x, y, SCM_ARG2, + s_scm_centered_divide, qp, rp); } else if (SCM_FRACTIONP (x)) { if (SCM_REALP (y)) return scm_i_inexact_centered_divide - (scm_i_fraction2double (x), SCM_REAL_VALUE (y)); + (scm_i_fraction2double (x), SCM_REAL_VALUE (y), qp, rp); else - return scm_i_slow_exact_centered_divide (x, y); + return scm_i_slow_exact_centered_divide (x, y, qp, rp); } else - SCM_WTA_DISPATCH_2 (g_scm_centered_divide, x, y, SCM_ARG1, - s_scm_centered_divide); + return two_valued_wta_dispatch_2 (g_scm_centered_divide, x, y, SCM_ARG1, + s_scm_centered_divide, qp, rp); } -#undef FUNC_NAME -static SCM -scm_i_inexact_centered_divide (double x, double y) +static void +scm_i_inexact_centered_divide (double x, double y, SCM *qp, SCM *rp) { double q, r; @@ -2224,14 +2285,14 @@ scm_i_inexact_centered_divide (double x, double y) else q = guile_NaN; r = x - q * y; - return scm_values (scm_list_2 (scm_from_double (q), - scm_from_double (r))); + *qp = scm_from_double (q); + *rp = scm_from_double (r); } /* Assumes that both x and y are bigints, though x might be able to fit into a fixnum. */ -static SCM -scm_i_bigint_centered_divide (SCM x, SCM y) +static void +scm_i_bigint_centered_divide (SCM x, SCM y, SCM *qp, SCM *rp) { SCM q, r, min_r; @@ -2276,24 +2337,24 @@ scm_i_bigint_centered_divide (SCM x, SCM y) } } scm_remember_upto_here_2 (x, y); - return scm_values (scm_list_2 (scm_i_normbig (q), - scm_i_normbig (r))); + *qp = scm_i_normbig (q); + *rp = scm_i_normbig (r); } /* Compute exact centered quotient and remainder the slow way. We use this only if both arguments are exact, and at least one of them is a fraction */ -static SCM -scm_i_slow_exact_centered_divide (SCM x, SCM y) +static void +scm_i_slow_exact_centered_divide (SCM x, SCM y, SCM *qp, SCM *rp) { - SCM q, r; + SCM q; if (!(SCM_I_INUMP (x) || SCM_BIGP (x) || SCM_FRACTIONP (x))) - SCM_WTA_DISPATCH_2 (g_scm_centered_divide, x, y, SCM_ARG1, - s_scm_centered_divide); + return two_valued_wta_dispatch_2 (g_scm_centered_divide, x, y, SCM_ARG1, + s_scm_centered_divide, qp, rp); else if (!(SCM_I_INUMP (y) || SCM_BIGP (y) || SCM_FRACTIONP (y))) - SCM_WTA_DISPATCH_2 (g_scm_centered_divide, x, y, SCM_ARG2, - s_scm_centered_divide); + return two_valued_wta_dispatch_2 (g_scm_centered_divide, x, y, SCM_ARG2, + s_scm_centered_divide, qp, rp); else if (scm_is_true (scm_positive_p (y))) q = scm_floor (scm_sum (scm_divide (x, y), exactly_one_half)); @@ -2302,8 +2363,8 @@ scm_i_slow_exact_centered_divide (SCM x, SCM y) exactly_one_half)); else scm_num_overflow (s_scm_centered_divide); - r = scm_difference (x, scm_product (q, y)); - return scm_values (scm_list_2 (q, r)); + *qp = q; + *rp = scm_difference (x, scm_product (q, y)); } diff --git a/libguile/numbers.h b/libguile/numbers.h index 10a4f17..b8529a3 100644 --- a/libguile/numbers.h +++ b/libguile/numbers.h @@ -178,10 +178,10 @@ SCM_API SCM scm_abs (SCM x); SCM_API SCM scm_quotient (SCM x, SCM y); SCM_API SCM scm_remainder (SCM x, SCM y); SCM_API SCM scm_modulo (SCM x, SCM y); -SCM_API SCM scm_euclidean_divide (SCM x, SCM y); +SCM_API void scm_euclidean_divide (SCM x, SCM y, SCM *q, SCM *r); SCM_API SCM scm_euclidean_quotient (SCM x, SCM y); SCM_API SCM scm_euclidean_remainder (SCM x, SCM y); -SCM_API SCM scm_centered_divide (SCM x, SCM y); +SCM_API void scm_centered_divide (SCM x, SCM y, SCM *q, SCM *r); SCM_API SCM scm_centered_quotient (SCM x, SCM y); SCM_API SCM scm_centered_remainder (SCM x, SCM y); SCM_API SCM scm_gcd (SCM x, SCM y); @@ -199,6 +199,9 @@ SCM_API SCM scm_bit_extract (SCM n, SCM start, SCM end); SCM_API SCM scm_logcount (SCM n); SCM_API SCM scm_integer_length (SCM n); +SCM_INTERNAL SCM scm_i_euclidean_divide (SCM x, SCM y); +SCM_INTERNAL SCM scm_i_centered_divide (SCM x, SCM y); + SCM_INTERNAL SCM scm_i_gcd (SCM x, SCM y, SCM rest); SCM_INTERNAL SCM scm_i_lcm (SCM x, SCM y, SCM rest); SCM_INTERNAL SCM scm_i_logand (SCM x, SCM y, SCM rest); -- 1.7.1