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 (file-comment
  15   "$Header$")
  16 \f
  17 ;;;; the primitive objects themselves
  18
  19 (define-primitive-object (cons :lowtag list-pointer-type
  20                                :alloc-trans cons)
  21   (car :ref-trans car :set-trans sb!c::%rplaca :init :arg)
  22   (cdr :ref-trans cdr :set-trans sb!c::%rplacd :init :arg))
  23
  24 (define-primitive-object (instance :lowtag instance-pointer-type
  25                                    :header instance-header-type
  26                                    :alloc-trans %make-instance)
  27   (slots :rest-p t))
  28
  29 (define-primitive-object (bignum :lowtag other-pointer-type
  30                                  :header bignum-type
  31                                  :alloc-trans sb!bignum::%allocate-bignum)
  32   (digits :rest-p t :c-type #!-alpha "long" #!+alpha "u32"))
  33
  34 (define-primitive-object (ratio :type ratio
  35                                 :lowtag other-pointer-type
  36                                 :header ratio-type
  37                                 :alloc-trans %make-ratio)
  38   (numerator :type integer
  39              :ref-known (flushable movable)
  40              :ref-trans %numerator
  41              :init :arg)
  42   (denominator :type integer
  43                :ref-known (flushable movable)
  44                :ref-trans %denominator
  45                :init :arg))
  46
  47 (define-primitive-object (single-float :lowtag other-pointer-type
  48                                        :header single-float-type)
  49   (value :c-type "float"))
  50
  51 (define-primitive-object (double-float :lowtag other-pointer-type
  52                                        :header double-float-type)
  53   (filler)
  54   (value :c-type "double" :length 2))
  55
  56 #!+long-float
  57 (define-primitive-object (long-float :lowtag other-pointer-type
  58                                      :header long-float-type)
  59   #!+sparc (filler)
  60   (value :c-type "long double" :length #!+x86 3 #!+sparc 4))
  61
  62 (define-primitive-object (complex :type complex
  63                                   :lowtag other-pointer-type
  64                                   :header complex-type
  65                                   :alloc-trans %make-complex)
  66   (real :type real
  67         :ref-known (flushable movable)
  68         :ref-trans %realpart
  69         :init :arg)
  70   (imag :type real
  71         :ref-known (flushable movable)
  72         :ref-trans %imagpart
  73         :init :arg))
  74
  75 (define-primitive-object (array :lowtag other-pointer-type
  76                                 :header t)
  77   (fill-pointer :type index
  78                 :ref-trans %array-fill-pointer
  79                 :ref-known (flushable foldable)
  80                 :set-trans (setf %array-fill-pointer)
  81                 :set-known (unsafe))
  82   (fill-pointer-p :type (member t nil)
  83                   :ref-trans %array-fill-pointer-p
  84                   :ref-known (flushable foldable)
  85                   :set-trans (setf %array-fill-pointer-p)
  86                   :set-known (unsafe))
  87   (elements :type index
  88             :ref-trans %array-available-elements
  89             :ref-known (flushable foldable)
  90             :set-trans (setf %array-available-elements)
  91             :set-known (unsafe))
  92   (data :type array
  93         :ref-trans %array-data-vector
  94         :ref-known (flushable foldable)
  95         :set-trans (setf %array-data-vector)
  96         :set-known (unsafe))
  97   (displacement :type (or index null)
  98                 :ref-trans %array-displacement
  99                 :ref-known (flushable foldable)
 100                 :set-trans (setf %array-displacement)
 101                 :set-known (unsafe))
 102   (displaced-p :type (member t nil)
 103                :ref-trans %array-displaced-p
 104                :ref-known (flushable foldable)
 105                :set-trans (setf %array-displaced-p)
 106                :set-known (unsafe))
 107   (dimensions :rest-p t))
 108
 109 (define-primitive-object (vector :type vector
 110                                  :lowtag other-pointer-type
 111                                  :header t)
 112   (length :ref-trans sb!c::vector-length
 113           :type index)
 114   (data :rest-p t :c-type #!-alpha "unsigned long" #!+alpha "u32"))
 115
 116 (define-primitive-object (code :type code-component
 117                                :lowtag other-pointer-type
 118                                :header t)
 119   (code-size :type index
 120              :ref-known (flushable movable)
 121              :ref-trans %code-code-size)
 122   (entry-points :type (or function null)
 123                 :ref-known (flushable)
 124                 :ref-trans %code-entry-points
 125                 :set-known (unsafe)
 126                 :set-trans (setf %code-entry-points))
 127   (debug-info :type t
 128               :ref-known (flushable)
 129               :ref-trans %code-debug-info
 130               :set-known (unsafe)
 131               :set-trans (setf %code-debug-info))
 132   (trace-table-offset)
 133   (constants :rest-p t))
 134
 135 (define-primitive-object (fdefn :type fdefn
 136                                 :lowtag other-pointer-type
 137                                 :header fdefn-type)
 138   (name :ref-trans fdefn-name)
 139   (function :type (or function null) :ref-trans fdefn-function)
 140   (raw-addr :c-type #!-alpha "char *" #!+alpha "u32"))
 141
 142 (define-primitive-object (function :type function
 143                                    :lowtag function-pointer-type
 144                                    :header function-header-type)
 145   #!-gengc (self :ref-trans %function-self :set-trans (setf %function-self))
 146   #!+gengc (entry-point :c-type "char *")
 147   (next :type (or function null)
 148         :ref-known (flushable)
 149         :ref-trans %function-next
 150         :set-known (unsafe)
 151         :set-trans (setf %function-next))
 152   (name :ref-known (flushable)
 153         :ref-trans %function-name
 154         :set-known (unsafe)
 155         :set-trans (setf %function-name))
 156   (arglist :ref-known (flushable)
 157            :ref-trans %function-arglist
 158            :set-known (unsafe)
 159            :set-trans (setf %function-arglist))
 160   (type :ref-known (flushable)
 161         :ref-trans %function-type
 162         :set-known (unsafe)
 163         :set-trans (setf %function-type))
 164   (code :rest-p t :c-type "unsigned char"))
 165
 166 #!-gengc
 167 (define-primitive-object (return-pc :lowtag other-pointer-type :header t)
 168   (return-point :c-type "unsigned char" :rest-p t))
 169
 170 (define-primitive-object (closure :lowtag function-pointer-type
 171                                   :header closure-header-type)
 172   #!-gengc (function :init :arg :ref-trans %closure-function)
 173   #!+gengc (entry-point :c-type "char *")
 174   (info :rest-p t))
 175
 176 (define-primitive-object (funcallable-instance
 177                           :lowtag function-pointer-type
 178                           :header funcallable-instance-header-type
 179                           :alloc-trans %make-funcallable-instance)
 180   #!-gengc
 181   (function
 182    :ref-known (flushable) :ref-trans %funcallable-instance-function
 183    :set-known (unsafe) :set-trans (setf %funcallable-instance-function))
 184   #!+gengc (entry-point :c-type "char *")
 185   (lexenv :ref-known (flushable) :ref-trans %funcallable-instance-lexenv
 186           :set-known (unsafe) :set-trans (setf %funcallable-instance-lexenv))
 187   (layout :init :arg
 188           :ref-known (flushable) :ref-trans %funcallable-instance-layout
 189           :set-known (unsafe) :set-trans (setf %funcallable-instance-layout))
 190   (info :rest-p t))
 191
 192 (define-primitive-object (value-cell :lowtag other-pointer-type
 193                                      :header value-cell-header-type
 194                                      :alloc-trans make-value-cell)
 195   (value :set-trans value-cell-set
 196          :set-known (unsafe)
 197          :ref-trans value-cell-ref
 198          :ref-known (flushable)
 199          :init :arg))
 200
 201 #!+alpha
 202 (define-primitive-object (sap :lowtag other-pointer-type
 203                               :header sap-type)
 204   (padding)
 205   (pointer :c-type "char *" :length 2))
 206
 207 #!-alpha
 208 (define-primitive-object (sap :lowtag other-pointer-type
 209                               :header sap-type)
 210   (pointer :c-type "char *"))
 211
 212
 213 (define-primitive-object (weak-pointer :type weak-pointer
 214                                        :lowtag other-pointer-type
 215                                        :header weak-pointer-type
 216                                        :alloc-trans make-weak-pointer)
 217   (value :ref-trans sb!c::%weak-pointer-value :ref-known (flushable)
 218          :init :arg)
 219   (broken :type (member t nil)
 220           :ref-trans sb!c::%weak-pointer-broken :ref-known (flushable)
 221           :init :null)
 222   (next :c-type #!-alpha "struct weak_pointer *" #!+alpha "u32"))
 223
 224 ;;;; other non-heap data blocks
 225
 226 (define-primitive-object (binding)
 227   value
 228   symbol)
 229
 230 (define-primitive-object (unwind-block)
 231   (current-uwp :c-type #!-alpha "struct unwind_block *" #!+alpha "u32")
 232   (current-cont :c-type #!-alpha "lispobj *" #!+alpha "u32")
 233   #!-x86 current-code
 234   entry-pc)
 235
 236 (define-primitive-object (catch-block)
 237   (current-uwp :c-type #!-alpha "struct unwind_block *" #!+alpha "u32")
 238   (current-cont :c-type #!-alpha "lispobj *" #!+alpha "u32")
 239   #!-x86 current-code
 240   entry-pc
 241   tag
 242   (previous-catch :c-type #!-alpha "struct catch_block *" #!+alpha "u32")
 243   size)
 244
 245 ;;; (For an explanation of this, see the comments at the definition of
 246 ;;; KLUDGE-NONDETERMINISTIC-CATCH-BLOCK-SIZE.)
 247 (assert (= sb!vm::kludge-nondeterministic-catch-block-size catch-block-size))
 248
 249 #!+gengc
 250 (define-primitive-object (mutator)
 251   ;; Holds the lisp thread structure, if any.
 252   (thread)
 253   ;; Signal control magic.
 254   (foreign-fn-call-active :c-type "boolean")
 255   (interrupts-disabled-count :c-type "int")
 256   (interrupt-pending :c-type "boolean")
 257   (pending-signal :c-type "int")
 258   (pending-code :c-type "int")
 259   (pending-mask :c-type "int")
 260   (gc-pending :c-type "boolean")
 261   ;; Stacks.
 262   (control-stack-base :c-type "lispobj *")
 263   (control-stack-pointer :c-type "lispobj *")
 264   (control-stack-end :c-type "lispobj *")
 265   (control-frame-pointer :c-type "lispobj *")
 266   (current-unwind-protect :c-type "struct unwind_block *")
 267   (current-catch-block :c-type "struct catch_block *")
 268   (binding-stack-base :c-type "struct binding *")
 269   (binding-stack-pointer :c-type "struct binding *")
 270   (binding-stack-end :c-type "struct binding *")
 271   (number-stack-base :c-type "char *")
 272   (number-stack-pointer :c-type "char *")
 273   (number-stack-end :c-type "char *")
 274   (eval-stack)
 275   (eval-stack-top)
 276   ;; Allocation stuff.
 277   (nursery-start :c-type "lispobj *")
 278   (nursery-fill-pointer :c-type "lispobj *")
 279   (nursery-end :c-type "lispobj *")
 280   (storebuf-start :c-type "lispobj **")
 281   (storebuf-fill-pointer :c-type "lispobj **")
 282   (storebuf-end :c-type "lispobj **")
 283   (words-consed :c-type "unsigned long"))
 284
 285 \f
 286 ;;;; symbols
 287
 288 #!+gengc
 289 (defknown %make-symbol (index simple-string) symbol
 290   (flushable movable))
 291
 292 #+gengc
 293 (defknown symbol-hash (symbol) index
 294   (flushable movable))
 295
 296 #+x86
 297 (defknown symbol-hash (symbol) (integer 0 #.*target-most-positive-fixnum*)
 298   (flushable movable))
 299
 300 (define-primitive-object (symbol :lowtag other-pointer-type
 301                                  :header symbol-header-type
 302                                  #!-x86 :alloc-trans
 303                                  #!-(or gengc x86) make-symbol
 304                                  #!+gengc %make-symbol)
 305   (value :set-trans %set-symbol-value
 306          :init :unbound)
 307   #!-(or gengc x86) unused
 308   #!+gengc (hash :init :arg)
 309   #!+x86 (hash)
 310   (plist :ref-trans symbol-plist
 311          :set-trans %set-symbol-plist
 312          :init :null)
 313   (name :ref-trans symbol-name :init :arg)
 314   (package :ref-trans symbol-package
 315            :set-trans %set-symbol-package
 316            :init :null))
 317
 318 (define-primitive-object (complex-single-float
 319                           :lowtag other-pointer-type
 320                           :header complex-single-float-type)
 321   (real :c-type "float")
 322   (imag :c-type "float"))
 323
 324 (define-primitive-object (complex-double-float
 325                           :lowtag other-pointer-type
 326                           :header complex-double-float-type)
 327   (filler)
 328   (real :c-type "double" :length 2)
 329   (imag :c-type "double" :length 2))
 330
 331 #!+long-float
 332 (define-primitive-object (complex-long-float
 333                           :lowtag other-pointer-type
 334                           :header complex-long-float-type)
 335   #!+sparc (filler)
 336   (real :c-type "long double" :length #!+x86 3 #!+sparc 4)
 337   (imag :c-type "long double" :length #!+x86 3 #!+sparc 4))
 338