X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fpcl%2Fdefs.lisp;h=5943a8db63033eda17475a789701e6ffb663b987;hb=0b5610d8a220a4b20cbeac958953ca4d67c00038;hp=6c5b9902760aec54f709a4d3e0ce54fbda383d9f;hpb=d5aafdd8ab6387e12bac187048ed322bc96fb79a;p=sbcl.git

diff --git a/src/pcl/defs.lisp b/src/pcl/defs.lisp
index 6c5b990..5943a8d 100644
--- a/src/pcl/defs.lisp
+++ b/src/pcl/defs.lisp
@@ -23,18 +23,20 @@
 
 (in-package "SB-PCL")
 
-
-(eval-when (:load-toplevel :execute)
-  (when (eq *boot-state* 'complete)
-    (error "Trying to load (or compile) PCL in an environment in which it~%~
-	    has already been loaded. This doesn't work, you will have to~%~
-	    get a fresh lisp (reboot) and then load PCL."))
-  (when *boot-state*
-    (cerror "Try loading (or compiling) PCL anyways."
-	    "Trying to load (or compile) PCL in an environment in which it~%~
-	     has already been partially loaded. This may not work, you may~%~
-	     need to get a fresh lisp (reboot) and then load PCL."))
-  ) ; EVAL-WHEN
+;;; (These are left over from the days when PCL was an add-on package
+;;; for a pre-CLOS Common Lisp. They shouldn't happen in a normal
+;;; build, of course, but they might happen if someone is experimenting
+;;; and debugging, and it's probably worth complaining if they do,
+;;; so we've left 'em in.)
+(when (eq *boot-state* 'complete)
+  (error "Trying to load (or compile) PCL in an environment in which it~%~
+	  has already been loaded. This doesn't work, you will have to~%~
+	  get a fresh lisp (reboot) and then load PCL."))
+(when *boot-state*
+  (cerror "Try loading (or compiling) PCL anyways."
+	  "Trying to load (or compile) PCL in an environment in which it~%~
+	   has already been partially loaded. This may not work, you may~%~
+	   need to get a fresh lisp (reboot) and then load PCL."))
 
 ;;; comments from CMU CL version of PCL:
 ;;;     This is like fdefinition on the Lispm. If Common Lisp had
@@ -454,25 +456,25 @@
 
 ;;; Grovel over SB-KERNEL::*BUILT-IN-CLASSES* in order to set
 ;;; SB-PCL:*BUILT-IN-CLASSES*.
-(sb-int:/show "about to set up SB-PCL::*BUILT-IN-CLASSES*")
+(/show "about to set up SB-PCL::*BUILT-IN-CLASSES*")
 (defvar *built-in-classes*
   (labels ((direct-supers (class)
-	     (sb-int:/show "entering DIRECT-SUPERS" (sb-kernel::class-name class))
+	     (/show "entering DIRECT-SUPERS" (sb-kernel::class-name class))
 	     (if (typep class 'cl:built-in-class)
 		 (sb-kernel:built-in-class-direct-superclasses class)
 		 (let ((inherits (sb-kernel:layout-inherits
 				  (sb-kernel:class-layout class))))
-		   (sb-int:/show inherits)
+		   (/show inherits)
 		   (list (svref inherits (1- (length inherits)))))))
 	   (direct-subs (class)
-	     (sb-int:/show "entering DIRECT-SUBS" (sb-kernel::class-name class))
-	     (sb-int:collect ((res))
+	     (/show "entering DIRECT-SUBS" (sb-kernel::class-name class))
+	     (collect ((res))
 	       (let ((subs (sb-kernel:class-subclasses class)))
-		 (sb-int:/show subs)
+		 (/show subs)
 		 (when subs
-		   (sb-int:dohash (sub v subs)
+		   (dohash (sub v subs)
 		     (declare (ignore v))
-		     (sb-int:/show sub)
+		     (/show sub)
 		     (when (member class (direct-supers sub))
 		       (res sub)))))
 	       (res)))
@@ -500,10 +502,10 @@
 		   ;; relevant cases.
 		   42))))
     (mapcar (lambda (kernel-bic-entry)
-	      (sb-int:/show "setting up" kernel-bic-entry)
+	      (/show "setting up" kernel-bic-entry)
 	      (let* ((name (car kernel-bic-entry))
 		     (class (cl:find-class name)))
-		(sb-int:/show name class)
+		(/show name class)
 		`(,name
 		  ,(mapcar #'cl:class-name (direct-supers class))
 		  ,(mapcar #'cl:class-name (direct-subs class))
@@ -523,7 +525,7 @@
 				     sb-kernel:funcallable-instance
 				     function stream)))
 		       sb-kernel::*built-in-classes*))))
-(sb-int:/show "done setting up SB-PCL::*BUILT-IN-CLASSES*")
+(/show "done setting up SB-PCL::*BUILT-IN-CLASSES*")
 
 ;;;; the classes that define the kernel of the metabraid
 
@@ -549,7 +551,8 @@
   (:metaclass structure-class))
 
 (defstruct (dead-beef-structure-object
-	    (:constructor |STRUCTURE-OBJECT class constructor|)))
+	    (:constructor |STRUCTURE-OBJECT class constructor|)
+	    (:copier nil)))
 
 (defclass std-object (slot-object) ()
   (:metaclass std-class))