Re: master: x86-64: TRUNCATE using the Lemire, Kaser, Kurz transform

The VOP gets defeated by one of the 23 transforms, when (speed 3):
https://github.com/sbcl/sbcl/blob/master/src/compiler/srctran.lisp#L5135

On Sun, Apr 19, 2026 at 5:18 AM snuglas via Sbcl-commits
<[email protected]> wrote:
>
> The branch "master" has been updated in SBCL:
>        via  ae89d7be84002e48bea7cfd8be84bd6c7896a2c0 (commit)
>       from  c41011cb52eb089b3edf219a871224afcfb8a122 (commit)
>
> - Log -----------------------------------------------------------------
> commit ae89d7be84002e48bea7cfd8be84bd6c7896a2c0
> Author: Douglas Katzman <[email protected]>
> Date:   Sat Apr 18 22:02:34 2026 -0400
>
>     x86-64: TRUNCATE using the Lemire, Kaser, Kurz transform
>
>     2 MULs outperforms one DIV or IDIV by at least 2x based on my
>     testing and also Agner Fog's instruction latency tables
> ---
>  src/code/target-package.lisp    |  2 +-
>  src/compiler/generic/utils.lisp |  8 +++++-
>  src/compiler/x86-64/arith.lisp  | 56 ++++++++++++++++++++++++++++++++++-------
>  tests/integerdiv.pure.lisp      | 18 +++++++++++++
>  4 files changed, 73 insertions(+), 11 deletions(-)
>
> diff --git a/src/code/target-package.lisp b/src/code/target-package.lisp
> index 1fc56ea2f..97135bea5 100644
> --- a/src/code/target-package.lisp
> +++ b/src/code/target-package.lisp
> @@ -439,7 +439,7 @@ of :INHERITED :EXTERNAL :INTERNAL."
>           (n min-numerator-bits))
>      (loop
>       (multiple-value-bind (c frac-bits)
> -         (sb-c:compute-fastrem-coefficient denominator n :variable)
> +         (sb-c:compute-fastrem-coefficient denominator n :minimum)
>         (cond ((= frac-bits 32)
>                (return (values (ldb (byte n 0) -1) c)))
>               ((> frac-bits 32)
> diff --git a/src/compiler/generic/utils.lisp b/src/compiler/generic/utils.lisp
> index 4a8a39cc1..85e6f5533 100644
> --- a/src/compiler/generic/utils.lisp
> +++ b/src/compiler/generic/utils.lisp
> @@ -577,7 +577,7 @@
>                         (when (<= d (+ (mod 2^F d) (expt 2 L)))
>                           (let ((c (ceiling (expt 2 F) d)))
>                             (return (values F c))))))))
> -    (cond ((eq fraction-bits :variable) ; return the smallest F
> +    (cond ((eq fraction-bits :minimum) ; return the smallest F
>             (values c smallest-f))
>            (t
>             ;; Otherwise hardwire F to 32 so the algorithm can use :DWORD
> @@ -589,6 +589,12 @@
>                      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.
> +  (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/x86-64/arith.lisp b/src/compiler/x86-64/arith.lisp
> index 31ab987a4..2b5b9de99 100644
> --- a/src/compiler/x86-64/arith.lisp
> +++ b/src/compiler/x86-64/arith.lisp
> @@ -2056,13 +2056,13 @@
>
>  (define-vop (fast-truncate-c/fixnum=>fixnum fast-safe-arith-op)
>    (:translate truncate)
> -  (:args (x :scs (any-reg) :target eax))
> +  (:args (x :scs (any-reg) :target rax))
>    (:info y)
>    (:arg-types tagged-num (:constant fixnum))
>    (:temporary (:sc signed-reg :offset rax-offset :target quo
> -                   :from :argument :to (:result 0)) eax)
> +                   :from :argument :to (:result 0)) rax)
>    (:temporary (:sc any-reg :offset rdx-offset :target rem
> -                   :from :eval :to (:result 1)) edx)
> +                   :from :eval :to (:result 1)) rdx)
>    (:temporary (:sc any-reg :from :eval :to :result) y-arg)
>    (:results (quo :scs (any-reg))
>              (rem :scs (any-reg)))
> @@ -2070,16 +2070,54 @@
>    (:note "inline fixnum arithmetic")
>    (:vop-var vop)
>    (:generator 30
> -    (move eax x)
> +   (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 (not (sb-c::tn-reads quo))
> +               (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))
>      (inst idiv y-arg)
> -    (if (location= quo eax)
> -        (inst shl eax n-fixnum-tag-bits)
> +    (if (location= quo rax)
> +        (inst shl rax n-fixnum-tag-bits)
>          (if (= n-fixnum-tag-bits 1)
> -            (inst lea quo (ea eax eax))
> -            (inst lea quo (ea nil eax (ash 1 n-fixnum-tag-bits)))))
> -    (move rem edx)))
> +            (inst lea quo (ea rax rax))
> +            (inst lea quo (ea nil rax (ash 1 n-fixnum-tag-bits)))))
> +    (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 a9ca38873..e28763756 100644
> --- a/tests/integerdiv.pure.lisp
> +++ b/tests/integerdiv.pure.lisp
> @@ -150,3 +150,21 @@
>    (loop for divisor from 3 to 10000
>          do (format t "divisor=~d~%" divisor)
>              (try-fastrem divisor 18)))
> +
> +(declaim (ftype function remN))
> +#+x86-64 ; test the TRUNCATE -> fastrem optimization
> +(with-test (:name :test-rem-transform)
> +  (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)))
> +      ;; should not use DIV or IDIV instructions
> +      (assert (not (search "DIV" (with-output-to-string (s) (disassemble 'remN :stream s)))))
> +      (dotimes (i 10000)
> +        (declare (notinline floor))
> +        (assert (= (remn i) (nth-value 1 (floor i divisor)))))
> +      (let ((max (ash 1 dividend-bits)))
> +        (dotimes (i 10000)
> +          (let ((x (random max)))
> +            (declare (notinline floor))
> +            (assert (= (remn x) (nth-value 1 (floor x divisor))))))))))
>
> -----------------------------------------------------------------------
>
>
> hooks/post-receive
> --
> SBCL
>
>
> _______________________________________________
> Sbcl-commits mailing list
> [email protected]
> https://lists.sourceforge.net/lists/listinfo/sbcl-commits


_______________________________________________
Sbcl-commits mailing list
[email protected]
https://lists.sourceforge.net/lists/listinfo/sbcl-commits