X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fpcl%2Fslots.lisp;h=b1fcbb39da124acaacca7629dd48d2e171eb0bac;hb=77869604fc3eb4417a630651e5fe40e74342ee59;hp=a19070bd352cf556561c751bb2ae45275f673bad;hpb=8aa9f63ab314c44840f6f0b331c5308988521f4a;p=sbcl.git

diff --git a/src/pcl/slots.lisp b/src/pcl/slots.lisp
index a19070b..b1fcbb3 100644
--- a/src/pcl/slots.lisp
+++ b/src/pcl/slots.lisp
@@ -26,11 +26,10 @@
 ;;;; ANSI CL condition for unbound slots
 
 (define-condition unbound-slot (cell-error)
-  ((instance :reader unbound-slot-instance :initarg :instance)
-   (slot :reader unbound-slot-slot :initarg :slot))
+  ((instance :reader unbound-slot-instance :initarg :instance))
   (:report (lambda (condition stream)
 	     (format stream "The slot ~S is unbound in the object ~S."
-		     (unbound-slot-slot condition)
+		     (cell-error-name condition)
 		     (unbound-slot-instance condition)))))
 
 (defmethod wrapper-fetcher ((class standard-class))
@@ -58,7 +57,7 @@
 	 (error "unrecognized instance type"))))
 
 (defun swap-wrappers-and-slots (i1 i2)
-  (sb-sys:without-interrupts
+  (with-pcl-lock			;FIXME is this sufficient?
    (cond ((std-instance-p i1)
 	  (let ((w1 (std-instance-wrapper i1))
 		(s1 (std-instance-slots i1)))
@@ -267,7 +266,36 @@
        (error "~@<The slot ~S has neither :INSTANCE nor :CLASS allocation, ~
 	       so it can't be written by the default ~S method.~@:>"
 	      slotd 'slot-makunbound-using-class))))
-  nil)
+  object)
+
+(defmethod slot-value-using-class
+    ((class condition-class)
+     (object condition)
+     (slotd condition-effective-slot-definition))
+  (let ((fun (slot-definition-reader-function slotd)))
+    (declare (type function fun))
+    (funcall fun object)))
+
+(defmethod (setf slot-value-using-class)
+    (new-value
+     (class condition-class)
+     (object condition)
+     (slotd condition-effective-slot-definition))
+  (let ((fun (slot-definition-writer-function slotd)))
+    (declare (type function fun))
+    (funcall fun new-value object)))
+
+(defmethod slot-boundp-using-class
+    ((class condition-class)
+     (object condition)
+     (slotd condition-effective-slot-definition))
+  (let ((fun (slot-definition-boundp-function slotd)))
+    (declare (type function fun))
+    (funcall fun object)))
+
+(defmethod slot-makunbound-using-class ((class condition-class) object slot)
+  (error "attempt to unbind slot ~S in condition object ~S."
+	 slot object))
 
 (defmethod slot-value-using-class
     ((class structure-class)
@@ -315,7 +343,7 @@
 	 instance))
 
 (defmethod slot-unbound ((class t) instance slot-name)
-  (error 'unbound-slot :slot slot-name :instance instance))
+  (error 'unbound-slot :name slot-name :instance instance))
 
 (defun slot-unbound-internal (instance position)
   (slot-unbound (class-of instance) instance
@@ -337,3 +365,7 @@
     (if constructor
 	(funcall constructor)
 	(error "can't allocate an instance of class ~S" (class-name class)))))
+
+(defmethod allocate-instance ((class condition-class) &rest initargs)
+  (declare (ignore initargs))
+  (make-condition (class-name class)))