X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcode%2Fntrace.lisp;h=5476378baa4446462039d1accc9997925d72176a;hb=9aac8cfe0d3b3dd27b292e5661104221ddbd1bee;hp=b6453870886e2bdbe0a4eae68373ed1a9e46b940;hpb=46c578f4cf21abde02e39a5da5a96dbd6653c4b8;p=sbcl.git diff --git a/src/code/ntrace.lisp b/src/code/ntrace.lisp index b645387..5476378 100644 --- a/src/code/ntrace.lisp +++ b/src/code/ntrace.lisp @@ -124,17 +124,24 @@ (error "can't trace special form ~S" x)) ((macro-function x)) (t - (values (fdefinition x) t)))) + (values (when (fboundp x) + (fdefinition x)) + t)))) (function x) - (t (values (fdefinition x) t))) - (case (sb-kernel:widetag-of res) - (#.sb-vm:closure-header-widetag + (t (values (when (fboundp x) + (fdefinition x)) + t))) + (typecase res + (closure (values (sb-kernel:%closure-fun res) named-p :compiled-closure)) - (#.sb-vm:funcallable-instance-header-widetag + (funcallable-instance (values res named-p :funcallable-instance)) - (t (values res named-p :compiled))))) + ;; FIXME: What about SB!EVAL:INTERPRETED-FUNCTION -- it gets picked off + ;; by the FIN above, is that right? + (t + (values res named-p :compiled))))) ;;; When a function name is redefined, and we were tracing that name, ;;; then untrace the old definition and trace the new one. @@ -641,19 +648,27 @@ are evaluated in the null environment." ;;; Untrace one function. (defun untrace-1 (function-or-name) (let* ((fun (trace-fdefinition function-or-name)) - (info (gethash fun *traced-funs*))) + (info (when fun (gethash fun *traced-funs*)))) (cond - ((not info) - (warn "Function is not TRACEd: ~S" function-or-name)) - (t - (cond - ((trace-info-encapsulated info) - (unencapsulate (trace-info-what info) 'trace)) - (t - (sb-di:delete-breakpoint (trace-info-start-breakpoint info)) - (sb-di:delete-breakpoint (trace-info-end-breakpoint info)))) - (setf (trace-info-untraced info) t) - (remhash fun *traced-funs*))))) + ((and fun (not info)) + (warn "Function is not TRACEd: ~S" function-or-name)) + ((not fun) + ;; Someone has FMAKUNBOUND it. + (let ((table *traced-funs*)) + (with-locked-hash-table (table) + (maphash (lambda (fun info) + (when (equal function-or-name (trace-info-what info)) + (remhash fun table))) + table)))) + (t + (cond + ((trace-info-encapsulated info) + (unencapsulate (trace-info-what info) 'trace)) + (t + (sb-di:delete-breakpoint (trace-info-start-breakpoint info)) + (sb-di:delete-breakpoint (trace-info-end-breakpoint info)))) + (setf (trace-info-untraced info) t) + (remhash fun *traced-funs*))))) ;;; Untrace all traced functions. (defun untrace-all ()