0.pre7.60:
[sbcl.git] / src / compiler / generic / genesis.lisp
index cfb66af..3204827 100644 (file)
@@ -94,9 +94,9 @@
   (bytes (make-array target-space-alignment :element-type '(unsigned-byte 8))
         :type (simple-array (unsigned-byte 8) 1))
   ;; the index of the next unwritten word (i.e. chunk of
-  ;; SB!VM:WORD-BYTES bytes) in BYTES, or equivalently the number of
+  ;; SB!VM:N-WORD-BYTES bytes) in BYTES, or equivalently the number of
   ;; words actually written in BYTES. In order to convert to an actual
-  ;; index into BYTES, thus must be multiplied by SB!VM:WORD-BYTES.
+  ;; index into BYTES, thus must be multiplied by SB!VM:N-WORD-BYTES.
   (free-word-index 0))
 
 (defun gspace-byte-address (gspace)
   ;; the GSPACE that this descriptor is allocated in, or NIL if not set yet.
   (gspace nil :type (or gspace null))
   ;; the offset in words from the start of GSPACE, or NIL if not set yet
-  (word-offset nil :type (or (unsigned-byte #.sb!vm:word-bits) null))
+  (word-offset nil :type (or (unsigned-byte #.sb!vm:n-word-bits) null))
   ;; the high and low halves of the descriptor
   ;;
   ;; KLUDGE: Judging from the comments in genesis.lisp of the CMU CL
     ;; NEW-FREE-WORD-INDEX.
     (do ()
        ((>= (length (gspace-bytes gspace))
-            (* new-free-word-index sb!vm:word-bytes)))
+            (* new-free-word-index sb!vm:n-word-bytes)))
       (expand-gspace-bytes gspace))
     ;; Now that GSPACE is big enough, we can meaningfully grab a chunk of it.
     (setf (gspace-free-word-index gspace) new-free-word-index)
 
 (defun descriptor-fixnum (des)
   (let ((bits (descriptor-bits des)))
-    (if (logbitp (1- sb!vm:word-bits) bits)
-      ;; KLUDGE: The (- SB!VM:WORD-BITS 2) term here looks right to
-      ;; me, and it works, but in CMU CL it was (1- SB!VM:WORD-BITS),
+    (if (logbitp (1- sb!vm:n-word-bits) bits)
+      ;; KLUDGE: The (- SB!VM:N-WORD-BITS 2) term here looks right to
+      ;; me, and it works, but in CMU CL it was (1- SB!VM:N-WORD-BITS),
       ;; and although that doesn't make sense for me, or work for me,
       ;; it's hard to see how it could have been wrong, since CMU CL
       ;; genesis worked. It would be nice to understand how this came
       ;; to be.. -- WHN 19990901
-      (logior (ash bits -2) (ash -1 (- sb!vm:word-bits 2)))
+      (logior (ash bits -2) (ash -1 (- sb!vm:n-word-bits 2)))
       (ash bits -2))))
 
 ;;; common idioms
 (defun make-random-descriptor (value)
   (make-descriptor (logand (ash value (- descriptor-low-bits))
                           (1- (ash 1
-                                   (- sb!vm:word-bits descriptor-low-bits))))
+                                   (- sb!vm:n-word-bits
+                                      descriptor-low-bits))))
                   (logand value (1- (ash 1 descriptor-low-bits)))))
 
 (defun make-fixnum-descriptor (num)
   (when (>= (integer-length num)
-           (1+ (- sb!vm:word-bits sb!vm:n-lowtag-bits)))
+           (1+ (- sb!vm:n-word-bits sb!vm:n-lowtag-bits)))
     (error "~D is too big for a fixnum." num))
   (make-random-descriptor (ash num (1- sb!vm:n-lowtag-bits))))
 
 
 (defun maybe-byte-swap (word)
   (declare (type (unsigned-byte 32) word))
-  (aver (= sb!vm:word-bits 32))
-  (aver (= sb!vm:byte-bits 8))
+  (aver (= sb!vm:n-word-bits 32))
+  (aver (= sb!vm:n-byte-bits 8))
   (if (not *genesis-byte-order-swap-p*)
       word
       (logior (ash (ldb (byte 8 0) word) 24)
 
 (defun maybe-byte-swap-short (short)
   (declare (type (unsigned-byte 16) short))
-  (aver (= sb!vm:word-bits 32))
-  (aver (= sb!vm:byte-bits 8))
+  (aver (= sb!vm:n-word-bits 32))
+  (aver (= sb!vm:n-byte-bits 8))
   (if (not *genesis-byte-order-swap-p*)
       short
       (logior (ash (ldb (byte 8 0) short) 8)
                             (ldb (byte 8 ,(* i 8)) new-value)))))
               `(progn
                  (defun ,name (byte-vector byte-index)
-  (aver (= sb!vm:word-bits 32))
-  (aver (= sb!vm:byte-bits 8))
+  (aver (= sb!vm:n-word-bits 32))
+  (aver (= sb!vm:n-byte-bits 8))
   (ecase sb!c:*backend-byte-order*
     (:little-endian
                       (logior ,@ash-list))
     (:big-endian
      (error "stub: no big-endian ports of SBCL (yet?)"))))
                  (defun (setf ,name) (new-value byte-vector byte-index)
-  (aver (= sb!vm:word-bits 32))
-  (aver (= sb!vm:byte-bits 8))
+  (aver (= sb!vm:n-word-bits 32))
+  (aver (= sb!vm:n-byte-bits 8))
   (ecase sb!c:*backend-byte-order*
     (:little-endian
                       (setf ,@setf-list))
   "Allocate LENGTH units of ELEMENT-BITS bits plus a header word in GSPACE and
   return an ``other-pointer'' descriptor to them. Initialize the header word
   with the resultant length and TYPE."
-  (let* ((bytes (/ (* element-bits length) sb!vm:byte-bits))
+  (let* ((bytes (/ (* element-bits length) sb!vm:n-byte-bits))
         (des (allocate-cold-descriptor gspace
-                                       (+ bytes sb!vm:word-bytes)
+                                       (+ bytes sb!vm:n-word-bytes)
                                        sb!vm:other-pointer-lowtag)))
     (write-memory des
                  (make-other-immediate-descriptor (ash bytes
   header word with TYPE and the length slot with LENGTH."
   ;; FIXME: Here and in ALLOCATE-UNBOXED-OBJECT, BYTES is calculated using
   ;; #'/ instead of #'CEILING, which seems wrong.
-  (let* ((bytes (/ (* element-bits length) sb!vm:byte-bits))
+  (let* ((bytes (/ (* element-bits length) sb!vm:n-byte-bits))
         (des (allocate-cold-descriptor gspace
-                                       (+ bytes (* 2 sb!vm:word-bytes))
+                                       (+ bytes (* 2 sb!vm:n-word-bytes))
                                        sb!vm:other-pointer-lowtag)))
     (write-memory des (make-other-immediate-descriptor 0 type))
     (write-wordindexed des
   ;; extra null byte at the end to aid in call-out to C.)
   (let* ((length (length string))
         (des (allocate-vector-object gspace
-                                     sb!vm:byte-bits
+                                     sb!vm:n-byte-bits
                                      (1+ length)
                                      sb!vm:simple-string-widetag))
         (bytes (gspace-bytes gspace))
-        (offset (+ (* sb!vm:vector-data-offset sb!vm:word-bytes)
+        (offset (+ (* sb!vm:vector-data-offset sb!vm:n-word-bytes)
                    (descriptor-byte-offset des))))
     (write-wordindexed des
                       sb!vm:vector-length-slot
 (defun bignum-to-core (n)
   #!+sb-doc
   "Copy a bignum to the cold core."
-  (let* ((words (ceiling (1+ (integer-length n)) sb!vm:word-bits))
+  (let* ((words (ceiling (1+ (integer-length n)) sb!vm:n-word-bits))
         (handle (allocate-unboxed-object *dynamic*
-                                         sb!vm:word-bits
+                                         sb!vm:n-word-bits
                                          words
                                          sb!vm:bignum-widetag)))
     (declare (fixnum words))
     (do ((index 1 (1+ index))
-        (remainder n (ash remainder (- sb!vm:word-bits))))
+        (remainder n (ash remainder (- sb!vm:n-word-bits))))
        ((> index words)
         (unless (zerop (integer-length remainder))
           ;; FIXME: Shouldn't this be a fatal error?
           (warn "~D words of ~D were written, but ~D bits were left over."
                 words n remainder)))
-      (let ((word (ldb (byte sb!vm:word-bits 0) remainder)))
+      (let ((word (ldb (byte sb!vm:n-word-bits 0) remainder)))
        (write-wordindexed handle index
                           (make-descriptor (ash word (- descriptor-low-bits))
                                            (ldb (byte descriptor-low-bits 0)
 (defun number-pair-to-core (first second type)
   #!+sb-doc
   "Makes a number pair of TYPE (ratio or complex) and fills it in."
-  (let ((des (allocate-unboxed-object *dynamic* sb!vm:word-bits 2 type)))
+  (let ((des (allocate-unboxed-object *dynamic* sb!vm:n-word-bits 2 type)))
     (write-wordindexed des 1 first)
     (write-wordindexed des 2 second)
     des))
   (etypecase x
     (single-float
      (let ((des (allocate-unboxed-object *dynamic*
-                                        sb!vm:word-bits
+                                        sb!vm:n-word-bits
                                         (1- sb!vm:single-float-size)
                                         sb!vm:single-float-widetag)))
        (write-wordindexed des
        des))
     (double-float
      (let ((des (allocate-unboxed-object *dynamic*
-                                        sb!vm:word-bits
+                                        sb!vm:n-word-bits
                                         (1- sb!vm:double-float-size)
                                         sb!vm:double-float-widetag))
           (high-bits (make-random-descriptor (double-float-high-bits x)))
     #!+(and long-float x86)
     (long-float
      (let ((des (allocate-unboxed-object *dynamic*
-                                        sb!vm:word-bits
+                                        sb!vm:n-word-bits
                                         (1- sb!vm:long-float-size)
                                         sb!vm:long-float-widetag))
           (exp-bits (make-random-descriptor (long-float-exp-bits x)))
 
 (defun complex-single-float-to-core (num)
   (declare (type (complex single-float) num))
-  (let ((des (allocate-unboxed-object *dynamic* sb!vm:word-bits
+  (let ((des (allocate-unboxed-object *dynamic* sb!vm:n-word-bits
                                      (1- sb!vm:complex-single-float-size)
                                      sb!vm:complex-single-float-widetag)))
     (write-wordindexed des sb!vm:complex-single-float-real-slot
 
 (defun complex-double-float-to-core (num)
   (declare (type (complex double-float) num))
-  (let ((des (allocate-unboxed-object *dynamic* sb!vm:word-bits
+  (let ((des (allocate-unboxed-object *dynamic* sb!vm:n-word-bits
                                      (1- sb!vm:complex-double-float-size)
                                      sb!vm:complex-double-float-widetag)))
     (let* ((real (realpart num))
 (declaim (ftype (function (sb!vm:word) descriptor) sap-to-core))
 (defun sapint-to-core (sapint)
   (let ((des (allocate-unboxed-object *dynamic*
-                                     sb!vm:word-bits
+                                     sb!vm:n-word-bits
                                      (1- sb!vm:sap-size)
                                      sb!vm:sap-widetag)))
     (write-wordindexed des
 ;;; descriptor.
 (defun vector-in-core (&rest objects)
   (let* ((size (length objects))
-        (result (allocate-vector-object *dynamic* sb!vm:word-bits size
+        (result (allocate-vector-object *dynamic* sb!vm:n-word-bits size
                                         sb!vm:simple-vector-widetag)))
     (dotimes (index size)
       (write-wordindexed result (+ index sb!vm:vector-data-offset)
   (declare (simple-string name))
   (let ((symbol (allocate-unboxed-object (or *cold-symbol-allocation-gspace*
                                             *dynamic*)
-                                        sb!vm:word-bits
+                                        sb!vm:n-word-bits
                                         (1- sb!vm:symbol-size)
                                         sb!vm:symbol-header-widetag)))
     (write-wordindexed symbol sb!vm:symbol-value-slot *unbound-marker*)
 (defun make-nil-descriptor ()
   (let* ((des (allocate-unboxed-object
               *static*
-              sb!vm:word-bits
+              sb!vm:n-word-bits
               sb!vm:symbol-size
               0))
         (result (make-descriptor (descriptor-high des)
                                  (+ (descriptor-low des)
-                                    (* 2 sb!vm:word-bytes)
+                                    (* 2 sb!vm:n-word-bytes)
                                     (- sb!vm:list-pointer-lowtag
                                        sb!vm:other-pointer-lowtag)))))
     (write-wordindexed des
       (let* ((fdefn (cold-fdefinition-object (cold-intern sym)))
             (offset (- (+ (- (descriptor-low fdefn)
                              sb!vm:other-pointer-lowtag)
-                          (* sb!vm:fdefn-raw-addr-slot sb!vm:word-bytes))
+                          (* sb!vm:fdefn-raw-addr-slot sb!vm:n-word-bytes))
                        (descriptor-low *nil-descriptor*)))
             (desired (sb!vm:static-function-offset sym)))
        (unless (= offset desired)
            (let ((fixed-up (- (+ value un-fixed-up)
                               gspace-byte-address
                               gspace-byte-offset
-                              sb!vm:word-bytes))) ; length of CALL argument
+                              sb!vm:n-word-bytes))) ; length of CALL argument
              (setf (byte-vector-ref-32 gspace-bytes gspace-byte-offset)
                    fixed-up)
              ;; Note relative fixups that point outside the code
                (fop-small-vector)
   (let* ((size (clone-arg))
         (result (allocate-vector-object *dynamic*
-                                        sb!vm:word-bits
+                                        sb!vm:n-word-bits
                                         size
                                         sb!vm:simple-vector-widetag)))
     (do ((index (1- size) (1- index)))
                   (ash sb!vm:vector-data-offset sb!vm:word-shift)))
         (end (+ start
                 (ceiling (* len sizebits)
-                         sb!vm:byte-bits))))
+                         sb!vm:n-byte-bits))))
     (read-sequence-or-die (descriptor-bytes result)
                          *fasl-input-stream*
                          :start start
   (let* ((len (read-arg 4))
         (result (allocate-vector-object
                  *dynamic*
-                 sb!vm:word-bits
+                 sb!vm:n-word-bits
                  len
                  sb!vm:simple-array-single-float-widetag))
         (start (+ (descriptor-byte-offset result)
                   (ash sb!vm:vector-data-offset sb!vm:word-shift)))
-        (end (+ start (* len sb!vm:word-bytes))))
+        (end (+ start (* len sb!vm:n-word-bytes))))
     (read-sequence-or-die (descriptor-bytes result)
                          *fasl-input-stream*
                          :start start
   (ecase +backend-fasl-file-implementation+
     (:x86 ; (which has 80-bit long-float format)
      (prepare-for-fast-read-byte *fasl-input-stream*
-       (let* ((des (allocate-unboxed-object *dynamic* sb!vm:word-bits
+       (let* ((des (allocate-unboxed-object *dynamic* sb!vm:n-word-bits
                                            (1- sb!vm:long-float-size)
                                            sb!vm:long-float-widetag))
              (low-bits (make-random-descriptor (fast-read-u-integer 4)))
     #+nil
     (#.sb!c:sparc-fasl-file-implementation ; 128 bit long-float format
      (prepare-for-fast-read-byte *fasl-input-stream*
-       (let* ((des (allocate-unboxed-object *dynamic* sb!vm:word-bits
+       (let* ((des (allocate-unboxed-object *dynamic* sb!vm:n-word-bits
                                            (1- sb!vm:long-float-size)
                                            sb!vm:long-float-widetag))
              (low-bits (make-random-descriptor (fast-read-u-integer 4)))
   (ecase +backend-fasl-file-implementation+
     (:x86 ; (which has 80-bit long-float format)
      (prepare-for-fast-read-byte *fasl-input-stream*
-       (let* ((des (allocate-unboxed-object *dynamic* sb!vm:word-bits
+       (let* ((des (allocate-unboxed-object *dynamic* sb!vm:n-word-bits
                                            (1- sb!vm:complex-long-float-size)
                                            sb!vm:complex-long-float-widetag))
              (real-low-bits (make-random-descriptor (fast-read-u-integer 4)))
     #+nil
     (#.sb!c:sparc-fasl-file-implementation ; 128 bit long-float format
      (prepare-for-fast-read-byte *fasl-input-stream*
-       (let* ((des (allocate-unboxed-object *dynamic* sb!vm:word-bits
+       (let* ((des (allocate-unboxed-object *dynamic* sb!vm:n-word-bits
                                            (1- sb!vm:complex-long-float-size)
                                            sb!vm:complex-long-float-widetag))
              (real-low-bits (make-random-descriptor (fast-read-u-integer 4)))
 (defun finalize-load-time-value-noise ()
   (cold-set (cold-intern '*!load-time-values*)
            (allocate-vector-object *dynamic*
-                                   sb!vm:word-bits
+                                   sb!vm:n-word-bits
                                    *load-time-value-counter*
                                    sb!vm:simple-vector-widetag)))
 
                   "~&/raw code from code-fop ~D ~D:~%"
                   nconst
                   code-size)
-          (do ((i start (+ i sb!vm:word-bytes)))
+          (do ((i start (+ i sb!vm:n-word-bytes)))
               ((>= i end))
             (format *trace-output*
                     "/#X~8,'0x: #X~8,'0x~%"
              "struct ~A {~%"
              (nsubstitute #\_ #\-
              (string-downcase (string (sb!vm:primitive-object-name obj)))))
-      (when (sb!vm:primitive-object-header obj)
+      (when (sb!vm:primitive-object-widetag obj)
        (format t "    lispobj header;~%"))
       (dolist (slot (sb!vm:primitive-object-slots obj))
        (format t "    ~A ~A~@[[1]~];~%"
          (format t "#define ~A_~A_OFFSET ~D~%"
                  (substitute #\_ #\- (string name))
                  (substitute #\_ #\- (string (sb!vm:slot-name slot)))
-                 (- (* (sb!vm:slot-offset slot) sb!vm:word-bytes) lowtag)))
+                 (- (* (sb!vm:slot-offset slot) sb!vm:n-word-bytes) lowtag)))
        (terpri))))
     (format t "#endif /* LANGUAGE_ASSEMBLY */~2%"))
 
              (descriptor-bits (cold-intern symbol))
              ;; We didn't run GENESIS, so guess at the address.
              (+ sb!vm:static-space-start
-                sb!vm:word-bytes
+                sb!vm:n-word-bytes
                 sb!vm:other-pointer-lowtag
                 (if symbol (sb!vm:static-symbol-offset symbol) 0)))))
 
@@ -2765,7 +2766,7 @@ initially undefined function references:~2%")
 (defun output-gspace (gspace)
   (force-output *core-file*)
   (let* ((posn (file-position *core-file*))
-        (bytes (* (gspace-free-word-index gspace) sb!vm:word-bytes))
+        (bytes (* (gspace-free-word-index gspace) sb!vm:n-word-bytes))
         (pages (ceiling bytes sb!c:*backend-page-size*))
         (total-bytes (* pages sb!c:*backend-page-size*)))