diff --git a/code/bignum.lisp b/code/bignum.lisp index a33cca8574d31a39cae6c18437e1bcf14df1f721..a5451ee4730b045eb87972bf206e16a1beca6716 100644 --- a/code/bignum.lisp +++ b/code/bignum.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/bignum.lisp,v 1.33 2003/03/17 16:07:08 emarsden Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/bignum.lisp,v 1.34 2003/05/26 20:20:32 gerd Exp $") ;;; ;;; ********************************************************************** ;;; @@ -1610,6 +1610,7 @@ down to individual words.") (let ((exp (+ exp bias))) (when (> exp max) (error 'simple-type-error + :datum x :format-control "Too large to be represented as a ~S:~% ~S" :format-arguments (list format x) :expected-type format)) diff --git a/code/byte-interp.lisp b/code/byte-interp.lisp index 444543221c02db1332aa7936578d5ebef7c72c02..92b3aff32c8bbc0c3d322403eea1d85c0930459f 100644 --- a/code/byte-interp.lisp +++ b/code/byte-interp.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/byte-interp.lisp,v 1.36 2003/03/22 16:15:22 gerd Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/byte-interp.lisp,v 1.37 2003/05/26 20:20:32 gerd Exp $") ;;; ;;; ********************************************************************** ;;; @@ -119,8 +119,8 @@ ;; The number of ``more-arg'' args. (num-more-args 0 :type (integer 0 #.call-arguments-limit)) ;; - ;; True if there is a rest-arg. - (rest-arg-p nil :type (member t nil)) + ;; True if there is a rest-arg, :MORE if there is &MORE. + (rest-arg-p nil :type (member t nil :more)) ;; ;; True if there are keywords. Note: keywords might still be NIL because ;; having &key with no keywords is valid and should result in @@ -465,7 +465,7 @@ `(let ((x ,x)) (unless (listp x) (with-debugger-info (component pc fp) - (error 'simple-type-error :item x :expected-type 'list + (error 'simple-type-error :datum x :expected-type 'list :format-control "Non-list argument to CAR: ~S" :format-arguments (list x)))) (car x))) @@ -474,7 +474,7 @@ `(let ((x ,x)) (unless (listp x) (with-debugger-info (component pc fp) - (error 'simple-type-error :item x :expected-type 'list + (error 'simple-type-error :datum x :expected-type 'list :format-control "Non-list argument to CDR: ~S" :format-arguments (list x)))) (cdr x))) @@ -1390,7 +1390,11 @@ ((not (hairy-byte-function-keywords-p xep)) (assert restp) (setf (current-stack-pointer) (1+ more-args-start)) - (setf (eval-stack-ref more-args-start) rest)) + (setf (eval-stack-ref more-args-start) rest) + (when (eq :more restp) + (incf (current-stack-pointer)) + (setf (eval-stack-ref (1+ more-args-start)) + (length rest)))) (t (unless (evenp more-args-supplied) (with-debugger-info (old-component ret-pc old-fp) @@ -1414,7 +1418,11 @@ (stack-copy temp more-args-start more-args-supplied) (when restp (setf (eval-stack-ref more-args-start) rest) - (incf more-args-start)) + (incf more-args-start) + (when (eq :more restp) + (setf (eval-stack-ref (1+ more-args-start)) + (length rest)) + (incf more-args-start))) (let ((index more-args-start)) (dolist (keyword keywords) (setf (eval-stack-ref index) (cadr keyword)) diff --git a/code/interr.lisp b/code/interr.lisp index d290f001c68d396da5130017a36168c30dee5810..783f196b129b655b2f839833e71ffdf402c29c6d 100644 --- a/code/interr.lisp +++ b/code/interr.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/interr.lisp,v 1.41 2003/04/21 15:37:24 gerd Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/interr.lisp,v 1.42 2003/05/26 20:20:32 gerd Exp $") ;;; ;;; ********************************************************************** ;;; @@ -315,6 +315,8 @@ (deferr invalid-array-index-error (array bound index) (error 'type-error :function-name name + :datum index + :expected-type `(integer 0 (,bound)) :format-control (cond ((zerop bound) "Invalid array index, ~D for ~S. Array has no elements.") diff --git a/code/list.lisp b/code/list.lisp index 3b4fcb1783e2971e95bae99e783970ffcbdaf886..a6c43354bb2f64fac179a8efdbef814ef50da9a8 100644 --- a/code/list.lisp +++ b/code/list.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/list.lisp,v 1.30 2003/04/22 16:49:27 toy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/list.lisp,v 1.31 2003/05/26 20:20:32 gerd Exp $") ;;; ;;; ********************************************************************** ;;; @@ -366,6 +366,8 @@ ((atom 2nd) (if 2nd (error 'simple-type-error + :datum x + :expected-type 'list :format-control "First argument is not a proper list." :format-arguments nil) 3rd)) diff --git a/code/seq.lisp b/code/seq.lisp index 333a836c237211af332465a8f0eabb2f148fedf2..f9f1388fde7d84c884703192c796f454bb2baa49 100644 --- a/code/seq.lisp +++ b/code/seq.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/seq.lisp,v 1.46 2003/01/23 21:05:35 toy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/seq.lisp,v 1.47 2003/05/26 20:20:31 gerd Exp $") ;;; ;;; ********************************************************************** ;;; @@ -970,6 +970,8 @@ "Coerces the Object to an object of type Output-Type-Spec." (labels ((coerce-error () (error 'simple-type-error + :expected-type output-type-spec + :datum object :format-control "~S can't be converted to type ~S." :format-arguments (list object output-type-spec))) (check-seq-len (type length) diff --git a/compiler/byte-comp.lisp b/compiler/byte-comp.lisp index b92c5cb652c0573aaf31b78d737971129bd27fee..991c97204adf5893741b940a4cc9eb495981e536 100644 --- a/compiler/byte-comp.lisp +++ b/compiler/byte-comp.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/compiler/byte-comp.lisp,v 1.33 2003/04/11 15:38:45 emarsden Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/byte-comp.lisp,v 1.34 2003/05/26 20:20:31 gerd Exp $") ;;; ;;; ********************************************************************** ;;; @@ -1921,7 +1921,11 @@ (if (constantp default) (eval default) nil) - (if s-p t nil)))))))) + (if s-p t nil))))) + (:more-context + (incf num-more 2) + (setf rest-arg-p :more)) + (:more-count)))) (make-hairy-byte-function :name (leaf-name entry) :min-args (optional-dispatch-min-args entry)