src/compiler/generic/early-objdef.lisp

   1 ;;;; type-based constants
   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 ;;; Tags for the main low-level types are stored in the low n (usually three)
  15 ;;; bits to identify the type of a machine word.  Certain constraints
  16 ;;; apply:
  17 ;;;   * EVEN-FIXNUM-LOWTAG and ODD-FIXNUM-LOWTAG must be 0 and 4: code
  18 ;;;     which shifts left two places to convert raw integers to tagged
  19 ;;;     fixnums is ubiquitous.
  20 ;;;   * LIST-POINTER-LOWTAG + N-WORD-BYTES = OTHER-POINTER-LOWTAG: NIL
  21 ;;;     is both a cons and a symbol (at the same address) and depends on this.
  22 ;;;     See the definition of SYMBOL in objdef.lisp
  23 ;;;   * OTHER-POINTER-LOWTAG > 4: Some code in the SPARC backend,
  24 ;;;     which uses bit 2 of the ALLOC register to indicate that
  25 ;;;     PSEUDO-ATOMIC is on, doesn't strip the low bits of reg_ALLOC
  26 ;;;     before ORing in OTHER-POINTER-LOWTAG within a PSEUDO-ATOMIC
  27 ;;;     section.
  28 ;;;   * OTHER-IMMEDIATE-0-LOWTAG are spaced 4 apart: various code wants to
  29 ;;;     iterate through these
  30 ;;;   * Allocation code on Alpha wants lowtags for heap-allocated
  31 ;;;     objects to be odd.
  32 ;;; (These are just the ones we know about as of sbcl-0.7.1.22. There
  33 ;;; might easily be more, since these values have stayed highly
  34 ;;; constrained for more than a decade, an inviting target for
  35 ;;; inventive abstraction-phobic maintainers.:-)
  36 ;;;
  37 ;;; Another way to look at lowtags is that there is no one lowtag
  38 ;;; length.  On 32-bit platforms, fixnums and other-immediates have a
  39 ;;; lowtag length of two bits, and pointers have a lowtag length of
  40 ;;; three bits.  On 64-bit platforms, fixnums and pointers gain an
  41 ;;; extra bit, and six "pad" lowtags waste the extra encoding space so
  42 ;;; obtained.
  43 ;;;
  44 ;;;  x00 -- fixnum
  45 ;;;  x10 -- other-immediate
  46 ;;;  001 -- instance-pointer
  47 ;;;  011 -- list-pointer
  48 ;;;  101 -- fun-pointer
  49 ;;;  111 -- other-pointer
  50 ;;;
  51 ;;; If you change the tag layout, check the various functions in
  52 ;;; src/runtime/runtime.h to see if they need to be updated, along
  53 ;;; with print_obj() in src/runtime/print.c, possibly 'late-objdef.lisp'
  54 ;;; and possibly the code in src/code/room.
  55 (eval-when (:compile-toplevel :load-toplevel :execute)
  56   ;; The EVAL-WHEN is necessary (at least for Lispworks), because the
  57   ;; second DEFENUM uses the value of OTHER-IMMEDIATE-0-LOWTAG, which is
  58   ;; defined in the first DEFENUM. -- AL 20000216
  59   #!+64-bit
  60   (defenum ()
  61     even-fixnum-lowtag
  62     other-immediate-0-lowtag
  63     pad0-lowtag
  64     instance-pointer-lowtag
  65     pad1-lowtag
  66     other-immediate-1-lowtag
  67     pad2-lowtag
  68     list-pointer-lowtag
  69     odd-fixnum-lowtag
  70     other-immediate-2-lowtag
  71     pad3-lowtag
  72     fun-pointer-lowtag
  73     pad4-lowtag
  74     other-immediate-3-lowtag
  75     pad5-lowtag
  76     other-pointer-lowtag)
  77   #!-64-bit
  78   (defenum ()
  79     even-fixnum-lowtag
  80     instance-pointer-lowtag
  81     other-immediate-0-lowtag
  82     list-pointer-lowtag
  83     odd-fixnum-lowtag
  84     fun-pointer-lowtag
  85     other-immediate-1-lowtag
  86     other-pointer-lowtag))
  87
  88 (def!constant nil-value
  89     (+ static-space-start n-word-bytes other-pointer-lowtag))
  90
  91 (defconstant-eqx fixnum-lowtags
  92     #.(let ((fixtags nil))
  93         (do-external-symbols (sym "SB!VM")
  94           (let* ((name (symbol-name sym))
  95                  (len (length name)))
  96             (when (and (boundp sym)
  97                        (integerp (symbol-value sym))
  98                        (> len 7)
  99                        (string= name "-LOWTAG" :start1 (- len 7))
 100                        (zerop (logand (symbol-value sym) fixnum-tag-mask)))
 101               (push sym fixtags))))
 102         `',(sort fixtags #'string< :key #'symbol-name))
 103   #'equal)
 104
 105 ;;; the heap types, stored in 8 bits of the header of an object on the
 106 ;;; heap, to identify the type of the heap object (which'll be at
 107 ;;; least two machine words, often more)
 108 ;;;
 109 ;;; Note: the order specified here is not critical for correctness,
 110 ;;; but (FIXME) with %TEST-HEADERS as currently defined, BIGNUM must
 111 ;;; be first, and COMPLEX-ARRAY must be last.
 112 ;;;
 113 ;;; However, for efficiency, we prefer contiguous sets of widetags for
 114 ;;; "similar" objects, so that type checking can be done with a range
 115 ;;; check, rather than several individual checks.
 116 ;;;
 117 ;;; * BIGNUM + RATIO (+ FIXNUM) = RATIONAL
 118 ;;;
 119 ;;; * SINGLE-FLOAT + DOUBLE-FLOAT + LONG-FLOAT = FLOAT
 120 ;;;   But: There's not a snowball's chance that #!+long-float works.
 121 ;;;        changeset 7646ae obliterated LONG-FLOAT-WIDETAG.
 122 ;;;
 123 ;;; * RATIONAL + FLOAT = REAL
 124 ;;;
 125 ;;; * (FIXME: COMPLEX example, which needs fixing anyway -- see
 126 ;;;   UPGRADED-COMPLEX-PART-TYPE)
 127 ;;;
 128 ;;; * SIMPLE-ARRAY-* = (SIMPLE-ARRAY * (*))
 129 ;;;
 130 ;;; * SIMPLE-ARRAY-NIL + SIMPLE-BASE-STRING = SIMPLE-STRING
 131 ;;;
 132 ;;; * SIMPLE-ARRAY + COMPLEX-ARRAYOID = (SATISFIES ARRAY-HEADER-P)
 133 ;;;
 134 ;;; In addition, with
 135 ;;; sufficient care we can cause extra combinations to appear with
 136 ;;; differences in only one bit, permitting a more efficient type
 137 ;;; test.  As an example, if SIMPLE-BASE-STRING = 0xA6 and
 138 ;;; COMPLEX-BASE-STRING = 0xE6, then the type test for BASE-STRING is
 139 ;;;
 140 ;;;   AND   tag, ~0x40, tag
 141 ;;;   ANDcc tag,  0xA6, tag
 142 ;;;   JNE   tag, label
 143 ;;;
 144 ;;; rather than two separate tests and jumps.
 145 ;;; However, the cases where this is possible are few, and I'm not sure if
 146 ;;; that happened before or after rearrangement of widetags in change 30eccf.
 147 ;;; At present on 64-bit target with unicode we have:
 148 ;;;   (logcount (logxor complex-character-string-widetag simple-character-string-widetag)) = 2
 149 ;;;   (logcount (logxor complex-base-string-widetag simple-base-string-widetag)) = 2
 150 ;;;   (logcount (logxor complex-vector-nil-widetag simple-array-nil-widetag)) = 3
 151 ;;;   (logcount (logxor complex-bit-vector-widetag simple-bit-vector-widetag)) = 1
 152 ;;; and we have one winner.  The situation is slightly different for 32-bit.
 153
 154 ;; FIXME: our nomenclature is baffling in more ways than implied by comments in
 155 ;; package-data-list regarding use of the word "complex" in both a numerical
 156 ;; sense and "non-simple" sense:
 157 ;; - There is no widetag specific to (AND (VECTOR T) (NOT SIMPLE-ARRAY)), i.e.
 158 ;; COMPLEX-VECTOR-WIDETAG is not the complex version of SIMPLE-VECTOR-WIDETAG
 159 ;; which is, in part, why the comment in x86/type-vops about optimizing a test
 160 ;; for (VECTOR T) is wrong.
 161 ;; - simple-array-nil should be named simple-rank-1-array-nil, though I think
 162 ;; simple-vector-nil is fine despite some reluctance to glue the particles
 163 ;; "simple" and "vector" together due to overtones of the standard meaning.
 164 ;; We could rename things that mean vector of wild type to VECTOR-*
 165 ;; and simple vector of T to SIMPLE-VECTOR-T. Just because CL says that
 166 ;; SIMPLE-VECTOR means the latter doesn't make it right for SBCL internals.
 167
 168 (eval-when (:compile-toplevel :load-toplevel :execute)
 169 (defenum (;; The first widetag must be greater than SB!VM:LOWTAG-LIMIT
 170           ;; otherwise code in generic/early-type-vops will suffer
 171           ;; a long, horrible death.  --njf, 2004-08-09
 172           :start #.(+ (ash 1 n-lowtag-bits) other-immediate-0-lowtag)
 173           :step 4)
 174                                             ; +unicode -unicode
 175 ;;                             Word bits    ;  32 | 64  32 | 64
 176                                             ;------------------
 177                                             ; [ all numbers are hex ]
 178   bignum-widetag                            ;  0A   11  0A   11
 179   ratio-widetag                             ;  0E   15  0E   15
 180   single-float-widetag                      ;  12   19  12   19
 181   double-float-widetag                      ;  16   1D  16   1D
 182   complex-widetag                           ;  1A   21  1A   21
 183   complex-single-float-widetag              ;  1E   25  1E   25
 184   complex-double-float-widetag              ;  22   29  22   29
 185
 186   code-header-widetag                       ;  26   2D  26   2D
 187
 188   simple-fun-widetag                        ;  2A   31  2A   31
 189   closure-widetag                           ;  2E   35  2E   35
 190   funcallable-instance-widetag              ;  32   39  32   39
 191
 192   ;; x86[-64] does not have objects with this widetag,
 193   #!+(or x86 x86-64) unused00-widetag
 194   #!-(or x86 x86-64)
 195   return-pc-widetag                         ;  36   3D  36   3D
 196
 197   value-cell-widetag                        ;  3A   41  3A   41
 198   symbol-widetag                            ;  3E   45  3E   45
 199   character-widetag                         ;  42   49  42   49
 200   sap-widetag                               ;  46   4D  46   4D
 201   unbound-marker-widetag                    ;  4A   51  4A   51
 202   weak-pointer-widetag                      ;  4E   55  4E   55
 203   instance-widetag                          ;  52   59  52   59
 204   fdefn-widetag                             ;  56   5D  56   5D
 205
 206   no-tls-value-marker-widetag               ;  5A   61  5A   61
 207   #!-sb-simd-pack
 208   unused01-widetag                          ;  5E       5E
 209   #!+sb-simd-pack
 210   simd-pack-widetag                         ;       65       65
 211   unused02-widetag                          ;  62   69  62   69
 212   unused03-widetag                          ;  66   6D  66   6D
 213   unused04-widetag                          ;  6A   71  6A   71
 214   unused05-widetag                          ;  6E   75  6E   75
 215   unused06-widetag                          ;  72   79  72   79
 216   unused07-widetag                          ;  76   7D  76   7D
 217   #!-64-bit
 218   unused08-widetag                          ;  7A       7A
 219   #!-64-bit
 220   unused09-widetag                          ;  7E       7E
 221
 222   simple-array-widetag                      ;  82   81  82   81
 223   simple-array-unsigned-byte-2-widetag      ;  86   85  86   85
 224   simple-array-unsigned-byte-4-widetag      ;  8A   89  8A   89
 225   simple-array-unsigned-byte-7-widetag      ;  8E   8D  8E   8D
 226   simple-array-unsigned-byte-8-widetag      ;  92   91  92   91
 227   simple-array-unsigned-byte-15-widetag     ;  96   95  96   95
 228   simple-array-unsigned-byte-16-widetag     ;  9A   99  9A   99
 229
 230   #!-64-bit
 231   simple-array-unsigned-fixnum-widetag      ;  9E   A5  9E   A5
 232   simple-array-unsigned-byte-31-widetag     ;  A2   9D  A2   9D
 233   simple-array-unsigned-byte-32-widetag     ;  A6   A1  A6   A1
 234   #!+64-bit
 235   simple-array-unsigned-fixnum-widetag      ;  9E   A5  9E   A5
 236   #!+64-bit
 237   simple-array-unsigned-byte-63-widetag     ;       A9       A9
 238   #!+64-bit
 239   simple-array-unsigned-byte-64-widetag     ;       AD       AD
 240   simple-array-signed-byte-8-widetag        ;  AA   B1  AA   B1
 241   simple-array-signed-byte-16-widetag       ;  AE   B5  AE   B5
 242   #!-64-bit
 243   simple-array-fixnum-widetag               ;  B2   BD  B2   BD
 244   simple-array-signed-byte-32-widetag       ;  B6   B9  B6   B9
 245   #!+64-bit
 246   simple-array-fixnum-widetag               ;  B2   BD  B2   BD
 247   #!+64-bit
 248   simple-array-signed-byte-64-widetag       ;       C1       C1
 249   simple-array-single-float-widetag         ;  BA   C5  BA   C5
 250   simple-array-double-float-widetag         ;  BE   C9  BE   C9
 251   simple-array-complex-single-float-widetag ;  C2   CD  C2   CD
 252   simple-array-complex-double-float-widetag ;  C6   D1  C6   D1
 253   simple-bit-vector-widetag                 ;  CA   D5  CA   D5
 254   simple-vector-widetag                     ;  CE   D9  CE   D9
 255
 256   ;; Strings
 257   simple-array-nil-widetag                  ;  D2   DD  D2   DD
 258   simple-base-string-widetag                ;  D6   E1  D6   E1
 259   #!+sb-unicode
 260   simple-character-string-widetag           ;  DA   E5
 261   #!+sb-unicode
 262   complex-character-string-widetag          ;  DE   E9
 263   complex-base-string-widetag               ;  E2   ED  DA   E5
 264   complex-vector-nil-widetag                ;  E6   F1  DE   E9
 265
 266   complex-bit-vector-widetag                ;  EA   F5  E2   ED
 267   complex-vector-widetag                    ;  EE   F9  E6   F1
 268   complex-array-widetag                     ;  F2   FD  EA   F5
 269 ))
 270
 271 (defconstant-eqx +fun-header-widetags+
 272     '#.(list funcallable-instance-widetag simple-fun-widetag closure-widetag)
 273   #'equal)
 274
 275 ;;; Don't use these. They're for Slime, ltk, Conium, hu.dwim.debug
 276 ;;; and who-knows-what-else.
 277 (defconstant simple-fun-header-widetag simple-fun-widetag)
 278 (defconstant closure-header-widetag closure-widetag)
 279
 280 ;;; the different vector subtypes
 281 (defenum ()
 282   vector-normal-subtype
 283   vector-unused-subtype
 284   vector-valid-hashing-subtype)
 285
 286 ;;; These next two constants must not occupy the same byte of a
 287 ;;; vector header word as the values in the preceding defenum.
 288
 289 ;; A vector tagged as +VECTOR-SHAREABLE+ is logically readonly,
 290 ;; and permitted to be shared with another vector per the CLHS standard
 291 ;; under the concept of similarity as constant. A vector so tagged is
 292 ;; often the print-name of a symbol, or was a literal in source code
 293 ;; and loaded from a fasl, or used in a few others situations
 294 ;; which warrant sharing.
 295 (def!constant +vector-shareable+ #x100)
 296
 297 ;; A vector tagged as +VECTOR-SHAREABLE-NONSTD+ is logically readonly,
 298 ;; and *not* technically permitted by the standard to be shared.
 299 ;; If, despite the apparent prohibition, the user opts to make these
 300 ;; shareable, we'll do it. This typically occurs with compilation
 301 ;; into memory, where the requirement is that the machine code
 302 ;; reference "the same" object as appeared in source, but where,
 303 ;; nonetheless, opportunities for sharing abound.
 304 (defconstant +vector-shareable-nonstd+ #x200)
 305
 306 ;;; This is so that COMPILE-FILE knows that things like :ALLOW-OTHER-KEYS
 307 ;;; can be immediate constants.
 308 #!+(and immobile-space (not immobile-symbols))
 309 (defconstant +initial-core-symbol-bit+ 8) ; bit index, not bit value
 310
 311 #|
 312 ;; Run this in the SB-VM or SB!VM package once for each target feature combo.
 313 (defun rewrite-widetag-comments ()
 314   (rename-file "src/compiler/generic/early-objdef.lisp" "early-objdef.old")
 315   (with-open-file (in "src/compiler/generic/early-objdef.old")
 316     (with-open-file (out "src/compiler/generic/early-objdef.lisp"
 317                          :direction :output :if-exists :supersede)
 318       (let* ((target-features
 319               (if (find-package "SB-COLD")
 320                   (symbol-value (find-symbol "*SHEBANG-FEATURES*" "SB-COLD"))
 321                   *features*))
 322              (feature-bits
 323               (+ (if (= n-word-bits 64) 1 0)
 324                  (if (member :sb-unicode target-features) 0 2)))
 325              (comment-col)
 326              (comment-offset (aref #(3 8 12 17) feature-bits))
 327              (state 0))
 328         (loop
 329          (let* ((line (read-line in nil))
 330                 (trimmed (and line (string-left-trim " " line)))
 331                 symbol)
 332            (unless line
 333              (return))
 334            (when (and (zerop state) (eql 0 (search "bignum-widetag" trimmed)))
 335              (setq state 1 comment-col (position #\; line)))
 336            (if (and (= state 1) (plusp (length trimmed))
 337                     (alpha-char-p (char trimmed 0))
 338                     (boundp (setq symbol (read-from-string trimmed))))
 339                (let ((new (make-string (+ comment-col 19)
 340                                        :initial-element #\Space)))
 341                  (replace new line)
 342                  (replace new (format nil "~2,'0X" (symbol-value symbol))
 343                           :start1 (+ comment-col comment-offset))
 344                  (write-line new out))
 345                (progn
 346                  (write-line line out)
 347                  (if (and (= state 1) (string= line ")"))
 348                      (setq state 2))))))))))
 349 |#