1 ;;;; late 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.
15 `(progn ,@*!late-primitive-object-forms
*)))
19 (dolist (slot (primitive-object-slots
20 (find 'thread
*primitive-objects
* :key
#'primitive-object-name
)))
21 (when (slot-special slot
)
22 (setf (info :variable
:wired-tls
(slot-special slot
))
23 (ash (slot-offset slot
) word-shift
))))
26 (defconstant large-object-size
27 (* 4 (max *backend-page-bytes
* gencgc-card-bytes
28 gencgc-alloc-granularity
)))
31 ;;; Keep this (mostly) lined up with 'early-objdef' for sanity's sake!
33 (defparameter *scav
/trans
/size
*
36 (cons (symbol-value (symbolicate (car entry
) "-WIDETAG"))
40 (single-float ,(or #!+64-bit
"immediate" "unboxed"))
41 (double-float "unboxed")
43 (complex-single-float "unboxed")
44 (complex-double-float "unboxed")
46 (code-header "code_header")
47 ;; The scavenge function for fun-header is basically "lose",
48 ;; but it's only defined on non-x86 platforms for some reason.
49 (simple-fun-header ,(or #!+(or x86 x86-64
) "lose" "fun_header") "fun_header" "lose")
50 (closure-header ,(or #!+(or x86 x86-64
) "closure_header" "boxed")
52 (funcallable-instance-header ,(or #!+compact-instance-header
"funinstance" "boxed")
54 ;; These have a scav and trans function, but no size function.
55 #!-
(or x86 x86-64
) (return-pc-header "return_pc_header" "return_pc_header" "lose")
57 (value-cell-header "boxed")
58 (symbol-header "boxed" "tiny_boxed")
59 (character "immediate")
61 (unbound-marker "immediate")
62 (weak-pointer "lose" "weak_pointer" "boxed")
63 (instance-header "instance" "instance" "short_boxed")
64 (fdefn ,(or #!+(or sparc arm
) "boxed" "fdefn") "tiny_boxed")
66 (no-tls-value-marker "immediate")
68 #!+sb-simd-pack
(simd-pack "unboxed")
70 (simple-array "boxed")
71 (simple-array-unsigned-byte-2 "vector_unsigned_byte_2")
72 (simple-array-unsigned-byte-4 "vector_unsigned_byte_4")
73 (simple-array-unsigned-byte-7 "vector_unsigned_byte_8")
74 (simple-array-unsigned-byte-8 "vector_unsigned_byte_8")
75 (simple-array-unsigned-byte-15 "vector_unsigned_byte_16")
76 (simple-array-unsigned-byte-16 "vector_unsigned_byte_16")
77 (simple-array-unsigned-fixnum #!-
64-bit
"vector_unsigned_byte_32"
78 #!+64-bit
"vector_unsigned_byte_64")
79 (simple-array-unsigned-byte-31 "vector_unsigned_byte_32")
80 (simple-array-unsigned-byte-32 "vector_unsigned_byte_32")
81 #!+64-bit
(simple-array-unsigned-byte-63 "vector_unsigned_byte_64")
82 #!+64-bit
(simple-array-unsigned-byte-64 "vector_unsigned_byte_64")
84 (simple-array-signed-byte-8 "vector_unsigned_byte_8")
85 (simple-array-signed-byte-16 "vector_unsigned_byte_16")
86 (simple-array-signed-byte-32 "vector_unsigned_byte_32")
87 (simple-array-fixnum #!-
64-bit
"vector_unsigned_byte_32"
88 #!+64-bit
"vector_unsigned_byte_64")
89 #!+64-bit
(simple-array-signed-byte-64 "vector_unsigned_byte_64")
91 (simple-array-single-float "vector_unsigned_byte_32")
92 (simple-array-double-float "vector_unsigned_byte_64")
93 (simple-array-complex-single-float "vector_unsigned_byte_64")
94 (simple-array-complex-double-float "vector_unsigned_byte_128")
96 (simple-bit-vector "vector_bit")
97 (simple-vector "vector")
99 (simple-array-nil "vector_nil")
100 (simple-base-string "base_string")
101 #!+sb-unicode
(simple-character-string "character_string")
102 #!+sb-unicode
(complex-character-string "boxed")
103 (complex-base-string "boxed")
104 (complex-vector-nil "boxed")
106 (complex-bit-vector "boxed")
107 (complex-vector "boxed")
108 (complex-array "boxed"))))
111 (defun write-gc-tables (stream)
112 (let ((scavtab (make-array 256 :initial-element nil
))
113 (transtab (make-array 256 :initial-element nil
))
114 (sizetab (make-array 256 :initial-element nil
)))
116 (cond ((eql 0 (logand i fixnum-tag-mask
))
117 (setf (svref scavtab i
) "immediate" (svref sizetab i
) "immediate"))
119 (let ((pointer-kind (case (logand i lowtag-mask
)
120 (#.instance-pointer-lowtag
"instance")
121 (#.list-pointer-lowtag
"list")
122 (#.fun-pointer-lowtag
"fun")
123 (#.other-pointer-lowtag
"other"))))
125 (setf (svref scavtab i
) (format nil
"~A_pointer" pointer-kind
)
126 (svref sizetab i
) "pointer"))))))
127 (dolist (entry *scav
/trans
/size
*)
128 (destructuring-bind (widetag scav
&optional
(trans scav
) (size trans
)) entry
129 (setf (svref scavtab widetag
) scav
130 (svref transtab widetag
) trans
131 (svref sizetab widetag
) size
)))
132 (flet ((write-table (decl prefix contents
)
133 (format stream
"~A = {" decl
)
134 (loop for i from
0 for x across contents
135 when
(zerop (mod i
4))
136 do
(format stream
"~% ")
137 do
(format stream
"~V@<~A~A~:[~;,~]~>"
138 (if (= (mod i
4) 3) 0 31)
139 prefix
(or x
"lose") (< i
256)))
140 (format stream
"~%};~%")))
141 (write-table "sword_t (*scavtab[256])(lispobj *where, lispobj object)"
143 (write-table "lispobj (*transother[256])(lispobj object)"
145 (format stream
"#define size_pointer size_immediate~%")
146 (format stream
"#define size_unboxed size_boxed~%")
147 (write-table "sword_t (*sizetab[256])(lispobj *where)"
149 (format stream
"#undef size_pointer~%")
150 (format stream
"#undef size_unboxed~%"))))