0.8.20.29:

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

diff --git a/src/code/fdefinition.lisp b/src/code/fdefinition.lisp
index 78a574a..59ca173 100644 (file)
--- a/src/code/fdefinition.lisp
+++ b/src/code/fdefinition.lisp
@@ -83,7 +83,7 @@
                                             (type definition))
                               (:copier nil))
   ;; This is definition's encapsulation type. The encapsulated
-  ;; definition is in the previous encapsulation-info element or
+  ;; definition is in the previous ENCAPSULATION-INFO element or
   ;; installed as the global definition of some function name.
   type
   ;; the previous, encapsulated definition. This used to be installed
@@ -112,7 +112,7 @@
     ;; an encapsulation that no longer exists.
     (let ((info (make-encapsulation-info type (fdefn-fun fdefn))))
       (setf (fdefn-fun fdefn)
-           (lambda (&rest arg-list)
+           (named-lambda encapsulation (&rest arg-list)
              (declare (special arg-list))
              (let ((basic-definition (encapsulation-info-definition info)))
                (declare (special basic-definition))
@@ -121,6 +121,7 @@
 ;;; This is like FIND-IF, except that we do it on a compiled closure's
 ;;; environment.
 (defun find-if-in-closure (test fun)
+  (declare (type function test))
   (dotimes (index (1- (get-closure-length fun)))
     (let ((elt (%closure-index-ref fun index)))
       (when (funcall test elt)
@@ -134,7 +135,7 @@
 
 ;;; When removing an encapsulation, we must remember that
 ;;; encapsulating definitions close over a reference to the
-;;; encapsulation-info that describes the encapsulating definition.
+;;; ENCAPSULATION-INFO that describes the encapsulating definition.
 ;;; When you find an info with the target type, the previous info in
 ;;; the chain has the ensulating definition of that type. We take the
 ;;; encapsulated definition from the info with the target type, and we
@@ -226,33 +227,35 @@
 
 (defvar *setf-fdefinition-hook* nil
   #!+sb-doc
-  "This holds functions that (SETF FDEFINITION) invokes before storing the
-   new value. These functions take the function name and the new value.")
+  "A list of functions that (SETF FDEFINITION) invokes before storing the
+   new value. The functions take the function name and the new value.")
 
 (defun %set-fdefinition (name new-value)
   #!+sb-doc
   "Set NAME's global function definition."
   (declare (type function new-value) (optimize (safety 1)))
-  (let ((fdefn (fdefinition-object name t)))
-    ;; *SETF-FDEFINITION-HOOK* won't be bound when initially running
-    ;; top level forms in the kernel core startup.
-    (when (boundp '*setf-fdefinition-hook*)
-      (dolist (f *setf-fdefinition-hook*)
-       (funcall f name new-value)))
-
-    (let ((encap-info (encapsulation-info (fdefn-fun fdefn))))
-      (cond (encap-info
-            (loop
-              (let ((more-info
-                     (encapsulation-info
-                      (encapsulation-info-definition encap-info))))
-                (if more-info
-                    (setf encap-info more-info)
-                    (return
-                     (setf (encapsulation-info-definition encap-info)
-                           new-value))))))
-           (t
-            (setf (fdefn-fun fdefn) new-value))))))
+  (with-single-package-locked-error (:symbol name "setting fdefinition of ~A")
+    (let ((fdefn (fdefinition-object name t)))
+      ;; *SETF-FDEFINITION-HOOK* won't be bound when initially running
+      ;; top level forms in the kernel core startup.
+      (when (boundp '*setf-fdefinition-hook*)
+       (dolist (f *setf-fdefinition-hook*)
+         (declare (type function f))
+         (funcall f name new-value)))
+      
+      (let ((encap-info (encapsulation-info (fdefn-fun fdefn))))
+       (cond (encap-info
+              (loop
+               (let ((more-info
+                      (encapsulation-info
+                       (encapsulation-info-definition encap-info))))
+                 (if more-info
+                     (setf encap-info more-info)
+                     (return
+                       (setf (encapsulation-info-definition encap-info)
+                             new-value))))))
+             (t
+              (setf (fdefn-fun fdefn) new-value)))))))
 \f
 ;;;; FBOUNDP and FMAKUNBOUND
 
@@ -265,8 +268,10 @@
 (defun fmakunbound (name)
   #!+sb-doc
   "Make NAME have no global function definition."
-  (let ((fdefn (fdefinition-object name nil)))
-    (when fdefn
-      (fdefn-makunbound fdefn)))
-  (sb!kernel:undefine-fun-name name)
-  name)
+  (with-single-package-locked-error 
+      (:symbol name "removing the function or macro definition of ~A")
+    (let ((fdefn (fdefinition-object name nil)))
+      (when fdefn
+       (fdefn-makunbound fdefn)))
+    (sb!kernel:undefine-fun-name name)
+    name))