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 ;;;;   * (mysterious crashes which occur after changing the length
  18 ;;;;     of SIMPLE-FUN, just adding a new slot not even doing anything
  19 ;;;;     with it, still dunno why)
  20 ;;;;   * The GC scavenging code (and for all I know other GC code too)
  21 ;;;;     is not automatically generated from these layouts, but instead
  22 ;;;;     was hand-written to correspond to them. The offsets are
  23 ;;;;     automatically propagated into the GC scavenging code, but the
  24 ;;;;     existence of slots, and whether they should be scavenged, is
  25 ;;;;     not automatically propagated. Thus e.g. if you add a
  26 ;;;;     SIMPLE-FUN-DEBUG-INFO slot holding a tagged object which needs
  27 ;;;;     to be GCed, you need to tweak scav_code_header() and
  28 ;;;;     verify_space() in gencgc.c, and the corresponding code in gc.c.
  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
  35 \f
  36 ;;;; the primitive objects themselves
  37
  38 (define-primitive-object (cons :lowtag list-pointer-lowtag
  39                                :alloc-trans cons)
  40   (car :ref-trans car :set-trans sb!c::%rplaca :init :arg)
  41   (cdr :ref-trans cdr :set-trans sb!c::%rplacd :init :arg))
  42
  43 (define-primitive-object (instance :lowtag instance-pointer-lowtag
  44                                    :widetag instance-header-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 "long" #!+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 (define-primitive-object (single-float :lowtag other-pointer-lowtag
  67                                        :widetag single-float-widetag)
  68   (value :c-type "float"))
  69
  70 (define-primitive-object (double-float :lowtag other-pointer-lowtag
  71                                        :widetag double-float-widetag)
  72   (filler)
  73   (value :c-type "double" :length 2))
  74
  75 #!+long-float
  76 (define-primitive-object (long-float :lowtag other-pointer-lowtag
  77                                      :widetag long-float-widetag)
  78   #!+sparc (filler)
  79   (value :c-type "long double" :length #!+x86 3 #!+sparc 4))
  80
  81 (define-primitive-object (complex :type complex
  82                                   :lowtag other-pointer-lowtag
  83                                   :widetag complex-widetag
  84                                   :alloc-trans %make-complex)
  85   (real :type real
  86         :ref-known (flushable movable)
  87         :ref-trans %realpart
  88         :init :arg)
  89   (imag :type real
  90         :ref-known (flushable movable)
  91         :ref-trans %imagpart
  92         :init :arg))
  93
  94 (define-primitive-object (array :lowtag other-pointer-lowtag
  95                                 :widetag t)
  96   (fill-pointer :type index
  97                 :ref-trans %array-fill-pointer
  98                 :ref-known (flushable foldable)
  99                 :set-trans (setf %array-fill-pointer)
 100                 :set-known (unsafe))
 101   (fill-pointer-p :type (member t nil)
 102                   :ref-trans %array-fill-pointer-p
 103                   :ref-known (flushable foldable)
 104                   :set-trans (setf %array-fill-pointer-p)
 105                   :set-known (unsafe))
 106   (elements :type index
 107             :ref-trans %array-available-elements
 108             :ref-known (flushable foldable)
 109             :set-trans (setf %array-available-elements)
 110             :set-known (unsafe))
 111   (data :type array
 112         :ref-trans %array-data-vector
 113         :ref-known (flushable foldable)
 114         :set-trans (setf %array-data-vector)
 115         :set-known (unsafe))
 116   (displacement :type (or index null)
 117                 :ref-trans %array-displacement
 118                 :ref-known (flushable foldable)
 119                 :set-trans (setf %array-displacement)
 120                 :set-known (unsafe))
 121   (displaced-p :type (member t nil)
 122                :ref-trans %array-displaced-p
 123                :ref-known (flushable foldable)
 124                :set-trans (setf %array-displaced-p)
 125                :set-known (unsafe))
 126   (dimensions :rest-p t))
 127
 128 (define-primitive-object (vector :type vector
 129                                  :lowtag other-pointer-lowtag
 130                                  :widetag t)
 131   (length :ref-trans sb!c::vector-length
 132           :type index)
 133   (data :rest-p t :c-type #!-alpha "unsigned long" #!+alpha "u32"))
 134
 135 (define-primitive-object (code :type code-component
 136                                :lowtag other-pointer-lowtag
 137                                :widetag t)
 138   (code-size :type index
 139              :ref-known (flushable movable)
 140              :ref-trans %code-code-size)
 141   (entry-points :type (or function null)
 142                 :ref-known (flushable)
 143                 :ref-trans %code-entry-points
 144                 :set-known (unsafe)
 145                 :set-trans (setf %code-entry-points))
 146   (debug-info :type t
 147               :ref-known (flushable)
 148               :ref-trans %code-debug-info
 149               :set-known (unsafe)
 150               :set-trans (setf %code-debug-info))
 151   (trace-table-offset)
 152   (constants :rest-p t))
 153
 154 (define-primitive-object (fdefn :type fdefn
 155                                 :lowtag other-pointer-lowtag
 156                                 :widetag fdefn-widetag)
 157   (name :ref-trans fdefn-name)
 158   (fun :type (or function null) :ref-trans fdefn-fun)
 159   (raw-addr :c-type #!-alpha "char *" #!+alpha "u32"))
 160
 161 ;;; a simple function (as opposed to hairier things like closures
 162 ;;; which are also subtypes of Common Lisp's FUNCTION type)
 163 (define-primitive-object (simple-fun :type function
 164                                      :lowtag fun-pointer-lowtag
 165                                      :widetag simple-fun-header-widetag)
 166   #!-x86 (self :ref-trans %simple-fun-self
 167                :set-trans (setf %simple-fun-self))
 168   #!+x86 (self
 169           ;; KLUDGE: There's no :SET-KNOWN, :SET-TRANS, :REF-KNOWN, or
 170           ;; :REF-TRANS here in this case. Instead, there's separate
 171           ;; DEFKNOWN/DEFINE-VOP/DEFTRANSFORM stuff in
 172           ;; compiler/x86/system.lisp to define and declare them by
 173           ;; hand. I don't know why this is, but that's (basically)
 174           ;; the way it was done in CMU CL, and it works. (It's not
 175           ;; exactly the same way it was done in CMU CL in that CMU
 176           ;; CL's allows duplicate DEFKNOWNs, blithely overwriting any
 177           ;; previous data associated with the previous DEFKNOWN, and
 178           ;; that property was used to mask the definitions here. In
 179           ;; SBCL as of 0.6.12.64 that's not allowed -- too confusing!
 180           ;; -- so we have to explicitly suppress the DEFKNOWNish
 181           ;; stuff here in order to allow this old hack to work in the
 182           ;; new world. -- WHN 2001-08-82
 183           )
 184   (next :type (or function null)
 185         :ref-known (flushable)
 186         :ref-trans %simple-fun-next
 187         :set-known (unsafe)
 188         :set-trans (setf %simple-fun-next))
 189   (name :ref-known (flushable)
 190         :ref-trans %simple-fun-name
 191         :set-known (unsafe)
 192         :set-trans (setf %simple-fun-name))
 193   (arglist :ref-known (flushable)
 194            :ref-trans %simple-fun-arglist
 195            :set-known (unsafe)
 196            :set-trans (setf %simple-fun-arglist))
 197   (type :ref-known (flushable)
 198         :ref-trans %simple-fun-type
 199         :set-known (unsafe)
 200         :set-trans (setf %simple-fun-type))
 201   ;; the SB!C::DEBUG-FUN object corresponding to this object, or NIL for none
 202   #+nil ; FIXME: doesn't work (gotcha, lowly maintenoid!) See notes on bug 137.
 203   (debug-fun :ref-known (flushable)
 204              :ref-trans %simple-fun-debug-fun
 205              :set-known (unsafe)
 206              :set-trans (setf %simple-fun-debug-fun))
 207   (code :rest-p t :c-type "unsigned char"))
 208
 209 (define-primitive-object (return-pc :lowtag other-pointer-lowtag :widetag t)
 210   (return-point :c-type "unsigned char" :rest-p t))
 211
 212 (define-primitive-object (closure :lowtag fun-pointer-lowtag
 213                                   :widetag closure-header-widetag)
 214   (fun :init :arg :ref-trans %closure-fun)
 215   (info :rest-p t))
 216
 217 (define-primitive-object (funcallable-instance
 218                           :lowtag fun-pointer-lowtag
 219                           :widetag funcallable-instance-header-widetag
 220                           :alloc-trans %make-funcallable-instance)
 221   #!-x86
 222   (fun
 223    :ref-known (flushable) :ref-trans %funcallable-instance-fun
 224    :set-known (unsafe) :set-trans (setf %funcallable-instance-fun))
 225   #!+x86
 226   (fun
 227    :ref-known (flushable) :ref-trans %funcallable-instance-fun
 228    ;; KLUDGE: There's no :SET-KNOWN or :SET-TRANS in this case.
 229    ;; Instead, later in compiler/x86/system.lisp there's a separate
 230    ;; DEFKNOWN for (SETF %FUNCALLABLE-INSTANCE-FUN), and a weird
 231    ;; unexplained DEFTRANSFORM from (SETF %SIMPLE-FUN-INSTANCE-FUN)
 232    ;; into (SETF %SIMPLE-FUN-SELF). The #!+X86 wrapped around this case
 233    ;; is a literal translation of the old CMU CL implementation into
 234    ;; the new world of sbcl-0.6.12.63, where multiple DEFKNOWNs for
 235    ;; the same operator cause an error (instead of silently deleting
 236    ;; all information associated with the old DEFKNOWN, as before).
 237    ;; It's definitely not very clean, with too many #!+ conditionals and
 238    ;; too little documentation, but I have more urgent things to
 239    ;; clean up right now, so I've just left it as a literal
 240    ;; translation without trying to fix it. -- WHN 2001-08-02
 241    )
 242   (lexenv :ref-known (flushable) :ref-trans %funcallable-instance-lexenv
 243           :set-known (unsafe) :set-trans (setf %funcallable-instance-lexenv))
 244   (layout :init :arg
 245           :ref-known (flushable) :ref-trans %funcallable-instance-layout
 246           :set-known (unsafe) :set-trans (setf %funcallable-instance-layout))
 247   (info :rest-p t))
 248
 249 (define-primitive-object (value-cell :lowtag other-pointer-lowtag
 250                                      :widetag value-cell-header-widetag
 251                                      :alloc-trans make-value-cell)
 252   (value :set-trans value-cell-set
 253          :set-known (unsafe)
 254          :ref-trans value-cell-ref
 255          :ref-known (flushable)
 256          :init :arg))
 257
 258 #!+alpha
 259 (define-primitive-object (sap :lowtag other-pointer-lowtag
 260                               :widetag sap-widetag)
 261   (padding)
 262   (pointer :c-type "char *" :length 2))
 263
 264 #!-alpha
 265 (define-primitive-object (sap :lowtag other-pointer-lowtag
 266                               :widetag sap-widetag)
 267   (pointer :c-type "char *"))
 268
 269
 270 (define-primitive-object (weak-pointer :type weak-pointer
 271                                        :lowtag other-pointer-lowtag
 272                                        :widetag weak-pointer-widetag
 273                                        :alloc-trans make-weak-pointer)
 274   (value :ref-trans sb!c::%weak-pointer-value :ref-known (flushable)
 275          :init :arg)
 276   (broken :type (member t nil)
 277           :ref-trans sb!c::%weak-pointer-broken :ref-known (flushable)
 278           :init :null)
 279   (next :c-type #!-alpha "struct weak_pointer *" #!+alpha "u32"))
 280
 281 ;;;; other non-heap data blocks
 282
 283 (define-primitive-object (binding)
 284   value
 285   symbol)
 286
 287 (define-primitive-object (unwind-block)
 288   (current-uwp :c-type #!-alpha "struct unwind_block *" #!+alpha "u32")
 289   (current-cont :c-type #!-alpha "lispobj *" #!+alpha "u32")
 290   #!-x86 current-code
 291   entry-pc)
 292
 293 (define-primitive-object (catch-block)
 294   (current-uwp :c-type #!-alpha "struct unwind_block *" #!+alpha "u32")
 295   (current-cont :c-type #!-alpha "lispobj *" #!+alpha "u32")
 296   #!-x86 current-code
 297   entry-pc
 298   tag
 299   (previous-catch :c-type #!-alpha "struct catch_block *" #!+alpha "u32")
 300   size)
 301
 302 ;;; (For an explanation of this, see the comments at the definition of
 303 ;;; KLUDGE-NONDETERMINISTIC-CATCH-BLOCK-SIZE.)
 304 (aver (= kludge-nondeterministic-catch-block-size catch-block-size))
 305 \f
 306 ;;;; symbols
 307
 308 #!+x86
 309 (defknown symbol-hash (symbol) (integer 0 #.*target-most-positive-fixnum*)
 310   (flushable movable))
 311
 312 (define-primitive-object (symbol :lowtag other-pointer-lowtag
 313                                  :widetag symbol-header-widetag
 314                                  #!-x86 :alloc-trans #!-x86 make-symbol)
 315   (value :set-trans %set-symbol-value
 316          :init :unbound)
 317   #!+x86 (hash)
 318   (plist :ref-trans symbol-plist
 319          :set-trans %set-symbol-plist
 320          :init :null)
 321   (name :ref-trans symbol-name :init :arg)
 322   (package :ref-trans symbol-package
 323            :set-trans %set-symbol-package
 324            :init :null))
 325
 326 (define-primitive-object (complex-single-float
 327                           :lowtag other-pointer-lowtag
 328                           :widetag complex-single-float-widetag)
 329   (real :c-type "float")
 330   (imag :c-type "float"))
 331
 332 (define-primitive-object (complex-double-float
 333                           :lowtag other-pointer-lowtag
 334                           :widetag complex-double-float-widetag)
 335   (filler)
 336   (real :c-type "double" :length 2)
 337   (imag :c-type "double" :length 2))
 338
 339 #!+long-float
 340 (define-primitive-object (complex-long-float
 341                           :lowtag other-pointer-lowtag
 342                           :widetag complex-long-float-widetag)
 343   #!+sparc (filler)
 344   (real :c-type "long double" :length #!+x86 3 #!+sparc 4)
 345   (imag :c-type "long double" :length #!+x86 3 #!+sparc 4))
 346