[Git][cmucl/cmucl][issue-175-simplify-float-compare-vops] 2 commits: For float <, allow x to be a descriptor instead of y.

[Raymond Toy (@rtoy)]

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


Commits:
d10df309 by Raymond Toy at 2023-03-09T13:18:24-08:00
For float <, allow x to be a descriptor instead of y.

Since the implementation of x < y reverses args to do y > x, it can be
helpful if x can be a descriptor.   Make it so.

- - - - -
e89872a2 by Raymond Toy at 2023-03-10T08:14:14-08:00
Replace cond with simple if

The cond expression can be replaced by a much simpler if, which
mirrors how the sparc and ppc ports handle the not-p jumps.

- - - - -


1 changed file:

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


Changes:

=====================================
src/compiler/x86/float-sse2.lisp
=====================================
@@ -963,19 +963,17 @@
 		 (inst ,inst x y))
 		(descriptor-reg
 		 (inst ,inst x (,ea y))))
-	      (cond (not-p
-		     ;; 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
-		     ;; 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))))))))
+	      ;; 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)
   (frob > double comisd))
 
@@ -990,29 +988,22 @@
 	     (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-y)
+	    (:temporary (:sc ,sc-type) load-x)
 	    (:generator 3
-	      (sc-case y
+	      ;; 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.
+	      (sc-case x
 		(,sc-type
 		 (inst ,inst y x))
 		(descriptor-reg
-		 (inst ,mover load-y (,ea y))
-		 (inst ,inst load-y x)))
-	      (cond (not-p
-		     ;; 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
-		     ;; 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))))))))
+		 (inst ,inst y (,ea x))))
+	      (inst jmp (if (not not-p) :a :be) target))))))
   (frob < single comiss movss)
   (frob < double comisd movsd))
 



View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/9cb12348b64546ee281c5ff572eef1186e722233...e89872a2392519f95fedd8741d914a5a814210f2

-- 
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/9cb12348b64546ee281c5ff572eef1186e722233...e89872a2392519f95fedd8741d914a5a814210f2
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/04ca2b00/attachment-0001.html>