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   (invalid-arg-count
  92    "invalid argument count")
  93   (bogus-arg-to-values-list
  94    "bogus argument to VALUES-LIST")
  95   (unbound-symbol
  96    "An attempt was made to use an undefined SYMBOL-VALUE.")
  97   (object-not-sap
  98    "Object is not a System Area Pointer (SAP).")
  99   (invalid-unwind
 100    "attempt to RETURN-FROM a block that no longer exists")
 101   (unseen-throw-tag
 102    "attempt to THROW to a non-existent tag")
 103   (division-by-zero
 104    "division by zero")
 105   (object-not-type
 106    "Object is of the wrong type.")
 107   (odd-key-args
 108    "odd number of &KEY arguments")
 109   (unknown-key-arg
 110    "unknown &KEY argument")
 111   (invalid-array-index
 112    "invalid array index")
 113   (wrong-number-of-indices
 114    "wrong number of indices")
 115   (object-not-simple-array
 116    "Object is not of type SIMPLE-ARRAY.")
 117   (object-not-signed-byte-32
 118    "Object is not of type (SIGNED-BYTE 32).")
 119   (object-not-unsigned-byte-32
 120    "Object is not of type (UNSIGNED-BYTE 32).")
 121   (object-not-complex
 122    "Object is not of type COMPLEX.")
 123   (object-not-complex-rational
 124    "Object is not of type (COMPLEX RATIONAL).")
 125   (object-not-complex-float
 126    "Object is not of type (COMPLEX FLOAT).")
 127   (object-not-complex-single-float
 128    "Object is not of type (COMPLEX SINGLE-FLOAT).")
 129   (object-not-complex-double-float
 130    "Object is not of type (COMPLEX DOUBLE-FLOAT).")
 131   #!+long-float
 132   (object-not-complex-long-float
 133    "Object is not of type (COMPLEX LONG-FLOAT).")
 134   #!+x86-64
 135   (object-not-sse-pack
 136    "Object is not of type SSE-PACK.")
 137   (object-not-weak-pointer
 138    "Object is not a WEAK-POINTER.")
 139   (object-not-instance
 140    "Object is not a INSTANCE.")
 141   (object-not-character
 142    "Object is not a CHARACTER.")
 143   (nil-fun-returned
 144    "A function with declared result type NIL returned.")
 145   (nil-array-accessed
 146    "An array with element-type NIL was accessed.")
 147   (layout-invalid
 148    "Object layout is invalid. (indicates obsolete instance)")
 149   (object-not-complex-vector
 150    "Object is not a complex (non-SIMPLE-ARRAY) vector.")
 151   (tls-exhausted
 152    "Thread local storage exhausted.")
 153   .
 154   #.(map 'list
 155          (lambda (saetp)
 156            (list
 157             (symbolicate "OBJECT-NOT-" (sb!vm:saetp-primitive-type-name saetp))
 158             (format nil "Object is not of type ~A."
 159                     (type-specifier
 160                      (specifier-type
 161                       `(simple-array ,(sb!vm:saetp-specifier saetp) (*)))))))
 162          sb!vm:*specialized-array-element-type-properties*))
 163