X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fpcl%2Fslots-boot.lisp;h=6bd1e8b1b34d96bd70e561f38a8e8145c9e4e29e;hb=bd0ba0f214518e8d72ff2d44de5a1e3e4b02af2c;hp=274d682def0b21dfaf7779835bed7744193e8048;hpb=2217cdb364e8b48c187b085895bb2a5cbdbd9622;p=sbcl.git

diff --git a/src/pcl/slots-boot.lisp b/src/pcl/slots-boot.lisp
index 274d682..6bd1e8b 100644
--- a/src/pcl/slots-boot.lisp
+++ b/src/pcl/slots-boot.lisp
@@ -130,29 +130,36 @@
     t))
 
 (defun get-optimized-std-accessor-method-function (class slotd name)
-  (if (structure-class-p class)
-      (ecase name
-	(reader (slot-definition-internal-reader-function slotd))
-	(writer (slot-definition-internal-writer-function slotd))
-	(boundp (make-structure-slot-boundp-function slotd)))
-      (let* ((fsc-p (cond ((standard-class-p class) nil)
-			  ((funcallable-standard-class-p class) t)
-			  ((std-class-p class)
-			   ;; Shouldn't be using the optimized-std-accessors
-			   ;; in this case.
-			   #+nil (format t "* warning: ~S ~S~%   ~S~%"
-				   name slotd class)
-			   nil)
-			  (t (error "~S is not a STANDARD-CLASS." class))))
-	     (slot-name (slot-definition-name slotd))
-	     (index (slot-definition-location slotd))
-	     (function (ecase name
-			 (reader #'make-optimized-std-reader-method-function)
-			 (writer #'make-optimized-std-writer-method-function)
-			 (boundp #'make-optimized-std-boundp-method-function)))
-	     (value (funcall function fsc-p slot-name index)))
-	(declare (type function function))
-	(values value index))))
+  (cond
+    ((structure-class-p class)
+     (ecase name
+       (reader (slot-definition-internal-reader-function slotd))
+       (writer (slot-definition-internal-writer-function slotd))
+       (boundp (make-structure-slot-boundp-function slotd))))
+    ((condition-class-p class)
+     (ecase name
+       (reader (slot-definition-reader-function slotd))
+       (writer (slot-definition-writer-function slotd))
+       (boundp (slot-definition-boundp-function slotd))))
+    (t
+     (let* ((fsc-p (cond ((standard-class-p class) nil)
+			 ((funcallable-standard-class-p class) t)
+			 ((std-class-p class)
+			  ;; Shouldn't be using the optimized-std-accessors
+			  ;; in this case.
+			  #+nil (format t "* warning: ~S ~S~%   ~S~%"
+					name slotd class)
+			  nil)
+			 (t (error "~S is not a STANDARD-CLASS." class))))
+	    (slot-name (slot-definition-name slotd))
+	    (index (slot-definition-location slotd))
+	    (function (ecase name
+			(reader #'make-optimized-std-reader-method-function)
+			(writer #'make-optimized-std-writer-method-function)
+			(boundp #'make-optimized-std-boundp-method-function)))
+	    (value (funcall function fsc-p slot-name index)))
+       (declare (type function function))
+       (values value index)))))
 
 (defun make-optimized-std-reader-method-function (fsc-p slot-name index)
   (declare #.*optimize-speed*)
@@ -236,31 +243,52 @@
     (declare (ignore class object slotd))
     t))
 
-(defun get-optimized-std-slot-value-using-class-method-function (class
-								 slotd
-								 name)
-  (if (structure-class-p class)
-      (ecase name
-	(reader (make-optimized-structure-slot-value-using-class-method-function
-		 (slot-definition-internal-reader-function slotd)))
-	(writer (make-optimized-structure-setf-slot-value-using-class-method-function
-		 (slot-definition-internal-writer-function slotd)))
-	(boundp (make-optimized-structure-slot-boundp-using-class-method-function)))
-      (let* ((fsc-p (cond ((standard-class-p class) nil)
-			  ((funcallable-standard-class-p class) t)
-			  (t (error "~S is not a standard-class" class))))
-	     (slot-name (slot-definition-name slotd))
-	     (index (slot-definition-location slotd))
-	     (function
-	      (ecase name
-		(reader
-		 #'make-optimized-std-slot-value-using-class-method-function)
-		(writer
-		 #'make-optimized-std-setf-slot-value-using-class-method-function)
-		(boundp
-		 #'make-optimized-std-slot-boundp-using-class-method-function))))
-	(declare (type function function))
-	(values (funcall function fsc-p slot-name index) index))))
+(defun get-optimized-std-slot-value-using-class-method-function
+    (class slotd name)
+  (cond
+    ((structure-class-p class)
+     (ecase name
+       (reader (make-optimized-structure-slot-value-using-class-method-function
+		(slot-definition-internal-reader-function slotd)))
+       (writer (make-optimized-structure-setf-slot-value-using-class-method-function
+		(slot-definition-internal-writer-function slotd)))
+       (boundp (make-optimized-structure-slot-boundp-using-class-method-function))))
+    ((condition-class-p class)
+     (ecase name
+       (reader
+	(let ((fun (slot-definition-reader-function slotd)))
+	  (declare (type function fun))
+	  (lambda (class object slotd)
+	    (declare (ignore class slotd))
+	    (funcall fun object))))
+       (writer
+	(let ((fun (slot-definition-writer-function slotd)))
+	  (declare (type function fun))
+	  (lambda (new-value class object slotd)
+	    (declare (ignore class slotd))
+	    (funcall fun new-value object))))
+       (boundp
+	(let ((fun (slot-definition-boundp-function slotd)))
+	  (declare (type function fun))
+	  (lambda (class object slotd)
+	    (declare (ignore class slotd))
+	    (funcall fun object))))))
+    (t
+     (let* ((fsc-p (cond ((standard-class-p class) nil)
+			 ((funcallable-standard-class-p class) t)
+			 (t (error "~S is not a standard-class" class))))
+	    (slot-name (slot-definition-name slotd))
+	    (index (slot-definition-location slotd))
+	    (function
+	     (ecase name
+	       (reader
+		#'make-optimized-std-slot-value-using-class-method-function)
+	       (writer
+		#'make-optimized-std-setf-slot-value-using-class-method-function)
+	       (boundp
+		#'make-optimized-std-slot-boundp-using-class-method-function))))
+       (declare (type function function))
+       (values (funcall function fsc-p slot-name index) index)))))
 
 (defun make-optimized-std-slot-value-using-class-method-function
     (fsc-p slot-name index)