1;;;; This file defines all of the internal errors. How they are
2;;;; handled is defined in .../code/interr.lisp. How they are signaled
3;;;; depends on the machine.
4
5;;;; This software is part of the SBCL system. See the README file for
6;;;; more information.
7;;;;
8;;;; This software is derived from the CMU CL system, which was
9;;;; written at Carnegie Mellon University and released into the
10;;;; public domain. The software is in the public domain and is
11;;;; provided with absolutely no warranty. See the COPYING and CREDITS
12;;;; files for more information.
13
14(in-package "SB!KERNEL")
15
16;;; This is for generating runtime/genesis/constants.h
17;;; (The strings are only used in C code and are relatively unimportant)
18(defun !c-stringify-internal-error (interr)
19  (destructuring-bind (description symbol . nargs) interr
20    (declare (ignore nargs))
21    (if (stringp description)
22        description
23        ;; Isn't this rewording a bit pointless? OBJECT-NOT-FOO-ERROR is
24        ;; descriptive enough for its use in describe_internal_error()
25        (format nil "Object is not of type ~A."
26                ;; Given a string "OBJECT-NOT-foo-ERROR", pull out the "foo"
27                (subseq (string symbol) 11 (- (length (string symbol)) 6))))))
28
29;; Define SB!C:+BACKEND-INTERNAL-ERRORS+ as a vector of pairs.
30;; General errors have the form ("description-of-foo" . foo-ERROR)
31;; and type errors are (type-spec . OBJECT-NOT-<type-spec>-ERRROR)
32(macrolet
33   ((compute-it (general-errors &rest type-errors)
34      (let ((list
35             (append
36              general-errors
37              ;; All simple vector specializations
38              (map 'list
39                   (lambda (saetp)
40                     ;; Convert from specifier -> type -> specifier
41                     ;; because some specializations have particular names:
42                     ;;  (SIMPLE-ARRAY BASE-CHAR (*)) -> SIMPLE-BASE-STRING
43                     ;;  (SIMPLE-ARRAY BIT (*)) -> SIMPLE-BIT-VECTOR
44                     ;;  (SIMPLE-ARRAY T (*)) -> SIMPLE-VECTOR
45                     (list
46                      (type-specifier
47                       (specifier-type
48                        `(simple-array ,(sb!vm:saetp-specifier saetp) (*))))
49                      (symbolicate "OBJECT-NOT-"
50                                   (sb!vm:saetp-primitive-type-name saetp))))
51                   sb!vm:*specialized-array-element-type-properties*)
52              (let ((unboxed-vectors
53                     (map 'list
54                          (lambda (saetp)
55                            (type-specifier
56                             (specifier-type
57                              `(simple-array ,(sb!vm:saetp-specifier saetp) (*)))))
58                          (remove t sb!vm:*specialized-array-element-type-properties*
59                                  :key 'sb!vm:saetp-specifier))))
60                `(((integer 0 ,sb!xc:array-dimension-limit)
61                   object-not-array-dimension)
62                  ;; Union of all unboxed array specializations,
63                  ;; for type-checking the argument to VECTOR-SAP
64                  ((or ,@unboxed-vectors) object-not-simple-specialized-vector)
65                  ;; For type-checking the argument to array blt functions
66                  ;; that take either a SAP or an unboxed vector.
67                  ;; KLUDGE: fragile, as the order of OR terms has to match
68                  ;; exactly the type constraint in the blt functions.
69                  ((or ,@unboxed-vectors system-area-pointer)
70                   object-not-sap-or-simple-specialized-vector)))
71              type-errors)))
72        ;; Error number must be of type (unsigned-byte 8).
73        (assert (<= (length list) 256))
74        `(defconstant-eqx sb!c:+backend-internal-errors+
75               ,(map 'vector
76                     (lambda (x)
77                       (if (symbolp x)
78                           (list* x (symbolicate "OBJECT-NOT-" x "-ERROR") 1)
79                           (list* (car x) (symbolicate (second x) "-ERROR")
80                                  (if (stringp (car x))
81                                      (third x)
82                                      1))))
83                     list)
84               #'equalp))))
85 (compute-it
86  ;; Keep the following two subsets of internal errors in this order:
87  ;;
88  ;; (I) all the errors which are not a TYPE-ERROR.
89  ;; FIXME: These should either consistently be sentences beginning with
90  ;; a capital letter and ending with a period, or consistently not that,
91  ;; instead of a random mix of both.
92  (("unknown system lossage" unknown 0)
93   ("An attempt was made to use an undefined FDEFINITION." undefined-fun 1)
94   #!+(or arm arm64 x86-64)
95   ("An attempt was made to use an undefined alien function" undefined-alien-fun 1)
96   ("invalid argument count" invalid-arg-count 1)
97   ("invalid argument count" local-invalid-arg-count 2)
98   ("bogus argument to VALUES-LIST" bogus-arg-to-values-list 1)
99   ("An attempt was made to use an undefined SYMBOL-VALUE." unbound-symbol 1)
100   ("attempt to RETURN-FROM a block that no longer exists" invalid-unwind 0)
101   ("attempt to THROW to a non-existent tag" unseen-throw-tag 1)
102   ("division by zero" division-by-zero 2)
103   ("Object is of the wrong type." object-not-type 2)
104   ("odd number of &KEY arguments" odd-key-args 0)
105   ("unknown &KEY argument" unknown-key-arg 1)
106   ("invalid array index" invalid-array-index 3)
107   ("A function with declared result type NIL returned." nil-fun-returned 1)
108   ("An array with element-type NIL was accessed." nil-array-accessed 1)
109   ("Object layout is invalid. (indicates obsolete instance)" layout-invalid 2)
110   ("Thread local storage exhausted." tls-exhausted 0))
111
112  ;; (II) All the type specifiers X for which there is a unique internal
113  ;;      error code corresponding to a primitive object-not-X-error.
114  function
115  list
116  bignum
117  ratio
118  single-float
119  double-float
120  #!+long-float long-float
121  simple-string
122  fixnum
123  vector
124  string
125  base-string
126  ((vector nil) object-not-vector-nil)
127  #!+sb-unicode ((vector character) object-not-character-string)
128  bit-vector
129  array
130  number
131  rational
132  float
133  real
134  integer
135  cons
136  symbol
137  (system-area-pointer object-not-sap)
138  simple-array
139  ((signed-byte 32) object-not-signed-byte-32)
140  ((signed-byte 64) object-not-signed-byte-64) ; regardless of word size
141  unsigned-byte
142  ((unsigned-byte 8) object-not-unsigned-byte-8)
143  ;; ANSI-STREAM-IN-BUFFER-LENGTH bounds check type
144  ((unsigned-byte 9) object-not-unsigned-byte-9)
145  ((unsigned-byte 32) object-not-unsigned-byte-32)
146  ((unsigned-byte 64) object-not-unsigned-byte-64) ; regardless of word size
147  complex
148  ((complex rational) object-not-complex-rational)
149  ((complex float) object-not-complex-float)
150  ((complex single-float) object-not-complex-single-float)
151  ((complex double-float) object-not-complex-double-float)
152  #!+long-float ((complex long-float) object-not-complex-long-float)
153  #!+sb-simd-pack simd-pack
154  weak-pointer
155  instance
156  character
157  ((and vector (not simple-array)) object-not-complex-vector)
158
159  ;; Now, in approximate order of descending popularity.
160  ;; If we exceed 255 error numbers, trailing ones can be deleted arbitrarily.
161  (sb!c:sc object-not-storage-class) ; the single most popular type
162  sb!c:tn-ref
163  index
164  ctype
165  sb!impl::buffer
166  sb!c::vop
167  sb!c::basic-combination
168  sb!sys:fd-stream
169  layout
170  (sb!assem:segment object-not-assem-segment)
171  sb!c::cblock
172  sb!disassem:disassem-state
173  sb!c::ctran
174  sb!c::clambda
175  sb!c:tn
176  ((or function symbol) object-not-callable)
177  sb!c:component
178  ((or index null) object-not-index-or-null)
179  stream
180  sb!c::ir2-block
181  sb!c::ir2-component
182  type-class
183  sb!c::lvar
184  sb!c::vop-info
185  (sb!disassem:instruction object-not-disassembler-instruction)
186  ((mod 1114112) object-not-unicode-code-point)
187  (sb!c::node object-not-compiler-node)
188  sequence
189  sb!c::functional
190  ((member t nil) object-not-boolean)
191  sb!c::lambda-var
192  sb!alien::alien-type-class
193  lexenv
194  ;; simple vector-of-anything is called a "rank-1-array"
195  ;; because "simple-vector" means (simple-array t (*))
196  ((simple-array * (*)) object-not-simple-rank-1-array)
197  hash-table
198  sb!c::combination
199  numeric-type
200  defstruct-description
201  sb!format::format-directive
202  package
203  form-tracking-stream
204  ansi-stream))
205
206(defun error-number-or-lose (name)
207  (or (position name sb!c:+backend-internal-errors+
208                :key #'cadr :test #'eq)
209      (error "unknown internal error: ~S" name)))
210
211(defun error-length (error-number)
212  (if (array-in-bounds-p sb!c:+backend-internal-errors+ error-number)
213      (cddr (svref sb!c:+backend-internal-errors+ error-number))
214      0))
215
216#-sb-xc-host ; no SB!C:SAP-READ-VAR-INTEGERF
217(defun decode-internal-error-args (sap error-number)
218  (let ((length (sb!kernel::error-length error-number)))
219    (declare (type (unsigned-byte 8) length))
220    (loop repeat length with index = 0
221       collect (sb!c:sap-read-var-integerf sap index))))
222