Use SB!IMPL as the implementation package for PARSE-BODY
[sbcl.git] / src / code / early-raw-slots.lisp
blob58f317af6b5ebd2f48e4b7001737daa33409925b
1 ;;;; This software is part of the SBCL system. See the README file for
2 ;;;; more information.
3 ;;;;
4 ;;;; This software is derived from the CMU CL system, which was
5 ;;;; written at Carnegie Mellon University and released into the
6 ;;;; public domain. The software is in the public domain and is
7 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
8 ;;;; files for more information.
10 (in-package "SB!KERNEL")
12 ;;; This file has to be loaded during cold-init as early as you'd like to
13 ;;; have any defstructs that use raw slots. %COMPILER-DEFSTRUCT needs the
14 ;;; raw-slot-data-list both at compile-time and load-time.
16 ;;; STRUCTURE-OBJECT supports two different strategies to place raw slots
17 ;;; (containing "just bits", not Lisp descriptors) within it in a way
18 ;;; that GC has knowledge of. No backend supports both strategies though.
20 ;;; The older strategy is "non-interleaved".
21 ;;; Consider a structure of 3 tagged slots (A,B,C) and 2 raw slots,
22 ;;; where (for simplicity) each raw slot takes space equal to one Lisp word.
23 ;;; (In general raw slots can take >1 word)
24 ;;; Lisp code arranges so that raw slots are last.
25 ;;; Word offsets are listed on the left
26 ;;; 0 : header = (instance-length << 8) | instance-header-widetag
27 ;;; 1 : dsd-index 0 = ptr to LAYOUT
28 ;;; 2 : dsd-index 1 = tagged slot A
29 ;;; 3 : dsd-index 2 = ... B
30 ;;; 4 : dsd-index 3 = ... C
31 ;;; 5 : filler
32 ;;; 6 : dsd-index 1 = second raw slot
33 ;;; 7 : dsd-index 0 = first raw slot
34 ;;;
35 ;;; Note that numbering of raw slots with respect to their DSD-INDEX
36 ;;; restarts at 0, so there are two "spaces" of dsd-indices, the non-raw
37 ;;; and the raw space. Also note that filler was added in the middle, so
38 ;;; that adding INSTANCE-LENGTH to the object's address always gets you
39 ;;; to exactly the 0th raw slot. The filler can't be squeezed out, because
40 ;;; all Lisp objects must consume an even number of words, and the length
41 ;;; of an instance reflects the number of physical - not logical - words
42 ;;; that follow the instance header.
43 ;;;
44 ;;; This strategy for placement of raw slots is easy for GC because GC's
45 ;;; view of an instance is simply some number of boxed words followed by
46 ;;; some number of ignored words.
47 ;;; However, this strategy presents a difficulty for Lisp in that a raw
48 ;;; slot at a given index is not at a fixed offset relative to the base of
49 ;;; the object - it is fixed relative to the _last_ word of the object.
50 ;;; This has to do with the requirement that structure accessors defined by
51 ;;; a parent type work correctly on a descendant type, while preserving the
52 ;;; simple-for-GC aspect. If another DEFSTRUCT says to :INCLUDE the above,
53 ;;; adding two more tagged slots D and E, the slot named D occupies word 5
54 ;;; ('filler' above), E occupies word 6, and the two raw slots shift down.
55 ;;; To read raw slot at index N requires adding to the object pointer
56 ;;; the number of words represented by instance-length and subtracting the
57 ;;; raw slot index.
58 ;;; Aside from instance-length, the only additional piece of information
59 ;;; that GC needs to know to scavenge a structure is the number of raw slots,
60 ;;; which is obtained from the object's layout in the N-UNTAGGED-SLOTS slot.
62 ;;; Assuming that it is more important to simplify runtime access than
63 ;;; to simplify GC, we can use the newer strategy, "interleaved" raw slots.
64 ;;; Interleaving freely intermingles tagged data with untagged data
65 ;;; following the layout. This permits descendant structures to add
66 ;;; slots of any kind to the end without changing any physical placement
67 ;;; that was already determined, and eliminates the runtime computation
68 ;;; of the offset to raw slots. It is also generally easier to understand.
69 ;;; The trade-off is that GC (and a few other things - structure dumping,
70 ;;; EQUALP checking, to name a few) have to be able to determine for each
71 ;;; slot whether it is a Lisp descriptor or just bits. This is done
72 ;;; with the LAYOUT-UNTAGGED-BITMAP of an object's layout.
73 ;;; The bitmap stores a '1' for each bit representing a raw word,
74 ;;; and could be a BIGNUM given a spectacularly huge structure.
76 ;;; Also note that in both strategies there are possibly some alignment
77 ;;; concerns which must be accounted for when DEFSTRUCT lays out slots,
78 ;;; by injecting padding words appropriately.
79 ;;; For example COMPLEX-DOUBLE-FLOAT *should* be aligned to twice the
80 ;;; alignment of a DOUBLE-FLOAT. It is not, as things stand,
81 ;;; but this is considered a minor bug.
82 ;;; Interleaving is supported only on x86-64, but porting should be
83 ;;; straightforward, because if anything the VOPs become simpler.
85 ;; To utilize a word-sized slot in a defstruct without having to resort to
86 ;; writing (myslot :type (unsigned-byte #.sb!vm:n-word-bits)), or even
87 ;; worse (:type #+sb-xc-host <sometype> #-sb-xc-host <othertype>),
88 ;; these abstractions are provided as soon as the raw slots defs are.
89 ;; 'signed-word' is here for companionship - slots of that type are not raw.
90 (def!type sb!vm:word () `(unsigned-byte ,sb!vm:n-word-bits))
91 (def!type sb!vm:signed-word () `(signed-byte ,sb!vm:n-word-bits))
93 ;; These definitions pertain to how a LAYOUT stores the raw-slot metadata,
94 ;; and we need them before 'class.lisp' is compiled (why, I'm can't remember).
95 ;; LAYOUT-RAW-SLOT-METADATA is an abstraction over whichever kind of
96 ;; metadata we have - it will be one or the other.
97 #!-interleaved-raw-slots
98 (progn (deftype layout-raw-slot-metadata-type () 'index)
99 (defmacro layout-raw-slot-metadata (x) `(layout-n-untagged-slots ,x)))
100 ;; It would be possible to represent an unlimited number of trailing untagged
101 ;; slots (maybe) without consing a bignum if we wished to allow signed integers
102 ;; for the raw slot bitmap, but that's probably confusing and pointless, so...
103 #!+interleaved-raw-slots
104 (progn (deftype layout-raw-slot-metadata-type () 'unsigned-byte)
105 (defmacro layout-raw-slot-metadata (x) `(layout-untagged-bitmap ,x)))
107 ;; information about how a slot of a given DSD-RAW-TYPE is to be accessed
108 (defstruct (raw-slot-data
109 (:copier nil)
110 (:predicate nil))
111 ;; the raw slot type, or T for a non-raw slot
113 ;; (Non-raw slots are in the ordinary place you'd expect, directly
114 ;; indexed off the instance pointer. Raw slots are indexed from the end
115 ;; of the instance and skipped by GC.)
116 (raw-type (missing-arg) :type (or symbol cons) :read-only t)
117 ;; What operator is used to access a slot of this type?
118 (accessor-name (missing-arg) :type symbol :read-only t)
119 (init-vop (missing-arg) :type symbol :read-only t)
120 ;; How many words are each value of this type?
121 (n-words (missing-arg) :type (and index (integer 1)) :read-only t)
122 ;; Necessary alignment in units of words. Note that instances
123 ;; themselves are aligned by exactly two words, so specifying more
124 ;; than two words here would not work.
125 (alignment 1 :type (integer 1 2) :read-only t)
126 (comparer (missing-arg) :type function :read-only t))
128 #!-sb-fluid (declaim (freeze-type raw-slot-data))
130 ;; Simulate DEFINE-LOAD-TIME-GLOBAL - always bound in the image
131 ;; but not eval'd in the compiler.
132 (defglobal *raw-slot-data-list* nil)
133 (defun !raw-slot-data-init ()
134 (macrolet ((make-comparer (accessor-name)
135 #+sb-xc-host
136 `(lambda (x y)
137 (declare (ignore x y))
138 (error "~S comparator called" ',accessor-name))
139 #-sb-xc-host
140 ;; Not a symbol, because there aren't any so-named functions.
141 `(named-lambda ,(string (symbolicate accessor-name "="))
142 (index x y)
143 (declare (optimize speed (safety 0)))
144 (= (,accessor-name x index)
145 (,accessor-name y index)))))
146 (let ((double-float-alignment
147 ;; white list of architectures that can load unaligned doubles:
148 #!+(or x86 x86-64 ppc) 1
149 ;; at least sparc, mips and alpha can't:
150 #!-(or x86 x86-64 ppc) 2))
151 (setq *raw-slot-data-list*
152 (list
153 (make-raw-slot-data :raw-type 'sb!vm:word
154 :accessor-name '%raw-instance-ref/word
155 :init-vop 'sb!vm::raw-instance-init/word
156 :n-words 1
157 :comparer (make-comparer %raw-instance-ref/word))
158 (make-raw-slot-data :raw-type 'single-float
159 :accessor-name '%raw-instance-ref/single
160 :init-vop 'sb!vm::raw-instance-init/single
161 ;; KLUDGE: On 64 bit architectures, we
162 ;; could pack two SINGLE-FLOATs into the
163 ;; same word if raw slots were indexed
164 ;; using bytes instead of words. However,
165 ;; I don't personally find optimizing
166 ;; SINGLE-FLOAT memory usage worthwile
167 ;; enough. And the other datatype that
168 ;; would really benefit is (UNSIGNED-BYTE
169 ;; 32), but that is a subtype of FIXNUM, so
170 ;; we store it unraw anyway. :-( -- DFL
171 :n-words 1
172 :comparer (make-comparer %raw-instance-ref/single))
173 (make-raw-slot-data :raw-type 'double-float
174 :accessor-name '%raw-instance-ref/double
175 :init-vop 'sb!vm::raw-instance-init/double
176 :alignment double-float-alignment
177 :n-words (/ 8 sb!vm:n-word-bytes)
178 :comparer (make-comparer %raw-instance-ref/double))
179 (make-raw-slot-data :raw-type 'complex-single-float
180 :accessor-name '%raw-instance-ref/complex-single
181 :init-vop 'sb!vm::raw-instance-init/complex-single
182 :n-words (/ 8 sb!vm:n-word-bytes)
183 :comparer (make-comparer %raw-instance-ref/complex-single))
184 (make-raw-slot-data :raw-type 'complex-double-float
185 :accessor-name '%raw-instance-ref/complex-double
186 :init-vop 'sb!vm::raw-instance-init/complex-double
187 :alignment double-float-alignment
188 :n-words (/ 16 sb!vm:n-word-bytes)
189 :comparer (make-comparer %raw-instance-ref/complex-double))
190 #!+long-float
191 (make-raw-slot-data :raw-type long-float
192 :accessor-name '%raw-instance-ref/long
193 :init-vop 'sb!vm::raw-instance-init/long
194 :n-words #!+x86 3 #!+sparc 4
195 :comparer (make-comparer %raw-instance-ref/long))
196 #!+long-float
197 (make-raw-slot-data :raw-type complex-long-float
198 :accessor-name '%raw-instance-ref/complex-long
199 :init-vop 'sb!vm::raw-instance-init/complex-long
200 :n-words #!+x86 6 #!+sparc 8
201 :comparer (make-comparer %raw-instance-ref/complex-long)))))))
203 #+sb-xc-host (!raw-slot-data-init)
205 (declaim (ftype (sfunction (symbol) raw-slot-data) raw-slot-data-or-lose))
206 (defun raw-slot-data-or-lose (type)
207 (or (car (member type *raw-slot-data-list* :key #'raw-slot-data-raw-type))
208 (error "Invalid raw slot type: ~S" type)))
210 (defun raw-slot-words (type)
211 (raw-slot-data-n-words (raw-slot-data-or-lose type)))
213 ;; DO-INSTANCE-TAGGED-SLOT iterates over the manifest slots of THING
214 ;; that contain tagged objects. (The LAYOUT does not count as a manifest slot).
215 ;; INDEX-VAR is bound to successive slot-indices,
216 ;; and is usually used as the second argument to %INSTANCE-REF.
217 ;; EXCLUDE-PADDING, if T, skips a final word that may be present
218 ;; at the end of the structure due to alignment requirements.
219 ;; LAYOUT is optional and somewhat unnecessary, but since some uses of
220 ;; this macro already have a layout in hand, it can be supplied.
221 ;; [If the compiler were smarter about doing fewer memory accesses,
222 ;; there would be no need at all for the LAYOUT - if it had already been
223 ;; accessed, it shouldn't be another memory read]
224 ;; * CAUTION: with a STANDARD-OBJECT you MUST NOT specify :EXCLUDE-PADDING T
225 ;; because that equates to using LAYOUT-LENGTH rather than %INSTANCE-LENGTH
226 ;; to compute the upper bound, but LAYOUT-LENGTH of a STANDARD-OBJECT
227 ;; is not pertinent to the number of storage cells in the primitive object.
229 (defmacro do-instance-tagged-slot ((index-var thing &key (layout nil layout-p)
230 exclude-padding)
231 &body body)
232 (with-unique-names (instance n-layout limit bitmap)
233 (declare (ignorable bitmap))
234 (let ((end-expr (if exclude-padding
235 `(layout-length ,n-layout)
236 `(%instance-length ,instance))))
237 `(let* (,@(if (and layout-p exclude-padding) nil `((,instance ,thing)))
238 (,n-layout ,(or layout `(%instance-layout ,instance))))
239 #!+interleaved-raw-slots
240 (do ((,bitmap (layout-untagged-bitmap ,n-layout))
241 (,index-var sb!vm:instance-data-start (1+ ,index-var))
242 (,limit ,end-expr))
243 ((>= ,index-var ,limit))
244 (declare (type index ,index-var))
245 (unless (logbitp ,index-var ,bitmap)
246 ,@body))
247 #!-interleaved-raw-slots
248 (do ((,index-var 1 (1+ ,index-var))
249 (,limit (- ,end-expr (layout-n-untagged-slots ,n-layout))))
250 ((>= ,index-var ,limit))
251 (declare (type index ,index-var))
252 ,@body)))))