X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fgeneric%2Finterr.lisp;h=8c14ed9a9fa18420c8770016e9d6c979c5c36169;hb=19319c931fc1636835dbef71808cc10e252bcf45;hp=a76e6b37aa40018fa10a7c7616430fc9f57bc743;hpb=ce02ab2ecd9c6ae2e570abd8c93ebf3be55bbdad;p=sbcl.git diff --git a/src/compiler/generic/interr.lisp b/src/compiler/generic/interr.lisp index a76e6b3..8c14ed9 100644 --- a/src/compiler/generic/interr.lisp +++ b/src/compiler/generic/interr.lisp @@ -20,24 +20,23 @@ ;;; FIXME: Having each of these error handlers be a full, named function ;;; seems to contribute a noticeable amount of bloat and little value. ;;; Perhaps we could just make a single error-handling function with a -;;; big CASE statement inside it? +;;; big CASE statement inside it? Or at least implement the error handling +;;; functions as closures instead of DEFUNs? (eval-when (:compile-toplevel :execute) (def!macro define-internal-errors (&rest errors) - (let ((info (mapcar #'(lambda (x) - (if x - (cons (symbolicate (first x) "-ERROR") - (second x)) - '(nil . "unused"))) - errors))) - `(progn - (setf sb!c:*backend-internal-errors* - ',(coerce info 'vector)) - nil)))) + (let ((info (mapcar (lambda (x) + (cons (symbolicate (first x) "-ERROR") + (second x))) + errors))) + `(progn + (setf sb!c:*backend-internal-errors* + ',(coerce info 'vector)) + nil)))) (define-internal-errors (unknown "unknown system lossage") - (object-not-function + (object-not-fun "Object is not of type FUNCTION.") (object-not-list "Object is not of type LIST.") @@ -54,18 +53,19 @@ "Object is not of type LONG-FLOAT.") (object-not-simple-string "Object is not of type SIMPLE-STRING.") - (object-not-simple-bit-vector - "Object is not of type SIMPLE-BIT-VECTOR.") - (object-not-simple-vector - "Object is not of type SIMPLE-VECTOR.") (object-not-fixnum "Object is not of type FIXNUM.") - (object-not-function-or-symbol - "Object is not of type FUNCTION or SYMBOL.") (object-not-vector "Object is not of type VECTOR.") (object-not-string "Object is not of type STRING.") + (object-not-base-string + "Object is not of type BASE-STRING.") + (object-not-vector-nil + "Object is not of type (VECTOR NIL).") + #!+sb-unicode + (object-not-character-string + "Object is not of type (VECTOR CHARACTER).") (object-not-bit-vector "Object is not of type BIT-VECTOR.") (object-not-array @@ -84,21 +84,19 @@ "Object is not of type CONS.") (object-not-symbol "Object is not of type SYMBOL.") - (undefined-symbol + (undefined-fun ;; FIXME: Isn't this used for calls to unbound (SETF FOO) too? If so, revise ;; the name. "An attempt was made to use an undefined FDEFINITION.") - (object-not-coerceable-to-function - "Object is not coerceable to type FUNCTION.") - (invalid-argument-count + #!+x86-64 + (undefined-alien-fun + "An attempt was made to use an undefined alien function") + (invalid-arg-count "invalid argument count") - (bogus-argument-to-values-list + (bogus-arg-to-values-list "bogus argument to VALUES-LIST") (unbound-symbol "An attempt was made to use an undefined SYMBOL-VALUE.") - ;; FIXME: We shouldn't need these placeholder NIL entries any more - ;; now that we pass our magic numbers cleanly through sbcl.h. - nil (object-not-sap "Object is not a System Area Pointer (SAP).") (invalid-unwind @@ -109,12 +107,10 @@ "division by zero") (object-not-type "Object is of the wrong type.") - (odd-key-arguments + (odd-key-args "odd number of &KEY arguments") - (unknown-key-argument + (unknown-key-arg "unknown &KEY argument") - nil - nil (invalid-array-index "invalid array index") (wrong-number-of-indices @@ -125,38 +121,6 @@ "Object is not of type (SIGNED-BYTE 32).") (object-not-unsigned-byte-32 "Object is not of type (UNSIGNED-BYTE 32).") - (object-not-simple-array-unsigned-byte-2 - "Object is not of type (SIMPLE-ARRAY (UNSIGNED-BYTE 2) (*)).") - (object-not-simple-array-unsigned-byte-4 - "Object is not of type (SIMPLE-ARRAY (UNSIGNED-BYTE 4) (*)).") - (object-not-simple-array-unsigned-byte-8 - "Object is not of type (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)).") - (object-not-simple-array-unsigned-byte-16 - "Object is not of type (SIMPLE-ARRAY (UNSIGNED-BYTE 16) (*)).") - (object-not-simple-array-unsigned-byte-32 - "Object is not of type (SIMPLE-ARRAY (UNSIGNED-BYTE 32) (*)).") - (object-not-simple-array-signed-byte-8 - "Object is not of type (SIMPLE-ARRAY (SIGNED-BYTE 8) (*)).") - (object-not-simple-array-signed-byte-16 - "Object is not of type (SIMPLE-ARRAY (SIGNED-BYTE 16) (*)).") - (object-not-simple-array-signed-byte-30 - "Object is not of type (SIMPLE-ARRAY FIXNUM (*)).") - (object-not-simple-array-signed-byte-32 - "Object is not of type (SIMPLE-ARRAY (SIGNED-BYTE 32) (*)).") - (object-not-simple-array-single-float - "Object is not of type (SIMPLE-ARRAY SINGLE-FLOAT (*)).") - (object-not-simple-array-double-float - "Object is not of type (SIMPLE-ARRAY DOUBLE-FLOAT (*)).") - #!+long-float - (object-not-simple-array-long-float - "Object is not of type (SIMPLE-ARRAY LONG-FLOAT (*)).") - (object-not-simple-array-complex-single-float - "Object is not of type (SIMPLE-ARRAY (COMPLEX SINGLE-FLOAT) (*)).") - (object-not-simple-array-complex-double-float - "Object is not of type (SIMPLE-ARRAY (COMPLEX DOUBLE-FLOAT) (*)).") - #!+long-float - (object-not-simple-array-complex-long-float - "Object is not of type (SIMPLE-ARRAY (COMPLEX LONG-FLOAT) (*)).") (object-not-complex "Object is not of type COMPLEX.") (object-not-complex-rational @@ -170,15 +134,33 @@ #!+long-float (object-not-complex-long-float "Object is not of type (COMPLEX LONG-FLOAT).") + #!+sb-simd-pack + (object-not-simd-pack + "Object is not of type SIMD-PACK.") (object-not-weak-pointer "Object is not a WEAK-POINTER.") (object-not-instance "Object is not a INSTANCE.") - (object-not-base-char - "Object is not of type BASE-CHAR.") - (nil-function-returned + (object-not-character + "Object is not a CHARACTER.") + (nil-fun-returned "A function with declared result type NIL returned.") + (nil-array-accessed + "An array with element-type NIL was accessed.") (layout-invalid - "invalid layout (indicates obsolete instance)") + "Object layout is invalid. (indicates obsolete instance)") (object-not-complex-vector - "Object is not a complex (non-SIMPLE-ARRAY) vector.")) + "Object is not a complex (non-SIMPLE-ARRAY) vector.") + (tls-exhausted + "Thread local storage exhausted.") + . + #.(map 'list + (lambda (saetp) + (list + (symbolicate "OBJECT-NOT-" (sb!vm:saetp-primitive-type-name saetp)) + (format nil "Object is not of type ~A." + (type-specifier + (specifier-type + `(simple-array ,(sb!vm:saetp-specifier saetp) (*))))))) + sb!vm:*specialized-array-element-type-properties*)) +