diff --git a/pcl/ctor.lisp b/pcl/ctor.lisp
index 270149b2481750f7a2c6733390a8135cd7e467ca..4bd9528e155313f36a0c4ab25b0136a2bc0d9de4 100644
--- a/pcl/ctor.lisp
+++ b/pcl/ctor.lisp
@@ -46,7 +46,7 @@
 ;;; is called.
 
 (file-comment
- "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/ctor.lisp,v 1.17 2004/08/06 17:21:54 rtoy Exp $")
+ "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/ctor.lisp,v 1.18 2007/05/02 13:33:46 rtoy Rel $")
 
 (in-package "PCL")
 
@@ -403,25 +403,35 @@
 	(standard-sort-methods si-methods)
       (declare (ignore si-primary))
       (assert (and (null ii-around) (null si-around)))
-      (let ((initargs (ctor-initargs ctor))
-	    (slot-inits (slot-init-forms ctor (or ii-before si-before))))
-	(flet ((method-calls (methods args)
-		 (loop for method in methods
-		       as fn = (method-function method)
-		       collect `(funcall (truly-the function ,fn) ,args ()))))
-	  (values
-	   `(let (,@(when (or ii-before ii-after)
-		    `((.ii-args.
-		       (list .instance. ,@(quote-plist-keys initargs)))))
-		  ,@(when (or si-before si-after)
-		    `((.si-args.
-		       (list .instance. t ,@(quote-plist-keys initargs))))))
-	      ,@(method-calls ii-before '.ii-args.)
-	      ,@(method-calls si-before '.si-args.)
-	      ,slot-inits
-	      ,@(method-calls si-after '.si-args.)
-	      ,@(method-calls ii-after '.ii-args.))
-	   (or ii-before si-before)))))))
+      (let ((initargs (ctor-initargs ctor)))
+	(multiple-value-bind (slot-inits defaulted-initargs)
+	    (slot-init-forms ctor (or ii-before si-before))
+	  (flet ((method-calls (methods args)
+		   (loop for method in methods
+			 as fn = (method-function method)
+			 collect `(funcall (truly-the function ,fn) ,args ()))))
+	    (let ((let (car slot-inits))
+		  (bindings (cadr slot-inits))
+		  (body (cddr slot-inits)))
+	      (assert (eq let 'let))
+	      (multiple-value-bind (slot-init-forms decls doc-string)
+		  (sys:parse-body body nil nil)
+		(declare (ignore doc-string))
+		(values
+		 `(let* (,@bindings
+			 ,@(when (or ii-before ii-after)
+		            `((.ii-args.
+			       (list .instance. ,@(quote-plist-keys initargs) ,@defaulted-initargs))))
+			 ,@(when (or si-before si-after)
+		            `((.si-args.
+			       (list .instance. t ,@(quote-plist-keys initargs) ,@defaulted-initargs)))))
+		    ,@decls
+		    ,@(method-calls ii-before '.ii-args.)
+		    ,@(method-calls si-before '.si-args.)
+		    ,@slot-init-forms
+		    ,@(method-calls si-after '.si-args.)
+		    ,@(method-calls ii-after '.ii-args.))
+		 (or ii-before si-before))))))))))
 
 ;;;
 ;;; Return four values from APPLICABLE-METHODS: around methods, before
@@ -467,6 +477,8 @@
 ;;; that we have to check if these before-methods have set slots.
 ;;; For structures the consequences are likewise.
 ;;;
+;;; madhu 061211 second return value is a list of default initargs.
+;;;
 (defun slot-init-forms (ctor before-method-p)
   (let* ((class (ctor-class ctor))
 	 (structure-p (structure-class-p class))
@@ -479,6 +491,7 @@
 	 (class-inits ())
 	 (structure-inits ())
 	 (default-inits ())
+	 (defaulted-initargs ())
 	 (default-initargs (class-default-initargs class))
 	 ;;
 	 ;; Note that the locations are actually defstruct slot
@@ -537,7 +550,13 @@
       ;; 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
-	      (let* ((type (if (constantp initform) 'constant 'var))
+	      (let* ((type (cond ((constantp initform)
+				  (push key defaulted-initargs)
+				  (push initform defaulted-initargs)
+				  'constant)
+				 (t (push key defaulted-initargs)
+				    (push (default-init-variable-name i) defaulted-initargs)
+				    'var)))
 		     (init (if (eq type 'var) initfn initform)))
 		(when (eq type 'var)
 		  (let ((init-var (default-init-variable-name i)))
@@ -610,10 +629,12 @@
 		  collect var into vars
 		  collect `(,var (funcall ,initfn)) into bindings
 		  finally (return (values vars bindings)))
-	  `(let ,bindings
-	     (declare (ignorable ,@vars) (optimize (safety 3)))
-	     ,@instance-init-forms
-	     ,@class-init-forms))))))
+	  (values
+	   `(let ,bindings
+	      (declare (ignorable ,@vars) (optimize (safety 3)))
+	      ,@instance-init-forms
+	      ,@class-init-forms)
+	   (nreverse defaulted-initargs)))))))
 
 ;;;
 ;;; Return an alist of lists (KEY LOCATION ...) telling, for each key
diff --git a/pcl/rt/ctor.lisp b/pcl/rt/ctor.lisp
index 67a709e2d0e70e7b0a1a8b35a1f258e8de043e4b..674ab02e3ae573ca833a86f9e6b8e7d8bb7ea9b3 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.7 2003/10/23 10:29:33 gerd Exp $")
+(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/rt/ctor.lisp,v 1.8 2007/05/02 13:33:51 rtoy Exp $")
 
 (in-package "PCL-TEST")
 
@@ -399,3 +399,20 @@
 	      (slot-boundp instance 'b)))
   0 nil)
 
+;; Test for default-initargs bug.
+(defclass g2 ()
+  ((a :initarg :aa)))
+
+(defmethod initialize-instance :after ((f g2) &key aa)
+  (princ aa))
+
+(defclass g3 (g2)
+  ((b :initarg :b))
+  (:default-initargs :aa 5))
+
+(deftest defaulting-initargs.1
+    (with-output-to-string (*standard-output*)
+      (make-instance 'g3))
+  "5")
+
+  
diff --git a/pcl/rt/system.lisp b/pcl/rt/system.lisp
index 0e195d39d8955f42bb7856814dd024f033a6db35..d6c9cd5533e58bad6cd10816bd2a25cd8213c8ba 100644
--- a/pcl/rt/system.lisp
+++ b/pcl/rt/system.lisp
@@ -28,11 +28,18 @@
 ;;; DAMAGE.
 
 #+cmu
-(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/rt/system.lisp,v 1.3 2003/06/13 21:08:22 gerd Exp $")
+(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/rt/system.lisp,v 1.4 2007/05/02 13:33:51 rtoy Rel $")
 
+#+nil
 (setf (logical-pathname-translations "pcl-test")
       `(("*.*.*" "/home/gerd/cmucl/src/pcl/rt/")))
 
+
+(setf (logical-pathname-translations "pcl-test")
+      (list (list "*.*.*"
+		  (merge-pathnames #p"*.*"
+				   *load-truename*))))
+
 (mk:defsystem :pcl-test
     :initially-do (progn )
     :source-pathname "pcl-test:"