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 ;;; This file has to be loaded during cold-init as early as you'd like to
  13 ;;; have any defstructs that use raw slots.  %COMPILER-DEFSTRUCT needs the
  14 ;;; raw-slot-data-list both at compile-time and load-time.
  15
  16 ;; To utilize a word-sized slot in a defstruct without having to resort to
  17 ;; writing (myslot :type (unsigned-byte #.sb!vm:n-word-bits)), or even
  18 ;; worse (:type #+sb-xc-host <sometype> #-sb-xc-host <othertype>),
  19 ;; these abstractions are provided as soon as the raw slots defs are.
  20 ;; 'signed-word' is here for companionship - slots of that type are not raw.
  21 (def!type sb!vm:word () `(unsigned-byte ,sb!vm:n-word-bits))
  22 (def!type sb!vm:signed-word () `(signed-byte ,sb!vm:n-word-bits))
  23
  24 ;; information about how a slot of a given DSD-RAW-TYPE is to be accessed
  25 (eval-when (:compile-toplevel :load-toplevel :execute)
  26 (defstruct (raw-slot-data
  27             (:copier nil)
  28             (:predicate nil))
  29   ;; the raw slot type, or T for a non-raw slot
  30   ;;
  31   ;; (Non-raw slots are in the ordinary place you'd expect, directly
  32   ;; indexed off the instance pointer.  Raw slots are indexed from the end
  33   ;; of the instance and skipped by GC.)
  34   (raw-type (missing-arg) :type (or symbol cons) :read-only t)
  35   ;; What operator is used to access a slot of this type?
  36   (accessor-name (missing-arg) :type symbol :read-only t)
  37   (init-vop (missing-arg) :type symbol :read-only t)
  38   ;; How many words are each value of this type?
  39   (n-words (missing-arg) :type (and index (integer 1)) :read-only t)
  40   ;; Necessary alignment in units of words.  Note that instances
  41   ;; themselves are aligned by exactly two words, so specifying more
  42   ;; than two words here would not work.
  43   (alignment 1 :type (integer 1 2) :read-only t)
  44   (comparer (missing-arg) :type function :read-only t)))
  45
  46 #!-sb-fluid (declaim (freeze-type raw-slot-data))
  47
  48 (defglobal *raw-slot-data-list*
  49   (macrolet ((make-comparer (accessor-name)
  50                `(lambda (index x y)
  51                   (declare (optimize speed (safety 0)))
  52                   (= (,accessor-name x index)
  53                      (,accessor-name y index)))))
  54     (let ((double-float-alignment
  55             ;; white list of architectures that can load unaligned doubles:
  56             #!+(or x86 x86-64 ppc) 1
  57             ;; at least sparc, mips and alpha can't:
  58             #!-(or x86 x86-64 ppc) 2))
  59       (list
  60        (make-raw-slot-data :raw-type 'sb!vm:word
  61                            :accessor-name '%raw-instance-ref/word
  62                            :init-vop 'sb!vm::raw-instance-init/word
  63                            :n-words 1
  64                            :comparer (make-comparer %raw-instance-ref/word))
  65        (make-raw-slot-data :raw-type 'single-float
  66                            :accessor-name '%raw-instance-ref/single
  67                            :init-vop 'sb!vm::raw-instance-init/single
  68                            ;; KLUDGE: On 64 bit architectures, we
  69                            ;; could pack two SINGLE-FLOATs into the
  70                            ;; same word if raw slots were indexed
  71                            ;; using bytes instead of words.  However,
  72                            ;; I don't personally find optimizing
  73                            ;; SINGLE-FLOAT memory usage worthwile
  74                            ;; enough.  And the other datatype that
  75                            ;; would really benefit is (UNSIGNED-BYTE
  76                            ;; 32), but that is a subtype of FIXNUM, so
  77                            ;; we store it unraw anyway.  :-( -- DFL
  78                            :n-words 1
  79                            :comparer (make-comparer %raw-instance-ref/single))
  80        (make-raw-slot-data :raw-type 'double-float
  81                            :accessor-name '%raw-instance-ref/double
  82                            :init-vop 'sb!vm::raw-instance-init/double
  83                            :alignment double-float-alignment
  84                            :n-words (/ 8 sb!vm:n-word-bytes)
  85                            :comparer (make-comparer %raw-instance-ref/double))
  86        (make-raw-slot-data :raw-type 'complex-single-float
  87                            :accessor-name '%raw-instance-ref/complex-single
  88                            :init-vop 'sb!vm::raw-instance-init/complex-single
  89                            :n-words (/ 8 sb!vm:n-word-bytes)
  90                            :comparer (make-comparer %raw-instance-ref/complex-single))
  91        (make-raw-slot-data :raw-type 'complex-double-float
  92                            :accessor-name '%raw-instance-ref/complex-double
  93                            :init-vop 'sb!vm::raw-instance-init/complex-double
  94                            :alignment double-float-alignment
  95                            :n-words (/ 16 sb!vm:n-word-bytes)
  96                            :comparer (make-comparer %raw-instance-ref/complex-double))
  97        #!+long-float
  98        (make-raw-slot-data :raw-type long-float
  99                            :accessor-name '%raw-instance-ref/long
 100                            :init-vop 'sb!vm::raw-instance-init/long
 101                            :n-words #!+x86 3 #!+sparc 4
 102                            :comparer (make-comparer %raw-instance-ref/long))
 103        #!+long-float
 104        (make-raw-slot-data :raw-type complex-long-float
 105                            :accessor-name '%raw-instance-ref/complex-long
 106                            :init-vop 'sb!vm::raw-instance-init/complex-long
 107                            :n-words #!+x86 6 #!+sparc 8
 108                            :comparer (make-comparer %raw-instance-ref/complex-long))))))
 109
 110 (declaim (ftype (sfunction (symbol) raw-slot-data) raw-slot-data-or-lose))
 111 (defun raw-slot-data-or-lose (type)
 112   (or (car (member type *raw-slot-data-list* :key #'raw-slot-data-raw-type))
 113       (error "Invalid raw slot type: ~S" type)))
 114
 115 (defun raw-slot-words (type)
 116   (raw-slot-data-n-words (raw-slot-data-or-lose type)))