X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fpcl%2Fvector.lisp;h=76179ea459186df1fc1ba629ac9b6fb082eb852d;hb=416152f084604094445a758ff399871132dff2bd;hp=dbf5fa84b6b3190bddd7efa5bc5ab8ff4053da74;hpb=99ad0a384664dc98af26245a33f11619ec0854ad;p=sbcl.git

diff --git a/src/pcl/vector.lisp b/src/pcl/vector.lisp
index dbf5fa8..76179ea 100644
--- a/src/pcl/vector.lisp
+++ b/src/pcl/vector.lisp
@@ -36,10 +36,10 @@
 (defun pv-cache-limit-fn (nlines)
   (default-limit-fn nlines))
 
-(defstruct (pv-table
-	     (:predicate pv-tablep)
-	     (:constructor make-pv-table-internal
-			   (slot-name-lists call-list)))
+(defstruct (pv-table (:predicate pv-tablep)
+		     (:constructor make-pv-table-internal
+				   (slot-name-lists call-list))
+		     (:copier nil))
   (cache nil :type (or cache null))
   (pv-size 0 :type fixnum)
   (slot-name-lists nil :type list)
@@ -428,7 +428,7 @@
 	  (when (or (not (eq *boot-state* 'complete))
 		    (and class (not (class-finalized-p class))))
 	    (setq class nil))
-	  (when (and class-name (not (eq class-name 't)))
+	  (when (and class-name (not (eq class-name t)))
 	    (when (or (null type)
 		      (not (and class
 				(memq *the-class-structure-object*
@@ -520,7 +520,7 @@
 		     ,parameter)
 		    ,new-value))
 	    (:boundp
-	     'T)))
+	     t)))
 	(let* ((parameter-entry (assq parameter slots))
 	       (slot-entry      (assq slot-name (cdr parameter-entry)))
 	       (position (posq parameter-entry slots))
@@ -580,7 +580,7 @@
 	     (when parameter-or-nil
 	       (let* ((class-name (caddr (variable-declaration
 					  'class parameter-or-nil env))))
-		 (when (and class-name (not (eq class-name 't)))
+		 (when (and class-name (not (eq class-name t)))
 		   (position parameter-or-nil slots :key #'car))))))
       (if (constantp form)
 	  (let ((form (eval form)))
@@ -663,7 +663,7 @@
 	  (let ((,index (pvref ,pv ,pv-offset)))
 	    (setq ,value (typecase ,index
 			   ,@(when (or (null type) (eq type ':instance))
-			       `((fixnum (%instance-ref ,slots ,index))))
+			       `((fixnum (clos-slots-ref ,slots ,index))))
 			   ,@(when (or (null type) (eq type ':class))
 			       `((cons (cdr ,index))))
 			   (t +slot-unbound+)))
@@ -697,7 +697,8 @@
 	  (let ((,index (pvref ,pv ,pv-offset)))
 	    (typecase ,index
 	      ,@(when (or (null type) (eq type ':instance))
-		  `((fixnum (setf (%instance-ref ,slots ,index) ,new-value))))
+                      `((fixnum (setf (clos-slots-ref ,slots ,index)
+				      ,new-value))))
 	      ,@(when (or (null type) (eq type ':class))
 		  `((cons (setf (cdr ,index) ,new-value))))
 	      (t ,default)))))))
@@ -743,8 +744,9 @@
 	  (let ((,index (pvref ,pv ,pv-offset)))
 	    (typecase ,index
 	      ,@(when (or (null type) (eq type ':instance))
-		  `((fixnum (not (eq (%instance-ref ,slots ,index)
-				     +slot-unbound+)))))
+		  `((fixnum (not (and ,slots
+                                      (eq (clos-slots-ref ,slots ,index)
+                                          +slot-unbound+))))))
 	      ,@(when (or (null type) (eq type ':class))
 		  `((cons (not (eq (cdr ,index) +slot-unbound+)))))
 	      (t ,default)))))))
@@ -1068,10 +1070,11 @@
 		     (nm (car next-methods))
 		     (nms (cdr next-methods))
 		     (nmc (when nm
-			    (make-method-call :function (if (std-instance-p nm)
-							    (method-function nm)
-							    nm)
-					      :call-method-args (list nms)))))
+			    (make-method-call
+			     :function (if (std-instance-p nm)
+					   (method-function nm)
+					   nm)
+			     :call-method-args (list nms)))))
 		(if restp
 		    (let* ((rest (nthcdr nreq method-args))
 			   (args (ldiff method-args rest)))
@@ -1108,7 +1111,7 @@
 	 (w-t pv-wrappers))
     (dolist (arg args)
       (setq w (wrapper-of arg))
-      (unless (eq 't (wrapper-state w)) ; FIXME: should be INVALID-WRAPPER-P
+      (unless (eq t (wrapper-state w)) ; FIXME: should be INVALID-WRAPPER-P
 	(setq w (check-wrapper-validity arg)))
       (setf (car w-t) w))
       (setq w-t (cdr w-t))