X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fpcl%2Fslots-boot.lisp;h=273805b18a62b64af1c28ddbd8968c0f1d865f21;hb=e47ffa8855d4139f88f5982fe4b82a05c3498ed3;hp=9208b634f13aa001a5361c8ad9484f1139601698;hpb=ac436be829bb9af24fbce37499735671b942872a;p=sbcl.git

diff --git a/src/pcl/slots-boot.lisp b/src/pcl/slots-boot.lisp
index 9208b63..273805b 100644
--- a/src/pcl/slots-boot.lisp
+++ b/src/pcl/slots-boot.lisp
@@ -99,18 +99,21 @@
    (etypecase index
      (fixnum (if fsc-p
 		 (lambda (instance)
+		   (check-obsolete-instance instance)
 		   (let ((value (clos-slots-ref (fsc-instance-slots instance)
 						index)))
 		     (if (eq value +slot-unbound+)
 			 (slot-unbound (class-of instance) instance slot-name)
 			 value)))
 		 (lambda (instance)
+		   (check-obsolete-instance instance)
 		   (let ((value (clos-slots-ref (std-instance-slots instance)
 					      index)))
 		     (if (eq value +slot-unbound+)
 			 (slot-unbound (class-of instance) instance slot-name)
 			 value)))))
      (cons   (lambda (instance)
+	       (check-obsolete-instance instance)
 	       (let ((value (cdr index)))
 		 (if (eq value +slot-unbound+)
 		     (slot-unbound (class-of instance) instance slot-name)
@@ -123,13 +126,15 @@
    (etypecase index
      (fixnum (if fsc-p
 		 (lambda (nv instance)
+		   (check-obsolete-instance instance)
 		   (setf (clos-slots-ref (fsc-instance-slots instance) index)
 			 nv))
 		 (lambda (nv instance)
+		   (check-obsolete-instance instance)
 		   (setf (clos-slots-ref (std-instance-slots instance) index)
 			 nv))))
      (cons   (lambda (nv instance)
-	       (declare (ignore instance))
+	       (check-obsolete-instance instance)
 	       (setf (cdr index) nv))))
    `(writer ,slot-name)))
 
@@ -139,15 +144,17 @@
    (etypecase index
      (fixnum (if fsc-p
 		 (lambda (instance)
+		   (check-obsolete-instance instance)
 		   (not (eq (clos-slots-ref (fsc-instance-slots instance)
 					    index)
 			    +slot-unbound+)))
 		 (lambda (instance)
+		   (check-obsolete-instance instance)
 		   (not (eq (clos-slots-ref (std-instance-slots instance)
 					    index)
 			    +slot-unbound+)))))
      (cons (lambda (instance)
-	     (declare (ignore instance))
+	     (check-obsolete-instance instance)
 	     (not (eq (cdr index) +slot-unbound+)))))
    `(boundp ,slot-name)))
 
@@ -201,7 +208,7 @@
     (fixnum (if fsc-p
 		(lambda (class instance slotd)
 		  (declare (ignore slotd))
-		  (unless (fsc-instance-p instance) (error "not fsc"))
+		  (check-obsolete-instance instance)
 		  (let ((value (clos-slots-ref (fsc-instance-slots instance)
 					       index)))
 		    (if (eq value +slot-unbound+)
@@ -209,7 +216,7 @@
 			value)))
 		(lambda (class instance slotd)
 		  (declare (ignore slotd))
-		  (unless (std-instance-p instance) (error "not std"))
+		  (check-obsolete-instance instance)
 		  (let ((value (clos-slots-ref (std-instance-slots instance)
 					       index)))
 		    (if (eq value +slot-unbound+)
@@ -217,6 +224,7 @@
 			value)))))
     (cons   (lambda (class instance slotd)
 	      (declare (ignore slotd))
+	      (check-obsolete-instance instance)
 	      (let ((value (cdr index)))
 		(if (eq value +slot-unbound+)
 		    (slot-unbound class instance slot-name)
@@ -230,14 +238,17 @@
     (fixnum (if fsc-p
 		(lambda (nv class instance slotd)
 		  (declare (ignore class slotd))
+		  (check-obsolete-instance instance)
 		  (setf (clos-slots-ref (fsc-instance-slots instance) index)
 			nv))
 		(lambda (nv class instance slotd)
 		  (declare (ignore class slotd))
+		  (check-obsolete-instance instance)
 		  (setf (clos-slots-ref (std-instance-slots instance) index)
 			nv))))
     (cons  (lambda (nv class instance slotd)
-	     (declare (ignore class instance slotd))
+	     (declare (ignore class slotd))
+	     (check-obsolete-instance instance)
 	     (setf (cdr index) nv)))))
 
 (defun make-optimized-std-slot-boundp-using-class-method-function
@@ -248,14 +259,17 @@
     (fixnum (if fsc-p
 		(lambda (class instance slotd)
 		  (declare (ignore class slotd))
+		  (check-obsolete-instance instance)
 		  (not (eq (clos-slots-ref (fsc-instance-slots instance) index)
 			   +slot-unbound+)))
 		(lambda (class instance slotd)
 		  (declare (ignore class slotd))
+		  (check-obsolete-instance instance)
 		  (not (eq (clos-slots-ref (std-instance-slots instance) index)
 			   +slot-unbound+)))))
     (cons   (lambda (class instance slotd)
-	      (declare (ignore class instance slotd))
+	      (declare (ignore class slotd))
+	      (check-obsolete-instance instance)
 	      (not (eq (cdr index) +slot-unbound+))))))
 
 (defun get-accessor-from-svuc-method-function (class slotd sdfun name)