From 246af004128d9e0d567bacf79a61c7acf43b2512 Mon Sep 17 00:00:00 2001 From: Stas Boukarev Date: Sun, 19 Jul 2026 01:02:19 +0300 Subject: [PATCH] Don't signal errors for (log qnan) Fixes lp#2160268 --- src/code/float.lisp | 22 ++++ src/code/irrat.lisp | 22 ++-- src/cold/exports.lisp | 3 +- src/compiler/arm/float.lisp | 32 ++--- src/compiler/arm64/float.lisp | 28 +++-- src/compiler/float-tran.lisp | 24 ++-- src/compiler/fndb.lisp | 3 + src/compiler/loongarch64/float.lisp | 12 +- src/compiler/mips/float.lisp | 4 +- src/compiler/ppc/float.lisp | 16 ++- src/compiler/ppc64/float.lisp | 16 ++- src/compiler/riscv/float.lisp | 4 +- src/compiler/sparc/float.lisp | 26 +++-- src/compiler/x86-64/float.lisp | 38 +++++- src/compiler/x86/float.lisp | 175 +++++++++++++++++++--------- xperfecthash63.lisp-expr | 3 + 16 files changed, 291 insertions(+), 137 deletions(-) diff --git a/src/code/float.lisp b/src/code/float.lisp index 35bf3895c..383120ffa 100644 --- a/src/code/float.lisp +++ b/src/code/float.lisp @@ -816,3 +816,25 @@ (t (ash int exp))))))) ((rational) x))) + +#-sb-xc-host +(make-defs (($fun < =)) + (defun quiet$fun (x y) + (declare (explicit-check)) + (number-dispatch ((x real) (y real)) + ((single-float single-float) + (quiet$fun x y)) + ((double-float double-float) + (quiet$fun x y)) + ((single-float double-float) + (quiet$fun (coerce x 'double-float) y)) + ((double-float single-float) + (quiet$fun x (coerce y 'double-float))) + (((foreach single-float double-float) rational) + (unless (float-nan-p x) + ($fun x y))) + ((rational (foreach single-float double-float)) + (unless (float-nan-p y) + ($fun x y))) + ((rational rational) + ($fun x y))))) diff --git a/src/code/irrat.lisp b/src/code/irrat.lisp index c343ece4a..ea148e5b9 100644 --- a/src/code/irrat.lisp +++ b/src/code/irrat.lisp @@ -345,17 +345,17 @@ (clear-info :source-location :declaration s))) (defun sqrt-double-float (number) - (if (< number 0) + (if (quiet< number 0) (complex 0d0 (sqrt (- number))) (sqrt number))) (defun sqrt-single-float (number) - (if (< number 0) + (if (quiet< number 0) (complex 0f0 (sqrt (- number))) (sqrt number))) (defun log-double-float (number) - (if (< number 0) + (if (quiet< number 0) (complex (log (- number)) pi) (log number))) @@ -365,18 +365,18 @@ (log number))) (defun log-double-float2 (number base) - (if (zerop base) + (if (quiet= base 0d0) 0d0 - (if (or (< base 0) - (< number 0)) + (if (or (quiet< base 0) + (quiet< number 0)) (/ (log number) (log base)) (truly-the double-float (log number base))))) (defun log-single-float2 (number base) - (if (zerop base) + (if (quiet= base 0d0) 0.0 - (if (or (< base 0) - (< number 0)) + (if (or (quiet< base 0) + (quiet< number 0)) (/ (log number) (log base)) (truly-the single-float (log number base))))) @@ -513,7 +513,7 @@ 'single-float))))) (((foreach single-float double-float)) ;; IEEE 754 says (log -0.0) should be -inf - (if (< number 0.0) + (if (quiet< number 0.0) (complex (log (- number)) (coerce pi '(dispatch-type number))) (log number))) ((complex) @@ -530,7 +530,7 @@ (coerce (%sqrt (- (coerce number 'double-float))) 'single-float)) (coerce (%sqrt (coerce number 'double-float)) 'single-float))) (((foreach single-float double-float)) - (if (minusp number) + (if (quiet< number 0) (complex (coerce 0.0 '(dispatch-type number)) (sqrt (- number))) (sqrt number))) diff --git a/src/cold/exports.lisp b/src/cold/exports.lisp index d8d47ed2a..95ce5bb77 100644 --- a/src/cold/exports.lisp +++ b/src/cold/exports.lisp @@ -2394,7 +2394,8 @@ is a good idea, but see SB-SYS re. blurring of boundaries.") "INLINE-VOP" "WRAP-IF" "COND-DISPATCH" "MAKE-DEFS" - "COPY-REMOVE" "COPY-REMOVE-IF" "COPY-REMOVE-IF-NOT") + "COPY-REMOVE" "COPY-REMOVE-IF" "COPY-REMOVE-IF-NOT" + "QUIET=" "QUIET<") #+sb-simd-pack (:export "SIMD-PACK" "SIMD-PACK-P" diff --git a/src/compiler/arm/float.lisp b/src/compiler/arm/float.lisp index cedfd28bf..fe4316d2a 100644 --- a/src/compiler/arm/float.lisp +++ b/src/compiler/arm/float.lisp @@ -371,7 +371,7 @@ (define-vop (float-compare) (:args (x) (y)) - (:variant-vars format is-=) + (:variant-vars format quiet) (:policy :fast-safe) (:note "inline float comparison") (:vop-var vop) @@ -380,11 +380,11 @@ (note-this-location vop :internal-error) (ecase format (:single - (if is-= + (if quiet (inst fcmps x y) (inst fcmpes x y))) (:double - (if is-= + (if quiet (inst fcmpd x y) (inst fcmped x y)))) (inst fmstat))) @@ -397,25 +397,27 @@ (frob single-float-compare single-reg single-float) (frob double-float-compare double-reg double-float)) -(macrolet ((frob (translate cond sname dname is-=) +(macrolet ((frob (translate cond sname dname quiet) `(progn (define-vop (,sname single-float-compare) (:translate ,translate) (:conditional ,cond) - (:variant :single ,is-=)) + (:variant :single ,quiet)) (define-vop (,dname double-float-compare) (:translate ,translate) (:conditional ,cond) - (:variant :double ,is-=))))) + (:variant :double ,quiet))))) (frob < :mi :gt >/single-float >/double-float nil) - (frob = :eq =/single-float =/double-float t)) + (frob = :eq =/single-float =/double-float t) + (frob quiet= :eq quiet=/single-float quiet=/double-float t)) (define-vop (float-compare-zero) (:args (x)) (:info y) (:ignore y) - (:variant-vars format is-=) + (:variant-vars format quiet) (:policy :fast-safe) (:note "inline float comparison") (:vop-var vop) @@ -424,11 +426,11 @@ (note-this-location vop :internal-error) (ecase format (:single - (if is-= + (if quiet (inst fcmpzs x) (inst fcmpezs x))) (:double - (if is-= + (if quiet (inst fcmpzd x) (inst fcmpezd x)))) (inst fmstat))) @@ -442,19 +444,21 @@ (frob double-float-compare-zero double-reg double-float (double-float -0d0 0d0))) -(macrolet ((frob (translate cond sname dname is-=) +(macrolet ((frob (translate cond sname dname quiet) `(progn (define-vop (,sname single-float-compare-zero) (:translate ,translate) (:conditional ,cond) - (:variant :single ,is-=)) + (:variant :single ,quiet)) (define-vop (,dname double-float-compare-zero) (:translate ,translate) (:conditional ,cond) - (:variant :double ,is-=))))) + (:variant :double ,quiet))))) (frob < :mi :gt >/single-float-zero >/double-float-zero nil) - (frob = :eq eql/single-float-zero eql/double-float-zero t)) + (frob = :eq eql/single-float-zero eql/double-float-zero t) + (frob quiet= :eq quiet=/single-float-zero quiet=/double-float-zero t)) ;;;; Conversion: diff --git a/src/compiler/arm64/float.lisp b/src/compiler/arm64/float.lisp index d7ac4d482..f09736679 100644 --- a/src/compiler/arm64/float.lisp +++ b/src/compiler/arm64/float.lisp @@ -519,14 +519,14 @@ (define-vop (float-compare) (:args (x) (y)) - (:variant-vars is-=) + (:variant-vars quiet) (:policy :fast-safe) (:note "inline float comparison") (:vop-var vop) (:save-p :compute-only) (:generator 3 (note-this-location vop :internal-error) - (if is-= + (if quiet (inst fcmp x y) (inst fcmpe x y)))) @@ -538,34 +538,36 @@ (frob single-float-compare single-reg single-float) (frob double-float-compare double-reg double-float)) -(macrolet ((frob (translate cond sname dname is-=) +(macrolet ((frob (translate cond sname dname quiet) `(progn (define-vop (,sname single-float-compare) (:translate ,translate) (:conditional ,cond) - (:variant ,is-=)) + (:variant ,quiet)) (define-vop (,dname double-float-compare) (:translate ,translate) (:conditional ,cond) - (:variant ,is-=))))) + (:variant ,quiet))))) (frob < :mi :gt >/single-float >/double-float nil) (frob <= :ls <=/single-float <=/double-float nil) (frob >= :ge >=/single-float >=/double-float nil) - (frob = :eq =/single-float =/double-float t)) + (frob = :eq =/single-float =/double-float nil) + (frob quiet= :eq quiet=/single-float quiet=/double-float t)) (define-vop (float-compare-zero) (:args (x)) (:info y) (:ignore y) - (:variant-vars is-=) + (:variant-vars quiet) (:policy :fast-safe) (:note "inline float comparison") (:vop-var vop) (:save-p :compute-only) (:generator 2 (note-this-location vop :internal-error) - (if is-= + (if quiet (inst fcmp x 0) (inst fcmpe x 0)))) @@ -578,21 +580,23 @@ (frob double-float-compare-zero double-reg double-float (double-float -0d0 0d0))) -(macrolet ((frob (translate cond sname dname is-=) +(macrolet ((frob (translate cond sname dname quiet) `(progn (define-vop (,sname single-float-compare-zero) (:translate ,translate) (:conditional ,cond) - (:variant ,is-=)) + (:variant ,quiet)) (define-vop (,dname double-float-compare-zero) (:translate ,translate) (:conditional ,cond) - (:variant ,is-=))))) + (:variant ,quiet))))) (frob < :mi :gt >/single-float-zero >/double-float-zero nil) (frob <= :ls <=/single-float-zero <=/double-float-zero nil) (frob >= :ge >=/single-float-zero >=/double-float-zero nil) - (frob = :eq =/single-float-zero =/double-float-zero t)) + (frob = :eq =/single-float-zero =/double-float-zero nil) + (frob quiet= :eq quiet=/single-float-zero quiet=/double-float-zero t)) (macrolet ((define-complex-float-= (complex-complex-name complex-real-name real-complex-name diff --git a/src/compiler/float-tran.lisp b/src/compiler/float-tran.lisp index 176d0895c..56092a6b4 100644 --- a/src/compiler/float-tran.lisp +++ b/src/compiler/float-tran.lisp @@ -530,7 +530,7 @@ (deftransform log ((x) ($type) * :node node) (let ((cast (cast-or-check-bound-type node (specifier-type 'real)))) (if cast - `(if (< x 0) + `(if (quiet< x 0) (sb-vm::op-not-type1-error x '(,(type-specifier cast) . log)) ($log x)) (give-up-ir1-transform)))) @@ -538,10 +538,10 @@ (deftransform log ((x y) ($type $type) * :node node) (let ((cast (cast-or-check-bound-type node (specifier-type 'real)))) (if cast - `(if (= y 0) + `(if (quiet= y 0) (coerce 0 '$type) - (if (or (< x 0) - (< y 0)) + (if (or (quiet< x 0) + (quiet< y 0)) (sb-vm::op-not-type2-error x y '(,(type-specifier cast) . log)) (/ ($log x) ($log y)))) (give-up-ir1-transform)))) @@ -549,7 +549,7 @@ (deftransform sqrt ((x) ($type) * :node node) (let ((cast (cast-or-check-bound-type node (specifier-type 'real)))) (if cast - `(if (< x 0) + `(if (quiet< x 0) (sb-vm::op-not-type1-error x '(,(type-specifier cast) . sqrt)) ($sqrt x)) (give-up-ir1-transform))))) @@ -557,7 +557,7 @@ (deftransform sqrt ((x) (rational) * :node node) (let ((cast (cast-or-check-bound-type node (specifier-type 'real)))) (if cast - `(if (< x 0) + `(if (quiet< x 0) (sb-vm::op-not-type1-error x '(,(type-specifier cast) . sqrt)) (%single-float (%sqrt (%double-float x)))) (give-up-ir1-transform)))) @@ -1574,7 +1574,7 @@ (csubtypep (lvar-type y) (specifier-type 'single-float)) (let ((x (lvar-value x))) (when (and (safe-single-coercion-p x) - (= x (coerce x 'single-float))) + (sb-xc:= x (coerce x 'single-float))) `(,(lvar-fun-name (basic-combination-fun node)) ,(coerce x 'single-float) y))))) (t `(,(lvar-fun-name (basic-combination-fun node)) x (%double-float y))))) @@ -1586,7 +1586,7 @@ (csubtypep (lvar-type x) (specifier-type 'single-float)) (let ((y (lvar-value y))) (when (and (safe-single-coercion-p y) - (= y (coerce y 'single-float))) + (sb-xc:= y (coerce y 'single-float))) `(,(lvar-fun-name (basic-combination-fun node)) x ,(coerce y 'single-float)))))) (t `(,(lvar-fun-name (basic-combination-fun node)) (%double-float x) y)))) @@ -1643,9 +1643,15 @@ ,most-positive-exactly-double-float-integer)) double-float)) #'real-double-float-contagion-cmp nil))) - (dolist (op '(= < > <= >=)) + (dolist (op '(= < > <= >= quiet< quiet=)) (def op))) +(make-defs (($fun < =)) + (defoptimizer (quiet$fun constraint-propagate-if) ((x y)) + (values nil nil + (list (list '$fun x (lvar-type y))) + (list (list '$fun x (lvar-type y) t))))) + (%deftransform '= nil '(function ((complex double-float) single-float)) #'double-float-real-contagion nil) (%deftransform '= nil '(function (single-float (complex double-float))) diff --git a/src/compiler/fndb.lisp b/src/compiler/fndb.lisp index 720d6a32b..b3e7fa019 100644 --- a/src/compiler/fndb.lisp +++ b/src/compiler/fndb.lisp @@ -232,6 +232,9 @@ (defknown (max min) (real &rest real) real (movable foldable flushable)) +(defknown (quiet= quiet<) (real real) boolean + (movable foldable flushable)) + (defknown (+ *) (&rest number) number (movable foldable flushable commutative)) (defknown - (number &rest number) number diff --git a/src/compiler/loongarch64/float.lisp b/src/compiler/loongarch64/float.lisp index f2ca5ad5a..a74806628 100644 --- a/src/compiler/loongarch64/float.lisp +++ b/src/compiler/loongarch64/float.lisp @@ -416,11 +416,13 @@ (if not-p (inst bceqz 5 target) (inst bcnez 5 target))))))) - (frob < fcmp.clt.s fcmp.clt.d nil fcmp.clt.s fcmp.clt.d t >/single-float >/double-float) - (frob >= fcmp.cle.s fcmp.cle.d t >=/single-float >=/double-float) - (frob = fcmp.ceq.s fcmp.ceq.d nil =/single-float =/double-float)) + (frob < fcmp.slt.s fcmp.slt.d nil fcmp.slt.s fcmp.slt.d t >/single-float >/double-float) + (frob >= fcmp.sle.s fcmp.sle.d t >=/single-float >=/double-float) + (frob = fcmp.seq.s fcmp.seq.d nil =/single-float =/double-float) + (frob quiet= fcmp.ceq.s fcmp.ceq.d nil quiet=/single-float quiet=/double-float)) (macrolet ((frob (name translate from-sc from-type from-format diff --git a/src/compiler/mips/float.lisp b/src/compiler/mips/float.lisp index 2bd68ce11..d13f336ff 100644 --- a/src/compiler/mips/float.lisp +++ b/src/compiler/mips/float.lisp @@ -530,8 +530,10 @@ (:translate ,translate) (:variant :double ,op ,complement))))) (frob < :lt nil :ngt t >/single-float >/double-float) - (frob = :seq nil =/single-float =/double-float)) + (frob = :seq nil =/single-float =/double-float) + (frob quiet= :eq nil quiet=/single-float quiet=/double-float)) ;;;; Conversion: diff --git a/src/compiler/ppc/float.lisp b/src/compiler/ppc/float.lisp index 8ad8c77dd..a7c93125b 100644 --- a/src/compiler/ppc/float.lisp +++ b/src/compiler/ppc/float.lisp @@ -407,7 +407,7 @@ (:args (x) (y)) (:conditional) (:info target not-p) - (:variant-vars format yep nope) + (:variant-vars format yep nope quiet) (:policy :fast-safe) (:note "inline float comparison") (:vop-var vop) @@ -416,7 +416,9 @@ (note-this-location vop :internal-error) (ecase format ((:single :double) - (inst fcmpo :cr1 x y))) + (if quiet + (inst fcmpu :cr1 x y) + (inst fcmpo :cr1 x y)))) (inst b? :cr1 (if not-p nope yep) target))) (macrolet ((frob (name sc ptype) @@ -427,17 +429,19 @@ (frob single-float-compare single-reg single-float) (frob double-float-compare double-reg double-float)) -(macrolet ((frob (translate yep nope sname dname) +(macrolet ((frob (translate yep nope sname dname &optional quiet) `(progn (define-vop (,sname single-float-compare) (:translate ,translate) - (:variant :single ,yep ,nope)) + (:variant :single ,yep ,nope ,quiet)) (define-vop (,dname double-float-compare) (:translate ,translate) - (:variant :double ,yep ,nope))))) + (:variant :double ,yep ,nope ,quiet))))) (frob < :lt :ge :gt :le >/single-float >/double-float) - (frob = :eq :ne =/single-float =/double-float)) + (frob = :eq :ne =/single-float =/double-float) + (frob quiet= :eq :ne quiet=/single-float quiet=/double-float)) ;;;; Conversion: diff --git a/src/compiler/ppc64/float.lisp b/src/compiler/ppc64/float.lisp index 3ab6e82f8..cbb5dc1db 100644 --- a/src/compiler/ppc64/float.lisp +++ b/src/compiler/ppc64/float.lisp @@ -442,7 +442,7 @@ (:args (x) (y)) (:conditional) (:info target not-p) - (:variant-vars format yep nope) + (:variant-vars format yep nope quiet) (:policy :fast-safe) (:note "inline float comparison") (:vop-var vop) @@ -451,7 +451,9 @@ (note-this-location vop :internal-error) (ecase format ((:single :double) - (inst fcmpo :cr1 x y))) + (if quiet + (inst fcmpu :cr1 x y) + (inst fcmpo :cr1 x y)))) (inst b? :cr1 (if not-p nope yep) target))) (macrolet ((frob (name sc ptype) @@ -462,17 +464,19 @@ (frob single-float-compare single-reg single-float) (frob double-float-compare double-reg double-float)) -(macrolet ((frob (translate yep nope sname dname) +(macrolet ((frob (translate yep nope sname dname &optional quiet) `(progn (define-vop (,sname single-float-compare) (:translate ,translate) - (:variant :single ,yep ,nope)) + (:variant :single ,yep ,nope ,quiet)) (define-vop (,dname double-float-compare) (:translate ,translate) - (:variant :double ,yep ,nope))))) + (:variant :double ,yep ,nope ,quiet))))) (frob < :lt :ge :gt :le >/single-float >/double-float) - (frob = :eq :ne =/single-float =/double-float)) + (frob = :eq :ne =/single-float =/double-float) + (frob quiet= :eq :ne quiet=/single-float quiet=/double-float t)) ;;;; Conversion: diff --git a/src/compiler/riscv/float.lisp b/src/compiler/riscv/float.lisp index a8868c419..658a1b6ed 100644 --- a/src/compiler/riscv/float.lisp +++ b/src/compiler/riscv/float.lisp @@ -472,10 +472,12 @@ (inst beq temp zero-tn target) (inst bne temp zero-tn target))))))) (frob < flt nil flt t >/single-float >/double-float) (frob >= fle t >=/single-float >=/double-float) - (frob = feq nil =/single-float =/double-float)) + (frob = feq nil =/single-float =/double-float) + (frob quiet= feq nil quiet=/single-float quiet=/double-float)) ;;;; Conversion: diff --git a/src/compiler/sparc/float.lisp b/src/compiler/sparc/float.lisp index eca828d38..19661cb66 100644 --- a/src/compiler/sparc/float.lisp +++ b/src/compiler/sparc/float.lisp @@ -756,7 +756,7 @@ (:args (x) (y)) (:conditional) (:info target not-p) - (:variant-vars format yep nope) + (:variant-vars format yep nope quiet) (:policy :fast-safe) (:note "inline float comparison") (:vop-var vop) @@ -764,9 +764,15 @@ (:generator 3 (note-this-location vop :internal-error) (ecase format - (:single (inst fcmps x y)) - (:double (inst fcmpd x y)) - (:long (inst fcmpq x y))) + (:single (if quiet + (inst fcmps x y) + (inst fcmpes x y))) + (:double (if quiet + (inst fcmpd x y) + (inst fcmped x y))) + (:long (if quiet + (inst fcmpq x y) + (inst fcmpeq x y)))) ;; The SPARC V9 doesn't need an instruction between a ;; floating-point compare and a floating-point branch. (unless (member :sparc-v9 *backend-subfeatures*) @@ -784,21 +790,23 @@ #+long-float (frob long-float-compare long-reg long-float)) -(macrolet ((frob (translate yep nope sname dname #+long-float lname) +(macrolet ((frob (translate yep nope sname dname #+long-float lname &optional quiet) `(progn (define-vop (,sname single-float-compare) (:translate ,translate) - (:variant :single ,yep ,nope)) + (:variant :single ,yep ,nope ,quiet)) (define-vop (,dname double-float-compare) (:translate ,translate) - (:variant :double ,yep ,nope)) + (:variant :double ,yep ,nope ,quiet)) #+long-float (define-vop (,lname long-float-compare) (:translate ,translate) - (:variant :long ,yep ,nope))))) + (:variant :long ,yep ,nope ,quiet))))) (frob < :l :ge :g :le >/single-float >/double-float #+long-float >/long-float) - (frob = :eq :ne =/single-float =/double-float #+long-float =/long-float)) + (frob = :eq :ne =/single-float =/double-float #+long-float =/long-float) + (frob quiet= :eq :ne quiet=/single-float quiet=/double-float #+long-float quiet=/long-float t)) #+long-float (deftransform eql ((x y) (long-float long-float)) diff --git a/src/compiler/x86-64/float.lisp b/src/compiler/x86-64/float.lisp index 83bb0407f..5e8b507ec 100644 --- a/src/compiler/x86-64/float.lisp +++ b/src/compiler/x86-64/float.lisp @@ -937,6 +937,8 @@ (:temporary (:sc single-reg :from :eval) xmm) (:conditional not :p :ne) (:vop-var vop) + (:variant-vars quiet) + (:variant nil) (:generator 3 (when (or (location= y xmm) (and (not (xmm-tn-p x)) (xmm-tn-p y))) @@ -953,7 +955,9 @@ (fp-immediate (setf y (register-inline-constant (tn-value y)))) (t)) - (inst comiss xmm y) + (if quiet + (inst ucomiss xmm y) + (inst comiss xmm y)) ;; if PF&CF, there was a NaN involved => not equal ;; otherwise, ZF => equal )) @@ -966,6 +970,8 @@ :target xmm)) (:temporary (:sc double-reg :from :eval) xmm) (:conditional not :p :ne) + (:variant-vars quiet) + (:variant nil) (:vop-var vop) (:generator 3 (when (or (location= y xmm) @@ -989,7 +995,9 @@ (descriptor-reg (setf y (ea-for-df-desc y))) (t)) - (inst comisd xmm y))) + (if quiet + (inst ucomisd xmm y) + (inst comisd xmm y)))) (macrolet ((define-complex-float-= (complex-complex-name complex-real-name real-complex-name real-sc real-type @@ -1049,6 +1057,8 @@ (:info) (:vop-var vop) (:conditional ,@flags) + (:variant-vars quiet) + (:variant nil) (:generator 3 (note-float-location ',op vop x y) (sc-case y @@ -1063,11 +1073,15 @@ (change-vop-flags vop '(,flip)) (rotatef x y)) `(t))) - (inst comisd x y))) + (if quiet + (inst ucomisd x y) + (inst comisd x y)))) (define-vop (,single-name single-float-compare) (:translate ,op) (:info) (:conditional ,@flags) + (:variant-vars quiet) + (:variant nil) (:generator 3 (note-float-location ',op vop x y) (sc-case y @@ -1080,8 +1094,9 @@ (change-vop-flags vop '(,flip)) (rotatef x y)) `(t))) - - (inst comiss x y)))))) + (if quiet + (inst ucomiss x y) + (inst comiss x y))))))) ;; UNORDERED: ZF,PF,CF <- 111; ;; GREATER_THAN: ZF,PF,CF <- 000; ;; LESS_THAN: ZF,PF,CF <- 001; @@ -1093,6 +1108,19 @@ (define <= <=single-float <=double-float (not :p :a) :nb) (define >= >=single-float >=double-float (:nb))) + +(define-vop (quiet> val 8) 3))") +(#(359CB801 4D28C61A 53351B33 A2DD0906 B9B79FF6) + "(FUNCTION SB-IMPL::PREDICATE SB-IMPL::KEY SB-IMPL::TEST SB-IMPL::TEST-NOT)" + "((& (^ (>> val 3) (>> val 6)) 7))") ) ;; EOF