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
  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 ;;;;   * Various code (e.g. STATIC-FSET in genesis.lisp) is hard-wired
  27 ;;;;     to know the name of the last slot of the object the code works
  28 ;;;;     with, and implicitly to know that the last slot is special (being
  29 ;;;;     the beginning of an arbitrary-length sequence of bytes following
  30 ;;;;     the fixed-layout slots).
  31 ;;;; -- WHN 2001-12-29
  32 \f
  33 ;;;; the primitive objects themselves
  34
  35 (!define-primitive-object (cons :type cons
  36                                :lowtag list-pointer-lowtag
  37                                :alloc-trans cons)
  38   (car :ref-trans car :set-trans sb!c::%rplaca :init :arg
  39        :cas-trans %compare-and-swap-car)
  40   (cdr :ref-trans cdr :set-trans sb!c::%rplacd :init :arg
  41        :cas-trans %compare-and-swap-cdr))
  42
  43 (!define-primitive-object (instance :lowtag instance-pointer-lowtag
  44                                    :widetag instance-widetag
  45                                    :alloc-trans %make-instance)
  46   (slots :rest-p t))
  47
  48 (!define-primitive-object (bignum :lowtag other-pointer-lowtag
  49                                  :widetag bignum-widetag
  50                                  :alloc-trans sb!bignum::%allocate-bignum)
  51   (digits :rest-p t :c-type #!-alpha "sword_t" #!+alpha "u32"))
  52
  53 (!define-primitive-object (ratio :type ratio
  54                                 :lowtag other-pointer-lowtag
  55                                 :widetag ratio-widetag
  56                                 :alloc-trans %make-ratio)
  57   (numerator :type integer
  58              :ref-known (flushable movable)
  59              :ref-trans %numerator
  60              :init :arg)
  61   (denominator :type integer
  62                :ref-known (flushable movable)
  63                :ref-trans %denominator
  64                :init :arg))
  65
  66 #!-64-bit
  67 (!define-primitive-object (single-float :lowtag other-pointer-lowtag
  68                                        :widetag single-float-widetag)
  69   (value :c-type "float"))
  70
  71 (!define-primitive-object (double-float :lowtag other-pointer-lowtag
  72                                        :widetag double-float-widetag)
  73   #!-64-bit (filler)
  74   (value :c-type "double" :length #.(/ 64 n-word-bits)))
  75
  76 #!+long-float
  77 (!define-primitive-object (long-float :lowtag other-pointer-lowtag
  78                                      :widetag long-float-widetag)
  79   #!+sparc (filler)
  80   (value :c-type "long double" :length #!+x86 3 #!+sparc 4))
  81
  82 (!define-primitive-object (complex :type complex
  83                                   :lowtag other-pointer-lowtag
  84                                   :widetag complex-widetag
  85                                   :alloc-trans %make-complex)
  86   (real :type real
  87         :ref-known (flushable movable)
  88         :ref-trans %realpart
  89         :init :arg)
  90   (imag :type real
  91         :ref-known (flushable movable)
  92         :ref-trans %imagpart
  93         :init :arg))
  94
  95 (!define-primitive-object (array :lowtag other-pointer-lowtag
  96                                 :widetag t)
  97   ;; FILL-POINTER of an ARRAY is in the same place as LENGTH of a
  98   ;; VECTOR -- see SHRINK-VECTOR.
  99   (fill-pointer :type index
 100                 :ref-trans %array-fill-pointer
 101                 :ref-known (flushable foldable)
 102                 :set-trans (setf %array-fill-pointer)
 103                 :set-known ())
 104   (fill-pointer-p :type (member t nil)
 105                   :ref-trans %array-fill-pointer-p
 106                   :ref-known (flushable foldable)
 107                   :set-trans (setf %array-fill-pointer-p)
 108                   :set-known ())
 109   (elements :type index
 110             :ref-trans %array-available-elements
 111             :ref-known (flushable foldable)
 112             :set-trans (setf %array-available-elements)
 113             :set-known ())
 114   (data :type array
 115         :ref-trans %array-data ; might be a vector, might not be
 116         :ref-known (flushable foldable)
 117         :set-trans (setf %array-data)
 118         :set-known ())
 119   (displacement :type index
 120                 :ref-trans %array-displacement
 121                 :ref-known (flushable foldable)
 122                 :set-trans (setf %array-displacement)
 123                 :set-known ())
 124   (displaced-p :type t
 125                :ref-trans %array-displaced-p
 126                :ref-known (flushable foldable)
 127                :set-trans (setf %array-displaced-p)
 128                :set-known ())
 129   (displaced-from :type list
 130                   :ref-trans %array-displaced-from
 131                   :ref-known (flushable)
 132                   :set-trans (setf %array-displaced-from)
 133                   :set-known ())
 134   (dimensions :rest-p t))
 135
 136 (!define-primitive-object (vector :type vector
 137                                  :lowtag other-pointer-lowtag
 138                                  :widetag t)
 139   ;; FILL-POINTER of an ARRAY is in the same place as LENGTH of a
 140   ;; VECTOR -- see SHRINK-VECTOR.
 141   (length :ref-trans sb!c::vector-length
 142           :type index)
 143   (data :rest-p t :c-type #!-alpha "uword_t" #!+alpha "u32"))
 144
 145 ;;; The header contains the size of slots and constants in words.
 146 (!define-primitive-object (code :type code-component
 147                                :lowtag other-pointer-lowtag
 148                                :widetag t)
 149   ;; This is the size of instructions in bytes, not aligned.
 150   ;; Adding the size from the header and aligned code-size will yield
 151   ;; the total size of the code-object.
 152   (code-size :type index
 153              :ref-known (flushable movable)
 154              :ref-trans %code-code-size)
 155   (debug-info :type t
 156               :ref-known (flushable)
 157               :ref-trans %code-debug-info
 158               :set-known ()
 159               :set-trans (setf %code-debug-info))
 160   #!-64-bit
 161   (n-entries :type fixnum
 162              :set-known ()
 163              :set-trans (setf %code-n-entries)
 164              :ref-trans %code-n-entries
 165              :ref-known (flushable foldable))
 166   #!+(or x86 immobile-space)
 167   (fixups :type t
 168           :ref-known (flushable)
 169           :ref-trans %code-fixups
 170           :set-known ()
 171           :set-trans (setf %code-fixups))
 172   (constants :rest-p t))
 173
 174 (!define-primitive-object (fdefn :type fdefn
 175                                 :lowtag other-pointer-lowtag
 176                                 :widetag fdefn-widetag)
 177   (name :ref-trans fdefn-name
 178         :set-trans %set-fdefn-name :set-known ())
 179   (fun :type (or function null) :ref-trans fdefn-fun)
 180   (raw-addr :c-type #!-alpha "char *" #!+alpha "u32"))
 181
 182 ;;; a simple function (as opposed to hairier things like closures
 183 ;;; which are also subtypes of Common Lisp's FUNCTION type)
 184 (!define-primitive-object (simple-fun :type function
 185                                      :lowtag fun-pointer-lowtag
 186                                      :widetag simple-fun-widetag)
 187   ;; All three function primitive-objects have the first word after the header
 188   ;; as some kind of entry point, either the address to jump to, in the case
 189   ;; of x86, or the Lisp function to jump to, for everybody else.
 190   (self :set-known ()
 191         :set-trans (setf %simple-fun-self))
 192   (name :ref-known (flushable)
 193         :ref-trans %simple-fun-name
 194         :set-known ()
 195         :set-trans (setf %simple-fun-name))
 196   (arglist :type list
 197            :ref-known (flushable)
 198            :ref-trans %simple-fun-arglist
 199            :set-known ()
 200            :set-trans (setf %simple-fun-arglist))
 201   (type :ref-known (flushable)
 202         ;; %%SIMPLE-FUN-TYPE is used only by %SIMPLE-FUN-TYPE.
 203         ;; Nobody should care that %SIMPLE-FUN-TYPE isn't open-coded.
 204         :ref-trans %%simple-fun-type
 205         :set-known ()
 206         :set-trans (setf %simple-fun-type))
 207   ;; NIL for empty, STRING for a docstring, SIMPLE-VECTOR for XREFS, and (CONS
 208   ;; STRING SIMPLE-VECTOR) for both.
 209   (info :init :null
 210         :ref-trans %simple-fun-info
 211         :ref-known (flushable)
 212         :set-trans (setf %simple-fun-info)
 213         :set-known ())
 214   ;; the SB!C::DEBUG-FUN object corresponding to this object, or NIL for none
 215   #+nil ; FIXME: doesn't work (gotcha, lowly maintenoid!) See notes on bug 137.
 216   (debug-fun :ref-known (flushable)
 217              :ref-trans %simple-fun-debug-fun
 218              :set-known ()
 219              :set-trans (setf %simple-fun-debug-fun))
 220   (code :rest-p t :c-type "unsigned char"))
 221
 222 #!-(or x86 x86-64)
 223 (!define-primitive-object (return-pc :lowtag other-pointer-lowtag :widetag t)
 224   (return-point :c-type "unsigned char" :rest-p t))
 225
 226 (!define-primitive-object (closure :lowtag fun-pointer-lowtag
 227                                    :widetag closure-widetag
 228                                    ;; This allocator is %COPY-foo because it's only
 229                                    ;; used when renaming a closure. The compiler has
 230                                    ;; its own way of making closures, which requires
 231                                    ;; that the length be a compile-time constant.
 232                                    :alloc-trans %copy-closure)
 233   (fun :init :arg :ref-trans #!+(or x86 x86-64) %closure-callee
 234                              #!-(or x86 x86-64) %closure-fun)
 235   (info :rest-p t))
 236
 237 (!define-primitive-object (funcallable-instance
 238                           :lowtag fun-pointer-lowtag
 239                           :widetag funcallable-instance-widetag
 240                           :alloc-trans %make-funcallable-instance)
 241   (trampoline :init :funcallable-instance-tramp)
 242   ;; TODO: if we can switch places of 'function' and 'fsc-instance-slots'
 243   ;; (at least for the builds with compact-instance-header)
 244   ;; then for both funcallable and non-funcallable instances,
 245   ;; the CLOS slot vector will be in the word 5 bytes past the tagged pointer.
 246   ;; This shouldn't be too hard to arrange, since nothing needs to know where
 247   ;; the tagged function lives except the funcallable instance trampoline.
 248   (function :ref-known (flushable) :ref-trans %funcallable-instance-function
 249             :set-known () :set-trans (setf %funcallable-instance-function))
 250   (info :rest-p t))
 251
 252 (!define-primitive-object (value-cell :lowtag other-pointer-lowtag
 253                                      :widetag value-cell-widetag
 254                                      ;; FIXME: We also have an explicit VOP
 255                                      ;; for this. Is this needed as well?
 256                                      :alloc-trans make-value-cell)
 257   (value :set-trans value-cell-set
 258          :set-known ()
 259          :ref-trans value-cell-ref
 260          :ref-known (flushable)
 261          :init :arg))
 262
 263 (!define-primitive-object (sap :lowtag other-pointer-lowtag
 264                               :widetag sap-widetag)
 265   (pointer :c-type "char *" :pointer t))
 266
 267
 268 (!define-primitive-object (weak-pointer :type weak-pointer
 269                                        :lowtag other-pointer-lowtag
 270                                        :widetag weak-pointer-widetag
 271                                        :alloc-trans make-weak-pointer)
 272   (value :ref-trans %weak-pointer-value :ref-known (flushable)
 273          :init :arg)
 274   (next :c-type #!-alpha "struct weak_pointer *" #!+alpha "u32"))
 275
 276 ;;;; other non-heap data blocks
 277
 278 (!define-primitive-object (binding)
 279   value
 280   symbol) ;; on sb-thread, this is actually a tls-index
 281
 282 (!define-primitive-object (unwind-block)
 283   (uwp :c-type #!-alpha "struct unwind_block *" #!+alpha "u32")
 284   (cfp :c-type #!-alpha "lispobj *" #!+alpha "u32")
 285   #!-(or x86 x86-64) code
 286   entry-pc
 287   #!+win32 next-seh-frame
 288   #!+win32 seh-frame-handler)
 289
 290 (!define-primitive-object (catch-block)
 291   (uwp :c-type #!-alpha "struct unwind_block *" #!+alpha "u32")
 292   (cfp :c-type #!-alpha "lispobj *" #!+alpha "u32")
 293   #!-(or x86 x86-64) code
 294   entry-pc
 295   #!+(and win32 x86) next-seh-frame
 296   #!+(and win32 x86) seh-frame-handler
 297   tag
 298   (previous-catch :c-type #!-alpha "struct catch_block *" #!+alpha "u32"))
 299 \f
 300 ;;;; symbols
 301
 302 (!define-primitive-object (symbol :lowtag other-pointer-lowtag
 303                                  :widetag symbol-widetag
 304                                  :alloc-trans %%make-symbol
 305                                  :type symbol)
 306
 307   ;; Beware when changing this definition.  NIL-the-symbol is defined
 308   ;; using this layout, and NIL-the-end-of-list-marker is the cons
 309   ;; ( NIL . NIL ), living in the first two slots of NIL-the-symbol
 310   ;; (conses have no header).  Careful selection of lowtags ensures
 311   ;; that the same pointer can be used for both purposes:
 312   ;; OTHER-POINTER-LOWTAG is 7, LIST-POINTER-LOWTAG is 3, so if you
 313   ;; subtract 3 from (SB-KERNEL:GET-LISP-OBJ-ADDRESS 'NIL) you get the
 314   ;; first data slot, and if you subtract 7 you get a symbol header.
 315
 316   ;; also the CAR of NIL-as-end-of-list
 317   (value :init :unbound
 318          :set-trans %set-symbol-global-value
 319          :set-known ())
 320   ;; also the CDR of NIL-as-end-of-list.  Its reffer needs special
 321   ;; care for this reason, as hash values must be fixnums.
 322   (hash :set-trans %set-symbol-hash)
 323
 324   (info :ref-trans symbol-info :ref-known (flushable)
 325         :set-trans (setf symbol-info)
 326         :set-known ()
 327         :cas-trans %compare-and-swap-symbol-info
 328         :type (or simple-vector list)
 329         :init :null)
 330   (name :ref-trans symbol-name :init :arg)
 331   (package :ref-trans symbol-package
 332            :set-trans %set-symbol-package
 333            :init :null)
 334   ;; 0 tls-index means no tls-index is allocated
 335   ;; 64-bit put the tls-index in the header word.
 336   #!+(and sb-thread (not 64-bit))
 337   (tls-index :ref-known (flushable) :ref-trans symbol-tls-index))
 338
 339 (!define-primitive-object (complex-single-float
 340                           :lowtag other-pointer-lowtag
 341                           :widetag complex-single-float-widetag)
 342   #!+64-bit
 343   (data :c-type "struct { float data[2]; } ")
 344   #!-64-bit
 345   (real :c-type "float")
 346   #!-64-bit
 347   (imag :c-type "float"))
 348
 349 (!define-primitive-object (complex-double-float
 350                           :lowtag other-pointer-lowtag
 351                           :widetag complex-double-float-widetag)
 352   (filler)
 353   (real :c-type "double" :length #.(/ 64 n-word-bits))
 354   (imag :c-type "double" :length #.(/ 64 n-word-bits)))
 355
 356 #!+sb-simd-pack
 357 (!define-primitive-object (simd-pack
 358                           :lowtag other-pointer-lowtag
 359                           :widetag simd-pack-widetag)
 360   (tag :ref-trans %simd-pack-tag
 361        :attributes (movable flushable)
 362        :type fixnum)
 363   (lo-value :c-type "long" :type (unsigned-byte 64))
 364   (hi-value :c-type "long" :type (unsigned-byte 64)))
 365
 366 ;;; this isn't actually a lisp object at all, it's a c structure that lives
 367 ;;; in c-land.  However, we need sight of so many parts of it from Lisp that
 368 ;;; it makes sense to define it here anyway, so that the GENESIS machinery
 369 ;;; can take care of maintaining Lisp and C versions.
 370 (!define-primitive-object (thread)
 371   ;; no_tls_value_marker is borrowed very briefly at thread startup to
 372   ;; pass the address of initial-function into new_thread_trampoline.
 373   ;; tls[0] = NO_TLS_VALUE_MARKER_WIDETAG because a the tls index slot
 374   ;; of a symbol is initialized to zero
 375   (no-tls-value-marker)
 376   (os-thread :c-type "os_thread_t")
 377   ;; This is the original address at which the memory was allocated,
 378   ;; which may have different alignment then what we prefer to use.
 379   ;; Kept here so that when the thread dies we can release the whole
 380   ;; memory we reserved.
 381   (os-address :c-type "void *" :pointer t)
 382
 383   ;; Keep these next six slots (alloc-region being figured in as 1 slot)
 384   ;; near the beginning of the structure so that x86[-64] assembly code
 385   ;; can use single-byte displacements from thread-base-tn.
 386   ;; Doing so reduces code size for allocation sequences and special variable
 387   ;; manipulations by fixing their TLS offsets to be < 2^7, the largest
 388   ;; aligned displacement fitting in a signed byte.
 389   #!+gencgc (alloc-region :c-type "struct alloc_region" :length 5)
 390   #!+sb-thread (pseudo-atomic-bits #!+(or x86 x86-64) :special #!+(or x86 x86-64) *pseudo-atomic-bits*)
 391   ;; next two not used in C, but this wires the TLS offsets to small values
 392   #!+(and x86-64 sb-thread)
 393   (current-catch-block :special *current-catch-block*)
 394   #!+(and x86-64 sb-thread)
 395   (current-unwind-protect-block :special *current-unwind-protect-block*)
 396   (alien-stack-pointer :c-type "lispobj *" :pointer t
 397                        :special *alien-stack-pointer*)
 398   (binding-stack-pointer :c-type "lispobj *" :pointer t
 399                          :special *binding-stack-pointer*)
 400   (stepping)
 401   ;; END of slots to keep near the beginning.
 402
 403   ;; These aren't accessed (much) from Lisp, so don't really care
 404   ;; if it takes a 4-byte displacement.
 405   (alien-stack-start :c-type "lispobj *" :pointer t)
 406   (binding-stack-start :c-type "lispobj *" :pointer t
 407                        :special *binding-stack-start*)
 408
 409   #!+sb-thread
 410   (os-attr :c-type "pthread_attr_t *" :pointer t)
 411   #!+(and sb-thread (not sb-safepoint))
 412   (state-sem :c-type "os_sem_t *" :pointer t)
 413   #!+(and sb-thread (not sb-safepoint))
 414   (state-not-running-sem :c-type "os_sem_t *" :pointer t)
 415   #!+(and sb-thread (not sb-safepoint))
 416   (state-not-running-waitcount :c-type "int" :length 1)
 417   #!+(and sb-thread (not sb-safepoint))
 418   (state-not-stopped-sem :c-type "os_sem_t *" :pointer t)
 419   #!+(and sb-thread (not sb-safepoint))
 420   (state-not-stopped-waitcount :c-type "int" :length 1)
 421   (control-stack-start :c-type "lispobj *" :pointer t
 422                        :special *control-stack-start*)
 423   (control-stack-end :c-type "lispobj *" :pointer t
 424                      :special *control-stack-end*)
 425   (control-stack-guard-page-protected)
 426   #!+win32 (private-events :c-type "struct private_events" :length 2)
 427   (this :c-type "struct thread *" :pointer t)
 428   (prev :c-type "struct thread *" :pointer t)
 429   (next :c-type "struct thread *" :pointer t)
 430   ;; starting, running, suspended, dead
 431   (state :c-type "lispobj")
 432
 433   #!+x86 (tls-cookie)                          ;  LDT index
 434   (interrupt-data :c-type "struct interrupt_data *"
 435                   :pointer t)
 436   ;; For various reasons related to pseudo-atomic and interrupt
 437   ;; handling, we need to know if the machine context is in Lisp code
 438   ;; or not.  On non-threaded targets, this is a global variable in
 439   ;; the runtime, but it's clearly a per-thread value.
 440   #!+sb-thread
 441   (foreign-function-call-active :c-type "boolean")
 442   ;; Same as above for the location of the current control stack frame.
 443   #!+(and sb-thread (not (or x86 x86-64)))
 444   (control-frame-pointer :c-type "lispobj *")
 445   ;; Same as above for the location of the current control stack
 446   ;; pointer.  This is also used on threaded x86oids to allow LDB to
 447   ;; print an approximation of the CSP as needed.
 448   #!+sb-thread
 449   (control-stack-pointer :c-type "lispobj *")
 450   #!+mach-exception-handler
 451   (mach-port-name :c-type "mach_port_name_t")
 452   ;; Context base pointer for running on top of system libraries built using
 453   ;; -fomit-frame-pointer.  Currently truly required and implemented only
 454   ;; for (and win32 x86-64), but could be generalized to other platforms if
 455   ;; needed:
 456   #!+win32 (carried-base-pointer :c-type "os_context_register_t")
 457   #!+sb-safepoint (csp-around-foreign-call :c-type "lispobj *")
 458   #!+sb-safepoint (pc-around-foreign-call :c-type "lispobj *")
 459   #!+win32 (synchronous-io-handle-and-flag :c-type "HANDLE" :length 1)
 460   #!+(and sb-safepoint-strictly (not win32))
 461   (sprof-alloc-region :c-type "struct alloc_region" :length 5)
 462   (interrupt-contexts :c-type "os_context_t *" :rest-p t :pointer t))