diff --git a/code/debug-int.lisp b/code/debug-int.lisp index efc54e8a09995f3bfeeb9cbd39c0ebc9c37b2029..21dd47ecb82880bbbc301b4fa0a44b2558fcf5fd 100644 --- a/code/debug-int.lisp +++ b/code/debug-int.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/debug-int.lisp,v 1.121 2005/03/18 05:33:12 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/debug-int.lisp,v 1.122 2006/01/23 14:11:02 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -1955,7 +1955,28 @@ The result is a symbol or nil if the routine cannot be found." (debug-function-from-pc component (* (- (kernel:function-word-offset fun) (kernel:get-header-data component)) - vm:word-bytes))))))) + vm:word-bytes))))) + (#.vm:list-pointer-type + ;; FIXME: Kind of gross, but this is how we recognize LABELS/FLET + ;; functions: we're given a list of the function name. + (unless (valid-function-name-p fun) + (error "Invalid function name: ~A~%" fun)) + (let* ((external (fdefinition (car (last fun)))) + (component (kernel:function-code-header external)) + (res + ;; Look through all the debug functions until we find one + ;; that matches our name. + (find-if + #'(lambda (x) + (and (c::compiled-debug-function-p x) + (equal (c::compiled-debug-function-name x) fun) + (eq (c::compiled-debug-function-kind x) nil))) + (get-debug-info-function-map + (kernel:%code-debug-info component))))) + (if res + (make-compiled-debug-function res + (kernel:function-code-header external)) + (error "No such function ~A~%" fun)))))) ;;; DEBUG-FUNCTION-KIND -- Public. diff --git a/code/ntrace.lisp b/code/ntrace.lisp index 616843baaf982ac09c56385bd36a26a18d5b6fa4..88f4f691a5d09e6e298a164355f2f081fda461bb 100644 --- a/code/ntrace.lisp +++ b/code/ntrace.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/ntrace.lisp,v 1.32 2005/12/17 17:52:15 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/ntrace.lisp,v 1.33 2006/01/23 14:11:02 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -164,6 +164,10 @@ (t (values (fdefinition x) t)))) (function x) + (list + ;; An extended function name for flets/labels. Should we + ;; make this check? + (values x nil)) (t (values (fdefinition x) t))) (if (eval:interpreted-function-p res) (values res named-p (if (eval:interpreted-function-closure res)