--- a/src/clos/boot.lsp
+++ b/src/clos/boot.lsp
@@ -14,6 +14,38 @@
 
 (defconstant +builtin-classes-pre-array+
   (make-array (1+ #.(length +builtin-classes-list+))))
+
+
+;;;
+;;; The following macro is also used at bootstap for instantiating
+;;; a class based only on the s-form description.
+;;;
+(eval-when (:compile-toplevel :execute)
+  (defmacro with-early-make-instance (slots (object class &rest key-value-pairs)
+				      &rest body)
+    (when (symbolp slots)
+      (setf slots (symbol-value slots)))
+    `(let* ((%class ,class)
+	    (,object (si::allocate-raw-instance nil %class
+						,(length slots))))
+       (declare (type standard-object ,object))
+       ,@(flet ((initializerp (name list)
+		  (not (eq (getf list name 'wrong) 'wrong))))
+	       (loop for (name . slotd) in slots
+		  for initarg = (getf slotd :initarg)
+		  for initform = (getf slotd :initform (si::unbound))
+		  for initvalue = (getf key-value-pairs initarg)
+		  for index from 0
+		  do (cond ((and initarg (initializerp initarg key-value-pairs))
+			    (setf initform (getf key-value-pairs initarg)))
+			   ((initializerp name key-value-pairs)
+			    (setf initform (getf key-value-pairs name))))
+		  when (si:sl-boundp initform)
+		  collect `(si::instance-set ,object ,index ,initform)))
+       (when %class
+	 (si::instance-sig-set ,object))
+       (with-early-accessors (,slots)
+	 ,@body))))
 
 ;;; ----------------------------------------------------------------------
 ;;; Building the classes T, CLASS, STANDARD-OBJECT and STANDARD-CLASS.
@@ -87,42 +119,6 @@
 		     (slot-table class) table
 		     (class-direct-slots class) (copy-list all-slots)))))
 
-(defun reader-closure (index)
-  (declare (si::c-local))
-  (lambda (object) (si::instance-ref object index)))
-
-(defun writer-closure (index)
-  (declare (si::c-local))
-  (lambda (value object) (si::instance-set object index value)))
-
-(defun generate-accessors (class slotd-definitions)
-  (declare (si::c-local)
-	   (optimize speed (safety 0)))
-  (loop for index from 0
-     for slotd in slotd-definitions
-     do (loop with key-value-pairs = (rest slotd)
-	   for key = (pop key-value-pairs)
-	   for value = (pop key-value-pairs)
-	   while key
-	   do (case key
-		(:reader
-		 (setf (fdefinition value) (reader-closure index))
-		 #+(or)
-		 (install-method value nil (list class) '(self)
-				 (reader-closure index) t))
-		#+(or)
-		(:writer ;; not used above
-		 (setf (fdefinition value) (writer-closure index)))
-		(:accessor
-		 (setf (fdefinition value) (reader-closure index)
-		       (fdefinition `(setf ,value)) (writer-closure index))
-		 #+(or)
-		 (install-method value nil (list class) '(self)
-				 (reader-closure index) t))
-		 #+(or)
-		 (install-method value nil (list (find-class 't) class) '(value self)
-				 (writer-closure index) t)))))
-
 ;; 1) Create the classes
 ;;
 ;; Notice that, due to circularity in the definition, STANDARD-CLASS has
@@ -137,8 +133,6 @@
     (defconstant +the-std-class+ (find-class 'std-class nil))
     (defconstant +the-funcallable-standard-class+
       (find-class 'funcallable-standard-class nil))
-    (loop for c in class-hierarchy
-       do (generate-accessors (find-class (first c)) (getf (rest c) :direct-slots)))
     ;;
     ;; 2) Class T had its metaclass wrong. Fix it.
     ;;
@@ -150,5 +144,5 @@
     ;;
     ;; This is needed for further optimization
     ;;
-    (setf (class-sealedp (find-class 'method-combination)) t)
+    (setf (slot-value (find-class 'method-combination) 'sealedp) t)
     ))