diff --git a/pcl/ctor.lisp b/pcl/ctor.lisp
index 1f8e2c07ecf3c53b80369f8721e08e47a5f2dd97..76b3cd4ea1b7b5cfb0483ef1019b630a58209ce0 100644
--- a/pcl/ctor.lisp
+++ b/pcl/ctor.lisp
@@ -46,7 +46,7 @@
 ;;; is called.
 
 (ext:file-comment
- "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/ctor.lisp,v 1.5 2003/04/22 13:10:13 gerd Exp $")
+ "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/ctor.lisp,v 1.6 2003/04/24 13:44:15 gerd Exp $")
 
 (in-package "PCL")
 
@@ -367,18 +367,6 @@
 		 ,body
 		 .instance.))))))
 
-;;;
-;;; Return a form for invoking METHOD with arguments from ARGS.  As
-;;; can be seen in METHOD-FUNCTION-FROM-FAST-FUNCTION, method
-;;; functions look like (LAMBDA (ARGS NEXT-METHODS) ...).  We could
-;;; call fast method functions directly here, but benchmarks show that
-;;; there's no speed to gain, so lets avoid the hair here.
-;;;
-#+nil
-(defmacro invoke-method (method args)
-  (let ((fn (method-function method)))
-    `(funcall (ext:truly-the function ,fn) ,args ())))
-
 ;;;
 ;;; Return a form that is sort of an effective method comprising all
 ;;; calls to INITIALIZE-INSTANCE and SHARED-INITIALIZE that would
@@ -466,6 +454,7 @@
 			:initial-element nil)))
 	 (class-inits ())
 	 (structure-inits ())
+	 (default-inits ())
 	 (default-initargs (class-default-initargs class))
 	 ;;
 	 ;; Note that the locations are actually defstruct slot
@@ -476,14 +465,22 @@
     (labels ((locations (key)
 	       (cdr (assoc key locations :test #'eq)))
 
+	     (initialized-p (location)
+	       (cond (structure-p
+		      (assq location structure-inits))
+		     ((integerp location)
+		      (not (null (aref slot-vector location))))
+		     (t
+		      (assoc location class-inits :test #'eq))))
+
 	     (class-init (location type val slot-type)
 	       (assert (consp location))
 	       (assert (not structure-p))
-	       (unless (assoc location class-inits :test #'eq)
+	       (unless (initialized-p location)
 		 (push (list location type val slot-type) class-inits)))
 
 	     (instance-init (location type val slot-type)
-	       (unless (instance-slot-initialized-p location)
+	       (unless (initialized-p location)
 		 (cond (structure-p
 			(assert (symbolp location))
 			(push (list location type val slot-type)
@@ -493,10 +490,11 @@
 			(setf (aref slot-vector location)
 			      (list type val slot-type))))))
 
-	     (instance-slot-initialized-p (location)
-	       (if structure-p
-		   (assq location structure-inits)
-		   (not (null (aref slot-vector location))))))
+	     (default-init-variable-name (i)
+	       (let ((ps #(.d0. .d1. .d2. .d3. .d4. .d5.)))
+		 (if (array-in-bounds-p ps i)
+		     (aref ps i)
+		     (intern (format nil ".D~D." i) *the-pcl-package*)))))
       ;;
       ;; Loop over supplied initargs and values and record which
       ;; instance and class slots they initialize.
@@ -509,15 +507,22 @@
       ;;
       ;; Loop over default initargs of the class, recording
       ;; initializations of slots that have not been initialized
-      ;; above.
-      (loop for (key initfn initform) in default-initargs
+      ;; above.  Default initargs which are not in the supplied
+      ;; initargs are treated as if they were appended to supplied
+      ;; initargs, that is, their values must be evaluated even
+      ;; if not actually used for initializing a slot.
+      (loop for (key initfn initform) in default-initargs and i from 0
 	    unless (memq key initkeys) do
-	      (loop with type = (if (constantp initform) 'constant 'initfn)
-		    with init = (if (eq type 'initfn) initfn initform)
-		    for (location . slot-type) in (locations key) do
-		      (if (consp location)
-			  (class-init location type init slot-type)
-			  (instance-init location type init slot-type))))
+	      (let* ((type (if (constantp initform) 'constant 'var))
+		     (init (if (eq type 'var) initfn initform)))
+		(when (eq type 'var)
+		  (let ((init-var (default-init-variable-name i)))
+		    (setq init init-var)
+		    (push (cons init-var initfn) default-inits)))
+		(loop for (location . slot-type) in (locations key) do
+			(if (consp location)
+			    (class-init location type init slot-type)
+			    (instance-init location type init slot-type)))))
       ;;
       ;; Loop over all slots of the class, filling in the rest from
       ;; slot initforms.
@@ -533,7 +538,7 @@
 	      (unless (or (eq allocation :class)
 			  (and (not structure-p)
 			       (null initfn))
-			  (instance-slot-initialized-p location))
+			  (initialized-p location))
 		(if (constantp initform)
 		    (instance-init location 'initform initform slot-type)
 		    (instance-init location 'initform/initfn initfn
@@ -552,12 +557,18 @@
 		       `(setf (cdr ',location)
 			      (the ,slot-type
 				,(ecase type
-					(constant `',(eval value))
-					(param `,value)
-					(initfn `(funcall ,value)))))))))
-	`(progn
-	   ,@instance-init-forms
-	   ,@class-init-forms)))))
+				   (constant `',(eval value))
+				   ((param var) `,value)
+				   (initfn `(funcall ,value)))))))))
+	(multiple-value-bind (vars bindings)
+	    (loop for (var . initfn) in (nreverse default-inits)
+		  collect var into vars
+		  collect `(,var (funcall ,initfn)) into bindings
+		  finally (return (values vars bindings)))
+	  `(let ,bindings
+	     (declare (ignorable ,@vars))
+	     ,@instance-init-forms
+	     ,@class-init-forms))))))
 
 ;;;
 ;;; Return an alist of lists (KEY LOCATION ...) telling, for each key
@@ -599,7 +610,7 @@
 	    ((nil)
 	     (unless before-method-p
 	       `(setf (%svref .slots. ,i) +slot-unbound+)))
-	    (param
+	    ((param var)
 	     `(setf (%svref .slots. ,i) (the ,slot-type ,value)))
 	    (initfn
 	     `(setf (%svref .slots. ,i)
@@ -635,7 +646,7 @@
 		 `(when (eq (,accessor .instance.) '.unbound.)
 		    (setf (,accessor .instance.) nil))
 		 `(setf (,accessor .instance.) nil)))
-	    (param
+	    ((param var)
 	     `(setf (,accessor .instance.) (the ,slot-type ,value)))
 	    (initfn
 	     `(setf (,accessor .instance.)
diff --git a/pcl/rt/ctor.lisp b/pcl/rt/ctor.lisp
index f990bcf1e48c2eb37dca73778c35d31a1dc0a16f..852f58816b09aca52b20b7fe6f200ef9d52de5df 100644
--- a/pcl/rt/ctor.lisp
+++ b/pcl/rt/ctor.lisp
@@ -28,7 +28,7 @@
 ;;; DAMAGE.
 
 #+cmu
-(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/rt/ctor.lisp,v 1.2 2003/03/22 16:15:15 gerd Exp $")
+(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/rt/ctor.lisp,v 1.3 2003/04/24 13:44:15 gerd Exp $")
 
 (in-package "PCL-TEST")
 
@@ -239,7 +239,7 @@
 		 'foo '(:a a :b b))))
       (setf (pcl::ctor-class ctor) (find-class 'foo))
       (pcl::slot-init-forms ctor nil))
-  (progn
+  (let ()
     (setf (pcl::%svref pcl::.slots. 0) (the t b))
     (setf (pcl::%svref pcl::.slots. 1) (the t a))))
 
@@ -249,7 +249,7 @@
 		 'foo '(:a a))))
       (setf (pcl::ctor-class ctor) (find-class 'foo))
       (pcl::slot-init-forms ctor nil))
-  (progn
+  (let ()
     (setf (pcl::%svref pcl::.slots. 0) (the t '2))
     (setf (pcl::%svref pcl::.slots. 1) (the t a))))
 
@@ -263,7 +263,7 @@
 		 'foo5 '(:a a))))
       (setf (pcl::ctor-class ctor) (find-class 'foo5))
       (pcl::slot-init-forms ctor nil))
-  (progn
+  (let ()
     (setf (pcl::%svref pcl::.slots. 0) pcl::+slot-unbound+)
     (setf (pcl::%svref pcl::.slots. 1) (the t a))))
 
@@ -277,7 +277,7 @@
 		 'foo5a '())))
       (setf (pcl::ctor-class ctor) (find-class 'foo5a))
       (pcl::slot-init-forms ctor nil))
-  (progn
+  (let ()
     (setf (pcl::%svref pcl::.slots. 0) (the t '0))
     (setf (pcl::%svref pcl::.slots. 1) (the t '0))))
 
@@ -291,7 +291,7 @@
 		 'foo6 '(:a a))))
       (setf (pcl::ctor-class ctor) (find-class 'foo6))
       (pcl::slot-init-forms ctor nil))
-  (progn
+  (let ()
     (setf (pcl::%svref pcl::.slots. 0) pcl::+slot-unbound+)
     (setf (cdr '(a . 0)) (the t a))))
 
@@ -308,10 +308,10 @@
 		 'foo7 '())))
       (setf (pcl::ctor-class ctor) (find-class 'foo7))
       (let ((form (pcl::slot-init-forms ctor nil)))
-	(values (second form)
-		(second (third form))
-		(first (third (third (third form))))
-		(functionp (second (third (third (third form))))))))
+	(values (third form)
+		(second (fourth form))
+		(first (third (third (fourth form))))
+		(functionp (second (third (third (fourth form))))))))
   (setf (pcl::%svref pcl::.slots. 0) pcl::+slot-unbound+)
   (pcl::%svref pcl::.slots. 1)
   funcall
@@ -323,7 +323,7 @@
 		 'foo '(:a '(foo)))))
       (setf (pcl::ctor-class ctor) (find-class 'foo))
       (pcl::slot-init-forms ctor nil))
-  (progn
+  (let ()
     (setf (pcl::%svref pcl::.slots. 0) (the t '2))
     (setf (pcl::%svref pcl::.slots. 1) (the t '(foo)))))
 
@@ -333,7 +333,7 @@
 		 'foo '(:a 'x))))
       (setf (pcl::ctor-class ctor) (find-class 'foo))
       (pcl::slot-init-forms ctor nil))
-  (progn
+  (let ()
     (setf (pcl::%svref pcl::.slots. 0) (the t '2))
     (setf (pcl::%svref pcl::.slots. 1) (the t 'x))))