cleanup after widetag renaming in 0.pre7.58..
..renamed %VECTOR-TYPE-CODE to VECTOR-WIDETAG-AND-N-BITS
..renamed %COMPLEX-VECTOR-TYPE-CODE to COMPLEX-VECTOR-WIDETAG
..renamed DEFINE-PRIMITIVE-OBJECT :HEADER to :WIDETAG
..renamed PRIMITIVE-OBJECT-HEADER to PRIMITIVE-OBJECT-WIDETAG
renamed WORD-BITS to N-WORD-BITS
"OFFSET-STATIC-SYMBOL" "OTHER-IMMEDIATE-0-LOWTAG"
"OTHER-IMMEDIATE-1-LOWTAG" "OTHER-POINTER-LOWTAG"
"PAD-DATA-BLOCK" "PENDING-INTERRUPT-TRAP"
- "PRIMITIVE-OBJECT" "PRIMITIVE-OBJECT-HEADER"
+ "PRIMITIVE-OBJECT" "PRIMITIVE-OBJECT-WIDETAG"
"PRIMITIVE-OBJECT-LOWTAG" "PRIMITIVE-OBJECT-NAME"
"PRIMITIVE-OBJECT-OPTIONS" "PRIMITIVE-OBJECT-P"
"PRIMITIVE-OBJECT-SIZE" "PRIMITIVE-OBJECT-SLOTS"
"WEAK-POINTER-BROKEN-SLOT" "WEAK-POINTER-NEXT-SLOT"
"WEAK-POINTER-SIZE" "WEAK-POINTER-WIDETAG"
"WEAK-POINTER-VALUE-SLOT"
- "WORD" "WORD-BITS" "WORD-BYTES" "WORD-REG-SC-NUMBER" "WORD-SHIFT"
+ "WORD" "N-WORD-BITS" "WORD-BYTES"
+ "WORD-REG-SC-NUMBER" "WORD-SHIFT"
"ZERO-SC-NUMBER"))
#s(sb-cold:package-data
(declare (type (unsigned-byte 8) length)
(type (simple-array (unsigned-byte 8) (*)) vector))
(copy-from-system-area pc (* sb!vm:byte-bits 5)
- vector (* sb!vm:word-bits
+ vector (* sb!vm:n-word-bits
sb!vm:vector-data-offset)
(* length sb!vm:byte-bits))
(let* ((index 0)
(sb!xc:defmacro pick-vector-type (type &rest specs)
`(cond ,@(mapcar #'(lambda (spec)
`(,(if (eq (car spec) t)
- t
- `(subtypep ,type ',(car spec)))
+ t
+ `(subtypep ,type ',(car spec)))
,@(cdr spec)))
specs))))
;;; MAKE-ARRAY for any non-simple array. Thus, there's some value to
;;; making this somewhat efficient, at least not doing full calls to
;;; SUBTYPEP in the easy cases.
-(defun %vector-type-code (type)
+(defun %vector-widetag-and-n-bits (type)
(case type
;; Pick off some easy common cases.
;;
;; on smarter compiler transforms which do the calculation once
;; and for all in any reasonable user programs.)
((t)
- (values #.sb!vm:simple-vector-widetag #.sb!vm:word-bits))
+ (values #.sb!vm:simple-vector-widetag #.sb!vm:n-word-bits))
((character base-char standard-char)
(values #.sb!vm:simple-string-widetag #.sb!vm:byte-bits))
((bit)
(values #.sb!vm:simple-array-complex-long-float-widetag
#!+x86 192
#!+sparc 256))
- (t (values #.sb!vm:simple-vector-widetag #.sb!vm:word-bits))))))
-(defun %complex-vector-type-code (type)
+ (t (values #.sb!vm:simple-vector-widetag #.sb!vm:n-word-bits))))))
+(defun %complex-vector-widetag (type)
(case type
;; Pick off some easy common cases.
((t)
(error "can't specify :DISPLACED-INDEX-OFFSET without :DISPLACED-TO"))
(if (and simple (= array-rank 1))
;; Its a (simple-array * (*))
- (multiple-value-bind (type bits) (%vector-type-code element-type)
+ (multiple-value-bind (type n-bits)
+ (%vector-widetag-and-n-bits element-type)
(declare (type (unsigned-byte 8) type)
- (type (integer 1 256) bits))
+ (type (integer 1 256) n-bits))
(let* ((length (car dimensions))
(array (allocate-vector
type
(ceiling (* (if (= type sb!vm:simple-string-widetag)
(1+ length)
length)
- bits)
- sb!vm:word-bits))))
+ n-bits)
+ sb!vm:n-word-bits))))
(declare (type index length))
(when initial-element-p
(fill array initial-element))
initial-contents initial-element initial-element-p)))
(array (make-array-header
(cond ((= array-rank 1)
- (%complex-vector-type-code element-type))
+ (%complex-vector-widetag element-type))
(simple sb!vm:simple-array-widetag)
(t sb!vm:complex-array-widetag))
array-rank)))
;;;; constants and types
;;; the number of bits to process at a time
-(defconstant unit-bits sb!vm:word-bits)
+(defconstant unit-bits sb!vm:n-word-bits)
;;; the maximum number of bits that can be dealt with in a single call
(defconstant max-bits (ash most-positive-fixnum -2))
;; %BYTE-BLIT (and correspondingly rename the corresponding VOP) and
;; replace the DST-END argument with an N-BYTES argument?
(copy-to-system-area bv
- (* sb!vm:vector-data-offset sb!vm:word-bits)
+ (* sb!vm:vector-data-offset sb!vm:n-word-bits)
sap
offset
(* (length bv) sb!vm:byte-bits)))
(sb!sys:int-sap val)))
(#.sb!vm:signed-reg-sc-number
(with-escaped-value (val)
- (if (logbitp (1- sb!vm:word-bits) val)
- (logior val (ash -1 sb!vm:word-bits))
+ (if (logbitp (1- sb!vm:n-word-bits) val)
+ (logior val (ash -1 sb!vm:n-word-bits))
val)))
(#.sb!vm:unsigned-reg-sc-number
(with-escaped-value (val)
(#.sb!vm:signed-reg-sc-number
(/show0 "case of SIGNED-REG-SC-NUMBER")
(with-escaped-value (val)
- (if (logbitp (1- sb!vm:word-bits) val)
- (logior val (ash -1 sb!vm:word-bits))
+ (if (logbitp (1- sb!vm:n-word-bits) val)
+ (logior val (ash -1 sb!vm:n-word-bits))
val)))
(#.sb!vm:unsigned-reg-sc-number
(/show0 "case of UNSIGNED-REG-SC-NUMBER")
(#.sb!vm:sap-reg-sc-number
(set-escaped-value (sap-int value)))
(#.sb!vm:signed-reg-sc-number
- (set-escaped-value (logand value (1- (ash 1 sb!vm:word-bits)))))
+ (set-escaped-value (logand value (1- (ash 1 sb!vm:n-word-bits)))))
(#.sb!vm:unsigned-reg-sc-number
(set-escaped-value value))
(#.sb!vm:non-descriptor-reg-sc-number
(#.sb!vm:sap-reg-sc-number
(set-escaped-value (sap-int value)))
(#.sb!vm:signed-reg-sc-number
- (set-escaped-value (logand value (1- (ash 1 sb!vm:word-bits)))))
+ (set-escaped-value (logand value (1- (ash 1 sb!vm:n-word-bits)))))
(#.sb!vm:unsigned-reg-sc-number
(set-escaped-value value))
(#.sb!vm:single-reg-sc-number
(frame (do ((cfp (sb!vm:context-register scp sb!vm::cfp-offset))
(f (top-frame) (frame-down f)))
((= cfp (sap-int (frame-pointer f))) f)
- (declare (type (unsigned-byte #.sb!vm:word-bits) cfp))))
+ (declare (type (unsigned-byte #.sb!vm:n-word-bits) cfp))))
(component (breakpoint-data-component data))
(cookie (gethash component *fun-end-cookies*)))
(remhash component *fun-end-cookies*)
(copy-to-system-area thing
(+ (* start sb!vm:byte-bits)
(* sb!vm:vector-data-offset
- sb!vm:word-bits))
+ sb!vm:n-word-bits))
(fd-stream-obuf-sap fd-stream)
(* tail sb!vm:byte-bits)
(* bytes sb!vm:byte-bits)))
(copy-to-system-area thing
(+ (* start sb!vm:byte-bits)
(* sb!vm:vector-data-offset
- sb!vm:word-bits))
+ sb!vm:n-word-bits))
(fd-stream-obuf-sap fd-stream)
0
(* bytes sb!vm:byte-bits)))
(let* ((length (- end start))
(string (make-string length)))
(copy-from-system-area sap (* start sb!vm:byte-bits)
- string (* sb!vm:vector-data-offset sb!vm:word-bits)
+ string (* sb!vm:vector-data-offset
+ sb!vm:n-word-bits)
(* length sb!vm:byte-bits))
string))
(exp (ldb sb!vm:double-float-exponent-byte hi-bits))
(frac (logior (ldb sb!vm:double-float-significand-byte hi-bits)
sb!vm:double-float-hidden-bit))
- (shift (- exp (- sb!vm:double-float-digits sb!vm:word-bits)
+ (shift (- exp (- sb!vm:double-float-digits sb!vm:n-word-bits)
sb!vm:double-float-bias)))
(when (> exp sb!vm:double-float-normal-exponent-max)
(error 'floating-point-invalid-operation :operator 'truncate
:operands (list x)))
- (if (<= shift (- sb!vm:word-bits sb!vm:double-float-digits))
+ (if (<= shift (- sb!vm:n-word-bits sb!vm:double-float-digits))
0
(let* ((res-hi (ash frac shift))
(res (if (plusp shift)
(logior res-hi
(the fixnum
(ash (double-float-low-bits x)
- (- shift sb!vm:word-bits))))
+ (- shift sb!vm:n-word-bits))))
res-hi)))
(declare (type (unsigned-byte 31) res-hi res))
(if (minusp hi-bits)
(def-alien-type-translator system-area-pointer ()
(make-alien-system-area-pointer-type
- :bits #!-alpha sb!vm:word-bits #!+alpha 64))
+ :bits #!-alpha sb!vm:n-word-bits #!+alpha 64))
(def-alien-type-method (system-area-pointer :unparse) (type)
(declare (ignore type))
(def-alien-type-class (integer)
(signed t :type (member t nil)))
-(def-alien-type-translator signed (&optional (bits sb!vm:word-bits))
+(def-alien-type-translator signed (&optional (bits sb!vm:n-word-bits))
(make-alien-integer-type :bits bits))
-(def-alien-type-translator integer (&optional (bits sb!vm:word-bits))
+(def-alien-type-translator integer (&optional (bits sb!vm:n-word-bits))
(make-alien-integer-type :bits bits))
-(def-alien-type-translator unsigned (&optional (bits sb!vm:word-bits))
+(def-alien-type-translator unsigned (&optional (bits sb!vm:n-word-bits))
(make-alien-integer-type :bits bits :signed nil))
(def-alien-type-method (integer :unparse) (type)
;;; FIXME: Check to make sure that we aren't attaching user-readable
;;; stuff to CL:BOOLEAN in any way which impairs ANSI compliance.
-(def-alien-type-translator boolean (&optional (bits sb!vm:word-bits))
+(def-alien-type-translator boolean (&optional (bits sb!vm:n-word-bits))
(make-alien-boolean-type :bits bits :signed nil))
(def-alien-type-method (boolean :unparse) (type)
;;;; the POINTER type
(def-alien-type-class (pointer :include (alien-value (:bits
- #!-alpha sb!vm:word-bits
+ #!-alpha
+ sb!vm:n-word-bits
#!+alpha 64)))
(to nil :type (or alien-type null)))
(sb!kernel:%raw-bits object offset))
(defun %set-raw-bits (object offset value)
- (declare (type index offset) (type (unsigned-byte #.sb!vm:word-bits) value))
+ (declare (type index offset))
+ (declare (type (unsigned-byte #.sb!vm:n-word-bits) value))
(setf (sb!kernel:%raw-bits object offset) value))
(defun make-single-float (x) (make-single-float x))
(defvar *meta-room-info* (make-array 256 :initial-element nil))
(dolist (obj *primitive-objects*)
- (let ((header (primitive-object-header obj))
+ (let ((widetag (primitive-object-widetag obj))
(lowtag (primitive-object-lowtag obj))
(name (primitive-object-name obj))
(variable (primitive-object-variable-length obj))
(size (primitive-object-size obj)))
(cond
((not lowtag))
- ((not header)
+ ((not widetag)
(let ((info (make-room-info :name name
:kind :lowtag))
(lowtag (symbol-value lowtag)))
(setf (svref *meta-room-info* (logior lowtag (ash i 3))) info))))
(variable)
(t
- (setf (svref *meta-room-info* (symbol-value header))
+ (setf (svref *meta-room-info* (symbol-value widetag))
(make-room-info :name name
:kind :fixed
:length size))))))
;; Blast the string into place.
(sb-kernel:copy-to-system-area (the simple-string s)
(* sb-vm:vector-data-offset
- sb-vm:word-bits)
+ sb-vm:n-word-bits)
string-sap 0
(* (1+ n) sb-vm:byte-bits))
;; Blast the pointer to the string into place.
(sb-kernel:copy-from-system-area
(alien-sap buf) 0
string (* sb-vm:vector-data-offset
- sb-vm:word-bits)
+ sb-vm:n-word-bits)
(* count sb-vm:byte-bits))
(write-string string stream
:end count)))))))))))
(sb!alien:def-alien-routine "save" (sb!alien:boolean)
(file sb!c-call:c-string)
- (initial-function (sb!alien:unsigned #.sb!vm:word-bits)))
+ (initial-function (sb!alien:unsigned #.sb!vm:n-word-bits)))
;;; FIXME: When this is run without the PURIFY option,
;;; it seems to save memory all the way up to the high-water mark,
(when (/= start +in-buffer-extra+)
(bit-bash-copy ibuf (+ (* +in-buffer-extra+ sb!vm:byte-bits)
(* sb!vm:vector-data-offset
- sb!vm:word-bits))
+ sb!vm:n-word-bits))
ibuf (+ (the index (* start sb!vm:byte-bits))
(* sb!vm:vector-data-offset
- sb!vm:word-bits))
+ sb!vm:n-word-bits))
(* count sb!vm:byte-bits)))
(setf (lisp-stream-in-index stream) (1+ start))
(code-char (aref ibuf start))))))
(funcall (lisp-stream-bin stream) stream eof-error-p eof-value))
(t
(unless (zerop start)
- (bit-bash-copy ibuf (* sb!vm:vector-data-offset sb!vm:word-bits)
+ (bit-bash-copy ibuf (* sb!vm:vector-data-offset sb!vm:n-word-bits)
ibuf (+ (the index (* start sb!vm:byte-bits))
(* sb!vm:vector-data-offset
- sb!vm:word-bits))
+ sb!vm:n-word-bits))
(* count sb!vm:byte-bits)))
(setf (lisp-stream-in-index stream) (1+ start))
(aref ibuf start)))))
(ecase units
(:bits 1)
(:bytes sb!vm:byte-bits)
- (:words sb!vm:word-bits))))
+ (:words sb!vm:n-word-bits))))
(error "unknown size for alien type ~S"
(unparse-alien-type alien-type)))))
\f
(let ((result (make-string length)))
(sb!kernel:copy-from-system-area (alien-sap ptr) 0
result (* sb!vm:vector-data-offset
- sb!vm:word-bits)
+ sb!vm:n-word-bits)
(* length sb!vm:byte-bits))
result)))))
(- (sb!impl::make-double-float
(dpb (ash (random-chunk state)
(- sb!vm:double-float-digits random-chunk-length
- sb!vm:word-bits))
+ sb!vm:n-word-bits))
sb!vm:double-float-significand-byte
(sb!impl::double-float-high-bits 1d0))
(random-chunk state))
(- (sb!impl::make-double-float
(dpb (ash (sb!vm::random-mt19937 state-vector)
(- sb!vm:double-float-digits random-chunk-length
- sb!vm:word-bits))
+ sb!vm:n-word-bits))
sb!vm:double-float-significand-byte
(sb!impl::double-float-high-bits 1d0))
(sb!vm::random-mt19937 state-vector))
(/hexstr length)
(/hexstr vector)
(copy-from-system-area pc (* sb!vm:byte-bits 2)
- vector (* sb!vm:word-bits
+ vector (* sb!vm:n-word-bits
sb!vm:vector-data-offset)
(* length sb!vm:byte-bits))
(let* ((index 0)
,size vector-data-offset other-pointer-lowtag ,scs
,element-type data-vector-set)))
(def-small-data-vector-frobs (type bits)
- (let* ((elements-per-word (floor word-bits bits))
+ (let* ((elements-per-word (floor n-word-bits bits))
(bit-shift (1- (integer-length elements-per-word))))
`(progn
(define-vop (,(symbolicate 'data-vector-ref/ type))
(eval-when (:compile-toplevel :load-toplevel :execute)
-(defconstant word-bits 32
+(defconstant n-word-bits 32
#!+sb-doc
"Number of bits per word where a word holds one lisp descriptor.")
#!+sb-doc
"Number of bits per byte where a byte is the smallest addressable object.")
-(defconstant word-shift (1- (integer-length (/ word-bits byte-bits)))
+(defconstant word-shift (1- (integer-length (/ n-word-bits byte-bits)))
#!+sb-doc
"Number of bits to shift between word addresses and byte addresses.")
-(defconstant word-bytes (/ word-bits byte-bits)
+(defconstant word-bytes (/ n-word-bits byte-bits)
#!+sb-doc
"Number of bytes in a word.")
(+ (byte-size single-float-significand-byte) 1))
(defconstant double-float-digits
- (+ (byte-size double-float-significand-byte) word-bits 1))
+ (+ (byte-size double-float-significand-byte) n-word-bits 1))
;; Values in 17f code seem to be same as HPPA. These values are from
;; DEC Assembly Language Programmers guide. The active bits are
(function-p (if (intersection headers *fun-header-widetags*)
(if (subsetp headers *fun-header-widetags*)
t
- (error "Can't test for mix of function subtypes ~
+ (error "can't test for mix of function subtypes ~
and normal header types."))
nil)))
(unless type-codes
- (error "Must supply at least on type for test-type."))
+ (error "must supply at least one type for test-type"))
(cond
(fixnump
(when (remove-if #'(lambda (x)
(or (= x even-fixnum-lowtag)
(= x odd-fixnum-lowtag)))
lowtags)
- (error "Can't mix fixnum testing with other lowtags."))
+ (error "can't mix fixnum testing with other lowtags"))
(when function-p
- (error "Can't mix fixnum testing with function subtype testing."))
+ (error "can't mix fixnum testing with function subtype testing"))
(when immediates
- (error "Can't mix fixnum testing with other immediates."))
+ (error "can't mix fixnum testing with other immediates"))
(if headers
`(%test-fixnum-and-headers ,value ,temp ,target ,not-p
',(canonicalize-headers headers))
`(%test-fixnum ,value ,temp ,target ,not-p)))
(immediates
(when headers
- (error "Can't mix testing of immediates with testing of headers."))
+ (error "can't mix testing of immediates with testing of headers"))
(when lowtags
- (error "Can't mix testing of immediates with testing of lowtags."))
+ (error "can't mix testing of immediates with testing of lowtags"))
(when (cdr immediates)
- (error "Can't test multiple immediates at the same time."))
+ (error "can't test multiple immediates at the same time"))
`(%test-immediate ,value ,temp ,target ,not-p ,(car immediates)))
(lowtags
(when (cdr lowtags)
- (error "Can't test multiple lowtags at the same time."))
+ (error "can't test multiple lowtags at the same time"))
(if headers
`(%test-lowtag-and-headers
,value ,temp ,target ,not-p ,(car lowtags)
`(%test-headers ,value ,temp ,target ,not-p ,function-p
',(canonicalize-headers headers)))
(t
- (error "Nothing to test?"))))))
+ (error "nothing to test?"))))))
(defun %test-fixnum (value temp target not-p)
(assemble ()
'length
`(+ length ,n-pad-elements)))
(n-words-form
- (if (>= n-bits-per-element sb!vm:word-bits)
+ (if (>= n-bits-per-element sb!vm:n-word-bits)
`(* ,padded-length-form
(the fixnum ; i.e., not RATIO
- ,(/ n-bits-per-element sb!vm:word-bits)))
- (let ((n-elements-per-word (/ sb!vm:word-bits
+ ,(/ n-bits-per-element sb!vm:n-word-bits)))
+ (let ((n-elements-per-word (/ sb!vm:n-word-bits
n-bits-per-element)))
(declare (type index n-elements-per-word)) ; i.e., not RATIO
`(ceiling ,padded-length-form ,n-elements-per-word))))
;;; less-portable implementation of CLEAR-BIT-VECTOR:
;;; (do ((i sb!vm:vector-data-offset (1+ i))
;;; (end (+ sb!vm:vector-data-offset
-;;; (ash (+ (length vec) (1- sb!vm:word-bits))
-;;; (- (1- (integer-length sb!vm:word-bits)))))))
+;;; (ash (+ (length vec) (1- sb!vm:n-word-bits))
+;;; (- (1- (integer-length sb!vm:n-word-bits)))))))
;;; ((= i end) vec)
;;; (setf (sb!kernel:%raw-bits vec i) 0)))
;;; We could use this in the target SBCL if the new version turns out to be a
;; 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
(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:n-word-bits 32))
(aver (= sb!vm:byte-bits 8))
(if (not *genesis-byte-order-swap-p*)
word
(defun maybe-byte-swap-short (short)
(declare (type (unsigned-byte 16) short))
- (aver (= sb!vm:word-bits 32))
+ (aver (= sb!vm:n-word-bits 32))
(aver (= sb!vm:byte-bits 8))
(if (not *genesis-byte-order-swap-p*)
short
(ldb (byte 8 ,(* i 8)) new-value)))))
`(progn
(defun ,name (byte-vector byte-index)
- (aver (= sb!vm:word-bits 32))
+ (aver (= sb!vm:n-word-bits 32))
(aver (= sb!vm:byte-bits 8))
(ecase sb!c:*backend-byte-order*
(:little-endian
(: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:n-word-bits 32))
(aver (= sb!vm:byte-bits 8))
(ecase sb!c:*backend-byte-order*
(:little-endian
(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)
(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)))
(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)
(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)))
"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]~];~%"
(cdr :ref-trans cdr :set-trans sb!c::%rplacd :init :arg))
(define-primitive-object (instance :lowtag instance-pointer-lowtag
- :header instance-header-widetag
+ :widetag instance-header-widetag
:alloc-trans %make-instance)
(slots :rest-p t))
(define-primitive-object (bignum :lowtag other-pointer-lowtag
- :header bignum-widetag
+ :widetag bignum-widetag
:alloc-trans sb!bignum::%allocate-bignum)
(digits :rest-p t :c-type #!-alpha "long" #!+alpha "u32"))
(define-primitive-object (ratio :type ratio
:lowtag other-pointer-lowtag
- :header ratio-widetag
+ :widetag ratio-widetag
:alloc-trans %make-ratio)
(numerator :type integer
:ref-known (flushable movable)
:init :arg))
(define-primitive-object (single-float :lowtag other-pointer-lowtag
- :header single-float-widetag)
+ :widetag single-float-widetag)
(value :c-type "float"))
(define-primitive-object (double-float :lowtag other-pointer-lowtag
- :header double-float-widetag)
+ :widetag double-float-widetag)
(filler)
(value :c-type "double" :length 2))
#!+long-float
(define-primitive-object (long-float :lowtag other-pointer-lowtag
- :header long-float-widetag)
+ :widetag long-float-widetag)
#!+sparc (filler)
(value :c-type "long double" :length #!+x86 3 #!+sparc 4))
(define-primitive-object (complex :type complex
:lowtag other-pointer-lowtag
- :header complex-widetag
+ :widetag complex-widetag
:alloc-trans %make-complex)
(real :type real
:ref-known (flushable movable)
:init :arg))
(define-primitive-object (array :lowtag other-pointer-lowtag
- :header t)
+ :widetag t)
(fill-pointer :type index
:ref-trans %array-fill-pointer
:ref-known (flushable foldable)
(define-primitive-object (vector :type vector
:lowtag other-pointer-lowtag
- :header t)
+ :widetag t)
(length :ref-trans sb!c::vector-length
:type index)
(data :rest-p t :c-type #!-alpha "unsigned long" #!+alpha "u32"))
(define-primitive-object (code :type code-component
:lowtag other-pointer-lowtag
- :header t)
+ :widetag t)
(code-size :type index
:ref-known (flushable movable)
:ref-trans %code-code-size)
(define-primitive-object (fdefn :type fdefn
:lowtag other-pointer-lowtag
- :header fdefn-widetag)
+ :widetag fdefn-widetag)
(name :ref-trans fdefn-name)
(fun :type (or function null) :ref-trans fdefn-fun)
(raw-addr :c-type #!-alpha "char *" #!+alpha "u32"))
;;; which are also subtypes of Common Lisp's FUNCTION type)
(define-primitive-object (simple-fun :type function
:lowtag fun-pointer-lowtag
- :header simple-fun-header-widetag)
+ :widetag simple-fun-header-widetag)
#!-x86 (self :ref-trans %simple-fun-self
:set-trans (setf %simple-fun-self))
#!+x86 (self
:set-trans (setf %simple-fun-type))
(code :rest-p t :c-type "unsigned char"))
-(define-primitive-object (return-pc :lowtag other-pointer-lowtag :header t)
+(define-primitive-object (return-pc :lowtag other-pointer-lowtag :widetag t)
(return-point :c-type "unsigned char" :rest-p t))
(define-primitive-object (closure :lowtag fun-pointer-lowtag
- :header closure-header-widetag)
+ :widetag closure-header-widetag)
(fun :init :arg :ref-trans %closure-fun)
(info :rest-p t))
(define-primitive-object (funcallable-instance
:lowtag fun-pointer-lowtag
- :header funcallable-instance-header-widetag
+ :widetag funcallable-instance-header-widetag
:alloc-trans %make-funcallable-instance)
#!-x86
(fun
(info :rest-p t))
(define-primitive-object (value-cell :lowtag other-pointer-lowtag
- :header value-cell-header-widetag
+ :widetag value-cell-header-widetag
:alloc-trans make-value-cell)
(value :set-trans value-cell-set
:set-known (unsafe)
#!+alpha
(define-primitive-object (sap :lowtag other-pointer-lowtag
- :header sap-widetag)
+ :widetag sap-widetag)
(padding)
(pointer :c-type "char *" :length 2))
#!-alpha
(define-primitive-object (sap :lowtag other-pointer-lowtag
- :header sap-widetag)
+ :widetag sap-widetag)
(pointer :c-type "char *"))
(define-primitive-object (weak-pointer :type weak-pointer
:lowtag other-pointer-lowtag
- :header weak-pointer-widetag
+ :widetag weak-pointer-widetag
:alloc-trans make-weak-pointer)
(value :ref-trans sb!c::%weak-pointer-value :ref-known (flushable)
:init :arg)
(flushable movable))
(define-primitive-object (symbol :lowtag other-pointer-lowtag
- :header symbol-header-widetag
+ :widetag symbol-header-widetag
#!-x86 :alloc-trans #!-x86 make-symbol)
(value :set-trans %set-symbol-value
:init :unbound)
(define-primitive-object (complex-single-float
:lowtag other-pointer-lowtag
- :header complex-single-float-widetag)
+ :widetag complex-single-float-widetag)
(real :c-type "float")
(imag :c-type "float"))
(define-primitive-object (complex-double-float
:lowtag other-pointer-lowtag
- :header complex-double-float-widetag)
+ :widetag complex-double-float-widetag)
(filler)
(real :c-type "double" :length 2)
(imag :c-type "double" :length 2))
#!+long-float
(define-primitive-object (complex-long-float
:lowtag other-pointer-lowtag
- :header complex-long-float-widetag)
+ :widetag complex-long-float-widetag)
#!+sparc (filler)
(real :c-type "long double" :length #!+x86 3 #!+sparc 4)
(imag :c-type "long double" :length #!+x86 3 #!+sparc 4))
(setf (code-header-ref code-obj sb!vm:code-trace-table-offset-slot) length)
(copy-to-system-area trace-table
- (* sb!vm:vector-data-offset sb!vm:word-bits)
+ (* sb!vm:vector-data-offset sb!vm:n-word-bits)
fill-ptr
0
trace-table-bits)
(foldable flushable movable))
(defknown %fixnum-digit-with-correct-sign (bignum-element-type)
- (signed-byte #.sb!vm:word-bits)
+ (signed-byte #.sb!vm:n-word-bits)
(foldable flushable movable))
(defknown (%ashl %ashr %digit-logical-shift-right)
(def!struct (primitive-object (:make-load-form-fun just-dump-it-normally))
(name nil :type symbol)
- (header nil :type symbol)
+ (widetag nil :type symbol)
(lowtag nil :type symbol)
(options nil :type list)
(slots nil :type list)
name))
(defmacro define-primitive-object
- ((name &key header lowtag alloc-trans (type t))
+ ((name &key lowtag widetag alloc-trans (type t))
&rest slot-specs)
(collect ((slots) (exports) (constants) (forms) (inits))
- (let ((offset (if header 1 0))
+ (let ((offset (if widetag 1 0))
(variable-length nil))
(dolist (spec slot-specs)
(when variable-length
(constants `(defconstant ,size ,offset))
(exports size)))
(when alloc-trans
- (forms `(def-alloc ,alloc-trans ,offset ,variable-length ,header
+ (forms `(def-alloc ,alloc-trans ,offset ,variable-length ,widetag
,lowtag ',(inits))))
`(progn
(eval-when (:compile-toplevel :load-toplevel :execute)
(%define-primitive-object
',(make-primitive-object :name name
- :header header
+ :widetag widetag
:lowtag lowtag
:slots (slots)
:size offset
;;; FIXME: Add a comment telling whether this holds for all vectors
;;; or only for vectors based on simple arrays (non-adjustable, etc.).
(defconstant vector-data-bit-offset
- (* sb!vm:vector-data-offset sb!vm:word-bits))
+ (* sb!vm:vector-data-offset sb!vm:n-word-bits))
;;; We need to define these predicates, since the TYPEP source
;;; transform picks whichever predicate was defined last when there
#+nil
(macrolet
((frob (type bits)
- (let ((elements-per-word (truncate sb!vm:word-bits bits)))
+ (let ((elements-per-word (truncate sb!vm:n-word-bits bits)))
`(progn
(deftransform data-vector-ref ((vector index)
(,type *))
(floor index ,',elements-per-word)
(ldb ,(ecase sb!vm:target-byte-order
(:little-endian '(byte ,bits (* bit ,bits)))
- (:big-endian '(byte ,bits (- sb!vm:word-bits
+ (:big-endian '(byte ,bits (- sb!vm:n-word-bits
(* (1+ bit) ,bits)))))
(%raw-bits vector (+ word sb!vm:vector-data-offset)))))
(deftransform data-vector-set ((vector index new-value)
(setf (ldb ,(ecase sb!vm:target-byte-order
(:little-endian '(byte ,bits (* bit ,bits)))
(:big-endian
- '(byte ,bits (- sb!vm:word-bits
+ '(byte ,bits (- sb!vm:n-word-bits
(* (1+ bit) ,bits)))))
(%raw-bits vector (+ word sb!vm:vector-data-offset)))
new-value)))))))
(end (+ sb!vm:vector-data-offset
(truncate (the index
(+ (length bit-array-1)
- sb!vm:word-bits -1))
- sb!vm:word-bits))))
+ sb!vm:n-word-bits -1))
+ sb!vm:n-word-bits))))
((= index end) result-bit-array)
(declare (optimize (speed 3) (safety 0))
(type index index end))
(end (+ sb!vm:vector-data-offset
(truncate (the index
(+ (length bit-array)
- (1- sb!vm:word-bits)))
- sb!vm:word-bits))))
+ (1- sb!vm:n-word-bits)))
+ sb!vm:n-word-bits))))
((= index end) result-bit-array)
(declare (optimize (speed 3) (safety 0))
(type index index end))
\f
;;;; FIXME: I'm not sure where to put this. -- WHN 19990817
-(deftype sb!vm:word () `(unsigned-byte ,sb!vm:word-bits))
+(deftype sb!vm:word () `(unsigned-byte ,sb!vm:n-word-bits))
\f
;;;; implementation-dependent DEFTYPEs
;;; internal time format. (Note: not a FIXNUM, ouch..)
(sb!xc:deftype internal-time () 'unsigned-byte)
-(sb!xc:deftype bignum-element-type () `(unsigned-byte ,sb!vm:word-bits))
+(sb!xc:deftype bignum-element-type () `(unsigned-byte ,sb!vm:n-word-bits))
(sb!xc:deftype bignum-type () 'bignum)
(sb!xc:deftype bignum-index () 'index)
\f
(if (and (numeric-type-p size)
(csubtypep size (specifier-type 'integer)))
(let ((size-high (numeric-type-high size)))
- (if (and size-high (<= size-high sb!vm:word-bits))
+ (if (and size-high (<= size-high sb!vm:n-word-bits))
(specifier-type `(unsigned-byte ,size-high))
(specifier-type 'unsigned-byte)))
*universal-type*)))
(let ((size-high (numeric-type-high size))
(posn-high (numeric-type-high posn)))
(if (and size-high posn-high
- (<= (+ size-high posn-high) sb!vm:word-bits))
+ (<= (+ size-high posn-high) sb!vm:n-word-bits))
(specifier-type `(unsigned-byte ,(+ size-high posn-high)))
(specifier-type 'unsigned-byte)))
*universal-type*)))
(high (numeric-type-high int))
(low (numeric-type-low int)))
(if (and size-high posn-high high low
- (<= (+ size-high posn-high) sb!vm:word-bits))
+ (<= (+ size-high posn-high) sb!vm:n-word-bits))
(specifier-type
(list (if (minusp low) 'signed-byte 'unsigned-byte)
(max (integer-length high)
(high (numeric-type-high int))
(low (numeric-type-low int)))
(if (and size-high posn-high high low
- (<= (+ size-high posn-high) sb!vm:word-bits))
+ (<= (+ size-high posn-high) sb!vm:n-word-bits))
(specifier-type
(list (if (minusp low) 'signed-byte 'unsigned-byte)
(max (integer-length high)
(deftransform %ldb ((size posn int)
(fixnum fixnum integer)
- (unsigned-byte #.sb!vm:word-bits))
+ (unsigned-byte #.sb!vm:n-word-bits))
"convert to inline logical operations"
`(logand (ash int (- posn))
- (ash ,(1- (ash 1 sb!vm:word-bits))
- (- size ,sb!vm:word-bits))))
+ (ash ,(1- (ash 1 sb!vm:n-word-bits))
+ (- size ,sb!vm:n-word-bits))))
(deftransform %mask-field ((size posn int)
(fixnum fixnum integer)
- (unsigned-byte #.sb!vm:word-bits))
+ (unsigned-byte #.sb!vm:n-word-bits))
"convert to inline logical operations"
`(logand int
- (ash (ash ,(1- (ash 1 sb!vm:word-bits))
- (- size ,sb!vm:word-bits))
+ (ash (ash ,(1- (ash 1 sb!vm:n-word-bits))
+ (- size ,sb!vm:n-word-bits))
posn)))
;;; Note: for %DPB and %DEPOSIT-FIELD, we can't use
(deftransform %dpb ((new size posn int)
*
- (unsigned-byte #.sb!vm:word-bits))
+ (unsigned-byte #.sb!vm:n-word-bits))
"convert to inline logical operations"
`(let ((mask (ldb (byte size 0) -1)))
(logior (ash (logand new mask) posn)
(deftransform %dpb ((new size posn int)
*
- (signed-byte #.sb!vm:word-bits))
+ (signed-byte #.sb!vm:n-word-bits))
"convert to inline logical operations"
`(let ((mask (ldb (byte size 0) -1)))
(logior (ash (logand new mask) posn)
(deftransform %deposit-field ((new size posn int)
*
- (unsigned-byte #.sb!vm:word-bits))
+ (unsigned-byte #.sb!vm:n-word-bits))
"convert to inline logical operations"
`(let ((mask (ash (ldb (byte size 0) -1) posn)))
(logior (logand new mask)
(deftransform %deposit-field ((new size posn int)
*
- (signed-byte #.sb!vm:word-bits))
+ (signed-byte #.sb!vm:n-word-bits))
"convert to inline logical operations"
`(let ((mask (ash (ldb (byte size 0) -1) posn)))
(logior (logand new mask)
(+ (ash word sb!vm:byte-bits) byte)
(+ word (ash byte bit-shift))))
(incf bit-shift sb!vm:byte-bits)))
- (format stream "#X~V,'0X" (ash sb!vm:word-bits -2) word)))))
+ (format stream "#X~V,'0X" (ash sb!vm:n-word-bits -2) word)))))
\f
(defvar *default-dstate-hooks* (list #'lra-hook))
;;;; bit, 2-bit, and 4-bit vectors
(macrolet ((def-small-data-vector-frobs (type bits)
- (let* ((elements-per-word (floor sb!vm:word-bits bits))
+ (let* ((elements-per-word (floor sb!vm:n-word-bits bits))
(bit-shift (1- (integer-length elements-per-word))))
`(progn
(define-vop (,(symbolicate 'data-vector-ref/ type))
(values 0 (1+ length) nil nil))
(t
(sb!kernel:copy-from-system-area sap (* byte-bits (1+ offset))
- vector (* word-bits
+ vector (* n-word-bits
vector-data-offset)
(* length byte-bits))
(collect ((sc-offsets)
\f
;;;; machine architecture parameters
-(defconstant word-bits 32
+(defconstant n-word-bits 32
#!+sb-doc
"Number of bits per word where a word holds one lisp descriptor.")
#!+sb-doc
"Number of bits per byte where a byte is the smallest addressable object.")
-(defconstant word-shift (1- (integer-length (/ word-bits byte-bits)))
+(defconstant word-shift (1- (integer-length (/ n-word-bits byte-bits)))
#!+sb-doc
"Number of bits to shift between word addresses and byte addresses.")
-(defconstant word-bytes (/ word-bits byte-bits)
+(defconstant word-bytes (/ n-word-bits byte-bits)
#!+sb-doc
"Number of bytes in a word.")
(+ (byte-size single-float-significand-byte) 1))
(defconstant double-float-digits
- (+ (byte-size double-float-significand-byte) word-bits 1))
+ (+ (byte-size double-float-significand-byte) n-word-bits 1))
(defconstant long-float-digits
- (+ (byte-size long-float-significand-byte) word-bits 1))
+ (+ (byte-size long-float-significand-byte) n-word-bits 1))
;;; pfw -- from i486 microprocessor programmer's reference manual
(defconstant float-invalid-trap-bit (ash 1 0))
;;; for internal versions, especially for internal versions off the
;;; main CVS branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.pre7.58"
+"0.pre7.59"
projects / sbcl.git / commitdiff