From 980de3a433166f03c9f219ca7955d70a30416fb7 Mon Sep 17 00:00:00 2001
From: Stas Boukarev <stassats@gmail.com>
Date: Tue, 14 Apr 2015 21:55:43 +0300
Subject: [PATCH] Source locate mixin VOPs.

VOPs without generators couldn't be located, because the generator
function was used for location. Add a new :source-location info type
and record it for all VOPs.
---
 contrib/sb-introspect/introspect.lisp  | 31 +++----------------------------
 contrib/sb-introspect/test-driver.lisp |  9 +++------
 src/compiler/globaldb.lisp             |  1 +
 src/compiler/meta-vmdef.lisp           |  3 +++
 4 files changed, 10 insertions(+), 34 deletions(-)

diff --git a/contrib/sb-introspect/introspect.lisp b/contrib/sb-introspect/introspect.lisp
index 9380808e8..3fcc1b5ed 100644
--- a/contrib/sb-introspect/introspect.lisp
+++ b/contrib/sb-introspect/introspect.lisp
@@ -162,32 +162,6 @@ constant pool."
   ;; is.
   (description nil :type list))
 
-(defun vop-sources-from-fun-templates (name)
-  (let ((fun-info (sb-int:info :function :info name)))
-    (when fun-info
-      (loop for vop in (sb-c::fun-info-templates fun-info)
-            for source = (find-definition-source
-                          (sb-c::vop-info-generator-function vop))
-            do (setf (definition-source-description source)
-                     (list (sb-c::template-name vop)
-                           (sb-c::template-note vop)))
-            collect source))))
-
-(defun find-vop-source (name)
-  (let* ((templates (vop-sources-from-fun-templates name))
-         (vop (gethash name sb-c::*backend-template-names*))
-         (generator (when vop
-                      (sb-c::vop-info-generator-function vop)))
-         (source (when generator
-                   (find-definition-source generator))))
-    (cond
-      (source
-       (setf (definition-source-description source)
-             (list name))
-       (cons source templates))
-      (t
-       templates))))
-
 (defun find-definition-sources-by-name (name type)
   "Returns a list of DEFINITION-SOURCEs for the objects of type TYPE
 defined with name NAME. NAME may be a symbol or a extended function
@@ -360,8 +334,9 @@ If an unsupported TYPE is requested, the function will return NIL.
                             (list name))
                       source))))))
        ((:vop)
-        (when (symbolp name)
-          (find-vop-source name)))
+        (let ((loc (sb-int:info :source-location :vop name)))
+          (and loc
+               (translate-source-location loc))))
        ((:source-transform)
         (let* ((transform-fun
                 (or (sb-int:info :function :source-transform name)
diff --git a/contrib/sb-introspect/test-driver.lisp b/contrib/sb-introspect/test-driver.lisp
index 14472e5d3..5bdf9c870 100644
--- a/contrib/sb-introspect/test-driver.lisp
+++ b/contrib/sb-introspect/test-driver.lisp
@@ -43,13 +43,10 @@
            '(x))
   t)
 
-;; The CHECK-TYPE vop does not have a generator function. Make sure
-;; (find-definition-sources-by-name 'check-type :vop) returns NIL
-;; instead of signaling an error.
 (deftest definition-source.1
-    (values (find-definition-sources-by-name 'check-type :vop)
-            (listp (find-definition-sources-by-name 'check-type :macro)))
-  nil t)
+    (values (consp (find-definition-sources-by-name 'check-type :vop))
+            (consp (find-definition-sources-by-name 'check-type :macro)))
+  t t)
 
 (deftest definition-source-plist.1
     (let* ((source (find-definition-source #'cl-user::one))
diff --git a/src/compiler/globaldb.lisp b/src/compiler/globaldb.lisp
index 0ee1645e9..ccd904308 100644
--- a/src/compiler/globaldb.lisp
+++ b/src/compiler/globaldb.lisp
@@ -716,6 +716,7 @@
 (define-info-type (:source-location :constant) :type-spec t)
 (define-info-type (:source-location :typed-structure) :type-spec t)
 (define-info-type (:source-location :symbol-macro) :type-spec t)
+(define-info-type (:source-location :vop) :type-spec t)
 
 ;; This is for the SB-INTROSPECT contrib module, and debugging.
 (defun call-with-each-info (function symbol)
diff --git a/src/compiler/meta-vmdef.lisp b/src/compiler/meta-vmdef.lisp
index d5b7954dc..81756c29f 100644
--- a/src/compiler/meta-vmdef.lisp
+++ b/src/compiler/meta-vmdef.lisp
@@ -1634,6 +1634,9 @@
        (let ((,n-res ,(set-up-vop-info inherited-parse parse)))
          (store-vop-info ,n-res)
          ,@(set-up-fun-translation parse n-res))
+       (let ((source-location (source-location)))
+         (when source-location
+           (setf (info :source-location :vop ',name) source-location)))
        ',name)))
 
 (defun store-vop-info (vop-info)
-- 
2.11.4.GIT