src/code/early-raw-slots.lisp

   1 ;;;; This software is part of the SBCL system. See the README file for
   2 ;;;; more information.
   3 ;;;;
   4 ;;;; This software is derived from the CMU CL system, which was
   5 ;;;; written at Carnegie Mellon University and released into the
   6 ;;;; public domain. The software is in the public domain and is
   7 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
   8 ;;;; files for more information.
   9
  10 (in-package "SB!KERNEL")
  11
  12 ;;; STRUCTURE-OBJECT supports placement of raw bits within the object
  13 ;;; to allow representation of native word and float-point types directly.
  14
  15 ;;; Historically the implementation was optimized for GC by placing all
  16 ;;; such slots at the end of the instance, and scavenging only up to last
  17 ;;; non-raw slot. This imposed significant overhead for access from Lisp,
  18 ;;; because "is-a" inheritance was obliged to rearrange raw slots
  19 ;;; to comply with the GC requirement, thus forcing ancestor structure
  20 ;;; accessors to compensate for physical structure length in all cases.
  21 ;;; Assuming that it is more important to simplify Lisp access than
  22 ;;; to simplify GC, we use a more flexible strategy that permits
  23 ;;; descendant structures to place new slots anywhere without changing
  24 ;;; slot placement established in ancestor structures.
  25 ;;; The trade-off is that GC (and a few other things - structure dumping,
  26 ;;; EQUALP checking, to name a few) have to be able to determine for each
  27 ;;; slot whether it is a Lisp descriptor or just bits. This is done
  28 ;;; with the LAYOUT-BITMAP of an object's layout.
  29 ;;; The bitmap stores a '1' for each bit representing a raw word,
  30 ;;; and could be a BIGNUM given a spectacularly huge structure.
  31
  32 ;;; Also note that there are possibly some alignment concerns which must
  33 ;;; be accounted for when DEFSTRUCT lays out slots,
  34 ;;; by injecting padding words appropriately.
  35 ;;; For example COMPLEX-DOUBLE-FLOAT *should* be aligned to twice the
  36 ;;; alignment of a DOUBLE-FLOAT. It is not, as things stand,
  37 ;;; but this is considered a minor bug.
  38
  39 ;; To utilize a word-sized slot in a defstruct without having to resort to
  40 ;; writing (myslot :type (unsigned-byte #.sb!vm:n-word-bits)), or even
  41 ;; worse (:type #+sb-xc-host <sometype> #-sb-xc-host <othertype>),
  42 ;; these abstractions are provided as soon as the raw slots defs are.
  43 ;; 'signed-word' is here for companionship - slots of that type are not raw.
  44 (def!type sb!vm:word () `(unsigned-byte ,sb!vm:n-word-bits))
  45 (def!type sb!vm:signed-word () `(signed-byte ,sb!vm:n-word-bits))
  46 (defconstant +layout-all-tagged+ -1)
  47
  48 ;; information about how a slot of a given DSD-RAW-TYPE is to be accessed
  49 (defstruct (raw-slot-data
  50             (:copier nil)
  51             (:predicate nil))
  52   ;; the type specifier, which must specify a numeric type.
  53   (raw-type (missing-arg) :type symbol :read-only t)
  54   ;; What operator is used to access a slot of this type?
  55   (accessor-name (missing-arg) :type symbol :read-only t)
  56   (init-vop (missing-arg) :type symbol :read-only t)
  57   ;; How many words are each value of this type?
  58   (n-words (missing-arg) :type (and index (integer 1)) :read-only t)
  59   ;; Necessary alignment in units of words.  Note that instances
  60   ;; themselves are aligned by exactly two words, so specifying more
  61   ;; than two words here would not work.
  62   (alignment 1 :type (integer 1 2) :read-only t)
  63   (comparer (missing-arg) :type function :read-only t))
  64
  65 #!-sb-fluid (declaim (freeze-type raw-slot-data))
  66
  67 ;; Simulate DEFINE-LOAD-TIME-GLOBAL - always bound in the image
  68 ;; but not eval'd in the compiler.
  69 (defglobal *raw-slot-data* nil)
  70 ;; By making this a cold-init function, it is possible to use raw slots
  71 ;; in cold toplevel forms.
  72 (defun !raw-slot-data-init ()
  73   (macrolet ((make-comparer (accessor-name)
  74                #+sb-xc-host
  75                `(lambda (x y)
  76                   (declare (ignore x y))
  77                   (error "~S comparator called" ',accessor-name))
  78                #-sb-xc-host
  79                ;; Not a symbol, because there aren't any so-named functions.
  80                `(named-lambda ,(string (symbolicate accessor-name "="))
  81                     (index x y)
  82                   (declare (optimize speed (safety 0)))
  83                   (= (,accessor-name x index)
  84                      (,accessor-name y index)))))
  85     (let ((double-float-alignment
  86             ;; white list of architectures that can load unaligned doubles:
  87             #!+(or x86 x86-64 ppc arm64) 1
  88             ;; at least sparc, mips and alpha can't:
  89             #!-(or x86 x86-64 ppc arm64) 2))
  90      (setq *raw-slot-data*
  91       (vector
  92        (make-raw-slot-data :raw-type 'sb!vm:word
  93                            :accessor-name '%raw-instance-ref/word
  94                            :init-vop 'sb!vm::raw-instance-init/word
  95                            :n-words 1
  96                            :comparer (make-comparer %raw-instance-ref/word))
  97        #!+raw-signed-word
  98        (make-raw-slot-data :raw-type 'sb!vm:signed-word
  99                            :accessor-name '%raw-instance-ref/signed-word
 100                            :init-vop 'sb!vm::raw-instance-init/signed-word
 101                            :n-words 1
 102                            :comparer (make-comparer %raw-instance-ref/signed-word))
 103        (make-raw-slot-data :raw-type 'single-float
 104                            :accessor-name '%raw-instance-ref/single
 105                            :init-vop 'sb!vm::raw-instance-init/single
 106                            ;; KLUDGE: On 64 bit architectures, we
 107                            ;; could pack two SINGLE-FLOATs into the
 108                            ;; same word if raw slots were indexed
 109                            ;; using bytes instead of words.  However,
 110                            ;; I don't personally find optimizing
 111                            ;; SINGLE-FLOAT memory usage worthwile
 112                            ;; enough.  And the other datatype that
 113                            ;; would really benefit is (UNSIGNED-BYTE
 114                            ;; 32), but that is a subtype of FIXNUM, so
 115                            ;; we store it unraw anyway.  :-( -- DFL
 116                            :n-words 1
 117                            :comparer (make-comparer %raw-instance-ref/single))
 118        (make-raw-slot-data :raw-type 'double-float
 119                            :accessor-name '%raw-instance-ref/double
 120                            :init-vop 'sb!vm::raw-instance-init/double
 121                            :alignment double-float-alignment
 122                            :n-words (/ 8 sb!vm:n-word-bytes)
 123                            :comparer (make-comparer %raw-instance-ref/double))
 124        (make-raw-slot-data :raw-type 'complex-single-float
 125                            :accessor-name '%raw-instance-ref/complex-single
 126                            :init-vop 'sb!vm::raw-instance-init/complex-single
 127                            :n-words (/ 8 sb!vm:n-word-bytes)
 128                            :comparer (make-comparer %raw-instance-ref/complex-single))
 129        (make-raw-slot-data :raw-type 'complex-double-float
 130                            :accessor-name '%raw-instance-ref/complex-double
 131                            :init-vop 'sb!vm::raw-instance-init/complex-double
 132                            :alignment double-float-alignment
 133                            :n-words (/ 16 sb!vm:n-word-bytes)
 134                            :comparer (make-comparer %raw-instance-ref/complex-double))
 135        #!+long-float
 136        (make-raw-slot-data :raw-type long-float
 137                            :accessor-name '%raw-instance-ref/long
 138                            :init-vop 'sb!vm::raw-instance-init/long
 139                            :n-words #!+x86 3 #!+sparc 4
 140                            :comparer (make-comparer %raw-instance-ref/long))
 141        #!+long-float
 142        (make-raw-slot-data :raw-type complex-long-float
 143                            :accessor-name '%raw-instance-ref/complex-long
 144                            :init-vop 'sb!vm::raw-instance-init/complex-long
 145                            :n-words #!+x86 6 #!+sparc 8
 146                            :comparer (make-comparer %raw-instance-ref/complex-long)))))))
 147
 148 #+sb-xc-host (!raw-slot-data-init)
 149 #+sb-xc
 150 (declaim (type (simple-vector #.(length *raw-slot-data*)) *raw-slot-data*))
 151
 152 ;; DO-INSTANCE-TAGGED-SLOT iterates over the manifest slots of THING
 153 ;; that contain tagged objects. (The LAYOUT does not count as a manifest slot).
 154 ;; INDEX-VAR is bound to successive slot-indices,
 155 ;; and is usually used as the second argument to %INSTANCE-REF.
 156 ;; :PAD, if T, includes a final word that may be present at the end of the
 157 ;; structure due to alignment requirements.
 158 ;; LAYOUT is optional and somewhat unnecessary, but since some uses of
 159 ;; this macro already have a layout in hand, it can be supplied.
 160 ;; [If the compiler were smarter about doing fewer memory accesses,
 161 ;; there would be no need at all for the LAYOUT - if it had already been
 162 ;; accessed, it shouldn't be another memory read]
 163 ;;
 164 (defmacro do-instance-tagged-slot ((index-var thing &key layout (pad t)) &body body)
 165   (with-unique-names (instance bitmap limit)
 166     `(let* ((,instance ,thing)
 167             (,bitmap (layout-bitmap ,(or layout `(%instance-layout ,instance))))
 168             (,limit ,(if pad
 169                          ;; target instances have an odd number of payload words.
 170                          `(logior (%instance-length ,instance) #-sb-xc-host 1)
 171                          `(%instance-length ,instance))))
 172        (do ((,index-var sb!vm:instance-data-start (1+ ,index-var)))
 173            ((>= ,index-var ,limit))
 174          (declare (type index ,index-var))
 175          (when (logbitp ,index-var ,bitmap)
 176            ,@body)))))