master: Implement choice of using fastrem in IR1 transform

The branch "master" has been updated in SBCL:
       via  914726b494c081ae0a4cfe5e21c92f7532ff7f98 (commit)
      from  cfdbd482aa0e894d85f23664bfeece658df325f1 (commit)

- Log -----------------------------------------------------------------
commit 914726b494c081ae0a4cfe5e21c92f7532ff7f98
Author: Douglas Katzman <[email protected]>
Date:   Sun Apr 19 16:30:24 2026 -0400

    Implement choice of using fastrem in IR1 transform
---
 src/compiler/generic/utils.lisp |  7 -------
 src/compiler/srctran.lisp       | 37 +++++++++++++++++++++++++++++++++++++
 src/compiler/x86-64/arith.lisp  | 40 +---------------------------------------
 tests/integerdiv.pure.lisp      |  7 ++++---
 4 files changed, 42 insertions(+), 49 deletions(-)

diff --git a/src/compiler/generic/utils.lisp b/src/compiler/generic/utils.lisp
index cdff56dab..9a865c658 100644
--- a/src/compiler/generic/utils.lisp
+++ b/src/compiler/generic/utils.lisp
@@ -589,13 +589,6 @@
                     smallest-f d n))
            (values (ceiling (expt 2 fraction-bits) d) fraction-bits)))))
 
-(defun type-width-in-bits (ctype)
-  ;; Return (integer-length upper-bound) of numeric type. This is NOT a theoretical
-  ;; smallest N bits needed to encode an element of type in a packed representation
-  ;; (e.g. the interval 5..8 _could_ be stored in 2 bits) but we don't do that.
-  (if (typep ctype 'numeric-union-type)
-      (integer-length (sb-c::interval-high (sb-c::numeric-type->interval ctype)))))
-
 (defun env-system-tlab-p (env)
   #-system-tlabs (declare (ignore env))
   #+system-tlabs
diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp
index 4c722a27c..d48a4d38c 100644
--- a/src/compiler/srctran.lisp
+++ b/src/compiler/srctran.lisp
@@ -5123,6 +5123,30 @@
                     (define-source-transform %multiply-high (x y)
                       `(values (sb-bignum:%multiply ,x ,y))))
 
+(defun try-fastrem-algorithm (numerator-precision divisor)
+  ;; The reason for the concern about inputs is that for the general algorithm to accept
+  ;; any 64-bit integer (if FIXNUM, 62 bits) it needs 4 MUL instructions
+  ;; (confirmed by looking at https://github.com/lemire/fastmod)
+  ;; But 2 MUL instructions are enough for reasonable inputs. Both the divisor and the
+  ;; maximum input affect how many bits are needed in intermediate results.
+  (binding* (((magic smallest-nbits)
+              (sb-c:compute-fastrem-coefficient divisor numerator-precision :minimum))
+             (frac-bits
+              ;; "smallest" is how many bits you need for the algorithm to work, assuming
+              ;; you could actually calculate on bit fields of arbitrary size. But to make it
+              ;; efficient, you need a fixed-binary-point reciprocal in exactly 32 bits
+              ;; or exactly 64 bits (or 128, if fully supporting 64-bit ints)
+              (cond ((<= smallest-nbits 32) 32)
+                    #+64-bit
+                    ((<= smallest-nbits 64) 64))))
+    (when frac-bits
+      (when (/= smallest-nbits frac-bits) ; recompute MAGIC to required number of bits
+        (setq magic (sb-c:compute-fastrem-coefficient divisor numerator-precision frac-bits)))
+      (case frac-bits
+        (32 `(values 0 (sb-vm::fastrem-32 x ,magic ,divisor)))
+        #+64-bit
+        (64 `(values 0 (sb-vm::fastrem-64 x ,magic ,divisor)))))))
+
 ;;; If the divisor is constant and both args are positive and fit in a
 ;;; machine word, replace the division by a multiplication and possibly
 ;;; some shifts and an addition. Calculate the remainder by a second
@@ -5152,7 +5176,15 @@
     (let ((rem (and (mv-bind-unused-p result 0)
                     (mv-bind-dest result 1 t)))
           plusp)
+      ;; When only a remainder is needed, there are two ways of going about it:
+      ;; * Using the well-entrenched divide-by-multiplying technique, compute the quotient and
+      ;;   then subtract the product of (quotient x divisor) from the original input.
+      ;; * The Lemire et. al. technique avoids subtracting.  It also offers a way to determine
+      ;;   divisibility (0 remainder) with 1 fewer step, though our way is fairly good too.
+      ;; Therefore, if just getting a remainder and neither COMBINATION-MATCHES-P is true,
+      ;; we try the Lemire transform before falling back to the traditional way.
       (or
+       ;; Choice 1
        (when (and rem
                   (or (combination-matches 'eq '(* 0) rem)
                       (and (combination-matches '> '(* 0) rem)
@@ -5183,6 +5215,11 @@
                                          `(> (rotate-right-word (truly-the word (logand (* x ,inv) ,max-x))
                                                                 ,zeros)
                                              ,(truncate max-x y)))))))))
