1 ;;;; This software is part of the SBCL system. See the README file for
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 ;;; STRUCTURE-OBJECT supports placement of raw bits within the object
13 ;;; to allow representation of native word and float-point types directly.
15 ;;; Historically the implementation was optimized for GC by placing all
16 ;;; such slots at the end of the instance, and scavenging only up to last
17 ;;; non-raw slot. This imposed significant overhead for access from Lisp,
18 ;;; because "is-a" inheritance was obliged to rearrange raw slots
19 ;;; to comply with the GC requirement, thus forcing ancestor structure
20 ;;; accessors to compensate for physical structure length in all cases.
21 ;;; Assuming that it is more important to simplify Lisp access than
22 ;;; to simplify GC, we use a more flexible strategy that permits
23 ;;; descendant structures to place new slots anywhere without changing
24 ;;; slot placement established in ancestor structures.
25 ;;; The trade-off is that GC (and a few other things - structure dumping,
26 ;;; EQUALP checking, to name a few) have to be able to determine for each
27 ;;; slot whether it is a Lisp descriptor or just bits. This is done
28 ;;; with the LAYOUT-BITMAP of an object's layout.
29 ;;; The bitmap stores a '1' for each bit representing a raw word,
30 ;;; and could be a BIGNUM given a spectacularly huge structure.
32 ;;; Also note that there are possibly some alignment concerns which must
33 ;;; be accounted for when DEFSTRUCT lays out slots,
34 ;;; by injecting padding words appropriately.
35 ;;; For example COMPLEX-DOUBLE-FLOAT *should* be aligned to twice the
36 ;;; alignment of a DOUBLE-FLOAT. It is not, as things stand,
37 ;;; but this is considered a minor bug.
39 ;; To utilize a word-sized slot in a defstruct without having to resort to
40 ;; writing (myslot :type (unsigned-byte #.sb!vm:n-word-bits)), or even
41 ;; worse (:type #+sb-xc-host <sometype> #-sb-xc-host <othertype>),
42 ;; these abstractions are provided as soon as the raw slots defs are.
43 ;; 'signed-word' is here for companionship - slots of that type are not raw.
44 (def!type sb
!vm
:word
() `(unsigned-byte ,sb
!vm
:n-word-bits
))
45 (def!type sb
!vm
:signed-word
() `(signed-byte ,sb
!vm
:n-word-bits
))
47 ;; information about how a slot of a given DSD-RAW-TYPE is to be accessed
48 (defstruct (raw-slot-data
51 ;; the type specifier, which must specify a numeric type.
52 (raw-type (missing-arg) :type symbol
:read-only t
)
53 ;; What operator is used to access a slot of this type?
54 (accessor-name (missing-arg) :type symbol
:read-only t
)
55 (init-vop (missing-arg) :type symbol
:read-only t
)
56 ;; How many words are each value of this type?
57 (n-words (missing-arg) :type
(and index
(integer 1)) :read-only t
)
58 ;; Necessary alignment in units of words. Note that instances
59 ;; themselves are aligned by exactly two words, so specifying more
60 ;; than two words here would not work.
61 (alignment 1 :type
(integer 1 2) :read-only t
)
62 (comparer (missing-arg) :type function
:read-only t
))
64 #!-sb-fluid
(declaim (freeze-type raw-slot-data
))
66 ;; Simulate DEFINE-LOAD-TIME-GLOBAL - always bound in the image
67 ;; but not eval'd in the compiler.
68 (defglobal *raw-slot-data
* nil
)
69 ;; By making this a cold-init function, it is possible to use raw slots
70 ;; in cold toplevel forms.
71 (defun !raw-slot-data-init
()
72 (macrolet ((make-comparer (accessor-name)
75 (declare (ignore x y
))
76 (error "~S comparator called" ',accessor-name
))
78 ;; Not a symbol, because there aren't any so-named functions.
79 `(named-lambda ,(string (symbolicate accessor-name
"="))
81 (declare (optimize speed
(safety 0)))
82 (= (,accessor-name x index
)
83 (,accessor-name y index
)))))
84 (let ((double-float-alignment
85 ;; white list of architectures that can load unaligned doubles:
86 #!+(or x86 x86-64 ppc arm64
) 1
87 ;; at least sparc, mips and alpha can't:
88 #!-
(or x86 x86-64 ppc arm64
) 2))
91 (make-raw-slot-data :raw-type
'sb
!vm
:word
92 :accessor-name
'%raw-instance-ref
/word
93 :init-vop
'sb
!vm
::raw-instance-init
/word
95 :comparer
(make-comparer %raw-instance-ref
/word
))
96 (make-raw-slot-data :raw-type
'single-float
97 :accessor-name
'%raw-instance-ref
/single
98 :init-vop
'sb
!vm
::raw-instance-init
/single
99 ;; KLUDGE: On 64 bit architectures, we
100 ;; could pack two SINGLE-FLOATs into the
101 ;; same word if raw slots were indexed
102 ;; using bytes instead of words. However,
103 ;; I don't personally find optimizing
104 ;; SINGLE-FLOAT memory usage worthwile
105 ;; enough. And the other datatype that
106 ;; would really benefit is (UNSIGNED-BYTE
107 ;; 32), but that is a subtype of FIXNUM, so
108 ;; we store it unraw anyway. :-( -- DFL
110 :comparer
(make-comparer %raw-instance-ref
/single
))
111 (make-raw-slot-data :raw-type
'double-float
112 :accessor-name
'%raw-instance-ref
/double
113 :init-vop
'sb
!vm
::raw-instance-init
/double
114 :alignment double-float-alignment
115 :n-words
(/ 8 sb
!vm
:n-word-bytes
)
116 :comparer
(make-comparer %raw-instance-ref
/double
))
117 (make-raw-slot-data :raw-type
'complex-single-float
118 :accessor-name
'%raw-instance-ref
/complex-single
119 :init-vop
'sb
!vm
::raw-instance-init
/complex-single
120 :n-words
(/ 8 sb
!vm
:n-word-bytes
)
121 :comparer
(make-comparer %raw-instance-ref
/complex-single
))
122 (make-raw-slot-data :raw-type
'complex-double-float
123 :accessor-name
'%raw-instance-ref
/complex-double
124 :init-vop
'sb
!vm
::raw-instance-init
/complex-double
125 :alignment double-float-alignment
126 :n-words
(/ 16 sb
!vm
:n-word-bytes
)
127 :comparer
(make-comparer %raw-instance-ref
/complex-double
))
129 (make-raw-slot-data :raw-type long-float
130 :accessor-name
'%raw-instance-ref
/long
131 :init-vop
'sb
!vm
::raw-instance-init
/long
132 :n-words
#!+x86
3 #!+sparc
4
133 :comparer
(make-comparer %raw-instance-ref
/long
))
135 (make-raw-slot-data :raw-type complex-long-float
136 :accessor-name
'%raw-instance-ref
/complex-long
137 :init-vop
'sb
!vm
::raw-instance-init
/complex-long
138 :n-words
#!+x86
6 #!+sparc
8
139 :comparer
(make-comparer %raw-instance-ref
/complex-long
)))))))
141 #+sb-xc-host
(!raw-slot-data-init
)
143 (declaim (type (simple-vector #.
(length *raw-slot-data
*)) *raw-slot-data
*))
145 ;; DO-INSTANCE-TAGGED-SLOT iterates over the manifest slots of THING
146 ;; that contain tagged objects. (The LAYOUT does not count as a manifest slot).
147 ;; INDEX-VAR is bound to successive slot-indices,
148 ;; and is usually used as the second argument to %INSTANCE-REF.
149 ;; :PAD, if T, includes a final word that may be present at the end of the
150 ;; structure due to alignment requirements.
151 ;; LAYOUT is optional and somewhat unnecessary, but since some uses of
152 ;; this macro already have a layout in hand, it can be supplied.
153 ;; [If the compiler were smarter about doing fewer memory accesses,
154 ;; there would be no need at all for the LAYOUT - if it had already been
155 ;; accessed, it shouldn't be another memory read]
157 (defmacro do-instance-tagged-slot
((index-var thing
&key layout
(pad t
)) &body body
)
158 (with-unique-names (instance bitmap limit
)
159 `(let* ((,instance
,thing
)
160 (,bitmap
(layout-bitmap ,(or layout
`(%instance-layout
,instance
))))
162 ;; target instances have an odd number of payload words.
163 `(logior (%instance-length
,instance
) #-sb-xc-host
1)
164 `(%instance-length
,instance
))))
165 (do ((,index-var sb
!vm
:instance-data-start
(1+ ,index-var
)))
166 ((>= ,index-var
,limit
))
167 (declare (type index
,index-var
))
168 (unless (logbitp ,index-var
,bitmap
)