X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcompiler%2Ftarget-disassem.lisp;h=01fd03bd5219678cb36d9218a5b7a2d2e52809b5;hb=673234cb910923d41badca51b383e3188f375691;hp=9bcfd33f8e438ea59c0a183fe400ec7b9d2e274e;hpb=d604a358d8e5eb5587989e0a4f1d31dbe6ac5ffe;p=sbcl.git diff --git a/src/compiler/target-disassem.lisp b/src/compiler/target-disassem.lisp index 9bcfd33..01fd03b 100644 --- a/src/compiler/target-disassem.lisp +++ b/src/compiler/target-disassem.lisp @@ -1190,10 +1190,9 @@ (setf (dstate-output-state dstate) :block-boundary)))) -;;; Add hooks to track to track the source code in SEGMENT during -;;; disassembly. SFCACHE can be either NIL or it can be a -;;; SOURCE-FORM-CACHE structure, in which case it is used to cache -;;; forms from files. +;;; Add hooks to track the source code in SEGMENT during disassembly. +;;; SFCACHE can be either NIL or it can be a SOURCE-FORM-CACHE +;;; structure, in which case it is used to cache forms from files. (defun add-source-tracking-hooks (segment debug-fun &optional sfcache) (declare (type segment segment) (type (or null sb!di:debug-fun) debug-fun) @@ -1495,7 +1494,7 @@ (error "can't compile a lexical closure")) (compile nil lambda))) -(defun compiled-fun-or-lose (thing &optional (name thing)) +(defun valid-extended-function-designator-for-disassemble-p (thing) (cond ((legal-fun-name-p thing) (compiled-fun-or-lose (fdefinition thing) thing)) ((functionp thing) @@ -1503,8 +1502,17 @@ ((and (listp thing) (eq (car thing) 'lambda)) (compile nil thing)) - (t - (error "can't make a compiled function from ~S" name)))) + (t nil))) + +(defun compiled-fun-or-lose (thing &optional (name thing)) + (let ((fun (valid-extended-function-designator-for-disassemble-p thing))) + (if fun + fun + (error 'simple-type-error + :datum thing + :expected-type '(satisfies valid-extended-function-designator-for-disassemble-p) + :format-control "can't make a compiled function from ~S" + :format-arguments (list name))))) (defun disassemble (object &key (stream *standard-output*)