Raymond Toy pushed to branch issue-175-simplify-float-compare-vops at cmucl / cmucl

Commits: 1e7d1ddc by Raymond Toy at 2023-03-10T12:09:54-08:00 Remove old macros for < and >.

- - - - -

1 changed file:

- src/compiler/x86/float-sse2.lisp

Changes:

===================================== src/compiler/x86/float-sse2.lisp ===================================== @@ -944,87 +944,6 @@ (frob single ucomiss) (frob double ucomisd))

-#+nil -(macrolet - ((gen-code (swap-args-p sc-type inst ea) - (if swap-args-p - `(sc-case x - (,sc-type - (inst ,inst y x)) - (descriptor-reg - (inst ,inst y (,ea x)))) - `(sc-case y - (,sc-type - (inst ,inst x y)) - (descriptor-reg - (inst ,inst x (,ea y)))))) - (frob (op size inst swap-args-p) - (let ((ea (ecase size - (single - 'ea-for-sf-desc) - (double - 'ea-for-df-desc))) - (name (symbolicate op "/" size "-FLOAT")) - (sc-type (symbolicate size "-REG")) - (inherit (symbolicate size "-FLOAT-COMPARE"))) - `(define-vop (,name ,inherit) - (:translate ,op) - (:info target not-p) - (:generator 3 - (gen-code ,swap-args-p ,sc-type ,inst ,ea) - ;; When a NaN occurs, comis sets ZF, PF, and CF = 1. In - ;; the normal case (not-p false), we want to jump to the - ;; target when x > y. This happens when CF = 0. Hence, - ;; we won't jump to the target when there's a NaN, as - ;; desired. - ;; - ;; For the not-p case, we want to jump to target when x - ;; <= y. This means CF = 1 or ZF = 1. But NaN sets - ;; these bits too, so we jump to the target for NaN or x - ;; <= y, as desired. - (inst jmp (if (not not-p) :a :be) target)))))) - (frob > single comiss nil) - (frob > double comisd nil)) - -#+nil -(macrolet - ((gen-code (swap-args-p sc-type inst ea) - (if swap-args-p - `(sc-case x - (,sc-type - (inst ,inst y x)) - (descriptor-reg - (inst ,inst y (,ea x)))) - `(sc-case y - (,sc-type - (inst ,inst x y)) - (descriptor-reg - (inst ,inst x (,ea y)))))) - (frob (op size inst swap-args-p) - (let ((ea (ecase size - (single - 'ea-for-sf-desc) - (double - 'ea-for-df-desc))) - (name (symbolicate op "/" size "-FLOAT")) - (sc-type (symbolicate size "-REG")) - (inherit (symbolicate size "-FLOAT-COMPARE"))) - `(define-vop (,name ,inherit) - (:args (x :scs (,sc-type descriptor-reg)) - (y :scs (,sc-type))) - (:translate ,op) - (:info target not-p) - (:temporary (:sc ,sc-type) load-x) - (:generator 3 - ;; Note: x < y is the same as y > x. We reverse the - ;; args to reduce the number of jump instructions - ;; needed. Then the logic for the branches is the same - ;; as for the case y > x above. - (gen-code ,swap-args-p ,sc-type ,inst ,ea) - (inst jmp (if (not not-p) :a :be) target)))))) - (frob < single comiss t) - (frob < double comisd t)) - (macrolet ((gen-code (op sc-type inst ea) ;; When the operation is >, the second arg (y) can be a

View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/1e7d1ddcf57f37b66262f21e...