1 ;;;; machine-independent aspects of the object representation
3 ;;;; This software is part of the SBCL system. See the README file for
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.
14 ;;;; KLUDGE: The primitive objects here may look like self-contained
15 ;;;; definitions, but in general they're not. In particular, if you
16 ;;;; try to add a slot to them, beware of the following:
17 ;;;; * The GC scavenging code (and for all I know other GC code too)
18 ;;;; is not automatically generated from these layouts, but instead
19 ;;;; was hand-written to correspond to them. The offsets are
20 ;;;; automatically propagated into the GC scavenging code, but the
21 ;;;; existence of slots, and whether they should be scavenged, is
22 ;;;; not automatically propagated. Thus e.g. if you add a
23 ;;;; SIMPLE-FUN-DEBUG-INFO slot holding a tagged object which needs
24 ;;;; to be GCed, you need to tweak scav_code_header() and
25 ;;;; verify_space() in gencgc.c, and the corresponding code in gc.c.
26 ;;;; * The src/runtime/print.c code (used by LDB) is implemented
27 ;;;; using hand-written lists of slot names, which aren't automatically
28 ;;;; generated from the code in this file.
29 ;;;; * Various code (e.g. STATIC-FSET in genesis.lisp) is hard-wired
30 ;;;; to know the name of the last slot of the object the code works
31 ;;;; with, and implicitly to know that the last slot is special (being
32 ;;;; the beginning of an arbitrary-length sequence of bytes following
33 ;;;; the fixed-layout slots).
34 ;;;; -- WHN 2001-12-29
36 ;;;; the primitive objects themselves
38 (define-primitive-object (cons :lowtag list-pointer-lowtag
40 (car :ref-trans car
:set-trans sb
!c
::%rplaca
:init
:arg
41 :cas-trans %compare-and-swap-car
)
42 (cdr :ref-trans cdr
:set-trans sb
!c
::%rplacd
:init
:arg
43 :cas-trans %compare-and-swap-cdr
))
45 (define-primitive-object (instance :lowtag instance-pointer-lowtag
46 :widetag instance-header-widetag
47 :alloc-trans %make-instance
)
50 (define-primitive-object (bignum :lowtag other-pointer-lowtag
51 :widetag bignum-widetag
52 :alloc-trans sb
!bignum
::%allocate-bignum
)
53 (digits :rest-p t
:c-type
#!-alpha
"long" #!+alpha
"u32"))
55 (define-primitive-object (ratio :type ratio
56 :lowtag other-pointer-lowtag
57 :widetag ratio-widetag
58 :alloc-trans %make-ratio
)
59 (numerator :type integer
60 :ref-known
(flushable movable
)
63 (denominator :type integer
64 :ref-known
(flushable movable
)
65 :ref-trans %denominator
68 #!+#.
(cl:if
(cl:= sb
!vm
:n-word-bits
32) '(and) '(or))
69 (define-primitive-object (single-float :lowtag other-pointer-lowtag
70 :widetag single-float-widetag
)
71 (value :c-type
"float"))
73 (define-primitive-object (double-float :lowtag other-pointer-lowtag
74 :widetag double-float-widetag
)
76 (value :c-type
"double" :length
#!-x86-64
2 #!+x86-64
1))
79 (define-primitive-object (long-float :lowtag other-pointer-lowtag
80 :widetag long-float-widetag
)
82 (value :c-type
"long double" :length
#!+x86
3 #!+sparc
4))
84 (define-primitive-object (complex :type complex
85 :lowtag other-pointer-lowtag
86 :widetag complex-widetag
87 :alloc-trans %make-complex
)
89 :ref-known
(flushable movable
)
93 :ref-known
(flushable movable
)
97 (define-primitive-object (array :lowtag other-pointer-lowtag
99 ;; FILL-POINTER of an ARRAY is in the same place as LENGTH of a
100 ;; VECTOR -- see SHRINK-VECTOR.
101 (fill-pointer :type index
102 :ref-trans %array-fill-pointer
103 :ref-known
(flushable foldable
)
104 :set-trans
(setf %array-fill-pointer
)
106 (fill-pointer-p :type
(member t nil
)
107 :ref-trans %array-fill-pointer-p
108 :ref-known
(flushable foldable
)
109 :set-trans
(setf %array-fill-pointer-p
)
111 (elements :type index
112 :ref-trans %array-available-elements
113 :ref-known
(flushable foldable
)
114 :set-trans
(setf %array-available-elements
)
117 :ref-trans %array-data-vector
118 :ref-known
(flushable foldable
)
119 :set-trans
(setf %array-data-vector
)
121 (displacement :type
(or index null
)
122 :ref-trans %array-displacement
123 :ref-known
(flushable foldable
)
124 :set-trans
(setf %array-displacement
)
127 :ref-trans %array-displaced-p
128 :ref-known
(flushable foldable
)
129 :set-trans
(setf %array-displaced-p
)
131 (displaced-from :type list
132 :ref-trans %array-displaced-from
133 :ref-known
(flushable)
134 :set-trans
(setf %array-displaced-from
)
136 (dimensions :rest-p t
))
138 (define-primitive-object (vector :type vector
139 :lowtag other-pointer-lowtag
141 ;; FILL-POINTER of an ARRAY is in the same place as LENGTH of a
142 ;; VECTOR -- see SHRINK-VECTOR.
143 (length :ref-trans sb
!c
::vector-length
145 (data :rest-p t
:c-type
#!-alpha
"unsigned long" #!+alpha
"u32"))
147 (define-primitive-object (code :type code-component
148 :lowtag other-pointer-lowtag
150 (code-size :type index
151 :ref-known
(flushable movable
)
152 :ref-trans %code-code-size
)
153 (entry-points :type
(or function null
)
154 :ref-known
(flushable)
155 :ref-trans %code-entry-points
157 :set-trans
(setf %code-entry-points
))
159 :ref-known
(flushable)
160 :ref-trans %code-debug-info
162 :set-trans
(setf %code-debug-info
))
164 (constants :rest-p t
))
166 (define-primitive-object (fdefn :type fdefn
167 :lowtag other-pointer-lowtag
168 :widetag fdefn-widetag
)
169 (name :ref-trans fdefn-name
)
170 (fun :type
(or function null
) :ref-trans fdefn-fun
)
171 (raw-addr :c-type
#!-alpha
"char *" #!+alpha
"u32"))
173 ;;; a simple function (as opposed to hairier things like closures
174 ;;; which are also subtypes of Common Lisp's FUNCTION type)
175 (define-primitive-object (simple-fun :type function
176 :lowtag fun-pointer-lowtag
177 :widetag simple-fun-header-widetag
)
178 #!-
(or x86 x86-64
) (self :ref-trans %simple-fun-self
179 :set-trans
(setf %simple-fun-self
))
180 #!+(or x86 x86-64
) (self
181 ;; KLUDGE: There's no :SET-KNOWN, :SET-TRANS, :REF-KNOWN, or
182 ;; :REF-TRANS here in this case. Instead, there's separate
183 ;; DEFKNOWN/DEFINE-VOP/DEFTRANSFORM stuff in
184 ;; compiler/x86/system.lisp to define and declare them by
185 ;; hand. I don't know why this is, but that's (basically)
186 ;; the way it was done in CMU CL, and it works. (It's not
187 ;; exactly the same way it was done in CMU CL in that CMU
188 ;; CL's allows duplicate DEFKNOWNs, blithely overwriting any
189 ;; previous data associated with the previous DEFKNOWN, and
190 ;; that property was used to mask the definitions here. In
191 ;; SBCL as of 0.6.12.64 that's not allowed -- too confusing!
192 ;; -- so we have to explicitly suppress the DEFKNOWNish
193 ;; stuff here in order to allow this old hack to work in the
194 ;; new world. -- WHN 2001-08-82
196 (next :type
(or function null
)
197 :ref-known
(flushable)
198 :ref-trans %simple-fun-next
200 :set-trans
(setf %simple-fun-next
))
201 (name :ref-known
(flushable)
202 :ref-trans %simple-fun-name
204 :set-trans
(setf %simple-fun-name
))
206 :ref-known
(flushable)
207 :ref-trans %simple-fun-arglist
209 :set-trans
(setf %simple-fun-arglist
))
210 (type :ref-known
(flushable)
211 :ref-trans %simple-fun-type
213 :set-trans
(setf %simple-fun-type
))
214 ;; NIL for empty, STRING for a docstring, SIMPLE-VECTOR for XREFS, and (CONS
215 ;; STRING SIMPLE-VECTOR) for both.
217 :ref-trans %simple-fun-info
218 :ref-known
(flushable)
219 :set-trans
(setf %simple-fun-info
)
221 ;; the SB!C::DEBUG-FUN object corresponding to this object, or NIL for none
222 #+nil
; FIXME: doesn't work (gotcha, lowly maintenoid!) See notes on bug 137.
223 (debug-fun :ref-known
(flushable)
224 :ref-trans %simple-fun-debug-fun
226 :set-trans
(setf %simple-fun-debug-fun
))
227 (code :rest-p t
:c-type
"unsigned char"))
229 (define-primitive-object (return-pc :lowtag other-pointer-lowtag
:widetag t
)
230 (return-point :c-type
"unsigned char" :rest-p t
))
232 (define-primitive-object (closure :lowtag fun-pointer-lowtag
233 :widetag closure-header-widetag
)
234 (fun :init
:arg
:ref-trans %closure-fun
)
237 (define-primitive-object (funcallable-instance
238 :lowtag fun-pointer-lowtag
239 :widetag funcallable-instance-header-widetag
240 :alloc-trans %make-funcallable-instance
)
241 (trampoline :init
:funcallable-instance-tramp
)
242 (function :ref-known
(flushable) :ref-trans %funcallable-instance-function
243 :set-known
(unsafe) :set-trans
(setf %funcallable-instance-function
))
246 (define-primitive-object (value-cell :lowtag other-pointer-lowtag
247 :widetag value-cell-header-widetag
248 ;; FIXME: We also have an explicit VOP
249 ;; for this. Is this needed as well?
250 :alloc-trans make-value-cell
)
251 (value :set-trans value-cell-set
253 :ref-trans value-cell-ref
254 :ref-known
(flushable)
258 (define-primitive-object (sap :lowtag other-pointer-lowtag
259 :widetag sap-widetag
)
261 (pointer :c-type
"char *" :length
2))
264 (define-primitive-object (sap :lowtag other-pointer-lowtag
265 :widetag sap-widetag
)
266 (pointer :c-type
"char *"))
269 (define-primitive-object (weak-pointer :type weak-pointer
270 :lowtag other-pointer-lowtag
271 :widetag weak-pointer-widetag
272 :alloc-trans make-weak-pointer
)
273 (value :ref-trans sb
!c
::%weak-pointer-value
:ref-known
(flushable)
275 (broken :type
(member t nil
)
276 :ref-trans sb
!c
::%weak-pointer-broken
:ref-known
(flushable)
278 (next :c-type
#!-alpha
"struct weak_pointer *" #!+alpha
"u32"))
280 ;;;; other non-heap data blocks
282 (define-primitive-object (binding)
286 (define-primitive-object (unwind-block)
287 (current-uwp :c-type
#!-alpha
"struct unwind_block *" #!+alpha
"u32")
288 (current-cont :c-type
#!-alpha
"lispobj *" #!+alpha
"u32")
289 #!-
(or x86 x86-64
) current-code
291 #!+win32 next-seh-frame
292 #!+win32 seh-frame-handler
)
294 (define-primitive-object (catch-block)
295 (current-uwp :c-type
#!-alpha
"struct unwind_block *" #!+alpha
"u32")
296 (current-cont :c-type
#!-alpha
"lispobj *" #!+alpha
"u32")
297 #!-
(or x86 x86-64
) current-code
299 #!+win32 next-seh-frame
300 #!+win32 seh-frame-handler
302 (previous-catch :c-type
#!-alpha
"struct catch_block *" #!+alpha
"u32"))
304 ;;; (For an explanation of this, see the comments at the definition of
305 ;;; KLUDGE-NONDETERMINISTIC-CATCH-BLOCK-SIZE.)
306 (aver (= kludge-nondeterministic-catch-block-size catch-block-size
))
310 (define-primitive-object (symbol :lowtag other-pointer-lowtag
311 :widetag symbol-header-widetag
312 :alloc-trans %make-symbol
)
314 ;; Beware when changing this definition. NIL-the-symbol is defined
315 ;; using this layout, and NIL-the-end-of-list-marker is the cons
316 ;; ( NIL . NIL ), living in the first two slots of NIL-the-symbol
317 ;; (conses have no header). Careful selection of lowtags ensures
318 ;; that the same pointer can be used for both purposes:
319 ;; OTHER-POINTER-LOWTAG is 7, LIST-POINTER-LOWTAG is 3, so if you
320 ;; subtract 3 from (SB-KERNEL:GET-LISP-OBJ-ADDRESS 'NIL) you get the
321 ;; first data slot, and if you subtract 7 you get a symbol header.
323 ;; also the CAR of NIL-as-end-of-list
324 (value :init
:unbound
325 :set-trans %set-symbol-global-value
327 ;; also the CDR of NIL-as-end-of-list. Its reffer needs special
328 ;; care for this reason, as hash values must be fixnums.
329 (hash :set-trans %set-symbol-hash
)
331 (plist :ref-trans symbol-plist
332 :set-trans %set-symbol-plist
333 :cas-trans %compare-and-swap-symbol-plist
336 (name :ref-trans symbol-name
:init
:arg
)
337 (package :ref-trans symbol-package
338 :set-trans %set-symbol-package
340 #!+sb-thread
(tls-index :ref-known
(flushable) :ref-trans symbol-tls-index
))
342 (define-primitive-object (complex-single-float
343 :lowtag other-pointer-lowtag
344 :widetag complex-single-float-widetag
)
346 (data :c-type
"struct { float data[2]; } ")
348 (real :c-type
"float")
350 (imag :c-type
"float"))
352 (define-primitive-object (complex-double-float
353 :lowtag other-pointer-lowtag
354 :widetag complex-double-float-widetag
)
356 (real :c-type
"double" :length
#!-x86-64
2 #!+x86-64
1)
357 (imag :c-type
"double" :length
#!-x86-64
2 #!+x86-64
1))
360 (define-primitive-object (sse-pack
361 :lowtag other-pointer-lowtag
362 :widetag sse-pack-widetag
)
364 (lo-value :c-type
"long" :type
(unsigned-byte 64))
365 (hi-value :c-type
"long" :type
(unsigned-byte 64)))
367 #!+(and sb-lutex sb-thread
)
368 (define-primitive-object (lutex
369 :lowtag other-pointer-lowtag
370 :widetag lutex-widetag
371 :alloc-trans %make-lutex
)
372 (gen :c-type
"long" :length
1)
373 (live :c-type
"long" :length
1)
374 (next :c-type
"struct lutex *" :length
1)
375 (prev :c-type
"struct lutex *" :length
1)
376 (mutex :c-type
"pthread_mutex_t *"
378 (mutexattr :c-type
"pthread_mutexattr_t *"
380 (condition-variable :c-type
"pthread_cond_t *"
383 ;;; this isn't actually a lisp object at all, it's a c structure that lives
384 ;;; in c-land. However, we need sight of so many parts of it from Lisp that
385 ;;; it makes sense to define it here anyway, so that the GENESIS machinery
386 ;;; can take care of maintaining Lisp and C versions.
387 ;;; Hence the even-fixnum lowtag just so we don't get odd(sic) numbers
388 ;;; added to the slot offsets
389 (define-primitive-object (thread :lowtag even-fixnum-lowtag
)
390 ;; no_tls_value_marker is borrowed very briefly at thread startup to
391 ;; pass the address of initial-function into new_thread_trampoline.
392 ;; tls[0] = NO_TLS_VALUE_MARKER_WIDETAG because a the tls index slot
393 ;; of a symbol is initialized to zero
394 (no-tls-value-marker)
395 (os-thread :c-type
"os_thread_t")
396 ;; This is the original address at which the memory was allocated,
397 ;; which may have different alignment then what we prefer to use.
398 ;; Kept here so that when the thread dies we can release the whole
399 ;; memory we reserved.
400 (os-address :c-type
"void *" :length
#!+alpha
2 #!-alpha
1)
402 (os-attr :c-type
"pthread_attr_t *" :length
#!+alpha
2 #!-alpha
1)
404 (state-lock :c-type
"pthread_mutex_t *" :length
#!+alpha
2 #!-alpha
1)
406 (state-cond :c-type
"pthread_cond_t *" :length
#!+alpha
2 #!-alpha
1)
407 (binding-stack-start :c-type
"lispobj *" :length
#!+alpha
2 #!-alpha
1)
408 (binding-stack-pointer :c-type
"lispobj *" :length
#!+alpha
2 #!-alpha
1)
409 (control-stack-start :c-type
"lispobj *" :length
#!+alpha
2 #!-alpha
1)
410 (control-stack-end :c-type
"lispobj *" :length
#!+alpha
2 #!-alpha
1)
411 (control-stack-guard-page-protected)
412 (alien-stack-start :c-type
"lispobj *" :length
#!+alpha
2 #!-alpha
1)
413 (alien-stack-pointer :c-type
"lispobj *" :length
#!+alpha
2 #!-alpha
1)
414 #!+gencgc
(alloc-region :c-type
"struct alloc_region" :length
5)
415 (this :c-type
"struct thread *" :length
#!+alpha
2 #!-alpha
1)
416 (prev :c-type
"struct thread *" :length
#!+alpha
2 #!-alpha
1)
417 (next :c-type
"struct thread *" :length
#!+alpha
2 #!-alpha
1)
418 ;; starting, running, suspended, dead
419 (state :c-type
"lispobj")
420 (tls-cookie) ; on x86, the LDT index
421 #!+(or x86 x86-64
) (pseudo-atomic-bits)
422 (interrupt-data :c-type
"struct interrupt_data *"
423 :length
#!+alpha
2 #!-alpha
1)
425 ;; KLUDGE: On alpha, until STEPPING we have been lucky and the 32
426 ;; bit slots came in pairs. However the C compiler will align
427 ;; interrupt_contexts on a double word boundary. This logic should
428 ;; be handled by DEFINE-PRIMITIVE-OBJECT.
431 (interrupt-contexts :c-type
"os_context_t *" :rest-p t
))