1.0.46.9: detect invalid use of :PREDICATE with DEFSTRUCT :TYPE

[sbcl.git] / src / code / ntrace.lisp

diff --git a/src/code/ntrace.lisp b/src/code/ntrace.lisp
index b645387..5476378 100644 (file)
--- 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 ()