0.7.13.21:
[sbcl.git] / src / compiler / generic / late-type-vops.lisp
1 ;;;; generic type testing and checking VOPs
2
3 ;;;; This software is part of the SBCL system. See the README file for
4 ;;;; more information.
5 ;;;;
6 ;;;; This software is derived from the CMU CL system, which was
7 ;;;; written at Carnegie Mellon University and released into the
8 ;;;; public domain. The software is in the public domain and is
9 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
10 ;;;; files for more information.
11 (in-package "SB!VM")
12 \f
13 (!define-type-vops fixnump check-fixnum fixnum object-not-fixnum-error
14   (even-fixnum-lowtag odd-fixnum-lowtag)
15   ;; we can save a register on the x86.
16   :variant simple
17   ;; we can save a couple of instructions and a branch on the ppc.
18   ;; FIXME: make this be FIXNUM-MASK
19   :mask 3)
20
21 (!define-type-vops functionp check-fun function object-not-fun-error
22   (fun-pointer-lowtag)
23   :mask lowtag-mask)
24
25 (!define-type-vops listp check-list list object-not-list-error
26   (list-pointer-lowtag)
27   :mask lowtag-mask)
28
29 (!define-type-vops %instancep check-instance instance object-not-instance-error
30   (instance-pointer-lowtag)
31   :mask lowtag-mask)
32
33 (!define-type-vops bignump check-bignum bignum object-not-bignum-error
34   (bignum-widetag))
35
36 (!define-type-vops ratiop check-ratio ratio object-not-ratio-error
37   (ratio-widetag))
38
39 (!define-type-vops complexp check-complex complex object-not-complex-error
40   (complex-widetag complex-single-float-widetag complex-double-float-widetag
41                    #!+long-float complex-long-float-widetag))
42
43 (!define-type-vops complex-rational-p check-complex-rational nil
44     object-not-complex-rational-error
45   (complex-widetag))
46
47 (!define-type-vops complex-float-p check-complex-float nil
48     object-not-complex-float-error
49   (complex-single-float-widetag complex-double-float-widetag
50                                 #!+long-float complex-long-float-widetag))
51
52 (!define-type-vops complex-single-float-p check-complex-single-float complex-single-float
53     object-not-complex-single-float-error
54   (complex-single-float-widetag))
55
56 (!define-type-vops complex-double-float-p check-complex-double-float complex-double-float
57     object-not-complex-double-float-error
58   (complex-double-float-widetag))
59
60 #!+long-float
61 (!define-type-vops complex-long-float-p check-complex-long-float complex-long-float
62     object-not-complex-long-float-error
63   (complex-long-float-widetag))
64
65 (!define-type-vops single-float-p check-single-float single-float
66     object-not-single-float-error
67   (single-float-widetag))
68
69 (!define-type-vops double-float-p check-double-float double-float
70     object-not-double-float-error
71   (double-float-widetag))
72
73 #!+long-float
74 (!define-type-vops long-float-p check-long-float long-float
75     object-not-long-float-error
76   (long-float-widetag))
77
78 (!define-type-vops simple-string-p check-simple-string simple-string
79     object-not-simple-string-error
80   (simple-string-widetag))
81
82 (!define-type-vops simple-bit-vector-p check-simple-bit-vector simple-bit-vector
83     object-not-simple-bit-vector-error
84   (simple-bit-vector-widetag))
85
86 (!define-type-vops simple-vector-p check-simple-vector simple-vector
87     object-not-simple-vector-error
88   (simple-vector-widetag))
89
90 (!define-type-vops simple-array-nil-p
91                    check-simple-array-nil
92                    simple-array-nil
93                    object-not-simple-array-nil-error
94   (simple-array-nil-widetag))
95                    
96 (!define-type-vops simple-array-unsigned-byte-2-p
97       check-simple-array-unsigned-byte-2
98       simple-array-unsigned-byte-2
99     object-not-simple-array-unsigned-byte-2-error
100   (simple-array-unsigned-byte-2-widetag))
101
102 (!define-type-vops simple-array-unsigned-byte-4-p
103       check-simple-array-unsigned-byte-4
104       simple-array-unsigned-byte-4
105     object-not-simple-array-unsigned-byte-4-error
106   (simple-array-unsigned-byte-4-widetag))
107
108 (!define-type-vops simple-array-unsigned-byte-8-p
109       check-simple-array-unsigned-byte-8
110       simple-array-unsigned-byte-8
111     object-not-simple-array-unsigned-byte-8-error
112   (simple-array-unsigned-byte-8-widetag))
113
114 (!define-type-vops simple-array-unsigned-byte-16-p
115       check-simple-array-unsigned-byte-16
116       simple-array-unsigned-byte-16
117     object-not-simple-array-unsigned-byte-16-error
118   (simple-array-unsigned-byte-16-widetag))
119
120 (!define-type-vops simple-array-unsigned-byte-32-p
121       check-simple-array-unsigned-byte-32
122       simple-array-unsigned-byte-32
123     object-not-simple-array-unsigned-byte-32-error
124   (simple-array-unsigned-byte-32-widetag))
125
126 (!define-type-vops simple-array-signed-byte-8-p
127       check-simple-array-signed-byte-8
128       simple-array-signed-byte-8
129     object-not-simple-array-signed-byte-8-error
130   (simple-array-signed-byte-8-widetag))
131
132 (!define-type-vops simple-array-signed-byte-16-p
133       check-simple-array-signed-byte-16
134       simple-array-signed-byte-16
135     object-not-simple-array-signed-byte-16-error
136   (simple-array-signed-byte-16-widetag))
137
138 (!define-type-vops simple-array-signed-byte-30-p
139       check-simple-array-signed-byte-30
140       simple-array-signed-byte-30
141     object-not-simple-array-signed-byte-30-error
142   (simple-array-signed-byte-30-widetag))
143
144 (!define-type-vops simple-array-signed-byte-32-p
145       check-simple-array-signed-byte-32
146       simple-array-signed-byte-32
147     object-not-simple-array-signed-byte-32-error
148   (simple-array-signed-byte-32-widetag))
149
150 (!define-type-vops simple-array-single-float-p check-simple-array-single-float
151       simple-array-single-float
152     object-not-simple-array-single-float-error
153   (simple-array-single-float-widetag))
154
155 (!define-type-vops simple-array-double-float-p check-simple-array-double-float
156       simple-array-double-float
157     object-not-simple-array-double-float-error
158   (simple-array-double-float-widetag))
159
160 #!+long-float
161 (!define-type-vops simple-array-long-float-p check-simple-array-long-float
162       simple-array-long-float
163     object-not-simple-array-long-float-error
164   (simple-array-long-float-widetag))
165
166 (!define-type-vops simple-array-complex-single-float-p
167       check-simple-array-complex-single-float
168       simple-array-complex-single-float
169     object-not-simple-array-complex-single-float-error
170   (simple-array-complex-single-float-widetag))
171
172 (!define-type-vops simple-array-complex-double-float-p
173       check-simple-array-complex-double-float
174       simple-array-complex-double-float
175     object-not-simple-array-complex-double-float-error
176   (simple-array-complex-double-float-widetag))
177
178 #!+long-float
179 (!define-type-vops simple-array-complex-long-float-p
180       check-simple-array-complex-long-float
181       simple-array-complex-long-float
182     object-not-simple-array-complex-long-float-error
183   (simple-array-complex-long-float-widetag))
184
185 (!define-type-vops base-char-p check-base-char base-char
186     object-not-base-char-error
187   (base-char-widetag))
188
189 (!define-type-vops system-area-pointer-p check-system-area-pointer
190       system-area-pointer
191     object-not-sap-error
192   (sap-widetag))
193
194 (!define-type-vops weak-pointer-p check-weak-pointer weak-pointer
195     object-not-weak-pointer-error
196   (weak-pointer-widetag))
197
198 (!define-type-vops code-component-p nil nil nil
199   (code-header-widetag))
200
201 (!define-type-vops lra-p nil nil nil
202   (return-pc-header-widetag))
203
204 (!define-type-vops fdefn-p nil nil nil
205   (fdefn-widetag))
206
207 (!define-type-vops funcallable-instance-p nil nil nil
208   (funcallable-instance-header-widetag))
209
210 (!define-type-vops array-header-p nil nil nil
211   (simple-array-widetag complex-string-widetag complex-bit-vector-widetag
212                         complex-vector-widetag complex-array-widetag))
213
214 (!define-type-vops stringp check-string nil object-not-string-error
215   (simple-string-widetag complex-string-widetag))
216
217 (!define-type-vops bit-vector-p check-bit-vector nil
218     object-not-bit-vector-error
219   (simple-bit-vector-widetag complex-bit-vector-widetag))
220
221 (!define-type-vops vectorp check-vector nil object-not-vector-error
222   (simple-string-widetag
223    simple-array-nil-widetag
224    simple-bit-vector-widetag
225    simple-vector-widetag
226    simple-array-unsigned-byte-2-widetag
227    simple-array-unsigned-byte-4-widetag
228    simple-array-unsigned-byte-8-widetag
229    simple-array-unsigned-byte-16-widetag
230    simple-array-unsigned-byte-32-widetag
231    simple-array-signed-byte-8-widetag
232    simple-array-signed-byte-16-widetag
233    simple-array-signed-byte-30-widetag
234    simple-array-signed-byte-32-widetag
235    simple-array-single-float-widetag
236    simple-array-double-float-widetag
237    #!+long-float simple-array-long-float-widetag
238    simple-array-complex-single-float-widetag
239    simple-array-complex-double-float-widetag
240    #!+long-float simple-array-complex-long-float-widetag
241    complex-string-widetag
242    complex-bit-vector-widetag
243    complex-vector-widetag))
244
245 ;;; Note that this "type VOP" is sort of an oddball; it doesn't so
246 ;;; much test for a Lisp-level type as just expose a low-level type
247 ;;; code at the Lisp level. It is used as a building block to help us
248 ;;; to express things like the test for (TYPEP FOO '(VECTOR T))
249 ;;; efficiently in Lisp code, but it doesn't correspond to any type
250 ;;; expression which would actually occur in reasonable application
251 ;;; code. (Common Lisp doesn't have any natural way of expressing this
252 ;;; type.) Thus, there's no point in building up the full machinery of
253 ;;; associated backend type predicates and so forth as we do for
254 ;;; ordinary type VOPs.
255 (!define-type-vops complex-vector-p check-complex-vector nil
256     object-not-complex-vector-error
257   (complex-vector-widetag))
258
259 (!define-type-vops simple-array-p check-simple-array nil
260     object-not-simple-array-error
261   (simple-array-widetag
262    simple-string-widetag
263    simple-array-nil-widetag
264    simple-bit-vector-widetag
265    simple-vector-widetag
266    simple-array-unsigned-byte-2-widetag
267    simple-array-unsigned-byte-4-widetag
268    simple-array-unsigned-byte-8-widetag
269    simple-array-unsigned-byte-16-widetag
270    simple-array-unsigned-byte-32-widetag
271    simple-array-signed-byte-8-widetag
272    simple-array-signed-byte-16-widetag
273    simple-array-signed-byte-30-widetag
274    simple-array-signed-byte-32-widetag
275    simple-array-single-float-widetag
276    simple-array-double-float-widetag
277    #!+long-float simple-array-long-float-widetag
278    simple-array-complex-single-float-widetag
279    simple-array-complex-double-float-widetag
280    #!+long-float simple-array-complex-long-float-widetag))
281
282 (!define-type-vops arrayp check-array nil object-not-array-error
283   (simple-array-widetag
284    simple-string-widetag
285    simple-array-nil-widetag
286    simple-bit-vector-widetag
287    simple-vector-widetag
288    simple-array-unsigned-byte-2-widetag
289    simple-array-unsigned-byte-4-widetag
290    simple-array-unsigned-byte-8-widetag
291    simple-array-unsigned-byte-16-widetag
292    simple-array-unsigned-byte-32-widetag
293    simple-array-signed-byte-8-widetag
294    simple-array-signed-byte-16-widetag
295    simple-array-signed-byte-30-widetag
296    simple-array-signed-byte-32-widetag
297    simple-array-single-float-widetag
298    simple-array-double-float-widetag
299    #!+long-float simple-array-long-float-widetag
300    simple-array-complex-single-float-widetag
301    simple-array-complex-double-float-widetag
302    #!+long-float simple-array-complex-long-float-widetag
303    complex-string-widetag
304    complex-bit-vector-widetag
305    complex-vector-widetag
306    complex-array-widetag))
307
308 (!define-type-vops numberp check-number nil object-not-number-error
309   (even-fixnum-lowtag
310    odd-fixnum-lowtag
311    bignum-widetag
312    ratio-widetag
313    single-float-widetag
314    double-float-widetag
315    #!+long-float long-float-widetag
316    complex-widetag
317    complex-single-float-widetag
318    complex-double-float-widetag
319    #!+long-float complex-long-float-widetag))
320
321 (!define-type-vops rationalp check-rational nil object-not-rational-error
322   (even-fixnum-lowtag odd-fixnum-lowtag ratio-widetag bignum-widetag))
323
324 (!define-type-vops integerp check-integer nil object-not-integer-error
325   (even-fixnum-lowtag odd-fixnum-lowtag bignum-widetag))
326
327 (!define-type-vops floatp check-float nil object-not-float-error
328   (single-float-widetag double-float-widetag #!+long-float long-float-widetag))
329
330 (!define-type-vops realp check-real nil object-not-real-error
331   (even-fixnum-lowtag
332    odd-fixnum-lowtag
333    ratio-widetag
334    bignum-widetag
335    single-float-widetag
336    double-float-widetag
337    #!+long-float long-float-widetag))