sb-introspect:find-definition-sources-by-name: find VOPs by name.

(sb-introspect:find-definition-sources-by-name x :vop) now
also returns VOPs which do not translate any functions.

diff --git a/NEWS b/NEWS
index a9e68ea..e051461 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -1,12 +1,13 @@
 ;;;; -*- coding: utf-8; fill-column: 78 -*-
 changes relative to sbcl-1.1.7:
-  * bug fix: disassembler missing ",8" on SHLD
   * enhancement: RUN-PROGRAM supports a :DIRECTORY argument to set
     the working directory of the spawned process.
     (lp#791800) (patch by Matthias Benkard)
   * enhancement: vectors can now be stack-allocated on PPC.
   * enhancement: "fixed objects" can now be stack-allocated on PPC.
   * enhancement: WITH-PINNED-OBJECTS no longer conses on PPC/GENCGC.
+  * enhancement: (sb-introspect:find-definition-sources-by-name x :vop) now
+    also returns VOPs which do not translate any functions.
   * bug fix: type derivation for LOG{AND,IOR,XOR} scales linearly instead
     of quadratically with the size of the input in the worst case.
     (lp#1096444)
@@ -15,6 +16,7 @@ changes relative to sbcl-1.1.7:
     decoding errors, or directories being deleted.
   * bug fix: Loading a core with a discontiguous dynamic space now correctly
     computes the amount of dynamic space used.
+  * bug fix: disassembler missing ",8" on SHLD
   * optimization: faster ISQRT on fixnums and small bignums
   * optimization: faster and smaller INTEGER-LENGTH on fixnums on x86-64.
 

diff --git a/contrib/sb-introspect/introspect.lisp b/contrib/sb-introspect/introspect.lisp
index f958e70..3a683e7 100644 (file)
--- a/contrib/sb-introspect/introspect.lisp
+++ b/contrib/sb-introspect/introspect.lisp
@@ -124,6 +124,30 @@ FBOUNDP."
   ;; 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*))
+         (source (and vop
+                      (find-definition-source
+                       (sb-c::vop-info-generator-function vop)))))
+    (when source
+      (setf (definition-source-description source)
+            (list name)))
+    (if source
+        (cons source templates)
+        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
@@ -288,15 +312,7 @@ If an unsupported TYPE is requested, the function will return NIL.
                         source)))))))
        ((:vop)
         (when (symbolp 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)))))
+          (find-vop-source name)))
        ((:source-transform)
         (when (symbolp name)
           (let ((transform-fun (sb-int:info :function :source-transform name)))