Better error when calling an undefined alien function on x86-64.
[sbcl.git] / src / compiler / generic / interr.lisp
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 (defun error-number-or-lose (name)
17   (or (position name sb!c:*backend-internal-errors* :key #'car)
18       (error "unknown internal error: ~S" name)))
19
20 ;;; FIXME: Having each of these error handlers be a full, named function
21 ;;; seems to contribute a noticeable amount of bloat and little value.
22 ;;; Perhaps we could just make a single error-handling function with a
23 ;;; big CASE statement inside it? Or at least implement the error handling
24 ;;; functions as closures instead of DEFUNs?
25 (eval-when (:compile-toplevel :execute)
26   (def!macro define-internal-errors (&rest errors)
27              (let ((info (mapcar (lambda (x)
28                                    (cons (symbolicate (first x) "-ERROR")
29                                          (second x)))
30                                  errors)))
31                `(progn
32                   (setf sb!c:*backend-internal-errors*
33                         ',(coerce info 'vector))
34                   nil))))
35
36 (define-internal-errors
37   (unknown
38    "unknown system lossage")
39   (object-not-fun
40    "Object is not of type FUNCTION.")
41   (object-not-list
42    "Object is not of type LIST.")
43   (object-not-bignum
44    "Object is not of type BIGNUM.")
45   (object-not-ratio
46    "Object is not of type RATIO.")
47   (object-not-single-float
48    "Object is not of type SINGLE-FLOAT.")
49   (object-not-double-float
50    "Object is not of type DOUBLE-FLOAT.")
51   #!+long-float
52   (object-not-long-float
53    "Object is not of type LONG-FLOAT.")
54   (object-not-simple-string
55    "Object is not of type SIMPLE-STRING.")
56   (object-not-fixnum
57    "Object is not of type FIXNUM.")
58   (object-not-vector
59    "Object is not of type VECTOR.")
60   (object-not-string
61    "Object is not of type STRING.")
62   (object-not-base-string
63    "Object is not of type BASE-STRING.")
64   (object-not-vector-nil
65    "Object is not of type (VECTOR NIL).")
66   #!+sb-unicode
67   (object-not-character-string
68    "Object is not of type (VECTOR CHARACTER).")
69   (object-not-bit-vector
70    "Object is not of type BIT-VECTOR.")
71   (object-not-array
72    "Object is not of type ARRAY.")
73   (object-not-number
74    "Object is not of type NUMBER.")
75   (object-not-rational
76    "Object is not of type RATIONAL.")
77   (object-not-float
78    "Object is not of type FLOAT.")
79   (object-not-real
80    "Object is not of type REAL.")
81   (object-not-integer
82    "Object is not of type INTEGER.")
83   (object-not-cons
84    "Object is not of type CONS.")
85   (object-not-symbol
86    "Object is not of type SYMBOL.")
87   (undefined-fun
88    ;; FIXME: Isn't this used for calls to unbound (SETF FOO) too? If so, revise
89    ;; the name.
90    "An attempt was made to use an undefined FDEFINITION.")
91   #!+x86-64
92   (undefined-alien-fun
93    "An attempt was made to use an undefined alien function")
94   (invalid-arg-count
95    "invalid argument count")
96   (bogus-arg-to-values-list
97    "bogus argument to VALUES-LIST")
98   (unbound-symbol
99    "An attempt was made to use an undefined SYMBOL-VALUE.")
100   (object-not-sap
101    "Object is not a System Area Pointer (SAP).")
102   (invalid-unwind
103    "attempt to RETURN-FROM a block that no longer exists")
104   (unseen-throw-tag
105    "attempt to THROW to a non-existent tag")
106   (division-by-zero
107    "division by zero")
108   (object-not-type
109    "Object is of the wrong type.")
110   (odd-key-args
111    "odd number of &KEY arguments")
112   (unknown-key-arg
113    "unknown &KEY argument")
114   (invalid-array-index
115    "invalid array index")
116   (wrong-number-of-indices
117    "wrong number of indices")
118   (object-not-simple-array
119    "Object is not of type SIMPLE-ARRAY.")
120   (object-not-signed-byte-32
121    "Object is not of type (SIGNED-BYTE 32).")
122   (object-not-unsigned-byte-32
123    "Object is not of type (UNSIGNED-BYTE 32).")
124   (object-not-complex
125    "Object is not of type COMPLEX.")
126   (object-not-complex-rational
127    "Object is not of type (COMPLEX RATIONAL).")
128   (object-not-complex-float
129    "Object is not of type (COMPLEX FLOAT).")
130   (object-not-complex-single-float
131    "Object is not of type (COMPLEX SINGLE-FLOAT).")
132   (object-not-complex-double-float
133    "Object is not of type (COMPLEX DOUBLE-FLOAT).")
134   #!+long-float
135   (object-not-complex-long-float
136    "Object is not of type (COMPLEX LONG-FLOAT).")
137   #!+sb-simd-pack
138   (object-not-simd-pack
139    "Object is not of type SIMD-PACK.")
140   (object-not-weak-pointer
141    "Object is not a WEAK-POINTER.")
142   (object-not-instance
143    "Object is not a INSTANCE.")
144   (object-not-character
145    "Object is not a CHARACTER.")
146   (nil-fun-returned
147    "A function with declared result type NIL returned.")
148   (nil-array-accessed
149    "An array with element-type NIL was accessed.")
150   (layout-invalid
151    "Object layout is invalid. (indicates obsolete instance)")
152   (object-not-complex-vector
153    "Object is not a complex (non-SIMPLE-ARRAY) vector.")
154   (tls-exhausted
155    "Thread local storage exhausted.")
156   .
157   #.(map 'list
158          (lambda (saetp)
159            (list
160             (symbolicate "OBJECT-NOT-" (sb!vm:saetp-primitive-type-name saetp))
161             (format nil "Object is not of type ~A."
162                     (type-specifier
163                      (specifier-type
164                       `(simple-array ,(sb!vm:saetp-specifier saetp) (*)))))))
165          sb!vm:*specialized-array-element-type-properties*))
166