~ chicken-core (chicken-5) 69cf7a985c6bdc0c2c8c154fea3dccb08e7bb4a1

commit 69cf7a985c6bdc0c2c8c154fea3dccb08e7bb4a1
Author:     Peter Bex <peter@more-magic.net>
AuthorDate: Wed May 22 13:58:11 2024 +0200
Commit:     felix <felix@call-with-current-continuation.org>
CommitDate: Wed May 22 17:01:17 2024 +0200

    Call integer_divrem straight from the modulo operations
    
    These would call C_s_a_i_remainder initially, which performs many of
    the same checks that we've just already done before actually calling
    integer_divrem.  It also allocates more memory on the stack which is
    not necessary.
    
    In the case of the generic operator, doing so requires duplicating the
    code which converts floating-point integers to exact integers and back
    again.
    
    In the case of the integer-specific operator, there's no point in
    calling the *generic* remainder function in the first place!
    
    Signed-off-by: felix <felix@call-with-current-continuation.org>

diff --git a/runtime.c b/runtime.c
index 5116ed37..29dbcb00 100644
--- a/runtime.c
+++ b/runtime.c
@@ -9243,7 +9243,8 @@ C_s_a_u_i_integer_remainder(C_word **ptr, C_word n, C_word x, C_word y)
 C_regparm C_word C_fcall
 C_s_a_i_modulo(C_word **ptr, C_word n, C_word x, C_word y)
 {
-  C_word ab[C_SIZEOF_FIX_BIGNUM], *a = ab, r;
+  C_word ab[C_SIZEOF_FIX_BIGNUM], *a = ab, r,
+         nx = C_SCHEME_FALSE, ny = C_SCHEME_FALSE;
 
   if (!C_truep(C_i_integerp(x)))
     barf(C_BAD_ARGUMENT_TYPE_NO_INTEGER_ERROR, "modulo", x);
@@ -9251,13 +9252,41 @@ C_s_a_i_modulo(C_word **ptr, C_word n, C_word x, C_word y)
     barf(C_BAD_ARGUMENT_TYPE_NO_INTEGER_ERROR, "modulo", y);
   if (C_truep(C_i_zerop(y))) C_div_by_zero_error("modulo");
 
-  r = C_s_a_i_remainder(&a, 2, x, y);
-  if (C_i_positivep(y) != C_i_positivep(r) && !C_truep(C_i_zerop(r))) {
+  if (C_truep(C_i_flonump(x))) {
+    if C_truep(C_i_flonump(y)) {
+      double dx = C_flonum_magnitude(x), dy = C_flonum_magnitude(y), tmp;
+
+      C_modf(dx / dy, &tmp);
+      tmp = dx - tmp * dy;
+      if ((dx > 0.0) != (dy > 0.0) && tmp != 0.0) {
+        return C_flonum(ptr, tmp + dy);
+      } else {
+        return C_flonum(ptr, tmp);
+      }
+    }
+    x = nx = C_s_a_u_i_flo_to_int(&a, 1, x);
+  }
+  if (C_truep(C_i_flonump(y))) {
+    y = ny = C_s_a_u_i_flo_to_int(&a, 1, y);
+  }
+
+  integer_divrem(&a, x, y, NULL, &r);
+  if (C_i_positivep(y) != C_i_positivep(r) && r != C_fix(0)) {
     C_word m = C_s_a_i_plus(ptr, 2, r, y);
     m = move_buffer_object(ptr, ab, m);
     clear_buffer_object(ab, r);
     r = m;
   }
+
+  if (C_truep(nx) || C_truep(ny)) {
+    C_word newr = C_a_i_exact_to_inexact(ptr, 1, r);
+    clear_buffer_object(ab, r);
+    r = newr;
+
+    clear_buffer_object(ab, nx);
+    clear_buffer_object(ab, ny);
+  }
+
   return move_buffer_object(ptr, ab, r);
 }
 
@@ -9267,7 +9296,7 @@ C_s_a_u_i_integer_modulo(C_word **ptr, C_word n, C_word x, C_word y)
   C_word ab[C_SIZEOF_FIX_BIGNUM], *a = ab, r;
   if (y == C_fix(0)) C_div_by_zero_error("modulo");
 
-  r = C_s_a_i_remainder(&a, 2, x, y);
+  integer_divrem(&a, x, y, NULL, &r);
   if (C_i_positivep(y) != C_i_positivep(r) && r != C_fix(0)) {
     C_word m = C_s_a_u_i_integer_plus(ptr, 2, r, y);
     m = move_buffer_object(ptr, ab, m);