[Git][cmucl/cmucl][issue-175-simplify-float-compare-vops] Remove old macros for < and >.

[Raymond Toy (@rtoy)]

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/1e7d1ddcf57f37b66262f21e25dbd1ef7bd74924

-- 
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/1e7d1ddcf57f37b66262f21e25dbd1ef7bd74924
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/20230310/a4f47d29/attachment-0001.html>