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: