Re: master: Don't flush division operations

The next step is for fun-info-flushable to return a form to substitute with.

On Fri, Jan 30, 2026 at 4:50 PM Charles Zhang via Sbcl-commits
<[email protected]> wrote:
>
> Could we instead replace flushed combinations with a truly-the cast or something similar so that we can still flush the combinations but keep the type constraint?
>
> On Friday, January 30, 2026, 2:48 AM, stassats via Sbcl-commits <[email protected]> wrote:
>
> The branch "master" has been updated in SBCL:
>       via  0ca806dfb37d380eb7aa10757410a209d9b76114 (commit)
>       from  3d42fce84d4394a6efcc38c741ef701dff6042ef (commit)
>
> - Log -----------------------------------------------------------------
> commit 0ca806dfb37d380eb7aa10757410a209d9b76114
> Author: Stas Boukarev <[email protected]>
> Date:  Fri Jan 30 04:29:55 2026 +0300
>
>     Don't flush division operations
>
>     Division operations produce constraints that the divisor is not zero
>     afterwards. Which is probably more helpful than not calling them.
> ---
> src/compiler/fndb.lisp    | 18 +++++++++---------
> src/compiler/ir1util.lisp | 13 ++++++++-----
> src/compiler/srctran.lisp |  9 +++++++++
> 3 files changed, 26 insertions(+), 14 deletions(-)
>
> diff --git a/src/compiler/fndb.lisp b/src/compiler/fndb.lisp
> index 5dddc1f66..188fef512 100644
> --- a/src/compiler/fndb.lisp
> +++ b/src/compiler/fndb.lisp
> @@ -237,7 +237,7 @@
> (defknown - (number &rest number) number
>   (movable foldable flushable))
> (defknown / (number &rest number) number
> -  (movable foldable unsafely-flushable))
> +  (movable foldable))
> (defknown (1+ 1-) (number) number
>   (movable foldable flushable))
>
> @@ -251,7 +251,7 @@
>
> (defknown sb-kernel::integer-/-integer
>   (integer integer) rational
> -  (no-verify-arg-count unsafely-flushable))
> +  (no-verify-arg-count))
>
> (defknown (two-arg-< two-arg-= two-arg-> two-arg-<= two-arg->=)
>     (number number) boolean
> @@ -360,20 +360,20 @@
>
> (defknown (floor ceiling)
>   (real &optional real) (values integer real)
> -  (movable foldable flushable))
> +  (movable foldable))
>
> (defknown (truncate round)
>   (real &optional real) (values integer real)
> -  (movable foldable flushable recursive))
> +  (movable foldable recursive))
>
> (defknown (sb-kernel::floor1 sb-kernel::ceiling1) (real real) integer
> -  (movable foldable flushable no-verify-arg-count))
> +  (movable foldable no-verify-arg-count))
>
> (defknown (sb-kernel::truncate1 sb-kernel::round1) (real real) integer
> -  (movable foldable flushable recursive no-verify-arg-count))
> +  (movable foldable recursive no-verify-arg-count))
>
> (defknown (sb-kernel::ftruncate1 sb-kernel::ffloor1 sb-kernel::fceiling1 sb-kernel::fround1) (real real) float
> -  (movable foldable flushable no-verify-arg-count))
> +  (movable foldable no-verify-arg-count))
>
> (defknown unary-truncate (real) (values integer real)
>   (movable foldable flushable no-verify-arg-count))
> @@ -431,11 +431,11 @@
>   (movable foldable flushable no-verify-arg-count))
>
> (defknown (mod rem) (real real) real
> -    (movable foldable flushable))
> +    (movable foldable))
>
> (defknown (ffloor fceiling fround ftruncate)
>   (real &optional real) (values float real)
> -  (movable foldable flushable))
> +  (movable foldable))
>
> (defknown decode-float (float) (values float float-exponent float)
>   (movable foldable unsafely-flushable))
> diff --git a/src/compiler/ir1util.lisp b/src/compiler/ir1util.lisp
> index 80c485e29..e93471b0d 100644
> --- a/src/compiler/ir1util.lisp
> +++ b/src/compiler/ir1util.lisp
> @@ -1466,11 +1466,14 @@
>   (let ((kind (combination-kind call))
>         (info (combination-fun-info call)))
>     (or (when (and (eq kind :known) (fun-info-p info))
> -          (let ((attr (fun-info-attributes info)))
> -            (and (if (policy call (= safety 3))
> -                    (ir1-attributep attr flushable)
> -                    (ir1-attributep attr unsafely-flushable))
> -                (flushable-combination-args-p call info))))
> +          (let ((attr (fun-info-attributes info))
> +                (flushable-test (fun-info-flushable info)))
> +            (if flushable-test
> +                (funcall flushable-test call)
> +                (and (if (policy call (= safety 3))
> +                        (ir1-attributep attr flushable)
> +                        (ir1-attributep attr unsafely-flushable))
> +                    (flushable-combination-args-p call info)))))
>         ;; Is it declared flushable locally?
>         (let ((name (lvar-fun-name (combination-fun call) t)))
>           (memq name (lexenv-flushable (node-lexenv call)))))))
> diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp
> index 87807bfbf..0d62506b4 100644
> --- a/src/compiler/srctran.lisp
> +++ b/src/compiler/srctran.lisp
> @@ -6240,6 +6240,15 @@
>   (def ffloor)
>   (def fceiling))
>
> +(defoptimizers flushable (truncate ceiling floor round ftruncate fceiling ffloor fround)
> +    ((number &optional divisor))
> +  (or (not divisor)
> +      (not (types-equal-or-intersect (lvar-type divisor) (specifier-type '(real 0 0))))))
> +
> +(defoptimizer (/ flushable) ((number &optional divisor))
> +  (not (types-equal-or-intersect (lvar-type (or divisor number))
> +                                (specifier-type '(or (real 0 0) complex)))))
> +
>
> ;;;; character operations
>
>
> -----------------------------------------------------------------------
>
>
> 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


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