Raymond Toy pushed to branch issue-175-simplify-float-compare-vops at cmucl / cmucl
Commits: 225335b5 by Raymond Toy at 2023-03-10T11:42:37-08:00 First cut at using a common macro for both > and <.
This works, but I think it should be cleaned up a bit.
- - - - - 1ef34feb by Raymond Toy at 2023-03-10T12:05:04-08:00 Refactor comparison vops into one macro to handle them all.
Previously we had two macros: one for < and one for >. They are very similar so we combine them into one macro to handle both operations.
- - - - - 552d91f3 by Raymond Toy at 2023-03-10T12:06:57-08:00 Remove unused swap-args-p arg to frob
We can determine whether we want to swap or not from the operation, so we don't need this arg to frob anymore.
- - - - -
1 changed file:
- src/compiler/x86/float-sse2.lisp
Changes:
===================================== src/compiler/x86/float-sse2.lisp ===================================== @@ -944,8 +944,21 @@ (frob single ucomiss) (frob double ucomisd))
+#+nil (macrolet - ((frob (op size inst) + ((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) @@ -958,11 +971,7 @@ (:translate ,op) (:info target not-p) (:generator 3 - (sc-case y - (,sc-type - (inst ,inst x y)) - (descriptor-reg - (inst ,inst x (,ea y)))) + (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, @@ -974,11 +983,24 @@ ;; 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) - (frob > double comisd)) + (frob > single comiss nil) + (frob > double comisd nil))
+#+nil (macrolet - ((frob (op size inst) + ((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) @@ -998,12 +1020,69 @@ ;; 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. - (sc-case x - (,sc-type - (inst ,inst y x)) - (descriptor-reg - (inst ,inst y (,ea x)))) + (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 + ;; register or a descriptor. When the operation is <, the args + ;; are swapped and we want to allow x to be a register or + ;; descriptor. + (if (eq op '<) + `(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) + (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) + ;; When the operation is <, we want to rewrite x < y to y + ;; > x. In that case, we want to allow x to be in a + ;; descriptor. For >, y is allowed to be a descriptor. + ,@(when (eq op '<) + `((:args (x :scs (,sc-type descriptor-reg)) + (y :scs (,sc-type))))) + (:translate ,op) + (:info target not-p) + (:generator 3 + ;; Note: x < y is the same as y > x. We reverse the + ;; args to reduce the number of jump instructions + ;; needed. + (gen-code ,op ,sc-type ,inst ,ea) + ;; Consider the case of x > y. + ;; + ;; 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. + ;; + ;; For the case of x < y, we can use the equivalent y > + ;; x. Thus if we swap the args, the same logic applies. (inst jmp (if (not not-p) :a :be) target)))))) + (frob > single comiss) + (frob > double comisd) (frob < single comiss) (frob < double comisd))
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/5ad9f2d825f2e986e04fa2d...