diff --git a/pcl/boot.lisp b/pcl/boot.lisp
index 4cf83757b22ce0835fcea6188d6b0a95b144355f..970b315f70336bcfd96962053d8a29a1c14f2ba1 100644
--- a/pcl/boot.lisp
+++ b/pcl/boot.lisp
@@ -25,7 +25,7 @@
 ;;; *************************************************************************
 
 (file-comment
- "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/boot.lisp,v 1.72 2004/04/06 20:44:02 rtoy Exp $")
+ "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/boot.lisp,v 1.73 2005/08/18 16:55:00 rtoy Rel $")
 
 (in-package :pcl)
 
@@ -910,15 +910,15 @@ work during bootstrapping.
 	   (cond ((null args)
 		  (if (eql nreq 0) 
 		      (invoke-fast-method-call emf)
-		      (internal-error "Wrong number of args.")))
+		      (internal-program-error emf "Wrong number of args.")))
 		 ((null (cdr args))
 		  (if (eql nreq 1) 
 		      (invoke-fast-method-call emf (car args))
-		      (internal-error "Wrong number of args.")))
+		      (internal-program-error emf "Wrong number of args.")))
 		 ((null (cddr args))
 		  (if (eql nreq 2) 
 		      (invoke-fast-method-call emf (car args) (cadr args))
-		      (internal-error "Wrong number of args.")))
+		      (internal-program-error emf "Wrong number of args.")))
 		 (t
 		  (apply (fast-method-call-function emf)
 			 (fast-method-call-pv-cell emf)
@@ -930,7 +930,7 @@ work during bootstrapping.
 	    (method-call-call-method-args emf)))
     (fixnum 
      (cond ((null args)
-	    (internal-error "1 or 2 args expected."))
+	    (internal-program-error emf "1 or 2 args expected."))
 	   ((null (cdr args))
 	    (let ((value (%slot-ref (get-slots (car args)) emf)))
 	      (if (eq value +slot-unbound+)
@@ -940,10 +940,10 @@ work during bootstrapping.
 	    (setf (%slot-ref (get-slots (cadr args)) emf)
 		  (car args)))
 	   (t
-	    (internal-error "1 or 2 args expected."))))
+	    (internal-program-error emf "1 or 2 args expected."))))
     (fast-instance-boundp
      (if (or (null args) (cdr args))
-	 (internal-error "1 arg expected.")
+	 (internal-program-error emf "1 arg expected.")
 	 (not (eq (%slot-ref (get-slots (car args)) 
 			     (fast-instance-boundp-index emf))
 		  +slot-unbound+))))
diff --git a/pcl/dfun.lisp b/pcl/dfun.lisp
index 33097e7c35e5e485560e9f7efd46f3144413365b..cc7ec2c0e909dc3e51b5b89747abdd6d7d16b5b7 100644
--- a/pcl/dfun.lisp
+++ b/pcl/dfun.lisp
@@ -25,7 +25,7 @@
 ;;; *************************************************************************
 
 (file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/dfun.lisp,v 1.37 2005/06/15 17:30:59 rtoy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/dfun.lisp,v 1.38 2005/08/18 16:55:00 rtoy Exp $")
 
 (in-package :pcl)
 
@@ -1127,8 +1127,13 @@ And so, we are saved.
     (declare (ignore nreq applyp nkeys))
     (with-dfun-wrappers (args metatypes)
       (dfun-wrappers invalid-wrapper-p wrappers classes types)
+      #+nil
       (error "~@<The function ~S requires at least ~D arguments.~@:>"
 	     gf (length metatypes))
+      (error 'kernel:simple-program-error
+	     :name gf
+	     :format-control "~<The function ~S requires at least ~D arguments.~@:>"
+	     :format-arguments (list gf (length metatypes)))
       (multiple-value-bind (emf methods accessor-type index)
 	  (cache-miss-values-internal gf arg-info wrappers classes types state)
 	(values emf methods
diff --git a/pcl/low.lisp b/pcl/low.lisp
index e743b216c91993d210181ad4eee9697b34f28111..0126029bea9ace2f43337a22ec9429f68cedff9d 100644
--- a/pcl/low.lisp
+++ b/pcl/low.lisp
@@ -26,7 +26,7 @@
 ;;;
 
 (file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/low.lisp,v 1.32 2003/05/26 16:03:08 gerd Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/low.lisp,v 1.33 2005/08/18 16:55:01 rtoy Exp $")
 
 ;;; 
 ;;; This file contains optimized low-level constructs for PCL.
@@ -420,6 +420,11 @@ the compiler as completely as possible.  Currently this means that
   (error (format nil "~~@<Internal error: ~?~~@:>"
 		 format-control format-args)))
 
+(defun internal-program-error (name &rest args)
+  (error 'kernel:simple-program-error
+	 :function-name name
+	 :format-control (car args)
+	 :format-arguments (list (cdr args))))
 
 ;;;; Structure-instance stuff: