X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86-64%2Ffloat.lisp;h=f1b7f4175178bf78762be487d66b6f6dba6d6006;hb=ba871531b6b394da295c9a4527346e1e6327ccca;hp=63ae04004b73aa9202f219579e3c8f74f6b040df;hpb=de01f09401517c1a96de3faeac585e46895940ec;p=sbcl.git

diff --git a/src/compiler/x86-64/float.lisp b/src/compiler/x86-64/float.lisp
index 63ae040..f1b7f41 100644
--- a/src/compiler/x86-64/float.lisp
+++ b/src/compiler/x86-64/float.lisp
@@ -552,34 +552,61 @@
              (inst jmp :e target)
              (emit-label not-lab))))))
 
-;; XXX all of these probably have bad NaN behaviour
 (define-vop (<double-float double-float-compare)
   (:translate <)
   (:info target not-p)
-  (:generator 2
+  (:generator 3
     (inst comisd x y)
-    (inst jmp (if not-p :nc :c) target)))
+    (cond (not-p
+           (inst jmp :p target)
+           (inst jmp :nc target))
+          (t
+           (let ((not-lab (gen-label)))
+             (inst jmp :p not-lab)
+             (inst jmp :c target)
+             (emit-label not-lab))))))
 
 (define-vop (<single-float single-float-compare)
   (:translate <)
   (:info target not-p)
-  (:generator 2
+  (:generator 3
     (inst comiss x y)
-    (inst jmp (if not-p :nc :c) target)))
+    (cond (not-p
+           (inst jmp :p target)
+           (inst jmp :nc target))
+          (t
+           (let ((not-lab (gen-label)))
+             (inst jmp :p not-lab)
+             (inst jmp :c target)
+             (emit-label not-lab))))))
 
 (define-vop (>double-float double-float-compare)
   (:translate >)
   (:info target not-p)
-  (:generator 2
+  (:generator 3
     (inst comisd x y)
-    (inst jmp (if not-p :na :a) target)))
+    (cond (not-p
+           (inst jmp :p target)
+           (inst jmp :na target))
+          (t
+           (let ((not-lab (gen-label)))
+             (inst jmp :p not-lab)
+             (inst jmp :a target)
+             (emit-label not-lab))))))
 
 (define-vop (>single-float single-float-compare)
   (:translate >)
   (:info target not-p)
-  (:generator 2
+  (:generator 3
     (inst comiss x y)
-    (inst jmp (if not-p :na :a) target)))
+    (cond (not-p
+           (inst jmp :p target)
+           (inst jmp :na target))
+          (t
+           (let ((not-lab (gen-label)))
+             (inst jmp :p not-lab)
+             (inst jmp :a target)
+             (emit-label not-lab))))))