diff --git a/pcl/braid.lisp b/pcl/braid.lisp
index 8e7a78d18926a1df4bbd5ca1b392d774ae4b9f38..f52825c8dc3c1340e367307b2a6f9ce1f1afe4d0 100644
--- a/pcl/braid.lisp
+++ b/pcl/braid.lisp
@@ -25,7 +25,7 @@
 ;;; *************************************************************************
 
 (file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/braid.lisp,v 1.36 2003/05/10 19:09:02 gerd Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/braid.lisp,v 1.37 2003/05/11 11:30:35 gerd Exp $")
 
 ;;;
 ;;; Bootstrapping the meta-braid.
@@ -124,13 +124,14 @@
 	 slot-class-wrapper slot-class
 	 built-in-class-wrapper built-in-class
 	 structure-class-wrapper structure-class
+	 condition-class-wrapper condition-class
 	 standard-direct-slot-definition-wrapper standard-direct-slot-definition
 	 standard-effective-slot-definition-wrapper standard-effective-slot-definition
 	 class-eq-specializer-wrapper class-eq-specializer
 	 standard-generic-function-wrapper standard-generic-function)
     (initial-classes-and-wrappers 
      standard-class funcallable-standard-class
-     slot-class built-in-class structure-class
+     slot-class built-in-class structure-class condition-class
      standard-direct-slot-definition standard-effective-slot-definition 
      class-eq-specializer standard-generic-function)
     ;;
@@ -146,7 +147,8 @@
 			(standard-class standard-class-wrapper)
 			(funcallable-standard-class funcallable-standard-class-wrapper)
 			(built-in-class built-in-class-wrapper)
-			(structure-class structure-class-wrapper)))
+			(structure-class structure-class-wrapper)
+			(condition-class condition-class-wrapper)))
              (class (or (find-class name nil)
 			(allocate-standard-instance wrapper))))
 	(when (or (eq meta 'standard-class)
@@ -182,6 +184,8 @@
 				   built-in-class-wrapper)
 				  ((eq class structure-class)
 				   structure-class-wrapper)
+				  ((eq class condition-class)
+				   condition-class-wrapper)
 				  ((eq class class-eq-specializer)
 				   class-eq-specializer-wrapper)
 				  ((eq class standard-generic-function)
@@ -235,6 +239,11 @@
 		  direct-supers direct-subclasses cpl wrapper proto))
 		(structure-class	; *the-class-structure-object*
 		 (bootstrap-initialize-class 
+		  meta
+		  class name class-eq-specializer-wrapper source
+		  direct-supers direct-subclasses cpl wrapper))
+		(condition-class
+		 (bootstrap-initialize-class
 		  meta
 		  class name class-eq-specializer-wrapper source
 		  direct-supers direct-subclasses cpl wrapper))))))))
