X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86-64%2Fpred.lisp;h=a490a0a41d81fc2339db9664103984b5e448201d;hb=3fe9cb03ffeed767e9d795b5bfcd70eb71aedde9;hp=8c9b2fd87114696175c7bac87660a1d95432ba0e;hpb=91ee7afd75d8b282829daa647d0a8f1469336a77;p=sbcl.git

diff --git a/src/compiler/x86-64/pred.lisp b/src/compiler/x86-64/pred.lisp
index 8c9b2fd..a490a0a 100644
--- a/src/compiler/x86-64/pred.lisp
+++ b/src/compiler/x86-64/pred.lisp
@@ -180,35 +180,26 @@
                 (dolist (flag flags)
                   (inst cmov flag res then))))))))
 
-(macrolet ((def-move-if (name type reg &optional stack)
-               (when stack (setf stack (list stack)))
-
-               `(define-vop (,name move-if)
-                  (:args (then :scs (immediate ,reg ,@stack) :to :eval
-                               :load-if (not (or (sc-is then immediate)
-                                                 (and (sc-is then ,@stack)
-                                                      (not (location= else res))))))
-                         (else :scs (immediate ,reg ,@stack) :target res
-                               :load-if (not (sc-is else immediate ,@stack))))
-                  (:arg-types ,type ,type)
-                  (:results (res :scs (,reg)
-                                 :from (:argument 1)))
-                  (:result-types ,type))))
-  (def-move-if move-if/t
-      t descriptor-reg control-stack)
-  (def-move-if move-if/fx
-      tagged-num any-reg control-stack)
-  (def-move-if move-if/unsigned
-      unsigned-num unsigned-reg unsigned-stack)
-  (def-move-if move-if/signed
-      signed-num signed-reg signed-stack)
+(macrolet ((def-move-if (name type reg stack)
+             `(define-vop (,name move-if)
+                (:args (then :scs (immediate ,reg ,stack) :to :eval
+                             :load-if (not (or (sc-is then immediate)
+                                               (and (sc-is then ,stack)
+                                                    (not (location= else res))))))
+                       (else :scs (immediate ,reg ,stack) :target res
+                             :load-if (not (sc-is else immediate ,stack))))
+                (:arg-types ,type ,type)
+                (:results (res :scs (,reg)
+                               :from (:argument 1)))
+                (:result-types ,type))))
+  (def-move-if move-if/t t descriptor-reg control-stack)
+  (def-move-if move-if/fx tagged-num any-reg control-stack)
+  (def-move-if move-if/unsigned unsigned-num unsigned-reg unsigned-stack)
+  (def-move-if move-if/signed signed-num signed-reg signed-stack)
   ;; FIXME: See *CMOV-PTYPE-REPRESENTATION-VOP* above.
   #!+sb-unicode
-  (def-move-if move-if/char
-      character character-reg character-stack)
-  (def-move-if move-if/sap
-      system-area-pointer sap-reg sap-stack))
-
+  (def-move-if move-if/char character character-reg character-stack)
+  (def-move-if move-if/sap system-area-pointer sap-reg sap-stack))
 
 ;;;; conditional VOPs
 
@@ -226,7 +217,7 @@
   (:conditional :e)
   (:policy :fast-safe)
   (:translate eq)
-  (:generator 3
+  (:generator 8
     (cond
      ((sc-is y immediate)
       (let ((val (tn-value y)))
@@ -267,3 +258,23 @@
                                character-widetag))))))
       (t
        (inst cmp x y)))))
+
+;; The template above is a very good fallback for the generic
+;; case.  However, it is sometimes possible to perform unboxed
+;; comparisons.  Repurpose char= and eql templates here, instead
+;; of forcing values to be boxed and then compared.
+;;
+;; We only weaken EQL => EQ for characters and fixnums, and detect
+;; when types definitely mismatch.  No need to import other EQL
+;; VOPs (e.g. floats).
+(macrolet ((def (eq-name eql-name)
+             `(define-vop (,eq-name ,eql-name)
+                (:translate eq))))
+  (def fast-if-eq-character fast-char=/character)
+  (def fast-if-eq-character/c fast-char=/character/c)
+  (def fast-if-eq-fixnum fast-eql/fixnum)
+  (def fast-if-eq-fixnum/c fast-eql-c/fixnum)
+  (def fast-if-eq/signed fast-if-eql/signed)
+  (def fast-if-eq-c/signed fast-if-eql-c/signed)
+  (def fast-if-eq/unsigned fast-if-eql/unsigned)
+  (def fast-if-eq-c/unsigned fast-if-eql-c/unsigned))