Skip to content
Snippets Groups Projects
Commit 55dde220 authored by wlott's avatar wlott
Browse files

Spiffed up the error messages for all the internal errors. Actually,

signal conditions, so we can fill in the function name.
parent a8825868
No related branches found
No related tags found
No related merge requests found
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
;;; Scott Fahlman (FAHLMAN@CMUC). ;;; Scott Fahlman (FAHLMAN@CMUC).
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/interr.lisp,v 1.14 1990/11/26 18:46:38 wlott Exp $ ;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/interr.lisp,v 1.15 1990/12/11 15:18:29 wlott Exp $
;;; ;;;
;;; Functions and macros to define and deal with internal errors (i.e. ;;; Functions and macros to define and deal with internal errors (i.e.
;;; problems that can be signaled from assembler code). ;;; problems that can be signaled from assembler code).
...@@ -138,6 +138,7 @@ ...@@ -138,6 +138,7 @@
(nthcdr ,rest-pos ,sc-offsets)))))) (nthcdr ,rest-pos ,sc-offsets))))))
,@body)))))) ,@body))))))
) ; Eval-When (Compile Eval) ) ; Eval-When (Compile Eval)
(defun %deferr (name number description #+new-compiler function) (defun %deferr (name number description #+new-compiler function)
...@@ -162,193 +163,305 @@ ...@@ -162,193 +163,305 @@
(deferr object-not-function-error (deferr object-not-function-error
"Object is not of type FUNCTION." "Object is not of type FUNCTION."
(object) (object)
(error "Expected a function, but got: ~S" object)) (error 'type-error
:function-name name
:datum object
:expected-type 'function))
(deferr object-not-list-error (deferr object-not-list-error
"Object is not of type LIST." "Object is not of type LIST."
(&rest args) (object)
(error "object-not-list:~{ ~S~}" args)) (error 'type-error
:function-name name
:datum object
:expected-type 'list))
(deferr object-not-bignum-error (deferr object-not-bignum-error
"Object is not of type BIGNUM." "Object is not of type BIGNUM."
(&rest args) (object)
(error "object-not-bignum:~{ ~S~}" args)) (error 'type-error
:function-name name
:datum object
:expected-type 'bignum))
(deferr object-not-ratio-error (deferr object-not-ratio-error
"Object is not of type RATIO." "Object is not of type RATIO."
(&rest args) (object)
(error "object-not-ratio:~{ ~S~}" args)) (error 'type-error
:function-name name
:datum object
:expected-type 'ratio))
(deferr object-not-single-float-error (deferr object-not-single-float-error
"Object is not of type SINGLE-FLOAT." "Object is not of type SINGLE-FLOAT."
(&rest args) (object)
(error "object-not-single-float:~{ ~S~}" args)) (error 'type-error
:function-name name
:datum object
:expected-type 'single-float))
(deferr object-not-double-float-error (deferr object-not-double-float-error
"Object is not of type DOUBLE-FLOAT." "Object is not of type DOUBLE-FLOAT."
(&rest args) (object)
(error "object-not-double-float:~{ ~S~}" args)) (error 'type-error
:function-name name
:datum object
:expected-type 'double-float))
(deferr object-not-simple-string-error (deferr object-not-simple-string-error
"Object is not of type SIMPLE-STRING." "Object is not of type SIMPLE-STRING."
(&rest args) (object)
(error "object-not-simple-string:~{ ~S~}" args)) (error 'type-error
:function-name name
:datum object
:expected-type 'simple-string))
(deferr object-not-simple-bit-vector-error (deferr object-not-simple-bit-vector-error
"Object is not of type SIMPLE-BIT-VECTOR." "Object is not of type SIMPLE-BIT-VECTOR."
(&rest args) (object)
(error "object-not-simple-bit-vector:~{ ~S~}" args)) (error 'type-error
:function-name name
:datum object
:expected-type 'simple-bit-vector))
(deferr object-not-simple-vector-error (deferr object-not-simple-vector-error
"Object is not of type SIMPLE-VECTOR." "Object is not of type SIMPLE-VECTOR."
(&rest args) (object)
(error "object-not-simple-vector:~{ ~S~}" args)) (error 'type-error
:function-name name
:datum object
:expected-type 'simple-vector))
(deferr object-not-fixnum-error (deferr object-not-fixnum-error
"Object is not of type FIXNUM." "Object is not of type FIXNUM."
(&rest args) (object)
(error "object-not-fixnum:~{ ~S~}" args)) (error 'type-error
:function-name name
:datum object
:expected-type 'fixnum))
(deferr object-not-function-or-symbol-error (deferr object-not-function-or-symbol-error
"Object is not of type FUNCTION or of type SYMBOL." "Object is not of type FUNCTION or SYMBOL."
(&rest args) (object)
(error "object-not-function-or-symbol:~{ ~S~}" args)) (error 'type-error
:function-name name
:datum object
:expected-type '(or function symbol)))
(deferr object-not-vector-error (deferr object-not-vector-error
"Object is not of type VECTOR." "Object is not of type VECTOR."
(&rest args) (object)
(error "object-not-vector:~{ ~S~}" args)) (error 'type-error
:function-name name
:datum object
:expected-type 'vector))
(deferr object-not-string-error (deferr object-not-string-error
"Object is not of type STRING." "Object is not of type STRING."
(&rest args) (object)
(error "object-not-string:~{ ~S~}" args)) (error 'type-error
:function-name name
:datum object
:expected-type 'string))
(deferr object-not-bit-vector-error (deferr object-not-bit-vector-error
"Object is not of type BIT-VECTOR." "Object is not of type BIT-VECTOR."
(&rest args) (object)
(error "object-not-bit-vector:~{ ~S~}" args)) (error 'type-error
:function-name name
:datum object
:expected-type 'bit-vector))
(deferr object-not-array-error (deferr object-not-array-error
"Object is not of type ARRAY." "Object is not of type ARRAY."
(&rest args) (object)
(error "object-not-array:~{ ~S~}" args)) (error 'type-error
:function-name name
:datum object
:expected-type 'array))
(deferr object-not-number-error (deferr object-not-number-error
"Object is not of type NUMBER." "Object is not of type NUMBER."
(&rest args) (object)
(error "object-not-number:~{ ~S~}" args)) (error 'type-error
:function-name name
:datum object
:expected-type 'number))
(deferr object-not-rational-error (deferr object-not-rational-error
"Object is not of type RATIONAL." "Object is not of type RATIONAL."
(&rest args) (object)
(error "object-not-rational:~{ ~S~}" args)) (error 'type-error
:function-name name
:datum object
:expected-type 'rational))
(deferr object-not-float-error (deferr object-not-float-error
"Object is not of type FLOAT." "Object is not of type FLOAT."
(&rest args) (object)
(error "object-not-float:~{ ~S~}" args)) (error 'type-error
:function-name name
:datum object
:expected-type 'float))
(deferr object-not-real-error (deferr object-not-real-error
"Object is not of type REAL." "Object is not of type REAL."
(&rest args) (object)
(error "object-not-real:~{ ~S~}" args)) (error 'type-error
:function-name name
:datum object
:expected-type 'real))
(deferr object-not-integer-error (deferr object-not-integer-error
"Object is not of type INTEGER." "Object is not of type INTEGER."
(&rest args) (object)
(error "object-not-integer:~{ ~S~}" args)) (error 'type-error
:function-name name
:datum object
:expected-type 'integer))
(deferr object-not-cons-error (deferr object-not-cons-error
"Object is not of type CONS." "Object is not of type CONS."
(&rest args) (object)
(error "object-not-cons:~{ ~S~}" args)) (error 'type-error
:function-name name
:datum object
:expected-type 'cons))
(deferr object-not-symbol-error (deferr object-not-symbol-error
"Object is not of type SYMBOL." "Object is not of type SYMBOL."
(&rest args) (object)
(error "object-not-symbol:~{ ~S~}" args)) (error 'type-error
:function-name name
:datum object
:expected-type 'symbol))
(deferr undefined-symbol-error (deferr undefined-symbol-error
"Undefined symbol." "Undefined symbol."
(&rest args) (symbol)
(error "undefined-symbol:~{ ~S~}" args)) (error 'undefined-function
:function-name name
:name symbol))
(deferr object-not-coercable-to-function-error (deferr object-not-coercable-to-function-error
"Object is not coercable to type FUNCTION." "Object is not coercable to type FUNCTION."
(&rest args) (object)
(error "object-not-coercable-to-function:~{ ~S~}" args)) (error 'type-error
:function-name name
:datum object
:expected-type 'coercable-to-function))
(deferr invalid-argument-count-error (deferr invalid-argument-count-error
"Invalid argument count." "Invalid argument count."
(nargs) (nargs)
(error "Invalid number of arguments: ~S" nargs)) (error 'simple-error
:function-name name
:format-string "Invalid number of arguments: ~S"
:format-arguments (list nargs)))
(deferr bogus-argument-to-values-list-error (deferr bogus-argument-to-values-list-error
"Bogus argument to VALUES-LIST." "Bogus argument to VALUES-LIST."
(&rest args) (list)
(error "bogus-argument-to-values-list:~{ ~S~}" args)) (error 'simple-error
:function-name name
:format-string "Attempt to use VALUES-LIST on a dotted-list:~% ~S"
:format-arguments (list list)))
(deferr unbound-symbol-error (deferr unbound-symbol-error
"Unbound symbol." "Unbound symbol."
(&rest args) (symbol)
(error "unbound-symbol:~{ ~S~}" args)) (error 'unbound-variable :function-name name :name symbol))
(deferr object-not-base-character-error (deferr object-not-base-character-error
"Object is not of type BASE-CHARACTER." "Object is not of type BASE-CHARACTER."
(&rest args) (object)
(error "object-not-base-character:~{ ~S~}" args)) (error 'type-error
:function-name name
:datum object
:expected-type 'base-character))
(deferr object-not-sap-error (deferr object-not-sap-error
"Object is not a System Area Pointer (SAP)." "Object is not a System Area Pointer (SAP)."
(&rest args) (object)
(error "object-not-sap:~{ ~S~}" args)) (error 'type-error
:function-name name
:datum object
:expected-type 'system-area-pointer))
(deferr invalid-unwind-error (deferr invalid-unwind-error
"Attempt to RETURN-FROM a block that no longer exists." "Attempt to RETURN-FROM a block that no longer exists."
(&rest args) ()
(error "invalid-unwind:~{ ~S~}" args)) (error 'control-error
:function-name name
:format-string
"Attempt to RETURN-FROM a block or GO to a tag that no longer exists"))
(deferr unseen-throw-tag-error (deferr unseen-throw-tag-error
"Attempt to THROW to a non-existent tag." "Attempt to THROW to a non-existent tag."
(&rest args) (tag)
(error "unseen-throw-tag:~{ ~S~}" args)) (error 'control-error
:function-name name
:format-string "Attempt to THROW to a tag that does not exist: ~S"
:format-arguments (list tag)))
(deferr division-by-zero-error (deferr division-by-zero-error
"Attempt to divide by zero." "Attempt to divide by zero."
(&rest args) (this that)
(error "division-by-zero:~{ ~S~}" args)) (error 'division-by-zero
:function-name name
:operation 'division
:operands (list this that)))
(deferr object-not-type-error (deferr object-not-type-error
"Object is of the wrong type." "Object is of the wrong type."
(&rest args) (object type)
(error "object-not-type:~{ ~S~}" args)) (error 'type-error
:function-name name
:datum object
:expected-type type))
(deferr odd-keyword-arguments-error (deferr odd-keyword-arguments-error
"Odd number of keyword arguments." "Odd number of keyword arguments."
(&rest args) ()
(error "odd-keyword-arguments:~{ ~S~}" args)) (error 'simple-error
:function-name name
:format-string "Odd number of keyword arguments."))
(deferr unknown-keyword-argument-error (deferr unknown-keyword-argument-error
"Unknown keyword." "Unknown keyword."
(&rest args) (key)
(error "unknown-keyword-argument:~{ ~S~}" args)) (error 'simple-error
:function-name name
:format-string "Unknown keyword: ~S"
:format-arguments (list key)))
(deferr not-<=-error (deferr not-<=-error
"Not less than or equal." "Not less than or equal."
(&rest args) (this that)
(error "not-<=:~{ ~S~}" args)) (error 'simple-error
:function-name name
:format-string "Assertion that ~S <= ~S failed."
:format-arguments (list this that)))
(deferr not-=-error (deferr not-=-error
"Not equal." "Not equal."
(&rest args) (this that)
(error "not-=:~{ ~S~}" args)) (error 'simple-error
:function-name name
:format-string "Assertion that ~S = ~S failed."
:format-arguments (list this that)))
(deferr invalid-array-index-error (deferr invalid-array-index-error
"Invalid array index." "Invalid array index."
(&rest args) (array bound index)
(error "invalid-array-index:~{ ~S~}" args)) (error 'simple-error
:function-name name
:format-string
"Invalid array index, ~D for ~S. Should have been less than ~D"
:format-arguments (list index array bound)))
;;; ### Is this used?
(deferr wrong-number-of-indices-error (deferr wrong-number-of-indices-error
"Wrong number of indices." "Wrong number of indices."
(&rest args) (&rest args)
...@@ -356,71 +469,108 @@ ...@@ -356,71 +469,108 @@
(deferr object-not-simple-array-error (deferr object-not-simple-array-error
"Object is not of type SIMPLE-ARRAY." "Object is not of type SIMPLE-ARRAY."
(&rest args) (object)
(error "object-not-simple-array:~{ ~S~}" args)) (error 'type-error
:function-name name
:datum object
:expected-type 'simple-array))
(deferr object-not-signed-byte-32-error (deferr object-not-signed-byte-32-error
"Object is not of type (SIGNED-BYTE 32)." "Object is not of type (SIGNED-BYTE 32)."
(&rest args) (object)
(error "object-not-signed-byte-32:~{ ~S~}" args)) (error 'type-error
:function-name name
:datum object
:expected-type '(signed-byte 32)))
(deferr object-not-unsigned-byte-32-error (deferr object-not-unsigned-byte-32-error
"Object is not of type (UNSIGNED-BYTE 32)." "Object is not of type (UNSIGNED-BYTE 32)."
(&rest args) (object)
(error "object-not-unsigned-byte-32:~{ ~S~}" args)) (error 'type-error
:function-name name
:datum object
:expected-type '(unsigned-byte 32)))
(deferr object-not-simple-array-unsigned-byte-2-error (deferr object-not-simple-array-unsigned-byte-2-error
"Object is not of type (SIMPLE-ARRAY (UNSIGNED-BYTE 2) (*))." "Object is not of type (SIMPLE-ARRAY (UNSIGNED-BYTE 2) (*))."
(&rest args) (object)
(error "object-not-simple-array-unsigned-byte-2:~{ ~S~}" args)) (error 'type-error
:function-name name
:datum object
:expected-type '(simple-array (unsigned-byte 2) (*))))
(deferr object-not-simple-array-unsigned-byte-4-error (deferr object-not-simple-array-unsigned-byte-4-error
"Object is not of type (SIMPLE-ARRAY (UNSIGNED-BYTE 4) (*))." "Object is not of type (SIMPLE-ARRAY (UNSIGNED-BYTE 4) (*))."
(&rest args) (object)
(error "object-not-simple-array-unsigned-byte-4:~{ ~S~}" args)) (error 'type-error
:function-name name
:datum object
:expected-type '(simple-array (unsigned-byte 4) (*))))
(deferr object-not-simple-array-unsigned-byte-8-error (deferr object-not-simple-array-unsigned-byte-8-error
"Object is not of type (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*))." "Object is not of type (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*))."
(&rest args) (object)
(error "object-not-simple-array-unsigned-byte-8:~{ ~S~}" args)) (error 'type-error
:function-name name
:datum object
:expected-type '(simple-array (unsigned-byte 8) (*))))
(deferr object-not-simple-array-unsigned-byte-16-error (deferr object-not-simple-array-unsigned-byte-16-error
"Object is not of type (SIMPLE-ARRAY (UNSIGNED-BYTE 16) (*))." "Object is not of type (SIMPLE-ARRAY (UNSIGNED-BYTE 16) (*))."
(&rest args) (object)
(error "object-not-simple-array-unsigned-byte-16:~{ ~S~}" args)) (error 'type-error
:function-name name
:datum object
:expected-type '(simple-array (unsigned-byte 16) (*))))
(deferr object-not-simple-array-unsigned-byte-32-error (deferr object-not-simple-array-unsigned-byte-32-error
"Object is not of type (SIMPLE-ARRAY (UNSIGNED-BYTE 32) (*))." "Object is not of type (SIMPLE-ARRAY (UNSIGNED-BYTE 32) (*))."
(&rest args) (object)
(error "object-not-simple-array-unsigned-byte-32:~{ ~S~}" args)) (error 'type-error
:function-name name
:datum object
:expected-type '(simple-array (unsigned-byte 32) (*))))
(deferr object-not-simple-array-single-float-error (deferr object-not-simple-array-single-float-error
"Object is not of type (SIMPLE-ARRAY SINGLE-FLOAT (*))." "Object is not of type (SIMPLE-ARRAY SINGLE-FLOAT (*))."
(&rest args) (object)
(error "object-not-simple-array-single-float:~{ ~S~}" args)) (error 'type-error
:function-name name
:datum object
:expected-type '(simple-array single-float (*))))
(deferr object-not-simple-array-double-float-error (deferr object-not-simple-array-double-float-error
"Object is not of type (SIMPLE-ARRAY DOUBLE-FLOAT (*))." "Object is not of type (SIMPLE-ARRAY DOUBLE-FLOAT (*))."
(&rest args) (object)
(error "object-not-simple-array-double-float:~{ ~S~}" args)) (error 'type-error
:function-name name
:datum object
:expected-type '(simple-array double-float (*))))
(deferr object-not-complex-error (deferr object-not-complex-error
"Object is not of type COMPLEX." "Object is not of type COMPLEX."
(&rest args) (object)
(error "object-not-complex:~{ ~S~}" args)) (error 'type-error
:function-name name
:datum object
:expected-type 'complex))
(deferr object-not-weak-pointer-error (deferr object-not-weak-pointer-error
"Object is not a WEAK-POINTER." "Object is not a WEAK-POINTER."
(&rest args) (object)
(error "object-not-weak-pointer:~{ ~S~}" args)) (error 'type-error
:function-name name
:datum object
:expected-type 'weak-pointer))
(deferr object-not-structure-error (deferr object-not-structure-error
"Object is not a STRUCTURE." "Object is not a STRUCTURE."
(object) (object)
(error 'simple-error (error 'type-error
:function-name name :function-name name
:format-string "~S isn't a structure." :datum object
:format-arguments (list object))) :expected-type 'structure))
;;;; internal-error signal handler. ;;;; internal-error signal handler.
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment