From e80028ff4f24897a34c3e28bcc8e50d081668fd6 Mon Sep 17 00:00:00 2001
From: chiles <chiles>
Date: Thu, 7 Nov 1991 15:46:07 +0000
Subject: [PATCH] Fixed %SET-FDEFINITION to work in the kernel core startup
 before executing DEFVARs for *encapsulation-info* and
 *setf-fdefinition-hook*.

---
 code/fdefinition.lisp | 17 +++++++++++++----
 1 file changed, 13 insertions(+), 4 deletions(-)

diff --git a/code/fdefinition.lisp b/code/fdefinition.lisp
index 84d3e59ef..47cb21863 100644
--- a/code/fdefinition.lisp
+++ b/code/fdefinition.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/fdefinition.lisp,v 1.9 1991/11/05 16:51:20 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/fdefinition.lisp,v 1.10 1991/11/07 15:46:07 chiles Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -229,7 +229,10 @@
   "Set name's global function definition."
   (declare (type function new-value) (optimize (safety 1)))
   (macrolet ((set-basic-def (name new-value form)
-	       `(let ((encap-info (gethash ,name *encapsulation-info*)))
+	       ;; *encapsulation-info* won't be bound when initially running
+	       ;; top-level forms in the kernel core startup.
+	       `(let ((encap-info (if (boundp '*encapsulation-info*)
+				      (gethash ,name *encapsulation-info*))))
 		  (cond (encap-info
 			 (loop
 			   (when (not (encapsulation-info-next encap-info))
@@ -241,11 +244,17 @@
 			   (setf encap-info
 				 (encapsulation-info-next encap-info))))
 			(t
-			 (dolist (f *setf-fdefinition-hook*)
-			   (funcall f ,name ,new-value))
+			 ;; *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)))
 			 (setf ,form ,new-value))))))
     (function-name-dispatch name
       (set-basic-def name new-value (symbol-function name))
+      ;; We make sure no SETF definitions exist before the DEFVAR for
+      ;; *setf-functions* runs in the kernel core.
       (set-basic-def name new-value (gethash (cadr name) *setf-functions*)))))
 ;;;
 (defsetf fdefinition %set-fdefinition)
-- 
GitLab