[Git][cmucl/cmucl][issue-175-simplify-float-compare-vops] 2 commits: Simplify the vops to need just one jmp instead of two.
Raymond Toy (@rtoy)
gitlab at common-lisp.net
Wed Mar 8 18:18:26 UTC 2023
Raymond Toy pushed to branch issue-175-simplify-float-compare-vops at cmucl / cmucl
Commits:
6ff1b068 by Raymond Toy at 2023-03-08T10:16:58-08:00
Simplify the vops to need just one jmp instead of two.
- - - - -
8ff33374 by Raymond Toy at 2023-03-08T10:17:51-08:00
Add tests for NaN comparisons.
- - - - -
2 changed files:
- src/compiler/x86/float-sse2.lisp
- + tests/nan.lisp
Changes:
=====================================
src/compiler/x86/float-sse2.lisp
=====================================
@@ -964,18 +964,23 @@
(descriptor-reg
(inst ,inst x (,ea y))))
(cond (not-p
- (inst jmp :p target)
- (inst jmp :na target))
+ ;; Instead of x > y, we're doing x <= y and want
+ ;; to jmp when x <= y. If NaN occurrs we also
+ ;; want to jump. x <= y means CF = 1 or ZF = 1.
+ ;; When NaN occurs, ZF, PF, and CF are all set.
+ ;; Hence, we can just test for x <= y.
+ (inst jmp :be target))
(t
- (let ((not-lab (gen-label)))
- (inst jmp :p not-lab)
- (inst jmp :a target)
- (emit-label not-lab)))))))))
+ ;; If there's NaN, the ZF, PF, and CF bits are
+ ;; set. We only want to jmp to the target when
+ ;; x > y. This happens if CF = 0. Hence, we
+ ;; will not jmp to the target if NaN occurred.
+ (inst jmp :a target))))))))
(frob > single comiss)
(frob > double comisd))
(macrolet
- ((frob (op size inst)
+ ((frob (op size inst mover)
(let ((ea (ecase size
(single
'ea-for-sf-desc)
@@ -987,22 +992,29 @@
`(define-vop (,name ,inherit)
(:translate ,op)
(:info target not-p)
+ (:temporary (:sc ,sc-type) load-y)
(:generator 3
(sc-case y
(,sc-type
- (inst ,inst x y))
+ (inst ,inst y x))
(descriptor-reg
- (inst ,inst x (,ea y))))
+ (inst ,mover load-y (,ea y))
+ (inst ,inst load-y x)))
(cond (not-p
- (inst jmp :p target)
- (inst jmp :nb target))
+ ;; Instead of x < y, we're doing x >= y and want
+ ;; to jmp when x >= y. But x >=y is the same as
+ ;; y <= x, so if we swap the args, we can apply
+ ;; the same logic we use for > not-p case above.
+ (inst jmp :be target))
(t
- (let ((not-lab (gen-label)))
- (inst jmp :p not-lab)
- (inst jmp :b target)
- (emit-label not-lab)))))))))
- (frob < single comiss)
- (frob < double comisd))
+ ;; We want to jump when x < y. This is the same
+ ;; as jumping when y > x. So if we reverse the
+ ;; args, we can apply the same logic as we did
+ ;; above for the > vop.
+
+ (inst jmp :a target))))))))
+ (frob < single comiss movss)
+ (frob < double comisd movsd))
;;;; Conversion:
=====================================
tests/nan.lisp
=====================================
@@ -0,0 +1,160 @@
+;;; Tests for NaN comparisons.
+(defpackage :nan-tests
+ (:use :cl :lisp-unit))
+
+(in-package :nan-tests)
+
+(defparameter *single-float-nan*
+ (ext:with-float-traps-masked (:invalid :divide-by-zero)
+ (/ 0d0 0d0)))
+
+(defparameter *double-float-nan*
+ (ext:with-float-traps-masked (:invalid :divide-by-zero)
+ (/ 0d0 0d0)))
+
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (macrolet
+ ((frob (ntype op)
+ (let* ((name (ext:symbolicate (if (eq ntype 'single-float)
+ "S"
+ "D")
+ "TST-" op))
+ (name3 (ext:symbolicate name "3")))
+
+ `(progn
+ (defun ,name (x y)
+ (declare (,ntype x y))
+ (,op x y))
+ (defun ,name3 (x y z)
+ (declare (,ntype x y z))
+ (,op x y z))))))
+ (frob single-float <)
+ (frob single-float >)
+ (frob double-float <)
+ (frob double-float >)))
+
+(define-test nan-single.<
+ (:tag :nan)
+ ;; First just make sure it works with regular single-floats
+ (assert-true (stst-< 1f0 2f0))
+ (assert-false (stst-< 1f0 1f0))
+ (assert-false (stst-< 1f0 0f0))
+ ;; Now try NaN. All comparisons should be false.
+ (ext:with-float-traps-masked (:invalid)
+ (assert-false (stst-< *single-float-nan* 1f0))
+ (assert-false (stst-< 1f0 *single-float-nan*))
+ (assert-false (stst-< *single-float-nan* *single-float-nan*))))
+
+(define-test nan-double.<
+ (:tag :nan)
+ ;; First just make sure it works with regular single-floats
+ (assert-true (dtst-< 1d0 2d0))
+ (assert-false (dtst-< 1d0 1d0))
+ (assert-false (dtst-< 1d0 0d0))
+ ;; Now try NaN. All comparisons should be false.
+ (ext:with-float-traps-masked (:invalid)
+ (assert-false (dtst-< *double-float-nan* 1d0))
+ (assert-false (dtst-< 1d0 *double-float-nan*))
+ (assert-false (dtst-< *double-float-nan* *double-float-nan*))))
+
+(define-test nan-single.>
+ (:tag :nan)
+ ;; First just make sure it works with regular single-floats
+ (assert-true (stst-> 2f0 1f0))
+ (assert-false (stst-> 1f0 1f0))
+ (assert-false (stst-> 0f0 1f0))
+ ;; Now try NaN. All comparisons should be false.
+ (ext:with-float-traps-masked (:invalid)
+ (assert-false (stst-> *single-float-nan* 1f0))
+ (assert-false (stst-> 1f0 *single-float-nan*))
+ (assert-false (stst-> *single-float-nan* *single-float-nan*))))
+
+(define-test nan-double.>
+ (:tag :nan)
+ ;; First just make sure it works with regular single-floats
+ (assert-true (dtst-> 2d0 1d0))
+ (assert-false (dtst-> 1d0 1d0))
+ (assert-false (dtst-> 0d0 1d0))
+ ;; Now try NaN. All comparisons should be false.
+ (ext:with-float-traps-masked (:invalid)
+ (assert-false (dtst-> *double-float-nan* 1d0))
+ (assert-false (dtst-> 1d0 *double-float-nan*))
+ (assert-false (dtst-> *double-float-nan* *double-float-nan*))))
+
+(define-test nan-single.<3
+ (:tag :nan)
+ ;; First just make sure it works with regular single-floats
+ (assert-true (stst-<3 1f0 2f0 3f0))
+ (assert-false (stst-<3 1f0 2f0 2f0))
+ (assert-false (stst-<3 1f0 1f0 2f0))
+ (assert-false (stst-<3 1f0 0f0 2f0))
+ ;; Now try NaN. Currently we can only test if there's NaN in the
+ ;; first two args. When NaN is the last arg, we return the
+ ;; incorrect value because of how multi-compare converts multiple
+ ;; args into paris of comparisons.
+ ;;
+ ;; When that is fixed, we can add additional tests. Nevertheless,
+ ;; this is useful because it tests the not-p case of the vops.
+ (ext:with-float-traps-masked (:invalid)
+ (assert-false (stst-<3 *single-float-nan* 2f0 3f0))
+ (assert-false (stst-<3 1f0 *single-float-nan* 3f0))
+ (assert-false (stst-<3 *single-float-nan* *single-float-nan* 3f0))))
+
+(define-test nan-double.<3
+ (:tag :nan)
+ ;; First just make sure it works with regular double-floats
+ (assert-true (dtst-<3 1d0 2d0 3d0))
+ (assert-false (dtst-<3 1d0 2d0 2d0))
+ (assert-false (dtst-<3 1d0 1d0 2d0))
+ (assert-false (dtst-<3 1d0 0d0 2d0))
+ ;; Now try NaN. Currently we can only test if there's NaN in the
+ ;; first two args. When NaN is the last arg, we return the
+ ;; incorrect value because of how multi-compare converts multiple
+ ;; args into paris of comparisons.
+ ;;
+ ;; When that is fixed, we can add additional tests. Nevertheless,
+ ;; this is useful because it tests the not-p case of the vops.
+ (ext:with-float-traps-masked (:invalid)
+ (assert-false (dtst-<3 *double-float-nan* 2d0 3d0))
+ (assert-false (dtst-<3 1d0 *double-float-nan* 3d0))
+ (assert-false (dtst-<3 *double-float-nan* *double-float-nan* 3d0))))
+
+(define-test nan-single.>3
+ (:tag :nan)
+ ;; First just make sure it works with regular single-floats
+ (assert-true (stst->3 3f0 2f0 1f0))
+ (assert-false (stst->3 3f0 1f0 1f0))
+ (assert-false (stst->3 2f0 2f0 1f0))
+ (assert-false (stst->3 0f0 2f0 1f0))
+ ;; Now try NaN. Currently we can only test if there's NaN in the
+ ;; first two args. When NaN is the last arg, we return the
+ ;; incorrect value because of how multi-compare converts multiple
+ ;; args into paris of comparisons.
+ ;;
+ ;; When that is fixed, we can add additional tests. Nevertheless,
+ ;; this is useful because it tests the not-p case of the vops.
+ (ext:with-float-traps-masked (:invalid)
+ (assert-false (stst->3 *single-float-nan* 2f0 3f0))
+ (assert-false (stst->3 1f0 *single-float-nan* 3f0))
+ (assert-false (stst->3 *single-float-nan* *single-float-nan* 3f0))))
+
+(define-test nan-double.>3
+ (:tag :nan)
+ ;; First just make sure it works with regular double-floats
+ (assert-true (dtst->3 3d0 2d0 1d0))
+ (assert-false (dtst->3 3d0 1d0 1d0))
+ (assert-false (dtst->3 2d0 2d0 1d0))
+ (assert-false (dtst->3 0d0 2d0 1d0))
+ ;; Now try NaN. Currently we can only test if there's NaN in the
+ ;; first two args. When NaN is the last arg, we return the
+ ;; incorrect value because of how multi-compare converts multiple
+ ;; args into paris of comparisons.
+ ;;
+ ;; When that is fixed, we can add additional tests. Nevertheless,
+ ;; this is useful because it tests the not-p case of the vops.
+ (ext:with-float-traps-masked (:invalid)
+ (assert-false (dtst->3 *double-float-nan* 2d0 3d0))
+ (assert-false (dtst->3 1d0 *double-float-nan* 3d0))
+ (assert-false (dtst->3 *double-float-nan* *double-float-nan* 3d0))))
+
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/87906cf27d0fa2d30ccc4dcbc0eff1887ba5f48c...8ff333746f203da99d5faef5192040134941b813
--
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/87906cf27d0fa2d30ccc4dcbc0eff1887ba5f48c...8ff333746f203da99d5faef5192040134941b813
You're receiving this email because of your account on gitlab.common-lisp.net.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <https://mailman.common-lisp.net/pipermail/cmucl-cvs/attachments/20230308/37d17024/attachment-0001.html>
More information about the cmucl-cvs
mailing list