(inst ret)
DO-STATIC-FUN
- ;; Same as: (inst enter (fixnumize 1))
+ ;; Same as: (inst enter (* n-word-bytes 1))
(inst push rbp-tn)
(inst mov rbp-tn rsp-tn)
- (inst sub rsp-tn (fixnumize 1))
+ (inst sub rsp-tn (* n-word-bytes 1))
(inst push (make-ea :qword :base rbp-tn
:disp (frame-byte-offset return-pc-save-offset)))
(inst mov rcx (fixnumize 2)) ; arg count
(static-fun-offset
',(symbolicate "TWO-ARG-" fun))))))))
+ #.`
(define-generic-arith-routine (+ 10)
(move res x)
(inst add res y)
(inst jmp :no OKAY)
- (inst rcr res 1) ; carry has correct sign
- (inst sar res 2) ; remove type bits
+ ;; Unbox the overflowed result, recovering the correct sign from
+ ;; the carry flag, then re-box as a bignum.
+ (inst rcr res 1)
+ ,@(when (> n-fixnum-tag-bits 1) ; don't shift by 0
+ '((inst sar res (1- n-fixnum-tag-bits))))
(move rcx res)
OKAY)
+ #.`
(define-generic-arith-routine (- 10)
(move res x)
(inst sub res y)
(inst jmp :no OKAY)
+ ;; Unbox the overflowed result, recovering the correct sign from
+ ;; the carry flag, then re-box as a bignum.
(inst cmc) ; carry has correct sign now
(inst rcr res 1)
- (inst sar res 2) ; remove type bits
+ ,@(when (> n-fixnum-tag-bits 1) ; don't shift by 0
+ '((inst sar res (1- n-fixnum-tag-bits))))
(move rcx res)
(inst push rbp-tn)
(inst mov rbp-tn rsp-tn)
- (inst sub rsp-tn (fixnumize 1))
+ (inst sub rsp-tn (* n-word-bytes 1))
(inst push (make-ea :qword :base rbp-tn
:disp (frame-byte-offset return-pc-save-offset)))
(inst mov rcx (fixnumize 1)) ; arg count
(inst ret)
DO-STATIC-FUN
- (inst sub rsp-tn (fixnumize 3))
+ (inst sub rsp-tn (* n-word-bytes 3))
(inst mov (make-ea :qword :base rsp-tn
:disp (frame-byte-offset
(+ sp->fp-offset
(inst ret)
DO-STATIC-FUN
- (inst sub rsp-tn (fixnumize 3))
+ (inst sub rsp-tn (* n-word-bytes 3))
(inst mov (make-ea :qword :base rsp-tn
:disp (frame-byte-offset
(+ sp->fp-offset
(inst ret)
DO-STATIC-FUN
- (inst sub rsp-tn (fixnumize 3))
+ (inst sub rsp-tn (* n-word-bytes 3))
(inst mov (make-ea :qword :base rsp-tn
:disp (frame-byte-offset
(+ sp->fp-offset
;; 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 (1- n-lowtag-bits))
+ (inst shr ecx n-fixnum-tag-bits)
(inst std) ; count down
(inst sub esi n-word-bytes)
(inst lea edi (make-ea :qword :base ebx :disp (- n-word-bytes)))
;; Calculate NARGS (as a fixnum)
(move ecx esi)
(inst sub ecx rsp-tn)
+ #!-#.(cl:if (cl:= sb!vm:word-shift sb!vm:n-fixnum-tag-bits) '(and) '(or))
+ (inst shr ecx (- word-shift n-fixnum-tag-bits))
;; Check for all the args fitting the registers.
- (inst cmp ecx (fixnumize 3))
+ (inst cmp ecx (fixnumize register-arg-count))
(inst jmp :le REGISTER-ARGS)
;; Save the OLD-FP and RETURN-PC because the blit is going to trash
;; 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 (1- n-lowtag-bits))
+ (inst shr ecx n-fixnum-tag-bits)
(inst std) ; count down
(inst lea edi (make-ea :qword :base rbp-tn :disp (frame-byte-offset 0)))
- (inst sub esi (fixnumize 1))
+ (inst sub esi n-word-bytes)
(inst rep)
(inst movs :qword)
(inst cld)
positive-fixnum)
(:policy :fast-safe)
(:generator 100
- (inst lea result (make-ea :byte :base words :disp
- (+ (1- (ash 1 n-lowtag-bits))
- (* vector-data-offset n-word-bytes))))
+ (inst lea result (make-ea :byte :index words
+ :scale (ash 1 (- word-shift n-fixnum-tag-bits))
+ :disp (+ lowtag-mask
+ (* vector-data-offset n-word-bytes))))
(inst and result (lognot lowtag-mask))
(pseudo-atomic
(allocation result result)
(:policy :fast-safe)
(:node-var node)
(:generator 100
- (inst lea result (make-ea :byte :base words :disp
- (+ (1- (ash 1 n-lowtag-bits))
- (* vector-data-offset n-word-bytes))))
+ (inst lea result (make-ea :byte :index words
+ :scale (ash 1 (- word-shift n-fixnum-tag-bits))
+ :disp (+ lowtag-mask
+ (* vector-data-offset n-word-bytes))))
(inst and result (lognot lowtag-mask))
;; FIXME: It would be good to check for stack overflow here.
(move ecx words)
(:node-var node)
(:generator 50
(inst lea bytes
- (make-ea :qword :base extra :disp (* (1+ words) n-word-bytes)))
+ (make-ea :qword :disp (* (1+ words) n-word-bytes) :index extra
+ :scale (ash 1 (- word-shift n-fixnum-tag-bits))))
(inst mov header bytes)
- (inst shl header (- n-widetag-bits 3)) ; w+1 to length field
+ (inst shl header (- n-widetag-bits word-shift)) ; w+1 to length field
(inst lea header ; (w-1 << 8) | type
- (make-ea :qword :base header :disp (+ (ash -2 n-widetag-bits) type)))
+ (make-ea :qword :base header
+ :disp (+ (ash -2 n-widetag-bits) type)))
(inst and bytes (lognot lowtag-mask))
(pseudo-atomic
(allocation result bytes node)
(:note "inline fixnum arithmetic")
(:generator 4
(move r x)
- (inst sar r 3)
+ (inst sar r n-fixnum-tag-bits)
(inst imul r y)))
(define-vop (fast-*-c/fixnum=>fixnum fast-safe-arith-op)
(progn
(inst sar result (- amount))
(inst and result (lognot fixnum-tag-mask)))))
+ ;; shifting left (zero fill)
((plusp amount)
(unless modularp
(aver (not "Impossible: fixnum ASH should not be called with
(if (sc-is result any-reg)
(zeroize result)
(inst mov result 0)))
+ ;; shifting right (sign fill)
(t (inst sar result 63)
(inst and result (lognot fixnum-tag-mask))))))))
(:result-types unsigned-num)
(:generator 1
(move digit fixnum)
- (inst sar digit 3)))
+ (inst sar digit n-fixnum-tag-bits)))
(define-vop (bignum-floor)
(:translate sb!bignum:%bigfloor)
(:generator 1
(move res digit)
(when (sc-is res any-reg control-stack)
- (inst shl res 3))))
+ (inst shl res n-fixnum-tag-bits))))
(define-vop (digit-ashr)
(:translate sb!bignum:%ashr)
(:node-var node)
(:generator 13
(inst lea bytes
- (make-ea :qword :base rank
+ (make-ea :qword
+ :index rank :scale (ash 1 (- word-shift n-fixnum-tag-bits))
:disp (+ (* (1+ array-dimensions-offset) n-word-bytes)
lowtag-mask)))
(inst and bytes (lognot lowtag-mask))
:disp (fixnumize (1- array-dimensions-offset))))
(inst shl header n-widetag-bits)
(inst or header type)
- (inst shr header (1- n-lowtag-bits))
+ (inst shr header n-fixnum-tag-bits)
(pseudo-atomic
(allocation result bytes node)
(inst lea result (make-ea :qword :base result :disp other-pointer-lowtag))
complex-offset)
other-pointer-lowtag))))))
-(define-vop (data-vector-ref-with-offset/simple-array-single-float)
- (:note "inline array access")
- (:translate data-vector-ref-with-offset)
- (:policy :fast-safe)
- (:args (object :scs (descriptor-reg))
- (index :scs (any-reg)))
- (:info offset)
- (:arg-types simple-array-single-float positive-fixnum
- (:constant (constant-displacement other-pointer-lowtag
- 4 vector-data-offset)))
- (:temporary (:sc unsigned-reg) dword-index)
- (:results (value :scs (single-reg)))
- (:result-types single-float)
- (:generator 5
- (move dword-index index)
- (inst shr dword-index 1)
- (inst movss value (make-ea-for-float-ref object dword-index offset 4))))
+#.
+(let ((use-temp (<= word-shift n-fixnum-tag-bits)))
+ `(define-vop (data-vector-ref-with-offset/simple-array-single-float)
+ (:note "inline array access")
+ (:translate data-vector-ref-with-offset)
+ (:policy :fast-safe)
+ (:args (object :scs (descriptor-reg))
+ (index :scs (any-reg)))
+ (:info offset)
+ (:arg-types simple-array-single-float positive-fixnum
+ (:constant (constant-displacement other-pointer-lowtag
+ 4 vector-data-offset)))
+ ,@(when use-temp '((:temporary (:sc unsigned-reg) dword-index)))
+ (:results (value :scs (single-reg)))
+ (:result-types single-float)
+ (:generator 5
+ ,@(if use-temp
+ '((move dword-index index)
+ (inst shr dword-index (1+ (- n-fixnum-tag-bits word-shift)))
+ (inst movss value (make-ea-for-float-ref object dword-index offset 4)))
+ '((inst movss value (make-ea-for-float-ref object index offset 4
+ :scale (ash 4 (- n-fixnum-tag-bits)))))))))
(define-vop (data-vector-ref-c-with-offset/simple-array-single-float)
(:note "inline array access")
(:generator 4
(inst movss value (make-ea-for-float-ref object index offset 4))))
-(define-vop (data-vector-set-with-offset/simple-array-single-float)
- (:note "inline array store")
- (:translate data-vector-set-with-offset)
- (:policy :fast-safe)
- (:args (object :scs (descriptor-reg))
- (index :scs (any-reg))
- (value :scs (single-reg) :target result))
- (:info offset)
- (:arg-types simple-array-single-float positive-fixnum
- (:constant (constant-displacement other-pointer-lowtag
- 4 vector-data-offset))
- single-float)
- (:temporary (:sc unsigned-reg) dword-index)
- (:results (result :scs (single-reg)))
- (:result-types single-float)
- (:generator 5
- (move dword-index index)
- (inst shr dword-index 1)
- (inst movss (make-ea-for-float-ref object dword-index offset 4) value)
- (move result value)))
+#.
+(let ((use-temp (<= word-shift n-fixnum-tag-bits)))
+ `(define-vop (data-vector-set-with-offset/simple-array-single-float)
+ (:note "inline array store")
+ (:translate data-vector-set-with-offset)
+ (:policy :fast-safe)
+ (:args (object :scs (descriptor-reg))
+ (index :scs (any-reg))
+ (value :scs (single-reg) :target result))
+ (:info offset)
+ (:arg-types simple-array-single-float positive-fixnum
+ (:constant (constant-displacement other-pointer-lowtag
+ 4 vector-data-offset))
+ single-float)
+ ,@(when use-temp '((:temporary (:sc unsigned-reg) dword-index)))
+ (:results (result :scs (single-reg)))
+ (:result-types single-float)
+ (:generator 5
+ ,@(if use-temp
+ '((move dword-index index)
+ (inst shr dword-index (1+ (- n-fixnum-tag-bits word-shift)))
+ (inst movss (make-ea-for-float-ref object dword-index offset 4) value))
+ '((inst movss (make-ea-for-float-ref object index offset 4
+ :scale (ash 4 (- n-fixnum-tag-bits))) value)))
+ (move result value))))
(define-vop (data-vector-set-c-with-offset/simple-array-single-float)
(:note "inline array store")
(:results (value :scs (double-reg)))
(:result-types double-float)
(:generator 7
- (inst movsd value (make-ea-for-float-ref object index offset 8))))
+ (inst movsd value (make-ea-for-float-ref object index offset 8
+ :scale (ash 1 (- word-shift n-fixnum-tag-bits))))))
(define-vop (data-vector-ref-c/simple-array-double-float)
(:note "inline array access")
(:results (result :scs (double-reg)))
(:result-types double-float)
(:generator 20
- (inst movsd (make-ea-for-float-ref object index offset 8) value)
+ (inst movsd (make-ea-for-float-ref object index offset 8
+ :scale (ash 1 (- word-shift n-fixnum-tag-bits)))
+ value)
(move result value)))
(define-vop (data-vector-set-c-with-offset/simple-array-double-float)
(:results (value :scs (complex-single-reg)))
(:result-types complex-single-float)
(:generator 5
- (inst movq value (make-ea-for-float-ref object index offset 8))))
+ (inst movq value (make-ea-for-float-ref object index offset 8
+ :scale (ash 1 (- word-shift n-fixnum-tag-bits))))))
(define-vop (data-vector-ref-c-with-offset/simple-array-complex-single-float)
(:note "inline array access")
(:result-types complex-single-float)
(:generator 5
(move result value)
- (inst movq (make-ea-for-float-ref object index offset 8) value)))
+ (inst movq (make-ea-for-float-ref object index offset 8
+ :scale (ash 1 (- word-shift n-fixnum-tag-bits)))
+ value)))
(define-vop (data-vector-set-c-with-offset/simple-array-complex-single-float)
(:note "inline array store")
(:results (value :scs (complex-double-reg)))
(:result-types complex-double-float)
(:generator 7
- (inst movapd value (make-ea-for-float-ref object index offset 16 :scale 2))))
+ (inst movapd value (make-ea-for-float-ref object index offset 16
+ :scale (ash 2 (- word-shift n-fixnum-tag-bits))))))
(define-vop (data-vector-ref-c-with-offset/simple-array-complex-double-float)
(:note "inline array access")
(:results (value :scs (complex-double-reg)))
(:result-types complex-double-float)
(:generator 6
- (inst movapd value (make-ea-for-float-ref object index offset 16 :scale 2))))
+ (inst movapd value (make-ea-for-float-ref object index offset 16))))
(define-vop (data-vector-set-with-offset/simple-array-complex-double-float)
(:note "inline array store")
(:results (result :scs (complex-double-reg)))
(:result-types complex-double-float)
(:generator 20
- (inst movapd (make-ea-for-float-ref object index offset 16 :scale 2) value)
+ (inst movapd (make-ea-for-float-ref object index offset 16
+ :scale (ash 2 (- word-shift n-fixnum-tag-bits)))
+ value)
(move result value)))
(define-vop (data-vector-set-c-with-offset/simple-array-complex-double-float)
(:results (result :scs (complex-double-reg)))
(:result-types complex-double-float)
(:generator 19
- (inst movapd (make-ea-for-float-ref object index offset 16 :scale 2) value)
+ (inst movapd (make-ea-for-float-ref object index offset 16) value)
(move result value)))
\f
:disp (frame-byte-offset
(+ sp->fp-offset register-arg-count))))
;; Do the copy.
- (inst shr rcx-tn word-shift) ; make word count
+ (inst shr rcx-tn n-fixnum-tag-bits) ; make word count
(inst std)
(inst rep)
(inst movs :qword)
;; If none, then just blow out of here.
(inst jmp :le restore-edi)
(inst mov rcx-tn rax-tn)
- (inst shr rcx-tn word-shift) ; word count
+ (inst shr rcx-tn n-fixnum-tag-bits) ; word count
;; Load RAX with NIL for fast storing.
(inst mov rax-tn nil-value)
;; Do the store.
register-arg-count)
(inst cmp nargs (fixnumize register-arg-count))
(inst jmp :g stack-values)
+ #!+#.(cl:if (cl:= sb!vm:word-shift sb!vm:n-fixnum-tag-bits) '(and) '(or))
(inst sub rsp-tn nargs)
+ #!-#.(cl:if (cl:= sb!vm:word-shift sb!vm:n-fixnum-tag-bits) '(and) '(or))
+ (progn
+ ;; FIXME: This can't be efficient, but LEA (my first choice)
+ ;; doesn't do subtraction.
+ (inst shl nargs (- word-shift n-fixnum-tag-bits))
+ (inst sub rsp-tn nargs)
+ (inst shr nargs (- word-shift n-fixnum-tag-bits)))
(emit-label stack-values))
;; dtc: this writes the registers onto the stack even if they are
;; not needed, only the number specified in rcx are used and have
;; Compute the number of arguments.
(noise '(inst mov rcx new-fp))
(noise '(inst sub rcx rsp-tn))
+ #.(unless (= word-shift n-fixnum-tag-bits)
+ '(noise '(inst shr rcx
+ (- word-shift n-fixnum-tag-bits))))
;; Move the necessary args to registers,
;; this moves them all even if they are
;; not all needed.
;; there are at least 3 slots. This hack
;; just adds 3 more.
,(if variable
- '(inst sub rsp-tn (fixnumize 3)))
+ '(inst sub rsp-tn (* 3 n-word-bytes)))
;; Bias the new-fp for use as an fp
,(if variable
- '(inst sub new-fp (fixnumize sp->fp-offset)))
+ '(inst sub new-fp (* sp->fp-offset n-word-bytes)))
;; Save the fp
(storew rbp-tn new-fp
(inst cmp rcx-tn (fixnumize fixed))
(inst jmp :be JUST-ALLOC-FRAME)))
+ ;; Create a negated copy of the number of arguments to allow us to
+ ;; use EA calculations in order to do scaled subtraction.
+ (inst mov temp rcx-tn)
+ (inst neg temp)
+
;; Allocate the space on the stack.
;; stack = rbp + sp->fp-offset - (max 3 frame-size) - (nargs - fixed)
- (inst lea rbx-tn
+ (inst lea rsp-tn
(make-ea :qword :base rbp-tn
+ :index temp :scale (ash 1 (- word-shift n-fixnum-tag-bits))
:disp (* n-word-bytes
(- (+ sp->fp-offset fixed)
(max 3 (sb-allocated-size 'stack))))))
- (inst sub rbx-tn rcx-tn) ; Got the new stack in rbx
- (inst mov rsp-tn rbx-tn)
;; Now: nargs>=1 && nargs>fixed
;; Initialize R8 to be the end of args.
(inst lea source (make-ea :qword :base rbp-tn
+ :index temp :scale (ash 1 (- word-shift n-fixnum-tag-bits))
:disp (* sp->fp-offset n-word-bytes)))
- (inst sub source rbx-tn)
;; We need to copy from downwards up to avoid overwriting some of
;; the yet uncopied args. So we need to use R9 as the copy index
(inst mov temp (make-ea :qword :base source :index copy-index))
(inst mov (make-ea :qword :base rsp-tn :index copy-index) temp)
(inst add copy-index n-word-bytes)
- (inst sub rcx-tn n-word-bytes)
+ (inst sub rcx-tn (fixnumize 1))
(inst jmp :nz COPY-LOOP)
DO-REGS
(keyword :scs (descriptor-reg any-reg)))
(:result-types * *)
(:generator 4
- (inst mov value (make-ea :qword :base object :index index))
+ (inst mov value (make-ea :qword :base object :index index
+ :scale (ash 1 (- word-shift n-fixnum-tag-bits))))
(inst mov keyword (make-ea :qword :base object :index index
+ :scale (ash 1 (- word-shift n-fixnum-tag-bits))
:disp n-word-bytes))))
(define-vop (more-arg)
(:generator 4
(move value index)
(inst neg value)
- (inst mov value (make-ea :qword :base object :index value))))
+ (inst mov value (make-ea :qword :base object :index value
+ :scale (ash 1 (- word-shift n-fixnum-tag-bits))))))
;;; Turn more arg (context, count) into a list.
(define-vop (listify-rest-args)
;; Check to see whether there are no args, and just return NIL if so.
(inst mov result nil-value)
(inst jrcxz done)
- (inst lea dst (make-ea :qword :base rcx :index rcx))
+ (inst lea dst (make-ea :qword :index rcx :scale (ash 2 (- word-shift n-fixnum-tag-bits))))
(maybe-pseudo-atomic stack-allocate-p
(allocation dst dst node stack-allocate-p list-pointer-lowtag)
;; Set decrement mode (successive args at lower addresses)
(inst sub src n-word-bytes)
(storew rax dst 0 list-pointer-lowtag)
;; Go back for more.
- (inst sub rcx n-word-bytes)
+ (inst sub rcx (fixnumize 1))
(inst jmp :nz loop)
;; NIL out the last cons.
(storew nil-value dst 1 list-pointer-lowtag)
;; SP at this point points at the last arg pushed.
;; Point to the first more-arg, not above it.
(inst lea context (make-ea :qword :base rsp-tn
- :index count :scale 1
- :disp (- (+ (fixnumize fixed) n-word-bytes))))
+ :index count
+ :scale (ash 1 (- word-shift n-fixnum-tag-bits))
+ :disp (- (* (1+ fixed) n-word-bytes))))
(unless (zerop fixed)
(inst sub count (fixnumize fixed)))))
;; it is a fixnum. The lowtag selection magic that is required to
;; ensure this is explained in the comment in objdef.lisp
(loadw res symbol symbol-hash-slot other-pointer-lowtag)
- (inst and res (lognot #b111))))
+ (inst and res (lognot fixnum-tag-mask))))
\f
;;;; fdefinition (FDEFN) objects
\f
;;;; raw instance slot accessors
-(defun make-ea-for-raw-slot (object index instance-length
- &optional (adjustment 0))
+(defun make-ea-for-raw-slot (object instance-length
+ &key (index nil) (adjustment 0) (scale 1))
(if (integerp instance-length)
;; For RAW-INSTANCE-INIT/* VOPs, which know the exact instance length
;; at compile time.
(- instance-pointer-lowtag)
adjustment))
(etypecase index
- (tn
- (make-ea :qword :base object :index instance-length
+ (null
+ (make-ea :qword :base object :index instance-length :scale scale
:disp (+ (* (1- instance-slots-offset) n-word-bytes)
(- instance-pointer-lowtag)
adjustment)))
(inst shr tmp n-widetag-bits)
(inst shl tmp n-fixnum-tag-bits)
(inst sub tmp index)
- (inst mov value (make-ea-for-raw-slot object index tmp))))
+ (inst mov value (make-ea-for-raw-slot object tmp :scale (ash 1 (- word-shift n-fixnum-tag-bits))))))
(define-vop (raw-instance-ref-c/word)
(:translate %raw-instance-ref/word)
(:generator 4
(loadw tmp object 0 instance-pointer-lowtag)
(inst shr tmp n-widetag-bits)
- (inst mov value (make-ea-for-raw-slot object index tmp))))
+ (inst mov value (make-ea-for-raw-slot object tmp :index index))))
(define-vop (raw-instance-set/word)
(:translate %raw-instance-set/word)
(inst shr tmp n-widetag-bits)
(inst shl tmp n-fixnum-tag-bits)
(inst sub tmp index)
- (inst mov (make-ea-for-raw-slot object index tmp) value)
+ (inst mov (make-ea-for-raw-slot object tmp :scale (ash 1 (- word-shift n-fixnum-tag-bits))) value)
(move result value)))
(define-vop (raw-instance-set-c/word)
(:generator 4
(loadw tmp object 0 instance-pointer-lowtag)
(inst shr tmp n-widetag-bits)
- (inst mov (make-ea-for-raw-slot object index tmp) value)
+ (inst mov (make-ea-for-raw-slot object tmp :index index) value)
(move result value)))
(define-vop (raw-instance-init/word)
(:arg-types * unsigned-num)
(:info instance-length index)
(:generator 4
- (inst mov (make-ea-for-raw-slot object index instance-length) value)))
+ (inst mov (make-ea-for-raw-slot object instance-length :index index) value)))
(define-vop (raw-instance-atomic-incf-c/word)
(:translate %raw-instance-atomic-incf/word)
(:generator 4
(loadw tmp object 0 instance-pointer-lowtag)
(inst shr tmp n-widetag-bits)
- (inst xadd (make-ea-for-raw-slot object index tmp) diff :lock)
+ (inst xadd (make-ea-for-raw-slot object tmp :index index) diff :lock)
(move result diff)))
(define-vop (raw-instance-ref/single)
(inst shr tmp n-widetag-bits)
(inst shl tmp n-fixnum-tag-bits)
(inst sub tmp index)
- (inst movss value (make-ea-for-raw-slot object index tmp))))
+ (inst movss value (make-ea-for-raw-slot object tmp :scale (ash 1 (- word-shift n-fixnum-tag-bits))))))
(define-vop (raw-instance-ref-c/single)
(:translate %raw-instance-ref/single)
(:generator 4
(loadw tmp object 0 instance-pointer-lowtag)
(inst shr tmp n-widetag-bits)
- (inst movss value (make-ea-for-raw-slot object index tmp))))
+ (inst movss value (make-ea-for-raw-slot object tmp :index index))))
(define-vop (raw-instance-set/single)
(:translate %raw-instance-set/single)
(inst shr tmp n-widetag-bits)
(inst shl tmp n-fixnum-tag-bits)
(inst sub tmp index)
- (inst movss (make-ea-for-raw-slot object index tmp) value)
+ (inst movss (make-ea-for-raw-slot object tmp :scale (ash 1 (- word-shift n-fixnum-tag-bits))) value)
(move result value)))
(define-vop (raw-instance-set-c/single)
(:generator 4
(loadw tmp object 0 instance-pointer-lowtag)
(inst shr tmp n-widetag-bits)
- (inst movss (make-ea-for-raw-slot object index tmp) value)
+ (inst movss (make-ea-for-raw-slot object tmp :index index) value)
(move result value)))
(define-vop (raw-instance-init/single)
(:arg-types * single-float)
(:info instance-length index)
(:generator 4
- (inst movss (make-ea-for-raw-slot object index instance-length) value)))
+ (inst movss (make-ea-for-raw-slot object instance-length :index index) value)))
(define-vop (raw-instance-ref/double)
(:translate %raw-instance-ref/double)
(inst shr tmp n-widetag-bits)
(inst shl tmp n-fixnum-tag-bits)
(inst sub tmp index)
- (inst movsd value (make-ea-for-raw-slot object index tmp))))
+ (inst movsd value (make-ea-for-raw-slot object tmp :scale (ash 1 (- word-shift n-fixnum-tag-bits))))))
(define-vop (raw-instance-ref-c/double)
(:translate %raw-instance-ref/double)
(:generator 4
(loadw tmp object 0 instance-pointer-lowtag)
(inst shr tmp n-widetag-bits)
- (inst movsd value (make-ea-for-raw-slot object index tmp))))
+ (inst movsd value (make-ea-for-raw-slot object tmp :index index))))
(define-vop (raw-instance-set/double)
(:translate %raw-instance-set/double)
(inst shr tmp n-widetag-bits)
(inst shl tmp n-fixnum-tag-bits)
(inst sub tmp index)
- (inst movsd (make-ea-for-raw-slot object index tmp) value)
+ (inst movsd (make-ea-for-raw-slot object tmp :scale (ash 1 (- word-shift n-fixnum-tag-bits))) value)
(move result value)))
(define-vop (raw-instance-set-c/double)
(:generator 4
(loadw tmp object 0 instance-pointer-lowtag)
(inst shr tmp n-widetag-bits)
- (inst movsd (make-ea-for-raw-slot object index tmp) value)
+ (inst movsd (make-ea-for-raw-slot object tmp :index index) value)
(move result value)))
(define-vop (raw-instance-init/double)
(:arg-types * double-float)
(:info instance-length index)
(:generator 4
- (inst movsd (make-ea-for-raw-slot object index instance-length) value)))
+ (inst movsd (make-ea-for-raw-slot object instance-length :index index) value)))
(define-vop (raw-instance-ref/complex-single)
(:translate %raw-instance-ref/complex-single)
(inst shr tmp n-widetag-bits)
(inst shl tmp n-fixnum-tag-bits)
(inst sub tmp index)
- (inst movq value (make-ea-for-raw-slot object index tmp))))
+ (inst movq value (make-ea-for-raw-slot object tmp :scale (ash 1 (- word-shift n-fixnum-tag-bits))))))
(define-vop (raw-instance-ref-c/complex-single)
(:translate %raw-instance-ref/complex-single)
(:generator 4
(loadw tmp object 0 instance-pointer-lowtag)
(inst shr tmp n-widetag-bits)
- (inst movq value (make-ea-for-raw-slot object index tmp))))
+ (inst movq value (make-ea-for-raw-slot object tmp :index index))))
(define-vop (raw-instance-set/complex-single)
(:translate %raw-instance-set/complex-single)
(inst shl tmp n-fixnum-tag-bits)
(inst sub tmp index)
(move result value)
- (inst movq (make-ea-for-raw-slot object index tmp) value)))
+ (inst movq (make-ea-for-raw-slot object tmp :scale (ash 1 (- word-shift n-fixnum-tag-bits))) value)))
(define-vop (raw-instance-set-c/complex-single)
(:translate %raw-instance-set/complex-single)
(loadw tmp object 0 instance-pointer-lowtag)
(inst shr tmp n-widetag-bits)
(move result value)
- (inst movq (make-ea-for-raw-slot object index tmp) value)))
+ (inst movq (make-ea-for-raw-slot object tmp :index index) value)))
(define-vop (raw-instance-init/complex-single)
(:args (object :scs (descriptor-reg))
(:arg-types * complex-single-float)
(:info instance-length index)
(:generator 4
- (inst movq (make-ea-for-raw-slot object index instance-length) value)))
+ (inst movq (make-ea-for-raw-slot object instance-length :index index) value)))
(define-vop (raw-instance-ref/complex-double)
(:translate %raw-instance-ref/complex-double)
(inst shr tmp n-widetag-bits)
(inst shl tmp n-fixnum-tag-bits)
(inst sub tmp index)
- (inst movdqu value (make-ea-for-raw-slot object index tmp -8))))
+ (inst movdqu value (make-ea-for-raw-slot object tmp :scale (ash 1 (- word-shift n-fixnum-tag-bits)) :adjustment -8))))
(define-vop (raw-instance-ref-c/complex-double)
(:translate %raw-instance-ref/complex-double)
(:generator 4
(loadw tmp object 0 instance-pointer-lowtag)
(inst shr tmp n-widetag-bits)
- (inst movdqu value (make-ea-for-raw-slot object index tmp -8))))
+ (inst movdqu value (make-ea-for-raw-slot object tmp :index index :adjustment -8))))
(define-vop (raw-instance-set/complex-double)
(:translate %raw-instance-set/complex-double)
(inst shl tmp n-fixnum-tag-bits)
(inst sub tmp index)
(move result value)
- (inst movdqu (make-ea-for-raw-slot object index tmp -8) value)))
+ (inst movdqu (make-ea-for-raw-slot object tmp :scale (ash 1 (- word-shift n-fixnum-tag-bits)) :adjustment -8) value)))
(define-vop (raw-instance-set-c/complex-double)
(:translate %raw-instance-set/complex-double)
(loadw tmp object 0 instance-pointer-lowtag)
(inst shr tmp n-widetag-bits)
(move result value)
- (inst movdqu (make-ea-for-raw-slot object index tmp -8) value)))
+ (inst movdqu (make-ea-for-raw-slot object tmp :index index :adjustment -8) value)))
(define-vop (raw-instance-init/complex-double)
(:args (object :scs (descriptor-reg))
(:arg-types * complex-double-float)
(:info instance-length index)
(:generator 4
- (inst movdqu (make-ea-for-raw-slot object index instance-length -8) value)))
+ (inst movdqu (make-ea-for-raw-slot object instance-length :index index :adjustment -8) value)))
(move temp offset)
(inst neg temp)
(inst mov result
- (make-ea :qword :base sap :disp (frame-byte-offset 0) :index temp))))
+ (make-ea :qword :base sap :disp (frame-byte-offset 0) :index temp
+ :scale (ash 1 (- word-shift n-fixnum-tag-bits))))))
(define-vop (read-control-stack-c)
(:translate stack-ref)
(move temp offset)
(inst neg temp)
(inst mov
- (make-ea :qword :base sap :disp (frame-byte-offset 0) :index temp)
+ (make-ea :qword :base sap :disp (frame-byte-offset 0) :index temp
+ :scale (ash 1 (- word-shift n-fixnum-tag-bits)))
value)
(move result value)))
(:generator 5
(move rax old-value)
(inst cmpxchg (make-ea :qword :base object :index index
+ :scale (ash 1 (- word-shift n-fixnum-tag-bits))
:disp (- (* ,offset n-word-bytes) ,lowtag))
new-value :lock)
(move value rax)))))
(:result-types ,el-type)
(:generator 3 ; pw was 5
(inst mov value (make-ea :qword :base object :index index
+ :scale (ash 1 (- word-shift n-fixnum-tag-bits))
:disp (- (* ,offset n-word-bytes)
,lowtag)))))
(define-vop (,(symbolicate name "-C"))
(:result-types ,el-type)
(:generator 3 ; pw was 5
(inst mov value (make-ea :qword :base object :index index
+ :scale (ash 1 (- word-shift n-fixnum-tag-bits))
:disp (- (* (+ ,offset offset) n-word-bytes)
,lowtag)))))
(define-vop (,(symbolicate name "-C"))
(:result-types ,el-type)
(:generator 4 ; was 5
(inst mov (make-ea :qword :base object :index index
+ :scale (ash 1 (- word-shift n-fixnum-tag-bits))
:disp (- (* ,offset n-word-bytes) ,lowtag))
value)
(move result value)))
(:result-types ,el-type)
(:generator 4 ; was 5
(inst mov (make-ea :qword :base object :index index
+ :scale (ash 1 (- word-shift n-fixnum-tag-bits))
:disp (- (* (+ ,offset offset) n-word-bytes) ,lowtag))
value)
(move result value)))
(:generator 20
(aver (not (location= x y)))
(let ((done (gen-label)))
- (inst mov y #.(ash lowtag-mask n-positive-fixnum-bits))
+ (inst mov y #.(ash (1- (ash 1 (1+ n-fixnum-tag-bits)))
+ n-positive-fixnum-bits))
;; The assembly routines test the sign flag from this one, so if
;; you change stuff here, make sure the sign flag doesn't get
;; overwritten before the CALL!
(inst sub rdi n-word-bytes)
(move rcx count) ; fixnum words == bytes
(move num rcx)
- (inst shr rcx word-shift) ; word count for <rep movs>
+ (inst shr rcx n-fixnum-tag-bits) ; word count for <rep movs>
;; If we got zero, we be done.
(inst jrcxz DONE)
;; Copy them down.
;; effect of the ENTER with discrete instructions. Takes
;; 3+4+4=11 bytes as opposed to 1+4=5 bytes.
(cond ((policy ,node (>= speed space))
- (inst sub rsp-tn (fixnumize 3))
+ (inst sub rsp-tn (* 3 n-word-bytes))
(inst mov (make-ea :qword :base rsp-tn
:disp (frame-byte-offset
(+ sp->fp-offset
(t
;; Dummy for return address.
(inst push rbp-tn)
- (inst enter (fixnumize 1))))
+ (inst enter n-word-bytes)))
,(if (zerop num-args)
'(inst xor ecx ecx)
(inst cmp al-tn fun-pointer-lowtag)
(inst jmp :e FUNCTION-PTR)
- ;; Pick off structures and list pointers.
- (inst test al-tn 1)
- (inst jmp :ne DONE)
-
;; Pick off fixnums.
- (inst and al-tn fixnum-tag-mask)
+ (inst test al-tn fixnum-tag-mask)
(inst jmp :e DONE)
+ ;; Pick off structures and list pointers.
+ (inst test al-tn 2)
+ (inst jmp :ne DONE)
+
;; must be an other immediate
(inst mov rax object)
(inst jmp DONE)
DONE
(inst mov count start) ; start is high address
- (inst sub count rsp-tn))) ; stackp is low address
+ (inst sub count rsp-tn) ; stackp is low address
+ #!-#.(cl:if (cl:= sb!vm:word-shift sb!vm:n-fixnum-tag-bits) '(and) '(or))
+ (inst shr count (- word-shift n-fixnum-tag-bits))))
;;; Copy the more arg block to the top of the stack so we can use them
;;; as function arguments.
(any-reg
(move src context)
+ #!+#.(cl:if (cl:= sb!vm:word-shift sb!vm:n-fixnum-tag-bits) '(and) '(or))
(inst sub src skip)
+ #!-#.(cl:if (cl:= sb!vm:word-shift sb!vm:n-fixnum-tag-bits) '(and) '(or))
+ (progn
+ ;; FIXME: This can't be efficient, but LEA (my first choice)
+ ;; doesn't do subtraction.
+ (inst shl skip (- word-shift n-fixnum-tag-bits))
+ (inst sub src skip)
+ (inst shr skip (- word-shift n-fixnum-tag-bits)))
(move count num)
(inst sub count skip)))
- (move loop-index count)
+ (inst lea loop-index (make-ea :byte :index count
+ :scale (ash 1 (- word-shift n-fixnum-tag-bits))))
(inst mov start rsp-tn)
(inst jrcxz DONE) ; check for 0 count?
- (inst sub rsp-tn count)
- (inst sub src count)
+ (inst sub rsp-tn loop-index)
+ (inst sub src loop-index)
LOOP
(inst mov temp (make-ea :qword :base src :index loop-index))
xor %rdx,%rdx # clear any descriptor registers
xor %rdi,%rdi # that we can't be sure we'll
xor %rsi,%rsi # initialise properly. XX do r8-r15 too?
- shl $3,%rcx # (fixnumize num-args)
+ shl $N_FIXNUM_TAG_BITS,%rcx # (fixnumize num-args)
cmp $0,%rcx
je Ldone
mov 0(%rbx),%rdx # arg0
projects / sbcl.git / commitdiff