+       ;; Choice 2
+       (and rem (binding* ((form (try-fastrem-algorithm (integer-length max-x) y) :exit-if-null))
+                  (erase-node-type node t 0)
+                  form))
+       ;; Choice 3
        `(let* ((quot (truly-the (integer 0 ,(truncate max-x y))
                                 ,(gen-unsigned-div-by-constant-expr y max-x)))
                (rem (truly-the (mod ,y)
diff --git a/src/compiler/x86-64/arith.lisp b/src/compiler/x86-64/arith.lisp
index 4f7da4e0c..74209f64a 100644
--- a/src/compiler/x86-64/arith.lisp
+++ b/src/compiler/x86-64/arith.lisp
@@ -2071,44 +2071,6 @@
   (:note "inline fixnum arithmetic")
   (:vop-var vop)
   (:generator 30
-   (block nil
-    ;; This ought to be done machine-independently, but there are already 23 transforms
-    ;; on TRUNCATE and I don't understand how they get tried in the optimal order.
-    ;; The benefit of that is we could just invoke the fastrem-32 or fastrem-64 vop
-    ;; rather than having to replicate them inside here.
-    (when (and (eq (tn-kind quo) :unused)
-               (typep y '(unsigned-byte 64))
-               (csubtypep (tn-ref-type (vop-args vop)) (specifier-type '(unsigned-byte 64))))
-      ;; The reason for the concern about inputs is that the general algorithm to accept
-      ;; any 64-bit integer (which as FIXNUM would limit be 62 bits) needs 4 MUL instructions
-      ;; (confirmed by looking at https://github.com/lemire/fastmod)
-      ;; But 2 MUL instructions is enough for reasonable inputs. Both the divisor and the
-      ;; maximum input affect how many bits are needed in intermediate results.
-      (binding* ((numerator-precision
-                  (type-width-in-bits (tn-ref-type (vop-args vop))) :exit-if-null)
-                 ((magic smallest-nbits)
-                  (sb-c:compute-fastrem-coefficient y numerator-precision :minimum))
-                 ((frac-bits operand-size)
-                  ;; "smallest" is how many bits you need for the algorithm to work, assuming
-                  ;; you could actually calculate on bit fields of arbitrary size. But to make it
-                  ;; efficient, you need a fixed-binary-point reciprocal in exactly 32 bits
-                  ;; or exactly 64 bits (or 128, if fully supporting 64-bit ints)
-                  (cond ((<= smallest-nbits 32) (values 32 :dword))
-                        ((<= smallest-nbits 64) (values 64 :qword)))))
-        (when operand-size
-          (when (/= smallest-nbits frac-bits) ; recompute MAGIC to required number of bits
-            (setq magic (sb-c:compute-fastrem-coefficient y numerator-precision frac-bits)))
-          (let ((arg-size (if (<= numerator-precision 31) :dword :qword)))
-            (move rax x arg-size)
-            (inst shr arg-size rax n-fixnum-tag-bits)) ; untag it
-          (inst mul operand-size (register-inline-constant operand-size magic))
-          (inst mul operand-size (register-inline-constant operand-size y))
-          ;; The result might fit into a :DWORD depending on the divisor
-          (let ((res-size (if (<= (integer-length (1- y)) 31) :dword :qword))) ; (tagged)
-            (if (location= rem rdx)
-                (inst shl res-size rem 1)
-                (inst lea res-size rem (ea rdx rdx))))
-          (return))))
     (move rax x)
     (inst cqo)
     (inst mov y-arg (fixnumize y))
@@ -2119,7 +2081,7 @@
           (if (= n-fixnum-tag-bits 1)
               (inst lea quo (ea rax rax))
               (inst lea quo (ea nil rax (ash 1 n-fixnum-tag-bits))))))
-    (move rem rdx))))
+    (move rem rdx)))
 
 (define-vop (fast-truncate/unsigned=>unsigned fast-safe-arith-op)
   (:translate truncate)
diff --git a/tests/integerdiv.pure.lisp b/tests/integerdiv.pure.lisp
index e28763756..c43cf7b6f 100644
--- a/tests/integerdiv.pure.lisp
+++ b/tests/integerdiv.pure.lisp
@@ -152,12 +152,13 @@
             (try-fastrem divisor 18)))
 
 (declaim (ftype function remN))
-#+x86-64 ; test the TRUNCATE -> fastrem optimization
-(with-test (:name :test-rem-transform)
+(with-test (:name :test-rem-transform :skipped-on (:not :64-bit)) ; incomplete support for 32-bit
   (dolist (dividend-bits '(24 58))
     ;; a divisor of 1235 needs too many intermediate bits for dividend-bits=58
     (dolist (divisor `(3 7 133 ,(if (= dividend-bits 24) 1235 149)))
-      (compile 'remN `(lambda (x) (rem (the (unsigned-byte ,dividend-bits) x) ,divisor)))
+      (compile 'remN `(lambda (x)
+                        (declare (optimize speed))
+                        (rem (the (unsigned-byte ,dividend-bits) x) ,divisor)))
       ;; should not use DIV or IDIV instructions
       (assert (not (search "DIV" (with-output-to-string (s) (disassemble 'remN :stream s)))))
       (dotimes (i 10000)

-----------------------------------------------------------------------


hooks/post-receive
-- 
SBCL