@@ -290,7 +299,7 @@
 		,@(and default-initargs
 		       `(default-initargs ,default-initargs))))
     (when (memq metaclass-name '(standard-class funcallable-standard-class
-				 structure-class slot-class))
+				 structure-class slot-class condition-class))
       (set-slot 'direct-slots direct-slots)
       (set-slot 'slots slots)
       (set-slot 'initialize-info nil))
@@ -310,26 +319,28 @@
 	       (setf (bootstrap-get-slot metaclass-name super 'direct-subclasses)
 		     (cons class subclasses))))))
     ;;
-    (if (eq metaclass-name 'structure-class)
-	(let ((constructor-sym '|STRUCTURE-OBJECT class constructor|))
-	  (set-slot 'predicate-name (or (cadr (assoc name *early-class-predicates*))
-					(make-class-predicate-name name)))
-	  (set-slot 'defstruct-form 
-		    `(defstruct (structure-object (:constructor ,constructor-sym))))
-	  (set-slot 'defstruct-constructor constructor-sym)
-	  (set-slot 'from-defclass-p t)    
-	  (set-slot 'plist nil)
-	  (set-slot 'prototype (funcall constructor-sym)))
-	(set-slot 'prototype (if proto-p proto (allocate-standard-instance wrapper))))
+    (case metaclass-name
+      (structure-class
+       (let ((constructor-sym '|STRUCTURE-OBJECT class constructor|))
+	 (set-slot 'predicate-name (or (cadr (assoc name *early-class-predicates*))
+				       (make-class-predicate-name name)))
+	 (set-slot 'defstruct-form 
+		   `(defstruct (structure-object (:constructor ,constructor-sym))))
+	 (set-slot 'defstruct-constructor constructor-sym)
+	 (set-slot 'from-defclass-p t)    
+	 (set-slot 'plist nil)
+	 (set-slot 'prototype (funcall constructor-sym))))
+      (condition-class
+       (set-slot 'prototype (make-condition name)))
+      (t
+       (set-slot 'prototype
+		 (if proto-p proto (allocate-standard-instance wrapper)))))
     class))
 
 (defun bootstrap-make-slot-definitions (name class slots wrapper effective-p)
-  (let ((index -1))
-    (mapcar (lambda (slot)
-	      (incf index)
-	      (bootstrap-make-slot-definition
-	       name class slot wrapper effective-p index))
-	    slots)))
+  (loop for index from 0 and slot in slots collect
+	(bootstrap-make-slot-definition name class slot wrapper
+					effective-p index)))
 
 (defun bootstrap-make-slot-definition (name class slot wrapper effective-p index)  
   (let* ((slotd-class-name (if effective-p
@@ -359,10 +370,7 @@
 	  (set-val 'boundp-function (make-optimized-std-boundp-method-function 
 				     fsc-p slot-name index)))
 	(set-val 'accessor-flags 7)
-	(let ((table (or (gethash slot-name *name->class->slotd-table*)
-			 (setf (gethash slot-name *name->class->slotd-table*)
-			       (make-hash-table :test 'eq :size 5)))))
-	  (setf (gethash class table) slotd)))
+	(setf (gethash class (slot-name->class-table slot-name)) slotd))
       (when (and (eq name 'standard-class)
 		 (eq slot-name 'slots) effective-p)
 	(setq *the-eslotd-standard-class-slots* slotd))
diff --git a/pcl/defs.lisp b/pcl/defs.lisp
index 9cc48ce05d849483c8ffa455e168aa5d2ea1111b..bdf6e38ad0cb94512d2c633b44b5305789f9b465 100644
--- a/pcl/defs.lisp
+++ b/pcl/defs.lisp
@@ -95,6 +95,7 @@
 		  *the-class-built-in-class*
 		  *the-class-slot-class*
 		  *the-class-std-class*
+		  *the-class-condition-class*
 		  *the-class-structure-class*
 		  *the-class-standard-class*
 		  *the-class-funcallable-standard-class*
@@ -286,6 +287,11 @@
 
 (defvar *name->class->slotd-table* (make-hash-table))
 
+(defun slot-name->class-table (slot-name)
+  (or (gethash slot-name *name->class->slotd-table*)
+      (setf (gethash slot-name *name->class->slotd-table*)
+	    (make-hash-table :test 'eq :size 5))))
+
 (defvar *standard-method-combination*)
 
 
@@ -535,6 +541,9 @@
     :initform nil
     :initarg :from-defclass-p)))
      
+(defclass condition (slot-object kernel:instance) ()
+  (:metaclass condition-class))
+
 (defclass condition-class (slot-class) ())
 
 (defclass specializer-with-object (specializer) ())
@@ -808,6 +817,7 @@ was inherited."
     (standard-class standard-class-p)
     (funcallable-standard-class funcallable-standard-class-p)
     (structure-class structure-class-p)
+    (condition-class condition-class-p)
     (forward-referenced-class forward-referenced-class-p)
     (method method-p)
     (standard-method standard-method-p)
diff --git a/pcl/dfun.lisp b/pcl/dfun.lisp
index 27e1830a2753a64aa5191afd20d2ec75575cc05d..c80aefaf63dc49a63e820cd0fec06a1f057e4875 100644
--- a/pcl/dfun.lisp
+++ b/pcl/dfun.lisp
@@ -25,7 +25,7 @@
 ;;; *************************************************************************
 
 (file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/dfun.lisp,v 1.26 2003/05/04 13:11:21 gerd Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/dfun.lisp,v 1.27 2003/05/11 11:30:34 gerd Exp $")
 
 (in-package :pcl)
 
@@ -1356,7 +1356,7 @@ And so, we are saved.
 					  (slot-accessor-std-p slotd type)))
 			   (return-from make-accessor-table nil))
 			 (push (cons specl slotd) (gethash class table)))))
-		   (gethash slot-name *name->class->slotd-table*))))
+		   (slot-name->class-table slot-name))))
       (maphash (lambda (class specl+slotd-list)
 		 (dolist (sclass (precedence class)
 			  (internal-error "This can't happen."))
diff --git a/pcl/generic-functions.lisp b/pcl/generic-functions.lisp
index e27f9635ddbb123e2bb4e8ed40c6a4c612140484..ca789db581362a34e02ae2066771a310b413b699 100644
--- a/pcl/generic-functions.lisp
+++ b/pcl/generic-functions.lisp
@@ -1,7 +1,7 @@
 ;;;-*-Mode:LISP; Package:PCL; Base:10; Syntax:Common-lisp -*-
 
 (file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/generic-functions.lisp,v 1.25 2003/05/04 13:11:21 gerd Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/generic-functions.lisp,v 1.26 2003/05/11 11:30:34 gerd Exp $")
 ;;;
 
 (in-package :pcl)
@@ -87,9 +87,7 @@
 ;          (standard-writer-method)
 
 (defgeneric structure-class-p (object))
-;          (t)
-;          (structure-class)
-
+(defgeneric condition-class-p (object))
 
 ;;; readers
 (defgeneric accessor-method-slot-definition (standard-accessor-method))
diff --git a/pcl/methods.lisp b/pcl/methods.lisp
index 689473f192203bba0083cef8ac8372c007f2dcd0..87fc76a9f8c2665cca817a790783e5b6eb1d5150 100644
--- a/pcl/methods.lisp
+++ b/pcl/methods.lisp
@@ -26,7 +26,7 @@
 ;;;
 
 (file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/methods.lisp,v 1.29 2003/05/04 13:11:21 gerd Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/methods.lisp,v 1.30 2003/05/11 11:30:34 gerd Exp $")
 
 (in-package :pcl)
 
@@ -851,6 +851,9 @@
 (defvar *structure-slot-value-using-class-method* nil)
 (defvar *structure-setf-slot-value-using-class-method* nil)
 (defvar *structure-slot-boundp-using-class-method* nil)
+(defvar *condition-slot-value-using-class-method* nil)
+(defvar *condition-setf-slot-value-using-class-method* nil)
+(defvar *condition-slot-boundp-using-class-method* nil)
 
 (defun standard-svuc-method (type)
   (case type
@@ -876,6 +879,18 @@
     (writer (setq *structure-setf-slot-value-using-class-method* method))
     (boundp (setq *structure-slot-boundp-using-class-method* method))))
 
+(defun condition-svuc-method (type)
+  (case type
+    (reader *condition-slot-value-using-class-method*)
+    (writer *condition-setf-slot-value-using-class-method*)
+    (boundp *condition-slot-boundp-using-class-method*)))
+
+(defun set-condition-svuc-method (type method)
+  (case type
+    (reader (setq *condition-slot-value-using-class-method* method))
+    (writer (setq *condition-setf-slot-value-using-class-method* method))
+    (boundp (setq *condition-boundp-using-class-method* method))))
+
 (defun update-std-or-str-methods (gf type)
   (dolist (method (generic-function-methods gf))
     (let ((specls (method-specializers method)))
@@ -889,6 +904,13 @@
 		    (eq (class-name (caddr specls)) 
 			'standard-effective-slot-definition))
 	       (set-standard-svuc-method type method))
+	      ((and (eq (class-name (car specls))
+			'condition-class)
+		    (eq (class-name (cadr specls)) 
+			'condition)
+		    (eq (class-name (caddr specls)) 
+			'condition-effective-slot-definition))
+	       (set-condition-svuc-method type method))
 	      ((and (eq (class-name (car specls))
 			'structure-class)
 		    (eq (class-name (cadr specls))
diff --git a/pcl/slots-boot.lisp b/pcl/slots-boot.lisp
index 9ad86050ae1f8f64c55390e60185305bd1c25f68..773acd5c16ea11248f2ec4545eba4c9f35acbb73 100644
--- a/pcl/slots-boot.lisp
+++ b/pcl/slots-boot.lisp
@@ -26,7 +26,7 @@
 ;;;
 
 (file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/slots-boot.lisp,v 1.22 2003/05/07 16:59:48 gerd Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/slots-boot.lisp,v 1.23 2003/05/11 11:30:34 gerd Exp $")
 ;;;
 
 (in-package :pcl)
@@ -99,9 +99,7 @@
 	;; Initialize this here, In case the LOAD-TIME-VALUE is
 	;; executed before INITIALIZE-INTERNAL-SLOT-FUNCTIONS had a
 	;; chance to run.
-	(unless (gethash slot-name *name->class->slotd-table*)
-	  (setf (gethash slot-name *name->class->slotd-table*)
-		(make-hash-table :test 'eq)))
+	(slot-name->class-table slot-name)
 	(setf (plist-value gf 'slot-missing-method) t)
 	(ecase type
 	  (reader (add-slot-missing-method gf slot-name 'slot-value))
@@ -150,23 +148,30 @@
   (lambda (object) (declare (ignore object)) 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)
-			  (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)
+			     (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*)
@@ -245,28 +250,49 @@
     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))))
+  (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 ((function (slot-definition-reader-function slotd)))
+	      (lambda (class object slotd)
+		(declare (ignore class slotd))
+		(funcall function object))))
+	   (writer
+	    (let ((function (slot-definition-writer-function slotd)))
+	      (lambda (nv class object slotd)
+		(declare (ignore class slotd))
+		(funcall function nv object))))
+	   (boundp
+	    (let ((function (slot-definition-boundp-function slotd)))
+	      (lambda (class object slotd)
+		(declare (ignore class slotd))
+		(funcall function 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)
diff --git a/pcl/slots.lisp b/pcl/slots.lisp
index 829dbd288f916d51ac3255619dc586604b3655c4..bdad9c7dd0a2bda6e89929ed96d79f5feff739b7 100644
--- a/pcl/slots.lisp
+++ b/pcl/slots.lisp
@@ -26,7 +26,7 @@
 ;;;
 
 (file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/slots.lisp,v 1.22 2003/05/10 20:27:23 gerd Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/slots.lisp,v 1.23 2003/05/11 11:30:34 gerd Exp $")
 ;;;
 
 (in-package :pcl)
@@ -267,13 +267,37 @@
 	    (slotd structure-effective-slot-definition))
   (error "Structure slots cannot be unbound."))
 
+
+(defmethod slot-value-using-class
+    ((class condition-class)
+     (object condition)
+     (slotd condition-effective-slot-definition))
+  (let ((fn (slot-definition-reader-function slotd)))
+    (declare (type function fn))
+    (funcall fn object)))
+
+(defmethod (setf slot-value-using-class)
+    (new-value
+     (class condition-class)
+     (object condition)
+     (slotd condition-effective-slot-definition))
+  (let ((fn (slot-definition-writer-function slotd)))
+    (declare (type function fn))
+    (funcall fn new-value object)))
+
+(defmethod slot-boundp-using-class
+    ((class condition-class)
+     (object condition)
+     (slotd condition-effective-slot-definition))
+  (let ((fn (slot-definition-boundp-function slotd)))
+    (declare (type function fn))
+    (funcall fn object)))
 
 (defmethod slot-makunbound-using-class ((class condition-class) object slot)
   (declare (ignore object slot))
   (error "Condition slots cannot be unbound."))
 
 
-
 (defmethod slot-missing
 	   ((class t) instance slot-name operation &optional new-value)
   (error
@@ -314,4 +338,3 @@
 	(error "~@<Can't allocate an instance of class ~S.~@:>"
 	       (class-name class)))))
 
-
diff --git a/pcl/std-class.lisp b/pcl/std-class.lisp
index ca947a750f768ee0fd4bbe548e346b5fc839ee4f..3a36e173dd1cd4df8df985dc4f064f45d259ea91 100644
--- a/pcl/std-class.lisp
+++ b/pcl/std-class.lisp
@@ -26,7 +26,7 @@
 ;;;
 
 (file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/std-class.lisp,v 1.64 2003/05/10 20:27:23 gerd Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/std-class.lisp,v 1.65 2003/05/11 11:30:34 gerd Exp $")
 
 (in-package :pcl)
 
@@ -76,10 +76,7 @@
 (defmethod initialize-internal-slot-functions ((slotd effective-slot-definition))
   (let* ((name (slot-value slotd 'name))
 	 (class (slot-value slotd 'class)))
-    (let ((table (or (gethash name *name->class->slotd-table*)
-		     (setf (gethash name *name->class->slotd-table*)
-			   (make-hash-table :test 'eq :size 5)))))
-      (setf (gethash class table) slotd))
+    (setf (gethash class (slot-name->class-table name)) slotd)
     (dolist (type '(reader writer boundp))
       (let* ((gf-name (ecase type
 			      (reader 'slot-value-using-class)
@@ -1602,7 +1599,12 @@
       (add-direct-subclasses class direct-superclasses)
       (setq predicate-name (make-class-predicate-name (class-name class)))
       (make-class-predicate class predicate-name)
-      (setf (slot-value class 'slots) (compute-slots class)))))
+      (setf (slot-value class 'slots) (compute-slots class))))
+  ;;
+  ;; We don't ADD-SLOT-ACCESSORS here because we don't want to
+  ;; override condition accessors with generic functions.  We do this
+  ;; differently.
+  (update-pv-table-cache-info class))
 				     
 (defmethod direct-slot-definition-class
     ((class condition-class) &rest initargs)
@@ -1645,3 +1647,7 @@
 		    (class-direct-slots superclass)))
 	  (reverse (slot-value class 'class-precedence-list))))
 
+(defmethod compute-slots :around ((class condition-class))
+  (let ((eslotds (call-next-method)))
+    (mapc #'initialize-internal-slot-functions eslotds)
+    eslotds))