X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fpcl%2Fslots-boot.lisp;h=dc46d563899cf100a661810350e6636867ea4293;hb=1b650be8b800cf96e2c268ae317fb26d0bf36827;hp=6bd1e8b1b34d96bd70e561f38a8e8145c9e4e29e;hpb=83e5661ae59addac315e6754013b3887b477570f;p=sbcl.git

diff --git a/src/pcl/slots-boot.lisp b/src/pcl/slots-boot.lisp
index 6bd1e8b..dc46d56 100644
--- a/src/pcl/slots-boot.lisp
+++ b/src/pcl/slots-boot.lisp
@@ -35,19 +35,21 @@
 			(slot-value
 			 (make-method-function
 			  (lambda (obj)
-			    (slot-missing (class-of obj) obj slot-name
-					  'slot-value))))
+			    (values
+			     (slot-missing (class-of obj) obj slot-name
+					   'slot-value)))))
 			(slot-boundp
 			 (make-method-function
 			  (lambda (obj)
-			    (slot-missing (class-of obj) obj slot-name
-					  'slot-boundp))))
+			    (not (not
+				  (slot-missing (class-of obj) obj slot-name
+						'slot-boundp))))))
 			(setf
 			 (make-method-function
 			  (lambda (val obj)
-			    (declare (ignore val))
 			    (slot-missing (class-of obj) obj slot-name
-					  'setf))))))))
+					  'setf val)
+			    val)))))))
 	       (setf (getf (getf initargs :plist) :slot-name-lists)
 		     (list (list nil slot-name)))
 	       (setf (getf (getf initargs :plist) :pv-table-symbol)
@@ -107,9 +109,11 @@
 	 (form
 	  `(let ((.ignore.
 		  (load-time-value
-		   (ensure-accessor 'writer ',writer-name ',slot-name))))
+		   (ensure-accessor 'writer ',writer-name ',slot-name)))
+		 (.new-value. ,new-value))
 	    (declare (ignore .ignore.))
-	    (funcall #',writer-name ,new-value ,object))))
+	    (funcall #',writer-name .new-value. ,object)
+	    .new-value.)))
     (if bindings
 	`(let ,bindings ,form)
 	form)))
@@ -165,27 +169,29 @@
   (declare #.*optimize-speed*)
   (set-fun-name
    (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)
-		     value)))))
+     (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+)
+		  (values
+		   (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+)
+		  (values
+		   (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+)
+	      (values (slot-unbound (class-of instance) instance slot-name))
+	      value)))))
    `(reader ,slot-name)))
 
 (defun make-optimized-std-writer-method-function (fsc-p slot-name index)
@@ -301,7 +307,7 @@
 		  (let ((value (clos-slots-ref (fsc-instance-slots instance)
 					       index)))
 		    (if (eq value +slot-unbound+)
-			(slot-unbound class instance slot-name)
+			(values (slot-unbound class instance slot-name))
 			value)))
 		(lambda (class instance slotd)
 		  (declare (ignore slotd))
@@ -309,14 +315,14 @@
 		  (let ((value (clos-slots-ref (std-instance-slots instance)
 					       index)))
 		    (if (eq value +slot-unbound+)
-			(slot-unbound class instance slot-name)
+			(values (slot-unbound class instance slot-name))
 			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)
+		    (values (slot-unbound class instance slot-name))
 		    value))))))
 
 (defun make-optimized-std-setf-slot-value-using-class-method-function
@@ -389,16 +395,16 @@
 		       (let ((value (clos-slots-ref (get-slots instance)
 						    index)))
 			 (if (eq value +slot-unbound+)
-			     (slot-unbound (class-of instance)
-					   instance
-					   slot-name)
+			     (values (slot-unbound (class-of instance)
+						   instance
+						   slot-name))
 			     value)))
 		      (cons
 		       (let ((value (cdr index)))
 			 (if (eq value +slot-unbound+)
-			     (slot-unbound (class-of instance)
-					   instance
-					   slot-name)
+			     (values (slot-unbound (class-of instance)
+						   instance
+						   slot-name))
 			     value)))
 		      (t
 		       (error "~@<The wrapper for class ~S does not have ~