[95729c]: src / compiler / generic / early-objdef.lisp Maximize Restore History

Download this file

early-objdef.lisp    260 lines (242 with data), 10.8 kB

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
;;;; type-based constants
;;;; This software is part of the SBCL system. See the README file for
;;;; more information.
;;;;
;;;; This software is derived from the CMU CL system, which was
;;;; written at Carnegie Mellon University and released into the
;;;; public domain. The software is in the public domain and is
;;;; provided with absolutely no warranty. See the COPYING and CREDITS
;;;; files for more information.
(in-package "SB!VM")
;;; Tags for the main low-level types are stored in the low n (usually three)
;;; bits to identify the type of a machine word. Certain constraints
;;; apply:
;;; * EVEN-FIXNUM-LOWTAG and ODD-FIXNUM-LOWTAG must be 0 and 4: code
;;; which shifts left two places to convert raw integers to tagged
;;; fixnums is ubiquitous.
;;; * LIST-POINTER-LOWTAG + N-WORD-BYTES = OTHER-POINTER-LOWTAG: NIL
;;; is both a cons and a symbol (at the same address) and depends on this.
;;; See the definition of SYMBOL in objdef.lisp
;;; * OTHER-POINTER-LOWTAG > 4: Some code in the SPARC backend,
;;; which uses bit 2 of the ALLOC register to indicate that
;;; PSEUDO-ATOMIC is on, doesn't strip the low bits of reg_ALLOC
;;; before ORing in OTHER-POINTER-LOWTAG within a PSEUDO-ATOMIC
;;; section.
;;; * OTHER-IMMEDIATE-0-LOWTAG are spaced 4 apart: various code wants to
;;; iterate through these
;;; * Allocation code on Alpha wants lowtags for heap-allocated
;;; objects to be odd.
;;; (These are just the ones we know about as of sbcl-0.7.1.22. There
;;; might easily be more, since these values have stayed highly
;;; constrained for more than a decade, an inviting target for
;;; inventive abstraction-phobic maintainers.:-)
;;;
;;; Another way to look at lowtags is that there is no one lowtag
;;; length. On 32-bit platforms, fixnums and other-immediates have a
;;; lowtag length of two bits, and pointers have a lowtag length of
;;; three bits. On 64-bit platforms, fixnums and pointers gain an
;;; extra bit, and six "pad" lowtags waste the extra encoding space so
;;; obtained.
;;;
;;; x00 -- fixnum
;;; x10 -- other-immediate
;;; 001 -- instance-pointer
;;; 011 -- list-pointer
;;; 101 -- fun-pointer
;;; 111 -- other-pointer
;;;
;;; If you change the tag layout, check the various functions in
;;; src/runtime/runtime.h to see if they need to be updated, along
;;; with print_obj() in src/runtime/print.c, possibly gc_init_tables()
;;; in src/runtime/gc-common-c and possibly the code in src/code/room.
(eval-when (:compile-toplevel :load-toplevel :execute)
;; The EVAL-WHEN is necessary (at least for Lispworks), because the
;; second DEFENUM uses the value of OTHER-IMMEDIATE-0-LOWTAG, which is
;; defined in the first DEFENUM. -- AL 20000216
#!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or))
(defenum ()
even-fixnum-lowtag
other-immediate-0-lowtag
pad0-lowtag
instance-pointer-lowtag
pad1-lowtag
other-immediate-1-lowtag
pad2-lowtag
list-pointer-lowtag
odd-fixnum-lowtag
other-immediate-2-lowtag
pad3-lowtag
fun-pointer-lowtag
pad4-lowtag
other-immediate-3-lowtag
pad5-lowtag
other-pointer-lowtag)
#!+#.(cl:if (cl:= 32 sb!vm:n-word-bits) '(and) '(or))
(defenum ()
even-fixnum-lowtag
instance-pointer-lowtag
other-immediate-0-lowtag
list-pointer-lowtag
odd-fixnum-lowtag
fun-pointer-lowtag
other-immediate-1-lowtag
other-pointer-lowtag))
(def!constant nil-value
(+ static-space-start n-word-bytes other-pointer-lowtag))
(defconstant-eqx fixnum-lowtags
#.(let ((fixtags nil))
(do-external-symbols (sym "SB!VM")
(let* ((name (symbol-name sym))
(len (length name)))
(when (and (boundp sym)
(integerp (symbol-value sym))
(> len 7)
(string= name "-LOWTAG" :start1 (- len 7))
(zerop (logand (symbol-value sym) fixnum-tag-mask)))
(push sym fixtags))))
`',(sort fixtags #'string< :key #'symbol-name))
#'equal)
;;; the heap types, stored in 8 bits of the header of an object on the
;;; heap, to identify the type of the heap object (which'll be at
;;; least two machine words, often more)
;;;
;;; Note: the order specified here is not critical for correctness,
;;; but (FIXME) with %TEST-HEADERS as currently defined, BIGNUM must
;;; be first, and COMPLEX-ARRAY must be last.
;;;
;;; However, for efficiency, we prefer contiguous sets of widetags for
;;; "similar" objects, so that type checking can be done with a range
;;; check, rather than several individual checks.
;;;
;;; * BIGNUM + RATIO (+ FIXNUM) = RATIONAL
;;;
;;; * SINGLE-FLOAT + DOUBLE-FLOAT + LONG-FLOAT = FLOAT
;;;
;;; * RATIONAL + FLOAT = REAL
;;;
;;; * (FIXME: COMPLEX example, which needs fixing anyway -- see
;;; UPGRADED-COMPLEX-PART-TYPE)
;;;
;;; * SIMPLE-ARRAY-* = (SIMPLE-ARRAY * (*))
;;;
;;; * SIMPLE-ARRAY-NIL + SIMPLE-BASE-STRING = SIMPLE-STRING
;;;
;;; * SIMPLE-ARRAY + COMPLEX-ARRAYOID = (SATISFIES ARRAY-HEADER-P)
;;;
;;; In addition, with
;;; sufficient care we can cause extra combinations to appear with
;;; differences in only one bit, permitting a more efficient type
;;; test. As an example, if SIMPLE-BASE-STRING = 0xA6 and
;;; COMPLEX-BASE-STRING = 0xE6, then the type test for BASE-STRING is
;;;
;;; AND tag, ~0x40, tag
;;; ANDcc tag, 0xA6, tag
;;; JNE tag, label
;;;
;;; rather than two separate tests and jumps
(defenum (;; The first widetag must be greater than SB!VM:LOWTAG-LIMIT
;; otherwise code in generic/early-type-vops will suffer
;; a long, horrible death. --njf, 2004-08-09
:start (+ (ash 1 n-lowtag-bits) other-immediate-0-lowtag)
:step 4)
;; NOTE: the binary numbers off to the side are only valid for 32-bit
;; ports; add #b1000 if you want to know the values for 64-bit ports.
;; And note that the numbers get a little scrambled further down.
;; --njf, 2004-08-09
bignum-widetag ; 00001010
ratio-widetag ; 00001110
single-float-widetag ; 00010010
double-float-widetag ; 00010110
complex-widetag ; 00011010
complex-single-float-widetag ; 00011110
complex-double-float-widetag ; 00100010
code-header-widetag ; 00100110
simple-fun-header-widetag ; 00101010
closure-header-widetag ; 00101110
funcallable-instance-header-widetag ; 00110010
return-pc-header-widetag ; 00110110
value-cell-header-widetag ; 00111010
symbol-header-widetag ; 00111110
character-widetag ; 01000010
sap-widetag ; 01000110
unbound-marker-widetag ; 01001010
weak-pointer-widetag ; 01001110
instance-header-widetag ; 01010010
fdefn-widetag ; 01010110
no-tls-value-marker-widetag ; 01011010
#!-sb-simd-pack
unused01-widetag
#!+sb-simd-pack
simd-pack-widetag ; 01011110
unused02-widetag ; 01100010
unused03-widetag ; 01100110
unused04-widetag ; 01101010
unused05-widetag ; 01101110
unused06-widetag ; 01110010
unused07-widetag ; 01110110
#!+#.(cl:if (cl:= 32 sb!vm:n-word-bits) '(and) '(or))
unused08-widetag ; 01111010
#!+#.(cl:if (cl:= 32 sb!vm:n-word-bits) '(and) '(or))
unused09-widetag ; 01111110
#!+#.(cl:if (cl:= 32 sb!vm:n-word-bits) '(and) '(or))
unused10-widetag ; 10000010
#!+#.(cl:if (cl:= 32 sb!vm:n-word-bits) '(and) '(or))
unused11-widetag ; 10000110
simple-array-widetag ; 10001010
simple-array-unsigned-byte-2-widetag ; 10001110
simple-array-unsigned-byte-4-widetag ; 10010010
simple-array-unsigned-byte-7-widetag ; 10010110
simple-array-unsigned-byte-8-widetag ; 10011010
simple-array-unsigned-byte-15-widetag ; 10011110
simple-array-unsigned-byte-16-widetag ; 10100010
#!+#.(cl:if (cl:= 32 sb!vm:n-word-bits) '(and) '(or))
simple-array-unsigned-fixnum-widetag ; 10100110
simple-array-unsigned-byte-31-widetag ; 10101010
simple-array-unsigned-byte-32-widetag ; 10101110
#!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or))
simple-array-unsigned-fixnum-widetag
#!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or))
simple-array-unsigned-byte-63-widetag
#!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or))
simple-array-unsigned-byte-64-widetag
simple-array-signed-byte-8-widetag ; 10110010
simple-array-signed-byte-16-widetag ; 10110110
#!+#.(cl:if (cl:= 32 sb!vm:n-word-bits) '(and) '(or))
simple-array-fixnum-widetag ; 10111010
simple-array-signed-byte-32-widetag ; 10111110
#!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or))
simple-array-fixnum-widetag
#!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or))
simple-array-signed-byte-64-widetag
simple-array-single-float-widetag ; 11000010
simple-array-double-float-widetag ; 11000110
simple-array-complex-single-float-widetag ; 11001010
simple-array-complex-double-float-widetag ; 11001110
simple-bit-vector-widetag ; 11010010
simple-vector-widetag ; 11010110
;; Strings
simple-array-nil-widetag ; 11011010
simple-base-string-widetag ; 11011110
#!+sb-unicode
simple-character-string-widetag
#!+sb-unicode
complex-character-string-widetag ; 11100110
complex-base-string-widetag ; 11101010
complex-vector-nil-widetag ; 11101110
complex-bit-vector-widetag ; 11110010
complex-vector-widetag ; 11110110
complex-array-widetag ; 11111010
#!+#.(cl:if (cl:= 32 sb!vm:n-word-bits) '(and) '(or))
unused12-widetag ; 11111110
#!+(and #.(cl:if (cl:= 32 sb!vm:n-word-bits) '(and) '(or))
(not sb-unicode))
unused13-widetag ; 11111010
#!+(and #.(cl:if (cl:= 32 sb!vm:n-word-bits) '(and) '(or))
(not sb-unicode))
unused14-widetag ; 11111110
)
;;; the different vector subtypes
(defenum ()
vector-normal-subtype
vector-unused-subtype
vector-valid-hashing-subtype)