diff --git a/code/defstruct.lisp b/code/defstruct.lisp
index 0bc314460f386a72ac8aee2a05e7d262b009f238..a7bf41ee1c2394759e02c44ad8ec83db61156484 100644
--- a/code/defstruct.lisp
+++ b/code/defstruct.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/defstruct.lisp,v 1.73 2001/03/15 18:01:36 pw Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/defstruct.lisp,v 1.74 2001/09/21 12:00:43 pw Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -328,7 +328,6 @@
   (declare (ignore depth))
   (format stream "#<Defstruct-Slot-Description for ~S>" (dsd-name structure)))
 
-
 (defun dd-maybe-make-print-method (defstruct)
   ;; Maybe generate CLOS DEFMETHOD forms for :print-function/:print-object.
   (let ((print-function-value (dd-print-function defstruct)))
@@ -337,17 +336,17 @@
 	    (function (cdr print-function-value)))
 	(unless (eq kind 'lambda)
 	  (setf (dd-print-function defstruct) nil)
-	  (let* ((name (dd-name defstruct))
-		 (function (if (symbolp function) `',function `#',function))
-		 (mcall `(funcall ,function o s))
-		 (fcall `(funcall ,function o s *current-level*)))
+	  (let* ((class (dd-name defstruct))
+		 (func (if (symbolp function) `',function `#',function)))
 	    ;; We can only generate this code if CLOS is loaded. Maybe should
 	    ;; signal an error instead of quietly ignoring the defmethod?
 	    `((when (fboundp 'print-object)
-		(defmethod print-object ((o ,name) s)
-		  ,(ecase kind
-		     (:print-object mcall)
-		     (:print-function fcall)))))))))))
+		(defmethod print-object ((object ,class) stream)
+		  (funcall
+		   ,func object stream
+		   ,@(when (or (eq kind :print-function)
+			       (eq function 'default-structure-print))
+		       '(*current-level*))))))))))))
 
 
 ;;; The legendary macro itself.