more renaming..
..renamed BYTE-BITS to N-BYTE-BITS
..renamed WORD-BYTES to N-WORD-BYTES
got rid of various redundant SB!VM: prefixes
exported LRA-SAVE-OFFSET, OCFP-SAVE-OFFSET, and NFP-SAVE-OFFSET
from SB!VM, since debug internals need 'em
"SHORT" "UNSIGNED-CHAR" "UNSIGNED-INT"
"UNSIGNED-LONG" "UNSIGNED-SHORT" "VOID"))
- #!+sb-dyncount
- #s(sb-cold:package-data
- :name "SB!DYNCOUNT"
- :doc "private: some somewhat-stale code for collecting runtime statistics"
- :use ("CL" "SB!ALIEN-INTERNALS" "SB!ALIEN" "SB!BIGNUM"
- "SB!EXT" "SB!INT" "SB!KERNEL" "SB!ASSEM" "SB!SYS")
- :export ("*COLLECT-DYNAMIC-STATISTICS*" "COUNT-ME"
- "DYNCOUNT-INFO-COUNTS" "DYNCOUNT-INFO-COSTS"
- "IR2-COMPONENT-DYNCOUNT-INFO"
- "DYNCOUNT-INFO" "DYNCOUNT-INFO-P"))
-
- #s(sb-cold:package-data
- :name "SB!FASL"
- :doc "private: stuff related to FASL load/dump logic (and GENESIS)"
- :use ("CL" "SB!ALIEN" "SB!ASSEM" "SB!BIGNUM" "SB!C" "SB!C-CALL"
- "SB!EXT" "SB!INT" "SB!KERNEL" "SB!SYS")
- :export ("*ASSEMBLER-ROUTINES*"
- "+BACKEND-FASL-FILE-IMPLEMENTATION+"
- "*FASL-FILE-TYPE*"
- "CLOSE-FASL-OUTPUT"
- "DUMP-ASSEMBLER-ROUTINES"
- "DUMP-OBJECT"
- "FASL-CONSTANT-ALREADY-DUMPED-P"
- "+FASL-FILE-VERSION+"
- "FASL-DUMP-COLD-LOAD-FORM" "FASL-DUMP-COMPONENT"
- "FASL-DUMP-COLD-FSET"
- "FASL-DUMP-LOAD-TIME-VALUE" "FASL-DUMP-LOAD-TIME-VALUE-LAMBDA"
- "FASL-DUMP-SOURCE-INFO" "FASL-DUMP-TOP-LEVEL-LAMBDA-CALL"
- "FASL-NOTE-HANDLE-FOR-CONSTANT"
- "FASL-OUTPUT" "FASL-OUTPUT-P"
- "FASL-OUTPUT-ENTRY-TABLE" "FASL-OUTPUT-STREAM"
- "FASL-VALIDATE-STRUCTURE"
- "*!LOAD-TIME-VALUES*"
- "LOAD-TYPE-PREDICATE"
- "OPEN-FASL-OUTPUT"
- "*!REVERSED-COLD-TOPLEVELS*"
- "*STATIC-FOREIGN-SYMBOLS*"))
-
- ;; This package is a grab bag for things which used to be internal
- ;; symbols in package COMMON-LISP. Lots of these symbols are accessed
- ;; with explicit SB!IMPL:: prefixes in the code. It would be nice to
- ;; reduce the use of this practice, so if symbols from here which are
- ;; accessed that way are found to belong more appropriately in
- ;; an existing package (e.g. KERNEL or SYS or EXT or FASL), I
- ;; (WHN 19990223) encourage maintainers to move them there..
- ;;
- ;; ..except that it's getting so big and crowded that maybe it
- ;; should be split up, too.
- #s(sb-cold:package-data
- :name "SB!IMPL"
- :doc "private: a grab bag of implementation details"
- :use ("CL" "SB!ALIEN" "SB!BIGNUM" "SB!C-CALL" "SB!DEBUG" "SB!EXT"
- "SB!FASL" "SB!GRAY" "SB!INT" "SB!KERNEL" "SB!SYS"))
-
#s(sb-cold:package-data
:name "SB!DEBUG"
:doc
"ADD-OFFS-NOTE-HOOK" "ADD-OFFS-COMMENT-HOOK"
"DSTATE-CUR-ADDR" "DSTATE-NEXT-ADDR"))
+ #!+sb-dyncount
+ #s(sb-cold:package-data
+ :name "SB!DYNCOUNT"
+ :doc "private: some somewhat-stale code for collecting runtime statistics"
+ :use ("CL" "SB!ALIEN-INTERNALS" "SB!ALIEN" "SB!BIGNUM"
+ "SB!EXT" "SB!INT" "SB!KERNEL" "SB!ASSEM" "SB!SYS")
+ :export ("*COLLECT-DYNAMIC-STATISTICS*" "COUNT-ME"
+ "DYNCOUNT-INFO-COUNTS" "DYNCOUNT-INFO-COSTS"
+ "IR2-COMPONENT-DYNCOUNT-INFO"
+ "DYNCOUNT-INFO" "DYNCOUNT-INFO-P"))
+
+ #s(sb-cold:package-data
+ :name "SB!FASL"
+ :doc "private: stuff related to FASL load/dump logic (and GENESIS)"
+ :use ("CL" "SB!ALIEN" "SB!ASSEM" "SB!BIGNUM" "SB!C" "SB!C-CALL"
+ "SB!EXT" "SB!INT" "SB!KERNEL" "SB!SYS")
+ :export ("*ASSEMBLER-ROUTINES*"
+ "+BACKEND-FASL-FILE-IMPLEMENTATION+"
+ "*FASL-FILE-TYPE*"
+ "CLOSE-FASL-OUTPUT"
+ "DUMP-ASSEMBLER-ROUTINES"
+ "DUMP-OBJECT"
+ "FASL-CONSTANT-ALREADY-DUMPED-P"
+ "+FASL-FILE-VERSION+"
+ "FASL-DUMP-COLD-LOAD-FORM" "FASL-DUMP-COMPONENT"
+ "FASL-DUMP-COLD-FSET"
+ "FASL-DUMP-LOAD-TIME-VALUE" "FASL-DUMP-LOAD-TIME-VALUE-LAMBDA"
+ "FASL-DUMP-SOURCE-INFO" "FASL-DUMP-TOP-LEVEL-LAMBDA-CALL"
+ "FASL-NOTE-HANDLE-FOR-CONSTANT"
+ "FASL-OUTPUT" "FASL-OUTPUT-P"
+ "FASL-OUTPUT-ENTRY-TABLE" "FASL-OUTPUT-STREAM"
+ "FASL-VALIDATE-STRUCTURE"
+ "*!LOAD-TIME-VALUES*"
+ "LOAD-TYPE-PREDICATE"
+ "OPEN-FASL-OUTPUT"
+ "*!REVERSED-COLD-TOPLEVELS*"
+ "*STATIC-FOREIGN-SYMBOLS*"))
+
+ ;; This package is a grab bag for things which used to be internal
+ ;; symbols in package COMMON-LISP. Lots of these symbols are accessed
+ ;; with explicit SB!IMPL:: prefixes in the code. It would be nice to
+ ;; reduce the use of this practice, so if symbols from here which are
+ ;; accessed that way are found to belong more appropriately in
+ ;; an existing package (e.g. KERNEL or SYS or EXT or FASL), I
+ ;; (WHN 19990223) encourage maintainers to move them there..
+ ;;
+ ;; ..except that it's getting so big and crowded that maybe it
+ ;; should be split up, too.
+ #s(sb-cold:package-data
+ :name "SB!IMPL"
+ :doc "private: a grab bag of implementation details"
+ :use ("CL" "SB!ALIEN" "SB!BIGNUM" "SB!C-CALL" "SB!DEBUG" "SB!EXT"
+ "SB!FASL" "SB!GRAY" "SB!INT" "SB!KERNEL" "SB!SYS"))
+
#s(sb-cold:package-data
:name "SB!EXT"
:doc "public: miscellaneous supported extensions to the ANSI Lisp spec"
"BASE-CHAR-STACK-SC-NUMBER" "BASE-CHAR-WIDETAG"
"BIGNUM-DIGITS-OFFSET" "BIGNUM-WIDETAG" "BINDING-SIZE"
"BINDING-SYMBOL-SLOT" "BINDING-VALUE-SLOT" "BREAKPOINT-TRAP"
- "BYTE-BITS" "BYTE-REG-SC-NUMBER"
+ "N-BYTE-BITS" "BYTE-REG-SC-NUMBER"
"CATCH-BLOCK-CURRENT-CODE-SLOT"
"CATCH-BLOCK-CURRENT-CONT-SLOT" "CATCH-BLOCK-CURRENT-UWP-SLOT"
"CATCH-BLOCK-ENTRY-PC-SLOT" "CATCH-BLOCK-PREVIOUS-CATCH-SLOT"
"LONG-FLOAT-WIDETAG"
"LONG-FLOAT-VALUE-SLOT" "LONG-REG-SC-NUMBER"
"LONG-STACK-SC-NUMBER"
- "N-LOWTAG-BITS" "LOWTAG-LIMIT" "LOWTAG-MASK"
+ "LOWTAG-LIMIT" "LOWTAG-MASK"
+ "LRA-SAVE-OFFSET"
"MEMORY-USAGE" "MOST-POSITIVE-COST"
- "NEGATIVE-IMMEDIATE-SC-NUMBER" "NON-DESCRIPTOR-REG-SC-NUMBER"
+ "N-LOWTAG-BITS"
+ "NEGATIVE-IMMEDIATE-SC-NUMBER"
+ "NFP-SAVE-OFFSET"
+ "NON-DESCRIPTOR-REG-SC-NUMBER"
"NULL-SC-NUMBER"
"OBJECT-NOT-LIST-TRAP" "OBJECT-NOT-INSTANCE-TRAP"
+ "OCFP-SAVE-OFFSET"
"ODD-FIXNUM-LOWTAG"
"OFFSET-STATIC-SYMBOL" "OTHER-IMMEDIATE-0-LOWTAG"
"OTHER-IMMEDIATE-1-LOWTAG" "OTHER-POINTER-LOWTAG"
"WEAK-POINTER-BROKEN-SLOT" "WEAK-POINTER-NEXT-SLOT"
"WEAK-POINTER-SIZE" "WEAK-POINTER-WIDETAG"
"WEAK-POINTER-VALUE-SLOT"
- "WORD" "N-WORD-BITS" "WORD-BYTES"
+ "WORD" "N-WORD-BITS" "N-WORD-BYTES"
"WORD-REG-SC-NUMBER" "WORD-SHIFT"
"ZERO-SC-NUMBER"))
;; This is kinda sleezy, changing words like this. But we can because
;; the vop thinks it is temporary.
(inst addq words (+ (1- (ash 1 n-lowtag-bits))
- (* vector-data-offset word-bytes))
+ (* vector-data-offset n-word-bytes))
words)
(inst li (lognot lowtag-mask) ndescr)
(inst and words ndescr words)
;; Get a pointer to the data.
(inst addq string
- (- (* vector-data-offset word-bytes) other-pointer-lowtag)
+ (- (* vector-data-offset n-word-bytes) other-pointer-lowtag)
lip)
(move zero-tn accum)
(inst br zero-tn test)
(:temp a4 descriptor-reg a4-offset)
(:temp a5 descriptor-reg a5-offset))
- ;; Note, because of the way the return-multiple vop is written, we can
- ;; assume that we are never called with nvals == 1 and that a0 has already
- ;; been loaded.
+ ;; Note, because of the way the RETURN-MULTIPLE VOP is written, we
+ ;; can assume that we are never called with NVALS == 1 and that A0
+ ;; has already been loaded.
(inst ble nvals default-a0-and-on)
- (inst ldl a1 (* 1 word-bytes) vals)
+ (inst ldl a1 (* 1 n-word-bytes) vals)
(inst subq nvals (fixnumize 2) count)
(inst ble count default-a2-and-on)
- (inst ldl a2 (* 2 word-bytes) vals)
+ (inst ldl a2 (* 2 n-word-bytes) vals)
(inst subq nvals (fixnumize 3) count)
(inst ble count default-a3-and-on)
- (inst ldl a3 (* 3 word-bytes) vals)
+ (inst ldl a3 (* 3 n-word-bytes) vals)
(inst subq nvals (fixnumize 4) count)
(inst ble count default-a4-and-on)
- (inst ldl a4 (* 4 word-bytes) vals)
+ (inst ldl a4 (* 4 n-word-bytes) vals)
(inst subq nvals (fixnumize 5) count)
(inst ble count default-a5-and-on)
- (inst ldl a5 (* 5 word-bytes) vals)
+ (inst ldl a5 (* 5 n-word-bytes) vals)
(inst subq nvals (fixnumize 6) count)
(inst ble count done)
;; Copy the remaining args to the top of the stack.
- (inst addq vals (* 6 word-bytes) vals)
- (inst addq cfp-tn (* 6 word-bytes) dst)
+ (inst addq vals (* 6 n-word-bytes) vals)
+ (inst addq cfp-tn (* 6 n-word-bytes) dst)
LOOP
(inst ldl temp 0 vals)
- (inst addq vals word-bytes vals)
+ (inst addq vals n-word-bytes vals)
(inst stl temp 0 dst)
(inst subq count (fixnumize 1) count)
- (inst addq dst word-bytes dst)
+ (inst addq dst n-word-bytes dst)
(inst bne count loop)
(inst br zero-tn done)
;; Load the argument regs (must do this now, 'cause the blt might
;; trash these locations)
- (inst ldl a0 (* 0 word-bytes) args)
- (inst ldl a1 (* 1 word-bytes) args)
- (inst ldl a2 (* 2 word-bytes) args)
- (inst ldl a3 (* 3 word-bytes) args)
- (inst ldl a4 (* 4 word-bytes) args)
- (inst ldl a5 (* 5 word-bytes) args)
+ (inst ldl a0 (* 0 n-word-bytes) args)
+ (inst ldl a1 (* 1 n-word-bytes) args)
+ (inst ldl a2 (* 2 n-word-bytes) args)
+ (inst ldl a3 (* 3 n-word-bytes) args)
+ (inst ldl a4 (* 4 n-word-bytes) args)
+ (inst ldl a5 (* 5 n-word-bytes) args)
;; Calc SRC, DST, and COUNT
(inst subq nargs (fixnumize register-arg-count) count)
- (inst addq args (* word-bytes register-arg-count) src)
+ (inst addq args (* n-word-bytes register-arg-count) src)
(inst ble count done)
- (inst addq cfp-tn (* word-bytes register-arg-count) dst)
+ (inst addq cfp-tn (* n-word-bytes register-arg-count) dst)
LOOP
;; Copy one arg.
(inst ldl temp 0 src)
- (inst addq src word-bytes src)
+ (inst addq src n-word-bytes src)
(inst stl temp 0 dst)
(inst subq count (fixnumize 1) count)
- (inst addq dst word-bytes dst)
+ (inst addq dst n-word-bytes dst)
(inst bgt count loop)
DONE
(inst push ebp-tn)
(inst lea
ebp-tn
- (make-ea :dword :base esp-tn :disp word-bytes))
+ (make-ea :dword :base esp-tn :disp n-word-bytes))
(inst sub esp-tn (fixnumize 2))
(inst push eax) ; callers return addr
(inst mov ecx (fixnumize 2)) ; arg count
(inst pop eax)
(inst push ebp-tn)
- (inst lea ebp-tn (make-ea :dword :base esp-tn :disp word-bytes))
+ (inst lea ebp-tn (make-ea :dword :base esp-tn :disp n-word-bytes))
(inst sub esp-tn (fixnumize 2))
(inst push eax)
(inst mov ecx (fixnumize 1)) ; arg count
TAIL-CALL-TO-STATIC-FN
(inst pop eax)
(inst push ebp-tn)
- (inst lea ebp-tn (make-ea :dword :base esp-tn :disp word-bytes))
+ (inst lea ebp-tn (make-ea :dword
+ :base esp-tn
+ :disp n-word-bytes))
(inst sub esp-tn (fixnumize 2)) ; FIXME: Push 2 words on stack,
; weirdly?
(inst push eax)
DO-STATIC-FN
(inst pop eax)
(inst push ebp-tn)
- (inst lea ebp-tn (make-ea :dword :base esp-tn :disp word-bytes))
+ (inst lea ebp-tn (make-ea :dword :base esp-tn :disp n-word-bytes))
(inst sub esp-tn (fixnumize 2))
(inst push eax)
(inst mov ecx (fixnumize 2))
DO-STATIC-FN
(inst pop eax)
(inst push ebp-tn)
- (inst lea ebp-tn (make-ea :dword :base esp-tn :disp word-bytes))
+ (inst lea ebp-tn (make-ea :dword :base esp-tn :disp n-word-bytes))
(inst sub esp-tn (fixnumize 2))
(inst push eax)
(inst mov ecx (fixnumize 2))
(inst xor k k)
LOOP1
(inst mov y (make-ea :dword :base state :index k :scale 4
- :disp (- (* (+ 3 sb!vm:vector-data-offset)
- sb!vm:word-bytes)
- sb!vm:other-pointer-lowtag)))
+ :disp (- (* (+ 3 vector-data-offset)
+ n-word-bytes)
+ other-pointer-lowtag)))
(inst mov tmp (make-ea :dword :base state :index k :scale 4
- :disp (- (* (+ 1 3 sb!vm:vector-data-offset)
- sb!vm:word-bytes)
- sb!vm:other-pointer-lowtag)))
+ :disp (- (* (+ 1 3 vector-data-offset)
+ n-word-bytes)
+ other-pointer-lowtag)))
(inst and y #x80000000)
(inst and tmp #x7fffffff)
(inst or y tmp)
(inst xor y #x9908b0df)
SKIP1
(inst xor y (make-ea :dword :base state :index k :scale 4
- :disp (- (* (+ 397 3 sb!vm:vector-data-offset)
- sb!vm:word-bytes)
- sb!vm:other-pointer-lowtag)))
+ :disp (- (* (+ 397 3 vector-data-offset)
+ n-word-bytes)
+ other-pointer-lowtag)))
(inst mov (make-ea :dword :base state :index k :scale 4
- :disp (- (* (+ 3 sb!vm:vector-data-offset)
- sb!vm:word-bytes)
- sb!vm:other-pointer-lowtag))
+ :disp (- (* (+ 3 vector-data-offset)
+ n-word-bytes)
+ other-pointer-lowtag))
y)
(inst inc k)
(inst cmp k (- 624 397))
(inst jmp :b loop1)
LOOP2
(inst mov y (make-ea :dword :base state :index k :scale 4
- :disp (- (* (+ 3 sb!vm:vector-data-offset)
- sb!vm:word-bytes)
- sb!vm:other-pointer-lowtag)))
+ :disp (- (* (+ 3 vector-data-offset)
+ n-word-bytes)
+ other-pointer-lowtag)))
(inst mov tmp (make-ea :dword :base state :index k :scale 4
- :disp (- (* (+ 1 3 sb!vm:vector-data-offset)
- sb!vm:word-bytes)
- sb!vm:other-pointer-lowtag)))
+ :disp (- (* (+ 1 3 vector-data-offset)
+ n-word-bytes)
+ other-pointer-lowtag)))
(inst and y #x80000000)
(inst and tmp #x7fffffff)
(inst or y tmp)
(inst xor y #x9908b0df)
SKIP2
(inst xor y (make-ea :dword :base state :index k :scale 4
- :disp (- (* (+ (- 397 624) 3 sb!vm:vector-data-offset)
- sb!vm:word-bytes)
- sb!vm:other-pointer-lowtag)))
+ :disp (- (* (+ (- 397 624) 3 vector-data-offset)
+ n-word-bytes)
+ other-pointer-lowtag)))
(inst mov (make-ea :dword :base state :index k :scale 4
- :disp (- (* (+ 3 sb!vm:vector-data-offset)
- sb!vm:word-bytes)
- sb!vm:other-pointer-lowtag))
+ :disp (- (* (+ 3 vector-data-offset)
+ n-word-bytes)
+ other-pointer-lowtag))
y)
(inst inc k)
(inst cmp k (- 624 1))
(inst jmp :b loop2)
(inst mov y (make-ea :dword :base state
- :disp (- (* (+ (- 624 1) 3 sb!vm:vector-data-offset)
- sb!vm:word-bytes)
- sb!vm:other-pointer-lowtag)))
+ :disp (- (* (+ (- 624 1) 3 vector-data-offset)
+ n-word-bytes)
+ other-pointer-lowtag)))
(inst mov tmp (make-ea :dword :base state
- :disp (- (* (+ 0 3 sb!vm:vector-data-offset)
- sb!vm:word-bytes)
- sb!vm:other-pointer-lowtag)))
+ :disp (- (* (+ 0 3 vector-data-offset)
+ n-word-bytes)
+ other-pointer-lowtag)))
(inst and y #x80000000)
(inst and tmp #x7fffffff)
(inst or y tmp)
(inst xor y #x9908b0df)
SKIP3
(inst xor y (make-ea :dword :base state
- :disp (- (* (+ (- 397 1) 3 sb!vm:vector-data-offset)
- sb!vm:word-bytes)
- sb!vm:other-pointer-lowtag)))
+ :disp (- (* (+ (- 397 1) 3 vector-data-offset)
+ n-word-bytes)
+ other-pointer-lowtag)))
(inst mov (make-ea :dword :base state
- :disp (- (* (+ (- 624 1) 3 sb!vm:vector-data-offset)
- sb!vm:word-bytes)
- sb!vm:other-pointer-lowtag))
+ :disp (- (* (+ (- 624 1) 3 vector-data-offset)
+ n-word-bytes)
+ other-pointer-lowtag))
y)
;; Restore the temporary registers and return.
(:arg words any-reg ecx-offset)
(:res result descriptor-reg edx-offset))
(inst mov result (+ (1- (ash 1 n-lowtag-bits))
- (* vector-data-offset word-bytes)))
+ (* vector-data-offset n-word-bytes)))
(inst add result words)
- (inst and result (lognot sb!vm:lowtag-mask))
+ (inst and result (lognot lowtag-mask))
(pseudo-atomic
(allocation result result)
(inst lea result (make-ea :byte :base result :disp other-pointer-lowtag))
;; Save the count, because the loop is going to destroy it.
(inst mov edx ecx)
- ;; Blit the values down the stack. Note: there might be overlap, so we have
- ;; to be careful not to clobber values before we've read them. Because the
- ;; stack builds down, we are coping to a larger address. Therefore, we need
- ;; to iterate from larger addresses to smaller addresses.
- ;; pfw-this says copy ecx words from esi to edi counting down.
+ ;; Blit the values down the stack. Note: there might be overlap, so
+ ;; we have to be careful not to clobber values before we've read
+ ;; them. Because the stack builds down, we are coping to a larger
+ ;; address. Therefore, we need to iterate from larger addresses to
+ ;; smaller addresses. pfw-this says copy ecx words from esi to edi
+ ;; counting down.
(inst shr ecx 2) ; fixnum to raw word count
(inst std) ; count down
(inst sub esi 4) ; ?
- (inst lea edi (make-ea :dword :base ebx :disp (- word-bytes)))
+ (inst lea edi (make-ea :dword :base ebx :disp (- n-word-bytes)))
(inst rep)
(inst movs :dword)
(inst mov ecx edx)
;; Set the stack top to the last result.
- (inst lea esp-tn (make-ea :dword :base edi :disp word-bytes))
+ (inst lea esp-tn (make-ea :dword :base edi :disp n-word-bytes))
;; Load the register args.
(loadw edx ebx -1)
(loadw edx esi -1)
(loadw edi esi -2)
(inst mov esi nil-value)
- (inst lea esp-tn (make-ea :dword :base ebx :disp (* -2 word-bytes)))
+ (inst lea esp-tn (make-ea :dword :base ebx :disp (* -2 n-word-bytes)))
(inst jmp eax)
THREE-VALUES
(loadw edx esi -1)
(loadw edi esi -2)
(loadw esi esi -3)
- (inst lea esp-tn (make-ea :dword :base ebx :disp (* -3 word-bytes)))
+ (inst lea esp-tn (make-ea :dword :base ebx :disp (* -3 n-word-bytes)))
(inst jmp eax))
\f
;;;; TAIL-CALL-VARIABLE
-;;; For tail-call-variable, we have to copy the arguments from the end of our
-;;; stack frame (were args are produced) to the start of our stack frame
-;;; (were args are expected).
+;;; For tail-call-variable, we have to copy the arguments from the end
+;;; of our stack frame (were args are produced) to the start of our
+;;; stack frame (were args are expected).
;;;
;;; We take the function to call in EAX and a pointer to the arguments in
;;; ESI. EBP says the same over the jump, and the old frame pointer is
(loadw ebx ebp-tn -2)
(inst push ecx)
- ;; Do the blit. Because we are coping from smaller addresses to larger
- ;; addresses, we have to start at the largest pair and work our way down.
+ ;; Do the blit. Because we are coping from smaller addresses to
+ ;; larger addresses, we have to start at the largest pair and work
+ ;; our way down.
(inst shr ecx 2) ; fixnum to raw words
(inst std) ; count down
- (inst lea edi (make-ea :dword :base ebp-tn :disp (- word-bytes)))
+ (inst lea edi (make-ea :dword :base ebp-tn :disp (- n-word-bytes)))
(inst sub esi (fixnumize 1))
(inst rep)
(inst movs :dword)
(popw ebp-tn -1) ; overwrites a0
;; Blow off the stack above the arguments.
- (inst lea esp-tn (make-ea :dword :base edi :disp word-bytes))
+ (inst lea esp-tn (make-ea :dword :base edi :disp n-word-bytes))
;; remaining register args
(loadw edi ebp-tn -2)
;; And jump into the function.
(inst jmp
(make-ea :byte :base eax
- :disp (- (* closure-fun-slot word-bytes)
+ :disp (- (* closure-fun-slot n-word-bytes)
fun-pointer-lowtag)))
;; All the arguments fit in registers, so load them.
;; Clear most of the stack.
(inst lea esp-tn
- (make-ea :dword :base ebp-tn :disp (* -3 word-bytes)))
+ (make-ea :dword :base ebp-tn :disp (* -3 n-word-bytes)))
;; Push the return-pc so it looks like we just called.
(pushw ebp-tn -2)
;; And away we go.
(inst jmp (make-ea :byte :base eax
- :disp (- (* closure-fun-slot word-bytes)
+ :disp (- (* closure-fun-slot n-word-bytes)
fun-pointer-lowtag))))
\f
(define-assembly-routine (throw
;; count in ecx-tn
(inst jmp (make-ea :byte :base block
- :disp (* unwind-block-entry-pc-slot word-bytes))))
+ :disp (* unwind-block-entry-pc-slot n-word-bytes))))
"Alpha")
\f
(defun fixup-code-object (code offset value kind)
- (unless (zerop (rem offset word-bytes))
+ (unless (zerop (rem offset n-word-bytes))
(error "Unaligned instruction? offset=#x~X." offset))
(sb!sys:without-gcing
(let ((sap (truly-the system-area-pointer
(vector (make-array length :element-type '(unsigned-byte 8))))
(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:n-word-bits
- sb!vm:vector-data-offset)
- (* length sb!vm:byte-bits))
+ (copy-from-system-area pc (* n-byte-bits 5)
+ vector (* n-word-bits vector-data-offset)
+ (* length n-byte-bits))
(let* ((index 0)
(error-number (sb!c::read-var-integer vector index)))
(collect ((sc-offsets))
((t)
(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))
+ (values #.sb!vm:simple-string-widetag #.sb!vm:n-byte-bits))
((bit)
(values #.sb!vm:simple-bit-vector-widetag 1))
;; OK, we have to wade into SUBTYPEPing after all.
;; FIXME: The data here are redundant with
;; *SPECIALIZED-ARRAY-ELEMENT-TYPE-PROPERTIES*.
(pick-vector-type type
- (base-char (values #.sb!vm:simple-string-widetag #.sb!vm:byte-bits))
+ (base-char (values #.sb!vm:simple-string-widetag #.sb!vm:n-byte-bits))
(bit (values #.sb!vm:simple-bit-vector-widetag 1))
((unsigned-byte 2)
(values #.sb!vm:simple-array-unsigned-byte-2-widetag 2))
;;;; constants and types
;;; the number of bits to process at a time
-(defconstant unit-bits sb!vm:n-word-bits)
+(defconstant unit-bits 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))
(let ((address (sap-int sap)))
(values (int-sap #!-alpha (32bit-logical-andc2 address 3)
#!+alpha (ash (ash address -2) 2))
- (+ (* (logand address 3) byte-bits) offset))))
+ (+ (* (logand address 3) n-byte-bits) offset))))
#!-sb-fluid (declaim (inline word-sap-ref %set-word-sap-ref))
(defun word-sap-ref (sap offset)
(defun copy-byte-vector-to-system-area (bv sap &optional (offset 0))
;; FIXME: There should be a type like SB!VM:BYTE so that we can write this
;; type as (SIMPLE-ARRAY SB!VM:BYTE 1). Except BYTE is an external symbol of
- ;; package CL; so maybe SB!VM:VM-BYTE?
+ ;; package CL, and shadowing it would be too ugly; so maybe SB!VM:VMBYTE?
+ ;; (And then N-BYTE-BITS would be N-VMBYTE-BITS and so forth?)
(declare (type (simple-array (unsigned-byte 8) 1) bv))
(declare (type sap sap))
(declare (type fixnum offset))
;; %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:n-word-bits)
+ (* vector-data-offset n-word-bits)
sap
offset
- (* (length bv) sb!vm:byte-bits)))
+ (* (length bv) n-byte-bits)))
(let ((component-ptr (component-ptr-from-pc pc)))
(unless (sap= component-ptr (int-sap #x0))
(let* ((code (component-from-component-ptr component-ptr))
- (code-header-len (* (get-header-data code) sb!vm:word-bytes))
+ (code-header-len (* (get-header-data code) sb!vm:n-word-bytes))
(pc-offset (- (sap-int pc)
(- (get-lisp-obj-address code)
sb!vm:other-pointer-lowtag)
nil)
(t
;; Check the two possible frame pointers.
- (let ((lisp-ocfp (sap-ref-sap fp (- (* (1+ sb!vm::ocfp-save-offset) 4))))
- (lisp-ra (sap-ref-sap fp (- (* (1+ sb!vm::return-pc-save-offset)
+ (let ((lisp-ocfp (sap-ref-sap fp (- (* (1+ ocfp-save-offset) 4))))
+ (lisp-ra (sap-ref-sap fp (- (* (1+ return-pc-save-offset)
4))))
- (c-ocfp (sap-ref-sap fp (* 0 sb!vm:word-bytes)))
- (c-ra (sap-ref-sap fp (* 1 sb!vm:word-bytes))))
+ (c-ocfp (sap-ref-sap fp (* 0 sb!vm:n-word-bytes)))
+ (c-ra (sap-ref-sap fp (* 1 sb!vm:n-word-bytes))))
(cond ((and (sap> lisp-ocfp fp) (cstack-pointer-valid-p lisp-ocfp)
(ra-pointer-valid-p lisp-ra)
(sap> c-ocfp fp) (cstack-pointer-valid-p c-ocfp)
(compute-calling-frame
(descriptor-sap
(get-context-value
- frame sb!vm::ocfp-save-offset
+ frame ocfp-save-offset
(sb!c::compiled-debug-fun-old-fp c-d-f)))
(get-context-value
- frame sb!vm::lra-save-offset
+ frame lra-save-offset
(sb!c::compiled-debug-fun-return-pc c-d-f))
frame)))
(bogus-debug-fun
#!-x86
(compute-calling-frame
#!-alpha
- (sap-ref-sap fp (* sb!vm::ocfp-save-offset
- sb!vm:word-bytes))
+ (sap-ref-sap fp (* ocfp-save-offset
+ sb!vm:n-word-bytes))
#!+alpha
(int-sap
- (sap-ref-32 fp (* sb!vm::ocfp-save-offset
- sb!vm:word-bytes)))
+ (sap-ref-32 fp (* ocfp-save-offset
+ sb!vm:n-word-bytes)))
- (stack-ref fp sb!vm::lra-save-offset)
+ (stack-ref fp lra-save-offset)
frame)))))))
down)))
(if escaped
(sub-access-debug-var-slot pointer loc escaped)
(ecase stack-slot
- (#.sb!vm::ocfp-save-offset
+ (#.ocfp-save-offset
(stack-ref pointer stack-slot))
- (#.sb!vm::lra-save-offset
+ (#.lra-save-offset
(sap-ref-sap pointer (- (* (1+ stack-slot) 4))))))))
#!-x86
(if escaped
(sub-set-debug-var-slot pointer loc value escaped)
(ecase stack-slot
- (#.sb!vm::ocfp-save-offset
+ (#.ocfp-save-offset
(setf (stack-ref pointer stack-slot) value))
- (#.sb!vm::lra-save-offset
+ (#.lra-save-offset
(setf (sap-ref-sap pointer (- (* (1+ stack-slot) 4))) value))))))
;;; This returns a frame for the one existing in time immediately
(if (fixnump lra)
(let ((fp (frame-pointer up-frame)))
(values lra
- (stack-ref fp (1+ sb!vm::lra-save-offset))))
+ (stack-ref fp (1+ lra-save-offset))))
(values (get-header-data lra)
(lra-code-header lra)))
(if code
(values code
(* (1+ (- word-offset (get-header-data code)))
- sb!vm:word-bytes)
+ sb!vm:n-word-bytes)
nil)
(values :foreign-function
0
(when (null code)
(return (values code 0 context)))
(let* ((code-header-len (* (get-header-data code)
- sb!vm:word-bytes))
+ sb!vm:n-word-bytes))
(pc-offset
(- (sap-int (sb!vm:context-pc context))
(- (get-lisp-obj-address code)
(/show "got PC-OFFSET")
(unless (<= 0 pc-offset
(* (code-header-ref code sb!vm:code-code-size-slot)
- sb!vm:word-bytes))
+ sb!vm:n-word-bytes))
;; We were in an assembly routine. Therefore, use the
;; LRA as the pc.
;;
(when (symbolp code)
(return (values code 0 scp)))
(let* ((code-header-len (* (get-header-data code)
- sb!vm:word-bytes))
+ sb!vm:n-word-bytes))
(pc-offset
(- (sap-int (sb!vm:context-pc scp))
(- (get-lisp-obj-address code)
;; delay slot.
#!+(or pmax sgi) ; pmax only (and broken anyway)
(when (logbitp 31 (sb!alien:slot scp '%mips::sc-cause))
- (incf pc-offset sb!vm:word-bytes))
+ (incf pc-offset sb!vm:n-word-bytes))
(unless (<= 0 pc-offset
(* (code-header-ref code sb!vm:code-code-size-slot)
- sb!vm:word-bytes))
+ sb!vm:n-word-bytes))
;; We were in an assembly routine. Therefore, use the
;; LRA as the pc.
(setf pc-offset
#!-alpha
(sap-ref-sap catch
(* sb!vm:catch-block-current-cont-slot
- sb!vm:word-bytes))
+ sb!vm:n-word-bytes))
#!+alpha
(:int-sap
(sap-ref-32 catch
(* sb!vm:catch-block-current-cont-slot
- sb!vm:word-bytes))))
+ sb!vm:n-word-bytes))))
(let* (#!-x86
(lra (stack-ref catch sb!vm:catch-block-entry-pc-slot))
#!+x86
(ra (sap-ref-sap
catch (* sb!vm:catch-block-entry-pc-slot
- sb!vm:word-bytes)))
+ sb!vm:n-word-bytes)))
#!-x86
(component
(stack-ref catch sb!vm:catch-block-current-code-slot))
#!-x86
(* (- (1+ (get-header-data lra))
(get-header-data component))
- sb!vm:word-bytes)
+ sb!vm:n-word-bytes)
#!+x86
(- (sap-int ra)
(- (get-lisp-obj-address component)
sb!vm:other-pointer-lowtag)
- (* (get-header-data component) sb!vm:word-bytes))))
+ (* (get-header-data component) sb!vm:n-word-bytes))))
(push (cons #!-x86
(stack-ref catch sb!vm:catch-block-tag-slot)
#!+x86
(make-lisp-obj
(sap-ref-32 catch (* sb!vm:catch-block-tag-slot
- sb!vm:word-bytes)))
+ sb!vm:n-word-bytes)))
(make-compiled-code-location
offset (frame-debug-fun frame)))
res)))
#!-alpha
(sap-ref-sap catch
(* sb!vm:catch-block-previous-catch-slot
- sb!vm:word-bytes))
+ sb!vm:n-word-bytes))
#!+alpha
(:int-sap
(sap-ref-32 catch
(* sb!vm:catch-block-previous-catch-slot
- sb!vm:word-bytes)))))))
+ sb!vm:n-word-bytes)))))))
\f
;;;; operations on DEBUG-FUNs
(debug-fun-from-pc component
(* (- (fun-word-offset fun)
(get-header-data component))
- sb!vm:word-bytes)))))))
+ sb!vm:n-word-bytes)))))))
;;; Return the kind of the function, which is one of :OPTIONAL,
;;; :EXTERNAL, TOP-level, :CLEANUP, or NIL.
;; routine in the C runtime support code
(or (< sb!vm:read-only-space-start val
(* sb!vm:*read-only-space-free-pointer*
- sb!vm:word-bytes))
+ sb!vm:n-word-bytes))
(< sb!vm:static-space-start val
(* sb!vm:*static-space-free-pointer*
- sb!vm:word-bytes))
+ sb!vm:n-word-bytes))
(< sb!vm:dynamic-space-start val
(sap-int (dynamic-space-free-pointer))))))
(make-lisp-obj val)
(sb!vm:context-register escaped
sb!vm::nfp-offset))
#!-alpha
- (sb!sys:sap-ref-sap fp (* sb!vm::nfp-save-offset
- sb!vm:word-bytes))
+ (sb!sys:sap-ref-sap fp (* nfp-save-offset
+ sb!vm:n-word-bytes))
#!+alpha
(sb!vm::make-number-stack-pointer
- (sb!sys:sap-ref-32 fp (* sb!vm::nfp-save-offset
- sb!vm:word-bytes))))))
+ (sb!sys:sap-ref-32 fp (* nfp-save-offset
+ sb!vm:n-word-bytes))))))
,@body)))
(ecase (sb!c:sc-offset-scn sc-offset)
((#.sb!vm:any-reg-sc-number
(#.sb!vm:single-stack-sc-number
(with-nfp (nfp)
(sb!sys:sap-ref-single nfp (* (sb!c:sc-offset-offset sc-offset)
- sb!vm:word-bytes))))
+ sb!vm:n-word-bytes))))
(#.sb!vm:double-stack-sc-number
(with-nfp (nfp)
(sb!sys:sap-ref-double nfp (* (sb!c:sc-offset-offset sc-offset)
- sb!vm:word-bytes))))
+ sb!vm:n-word-bytes))))
#!+long-float
(#.sb!vm:long-stack-sc-number
(with-nfp (nfp)
(sb!sys:sap-ref-long nfp (* (sb!c:sc-offset-offset sc-offset)
- sb!vm:word-bytes))))
+ sb!vm:n-word-bytes))))
(#.sb!vm:complex-single-stack-sc-number
(with-nfp (nfp)
(complex
(sb!sys:sap-ref-single nfp (* (sb!c:sc-offset-offset sc-offset)
- sb!vm:word-bytes))
+ sb!vm:n-word-bytes))
(sb!sys:sap-ref-single nfp (* (1+ (sb!c:sc-offset-offset sc-offset))
- sb!vm:word-bytes)))))
+ sb!vm:n-word-bytes)))))
(#.sb!vm:complex-double-stack-sc-number
(with-nfp (nfp)
(complex
(sb!sys:sap-ref-double nfp (* (sb!c:sc-offset-offset sc-offset)
- sb!vm:word-bytes))
+ sb!vm:n-word-bytes))
(sb!sys:sap-ref-double nfp (* (+ (sb!c:sc-offset-offset sc-offset) 2)
- sb!vm:word-bytes)))))
+ sb!vm:n-word-bytes)))))
#!+long-float
(#.sb!vm:complex-long-stack-sc-number
(with-nfp (nfp)
(complex
(sb!sys:sap-ref-long nfp (* (sb!c:sc-offset-offset sc-offset)
- sb!vm:word-bytes))
+ sb!vm:n-word-bytes))
(sb!sys:sap-ref-long nfp (* (+ (sb!c:sc-offset-offset sc-offset)
#!+sparc 4)
- sb!vm:word-bytes)))))
+ sb!vm:n-word-bytes)))))
(#.sb!vm:control-stack-sc-number
(sb!kernel:stack-ref fp (sb!c:sc-offset-offset sc-offset)))
(#.sb!vm:base-char-stack-sc-number
(with-nfp (nfp)
(code-char (sb!sys:sap-ref-32 nfp (* (sb!c:sc-offset-offset sc-offset)
- sb!vm:word-bytes)))))
+ sb!vm:n-word-bytes)))))
(#.sb!vm:unsigned-stack-sc-number
(with-nfp (nfp)
(sb!sys:sap-ref-32 nfp (* (sb!c:sc-offset-offset sc-offset)
- sb!vm:word-bytes))))
+ sb!vm:n-word-bytes))))
(#.sb!vm:signed-stack-sc-number
(with-nfp (nfp)
(sb!sys:signed-sap-ref-32 nfp (* (sb!c:sc-offset-offset sc-offset)
- sb!vm:word-bytes))))
+ sb!vm:n-word-bytes))))
(#.sb!vm:sap-stack-sc-number
(with-nfp (nfp)
(sb!sys:sap-ref-sap nfp (* (sb!c:sc-offset-offset sc-offset)
- sb!vm:word-bytes)))))))
+ sb!vm:n-word-bytes)))))))
#!+x86
(defun sub-access-debug-var-slot (fp sc-offset &optional escaped)
(#.sb!vm:single-stack-sc-number
(/show0 "case of SINGLE-STACK-SC-NUMBER")
(sap-ref-single fp (- (* (1+ (sb!c:sc-offset-offset sc-offset))
- sb!vm:word-bytes))))
+ sb!vm:n-word-bytes))))
(#.sb!vm:double-stack-sc-number
(/show0 "case of DOUBLE-STACK-SC-NUMBER")
(sap-ref-double fp (- (* (+ (sb!c:sc-offset-offset sc-offset) 2)
- sb!vm:word-bytes))))
+ sb!vm:n-word-bytes))))
#!+long-float
(#.sb!vm:long-stack-sc-number
(/show0 "case of LONG-STACK-SC-NUMBER")
(sap-ref-long fp (- (* (+ (sb!c:sc-offset-offset sc-offset) 3)
- sb!vm:word-bytes))))
+ sb!vm:n-word-bytes))))
(#.sb!vm:complex-single-stack-sc-number
(/show0 "case of COMPLEX-STACK-SC-NUMBER")
(complex
(sap-ref-single fp (- (* (1+ (sb!c:sc-offset-offset sc-offset))
- sb!vm:word-bytes)))
+ sb!vm:n-word-bytes)))
(sap-ref-single fp (- (* (+ (sb!c:sc-offset-offset sc-offset) 2)
- sb!vm:word-bytes)))))
+ sb!vm:n-word-bytes)))))
(#.sb!vm:complex-double-stack-sc-number
(/show0 "case of COMPLEX-DOUBLE-STACK-SC-NUMBER")
(complex
(sap-ref-double fp (- (* (+ (sb!c:sc-offset-offset sc-offset) 2)
- sb!vm:word-bytes)))
+ sb!vm:n-word-bytes)))
(sap-ref-double fp (- (* (+ (sb!c:sc-offset-offset sc-offset) 4)
- sb!vm:word-bytes)))))
+ sb!vm:n-word-bytes)))))
#!+long-float
(#.sb!vm:complex-long-stack-sc-number
(/show0 "case of COMPLEX-LONG-STACK-SC-NUMBER")
(complex
(sap-ref-long fp (- (* (+ (sb!c:sc-offset-offset sc-offset) 3)
- sb!vm:word-bytes)))
+ sb!vm:n-word-bytes)))
(sap-ref-long fp (- (* (+ (sb!c:sc-offset-offset sc-offset) 6)
- sb!vm:word-bytes)))))
+ sb!vm:n-word-bytes)))))
(#.sb!vm:control-stack-sc-number
(/show0 "case of CONTROL-STACK-SC-NUMBER")
(stack-ref fp (sb!c:sc-offset-offset sc-offset)))
(/show0 "case of BASE-CHAR-STACK-SC-NUMBER")
(code-char
(sap-ref-32 fp (- (* (1+ (sb!c:sc-offset-offset sc-offset))
- sb!vm:word-bytes)))))
+ sb!vm:n-word-bytes)))))
(#.sb!vm:unsigned-stack-sc-number
(/show0 "case of UNSIGNED-STACK-SC-NUMBER")
(sap-ref-32 fp (- (* (1+ (sb!c:sc-offset-offset sc-offset))
- sb!vm:word-bytes))))
+ sb!vm:n-word-bytes))))
(#.sb!vm:signed-stack-sc-number
(/show0 "case of SIGNED-STACK-SC-NUMBER")
(signed-sap-ref-32 fp (- (* (1+ (sb!c:sc-offset-offset sc-offset))
- sb!vm:word-bytes))))
+ sb!vm:n-word-bytes))))
(#.sb!vm:sap-stack-sc-number
(/show0 "case of SAP-STACK-SC-NUMBER")
(sap-ref-sap fp (- (* (1+ (sb!c:sc-offset-offset sc-offset))
- sb!vm:word-bytes)))))))
+ sb!vm:n-word-bytes)))))))
;;; This stores value as the value of DEBUG-VAR in FRAME. In the
;;; COMPILED-DEBUG-VAR case, access the current value to determine if
sb!vm::nfp-offset))
#!-alpha
(sap-ref-sap fp
- (* sb!vm::nfp-save-offset
- sb!vm:word-bytes))
+ (* nfp-save-offset
+ sb!vm:n-word-bytes))
#!+alpha
(sb!vm::make-number-stack-pointer
(sap-ref-32 fp
- (* sb!vm::nfp-save-offset
- sb!vm:word-bytes))))))
+ (* nfp-save-offset
+ sb!vm:n-word-bytes))))))
,@body)))
(ecase (sb!c:sc-offset-scn sc-offset)
((#.sb!vm:any-reg-sc-number
(#.sb!vm:single-stack-sc-number
(with-nfp (nfp)
(setf (sap-ref-single nfp (* (sb!c:sc-offset-offset sc-offset)
- sb!vm:word-bytes))
+ sb!vm:n-word-bytes))
(the single-float value))))
(#.sb!vm:double-stack-sc-number
(with-nfp (nfp)
(setf (sap-ref-double nfp (* (sb!c:sc-offset-offset sc-offset)
- sb!vm:word-bytes))
+ sb!vm:n-word-bytes))
(the double-float value))))
#!+long-float
(#.sb!vm:long-stack-sc-number
(with-nfp (nfp)
(setf (sap-ref-long nfp (* (sb!c:sc-offset-offset sc-offset)
- sb!vm:word-bytes))
+ sb!vm:n-word-bytes))
(the long-float value))))
(#.sb!vm:complex-single-stack-sc-number
(with-nfp (nfp)
(setf (sap-ref-single
- nfp (* (sb!c:sc-offset-offset sc-offset) sb!vm:word-bytes))
+ nfp (* (sb!c:sc-offset-offset sc-offset) sb!vm:n-word-bytes))
(the single-float (realpart value)))
(setf (sap-ref-single
nfp (* (1+ (sb!c:sc-offset-offset sc-offset))
- sb!vm:word-bytes))
+ sb!vm:n-word-bytes))
(the single-float (realpart value)))))
(#.sb!vm:complex-double-stack-sc-number
(with-nfp (nfp)
(setf (sap-ref-double
- nfp (* (sb!c:sc-offset-offset sc-offset) sb!vm:word-bytes))
+ nfp (* (sb!c:sc-offset-offset sc-offset) sb!vm:n-word-bytes))
(the double-float (realpart value)))
(setf (sap-ref-double
nfp (* (+ (sb!c:sc-offset-offset sc-offset) 2)
- sb!vm:word-bytes))
+ sb!vm:n-word-bytes))
(the double-float (realpart value)))))
#!+long-float
(#.sb!vm:complex-long-stack-sc-number
(with-nfp (nfp)
(setf (sap-ref-long
- nfp (* (sb!c:sc-offset-offset sc-offset) sb!vm:word-bytes))
+ nfp (* (sb!c:sc-offset-offset sc-offset) sb!vm:n-word-bytes))
(the long-float (realpart value)))
(setf (sap-ref-long
nfp (* (+ (sb!c:sc-offset-offset sc-offset) #!+sparc 4)
- sb!vm:word-bytes))
+ sb!vm:n-word-bytes))
(the long-float (realpart value)))))
(#.sb!vm:control-stack-sc-number
(setf (stack-ref fp (sb!c:sc-offset-offset sc-offset)) value))
(#.sb!vm:base-char-stack-sc-number
(with-nfp (nfp)
(setf (sap-ref-32 nfp (* (sb!c:sc-offset-offset sc-offset)
- sb!vm:word-bytes))
+ sb!vm:n-word-bytes))
(char-code (the character value)))))
(#.sb!vm:unsigned-stack-sc-number
(with-nfp (nfp)
(setf (sap-ref-32 nfp (* (sb!c:sc-offset-offset sc-offset)
- sb!vm:word-bytes))
+ sb!vm:n-word-bytes))
(the (unsigned-byte 32) value))))
(#.sb!vm:signed-stack-sc-number
(with-nfp (nfp)
(setf (signed-sap-ref-32 nfp (* (sb!c:sc-offset-offset sc-offset)
- sb!vm:word-bytes))
+ sb!vm:n-word-bytes))
(the (signed-byte 32) value))))
(#.sb!vm:sap-stack-sc-number
(with-nfp (nfp)
(setf (sap-ref-sap nfp (* (sb!c:sc-offset-offset sc-offset)
- sb!vm:word-bytes))
+ sb!vm:n-word-bytes))
(the system-area-pointer value)))))))
#!+x86
(#.sb!vm:single-stack-sc-number
(setf (sap-ref-single
fp (- (* (1+ (sb!c:sc-offset-offset sc-offset))
- sb!vm:word-bytes)))
+ sb!vm:n-word-bytes)))
(the single-float value)))
(#.sb!vm:double-stack-sc-number
(setf (sap-ref-double
fp (- (* (+ (sb!c:sc-offset-offset sc-offset) 2)
- sb!vm:word-bytes)))
+ sb!vm:n-word-bytes)))
(the double-float value)))
#!+long-float
(#.sb!vm:long-stack-sc-number
(setf (sap-ref-long
fp (- (* (+ (sb!c:sc-offset-offset sc-offset) 3)
- sb!vm:word-bytes)))
+ sb!vm:n-word-bytes)))
(the long-float value)))
(#.sb!vm:complex-single-stack-sc-number
(setf (sap-ref-single
fp (- (* (1+ (sb!c:sc-offset-offset sc-offset))
- sb!vm:word-bytes)))
+ sb!vm:n-word-bytes)))
(realpart (the (complex single-float) value)))
(setf (sap-ref-single
fp (- (* (+ (sb!c:sc-offset-offset sc-offset) 2)
- sb!vm:word-bytes)))
+ sb!vm:n-word-bytes)))
(imagpart (the (complex single-float) value))))
(#.sb!vm:complex-double-stack-sc-number
(setf (sap-ref-double
fp (- (* (+ (sb!c:sc-offset-offset sc-offset) 2)
- sb!vm:word-bytes)))
+ sb!vm:n-word-bytes)))
(realpart (the (complex double-float) value)))
(setf (sap-ref-double
fp (- (* (+ (sb!c:sc-offset-offset sc-offset) 4)
- sb!vm:word-bytes)))
+ sb!vm:n-word-bytes)))
(imagpart (the (complex double-float) value))))
#!+long-float
(#.sb!vm:complex-long-stack-sc-number
(setf (sap-ref-long
fp (- (* (+ (sb!c:sc-offset-offset sc-offset) 3)
- sb!vm:word-bytes)))
+ sb!vm:n-word-bytes)))
(realpart (the (complex long-float) value)))
(setf (sap-ref-long
fp (- (* (+ (sb!c:sc-offset-offset sc-offset) 6)
- sb!vm:word-bytes)))
+ sb!vm:n-word-bytes)))
(imagpart (the (complex long-float) value))))
(#.sb!vm:control-stack-sc-number
(setf (stack-ref fp (sb!c:sc-offset-offset sc-offset)) value))
(#.sb!vm:base-char-stack-sc-number
(setf (sap-ref-32 fp (- (* (1+ (sb!c:sc-offset-offset sc-offset))
- sb!vm:word-bytes)))
+ sb!vm:n-word-bytes)))
(char-code (the character value))))
(#.sb!vm:unsigned-stack-sc-number
(setf (sap-ref-32 fp (- (* (1+ (sb!c:sc-offset-offset sc-offset))
- sb!vm:word-bytes)))
+ sb!vm:n-word-bytes)))
(the (unsigned-byte 32) value)))
(#.sb!vm:signed-stack-sc-number
(setf (signed-sap-ref-32
- fp (- (* (1+ (sb!c:sc-offset-offset sc-offset)) sb!vm:word-bytes)))
+ fp (- (* (1+ (sb!c:sc-offset-offset sc-offset))
+ sb!vm:n-word-bytes)))
(the (signed-byte 32) value)))
(#.sb!vm:sap-stack-sc-number
(setf (sap-ref-sap fp (- (* (1+ (sb!c:sc-offset-offset sc-offset))
- sb!vm:word-bytes)))
+ sb!vm:n-word-bytes)))
(the system-area-pointer value))))))
;;; The method for setting and accessing COMPILED-DEBUG-VAR values use
(multiple-value-bind (lra component offset)
(make-bogus-lra
(get-context-value frame
- sb!vm::lra-save-offset
+ lra-save-offset
lra-sc-offset))
(setf (get-context-value frame
- sb!vm::lra-save-offset
+ lra-save-offset
lra-sc-offset)
lra)
(let ((end-bpts (breakpoint-%info starter-bpt)))
((not frame) nil)
(when (and (compiled-frame-p frame)
(eq lra
- (get-context-value frame
- sb!vm::lra-save-offset
- lra-sc-offset)))
+ (get-context-value frame lra-save-offset lra-sc-offset)))
(return t)))))
\f
;;;; ACTIVATE-BREAKPOINT
(setf (code-header-ref code-object (1+ real-lra-slot)) offset))
(setf (code-header-ref code-object known-return-p-slot)
known-return-p)
- (system-area-copy src-start 0 dst-start 0 (* length sb!vm:byte-bits))
+ (system-area-copy src-start 0 dst-start 0 (* length sb!vm:n-byte-bits))
(sb!vm:sanctify-for-execution code-object)
#!+x86
(values dst-start code-object (sap- trap-loc src-start))
((<= bytes space)
(if (system-area-pointer-p thing)
(system-area-copy thing
- (* start sb!vm:byte-bits)
+ (* start sb!vm:n-byte-bits)
(fd-stream-obuf-sap fd-stream)
- (* tail sb!vm:byte-bits)
- (* bytes sb!vm:byte-bits))
+ (* tail sb!vm:n-byte-bits)
+ (* bytes sb!vm:n-byte-bits))
;; FIXME: There should be some type checking somewhere to
;; verify that THING here is a vector, not just <not a SAP>.
(copy-to-system-area thing
- (+ (* start sb!vm:byte-bits)
+ (+ (* start sb!vm:n-byte-bits)
(* sb!vm:vector-data-offset
sb!vm:n-word-bits))
(fd-stream-obuf-sap fd-stream)
- (* tail sb!vm:byte-bits)
- (* bytes sb!vm:byte-bits)))
+ (* tail sb!vm:n-byte-bits)
+ (* bytes sb!vm:n-byte-bits)))
(setf (fd-stream-obuf-tail fd-stream) newtail))
((<= bytes len)
(flush-output-buffer fd-stream)
(if (system-area-pointer-p thing)
(system-area-copy thing
- (* start sb!vm:byte-bits)
+ (* start sb!vm:n-byte-bits)
(fd-stream-obuf-sap fd-stream)
0
- (* bytes sb!vm:byte-bits))
+ (* bytes sb!vm:n-byte-bits))
;; FIXME: There should be some type checking somewhere to
;; verify that THING here is a vector, not just <not a SAP>.
(copy-to-system-area thing
- (+ (* start sb!vm:byte-bits)
+ (+ (* start sb!vm:n-byte-bits)
(* sb!vm:vector-data-offset
sb!vm:n-word-bits))
(fd-stream-obuf-sap fd-stream)
0
- (* bytes sb!vm:byte-bits)))
+ (* bytes sb!vm:n-byte-bits)))
(setf (fd-stream-obuf-tail fd-stream) bytes))
(t
(flush-output-buffer fd-stream)
(setf (fd-stream-ibuf-tail stream) 0))
(t
(decf tail head)
- (system-area-copy ibuf-sap (* head sb!vm:byte-bits)
- ibuf-sap 0 (* tail sb!vm:byte-bits))
+ (system-area-copy ibuf-sap (* head sb!vm:n-byte-bits)
+ ibuf-sap 0 (* tail sb!vm:n-byte-bits))
(setf head 0)
(setf (fd-stream-ibuf-head stream) 0)
(setf (fd-stream-ibuf-tail stream) tail))))
(declare (type index start end))
(let* ((length (- end start))
(string (make-string length)))
- (copy-from-system-area sap (* start sb!vm:byte-bits)
+ (copy-from-system-area sap (* start sb!vm:n-byte-bits)
string (* sb!vm:vector-data-offset
sb!vm:n-word-bits)
- (* length sb!vm:byte-bits))
+ (* length sb!vm:n-byte-bits))
string))
;;; the N-BIN method for FD-STREAMs
(exceptions (dpb (float-trap-mask traps) float-sticky-bits 0))
(trap-mask (dpb (lognot (float-trap-mask traps))
float-traps-byte #xffffffff))
- (exception-mask (dpb (lognot (sb!vm::float-trap-mask traps))
+ (exception-mask (dpb (lognot (float-trap-mask traps))
float-sticky-bits #xffffffff))
(orig-modes (gensym)))
`(let ((,orig-modes (floating-point-modes)))
(define-fop (fop-single-float-vector 84)
(let* ((length (read-arg 4))
(result (make-array length :element-type 'single-float)))
- (read-n-bytes *fasl-input-stream* result 0 (* length sb!vm:word-bytes))
+ (read-n-bytes *fasl-input-stream* result 0 (* length sb!vm:n-word-bytes))
result))
(define-fop (fop-double-float-vector 85)
(let* ((length (read-arg 4))
(result (make-array length :element-type 'double-float)))
- (read-n-bytes *fasl-input-stream* result 0 (* length sb!vm:word-bytes 2))
+ (read-n-bytes *fasl-input-stream* result 0 (* length sb!vm:n-word-bytes 2))
result))
#!+long-float
(read-n-bytes *fasl-input-stream*
result
0
- (* length sb!vm:word-bytes #!+x86 3 #!+sparc 4))
+ (* length sb!vm:n-word-bytes #!+x86 3 #!+sparc 4))
result))
(define-fop (fop-complex-single-float-vector 86)
(let* ((length (read-arg 4))
(result (make-array length :element-type '(complex single-float))))
- (read-n-bytes *fasl-input-stream* result 0 (* length sb!vm:word-bytes 2))
+ (read-n-bytes *fasl-input-stream* result 0 (* length sb!vm:n-word-bytes 2))
result))
(define-fop (fop-complex-double-float-vector 87)
(let* ((length (read-arg 4))
(result (make-array length :element-type '(complex double-float))))
- (read-n-bytes *fasl-input-stream* result 0 (* length sb!vm:word-bytes 2 2))
+ (read-n-bytes *fasl-input-stream*
+ result
+ 0
+ (* length sb!vm:n-word-bytes 2 2))
result))
#!+long-float
(let* ((length (read-arg 4))
(result (make-array length :element-type '(complex long-float))))
(read-n-bytes *fasl-input-stream* result 0
- (* length sb!vm:word-bytes #!+x86 3 #!+sparc 4 2))
+ (* length sb!vm:n-word-bytes #!+x86 3 #!+sparc 4 2))
result))
-;;; *** NOT *** the FOP-INT-VECTOR as currently documented in rtguts. Size
-;;; must be a directly supported I-vector element size, with no extra bits.
-;;; This must be packed according to the local byte-ordering, allowing us to
-;;; directly read the bits.
+;;; CMU CL comment:
+;;; *** NOT *** the FOP-INT-VECTOR as currently documented in rtguts.
+;;; Size must be a directly supported I-vector element size, with no
+;;; extra bits. This must be packed according to the local
+;;; byte-ordering, allowing us to directly read the bits.
(define-fop (fop-int-vector 43)
(prepare-for-fast-read-byte *fasl-input-stream*
(let* ((len (fast-read-u-integer 4))
res
0
(ceiling (the index (* size len))
- sb!vm:byte-bits))
+ sb!vm:n-byte-bits))
res)))
;;; This is the same as FOP-INT-VECTOR, except this is for signed
0
(ceiling (the index (* (if (= size 30)
32 ; Adjust for (signed-byte 30)
- size) len)) sb!vm:byte-bits))
+ size) len)) sb!vm:n-byte-bits))
res)))
(define-fop (fop-eval 53)
(current-dynamic-space-start))))
(defun static-space-usage ()
- (- (* sb!vm:*static-space-free-pointer* sb!vm:word-bytes)
+ (- (* sb!vm:*static-space-free-pointer* sb!vm:n-word-bytes)
sb!vm:static-space-start))
(defun read-only-space-usage ()
- (- (* sb!vm::*read-only-space-free-pointer* sb!vm:word-bytes)
+ (- (* sb!vm::*read-only-space-free-pointer* sb!vm:n-word-bytes)
sb!vm:read-only-space-start))
(defun control-stack-usage ()
(def-alien-type-method (system-area-pointer :extract-gen) (type sap offset)
(declare (ignore type))
- `(sap-ref-sap ,sap (/ ,offset sb!vm:byte-bits)))
+ `(sap-ref-sap ,sap (/ ,offset sb!vm:n-byte-bits)))
\f
;;;; the ALIEN-VALUE type
(32 'sap-ref-32)
#!+alpha (64 'sap-ref-64)))))
(if ref-fun
- `(,ref-fun ,sap (/ ,offset sb!vm:byte-bits))
+ `(,ref-fun ,sap (/ ,offset sb!vm:n-byte-bits))
(error "cannot extract ~D bit integers"
(alien-integer-type-bits type)))))
\f
(def-alien-type-method (single-float :extract-gen) (type sap offset)
(declare (ignore type))
- `(sap-ref-single ,sap (/ ,offset sb!vm:byte-bits)))
+ `(sap-ref-single ,sap (/ ,offset sb!vm:n-byte-bits)))
(def-alien-type-class (double-float :include (float (:bits 64))
:include-args (type)))
(def-alien-type-method (double-float :extract-gen) (type sap offset)
(declare (ignore type))
- `(sap-ref-double ,sap (/ ,offset sb!vm:byte-bits)))
+ `(sap-ref-double ,sap (/ ,offset sb!vm:n-byte-bits)))
#!+long-float
(def-alien-type-class (long-float :include (float (:bits #!+x86 96
#!+long-float
(def-alien-type-method (long-float :extract-gen) (type sap offset)
(declare (ignore type))
- `(sap-ref-long ,sap (/ ,offset sb!vm:byte-bits)))
+ `(sap-ref-long ,sap (/ ,offset sb!vm:n-byte-bits)))
\f
;;;; the POINTER type
(def-alien-type-method (mem-block :extract-gen) (type sap offset)
(declare (ignore type))
- `(sap+ ,sap (/ ,offset sb!vm:byte-bits)))
+ `(sap+ ,sap (/ ,offset sb!vm:n-byte-bits)))
(def-alien-type-method (mem-block :deposit-gen) (type sap offset value)
(let ((bits (alien-mem-block-type-bits type)))
(ecase space
(:static
(values (int-sap static-space-start)
- (int-sap (* *static-space-free-pointer* word-bytes))))
+ (int-sap (* *static-space-free-pointer* n-word-bytes))))
(:read-only
(values (int-sap read-only-space-start)
- (int-sap (* *read-only-space-free-pointer* word-bytes))))
+ (int-sap (* *read-only-space-free-pointer* n-word-bytes))))
(:dynamic
(values (int-sap dynamic-space-start)
(dynamic-space-free-pointer)))))
(:string 1)))))
(declare (type (integer -3 3) shift))
(round-to-dualword
- (+ (* vector-data-offset word-bytes)
+ (+ (* vector-data-offset n-word-bytes)
(the fixnum
(if (minusp shift)
(ash (the fixnum
(cond
((or (not info)
(eq (room-info-kind info) :lowtag))
- (let ((size (* cons-size word-bytes)))
+ (let ((size (* cons-size n-word-bytes)))
(funcall fun
(make-lisp-obj (logior (sap-int current)
list-pointer-lowtag))
fun-pointer-lowtag)))
(size (round-to-dualword
(* (the fixnum (1+ (get-closure-length obj)))
- word-bytes))))
+ n-word-bytes))))
(funcall fun obj header-widetag size)
(setq current (sap+ current size))))
((eq (room-info-kind info) :instance)
(let* ((obj (make-lisp-obj
(logior (sap-int current) instance-pointer-lowtag)))
(size (round-to-dualword
- (* (+ (%instance-length obj) 1) word-bytes))))
+ (* (+ (%instance-length obj) 1) n-word-bytes))))
(declare (fixnum size))
(funcall fun obj header-widetag size)
(aver (zerop (logand size lowtag-mask)))
(1+ (get-header-data obj)))
(floatp obj)))
(round-to-dualword
- (* (room-info-length info) word-bytes)))
+ (* (room-info-length info) n-word-bytes)))
((:vector :string)
(vector-total-size obj info))
(:header
(round-to-dualword
- (* (1+ (get-header-data obj)) word-bytes)))
+ (* (1+ (get-header-data obj)) n-word-bytes)))
(:code
(+ (the fixnum
- (* (get-header-data obj) word-bytes))
+ (* (get-header-data obj) n-word-bytes))
(round-to-dualword
(* (the fixnum (%code-code-size obj))
- word-bytes)))))))
+ n-word-bytes)))))))
(declare (fixnum size))
(funcall fun obj header-widetag size)
(aver (zerop (logand size lowtag-mask)))
(%primitive code-instructions obj))))
(incf code-words words)
(dotimes (i words)
- (when (zerop (sap-ref-32 sap (* i sb!vm:word-bytes)))
+ (when (zerop (sap-ref-32 sap (* i n-word-bytes)))
(incf no-ops))))))
space)
(#.code-header-widetag
(let ((inst-words (truly-the fixnum (%code-code-size obj))))
(declare (type fixnum inst-words))
- (incf non-descriptor-bytes (* inst-words word-bytes))
+ (incf non-descriptor-bytes (* inst-words n-word-bytes))
(incf descriptor-words
- (- (truncate size word-bytes) inst-words))))
+ (- (truncate size n-word-bytes) inst-words))))
((#.bignum-widetag
#.single-float-widetag
#.double-float-widetag
#.simple-array-complex-single-float-widetag
#.simple-array-complex-double-float-widetag)
(incf non-descriptor-headers)
- (incf non-descriptor-bytes (- size word-bytes)))
+ (incf non-descriptor-bytes (- size n-word-bytes)))
((#.list-pointer-lowtag
#.instance-pointer-lowtag
#.ratio-widetag
#.sap-widetag
#.weak-pointer-widetag
#.instance-header-widetag)
- (incf descriptor-words (truncate size word-bytes)))
+ (incf descriptor-words (truncate size n-word-bytes)))
(t
- (error "Bogus type: ~D" type))))
+ (error "bogus type: ~D" type))))
space))
(format t "~:D words allocated for descriptor objects.~%"
descriptor-words)
(* sb-vm:vector-data-offset
sb-vm:n-word-bits)
string-sap 0
- (* (1+ n) sb-vm:byte-bits))
+ (* (1+ n) sb-vm:n-byte-bits))
;; Blast the pointer to the string into place.
(setf (sap-ref-sap vec-sap i) string-sap)
(setf string-sap (sap+ string-sap (round-bytes-to-words (1+ n))))
(alien-sap buf) 0
string (* sb-vm:vector-data-offset
sb-vm:n-word-bits)
- (* count sb-vm:byte-bits))
+ (* count sb-vm:n-byte-bits))
(write-string string stream
:end count)))))))))))
;;; The initialization of these streams is performed by
;;; STREAM-COLD-INIT-OR-RESET.
-(defvar *terminal-io* () #!+sb-doc "Terminal I/O stream.")
-(defvar *standard-input* () #!+sb-doc "Default input stream.")
-(defvar *standard-output* () #!+sb-doc "Default output stream.")
-(defvar *error-output* () #!+sb-doc "Error output stream.")
-(defvar *query-io* () #!+sb-doc "Query I/O stream.")
-(defvar *trace-output* () #!+sb-doc "Trace output stream.")
-(defvar *debug-io* () #!+sb-doc "Interactive debugging stream.")
+(defvar *terminal-io* () #!+sb-doc "terminal I/O stream")
+(defvar *standard-input* () #!+sb-doc "default input stream")
+(defvar *standard-output* () #!+sb-doc "default output stream")
+(defvar *error-output* () #!+sb-doc "error output stream")
+(defvar *query-io* () #!+sb-doc "query I/O stream")
+(defvar *trace-output* () #!+sb-doc "trace output stream")
+(defvar *debug-io* () #!+sb-doc "interactive debugging stream")
(defun ill-in (stream &rest ignore)
(declare (ignore ignore))
(funcall (lisp-stream-in stream) stream eof-error-p eof-value))
(t
(when (/= start +in-buffer-extra+)
- (bit-bash-copy ibuf (+ (* +in-buffer-extra+ sb!vm:byte-bits)
+ (bit-bash-copy ibuf (+ (* +in-buffer-extra+ sb!vm:n-byte-bits)
(* sb!vm:vector-data-offset
sb!vm:n-word-bits))
- ibuf (+ (the index (* start sb!vm:byte-bits))
+ ibuf (+ (the index (* start sb!vm:n-byte-bits))
(* sb!vm:vector-data-offset
sb!vm:n-word-bits))
- (* count sb!vm:byte-bits)))
+ (* count sb!vm:n-byte-bits)))
(setf (lisp-stream-in-index stream) (1+ start))
(code-char (aref ibuf start))))))
(t
(unless (zerop start)
(bit-bash-copy ibuf (* sb!vm:vector-data-offset sb!vm:n-word-bits)
- ibuf (+ (the index (* start sb!vm:byte-bits))
+ ibuf (+ (the index (* start sb!vm:n-byte-bits))
(* sb!vm:vector-data-offset
sb!vm:n-word-bits))
- (* count sb!vm:byte-bits)))
+ (* count sb!vm:n-byte-bits)))
(setf (lisp-stream-in-index stream) (1+ start))
(aref ibuf start)))))
\f
(truly-the index (+ index copy)))
(sb!sys:without-gcing
(system-area-copy (vector-sap string)
- (* index sb!vm:byte-bits)
+ (* index sb!vm:n-byte-bits)
(if (typep buffer 'system-area-pointer)
buffer
(vector-sap buffer))
- (* start sb!vm:byte-bits)
- (* copy sb!vm:byte-bits))))
+ (* start sb!vm:n-byte-bits)
+ (* copy sb!vm:n-byte-bits))))
(if (and (> requested copy) eof-error-p)
(error 'end-of-file :stream stream)
copy)))
(let* ((field (slot-or-lose type slot))
(offset (alien-record-field-offset field))
(field-type (alien-record-field-type field)))
- (%sap-alien (sap+ (alien-sap alien) (/ offset sb!vm:byte-bits))
+ (%sap-alien (sap+ (alien-sap alien) (/ offset sb!vm:n-byte-bits))
(make-alien-pointer-type :to field-type)))))))
\f
;;;; the DEREF operator
(type list indices)
(optimize (inhibit-warnings 3)))
(multiple-value-bind (target-type offset) (deref-guts alien indices)
- (%sap-alien (sap+ (alien-value-sap alien) (/ offset sb!vm:byte-bits))
+ (%sap-alien (sap+ (alien-value-sap alien) (/ offset sb!vm:n-byte-bits))
(make-alien-pointer-type :to target-type))))
\f
;;;; accessing heap alien variables
(values (ceiling bits
(ecase units
(:bits 1)
- (:bytes sb!vm:byte-bits)
+ (:bytes sb!vm:n-byte-bits)
(:words sb!vm:n-word-bits))))
(error "unknown size for alien type ~S"
(unparse-alien-type alien-type)))))
(sb!kernel:copy-from-system-area (alien-sap ptr) 0
result (* sb!vm:vector-data-offset
sb!vm:n-word-bits)
- (* length sb!vm:byte-bits))
+ (* length sb!vm:n-byte-bits))
result)))))
(look (sap+ ptr bytes-per-scrub-unit) 0 count))
(t
(setf (sap-ref-32 ptr offset) 0)
- (scrub ptr (+ offset sb!vm:word-bytes) count))))
+ (scrub ptr (+ offset sb!vm:n-word-bytes) count))))
(look (ptr offset count)
(declare (type system-area-pointer ptr)
(type (unsigned-byte 16) offset)
(cond ((= offset bytes-per-scrub-unit)
count)
((zerop (sap-ref-32 ptr offset))
- (look ptr (+ offset sb!vm:word-bytes) count))
+ (look ptr (+ offset sb!vm:n-word-bytes) count))
(t
- (scrub ptr offset (+ count sb!vm:word-bytes))))))
+ (scrub ptr offset (+ count sb!vm:n-word-bytes))))))
(let* ((csp (sap-int (sb!c::control-stack-pointer-sap)))
(initial-offset (logand csp (1- bytes-per-scrub-unit))))
(declare (type (unsigned-byte 32) csp))
(scrub (int-sap (- csp initial-offset))
- (* (floor initial-offset sb!vm:word-bytes) sb!vm:word-bytes)
+ (* (floor initial-offset sb!vm:n-word-bytes) sb!vm:n-word-bytes)
0)))
#!+x86 ;; (Stack grows downwards.)
(type (unsigned-byte 16) offset)
(type (unsigned-byte 20) count)
(values (unsigned-byte 20)))
- (let ((loc (int-sap (- (sap-int ptr) (+ offset sb!vm:word-bytes)))))
+ (let ((loc (int-sap (- (sap-int ptr) (+ offset sb!vm:n-word-bytes)))))
(cond ((= offset bytes-per-scrub-unit)
(look (int-sap (- (sap-int ptr) bytes-per-scrub-unit))
0 count))
(t ;; need to fix bug in %SET-STACK-REF
(setf (sap-ref-32 loc 0) 0)
- (scrub ptr (+ offset sb!vm:word-bytes) count)))))
+ (scrub ptr (+ offset sb!vm:n-word-bytes) count)))))
(look (ptr offset count)
(declare (type system-area-pointer ptr)
(type (unsigned-byte 16) offset)
(cond ((= offset bytes-per-scrub-unit)
count)
((zerop (sb!kernel::get-lisp-obj-address (stack-ref loc 0)))
- (look ptr (+ offset sb!vm:word-bytes) count))
+ (look ptr (+ offset sb!vm:n-word-bytes) count))
(t
- (scrub ptr offset (+ count sb!vm:word-bytes)))))))
+ (scrub ptr offset (+ count sb!vm:n-word-bytes)))))))
(let* ((csp (sap-int (sb!c::control-stack-pointer-sap)))
(initial-offset (logand csp (1- bytes-per-scrub-unit))))
(declare (type (unsigned-byte 32) csp))
(scrub (int-sap (+ csp initial-offset))
- (* (floor initial-offset sb!vm:word-bytes) sb!vm:word-bytes)
+ (* (floor initial-offset sb!vm:n-word-bytes) sb!vm:n-word-bytes)
0))))
\f
;;;; the default toplevel function
new-fixups)))
(t
(unless (or (eq (get-type fixups)
- sb!vm:unbound-marker-widetag)
+ unbound-marker-widetag)
(zerop fixups))
(format t "** Init. code FU = ~S~%" fixups)) ; FIXME
(setf (code-header-ref code code-constants-offset)
#!+gencgc
(defun !do-load-time-code-fixup (code offset fixup kind)
(flet ((add-load-time-code-fixup (code offset)
- (let ((fixups (code-header-ref code sb!vm:code-constants-offset)))
+ (let ((fixups (code-header-ref code code-constants-offset)))
(cond ((typep fixups '(simple-array (unsigned-byte 32) (*)))
(let ((new-fixups
(adjust-array fixups (1+ (length fixups))
:element-type '(unsigned-byte 32))))
(setf (aref new-fixups (length fixups)) offset)
- (setf (code-header-ref code sb!vm:code-constants-offset)
+ (setf (code-header-ref code code-constants-offset)
new-fixups)))
(t
(unless (or (eq (get-type fixups)
- sb!vm:unbound-marker-widetag)
+ unbound-marker-widetag)
(zerop fixups))
(sb!impl::!cold-lose "Argh! can't process fixup"))
- (setf (code-header-ref code sb!vm:code-constants-offset)
+ (setf (code-header-ref code code-constants-offset)
(make-specializable-array
1
:element-type '(unsigned-byte 32)
(/show0 "LENGTH,VECTOR,ERROR-NUMBER=..")
(/hexstr length)
(/hexstr vector)
- (copy-from-system-area pc (* sb!vm:byte-bits 2)
- vector (* sb!vm:n-word-bits
- sb!vm:vector-data-offset)
- (* length sb!vm:byte-bits))
+ (copy-from-system-area pc (* n-byte-bits 2)
+ vector (* n-word-bits vector-data-offset)
+ (* length n-byte-bits))
(let* ((index 0)
(error-number (sb!c::read-var-integer vector index)))
(/hexstr error-number)
(multiple-value-bind (slot-offset slot-type)
(find-slot-offset-and-type alien slot)
(/noshow "in DEFTRANSFORM %SLOT-ADDR, creating %SAP-ALIEN")
- `(%sap-alien (sap+ (alien-sap alien) (/ ,slot-offset sb!vm:byte-bits))
+ `(%sap-alien (sap+ (alien-sap alien) (/ ,slot-offset sb!vm:n-byte-bits))
',(make-alien-pointer-type :to slot-type))))
\f
;;;; DEREF support
(compute-deref-guts alien indices)
(/noshow "in DEFTRANSFORM %DEREF-ADDR, creating (LAMBDA .. %SAP-ALIEN)")
`(lambda (alien ,@indices-args)
- (%sap-alien (sap+ (alien-sap alien) (/ ,offset-expr sb!vm:byte-bits))
+ (%sap-alien (sap+ (alien-sap alien) (/ ,offset-expr sb!vm:n-byte-bits))
',(make-alien-pointer-type :to element-type)))))
\f
;;;; support for aliens on the heap
#!+x86 `(truly-the system-area-pointer
(%primitive alloc-alien-stack-space
,(ceiling (alien-type-bits alien-type)
- sb!vm:byte-bits)))
+ sb!vm:n-byte-bits)))
#!-x86 `(truly-the system-area-pointer
(%primitive alloc-number-stack-space
,(ceiling (alien-type-bits alien-type)
- sb!vm:byte-bits)))
+ sb!vm:n-byte-bits)))
(let* ((alien-rep-type-spec (compute-alien-rep-type alien-type))
(alien-rep-type (specifier-type alien-rep-type-spec)))
(cond ((csubtypep (specifier-type 'system-area-pointer)
(if (local-alien-info-force-to-memory-p info)
#!+x86 `(%primitive dealloc-alien-stack-space
,(ceiling (alien-type-bits alien-type)
- sb!vm:byte-bits))
+ sb!vm:n-byte-bits))
#!-x86 `(%primitive dealloc-number-stack-space
,(ceiling (alien-type-bits alien-type)
- sb!vm:byte-bits))
+ sb!vm:n-byte-bits))
nil)))
\f
;;;; %CAST
(:temporary (:scs (non-descriptor-reg)) header)
(:temporary (:scs (non-descriptor-reg)) bytes)
(:generator 6
- (inst lda bytes (* (1+ words) word-bytes) extra)
+ (inst lda bytes (* (1+ words) n-word-bytes) extra)
(inst sll bytes (- n-widetag-bits 2) header)
(inst lda header (+ (ash -2 n-widetag-bits) type) header)
(inst srl bytes n-lowtag-bits bytes)
(:temporary (:scs (non-descriptor-reg)) header)
(:results (result :scs (descriptor-reg)))
(:generator 13
- (inst addq rank (+ (* array-dimensions-offset word-bytes)
+ (inst addq rank (+ (* array-dimensions-offset n-word-bytes)
lowtag-mask)
bytes)
(inst li (lognot lowtag-mask) header)
(inst sll temp 2 temp)
(inst addq object temp lip)
(inst ldl result
- (- (* vector-data-offset word-bytes)
+ (- (* vector-data-offset n-word-bytes)
other-pointer-lowtag)
lip)
(inst and index ,(1- elements-per-word) temp)
(integer 0
,(1- (* (1+ (- (floor (+ #x7fff
other-pointer-lowtag)
- word-bytes)
+ n-word-bytes)
vector-data-offset))
elements-per-word)))))
(:info index)
(inst sll temp 2 temp)
(inst addq object temp lip)
(inst ldl old
- (- (* vector-data-offset word-bytes)
+ (- (* vector-data-offset n-word-bytes)
other-pointer-lowtag)
lip)
(inst and index ,(1- elements-per-word) shift)
(inst sll temp shift temp)
(inst bis old temp old))
(inst stl old
- (- (* vector-data-offset word-bytes)
+ (- (* vector-data-offset n-word-bytes)
other-pointer-lowtag)
lip)
(sc-case value
(integer 0
,(1- (* (1+ (- (floor (+ #x7fff
other-pointer-lowtag)
- word-bytes)
+ n-word-bytes)
vector-data-offset))
elements-per-word))))
positive-fixnum)
(floor index ,elements-per-word)
(inst ldl object
(- (* (+ word vector-data-offset)
- word-bytes)
+ n-word-bytes)
other-pointer-lowtag)
old)
(unless (and (sc-is value immediate)
(inst bis old temp old)))
(inst stl old
(- (* (+ word vector-data-offset)
- word-bytes)
+ n-word-bytes)
other-pointer-lowtag)
object)
(sc-case value
(:generator 20
(inst addq object index lip)
(inst lds value
- (- (* vector-data-offset word-bytes)
+ (- (* vector-data-offset n-word-bytes)
other-pointer-lowtag)
lip)))
(:generator 20
(inst addq object index lip)
(inst sts value
- (- (* vector-data-offset word-bytes)
+ (- (* vector-data-offset n-word-bytes)
other-pointer-lowtag)
lip)
(unless (location= result value)
(inst addq object index lip)
(inst addq lip index lip)
(inst ldt value
- (- (* vector-data-offset word-bytes)
+ (- (* vector-data-offset n-word-bytes)
other-pointer-lowtag)
lip)))
(inst addq object index lip)
(inst addq lip index lip)
(inst stt value
- (- (* vector-data-offset word-bytes)
+ (- (* vector-data-offset n-word-bytes)
other-pointer-lowtag) lip)
(unless (location= result value)
(inst fmove value result))))
(inst addq object index lip)
(inst addq lip index lip)
(inst lds real-tn
- (- (* vector-data-offset word-bytes) other-pointer-lowtag)
+ (- (* vector-data-offset n-word-bytes) other-pointer-lowtag)
lip))
(let ((imag-tn (complex-single-reg-imag-tn value)))
(inst lds imag-tn
- (- (* (1+ vector-data-offset) word-bytes) other-pointer-lowtag)
+ (- (* (1+ vector-data-offset) n-word-bytes) other-pointer-lowtag)
lip))))
(define-vop (data-vector-set/simple-array-complex-single-float)
(inst addq object index lip)
(inst addq lip index lip)
(inst sts value-real
- (- (* vector-data-offset word-bytes) other-pointer-lowtag)
+ (- (* vector-data-offset n-word-bytes) other-pointer-lowtag)
lip)
(unless (location= result-real value-real)
(inst fmove value-real result-real)))
(let ((value-imag (complex-single-reg-imag-tn value))
(result-imag (complex-single-reg-imag-tn result)))
(inst sts value-imag
- (- (* (1+ vector-data-offset) word-bytes) other-pointer-lowtag)
+ (- (* (1+ vector-data-offset) n-word-bytes) other-pointer-lowtag)
lip)
(unless (location= result-imag value-imag)
(inst fmove value-imag result-imag)))))
(inst addq lip index lip)
(inst addq lip index lip)
(inst ldt real-tn
- (- (* vector-data-offset word-bytes) other-pointer-lowtag)
+ (- (* vector-data-offset n-word-bytes) other-pointer-lowtag)
lip))
(let ((imag-tn (complex-double-reg-imag-tn value)))
(inst ldt imag-tn
- (- (* (+ vector-data-offset 2) word-bytes) other-pointer-lowtag)
+ (- (* (+ vector-data-offset 2) n-word-bytes) other-pointer-lowtag)
lip))))
(define-vop (data-vector-set/simple-array-complex-double-float)
(inst addq lip index lip)
(inst addq lip index lip)
(inst stt value-real
- (- (* vector-data-offset word-bytes) other-pointer-lowtag)
+ (- (* vector-data-offset n-word-bytes) other-pointer-lowtag)
lip)
(unless (location= result-real value-real)
(inst fmove value-real result-real)))
(let ((value-imag (complex-double-reg-imag-tn value))
(result-imag (complex-double-reg-imag-tn result)))
(inst stt value-imag
- (- (* (+ vector-data-offset 2) word-bytes) other-pointer-lowtag)
+ (- (* (+ vector-data-offset 2) n-word-bytes) other-pointer-lowtag)
lip)
(unless (location= result-imag value-imag)
(inst fmove value-imag result-imag)))))
(dolist (arg-type (alien-fun-type-arg-types type))
(arg-tns (invoke-alien-type-method :arg-tn arg-type arg-state)))
(values (my-make-wired-tn 'positive-fixnum 'any-reg nsp-offset)
- (* (max (arg-state-stack-frame-size arg-state) 4) word-bytes)
+ (* (max (arg-state-stack-frame-size arg-state) 4) n-word-bytes)
(arg-tns)
(invoke-alien-type-method :result-tn
(alien-fun-type-result-type type)
;;; bytes on the PMAX.
(defun bytes-needed-for-non-descriptor-stack-frame ()
(* (logandc2 (1+ (sb-allocated-size 'non-descriptor-stack)) 1)
- word-bytes))
+ n-word-bytes))
;;; This is used for setting up the Old-FP in local call.
(define-vop (current-fp)
;; collector won't forget about us if we call anyone else.
)
;; Build our stack frames.
- (inst lda csp-tn (* word-bytes (sb-allocated-size 'control-stack)) cfp-tn)
+ (inst lda
+ csp-tn
+ (* n-word-bytes (sb-allocated-size 'control-stack))
+ cfp-tn)
(let ((nfp (current-nfp-tn vop)))
(when nfp
(inst subq nsp-tn (bytes-needed-for-non-descriptor-stack-frame)
(:generator 2
(trace-table-entry trace-table-function-prologue)
(move csp-tn res)
- (inst lda csp-tn (* word-bytes (sb-allocated-size 'control-stack)) csp-tn)
+ (inst lda
+ csp-tn
+ (* n-word-bytes (sb-allocated-size 'control-stack))
+ csp-tn)
(when (ir2-physenv-number-stack-p callee)
(inst subq nsp-tn (bytes-needed-for-non-descriptor-stack-frame)
nsp-tn)
(:generator 2
(when (> nargs register-arg-count)
(move csp-tn res)
- (inst lda csp-tn (* nargs word-bytes) csp-tn))))
+ (inst lda csp-tn (* nargs n-word-bytes) csp-tn))))
;;; Emit code needed at the return-point from an unknown-values call
;;; for a fixed number of values. Values is the head of the TN-Ref
(defaults (cons default-lab tn))
(inst blt temp default-lab)
- (inst ldl move-temp (* i word-bytes) ocfp-tn)
+ (inst ldl move-temp (* i n-word-bytes) ocfp-tn)
(inst subq temp (fixnumize 1) temp)
(store-stack-tn tn move-temp)))
(when cur-nfp
(inst addq cur-nfp (bytes-needed-for-non-descriptor-stack-frame)
nsp-tn)))
- (inst subq return-pc-temp (- other-pointer-lowtag word-bytes) lip)
+ (inst subq return-pc-temp (- other-pointer-lowtag n-word-bytes) lip)
(move ocfp-temp cfp-tn)
(inst ret zero-tn lip 1)
(trace-table-entry trace-table-normal)))
#!-gengc (lisp-return return-pc lip :offset 2)
#!+gengc
(progn
- (inst addq return-pc (* 2 word-bytes) temp)
+ (inst addq return-pc (* 2 n-word-bytes) temp)
(unless (location= ra return-pc)
(inst move ra return-pc))
(inst ret zero-tn temp 1))
;; restore the frame pointer and clear as much of the control
;; stack as possible.
(move ocfp cfp-tn)
- (inst addq val-ptr (* nvals word-bytes) csp-tn)
+ (inst addq val-ptr (* nvals n-word-bytes) csp-tn)
;; pre-default any argument register that need it.
(when (< nvals register-arg-count)
(dolist (reg (subseq (list a0 a1 a2 a3 a4 a5) nvals))
(emit-label loop)
;; *--dst = *--src, --count
- (inst subq src word-bytes src)
+ (inst subq src n-word-bytes src)
(inst subq count (fixnumize 1) count)
(loadw temp src)
- (inst subq dst word-bytes dst)
+ (inst subq dst n-word-bytes dst)
(storew temp dst)
(inst bgt count loop)
;; Store the current cons in the cdr of the previous cons.
(emit-label loop)
- (inst addq dst (* 2 word-bytes) dst)
+ (inst addq dst (* 2 n-word-bytes) dst)
(storew dst dst -1 list-pointer-lowtag)
(emit-label enter)
;; Grab one value.
(loadw temp context)
- (inst addq context word-bytes context)
+ (inst addq context n-word-bytes context)
;; Store the value in the car (in delay slot)
(storew temp dst 0 list-pointer-lowtag)
(:temporary (:scs (descriptor-reg)) temp)
(:generator 5
(loadw temp symbol symbol-value-slot other-pointer-lowtag)
- (inst addq bsp-tn (* 2 word-bytes) bsp-tn)
+ (inst addq bsp-tn (* 2 n-word-bytes) bsp-tn)
(storew temp bsp-tn (- binding-value-slot binding-size))
(storew symbol bsp-tn (- binding-symbol-slot binding-size))
(#+gengc storew-and-remember-slot #-gengc storew
(#+gengc storew-and-remember-slot #-gengc storew
value symbol symbol-value-slot other-pointer-lowtag)
(storew zero-tn bsp-tn (- binding-symbol-slot binding-size))
- (inst subq bsp-tn (* 2 word-bytes) bsp-tn)))
+ (inst subq bsp-tn (* 2 n-word-bytes) bsp-tn)))
(define-vop (unbind-to-here)
(storew zero-tn bsp-tn (- binding-symbol-slot binding-size))
(emit-label skip)
- (inst subq bsp-tn (* 2 word-bytes) bsp-tn)
+ (inst subq bsp-tn (* 2 n-word-bytes) bsp-tn)
(inst cmpeq where bsp-tn temp)
(inst beq temp loop)
(:results (result :scs (descriptor-reg)))
(:result-types *)
(:generator 4
- (inst ldl result (* offset word-bytes) object)))
+ (inst ldl result (* offset n-word-bytes) object)))
(define-vop (write-control-stack)
(:translate %set-stack-ref)
(:results (result :scs (descriptor-reg)))
(:result-types *)
(:generator 1
- (inst stl value (* offset word-bytes) sap)
+ (inst stl value (* offset n-word-bytes) sap)
(move value result)))
(loadw temp thing 0 lowtag)
(inst srl temp sb!vm:n-widetag-bits temp)
(inst beq temp bogus)
- (inst sll temp (1- (integer-length sb!vm:word-bytes)) temp)
+ (inst sll temp (1- (integer-length sb!vm:n-word-bytes)) temp)
(unless (= lowtag sb!vm:other-pointer-lowtag)
(inst subq temp (- sb!vm:other-pointer-lowtag lowtag) temp))
(inst subq thing temp code)
(define-move-function (load-single 1) (vop x y)
((single-stack) (single-reg))
- (inst lds y (* (tn-offset x) word-bytes) (current-nfp-tn vop)))
+ (inst lds y (* (tn-offset x) n-word-bytes) (current-nfp-tn vop)))
(define-move-function (store-single 1) (vop x y)
((single-reg) (single-stack))
- (inst sts x (* (tn-offset y) word-bytes) (current-nfp-tn vop)))
+ (inst sts x (* (tn-offset y) n-word-bytes) (current-nfp-tn vop)))
(define-move-function (load-double 2) (vop x y)
((double-stack) (double-reg))
(let ((nfp (current-nfp-tn vop))
- (offset (* (tn-offset x) word-bytes)))
+ (offset (* (tn-offset x) n-word-bytes)))
(inst ldt y offset nfp)))
(define-move-function (store-double 2) (vop x y)
((double-reg) (double-stack))
(let ((nfp (current-nfp-tn vop))
- (offset (* (tn-offset y) word-bytes)))
+ (offset (* (tn-offset y) n-word-bytes)))
(inst stt x offset nfp)))
\f
;;;; float move VOPs
(:generator 13
(with-fixed-allocation (y ndescr type size)
(if double-p
- (inst stt x (- (* data word-bytes) other-pointer-lowtag) y)
- (inst sts x (- (* data word-bytes) other-pointer-lowtag) y)))))
+ (inst stt x (- (* data n-word-bytes) other-pointer-lowtag) y)
+ (inst sts x (- (* data n-word-bytes) other-pointer-lowtag) y)))))
(macrolet ((frob (name sc &rest args)
`(progn
(:note "pointer to float coercion")
(:generator 2
,@(if double-p
- `((inst ldt y (- (* ,value word-bytes)
+ `((inst ldt y (- (* ,value n-word-bytes)
other-pointer-lowtag)
x))
- `((inst lds y (- (* ,value word-bytes)
+ `((inst lds y (- (* ,value n-word-bytes)
other-pointer-lowtag)
x)))))
(define-move-vop ,name :move (descriptor-reg) (,sc)))))
(unless (location= x y)
(inst fmove x y)))
(,stack-sc
- (let ((offset (* (tn-offset y) word-bytes)))
+ (let ((offset (* (tn-offset y) n-word-bytes)))
,@(if double-p
'((inst stt x offset nfp))
'((inst sts x offset nfp))))))))
(define-move-function (load-complex-single 2) (vop x y)
((complex-single-stack) (complex-single-reg))
(let ((nfp (current-nfp-tn vop))
- (offset (* (tn-offset x) sb!vm:word-bytes)))
+ (offset (* (tn-offset x) n-word-bytes)))
(let ((real-tn (complex-single-reg-real-tn y)))
(inst lds real-tn offset nfp))
(let ((imag-tn (complex-single-reg-imag-tn y)))
- (inst lds imag-tn (+ offset sb!vm:word-bytes) nfp))))
+ (inst lds imag-tn (+ offset n-word-bytes) nfp))))
(define-move-function (store-complex-single 2) (vop x y)
((complex-single-reg) (complex-single-stack))
(let ((nfp (current-nfp-tn vop))
- (offset (* (tn-offset y) sb!vm:word-bytes)))
+ (offset (* (tn-offset y) n-word-bytes)))
(let ((real-tn (complex-single-reg-real-tn x)))
(inst sts real-tn offset nfp))
(let ((imag-tn (complex-single-reg-imag-tn x)))
- (inst sts imag-tn (+ offset sb!vm:word-bytes) nfp))))
+ (inst sts imag-tn (+ offset n-word-bytes) nfp))))
(define-move-function (load-complex-double 4) (vop x y)
((complex-double-stack) (complex-double-reg))
(let ((nfp (current-nfp-tn vop))
- (offset (* (tn-offset x) sb!vm:word-bytes)))
+ (offset (* (tn-offset x) n-word-bytes)))
(let ((real-tn (complex-double-reg-real-tn y)))
(inst ldt real-tn offset nfp))
(let ((imag-tn (complex-double-reg-imag-tn y)))
- (inst ldt imag-tn (+ offset (* 2 sb!vm:word-bytes)) nfp))))
+ (inst ldt imag-tn (+ offset (* 2 n-word-bytes)) nfp))))
(define-move-function (store-complex-double 4) (vop x y)
((complex-double-reg) (complex-double-stack))
(let ((nfp (current-nfp-tn vop))
- (offset (* (tn-offset y) sb!vm:word-bytes)))
+ (offset (* (tn-offset y) n-word-bytes)))
(let ((real-tn (complex-double-reg-real-tn x)))
(inst stt real-tn offset nfp))
(let ((imag-tn (complex-double-reg-imag-tn x)))
- (inst stt imag-tn (+ offset (* 2 sb!vm:word-bytes)) nfp))))
+ (inst stt imag-tn (+ offset (* 2 n-word-bytes)) nfp))))
;;;
;;; complex float register to register moves.
(:temporary (:scs (non-descriptor-reg)) ndescr)
(:note "complex single float to pointer coercion")
(:generator 13
- (with-fixed-allocation (y ndescr sb!vm:complex-single-float-widetag
- sb!vm:complex-single-float-size)
+ (with-fixed-allocation (y ndescr complex-single-float-widetag
+ complex-single-float-size)
(let ((real-tn (complex-single-reg-real-tn x)))
- (inst sts real-tn (- (* sb!vm:complex-single-float-real-slot
- sb!vm:word-bytes)
- sb!vm:other-pointer-lowtag)
+ (inst sts real-tn (- (* complex-single-float-real-slot
+ n-word-bytes)
+ other-pointer-lowtag)
y))
(let ((imag-tn (complex-single-reg-imag-tn x)))
- (inst sts imag-tn (- (* sb!vm:complex-single-float-imag-slot
- sb!vm:word-bytes)
- sb!vm:other-pointer-lowtag)
+ (inst sts imag-tn (- (* complex-single-float-imag-slot
+ n-word-bytes)
+ other-pointer-lowtag)
y)))))
;;;
(define-move-vop move-from-complex-single :move
(:temporary (:scs (non-descriptor-reg)) ndescr)
(:note "complex double float to pointer coercion")
(:generator 13
- (with-fixed-allocation (y ndescr sb!vm:complex-double-float-widetag
- sb!vm:complex-double-float-size)
+ (with-fixed-allocation (y ndescr complex-double-float-widetag
+ complex-double-float-size)
(let ((real-tn (complex-double-reg-real-tn x)))
- (inst stt real-tn (- (* sb!vm:complex-double-float-real-slot
- sb!vm:word-bytes)
- sb!vm:other-pointer-lowtag)
+ (inst stt real-tn (- (* complex-double-float-real-slot
+ n-word-bytes)
+ other-pointer-lowtag)
y))
(let ((imag-tn (complex-double-reg-imag-tn x)))
- (inst stt imag-tn (- (* sb!vm:complex-double-float-imag-slot
- sb!vm:word-bytes)
- sb!vm:other-pointer-lowtag)
+ (inst stt imag-tn (- (* complex-double-float-imag-slot
+ n-word-bytes)
+ other-pointer-lowtag)
y)))))
;;;
(define-move-vop move-from-complex-double :move
(:note "pointer to complex float coercion")
(:generator 2
(let ((real-tn (complex-single-reg-real-tn y)))
- (inst lds real-tn (- (* complex-single-float-real-slot sb!vm:word-bytes)
- sb!vm:other-pointer-lowtag)
+ (inst lds real-tn (- (* complex-single-float-real-slot
+ n-word-bytes)
+ other-pointer-lowtag)
x))
(let ((imag-tn (complex-single-reg-imag-tn y)))
- (inst lds imag-tn (- (* complex-single-float-imag-slot sb!vm:word-bytes)
- sb!vm:other-pointer-lowtag)
+ (inst lds imag-tn (- (* complex-single-float-imag-slot
+ n-word-bytes)
+ other-pointer-lowtag)
x))))
(define-move-vop move-to-complex-single :move
(descriptor-reg) (complex-single-reg))
(:note "pointer to complex float coercion")
(:generator 2
(let ((real-tn (complex-double-reg-real-tn y)))
- (inst ldt real-tn (- (* complex-double-float-real-slot sb!vm:word-bytes)
- sb!vm:other-pointer-lowtag)
+ (inst ldt real-tn (- (* complex-double-float-real-slot
+ n-word-bytes)
+ other-pointer-lowtag)
x))
(let ((imag-tn (complex-double-reg-imag-tn y)))
- (inst ldt imag-tn (- (* complex-double-float-imag-slot sb!vm:word-bytes)
- sb!vm:other-pointer-lowtag)
+ (inst ldt imag-tn (- (* complex-double-float-imag-slot
+ n-word-bytes)
+ other-pointer-lowtag)
x))))
(define-move-vop move-to-complex-double :move
(descriptor-reg) (complex-double-reg))
(y-imag (complex-single-reg-imag-tn y)))
(inst fmove x-imag y-imag))))
(complex-single-stack
- (let ((offset (* (tn-offset y) sb!vm:word-bytes)))
+ (let ((offset (* (tn-offset y) n-word-bytes)))
(let ((real-tn (complex-single-reg-real-tn x)))
(inst sts real-tn offset nfp))
(let ((imag-tn (complex-single-reg-imag-tn x)))
- (inst sts imag-tn (+ offset word-bytes) nfp)))))))
+ (inst sts imag-tn (+ offset n-word-bytes) nfp)))))))
(define-move-vop move-complex-single-float-argument :move-argument
(complex-single-reg descriptor-reg) (complex-single-reg))
(y-imag (complex-double-reg-imag-tn y)))
(inst fmove x-imag y-imag))))
(complex-double-stack
- (let ((offset (* (tn-offset y) sb!vm:word-bytes)))
+ (let ((offset (* (tn-offset y) n-word-bytes)))
(let ((real-tn (complex-double-reg-real-tn x)))
(inst stt real-tn offset nfp))
(let ((imag-tn (complex-double-reg-imag-tn x)))
- (inst stt imag-tn (+ offset (* 2 word-bytes)) nfp)))))))
+ (inst stt imag-tn (+ offset (* 2 n-word-bytes)) nfp)))))))
(define-move-vop move-complex-double-float-argument :move-argument
(complex-double-reg descriptor-reg) (complex-double-reg))
(sc-case x
(signed-reg
(inst stl x
- (* (tn-offset temp) sb!vm:word-bytes)
+ (* (tn-offset temp)
+ n-word-bytes)
(current-nfp-tn vop))
temp)
(signed-stack
x))))
(inst ,ld-inst y
- (* (tn-offset stack-tn) sb!vm:word-bytes)
+ (* (tn-offset stack-tn) n-word-bytes)
(current-nfp-tn vop))
(note-this-location vop :internal-error)
,@(when single
(sc-case y
(signed-stack
(inst stt temp
- (* (tn-offset y) sb!vm:word-bytes)
+ (* (tn-offset y) n-word-bytes)
(current-nfp-tn vop)))
(signed-reg
(inst stt temp
(* (tn-offset stack-temp)
- sb!vm:word-bytes)
+ n-word-bytes)
(current-nfp-tn vop))
(inst ldq y
- (* (tn-offset stack-temp) sb!vm:word-bytes)
+ (* (tn-offset stack-temp) n-word-bytes)
(current-nfp-tn vop))))))))
(frob %unary-truncate single-reg single-float cvttq/c t)
(frob %unary-truncate double-reg double-float cvttq/c)
(sc-case res
(single-reg
(inst stl bits
- (* (tn-offset stack-temp) sb!vm:word-bytes)
+ (* (tn-offset stack-temp) n-word-bytes)
(current-nfp-tn vop))
(inst lds res
- (* (tn-offset stack-temp) sb!vm:word-bytes)
+ (* (tn-offset stack-temp) n-word-bytes)
(current-nfp-tn vop)))
(single-stack
(inst stl bits
- (* (tn-offset res) sb!vm:word-bytes)
+ (* (tn-offset res) n-word-bytes)
(current-nfp-tn vop)))))
(signed-stack
(sc-case res
(single-reg
(inst lds res
- (* (tn-offset bits) sb!vm:word-bytes)
+ (* (tn-offset bits) n-word-bytes)
(current-nfp-tn vop)))
(single-stack
(unless (location= bits res)
(inst ldl temp
- (* (tn-offset bits) sb!vm:word-bytes)
+ (* (tn-offset bits) n-word-bytes)
(current-nfp-tn vop))
(inst stl temp
- (* (tn-offset res) sb!vm:word-bytes)
+ (* (tn-offset res) n-word-bytes)
(current-nfp-tn vop)))))))))
(define-vop (make-double-float)
(double-stack res)
(double-reg temp))))
(inst stl hi-bits
- (* (1+ (tn-offset stack-tn)) sb!vm:word-bytes)
+ (* (1+ (tn-offset stack-tn)) n-word-bytes)
(current-nfp-tn vop))
(inst stl lo-bits
- (* (tn-offset stack-tn) sb!vm:word-bytes)
+ (* (tn-offset stack-tn) n-word-bytes)
(current-nfp-tn vop)))
(when (sc-is res double-reg)
(inst ldt res
- (* (tn-offset temp) sb!vm:word-bytes)
+ (* (tn-offset temp) n-word-bytes)
(current-nfp-tn vop)))))
(define-vop (single-float-bits)
(sc-case float
(single-reg
(inst sts float
- (* (tn-offset stack-temp) sb!vm:word-bytes)
+ (* (tn-offset stack-temp) n-word-bytes)
(current-nfp-tn vop))
(inst ldl bits
- (* (tn-offset stack-temp) sb!vm:word-bytes)
+ (* (tn-offset stack-temp) n-word-bytes)
(current-nfp-tn vop)))
(single-stack
(inst ldl bits
- (* (tn-offset float) sb!vm:word-bytes)
+ (* (tn-offset float) n-word-bytes)
(current-nfp-tn vop)))
(descriptor-reg
- (loadw bits float sb!vm:single-float-value-slot
- sb!vm:other-pointer-lowtag))))
+ (loadw bits float single-float-value-slot
+ other-pointer-lowtag))))
(signed-stack
(sc-case float
(single-reg
(inst sts float
- (* (tn-offset bits) sb!vm:word-bytes)
+ (* (tn-offset bits) n-word-bytes)
(current-nfp-tn vop))))))))
(define-vop (double-float-high-bits)
(sc-case float
(double-reg
(inst stt float
- (* (tn-offset stack-temp) sb!vm:word-bytes)
+ (* (tn-offset stack-temp) n-word-bytes)
(current-nfp-tn vop))
(inst ldl hi-bits
- (* (1+ (tn-offset stack-temp)) sb!vm:word-bytes)
+ (* (1+ (tn-offset stack-temp)) n-word-bytes)
(current-nfp-tn vop)))
(double-stack
(inst ldl hi-bits
- (* (1+ (tn-offset float)) sb!vm:word-bytes)
+ (* (1+ (tn-offset float)) n-word-bytes)
(current-nfp-tn vop)))
(descriptor-reg
- (loadw hi-bits float (1+ sb!vm:double-float-value-slot)
- sb!vm:other-pointer-lowtag)))))
+ (loadw hi-bits float (1+ double-float-value-slot)
+ other-pointer-lowtag)))))
(define-vop (double-float-low-bits)
(:args (float :scs (double-reg descriptor-reg)
(sc-case float
(double-reg
(inst stt float
- (* (tn-offset stack-temp) sb!vm:word-bytes)
+ (* (tn-offset stack-temp) n-word-bytes)
(current-nfp-tn vop))
(inst ldl lo-bits
- (* (tn-offset stack-temp) sb!vm:word-bytes)
+ (* (tn-offset stack-temp) n-word-bytes)
(current-nfp-tn vop)))
(double-stack
(inst ldl lo-bits
- (* (tn-offset float) sb!vm:word-bytes)
+ (* (tn-offset float) n-word-bytes)
(current-nfp-tn vop)))
(descriptor-reg
- (loadw lo-bits float sb!vm:double-float-value-slot
- sb!vm:other-pointer-lowtag)))
+ (loadw lo-bits float double-float-value-slot
+ other-pointer-lowtag)))
(inst mskll lo-bits 4 lo-bits)))
\f
(inst excb)
(inst mf_fpcr temp1 temp1 temp1)
(inst excb)
- (inst stt temp1 (* word-bytes (tn-offset temp)) nfp)
- (inst ldl res (* (1+ (tn-offset temp)) sb!vm:word-bytes) nfp)
+ (inst stt temp1 (* n-word-bytes (tn-offset temp)) nfp)
+ (inst ldl res (* (1+ (tn-offset temp)) n-word-bytes) nfp)
(inst srl res 49 res))))
(define-vop (set-floating-point-modes)
(:generator 8
(let ((nfp (current-nfp-tn vop)))
(inst sll new 49 res)
- (inst stl zero-tn (* (tn-offset temp) sb!vm:word-bytes) nfp)
- (inst stl res (* (1+ (tn-offset temp)) sb!vm:word-bytes) nfp)
- (inst ldt temp1 (* (tn-offset temp) sb!vm:word-bytes) nfp)
+ (inst stl zero-tn (* (tn-offset temp) n-word-bytes) nfp)
+ (inst stl res (* (1+ (tn-offset temp)) n-word-bytes) nfp)
+ (inst ldt temp1 (* (tn-offset temp) n-word-bytes) nfp)
(inst excb)
(inst mt_fpcr temp1 temp1 temp1)
(inst excb)
(inst fmove imag r-imag))))
(complex-single-stack
(let ((nfp (current-nfp-tn vop))
- (offset (* (tn-offset r) sb!vm:word-bytes)))
+ (offset (* (tn-offset r) n-word-bytes)))
(inst sts real offset nfp)
- (inst sts imag (+ offset sb!vm:word-bytes) nfp))))))
+ (inst sts imag (+ offset n-word-bytes) nfp))))))
(define-vop (make-complex-double-float)
(:translate complex)
(inst fmove imag r-imag))))
(complex-double-stack
(let ((nfp (current-nfp-tn vop))
- (offset (* (tn-offset r) sb!vm:word-bytes)))
+ (offset (* (tn-offset r) n-word-bytes)))
(inst stt real offset nfp)
- (inst stt imag (+ offset (* 2 sb!vm:word-bytes)) nfp))))))
+ (inst stt imag (+ offset (* 2 n-word-bytes)) nfp))))))
(define-vop (complex-single-float-value)
(:args (x :scs (complex-single-reg) :target r
(inst fmove value-tn r))))
(complex-single-stack
(inst lds r (* (+ (ecase slot (:real 0) (:imag 1)) (tn-offset x))
- sb!vm:word-bytes)
+ n-word-bytes)
(current-nfp-tn vop))))))
(define-vop (realpart/complex-single-float complex-single-float-value)
(inst fmove value-tn r))))
(complex-double-stack
(inst ldt r (* (+ (ecase slot (:real 0) (:imag 2)) (tn-offset x))
- sb!vm:word-bytes)
+ n-word-bytes)
(current-nfp-tn vop))))))
(define-vop (realpart/complex-double-float complex-double-float-value)
"Return to RETURN-PC. LIP is an interior-reg temporary."
`(progn
(inst lda ,lip
- (- (* (1+ ,offset) word-bytes) other-pointer-lowtag)
+ (- (* (1+ ,offset) n-word-bytes) other-pointer-lowtag)
,return-pc)
,@(when frob-code
`((move ,return-pc code-tn)))
(deftype load/store-index (scale lowtag min-offset
&optional (max-offset min-offset))
`(integer ,(- (truncate (+ (ash 1 16)
- (* min-offset word-bytes)
+ (* min-offset n-word-bytes)
(- lowtag))
scale))
,(truncate (- (+ (1- (ash 1 16)) lowtag)
- (* max-offset word-bytes))
+ (* max-offset n-word-bytes))
scale)))
(defmacro define-full-reffer (name type offset lowtag scs el-type
(:result-types ,el-type)
(:generator 5
(inst addq object index lip)
- (inst ldl value (- (* ,offset word-bytes) ,lowtag) lip)
+ (inst ldl value (- (* ,offset n-word-bytes) ,lowtag) lip)
,@(when (equal scs '(unsigned-reg))
'((inst mskll value 4 value)))))
(define-vop (,(symbolicate name "-C"))
(:args (object :scs (descriptor-reg)))
(:info index)
(:arg-types ,type
- (:constant (load/store-index ,word-bytes ,(eval lowtag)
+ (:constant (load/store-index ,n-word-bytes ,(eval lowtag)
,(eval offset))))
(:results (value :scs ,scs))
(:result-types ,el-type)
(:generator 4
- (inst ldl value (- (* (+ ,offset index) word-bytes) ,lowtag)
+ (inst ldl value (- (* (+ ,offset index) n-word-bytes) ,lowtag)
object)
,@(when (equal scs '(unsigned-reg))
'((inst mskll value 4 value)))))))
(:result-types ,el-type)
(:generator 2
(inst addq index object lip)
- (inst stl value (- (* ,offset word-bytes) ,lowtag) lip)
+ (inst stl value (- (* ,offset n-word-bytes) ,lowtag) lip)
(move value result)))
(define-vop (,(symbolicate name "-C"))
,@(when translate
(value :scs ,scs))
(:info index)
(:arg-types ,type
- (:constant (load/store-index ,word-bytes ,(eval lowtag)
+ (:constant (load/store-index ,n-word-bytes ,(eval lowtag)
,(eval offset)))
,el-type)
(:results (result :scs ,scs))
(:result-types ,el-type)
(:generator 1
- (inst stl value (- (* (+ ,offset index) word-bytes) ,lowtag)
+ (inst stl value (- (* (+ ,offset index) n-word-bytes) ,lowtag)
object)
(move value result)))))
,@(ecase size
(:byte
(if signed
- `((inst ldq_u temp (- (* ,offset word-bytes) ,lowtag)
+ `((inst ldq_u temp (- (* ,offset n-word-bytes) ,lowtag)
lip)
- (inst lda temp1 (1+ (- (* ,offset word-bytes) ,lowtag))
+ (inst lda temp1 (1+ (- (* ,offset n-word-bytes) ,lowtag))
lip)
(inst extqh temp temp1 temp)
(inst sra temp 56 value))
- `((inst ldq_u temp (- (* ,offset word-bytes) ,lowtag) lip)
- (inst lda temp1 (- (* ,offset word-bytes) ,lowtag)
+ `((inst ldq_u
+ temp
+ (- (* ,offset n-word-bytes) ,lowtag)
+ lip)
+ (inst lda temp1 (- (* ,offset n-word-bytes) ,lowtag)
lip)
(inst extbl temp temp1 value))))
(:short
(if signed
- `((inst ldq_u temp (- (* ,offset word-bytes) ,lowtag)
+ `((inst ldq_u temp (- (* ,offset n-word-bytes) ,lowtag)
lip)
- (inst lda temp1 (- (* ,offset word-bytes) ,lowtag)
+ (inst lda temp1 (- (* ,offset n-word-bytes) ,lowtag)
lip)
(inst extwl temp temp1 temp)
(inst sll temp 48 temp)
(inst sra temp 48 value))
- `((inst ldq_u temp (- (* ,offset word-bytes) ,lowtag)
+ `((inst ldq_u temp (- (* ,offset n-word-bytes) ,lowtag)
lip)
- (inst lda temp1 (- (* ,offset word-bytes) ,lowtag) lip)
+ (inst lda temp1 (- (* ,offset n-word-bytes) ,lowtag) lip)
(inst extwl temp temp1 value)))))))
(define-vop (,(symbolicate name "-C"))
,@(when translate
,@(ecase size
(:byte
(if signed
- `((inst ldq_u temp (- (+ (* ,offset word-bytes)
+ `((inst ldq_u temp (- (+ (* ,offset n-word-bytes)
(* index ,scale)) ,lowtag)
object)
- (inst lda temp1 (1+ (- (+ (* ,offset word-bytes)
+ (inst lda temp1 (1+ (- (+ (* ,offset n-word-bytes)
(* index ,scale)) ,lowtag))
object)
(inst extqh temp temp1 temp)
(inst sra temp 56 value))
- `((inst ldq_u temp (- (+ (* ,offset word-bytes)
+ `((inst ldq_u temp (- (+ (* ,offset n-word-bytes)
(* index ,scale)) ,lowtag)
object)
- (inst lda temp1 (- (+ (* ,offset word-bytes)
+ (inst lda temp1 (- (+ (* ,offset n-word-bytes)
(* index ,scale)) ,lowtag)
object)
(inst extbl temp temp1 value))))
(:short
(if signed
- `((inst ldq_u temp (- (+ (* ,offset word-bytes)
+ `((inst ldq_u temp (- (+ (* ,offset n-word-bytes)
(* index ,scale)) ,lowtag)
object)
- (inst lda temp1 (- (+ (* ,offset word-bytes)
+ (inst lda temp1 (- (+ (* ,offset n-word-bytes)
(* index ,scale)) ,lowtag)
object)
(inst extwl temp temp1 temp)
(inst sll temp 48 temp)
(inst sra temp 48 value))
- `((inst ldq_u temp (- (+ (* ,offset word-bytes)
+ `((inst ldq_u temp (- (+ (* ,offset n-word-bytes)
(* index ,scale)) ,lowtag)
object)
- (inst lda temp1 (- (+ (* ,offset word-bytes)
+ (inst lda temp1 (- (+ (* ,offset n-word-bytes)
(* index ,scale)) ,lowtag)
object)
(inst extwl temp temp1 value))))))))))
'((inst addq lip index lip)))
,@(ecase size
(:byte
- `((inst lda temp (- (* ,offset word-bytes) ,lowtag) lip)
- (inst ldq_u temp1 (- (* ,offset word-bytes) ,lowtag) lip)
+ `((inst lda temp (- (* ,offset n-word-bytes) ,lowtag) lip)
+ (inst ldq_u temp1 (- (* ,offset n-word-bytes) ,lowtag) lip)
(inst insbl value temp temp2)
(inst mskbl temp1 temp temp1)
(inst bis temp1 temp2 temp1)
- (inst stq_u temp1 (- (* ,offset word-bytes) ,lowtag) lip)))
+ (inst stq_u temp1 (- (* ,offset n-word-bytes) ,lowtag) lip)))
(:short
- `((inst lda temp (- (* ,offset word-bytes) ,lowtag) lip)
- (inst ldq_u temp1 (- (* ,offset word-bytes) ,lowtag) lip)
+ `((inst lda temp (- (* ,offset n-word-bytes) ,lowtag) lip)
+ (inst ldq_u temp1 (- (* ,offset n-word-bytes) ,lowtag) lip)
(inst mskwl temp1 temp temp1)
(inst inswl value temp temp2)
(inst bis temp1 temp2 temp)
- (inst stq_u temp (- (* ,offset word-bytes) ,lowtag) lip))))
+ (inst stq_u temp (- (* ,offset n-word-bytes) ,lowtag) lip))))
(move value result)))
(define-vop (,(symbolicate name "-C"))
,@(when translate
(:generator 5
,@(ecase size
(:byte
- `((inst lda temp (- (* ,offset word-bytes)
+ `((inst lda temp (- (* ,offset n-word-bytes)
(* index ,scale) ,lowtag)
object)
- (inst ldq_u temp1 (- (* ,offset word-bytes)
+ (inst ldq_u temp1 (- (* ,offset n-word-bytes)
(* index ,scale) ,lowtag)
object)
(inst insbl value temp temp2)
(inst mskbl temp1 temp temp1)
(inst bis temp1 temp2 temp1)
- (inst stq_u temp1 (- (* ,offset word-bytes)
+ (inst stq_u temp1 (- (* ,offset n-word-bytes)
(* index ,scale) ,lowtag) object)))
(:short
- `((inst lda temp (- (* ,offset word-bytes)
+ `((inst lda temp (- (* ,offset n-word-bytes)
(* index ,scale) ,lowtag)
object)
- (inst ldq_u temp1 (- (* ,offset word-bytes)
+ (inst ldq_u temp1 (- (* ,offset n-word-bytes)
(* index ,scale) ,lowtag)
object)
(inst mskwl temp1 temp temp1)
(inst inswl value temp temp2)
(inst bis temp1 temp2 temp)
- (inst stq_u temp (- (* ,offset word-bytes)
+ (inst stq_u temp (- (* ,offset n-word-bytes)
(* index ,scale) ,lowtag) object))))
(move value result))))))
(:temporary (:scs (descriptor-reg)) temp)
(:temporary (:scs (non-descriptor-reg)) ndescr)
(:generator 22
- (inst lda block (* (tn-offset tn) sb!vm:word-bytes) cfp-tn)
+ (inst lda block (* (tn-offset tn) sb!vm:n-word-bytes) cfp-tn)
(load-symbol-value temp *current-unwind-protect-block*)
(storew temp block sb!vm:unwind-block-current-uwp-slot)
(storew cfp-tn block sb!vm:unwind-block-current-cont-slot)
(:temporary (:scs (descriptor-reg) :target block :to (:result 0)) result)
(:temporary (:scs (non-descriptor-reg)) ndescr)
(:generator 44
- (inst lda result (* (tn-offset tn) sb!vm:word-bytes) cfp-tn)
+ (inst lda result (* (tn-offset tn) sb!vm:n-word-bytes) cfp-tn)
(load-symbol-value temp *current-unwind-protect-block*)
(storew temp result sb!vm:catch-block-current-uwp-slot)
(storew cfp-tn result sb!vm:catch-block-current-cont-slot)
(:args (tn))
(:temporary (:scs (descriptor-reg)) new-uwp)
(:generator 7
- (inst lda new-uwp (* (tn-offset tn) sb!vm:word-bytes) cfp-tn)
+ (inst lda new-uwp (* (tn-offset tn) sb!vm:n-word-bytes) cfp-tn)
(store-symbol-value new-uwp *current-unwind-protect-block*)))
(define-vop (unlink-catch-block)
;; Copy stuff on stack.
(emit-label loop)
(loadw temp src)
- (inst lda src sb!vm:word-bytes src)
+ (inst lda src sb!vm:n-word-bytes src)
(storew temp dst)
(inst lda num (fixnumize -1) num)
- (inst lda dst sb!vm:word-bytes dst)
+ (inst lda dst sb!vm:n-word-bytes dst)
(inst bne num loop)
(emit-label done)
#!+sb-doc
"Number of bits per word where a word holds one lisp descriptor.")
-(defconstant byte-bits 8
+(defconstant n-byte-bits 8
#!+sb-doc
"Number of bits per byte where a byte is the smallest addressable object.")
-(defconstant word-shift (1- (integer-length (/ n-word-bits byte-bits)))
+(defconstant word-shift (1- (integer-length (/ n-word-bits n-byte-bits)))
#!+sb-doc
"Number of bits to shift between word addresses and byte addresses.")
-(defconstant word-bytes (/ n-word-bits byte-bits)
+(defconstant n-word-bytes (/ n-word-bits n-byte-bits)
#!+sb-doc
"Number of bytes in a word.")
(:single
'((inst lds result offset object)))
(:double
- '((inst ldt result (+ offset word-bytes) object))))))
+ '((inst ldt
+ result
+ (+ offset n-word-bytes)
+ object))))))
(define-vop (,set-name)
(:translate ,set-name)
(:policy :fast-safe)
(:result-types system-area-pointer)
(:generator 2
(inst lda sap
- (- (* vector-data-offset word-bytes) other-pointer-lowtag)
+ (- (* vector-data-offset n-word-bytes) other-pointer-lowtag)
vector)))
(:temporary (:scs (non-descriptor-reg)) count)
(:generator 1
(let ((offset
- (- (* (+ index vector-data-offset) word-bytes) other-pointer-lowtag)))
+ (- (* (+ index vector-data-offset) n-word-bytes)
+ other-pointer-lowtag)))
(inst ldl count offset count-vector)
(inst addq count 1 count)
(inst stl count offset count-vector))))
start-temp)
(:generator 20
(move csp-tn start-temp)
- (inst lda csp-tn (* nvals word-bytes) csp-tn)
+ (inst lda csp-tn (* nvals n-word-bytes) csp-tn)
(do ((val vals (tn-ref-across val))
(i 0 (1+ i)))
((null val))
(inst bne temp done)
(loadw temp list cons-car-slot list-pointer-lowtag)
(loadw list list cons-cdr-slot list-pointer-lowtag)
- (inst lda csp-tn word-bytes csp-tn)
+ (inst lda csp-tn n-word-bytes csp-tn)
(storew temp csp-tn -1)
(inst and list lowtag-mask ndescr)
(inst xor ndescr list-pointer-lowtag ndescr)
(zero
(move context src))
(immediate
- (inst lda src (* (tn-value skip) word-bytes) context))
+ (inst lda src (* (tn-value skip) n-word-bytes) context))
(any-reg
(inst addq context skip src)))
(move num count)
(declaim (type (or null inst-space) *disassem-inst-space*))
;;; minimum alignment of instructions, in bytes
-(defvar *disassem-inst-alignment-bytes* sb!vm:word-bytes)
+(defvar *disassem-inst-alignment-bytes* sb!vm:n-word-bytes)
(declaim (type alignment *disassem-inst-alignment-bytes*))
(defvar *disassem-location-column-width* 8)
(defun bytes-to-bits (bytes)
(declare (type length bytes))
- (* bytes sb!vm:byte-bits))
+ (* bytes sb!vm:n-byte-bits))
(defun bits-to-bytes (bits)
(declare (type length bits))
(multiple-value-bind (bytes rbits)
- (truncate bits sb!vm:byte-bits)
+ (truncate bits sb!vm:n-byte-bits)
(when (not (zerop rbits))
(error "~D bits is not a byte-multiple." bits))
bytes))
(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)
;; 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 maybe-byte-swap (word)
(declare (type (unsigned-byte 32) word))
(aver (= sb!vm:n-word-bits 32))
- (aver (= sb!vm:byte-bits 8))
+ (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:n-word-bits 32))
- (aver (= sb!vm:byte-bits 8))
+ (aver (= sb!vm:n-byte-bits 8))
(if (not *genesis-byte-order-swap-p*)
short
(logior (ash (ldb (byte 8 0) short) 8)
`(progn
(defun ,name (byte-vector byte-index)
(aver (= sb!vm:n-word-bits 32))
- (aver (= sb!vm:byte-bits 8))
+ (aver (= sb!vm:n-byte-bits 8))
(ecase sb!c:*backend-byte-order*
(:little-endian
(logior ,@ash-list))
(error "stub: no big-endian ports of SBCL (yet?)"))))
(defun (setf ,name) (new-value byte-vector byte-index)
(aver (= sb!vm:n-word-bits 32))
- (aver (= sb!vm:byte-bits 8))
+ (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
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
(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
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
"~&/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~%"
(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)))))
(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*)))
;;; (For an explanation of this, see the comments at the definition of
;;; KLUDGE-NONDETERMINISTIC-CATCH-BLOCK-SIZE.)
-(aver (= sb!vm::kludge-nondeterministic-catch-block-size catch-block-size))
+(aver (= kludge-nondeterministic-catch-block-size catch-block-size))
\f
;;;; symbols
(trace-table (pack-trace-table trace-table))
(trace-table-len (length trace-table))
(trace-table-bits (* trace-table-len tt-bits-per-entry))
- (total-length (+ length (ceiling trace-table-bits sb!vm:byte-bits)))
+ (total-length (+ length
+ (ceiling trace-table-bits sb!vm:n-byte-bits)))
(box-num (- (length constants) sb!vm:code-trace-table-offset-slot))
(code-obj
;; FIXME: In CMU CL the X86 behavior here depended on
(pad-data-block (1- symbol-size))
(- list-pointer-lowtag)
(* static-function-index (pad-data-block fdefn-size))
- (* fdefn-raw-addr-slot word-bytes))))
+ (* fdefn-raw-addr-slot n-word-bytes))))
(declare (optimize (safety 0)))
(bit-bash-copy string2
(the index
- (+ (the index (* start2 sb!vm:byte-bits))
+ (+ (the index (* start2 sb!vm:n-byte-bits))
,vector-data-bit-offset))
string1
(the index
- (+ (the index (* start1 sb!vm:byte-bits))
+ (+ (the index (* start1 sb!vm:n-byte-bits))
,vector-data-bit-offset))
(the index
(* (min (the index (- (or end1 (length string1))
start1))
(the index (- (or end2 (length string2))
start2)))
- sb!vm:byte-bits)))
+ sb!vm:n-byte-bits)))
string1))
;;; FIXME: It seems as though it should be possible to make a DEFUN
(let ((n-seq (gensym))
(n-length (gensym)))
(args n-seq)
- (lets `(,n-length (the index (* (length ,n-seq) sb!vm:byte-bits))))
+ (lets `(,n-length (the index (* (length ,n-seq) sb!vm:n-byte-bits))))
(all-lengths n-length)
(forms `(bit-bash-copy ,n-seq ,vector-data-bit-offset
res start
(declare (ignore rtype))
(let* (,@(lets)
(res (make-string (truncate (the index (+ ,@(all-lengths)))
- sb!vm:byte-bits)))
+ sb!vm:n-byte-bits)))
(start ,vector-data-bit-offset))
(declare (type index start ,@(all-lengths)))
,@(forms)
(defstruct (disassem-state (:conc-name dstate-)
(:constructor %make-dstate)
(:copier nil))
- (cur-offs 0 :type offset) ; offset of current pos in segment
- (next-offs 0 :type offset) ; offset of next position
-
+ ;; offset of current pos in segment
+ (cur-offs 0 :type offset)
+ ;; offset of next position
+ (next-offs 0 :type offset)
+ ;; a sap pointing to our segment
(segment-sap (required-argument) :type sb!sys:system-area-pointer)
- ; a sap pointing to our segment
- (segment nil :type (or null segment)) ; the current segment
-
- (alignment sb!vm:word-bytes :type alignment) ; what to align to in most cases
+ ;; the current segment
+ (segment nil :type (or null segment))
+ ;; what to align to in most cases
+ (alignment sb!vm:n-word-bytes :type alignment)
(byte-order :little-endian
:type (member :big-endian :little-endian))
-
- (properties nil :type list) ; for user code to hang stuff off of
+ ;; for user code to hang stuff off of
+ (properties nil :type list)
(filtered-values (make-array max-filtered-value-index)
:type filtered-value-vector)
-
- (addr-print-len nil :type ; used for prettifying printing
- (or null (integer 0 20)))
+ ;; used for prettifying printing
+ (addr-print-len nil :type (or null (integer 0 20)))
(argument-column 0 :type column)
- (output-state :beginning ; to make output look nicer
+ ;; to make output look nicer
+ (output-state :beginning
:type (member :beginning
:block-boundary
nil))
- (labels nil :type list) ; alist of (address . label-number)
- (label-hash (make-hash-table) ; same thing in a different form
- :type hash-table)
-
- (fun-hooks nil :type list) ; list of function
+ ;; alist of (address . label-number)
+ (labels nil :type list)
+ ;; same as LABELS slot data, but in a different form
+ (label-hash (make-hash-table) :type hash-table)
+ ;; list of function
+ (fun-hooks nil :type list)
- ;; these next two are popped as they are used
- (cur-labels nil :type list) ; alist of (address . label-number)
- (cur-offs-hooks nil :type list) ; list of offs-hook
+ ;; alist of (address . label-number), popped as it's used
+ (cur-labels nil :type list) ;
+ ;; list of offs-hook, popped as it's used
+ (cur-offs-hooks nil :type list)
- (notes nil :type list) ; for the current location
+ ;; for the current location
+ (notes nil :type list)
- (current-valid-locations nil ; currently active source variables
- :type (or null (vector bit))))
+ ;; currently active source variables
+ (current-valid-locations nil :type (or null (vector bit))))
(def!method print-object ((dstate disassem-state) stream)
(print-unreadable-object (dstate stream :type t)
(format stream
(type disassem-state dstate))
(when (and (aligned-p (+ (seg-virtual-location (dstate-segment dstate))
(dstate-cur-offs dstate))
- (* 2 sb!vm:word-bytes))
+ (* 2 sb!vm:n-word-bytes))
;; Check type.
(= (sb!sys:sap-ref-8 (dstate-segment-sap dstate)
(if (eq (dstate-byte-order dstate)
(let ((alignment (dstate-alignment dstate)))
(unless (null stream)
(multiple-value-bind (words bytes)
- (truncate alignment sb!vm:word-bytes)
+ (truncate alignment sb!vm:n-word-bytes)
(when (> words 0)
(print-words words stream dstate))
(when (> bytes 0)
(unless (zerop word-offs)
(write-string ", " stream))
(let ((word 0) (bit-shift 0))
- (dotimes (byte-offs sb!vm:word-bytes)
+ (dotimes (byte-offs sb!vm:n-word-bytes)
(let ((byte
(sb!sys:sap-ref-8
sap
(+ start-offs
- (* word-offs sb!vm:word-bytes)
+ (* word-offs sb!vm:n-word-bytes)
byte-offs))))
(setf word
(if (eq byte-order :big-endian)
- (+ (ash word sb!vm:byte-bits) byte)
+ (+ (ash word sb!vm:n-byte-bits) byte)
(+ word (ash byte bit-shift))))
- (incf bit-shift sb!vm:byte-bits)))
+ (incf bit-shift sb!vm:n-byte-bits)))
(format stream "#X~V,'0X" (ash sb!vm:n-word-bits -2) word)))))
\f
(defvar *default-dstate-hooks* (list #'lra-hook))
;;; access function of the slot.
(defun grok-symbol-slot-ref (address)
(declare (type address address))
- (if (not (aligned-p address sb!vm:word-bytes))
+ (if (not (aligned-p address sb!vm:n-word-bytes))
(values nil nil)
(do ((slots-tail *grokked-symbol-slots* (cdr slots-tail)))
((null slots-tail)
(let ((length (length vec)))
(dump-fop 'fop-single-float-vector file)
(dump-unsigned-32 length file)
- (dump-raw-bytes vec (* length sb!vm:word-bytes) file)))
+ (dump-raw-bytes vec (* length sb!vm:n-word-bytes) file)))
(defun dump-double-float-vector (vec file)
(let ((length (length vec)))
(dump-fop 'fop-double-float-vector file)
(dump-unsigned-32 length file)
- (dump-raw-bytes vec (* length sb!vm:word-bytes 2) file)))
+ (dump-raw-bytes vec (* length sb!vm:n-word-bytes 2) file)))
#!+long-float
(defun dump-long-float-vector (vec file)
(let ((length (length vec)))
(dump-fop 'fop-long-float-vector file)
(dump-unsigned-32 length file)
- (dump-raw-bytes vec (* length sb!vm:word-bytes #!+x86 3 #!+sparc 4) file)))
+ (dump-raw-bytes vec
+ (* length sb!vm:n-word-bytes #!+x86 3 #!+sparc 4)
+ file)))
(defun dump-complex-single-float-vector (vec file)
(let ((length (length vec)))
(dump-fop 'fop-complex-single-float-vector file)
(dump-unsigned-32 length file)
- (dump-raw-bytes vec (* length sb!vm:word-bytes 2) file)))
+ (dump-raw-bytes vec (* length sb!vm:n-word-bytes 2) file)))
(defun dump-complex-double-float-vector (vec file)
(let ((length (length vec)))
(dump-fop 'fop-complex-double-float-vector file)
(dump-unsigned-32 length file)
- (dump-raw-bytes vec (* length sb!vm:word-bytes 2 2) file)))
+ (dump-raw-bytes vec (* length sb!vm:n-word-bytes 2 2) file)))
#!+long-float
(defun dump-complex-long-float-vector (vec file)
(let ((length (length vec)))
(dump-fop 'fop-complex-long-float-vector file)
(dump-unsigned-32 length file)
- (dump-raw-bytes vec (* length sb!vm:word-bytes #!+x86 3 #!+sparc 4 2) file)))
+ (dump-raw-bytes vec
+ (* length sb!vm:n-word-bytes #!+x86 3 #!+sparc 4 2)
+ file)))
#!+(and long-float x86)
(defun dump-long-float (float file)
(defconstant tt-bits-per-state 3)
(defconstant tt-bytes-per-entry 2)
-(defconstant tt-bits-per-entry (* tt-bytes-per-entry sb!vm:byte-bits))
+(defconstant tt-bits-per-entry (* tt-bytes-per-entry sb!vm:n-byte-bits))
(defconstant tt-bits-per-offset (- tt-bits-per-entry tt-bits-per-state))
(defconstant tt-max-offset (1- (ash 1 tt-bits-per-offset)))
(move result (tn-ref-tn things)))
(t
(macrolet
- ((store-car (tn list &optional (slot sb!vm:cons-car-slot))
+ ((store-car (tn list &optional (slot cons-car-slot))
`(let ((reg
(sc-case ,tn
((any-reg descriptor-reg) ,tn)
((control-stack)
(move temp ,tn)
temp))))
- (storew reg ,list ,slot sb!vm:list-pointer-lowtag))))
+ (storew reg ,list ,slot list-pointer-lowtag))))
(let ((cons-cells (if star (1- num) num)))
(pseudo-atomic
(allocation res (* (pad-data-block cons-size) cons-cells) node)
;; -- WHN 19990916
;;
;; FIXME: should have a check for overflow of static space
- (load-symbol-value temp sb!vm:*static-space-free-pointer*)
+ (load-symbol-value temp *static-space-free-pointer*)
(inst lea result (make-ea :byte :base temp :disp other-pointer-lowtag))
(inst add temp boxed)
(inst add temp unboxed)
- (store-symbol-value temp sb!vm:*static-space-free-pointer*)
+ (store-symbol-value temp *static-space-free-pointer*)
(inst shl boxed (- n-widetag-bits word-shift))
(inst or boxed code-header-widetag)
(storew boxed result 0 other-pointer-lowtag)
(:node-var node)
(:generator 50
(inst lea bytes
- (make-ea :dword :base extra :disp (* (1+ words) word-bytes)))
+ (make-ea :dword :base extra :disp (* (1+ words) n-word-bytes)))
(inst mov header bytes)
(inst shl header (- n-widetag-bits 2)) ; w+1 to length field
(inst lea header ; (w-1 << 8) | type
(:result-types unsigned-num)
(:generator 50
(inst mov k (make-ea :dword :base state
- :disp (- (* (+ 2 sb!vm:vector-data-offset)
- sb!vm:word-bytes)
- sb!vm:other-pointer-lowtag)))
+ :disp (- (* (+ 2 vector-data-offset)
+ n-word-bytes)
+ other-pointer-lowtag)))
(inst cmp k 624)
(inst jmp :ne no-update)
(inst mov tmp state) ; The state is passed in EAX.
NO-UPDATE
;; y = ptgfsr[k++];
(inst mov y (make-ea :dword :base state :index k :scale 4
- :disp (- (* (+ 3 sb!vm:vector-data-offset)
- sb!vm:word-bytes)
- sb!vm:other-pointer-lowtag)))
+ :disp (- (* (+ 3 vector-data-offset)
+ n-word-bytes)
+ other-pointer-lowtag)))
;; y ^= (y >> 11);
(inst shr y 11)
(inst xor y (make-ea :dword :base state :index k :scale 4
- :disp (- (* (+ 3 sb!vm:vector-data-offset)
- sb!vm:word-bytes)
- sb!vm:other-pointer-lowtag)))
+ :disp (- (* (+ 3 vector-data-offset)
+ n-word-bytes)
+ other-pointer-lowtag)))
;; y ^= (y << 7) & #x9d2c5680
(inst mov tmp y)
(inst inc k)
(inst shl tmp 7)
(inst mov (make-ea :dword :base state
- :disp (- (* (+ 2 sb!vm:vector-data-offset)
- sb!vm:word-bytes)
- sb!vm:other-pointer-lowtag))
+ :disp (- (* (+ 2 vector-data-offset)
+ n-word-bytes)
+ other-pointer-lowtag))
k)
(inst and tmp #x9d2c5680)
(inst xor y tmp)
(:generator 13
(inst lea bytes
(make-ea :dword :base rank
- :disp (+ (* (1+ array-dimensions-offset) word-bytes)
+ :disp (+ (* (1+ array-dimensions-offset) n-word-bytes)
lowtag-mask)))
(inst and bytes (lognot lowtag-mask))
(inst lea header (make-ea :dword :base rank
(inst shr ecx ,bit-shift)
(inst mov result
(make-ea :dword :base object :index ecx :scale 4
- :disp (- (* vector-data-offset word-bytes)
+ :disp (- (* vector-data-offset n-word-bytes)
other-pointer-lowtag)))
(move ecx index)
(inst and ecx ,(1- elements-per-word))
(inst shr word-index ,bit-shift)
(inst lea ptr
(make-ea :dword :base object :index word-index :scale 4
- :disp (- (* vector-data-offset word-bytes)
+ :disp (- (* vector-data-offset n-word-bytes)
other-pointer-lowtag)))
(loadw old ptr)
(move ecx index)
(multiple-value-bind (word extra) (floor index ,elements-per-word)
(inst mov old
(make-ea :dword :base object
- :disp (- (* (+ word vector-data-offset) word-bytes)
+ :disp (- (* (+ word vector-data-offset)
+ n-word-bytes)
other-pointer-lowtag)))
(sc-case value
(immediate
(inst rol old shift)))))
(inst mov (make-ea :dword :base object
:disp (- (* (+ word vector-data-offset)
- word-bytes)
+ n-word-bytes)
other-pointer-lowtag))
old)
(sc-case value
(:generator 5
(with-empty-tn@fp-top(value)
(inst fld (make-ea :dword :base object :index index :scale 1
- :disp (- (* sb!vm:vector-data-offset sb!vm:word-bytes)
+ :disp (- (* sb!vm:vector-data-offset
+ sb!vm:n-word-bytes)
sb!vm:other-pointer-lowtag))))))
(define-vop (data-vector-ref-c/simple-array-single-float)
(with-empty-tn@fp-top(value)
(inst fld (make-ea :dword :base object
:disp (- (+ (* sb!vm:vector-data-offset
- sb!vm:word-bytes)
+ sb!vm:n-word-bytes)
(* 4 index))
sb!vm:other-pointer-lowtag))))))
;; Value is in ST0.
(inst fst (make-ea :dword :base object :index index :scale 1
:disp (- (* sb!vm:vector-data-offset
- sb!vm:word-bytes)
+ sb!vm:n-word-bytes)
sb!vm:other-pointer-lowtag)))
(unless (zerop (tn-offset result))
;; Value is in ST0 but not result.
(inst fxch value)
(inst fst (make-ea :dword :base object :index index :scale 1
:disp (- (* sb!vm:vector-data-offset
- sb!vm:word-bytes)
+ sb!vm:n-word-bytes)
sb!vm:other-pointer-lowtag)))
(cond ((zerop (tn-offset result))
;; The result is in ST0.
;; Value is in ST0.
(inst fst (make-ea :dword :base object
:disp (- (+ (* sb!vm:vector-data-offset
- sb!vm:word-bytes)
+ sb!vm:n-word-bytes)
(* 4 index))
sb!vm:other-pointer-lowtag)))
(unless (zerop (tn-offset result))
(inst fxch value)
(inst fst (make-ea :dword :base object
:disp (- (+ (* sb!vm:vector-data-offset
- sb!vm:word-bytes)
+ sb!vm:n-word-bytes)
(* 4 index))
sb!vm:other-pointer-lowtag)))
(cond ((zerop (tn-offset result))
(:generator 7
(with-empty-tn@fp-top(value)
(inst fldd (make-ea :dword :base object :index index :scale 2
- :disp (- (* sb!vm:vector-data-offset sb!vm:word-bytes)
+ :disp (- (* sb!vm:vector-data-offset
+ sb!vm:n-word-bytes)
sb!vm:other-pointer-lowtag))))))
(define-vop (data-vector-ref-c/simple-array-double-float)
(with-empty-tn@fp-top(value)
(inst fldd (make-ea :dword :base object
:disp (- (+ (* sb!vm:vector-data-offset
- sb!vm:word-bytes)
+ sb!vm:n-word-bytes)
(* 8 index))
sb!vm:other-pointer-lowtag))))))
;; Value is in ST0.
(inst fstd (make-ea :dword :base object :index index :scale 2
:disp (- (* sb!vm:vector-data-offset
- sb!vm:word-bytes)
+ sb!vm:n-word-bytes)
sb!vm:other-pointer-lowtag)))
(unless (zerop (tn-offset result))
;; Value is in ST0 but not result.
(inst fxch value)
(inst fstd (make-ea :dword :base object :index index :scale 2
:disp (- (* sb!vm:vector-data-offset
- sb!vm:word-bytes)
+ sb!vm:n-word-bytes)
sb!vm:other-pointer-lowtag)))
(cond ((zerop (tn-offset result))
;; The result is in ST0.
;; Value is in ST0.
(inst fstd (make-ea :dword :base object
:disp (- (+ (* sb!vm:vector-data-offset
- sb!vm:word-bytes)
+ sb!vm:n-word-bytes)
(* 8 index))
sb!vm:other-pointer-lowtag)))
(unless (zerop (tn-offset result))
(inst fxch value)
(inst fstd (make-ea :dword :base object
:disp (- (+ (* sb!vm:vector-data-offset
- sb!vm:word-bytes)
+ sb!vm:n-word-bytes)
(* 8 index))
sb!vm:other-pointer-lowtag)))
(cond ((zerop (tn-offset result))
(with-empty-tn@fp-top(value)
(inst fldl (make-ea :dword :base object :index temp :scale 1
:disp (- (* sb!vm:vector-data-offset
- sb!vm:word-bytes)
+ sb!vm:n-word-bytes)
sb!vm:other-pointer-lowtag))))))
#!+long-float
(with-empty-tn@fp-top(value)
(inst fldl (make-ea :dword :base object
:disp (- (+ (* sb!vm:vector-data-offset
- sb!vm:word-bytes)
+ sb!vm:n-word-bytes)
(* 12 index))
sb!vm:other-pointer-lowtag))))))
;; Value is in ST0.
(store-long-float
(make-ea :dword :base object :index temp :scale 1
- :disp (- (* sb!vm:vector-data-offset sb!vm:word-bytes)
+ :disp (- (* sb!vm:vector-data-offset sb!vm:n-word-bytes)
sb!vm:other-pointer-lowtag)))
(unless (zerop (tn-offset result))
;; Value is in ST0 but not result.
(inst fxch value)
(store-long-float
(make-ea :dword :base object :index temp :scale 1
- :disp (- (* sb!vm:vector-data-offset sb!vm:word-bytes)
+ :disp (- (* sb!vm:vector-data-offset sb!vm:n-word-bytes)
sb!vm:other-pointer-lowtag)))
(cond ((zerop (tn-offset result))
;; The result is in ST0.
;; Value is in ST0.
(store-long-float (make-ea :dword :base object
:disp (- (+ (* sb!vm:vector-data-offset
- sb!vm:word-bytes)
+ sb!vm:n-word-bytes)
(* 12 index))
sb!vm:other-pointer-lowtag)))
(unless (zerop (tn-offset result))
(inst fxch value)
(store-long-float (make-ea :dword :base object
:disp (- (+ (* sb!vm:vector-data-offset
- sb!vm:word-bytes)
+ sb!vm:n-word-bytes)
(* 12 index))
sb!vm:other-pointer-lowtag)))
(cond ((zerop (tn-offset result))
(with-empty-tn@fp-top (real-tn)
(inst fld (make-ea :dword :base object :index index :scale 2
:disp (- (* sb!vm:vector-data-offset
- sb!vm:word-bytes)
+ sb!vm:n-word-bytes)
sb!vm:other-pointer-lowtag)))))
(let ((imag-tn (complex-single-reg-imag-tn value)))
(with-empty-tn@fp-top (imag-tn)
(inst fld (make-ea :dword :base object :index index :scale 2
:disp (- (* (1+ sb!vm:vector-data-offset)
- sb!vm:word-bytes)
+ sb!vm:n-word-bytes)
sb!vm:other-pointer-lowtag)))))))
(define-vop (data-vector-ref-c/simple-array-complex-single-float)
(with-empty-tn@fp-top (real-tn)
(inst fld (make-ea :dword :base object
:disp (- (+ (* sb!vm:vector-data-offset
- sb!vm:word-bytes)
+ sb!vm:n-word-bytes)
(* 8 index))
sb!vm:other-pointer-lowtag)))))
(let ((imag-tn (complex-single-reg-imag-tn value)))
(with-empty-tn@fp-top (imag-tn)
(inst fld (make-ea :dword :base object
:disp (- (+ (* sb!vm:vector-data-offset
- sb!vm:word-bytes)
+ sb!vm:n-word-bytes)
(* 8 index) 4)
sb!vm:other-pointer-lowtag)))))))
;; Value is in ST0.
(inst fst (make-ea :dword :base object :index index :scale 2
:disp (- (* sb!vm:vector-data-offset
- sb!vm:word-bytes)
+ sb!vm:n-word-bytes)
sb!vm:other-pointer-lowtag)))
(unless (zerop (tn-offset result-real))
;; Value is in ST0 but not result.
(inst fxch value-real)
(inst fst (make-ea :dword :base object :index index :scale 2
:disp (- (* sb!vm:vector-data-offset
- sb!vm:word-bytes)
+ sb!vm:n-word-bytes)
sb!vm:other-pointer-lowtag)))
(cond ((zerop (tn-offset result-real))
;; The result is in ST0.
(inst fxch value-imag)
(inst fst (make-ea :dword :base object :index index :scale 2
:disp (- (+ (* sb!vm:vector-data-offset
- sb!vm:word-bytes)
+ sb!vm:n-word-bytes)
4)
sb!vm:other-pointer-lowtag)))
(unless (location= value-imag result-imag)
;; Value is in ST0.
(inst fst (make-ea :dword :base object
:disp (- (+ (* sb!vm:vector-data-offset
- sb!vm:word-bytes)
+ sb!vm:n-word-bytes)
(* 8 index))
sb!vm:other-pointer-lowtag)))
(unless (zerop (tn-offset result-real))
(inst fxch value-real)
(inst fst (make-ea :dword :base object
:disp (- (+ (* sb!vm:vector-data-offset
- sb!vm:word-bytes)
+ sb!vm:n-word-bytes)
(* 8 index))
sb!vm:other-pointer-lowtag)))
(cond ((zerop (tn-offset result-real))
(inst fxch value-imag)
(inst fst (make-ea :dword :base object
:disp (- (+ (* sb!vm:vector-data-offset
- sb!vm:word-bytes)
+ sb!vm:n-word-bytes)
(* 8 index) 4)
sb!vm:other-pointer-lowtag)))
(unless (location= value-imag result-imag)
(with-empty-tn@fp-top (real-tn)
(inst fldd (make-ea :dword :base object :index index :scale 4
:disp (- (* sb!vm:vector-data-offset
- sb!vm:word-bytes)
+ sb!vm:n-word-bytes)
sb!vm:other-pointer-lowtag)))))
(let ((imag-tn (complex-double-reg-imag-tn value)))
(with-empty-tn@fp-top (imag-tn)
(inst fldd (make-ea :dword :base object :index index :scale 4
:disp (- (+ (* sb!vm:vector-data-offset
- sb!vm:word-bytes)
+ sb!vm:n-word-bytes)
8)
sb!vm:other-pointer-lowtag)))))))
(with-empty-tn@fp-top (real-tn)
(inst fldd (make-ea :dword :base object
:disp (- (+ (* sb!vm:vector-data-offset
- sb!vm:word-bytes)
+ sb!vm:n-word-bytes)
(* 16 index))
sb!vm:other-pointer-lowtag)))))
(let ((imag-tn (complex-double-reg-imag-tn value)))
(with-empty-tn@fp-top (imag-tn)
(inst fldd (make-ea :dword :base object
:disp (- (+ (* sb!vm:vector-data-offset
- sb!vm:word-bytes)
+ sb!vm:n-word-bytes)
(* 16 index) 8)
sb!vm:other-pointer-lowtag)))))))
;; Value is in ST0.
(inst fstd (make-ea :dword :base object :index index :scale 4
:disp (- (* sb!vm:vector-data-offset
- sb!vm:word-bytes)
+ sb!vm:n-word-bytes)
sb!vm:other-pointer-lowtag)))
(unless (zerop (tn-offset result-real))
;; Value is in ST0 but not result.
(inst fxch value-real)
(inst fstd (make-ea :dword :base object :index index :scale 4
:disp (- (* sb!vm:vector-data-offset
- sb!vm:word-bytes)
+ sb!vm:n-word-bytes)
sb!vm:other-pointer-lowtag)))
(cond ((zerop (tn-offset result-real))
;; The result is in ST0.
(inst fxch value-imag)
(inst fstd (make-ea :dword :base object :index index :scale 4
:disp (- (+ (* sb!vm:vector-data-offset
- sb!vm:word-bytes)
+ sb!vm:n-word-bytes)
8)
sb!vm:other-pointer-lowtag)))
(unless (location= value-imag result-imag)
;; Value is in ST0.
(inst fstd (make-ea :dword :base object
:disp (- (+ (* sb!vm:vector-data-offset
- sb!vm:word-bytes)
+ sb!vm:n-word-bytes)
(* 16 index))
sb!vm:other-pointer-lowtag)))
(unless (zerop (tn-offset result-real))
(inst fxch value-real)
(inst fstd (make-ea :dword :base object
:disp (- (+ (* sb!vm:vector-data-offset
- sb!vm:word-bytes)
+ sb!vm:n-word-bytes)
(* 16 index))
sb!vm:other-pointer-lowtag)))
(cond ((zerop (tn-offset result-real))
(inst fxch value-imag)
(inst fstd (make-ea :dword :base object
:disp (- (+ (* sb!vm:vector-data-offset
- sb!vm:word-bytes)
+ sb!vm:n-word-bytes)
(* 16 index) 8)
sb!vm:other-pointer-lowtag)))
(unless (location= value-imag result-imag)
(with-empty-tn@fp-top (real-tn)
(inst fldl (make-ea :dword :base object :index temp :scale 2
:disp (- (* sb!vm:vector-data-offset
- sb!vm:word-bytes)
+ sb!vm:n-word-bytes)
sb!vm:other-pointer-lowtag)))))
(let ((imag-tn (complex-long-reg-imag-tn value)))
(with-empty-tn@fp-top (imag-tn)
(inst fldl (make-ea :dword :base object :index temp :scale 2
:disp (- (+ (* sb!vm:vector-data-offset
- sb!vm:word-bytes)
+ sb!vm:n-word-bytes)
12)
sb!vm:other-pointer-lowtag)))))))
(with-empty-tn@fp-top (real-tn)
(inst fldl (make-ea :dword :base object
:disp (- (+ (* sb!vm:vector-data-offset
- sb!vm:word-bytes)
+ sb!vm:n-word-bytes)
(* 24 index))
sb!vm:other-pointer-lowtag)))))
(let ((imag-tn (complex-long-reg-imag-tn value)))
(with-empty-tn@fp-top (imag-tn)
(inst fldl (make-ea :dword :base object
:disp (- (+ (* sb!vm:vector-data-offset
- sb!vm:word-bytes)
+ sb!vm:n-word-bytes)
(* 24 index) 12)
sb!vm:other-pointer-lowtag)))))))
;; Value is in ST0.
(store-long-float
(make-ea :dword :base object :index temp :scale 2
- :disp (- (* sb!vm:vector-data-offset sb!vm:word-bytes)
+ :disp (- (* sb!vm:vector-data-offset sb!vm:n-word-bytes)
sb!vm:other-pointer-lowtag)))
(unless (zerop (tn-offset result-real))
;; Value is in ST0 but not result.
(inst fxch value-real)
(store-long-float
(make-ea :dword :base object :index temp :scale 2
- :disp (- (* sb!vm:vector-data-offset sb!vm:word-bytes)
+ :disp (- (* sb!vm:vector-data-offset sb!vm:n-word-bytes)
sb!vm:other-pointer-lowtag)))
(cond ((zerop (tn-offset result-real))
;; The result is in ST0.
(inst fxch value-imag)
(store-long-float
(make-ea :dword :base object :index temp :scale 2
- :disp (- (+ (* sb!vm:vector-data-offset sb!vm:word-bytes) 12)
+ :disp (- (+ (* sb!vm:vector-data-offset sb!vm:n-word-bytes) 12)
sb!vm:other-pointer-lowtag)))
(unless (location= value-imag result-imag)
(inst fstd result-imag))
(store-long-float
(make-ea :dword :base object
:disp (- (+ (* sb!vm:vector-data-offset
- sb!vm:word-bytes)
+ sb!vm:n-word-bytes)
(* 24 index))
sb!vm:other-pointer-lowtag)))
(unless (zerop (tn-offset result-real))
(store-long-float
(make-ea :dword :base object
:disp (- (+ (* sb!vm:vector-data-offset
- sb!vm:word-bytes)
+ sb!vm:n-word-bytes)
(* 24 index))
sb!vm:other-pointer-lowtag)))
(cond ((zerop (tn-offset result-real))
(store-long-float
(make-ea :dword :base object
:disp (- (+ (* sb!vm:vector-data-offset
- sb!vm:word-bytes)
+ sb!vm:n-word-bytes)
;; FIXME: There are so many of these bare constants
;; (24, 12..) in the LONG-FLOAT code that it's
;; ridiculous. I should probably just delete it all
(:generator 5
(inst movzx value
(make-ea :byte :base object :index index :scale 1
- :disp (- (* vector-data-offset word-bytes)
+ :disp (- (* vector-data-offset n-word-bytes)
other-pointer-lowtag)))))
(define-vop (data-vector-ref-c/simple-array-unsigned-byte-8)
(:generator 4
(inst movzx value
(make-ea :byte :base object
- :disp (- (+ (* vector-data-offset word-bytes) index)
+ :disp (- (+ (* vector-data-offset n-word-bytes) index)
other-pointer-lowtag)))))
(define-vop (data-vector-set/simple-array-unsigned-byte-8)
(:generator 5
(move eax value)
(inst mov (make-ea :byte :base object :index index :scale 1
- :disp (- (* vector-data-offset word-bytes)
+ :disp (- (* vector-data-offset n-word-bytes)
other-pointer-lowtag))
al-tn)
(move result eax)))
(:generator 4
(move eax value)
(inst mov (make-ea :byte :base object
- :disp (- (+ (* vector-data-offset word-bytes) index)
+ :disp (- (+ (* vector-data-offset n-word-bytes) index)
other-pointer-lowtag))
al-tn)
(move result eax)))
(:generator 5
(inst movzx value
(make-ea :word :base object :index index :scale 2
- :disp (- (* vector-data-offset word-bytes)
+ :disp (- (* vector-data-offset n-word-bytes)
other-pointer-lowtag)))))
(define-vop (data-vector-ref-c/simple-array-unsigned-byte-16)
(:generator 4
(inst movzx value
(make-ea :word :base object
- :disp (- (+ (* vector-data-offset word-bytes) (* 2 index))
+ :disp (- (+ (* vector-data-offset n-word-bytes) (* 2 index))
other-pointer-lowtag)))))
(define-vop (data-vector-set/simple-array-unsigned-byte-16)
(:generator 5
(move eax value)
(inst mov (make-ea :word :base object :index index :scale 2
- :disp (- (* vector-data-offset word-bytes)
+ :disp (- (* vector-data-offset n-word-bytes)
other-pointer-lowtag))
ax-tn)
(move result eax)))
(:generator 4
(move eax value)
(inst mov (make-ea :word :base object
- :disp (- (+ (* vector-data-offset word-bytes)
+ :disp (- (+ (* vector-data-offset n-word-bytes)
(* 2 index))
other-pointer-lowtag))
ax-tn)
(:generator 5
(inst mov al-tn
(make-ea :byte :base object :index index :scale 1
- :disp (- (* vector-data-offset word-bytes)
+ :disp (- (* vector-data-offset n-word-bytes)
other-pointer-lowtag)))
(move value al-tn)))
(:generator 4
(inst mov al-tn
(make-ea :byte :base object
- :disp (- (+ (* vector-data-offset word-bytes) index)
+ :disp (- (+ (* vector-data-offset n-word-bytes) index)
other-pointer-lowtag)))
(move value al-tn)))
(:result-types base-char)
(:generator 5
(inst mov (make-ea :byte :base object :index index :scale 1
- :disp (- (* vector-data-offset word-bytes)
+ :disp (- (* vector-data-offset n-word-bytes)
other-pointer-lowtag))
value)
(move result value)))
(:result-types base-char)
(:generator 4
(inst mov (make-ea :byte :base object
- :disp (- (+ (* vector-data-offset word-bytes) index)
+ :disp (- (+ (* vector-data-offset n-word-bytes) index)
other-pointer-lowtag))
value)
(move result value)))
(:generator 5
(inst movsx value
(make-ea :byte :base object :index index :scale 1
- :disp (- (* vector-data-offset word-bytes)
+ :disp (- (* vector-data-offset n-word-bytes)
other-pointer-lowtag)))))
(define-vop (data-vector-ref-c/simple-array-signed-byte-8)
(:generator 4
(inst movsx value
(make-ea :byte :base object
- :disp (- (+ (* vector-data-offset word-bytes) index)
+ :disp (- (+ (* vector-data-offset n-word-bytes) index)
other-pointer-lowtag)))))
(define-vop (data-vector-set/simple-array-signed-byte-8)
(:generator 5
(move eax value)
(inst mov (make-ea :byte :base object :index index :scale 1
- :disp (- (* vector-data-offset word-bytes)
+ :disp (- (* vector-data-offset n-word-bytes)
other-pointer-lowtag))
al-tn)
(move result eax)))
(:generator 4
(move eax value)
(inst mov (make-ea :byte :base object
- :disp (- (+ (* vector-data-offset word-bytes) index)
+ :disp (- (+ (* vector-data-offset n-word-bytes) index)
other-pointer-lowtag))
al-tn)
(move result eax)))
(:generator 5
(inst movsx value
(make-ea :word :base object :index index :scale 2
- :disp (- (* vector-data-offset word-bytes)
+ :disp (- (* vector-data-offset n-word-bytes)
other-pointer-lowtag)))))
(define-vop (data-vector-ref-c/simple-array-signed-byte-16)
(:generator 4
(inst movsx value
(make-ea :word :base object
- :disp (- (+ (* vector-data-offset word-bytes)
+ :disp (- (+ (* vector-data-offset n-word-bytes)
(* 2 index))
other-pointer-lowtag)))))
(:generator 5
(move eax value)
(inst mov (make-ea :word :base object :index index :scale 2
- :disp (- (* vector-data-offset word-bytes)
+ :disp (- (* vector-data-offset n-word-bytes)
other-pointer-lowtag))
ax-tn)
(move result eax)))
(move eax value)
(inst mov
(make-ea :word :base object
- :disp (- (+ (* vector-data-offset word-bytes)
+ :disp (- (+ (* vector-data-offset n-word-bytes)
(* 2 index))
other-pointer-lowtag))
ax-tn)
(arg-type (alien-fun-type-arg-types type))
(arg-tns (invoke-alien-type-method :arg-tn arg-type arg-state)))
(values (my-make-wired-tn 'positive-fixnum 'any-reg esp-offset)
- (* (arg-state-stack-frame-size arg-state) word-bytes)
+ (* (arg-state-stack-frame-size arg-state) n-word-bytes)
(arg-tns)
(invoke-alien-type-method :result-tn
(alien-fun-type-result-type type)
(emit-label start-lab)
;; Skip space for the function header.
(inst simple-fun-header-word)
- (dotimes (i (1- sb!vm:simple-fun-code-offset))
+ (dotimes (i (1- simple-fun-code-offset))
(inst dword 0))
;; The start of the actual code.
;; The args fit within the frame so just allocate the frame.
(inst lea esp-tn
(make-ea :dword :base ebp-tn
- :disp (- (* sb!vm:word-bytes
+ :disp (- (* n-word-bytes
(max 3 (sb-allocated-size 'stack)))))))
(trace-table-entry trace-table-normal)))
(:ignore nfp callee)
(:generator 2
(move res esp-tn)
- (inst sub esp-tn (* sb!vm:word-bytes (sb-allocated-size 'stack)))))
+ (inst sub esp-tn (* n-word-bytes (sb-allocated-size 'stack)))))
;;; Allocate a partial frame for passing stack arguments in a full
;;; call. NARGS is the number of arguments passed. We allocate at
(:results (res :scs (any-reg control-stack)))
(:generator 2
(move res esp-tn)
- (inst sub esp-tn (* (max nargs 3) sb!vm:word-bytes))))
+ (inst sub esp-tn (* (max nargs 3) n-word-bytes))))
\f
;;; Emit code needed at the return-point from an unknown-values call
;;; for a fixed number of values. Values is the head of the TN-Ref
(emit-label no-stack-args)
(inst lea edi-tn
(make-ea :dword :base ebp-tn
- :disp (* (- (1+ register-arg-count)) word-bytes)))
+ :disp (* (- (1+ register-arg-count)) n-word-bytes)))
;; Load EAX with NIL so we can quickly store it, and set up
;; stuff for the loop.
(inst mov eax-tn nil-value)
;; Compute a pointer to where the stack args go.
(inst lea edi-tn
(make-ea :dword :base ebp-tn
- :disp (* (- (1+ register-arg-count)) word-bytes)))
+ :disp (* (- (1+ register-arg-count)) n-word-bytes)))
;; Save ESI, and compute a pointer to where the args come from.
(storew esi-tn ebx-tn (- (1+ 2)))
(inst lea esi-tn
(make-ea :dword :base ebx-tn
- :disp (* (- (1+ register-arg-count)) word-bytes)))
+ :disp (* (- (1+ register-arg-count)) n-word-bytes)))
;; Do the copy.
(inst shr ecx-tn word-shift) ; make word count
(inst std)
;; Zot all of the stack except for the old-fp.
(inst lea esp-tn (make-ea :dword :base ebp-tn
:disp (- (* (1+ ocfp-save-offset)
- word-bytes))))
+ n-word-bytes))))
;; Restore the old fp from its save location on the stack,
;; and zot the stack.
(inst pop ebp-tn))
;; Zot all of the stack except for the old-fp and return-pc.
(inst lea esp-tn
(make-ea :dword :base ebp-tn
- :disp (- (* (1+ (tn-offset return-pc)) word-bytes))))
+ :disp (- (* (1+ (tn-offset return-pc)) n-word-bytes))))
;; Restore the old fp. old-fp may be either on the stack in its
;; save location or in a register, in either case this restores it.
(move ebp-tn old-fp)
;; The return pops the return address (4 bytes), then we need
;; to pop all the slots before the return-pc which includes the
;; 4 bytes for the old-fp.
- (inst ret (* (tn-offset return-pc) word-bytes))))
+ (inst ret (* (tn-offset return-pc) n-word-bytes))))
(trace-table-entry trace-table-normal)))
\f
(inst ,(if (eq return :tail) 'jmp 'call)
(make-ea :dword :base eax
:disp ,(if named
- '(- (* fdefn-raw-addr-slot word-bytes)
+ '(- (* fdefn-raw-addr-slot
+ n-word-bytes)
other-pointer-lowtag)
- '(- (* closure-fun-slot word-bytes)
+ '(- (* closure-fun-slot n-word-bytes)
fun-pointer-lowtag))))
,@(ecase return
(:fixed
(if (zerop nvals)
(inst xor ecx ecx) ; smaller
(inst mov ecx (fixnumize nvals)))
- ;; restore the frame pointer.
+ ;; Restore the frame pointer.
(move ebp-tn old-fp)
- ;; clear as much of the stack as possible, but not past the return
+ ;; Clear as much of the stack as possible, but not past the return
;; address.
(inst lea esp-tn (make-ea :dword :base ebx
- :disp (- (* (max nvals 2) word-bytes))))
- ;; pre-default any argument register that need it.
+ :disp (- (* (max nvals 2) n-word-bytes))))
+ ;; Pre-default any argument register that need it.
(when (< nvals register-arg-count)
(let* ((arg-tns (nthcdr nvals (list a0 a1 a2)))
(first (first arg-tns)))
;; tell it to index off of EBX instead of EBP.
(cond ((zerop nvals)
;; Return popping the return address and the OCFP.
- (inst ret word-bytes))
+ (inst ret n-word-bytes))
((= nvals 1)
;; Return popping the return, leaving 1 slot. Can this
;; happen, or is a single value return handled elsewhere?
(t
(inst jmp (make-ea :dword :base ebx
:disp (- (* (1+ (tn-offset return-pc))
- word-bytes))))))
+ n-word-bytes))))))
(trace-table-entry trace-table-normal)))
(inst lea ebx-tn
(make-ea :dword :base ebp-tn
:disp (- (fixnumize fixed)
- (* sb!vm:word-bytes
+ (* n-word-bytes
(max 3 (sb-allocated-size 'stack))))))
(inst sub ebx-tn ecx-tn) ; Got the new stack in ebx
(inst mov esp-tn ebx-tn)
JUST-ALLOC-FRAME
(inst lea esp-tn
(make-ea :dword :base ebp-tn
- :disp (- (* sb!vm:word-bytes
+ :disp (- (* n-word-bytes
(max 3 (sb-allocated-size 'stack))))))
DONE))
(:result-types *)
(:generator 4
(inst mov value
- (make-ea :dword :base object :disp (- (* index word-bytes))))))
+ (make-ea :dword :base object :disp (- (* index n-word-bytes))))))
;;; Turn more arg (context, count) into a list.
(inst jmp enter)
(emit-label loop)
;; Compute a pointer to the next cons.
- (inst add dst (* cons-size word-bytes))
+ (inst add dst (* cons-size n-word-bytes))
;; Store a pointer to this cons in the CDR of the previous cons.
(storew dst dst -1 list-pointer-lowtag)
(emit-label enter)
;; Go back for more.
(inst loop loop)
;; NIL out the last cons.
- (storew nil-value dst 1 sb!vm:list-pointer-lowtag))
+ (storew nil-value dst 1 list-pointer-lowtag))
(emit-label done))))
;;; Return the location and size of the &MORE arg glob created by
(integer
(inst mov
(make-ea :dword :base object
- :disp (- (* offset word-bytes) lowtag))
+ :disp (- (* offset n-word-bytes) lowtag))
(fixnumize val)))
(symbol
(inst mov
(make-ea :dword :base object
- :disp (- (* offset word-bytes) lowtag))
+ :disp (- (* offset n-word-bytes) lowtag))
(+ nil-value (static-symbol-offset val))))
(character
(inst mov
(make-ea :dword :base object
- :disp (- (* offset word-bytes) lowtag))
+ :disp (- (* offset n-word-bytes) lowtag))
(logior (ash (char-code val) n-widetag-bits)
base-char-widetag)))))
;; Else, value not immediate.
(load-type type function (- fun-pointer-lowtag))
(inst lea raw
(make-ea :byte :base function
- :disp (- (* simple-fun-code-offset word-bytes)
+ :disp (- (* simple-fun-code-offset n-word-bytes)
fun-pointer-lowtag)))
(inst cmp type simple-fun-header-widetag)
(inst jmp :e normal-fn)
(:generator 5
(load-symbol-value bsp *binding-stack-pointer*)
(loadw temp symbol symbol-value-slot other-pointer-lowtag)
- (inst add bsp (* binding-size word-bytes))
+ (inst add bsp (* binding-size n-word-bytes))
(store-symbol-value bsp *binding-stack-pointer*)
(storew temp bsp (- binding-value-slot binding-size))
(storew symbol bsp (- binding-symbol-slot binding-size))
(loadw value bsp (- binding-value-slot binding-size))
(storew value symbol symbol-value-slot other-pointer-lowtag)
(storew 0 bsp (- binding-symbol-slot binding-size))
- (inst sub bsp (* binding-size word-bytes))
+ (inst sub bsp (* binding-size n-word-bytes))
(store-symbol-value bsp *binding-stack-pointer*)))
(define-vop (unbind-to-here)
(storew 0 bsp (- binding-symbol-slot binding-size))
SKIP
- (inst sub bsp (* binding-size word-bytes))
+ (inst sub bsp (* binding-size n-word-bytes))
(inst cmp where bsp)
(inst jmp :ne loop)
(store-symbol-value bsp *binding-stack-pointer*)
(move eax old-value)
(move temp new-value)
(inst cmpxchg (make-ea :dword :base object :index slot :scale 1
- :disp (- (* instance-slots-offset word-bytes)
+ :disp (- (* instance-slots-offset n-word-bytes)
instance-pointer-lowtag))
temp)
(move result eax)))
(move temp offset)
(inst neg temp)
(inst mov result
- (make-ea :dword :base sap :disp (- word-bytes) :index temp))))
+ (make-ea :dword :base sap :disp (- n-word-bytes) :index temp))))
(define-vop (read-control-stack-c)
(:translate stack-ref)
(:result-types *)
(:generator 5
(inst mov result (make-ea :dword :base sap
- :disp (- (* (1+ index) word-bytes))))))
+ :disp (- (* (1+ index) n-word-bytes))))))
(define-vop (write-control-stack)
(:translate %set-stack-ref)
(move temp offset)
(inst neg temp)
(inst mov
- (make-ea :dword :base sap :disp (- word-bytes) :index temp) value)
+ (make-ea :dword :base sap :disp (- n-word-bytes) :index temp) value)
(move result value)))
(define-vop (write-control-stack-c)
(:result-types *)
(:generator 5
(inst mov (make-ea :dword :base sap
- :disp (- (* (1+ index) word-bytes)))
+ :disp (- (* (1+ index) n-word-bytes)))
value)
(move result value)))
(loadw temp thing 0 lowtag)
(inst shr temp n-widetag-bits)
(inst jmp :z bogus)
- (inst shl temp (1- (integer-length word-bytes)))
+ (inst shl temp (1- (integer-length n-word-bytes)))
(unless (= lowtag other-pointer-lowtag)
(inst add temp (- lowtag other-pointer-lowtag)))
(move code thing)
(macrolet ((ea-for-xf-desc (tn slot)
`(make-ea
:dword :base ,tn
- :disp (- (* ,slot sb!vm:word-bytes)
- sb!vm:other-pointer-lowtag))))
+ :disp (- (* ,slot n-word-bytes)
+ other-pointer-lowtag))))
(defun ea-for-sf-desc (tn)
- (ea-for-xf-desc tn sb!vm:single-float-value-slot))
+ (ea-for-xf-desc tn single-float-value-slot))
(defun ea-for-df-desc (tn)
- (ea-for-xf-desc tn sb!vm:double-float-value-slot))
+ (ea-for-xf-desc tn double-float-value-slot))
#!+long-float
(defun ea-for-lf-desc (tn)
- (ea-for-xf-desc tn sb!vm:long-float-value-slot))
+ (ea-for-xf-desc tn long-float-value-slot))
;; complex floats
(defun ea-for-csf-real-desc (tn)
- (ea-for-xf-desc tn sb!vm:complex-single-float-real-slot))
+ (ea-for-xf-desc tn complex-single-float-real-slot))
(defun ea-for-csf-imag-desc (tn)
- (ea-for-xf-desc tn sb!vm:complex-single-float-imag-slot))
+ (ea-for-xf-desc tn complex-single-float-imag-slot))
(defun ea-for-cdf-real-desc (tn)
- (ea-for-xf-desc tn sb!vm:complex-double-float-real-slot))
+ (ea-for-xf-desc tn complex-double-float-real-slot))
(defun ea-for-cdf-imag-desc (tn)
- (ea-for-xf-desc tn sb!vm:complex-double-float-imag-slot))
+ (ea-for-xf-desc tn complex-double-float-imag-slot))
#!+long-float
(defun ea-for-clf-real-desc (tn)
- (ea-for-xf-desc tn sb!vm:complex-long-float-real-slot))
+ (ea-for-xf-desc tn complex-long-float-real-slot))
#!+long-float
(defun ea-for-clf-imag-desc (tn)
- (ea-for-xf-desc tn sb!vm:complex-long-float-imag-slot)))
+ (ea-for-xf-desc tn complex-long-float-imag-slot)))
(macrolet ((ea-for-xf-stack (tn kind)
`(make-ea
:dword :base ebp-tn
:disp (- (* (+ (tn-offset ,tn)
(ecase ,kind (:single 1) (:double 2) (:long 3)))
- sb!vm:word-bytes)))))
+ n-word-bytes)))))
(defun ea-for-sf-stack (tn)
(ea-for-xf-stack tn :single))
(defun ea-for-df-stack (tn)
(:double 2)
(:long 3))
(ecase ,slot (:real 1) (:imag 2))))
- sb!vm:word-bytes)))))
+ n-word-bytes)))))
(defun ea-for-csf-real-stack (tn &optional (base ebp-tn))
(ea-for-cxf-stack tn :single :real base))
(defun ea-for-csf-imag-stack (tn &optional (base ebp-tn))
(:note "float to pointer coercion")
(:generator 13
(with-fixed-allocation (y
- sb!vm:single-float-widetag
- sb!vm:single-float-size node)
+ single-float-widetag
+ single-float-size node)
(with-tn@fp-top(x)
(inst fst (ea-for-sf-desc y))))))
(define-move-vop move-from-single :move
(:note "float to pointer coercion")
(:generator 13
(with-fixed-allocation (y
- sb!vm:double-float-widetag
- sb!vm:double-float-size
+ double-float-widetag
+ double-float-size
node)
(with-tn@fp-top(x)
(inst fstd (ea-for-df-desc y))))))
(:note "float to pointer coercion")
(:generator 13
(with-fixed-allocation (y
- sb!vm:long-float-widetag
- sb!vm:long-float-size
+ long-float-widetag
+ long-float-size
node)
(with-tn@fp-top(x)
(store-long-float (ea-for-lf-desc y))))))
(:note "complex float to pointer coercion")
(:generator 13
(with-fixed-allocation (y
- sb!vm:complex-single-float-widetag
- sb!vm:complex-single-float-size
+ complex-single-float-widetag
+ complex-single-float-size
node)
(let ((real-tn (complex-single-reg-real-tn x)))
(with-tn@fp-top(real-tn)
(:note "complex float to pointer coercion")
(:generator 13
(with-fixed-allocation (y
- sb!vm:complex-double-float-widetag
- sb!vm:complex-double-float-size
+ complex-double-float-widetag
+ complex-double-float-size
node)
(let ((real-tn (complex-double-reg-real-tn x)))
(with-tn@fp-top(real-tn)
(:note "complex float to pointer coercion")
(:generator 13
(with-fixed-allocation (y
- sb!vm:complex-long-float-widetag
- sb!vm:complex-long-float-size
+ complex-long-float-widetag
+ complex-long-float-size
node)
(let ((real-tn (complex-long-reg-real-tn x)))
(with-tn@fp-top(real-tn)
(inst fxch x)))))
(,stack-sc
(if (= (tn-offset fp) esp-offset)
- (let* ((offset (* (tn-offset y) word-bytes))
+ (let* ((offset (* (tn-offset y) n-word-bytes))
(ea (make-ea :dword :base fp :disp offset)))
(with-tn@fp-top(x)
,@(ecase format
(:single 1)
(:double 2)
(:long 3)))
- sb!vm:word-bytes)))))
+ n-word-bytes)))))
(with-tn@fp-top(x)
,@(ecase format
(:single '((inst fst ea)))
(storew lo-bits ebp-tn (- (1+ offset)))
(with-empty-tn@fp-top(res)
(inst fldd (make-ea :dword :base ebp-tn
- :disp (- (* (1+ offset) word-bytes))))))))
+ :disp (- (* (1+ offset) n-word-bytes))))))))
#!+long-float
(define-vop (make-long-float)
(storew lo-bits ebp-tn (- (+ offset 2)))
(with-empty-tn@fp-top(res)
(inst fldl (make-ea :dword :base ebp-tn
- :disp (- (* (+ offset 2) word-bytes))))))))
+ :disp (- (* (+ offset 2) n-word-bytes))))))))
(define-vop (single-float-bits)
(:args (float :scs (single-reg descriptor-reg)
(inst mov bits float))
(descriptor-reg
(loadw
- bits float sb!vm:single-float-value-slot
- sb!vm:other-pointer-lowtag))))
+ bits float single-float-value-slot
+ other-pointer-lowtag))))
(signed-stack
(sc-case float
(single-reg
(with-tn@fp-top(float)
(let ((where (make-ea :dword :base ebp-tn
:disp (- (* (+ 2 (tn-offset temp))
- word-bytes)))))
+ n-word-bytes)))))
(inst fstd where)))
(loadw hi-bits ebp-tn (- (1+ (tn-offset temp)))))
(double-stack
(loadw hi-bits ebp-tn (- (1+ (tn-offset float)))))
(descriptor-reg
- (loadw hi-bits float (1+ sb!vm:double-float-value-slot)
- sb!vm:other-pointer-lowtag)))))
+ (loadw hi-bits float (1+ double-float-value-slot)
+ other-pointer-lowtag)))))
(define-vop (double-float-low-bits)
(:args (float :scs (double-reg descriptor-reg)
(with-tn@fp-top(float)
(let ((where (make-ea :dword :base ebp-tn
:disp (- (* (+ 2 (tn-offset temp))
- word-bytes)))))
+ n-word-bytes)))))
(inst fstd where)))
(loadw lo-bits ebp-tn (- (+ 2 (tn-offset temp)))))
(double-stack
(loadw lo-bits ebp-tn (- (+ 2 (tn-offset float)))))
(descriptor-reg
- (loadw lo-bits float sb!vm:double-float-value-slot
- sb!vm:other-pointer-lowtag)))))
+ (loadw lo-bits float double-float-value-slot
+ other-pointer-lowtag)))))
#!+long-float
(define-vop (long-float-exp-bits)
(with-tn@fp-top(float)
(let ((where (make-ea :dword :base ebp-tn
:disp (- (* (+ 3 (tn-offset temp))
- word-bytes)))))
+ n-word-bytes)))))
(store-long-float where)))
(inst movsx exp-bits
(make-ea :word :base ebp-tn
- :disp (* (- (1+ (tn-offset temp))) word-bytes))))
+ :disp (* (- (1+ (tn-offset temp))) n-word-bytes))))
(long-stack
(inst movsx exp-bits
(make-ea :word :base ebp-tn
- :disp (* (- (1+ (tn-offset float))) word-bytes))))
+ :disp (* (- (1+ (tn-offset float))) n-word-bytes))))
(descriptor-reg
(inst movsx exp-bits
(make-ea :word :base float
- :disp (- (* (+ 2 sb!vm:long-float-value-slot)
- word-bytes)
- sb!vm:other-pointer-lowtag)))))))
+ :disp (- (* (+ 2 long-float-value-slot)
+ n-word-bytes)
+ other-pointer-lowtag)))))))
#!+long-float
(define-vop (long-float-high-bits)
(with-tn@fp-top(float)
(let ((where (make-ea :dword :base ebp-tn
:disp (- (* (+ 3 (tn-offset temp))
- word-bytes)))))
+ n-word-bytes)))))
(store-long-float where)))
(loadw hi-bits ebp-tn (- (+ (tn-offset temp) 2))))
(long-stack
(loadw hi-bits ebp-tn (- (+ (tn-offset float) 2))))
(descriptor-reg
- (loadw hi-bits float (1+ sb!vm:long-float-value-slot)
- sb!vm:other-pointer-lowtag)))))
+ (loadw hi-bits float (1+ long-float-value-slot)
+ other-pointer-lowtag)))))
#!+long-float
(define-vop (long-float-low-bits)
(with-tn@fp-top(float)
(let ((where (make-ea :dword :base ebp-tn
:disp (- (* (+ 3 (tn-offset temp))
- word-bytes)))))
+ n-word-bytes)))))
(store-long-float where)))
(loadw lo-bits ebp-tn (- (+ (tn-offset temp) 3))))
(long-stack
(loadw lo-bits ebp-tn (- (+ (tn-offset float) 3))))
(descriptor-reg
- (loadw lo-bits float sb!vm:long-float-value-slot
- sb!vm:other-pointer-lowtag)))))
+ (loadw lo-bits float long-float-value-slot
+ other-pointer-lowtag)))))
\f
;;;; float mode hackery
(defknown ((setf floating-point-modes)) (float-modes)
float-modes)
-(defconstant npx-env-size (* 7 sb!vm:word-bytes))
+(defconstant npx-env-size (* 7 n-word-bytes))
(defconstant npx-cw-offset 0)
(defconstant npx-sw-offset 4)
(let ((offset (fixup-offset fixup)))
(if (label-p offset)
(emit-back-patch segment
- 4 ; FIXME: sb!vm:word-bytes
+ 4 ; FIXME: sb!vm:n-word-bytes
#'(lambda (segment posn)
(declare (ignore posn))
(emit-dword segment
(emit-mod-reg-r/m-byte segment #b11 reg (reg-tn-encoding thing)))
(stack
;; Convert stack tns into an index off of EBP.
- (let ((disp (- (* (1+ (tn-offset thing)) word-bytes))))
+ (let ((disp (- (* (1+ (tn-offset thing)) n-word-bytes))))
(cond ((< -128 disp 127)
(emit-mod-reg-r/m-byte segment #b01 reg #b101)
(emit-byte segment disp))
(emit-absolute-fixup segment
(make-fixup nil
:code-object
- (- (* (tn-offset thing) word-bytes)
+ (- (* (tn-offset thing) n-word-bytes)
other-pointer-lowtag))))))
(ea
(let* ((base (ea-base thing))
(cond (length-only
(values 0 (1+ length) nil nil))
(t
- (sb!kernel:copy-from-system-area sap (* byte-bits (1+ offset))
+ (sb!kernel:copy-from-system-area sap (* n-byte-bits (1+ offset))
vector (* n-word-bits
vector-data-offset)
- (* length byte-bits))
+ (* length n-byte-bits))
(collect ((sc-offsets)
(lengths))
(lengths 1) ; the length byte
;; from first principles whether it's defined in some way that genesis
;; can't grok.
(case (byte-imm-code chunk dstate)
- (#.sb!vm:error-trap
+ (#.error-trap
(nt "error trap")
(sb!disassem:handle-break-args #'snarf-error-junk stream dstate))
- (#.sb!vm:cerror-trap
+ (#.cerror-trap
(nt "cerror trap")
(sb!disassem:handle-break-args #'snarf-error-junk stream dstate))
- (#.sb!vm:breakpoint-trap
+ (#.breakpoint-trap
(nt "breakpoint trap"))
- (#.sb!vm:pending-interrupt-trap
+ (#.pending-interrupt-trap
(nt "pending interrupt trap"))
- (#.sb!vm:halt-trap
+ (#.halt-trap
(nt "halt trap"))
- (#.sb!vm:fun-end-breakpoint-trap
+ (#.fun-end-breakpoint-trap
(nt "function end breakpoint trap")))))
(define-instruction break (segment code)
(in-package "SB!VM")
-;;; We can load/store into fp registers through the top of
-;;; stack %st(0) (fr0 here). Loads imply a push to an empty register
-;;; which then changes all the reg numbers. These macros help manage that.
+;;; We can load/store into fp registers through the top of stack
+;;; %st(0) (fr0 here). Loads imply a push to an empty register which
+;;; then changes all the reg numbers. These macros help manage that.
-;;; Use this when we don't have to load anything. It preserves old tos value,
-;;; but probably destroys tn with operation.
+;;; Use this when we don't have to load anything. It preserves old tos
+;;; value, but probably destroys tn with operation.
(defmacro with-tn@fp-top((tn) &body body)
`(progn
(unless (zerop (tn-offset ,tn))
(inst mov ,n-dst ,n-src))))
(defmacro make-ea-for-object-slot (ptr slot lowtag)
- `(make-ea :dword :base ,ptr :disp (- (* ,slot word-bytes) ,lowtag)))
+ `(make-ea :dword :base ,ptr :disp (- (* ,slot n-word-bytes) ,lowtag)))
(defmacro loadw (value ptr &optional (slot 0) (lowtag 0))
`(inst mov ,value (make-ea-for-object-slot ,ptr ,slot ,lowtag)))
&rest forms)
`(pseudo-atomic
(allocation ,result-tn (pad-data-block ,size) ,inline)
- (storew (logior (ash (1- ,size) sb!vm:n-widetag-bits) ,widetag)
+ (storew (logior (ash (1- ,size) n-widetag-bits) ,widetag)
,result-tn)
(inst lea ,result-tn
(make-ea :byte :base ,result-tn :disp other-pointer-lowtag))
(:result-types ,el-type)
(:generator 3 ; pw was 5
(inst mov value (make-ea :dword :base object :index index
- :disp (- (* ,offset word-bytes) ,lowtag)))))
+ :disp (- (* ,offset n-word-bytes)
+ ,lowtag)))))
(define-vop (,(symbolicate name "-C"))
,@(when translate
`((:translate ,translate)))
(:result-types ,el-type)
(:generator 2 ; pw was 5
(inst mov value (make-ea :dword :base object
- :disp (- (* (+ ,offset index) word-bytes)
+ :disp (- (* (+ ,offset index) n-word-bytes)
,lowtag)))))))
(defmacro define-full-setter (name type offset lowtag scs el-type &optional translate)
(:result-types ,el-type)
(:generator 4 ; was 5
(inst mov (make-ea :dword :base object :index index
- :disp (- (* ,offset word-bytes) ,lowtag))
+ :disp (- (* ,offset n-word-bytes) ,lowtag))
value)
(move result value)))
(define-vop (,(symbolicate name "-C"))
(:result-types ,el-type)
(:generator 3 ; was 5
(inst mov (make-ea :dword :base object
- :disp (- (* (+ ,offset index) word-bytes) ,lowtag))
+ :disp (- (* (+ ,offset index) n-word-bytes)
+ ,lowtag))
value)
(move result value)))))
(:generator 4
(move result value)
(inst xadd (make-ea :dword :base object
- :disp (- (* offset word-bytes) lowtag))
+ :disp (- (* offset n-word-bytes) lowtag))
value)))
;;; SLOT-REF and SLOT-SET are used to define VOPs like CLOSURE-REF,
(integer
(inst mov
(make-ea :dword :base object
- :disp (- (* (+ base offset) word-bytes) lowtag))
+ :disp (- (* (+ base offset) n-word-bytes) lowtag))
(fixnumize val)))
(symbol
(inst mov
(make-ea :dword :base object
- :disp (- (* (+ base offset) word-bytes) lowtag))
+ :disp (- (* (+ base offset) n-word-bytes) lowtag))
(+ nil-value (static-symbol-offset val))))
(character
(inst mov
(make-ea :dword :base object
- :disp (- (* (+ base offset) word-bytes) lowtag))
+ :disp (- (* (+ base offset) n-word-bytes) lowtag))
(logior (ash (char-code val) n-widetag-bits)
base-char-widetag)))))
;; Else, value not immediate.
(move eax old-value)
(move temp new-value)
(inst cmpxchg (make-ea :dword :base object
- :disp (- (* (+ base offset) word-bytes) lowtag))
+ :disp (- (* (+ base offset) n-word-bytes) lowtag))
temp)
(move result eax)))
(:generator 4
(move result value)
(inst xadd (make-ea :dword :base object
- :disp (- (* (+ base offset) word-bytes) lowtag))
+ :disp (- (* (+ base offset) n-word-bytes) lowtag))
value)))
(inst jmp :ns one-word-bignum)
;; two word bignum
(inst mov y (logior (ash (1- (+ bignum-digits-offset 2))
- sb!vm:n-widetag-bits)
+ n-widetag-bits)
bignum-widetag))
(inst jmp L1)
(emit-label one-word-bignum)
(inst mov y (logior (ash (1- (+ bignum-digits-offset 1))
- sb!vm:n-widetag-bits)
+ n-widetag-bits)
bignum-widetag))
(emit-label L1)
(pseudo-atomic
(defun catch-block-ea (tn)
(aver (sc-is tn catch-block))
(make-ea :dword :base ebp-tn
- :disp (- (* (+ (tn-offset tn) catch-block-size) word-bytes))))
+ :disp (- (* (+ (tn-offset tn) catch-block-size) n-word-bytes))))
\f
;;;; Save and restore dynamic environment.
(emit-label label)
(note-this-location vop :non-local-entry)
- (inst lea esi (make-ea :dword :base source :disp (- word-bytes)))
+ (inst lea esi (make-ea :dword :base source :disp (- n-word-bytes)))
;; The 'top' arg contains the %esp value saved at the time the
;; catch block was created and points to where the thrown values
;; should sit.
(move edi top)
(move result edi)
- (inst sub edi word-bytes)
+ (inst sub edi n-word-bytes)
(move ecx count) ; fixnum words == bytes
(move num ecx)
(inst shr ecx word-shift) ; word count for <rep movs>
DONE
;; Reset the CSP at last moved arg.
- (inst lea esp-tn (make-ea :dword :base edi :disp word-bytes))))
+ (inst lea esp-tn (make-ea :dword :base edi :disp n-word-bytes))))
;;; This VOP is just to force the TNs used in the cleanup onto the stack.
\f
;;;; machine architecture parameters
-(defconstant n-word-bits 32
- #!+sb-doc
- "Number of bits per word where a word holds one lisp descriptor.")
+;;; the number of bits per word, where a word holds one lisp descriptor
+(defconstant n-word-bits 32)
-(defconstant byte-bits 8
- #!+sb-doc
- "Number of bits per byte where a byte is the smallest addressable object.")
+;;; the number of bits per byte, where a byte is the smallest
+;;; addressable object
+(defconstant n-byte-bits 8)
-(defconstant word-shift (1- (integer-length (/ n-word-bits byte-bits)))
- #!+sb-doc
- "Number of bits to shift between word addresses and byte addresses.")
+;;; the number of bits to shift between word addresses and byte addresses
+(defconstant word-shift (1- (integer-length (/ n-word-bits n-byte-bits))))
-(defconstant word-bytes (/ n-word-bits byte-bits)
- #!+sb-doc
- "Number of bytes in a word.")
+;;; the number of bytes in a word
+(defconstant n-word-bytes (/ n-word-bits n-byte-bits))
(defconstant float-sign-shift 31)
*current-catch-block*
*current-unwind-protect-block*
*eval-stack-top*
- sb!vm::*alien-stack*
+ *alien-stack*
;; interrupt handling
*pseudo-atomic-atomic*
sb!unix::*interrupt-pending*
*free-interrupt-context-index*
- sb!vm::*allocation-pointer*
- sb!vm::*binding-stack-pointer*
- sb!vm::*internal-gc-trigger* ; Not used.
+ *allocation-pointer*
+ *binding-stack-pointer*
+ *internal-gc-trigger* ; Not used.
;; the floating point constants
- sb!vm::*fp-constant-0d0*
- sb!vm::*fp-constant-1d0*
- sb!vm::*fp-constant-0s0*
- sb!vm::*fp-constant-1s0*
+ *fp-constant-0d0*
+ *fp-constant-1d0*
+ *fp-constant-0s0*
+ *fp-constant-1s0*
;; The following are all long-floats.
- sb!vm::*fp-constant-0l0*
- sb!vm::*fp-constant-1l0*
- sb!vm::*fp-constant-pi*
- sb!vm::*fp-constant-l2t*
- sb!vm::*fp-constant-l2e*
- sb!vm::*fp-constant-lg2*
- sb!vm::*fp-constant-ln2*
+ *fp-constant-0l0*
+ *fp-constant-1l0*
+ *fp-constant-pi*
+ *fp-constant-l2t*
+ *fp-constant-l2e*
+ *fp-constant-lg2*
+ *fp-constant-ln2*
;; The ..SLOT-UNBOUND.. symbol is static in order to optimise the
;; common slot unbound check.
(:result-types system-area-pointer)
(:generator 2
(move sap vector)
- (inst add sap (- (* vector-data-offset word-bytes) other-pointer-lowtag))))
+ (inst add
+ sap
+ (- (* vector-data-offset n-word-bytes) other-pointer-lowtag))))
(inst push object)
(inst lea eax (make-fixup (extern-alien-name "debug_print") :foreign))
(inst call (make-fixup (extern-alien-name "call_into_c") :foreign))
- (inst add esp-tn word-bytes)
+ (inst add esp-tn n-word-bytes)
(move result eax)))
(inst jmp done)
FUNCTION-PTR
- (load-type al-tn object (- sb!vm:fun-pointer-lowtag))
+ (load-type al-tn object (- fun-pointer-lowtag))
(inst jmp done)
OTHER-PTR
- (load-type al-tn object (- sb!vm:other-pointer-lowtag))
+ (load-type al-tn object (- other-pointer-lowtag))
DONE
(inst movzx result al-tn)))
(:results (result :scs (unsigned-reg)))
(:result-types positive-fixnum)
(:generator 6
- (load-type temp function (- sb!vm:fun-pointer-lowtag))
+ (load-type temp function (- fun-pointer-lowtag))
(inst movzx result temp)))
(define-vop (set-function-subtype)
(inst lea result
(make-ea :byte :base result
:disp (- fun-pointer-lowtag
- (* simple-fun-code-offset word-bytes))))))
+ (* simple-fun-code-offset n-word-bytes))))))
;;; The closure function slot is a pointer to raw code on X86 instead
;;; of a pointer to the code function object itself. This VOP is used
(:info index)
(:generator 0
(inst inc (make-ea :dword :base count-vector
- :disp (- (* (+ vector-data-offset index) word-bytes)
+ :disp (- (* (+ vector-data-offset index) n-word-bytes)
other-pointer-lowtag)))))
3))
((sc-is value control-stack)
(inst test (make-ea :byte :base ebp-tn
- :disp (- (* (1+ offset) sb!vm:word-bytes)))
+ :disp (- (* (1+ offset) n-word-bytes)))
3))
(t
(inst test value 3)))))
(move count num))
(t
(inst lea src (make-ea :dword :base context
- :disp (- (* (tn-value skip) word-bytes))))
+ :disp (- (* (tn-value skip)
+ n-word-bytes))))
(move count num)
- (inst sub count (* (tn-value skip) word-bytes)))))
+ (inst sub count (* (tn-value skip) n-word-bytes)))))
(any-reg
(move src context)
;;;
;;; (What a KLUDGE! Anyone who wants to come in and clean up this mess
;;; has my gratitude.) (FIXME: Maybe this should be me..)
-(defconstant sb!vm::kludge-nondeterministic-catch-block-size 6)
+(defconstant kludge-nondeterministic-catch-block-size 6)
(define-storage-classes
:alternate-scs (complex-long-stack))
;; a catch or unwind block
- (catch-block stack
- :element-size sb!vm::kludge-nondeterministic-catch-block-size))
+ (catch-block stack :element-size kludge-nondeterministic-catch-block-size))
(eval-when (:compile-toplevel :load-toplevel :execute)
(defparameter *byte-sc-names* '(base-char-reg byte-reg base-char-stack))
;;; for internal versions, especially for internal versions off the
;;; main CVS branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.pre7.59"
+"0.pre7.60"
projects / sbcl.git / commitdiff