- :datum object
- :expected-type '(unsigned-byte 32)))
-
-(deferr object-not-simple-array-unsigned-byte-2-error (object)
- (error 'type-error
- :datum object
- :expected-type '(simple-array (unsigned-byte 2) (*))))
-
-(deferr object-not-simple-array-unsigned-byte-4-error (object)
- (error 'type-error
- :datum object
- :expected-type '(simple-array (unsigned-byte 4) (*))))
-
-(deferr object-not-simple-array-unsigned-byte-8-error (object)
- (error 'type-error
- :datum object
- :expected-type '(simple-array (unsigned-byte 8) (*))))
-
-(deferr object-not-simple-array-unsigned-byte-16-error (object)
- (error 'type-error
- :datum object
- :expected-type '(simple-array (unsigned-byte 16) (*))))
-
-(deferr object-not-simple-array-unsigned-byte-32-error (object)
- (error 'type-error
- :datum object
- :expected-type '(simple-array (unsigned-byte 32) (*))))
-
-(deferr object-not-simple-array-signed-byte-8-error (object)
- (error 'type-error
- :datum object
- :expected-type '(simple-array (signed-byte 8) (*))))
-
-(deferr object-not-simple-array-signed-byte-16-error (object)
- (error 'type-error
- :datum object
- :expected-type '(simple-array (signed-byte 16) (*))))
-
-(deferr object-not-simple-array-signed-byte-30-error (object)
- (error 'type-error
- :datum object
- :expected-type '(simple-array (signed-byte 30) (*))))
-
-(deferr object-not-simple-array-signed-byte-32-error (object)
- (error 'type-error
- :datum object
- :expected-type '(simple-array (signed-byte 32) (*))))
-
-(deferr object-not-simple-array-single-float-error (object)
- (error 'type-error
- :datum object
- :expected-type '(simple-array single-float (*))))
-
-(deferr object-not-simple-array-double-float-error (object)
- (error 'type-error
- :datum object
- :expected-type '(simple-array double-float (*))))
-
-(deferr object-not-simple-array-complex-single-float-error (object)
- (error 'type-error
- :datum object
- :expected-type '(simple-array (complex single-float) (*))))
-
-(deferr object-not-simple-array-complex-double-float-error (object)
- (error 'type-error
- :datum object
- :expected-type '(simple-array (complex double-float) (*))))
-
-#!+long-float
-(deferr object-not-simple-array-complex-long-float-error (object)
- (error 'type-error
- :datum object
- :expected-type '(simple-array (complex long-float) (*))))
+ :datum object
+ :expected-type '(unsigned-byte 32)))
+
+(deferr tls-exhausted-error ()
+ ;; There is nothing we can do about it. A number of entries in the
+ ;; tls could be reserved and made available for recovery but since
+ ;; tls indices are never reused it would be kind of silly and
+ ;; without it signalling an error is more than likely to end in a
+ ;; recursive error.
+ (%primitive print "Thread local storage exhausted.")
+ (sb!impl::%halt))
+
+(macrolet
+ ((define-simple-array-internal-errors ()
+ `(progn
+ ,@(map 'list
+ (lambda (saetp)
+ `(deferr ,(symbolicate
+ "OBJECT-NOT-"
+ (sb!vm:saetp-primitive-type-name saetp)
+ "-ERROR")
+ (object)
+ (error 'type-error
+ :datum object
+ :expected-type '(simple-array
+ ,(sb!vm:saetp-specifier saetp)
+ (*)))))
+ sb!vm:*specialized-array-element-type-properties*))))
+ (define-simple-array-internal-errors))