X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fpcl%2Fdefs.lisp;h=2bdeb0526a64d20e78077d86b2633692de6ccf0a;hb=64a7331285b0eab2c216f52670763c7d192cfdaa;hp=515a222e98db51801a3cf074f2180a6b936237a4;hpb=651d4345926ca821f98f771a756e0e3000e957a1;p=sbcl.git

diff --git a/src/pcl/defs.lisp b/src/pcl/defs.lisp
index 515a222..2bdeb05 100644
--- a/src/pcl/defs.lisp
+++ b/src/pcl/defs.lisp
@@ -102,6 +102,7 @@
 		  *the-class-generic-function*
 		  *the-class-built-in-class*
 		  *the-class-slot-class*
+		  *the-class-condition-class*
 		  *the-class-structure-class*
 		  *the-class-std-class*
 		  *the-class-standard-class*
@@ -447,6 +448,9 @@
 (defclass slot-object (t) ()
   (:metaclass slot-class))
 
+(defclass condition (slot-object instance) ()
+  (:metaclass condition-class))
+
 (defclass structure-object (slot-object instance) ()
   (:metaclass structure-class))
 
@@ -516,7 +520,10 @@
     :initform (cons nil nil))
    (predicate-name
     :initform nil
-    :reader class-predicate-name)))
+    :reader class-predicate-name)
+   (finalized-p
+    :initform nil
+    :reader class-finalized-p)))
 
 (def!method make-load-form ((class class) &optional env)
   ;; FIXME: should we not instead pass ENV to FIND-CLASS?  Probably
@@ -552,10 +559,7 @@
     :accessor class-direct-slots)
    (slots
     :initform ()
-    :accessor class-slots)
-   (initialize-info
-    :initform nil
-    :accessor class-initialize-info)))
+    :accessor class-slots)))
 
 ;;; The class STD-CLASS is an implementation-specific common
 ;;; superclass of the classes STANDARD-CLASS and
@@ -573,7 +577,7 @@
 
 (defclass built-in-class (pcl-class) ())
 
-(defclass condition-class (pcl-class) ())
+(defclass condition-class (slot-class) ())
 
 (defclass structure-class (slot-class)
   ((defstruct-form
@@ -661,6 +665,16 @@
     :initarg :allocation-class
     :accessor slot-definition-allocation-class)))
 
+(defclass condition-slot-definition (slot-definition)
+  ((allocation
+    :initform :instance
+    :initarg :allocation
+    :accessor slot-definition-allocation)
+   (allocation-class
+    :initform nil
+    :initarg :allocation-class
+    :accessor slot-definition-allocation-class)))
+
 (defclass structure-slot-definition (slot-definition)
   ((defstruct-accessor-symbol
      :initform nil
@@ -698,6 +712,14 @@
     :initform nil
     :accessor slot-definition-location)))
 
+(defclass condition-direct-slot-definition (condition-slot-definition
+					    direct-slot-definition)
+  ())
+
+(defclass condition-effective-slot-definition (condition-slot-definition
+					       effective-slot-definition)
+  ())
+
 (defclass structure-direct-slot-definition (structure-slot-definition
 					    direct-slot-definition)
   ())
@@ -832,6 +854,7 @@
     (std-class std-class-p)
     (standard-class standard-class-p)
     (funcallable-standard-class funcallable-standard-class-p)
+    (condition-class condition-class-p)
     (structure-class structure-class-p)
     (forward-referenced-class forward-referenced-class-p)
     (method method-p)