0.pre7.20:
[sbcl.git] / src / compiler / generic / objdef.lisp
1 ;;;; machine-independent aspects of the object representation
2
3 ;;;; This software is part of the SBCL system. See the README file for
4 ;;;; more information.
5 ;;;;
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.
11
12 (in-package "SB!VM")
13 \f
14 ;;;; the primitive objects themselves
15
16 (define-primitive-object (cons :lowtag list-pointer-type
17                                :alloc-trans cons)
18   (car :ref-trans car :set-trans sb!c::%rplaca :init :arg)
19   (cdr :ref-trans cdr :set-trans sb!c::%rplacd :init :arg))
20
21 (define-primitive-object (instance :lowtag instance-pointer-type
22                                    :header instance-header-type
23                                    :alloc-trans %make-instance)
24   (slots :rest-p t))
25
26 (define-primitive-object (bignum :lowtag other-pointer-type
27                                  :header bignum-type
28                                  :alloc-trans sb!bignum::%allocate-bignum)
29   (digits :rest-p t :c-type #!-alpha "long" #!+alpha "u32"))
30
31 (define-primitive-object (ratio :type ratio
32                                 :lowtag other-pointer-type
33                                 :header ratio-type
34                                 :alloc-trans %make-ratio)
35   (numerator :type integer
36              :ref-known (flushable movable)
37              :ref-trans %numerator
38              :init :arg)
39   (denominator :type integer
40                :ref-known (flushable movable)
41                :ref-trans %denominator
42                :init :arg))
43
44 (define-primitive-object (single-float :lowtag other-pointer-type
45                                        :header single-float-type)
46   (value :c-type "float"))
47
48 (define-primitive-object (double-float :lowtag other-pointer-type
49                                        :header double-float-type)
50   (filler)
51   (value :c-type "double" :length 2))
52
53 #!+long-float
54 (define-primitive-object (long-float :lowtag other-pointer-type
55                                      :header long-float-type)
56   #!+sparc (filler)
57   (value :c-type "long double" :length #!+x86 3 #!+sparc 4))
58
59 (define-primitive-object (complex :type complex
60                                   :lowtag other-pointer-type
61                                   :header complex-type
62                                   :alloc-trans %make-complex)
63   (real :type real
64         :ref-known (flushable movable)
65         :ref-trans %realpart
66         :init :arg)
67   (imag :type real
68         :ref-known (flushable movable)
69         :ref-trans %imagpart
70         :init :arg))
71
72 (define-primitive-object (array :lowtag other-pointer-type
73                                 :header t)
74   (fill-pointer :type index
75                 :ref-trans %array-fill-pointer
76                 :ref-known (flushable foldable)
77                 :set-trans (setf %array-fill-pointer)
78                 :set-known (unsafe))
79   (fill-pointer-p :type (member t nil)
80                   :ref-trans %array-fill-pointer-p
81                   :ref-known (flushable foldable)
82                   :set-trans (setf %array-fill-pointer-p)
83                   :set-known (unsafe))
84   (elements :type index
85             :ref-trans %array-available-elements
86             :ref-known (flushable foldable)
87             :set-trans (setf %array-available-elements)
88             :set-known (unsafe))
89   (data :type array
90         :ref-trans %array-data-vector
91         :ref-known (flushable foldable)
92         :set-trans (setf %array-data-vector)
93         :set-known (unsafe))
94   (displacement :type (or index null)
95                 :ref-trans %array-displacement
96                 :ref-known (flushable foldable)
97                 :set-trans (setf %array-displacement)
98                 :set-known (unsafe))
99   (displaced-p :type (member t nil)
100                :ref-trans %array-displaced-p
101                :ref-known (flushable foldable)
102                :set-trans (setf %array-displaced-p)
103                :set-known (unsafe))
104   (dimensions :rest-p t))
105
106 (define-primitive-object (vector :type vector
107                                  :lowtag other-pointer-type
108                                  :header t)
109   (length :ref-trans sb!c::vector-length
110           :type index)
111   (data :rest-p t :c-type #!-alpha "unsigned long" #!+alpha "u32"))
112
113 (define-primitive-object (code :type code-component
114                                :lowtag other-pointer-type
115                                :header t)
116   (code-size :type index
117              :ref-known (flushable movable)
118              :ref-trans %code-code-size)
119   (entry-points :type (or function null)
120                 :ref-known (flushable)
121                 :ref-trans %code-entry-points
122                 :set-known (unsafe)
123                 :set-trans (setf %code-entry-points))
124   (debug-info :type t
125               :ref-known (flushable)
126               :ref-trans %code-debug-info
127               :set-known (unsafe)
128               :set-trans (setf %code-debug-info))
129   (trace-table-offset)
130   (constants :rest-p t))
131
132 (define-primitive-object (fdefn :type fdefn
133                                 :lowtag other-pointer-type
134                                 :header fdefn-type)
135   (name :ref-trans fdefn-name)
136   (function :type (or function null) :ref-trans fdefn-function)
137   (raw-addr :c-type #!-alpha "char *" #!+alpha "u32"))
138
139 (define-primitive-object (function :type function
140                                    :lowtag function-pointer-type
141                                    :header function-header-type)
142   #!-(or gengc x86) (self :ref-trans %function-self
143                           :set-trans (setf %function-self))
144   #!+x86 (self
145           ;; KLUDGE: There's no :SET-KNOWN, :SET-TRANS, :REF-KNOWN, or
146           ;; :REF-TRANS here in this case. Instead, there's separate
147           ;; DEFKNOWN/DEFINE-VOP/DEFTRANSFORM stuff in
148           ;; compiler/x86/system.lisp to define and declare them by
149           ;; hand. I don't know why this is, but that's (basically)
150           ;; the way it was done in CMU CL, and it works. (It's not
151           ;; exactly the same way it was done in CMU CL in that CMU
152           ;; CL's allows duplicate DEFKNOWNs, blithely overwriting any
153           ;; previous data associated with the previous DEFKNOWN, and
154           ;; that property was used to mask the definitions here. In
155           ;; SBCL as of 0.6.12.64 that's not allowed -- too confusing!
156           ;; -- so we have to explicitly suppress the DEFKNOWNish
157           ;; stuff here in order to allow this old hack to work in the
158           ;; new world. -- WHN 2001-08-82
159           )
160   #!+gengc (entry-point :c-type "char *")
161   (next :type (or function null)
162         :ref-known (flushable)
163         :ref-trans %function-next
164         :set-known (unsafe)
165         :set-trans (setf %function-next))
166   (name :ref-known (flushable)
167         :ref-trans %function-name
168         :set-known (unsafe)
169         :set-trans (setf %function-name))
170   (arglist :ref-known (flushable)
171            :ref-trans %function-arglist
172            :set-known (unsafe)
173            :set-trans (setf %function-arglist))
174   (type :ref-known (flushable)
175         :ref-trans %function-type
176         :set-known (unsafe)
177         :set-trans (setf %function-type))
178   (code :rest-p t :c-type "unsigned char"))
179
180 #!-gengc
181 (define-primitive-object (return-pc :lowtag other-pointer-type :header t)
182   (return-point :c-type "unsigned char" :rest-p t))
183
184 (define-primitive-object (closure :lowtag function-pointer-type
185                                   :header closure-header-type)
186   #!-gengc (function :init :arg :ref-trans %closure-function)
187   #!+gengc (entry-point :c-type "char *")
188   (info :rest-p t))
189
190 (define-primitive-object (funcallable-instance
191                           :lowtag function-pointer-type
192                           :header funcallable-instance-header-type
193                           :alloc-trans %make-funcallable-instance)
194   #!-(or gengc x86)
195   (function
196    :ref-known (flushable) :ref-trans %funcallable-instance-function
197    :set-known (unsafe) :set-trans (setf %funcallable-instance-function))
198   #!+x86
199   (function
200    :ref-known (flushable) :ref-trans %funcallable-instance-function
201    ;; KLUDGE: There's no :SET-KNOWN or :SET-TRANS in this case.
202    ;; Instead, later in compiler/x86/system.lisp there's a separate
203    ;; DEFKNOWN for (SETF %FUNCALLABLE-INSTANCE-FUNCTION), and a weird
204    ;; unexplained DEFTRANSFORM from (SETF %FUNCTION-INSTANCE-FUNCTION)
205    ;; into (SETF %FUNCTION-SELF). The #!+X86 wrapped around this case
206    ;; is a literal translation of the old CMU CL implementation into
207    ;; the new world of sbcl-0.6.12.63, where multiple DEFKNOWNs for
208    ;; the same operator cause an error (instead of silently deleting
209    ;; all information associated with the old DEFKNOWN, as before).
210    ;; It's definitely not very clean, with too many #!+ conditionals,
211    ;; too little documentation, and an implicit assumption that GENGC
212    ;; and X86 are mutually exclusive, but I have more urgent things to
213    ;; clean up right now, so I've just left it as a literal
214    ;; translation without trying to fix it. -- WHN 2001-08-02
215    )
216   #!+gengc (entry-point :c-type "char *")
217   (lexenv :ref-known (flushable) :ref-trans %funcallable-instance-lexenv
218           :set-known (unsafe) :set-trans (setf %funcallable-instance-lexenv))
219   (layout :init :arg
220           :ref-known (flushable) :ref-trans %funcallable-instance-layout
221           :set-known (unsafe) :set-trans (setf %funcallable-instance-layout))
222   (info :rest-p t))
223
224 (define-primitive-object (value-cell :lowtag other-pointer-type
225                                      :header value-cell-header-type
226                                      :alloc-trans make-value-cell)
227   (value :set-trans value-cell-set
228          :set-known (unsafe)
229          :ref-trans value-cell-ref
230          :ref-known (flushable)
231          :init :arg))
232
233 #!+alpha
234 (define-primitive-object (sap :lowtag other-pointer-type
235                               :header sap-type)
236   (padding)
237   (pointer :c-type "char *" :length 2))
238
239 #!-alpha
240 (define-primitive-object (sap :lowtag other-pointer-type
241                               :header sap-type)
242   (pointer :c-type "char *"))
243
244
245 (define-primitive-object (weak-pointer :type weak-pointer
246                                        :lowtag other-pointer-type
247                                        :header weak-pointer-type
248                                        :alloc-trans make-weak-pointer)
249   (value :ref-trans sb!c::%weak-pointer-value :ref-known (flushable)
250          :init :arg)
251   (broken :type (member t nil)
252           :ref-trans sb!c::%weak-pointer-broken :ref-known (flushable)
253           :init :null)
254   (next :c-type #!-alpha "struct weak_pointer *" #!+alpha "u32"))
255
256 ;;;; other non-heap data blocks
257
258 (define-primitive-object (binding)
259   value
260   symbol)
261
262 (define-primitive-object (unwind-block)
263   (current-uwp :c-type #!-alpha "struct unwind_block *" #!+alpha "u32")
264   (current-cont :c-type #!-alpha "lispobj *" #!+alpha "u32")
265   #!-x86 current-code
266   entry-pc)
267
268 (define-primitive-object (catch-block)
269   (current-uwp :c-type #!-alpha "struct unwind_block *" #!+alpha "u32")
270   (current-cont :c-type #!-alpha "lispobj *" #!+alpha "u32")
271   #!-x86 current-code
272   entry-pc
273   tag
274   (previous-catch :c-type #!-alpha "struct catch_block *" #!+alpha "u32")
275   size)
276
277 ;;; (For an explanation of this, see the comments at the definition of
278 ;;; KLUDGE-NONDETERMINISTIC-CATCH-BLOCK-SIZE.)
279 (aver (= sb!vm::kludge-nondeterministic-catch-block-size catch-block-size))
280 \f
281 ;;;; symbols
282
283 #!+gengc
284 (defknown %make-symbol (index simple-string) symbol
285   (flushable movable))
286
287 #!+gengc
288 (defknown symbol-hash (symbol) index
289   (flushable movable))
290
291 #!+x86
292 (defknown symbol-hash (symbol) (integer 0 #.*target-most-positive-fixnum*)
293   (flushable movable))
294
295 (define-primitive-object (symbol :lowtag other-pointer-type
296                                  :header symbol-header-type
297                                  #!-x86 :alloc-trans
298                                  #!-(or gengc x86) make-symbol
299                                  #!+gengc %make-symbol)
300   (value :set-trans %set-symbol-value
301          :init :unbound)
302   #!-(or gengc x86) unused
303   #!+gengc (hash :init :arg)
304   #!+x86 (hash)
305   (plist :ref-trans symbol-plist
306          :set-trans %set-symbol-plist
307          :init :null)
308   (name :ref-trans symbol-name :init :arg)
309   (package :ref-trans symbol-package
310            :set-trans %set-symbol-package
311            :init :null))
312
313 (define-primitive-object (complex-single-float
314                           :lowtag other-pointer-type
315                           :header complex-single-float-type)
316   (real :c-type "float")
317   (imag :c-type "float"))
318
319 (define-primitive-object (complex-double-float
320                           :lowtag other-pointer-type
321                           :header complex-double-float-type)
322   (filler)
323   (real :c-type "double" :length 2)
324   (imag :c-type "double" :length 2))
325
326 #!+long-float
327 (define-primitive-object (complex-long-float
328                           :lowtag other-pointer-type
329                           :header complex-long-float-type)
330   #!+sparc (filler)
331   (real :c-type "long double" :length #!+x86 3 #!+sparc 4)
332   (imag :c-type "long double" :length #!+x86 3 #!+sparc 4))
333