Specialised VOPs for EQ of fixnum values on x86oids

[sbcl.git] / src / compiler / ir1util.lisp

diff --git a/src/compiler/ir1util.lisp b/src/compiler/ir1util.lisp
index 82bea22..6c0a271 100644 (file)
--- a/src/compiler/ir1util.lisp
+++ b/src/compiler/ir1util.lisp
@@ -322,9 +322,9 @@
 ;;;;
 
 ;;; Filter values of LVAR through FORM, which must be an ordinary/mv
-;;; call. First argument must be 'DUMMY, which will be replaced with
-;;; LVAR. In case of an ordinary call the function should not have
-;;; return type NIL. We create a new "filtered" lvar.
+;;; call. Exactly one argument must be 'DUMMY, which will be replaced
+;;; with LVAR. In case of an ordinary call the function should not
+;;; have return type NIL. We create a new "filtered" lvar.
 ;;;
 ;;; TODO: remove preconditions.
 (defun filter-lvar (lvar form)
@@ -358,11 +358,18 @@
         ;; Replace 'DUMMY with the LVAR. (We can find 'DUMMY because
         ;; no LET conversion has been done yet.) The [mv-]combination
         ;; code from the call in the form will be the use of the new
-        ;; check lvar. We substitute for the first argument of
-        ;; this node.
+        ;; check lvar. We substitute exactly one argument.
         (let* ((node (lvar-use filtered-lvar))
-               (args (basic-combination-args node))
-               (victim (first args)))
+               victim)
+          (dolist (arg (basic-combination-args node) (aver victim))
+            (let* ((arg (principal-lvar arg))
+                   (use (lvar-use arg))
+                   leaf)
+              (when (and (ref-p use)
+                         (constant-p (setf leaf (ref-leaf use)))
+                         (eql (constant-value leaf) 'dummy))
+                (aver (not victim))
+                (setf victim arg))))
           (aver (eq (constant-value (ref-leaf (lvar-use victim)))
                     'dummy))
 
@@ -790,6 +797,30 @@
         (values nil nil)
         (values (node-source-form use) t))))
 
+(defun common-suffix (x y)
+  (let ((mismatch (mismatch x y :from-end t)))
+    (if mismatch
+        (subseq x mismatch)
+        x)))
+
+;;; If the LVAR has a single use, return NODE-SOURCE-FORM as a
+;;; singleton.  Otherwise, return a list of the lowest common
+;;; ancestor source form of all the uses (if it can be found),
+;;; followed by all the uses' source forms.
+(defun lvar-all-sources (lvar)
+  (let ((use (lvar-uses lvar)))
+    (if (listp use)
+        (let ((forms  '())
+              (path   (node-source-path (first use))))
+          (dolist (use use (cons (if (find 'original-source-start path)
+                                     (find-original-source path)
+                                     "a hairy form")
+                                 forms))
+            (pushnew (node-source-form use) forms)
+            (setf path (common-suffix path
+                                      (node-source-path use)))))
+        (list (node-source-form use)))))
+
 ;;; Return the unique node, delivering a value to LVAR.
 #!-sb-fluid (declaim (inline lvar-use))
 (defun lvar-use (lvar)