Index: /branches/working-0711/ccl/level-1/l1-clos.lisp
===================================================================
--- /branches/working-0711/ccl/level-1/l1-clos.lisp	(revision 7809)
+++ /branches/working-0711/ccl/level-1/l1-clos.lisp	(revision 7810)
@@ -1878,5 +1878,5 @@
                  (and (null (cdr (compute-applicable-methods #'initialize-instance (list proto))))
                       (null (cdr (compute-applicable-methods #'shared-initialize (list proto t)))))))
-      (let* ((slotds (sort (copy-list (class-slots class)) #'< :key #'slot-definition-location))
+      (let* ((slotds (sort (copy-list (class-slots class)) #'(lambda (x y) (if (consp x) x (if (consp y) y (< x y)))) :key #'slot-definition-location))
              (default-initargs (class-default-initargs class)))
         ;; Punt if any slot has multiple initargs
@@ -1886,4 +1886,5 @@
           (collect ((keys)
                     (binds)
+                    (class-slot-inits)
                     (forms))
             (dolist (slot slotds)
@@ -1891,4 +1892,5 @@
                      (initfunction (slot-definition-initfunction slot))
                      (initform (slot-definition-initform slot))
+                     (location (slot-definition-location slot))
                      (name (slot-definition-name slot))
                      (initial-value-form (if initfunction
@@ -1910,9 +1912,10 @@
                                    `(funcall ,function)))
                                initial-value-form))))
-                    (if (eq type t)
-                      (forms name)
+                    (if (consp location)
+                      (class-slot-inits `(when (eq (%slot-unbound-marker) (cdr ',location))(setf (cdr ',location) (require-type ,name ',type))))
                       (forms `(require-type ,name ',type))))
-                  (if (eq type t)
-                    (forms initial-value-form)
+                  (if (consp location)
+                    (class-slot-inits `(when (eq (%slot-unbound-marker) (cdr ',location))(setf (cdr ',location) (require-type ,initial-value-form ',type))))
+                    
                     (forms `(require-type ,initial-value-form ',type))))))
             (let* ((cell (make-symbol "CLASS-CELL"))
@@ -1922,4 +1925,5 @@
               (binds `(,instance (gvector :instance 0 (class-cell-extra ,cell) ,slots)))
               `(lambda (,cell &key ,@(keys))
+                ,@(class-slot-inits)
                 (let* (,@(binds))
                   (setf (instance.hash ,instance) (strip-tag-to-fixnum ,instance)
