From 17b58770189ea2427f7fc13e76a73ff543d58b03 Mon Sep 17 00:00:00 2001 From: Stas Boukarev Date: Sat, 4 May 2013 04:14:21 +0400 Subject: [PATCH] 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. --- NEWS | 4 +++- contrib/sb-introspect/introspect.lisp | 34 ++++++++++++++++++++++++--------- 2 files changed, 28 insertions(+), 10 deletions(-) diff --git a/NEWS b/NEWS index a9e68ea..e051461 100644 --- 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 --- 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))) -- 1.7.10.4