;;; Return a wired TN describing the N'th full call argument passing
;;; location.
-(!def-vm-support-routine standard-arg-location (n)
+(defun standard-arg-location (n)
(declare (type unsigned-byte n))
(if (< n register-arg-count)
(make-wired-tn *backend-t-primitive-type* descriptor-reg-sc-number
;;;
;;; Always wire the return PC location to the stack in its standard
;;; location.
-(!def-vm-support-routine make-return-pc-passing-location (standard)
+(defun make-return-pc-passing-location (standard)
(declare (ignore standard))
(make-wired-tn (primitive-type-or-lose 'system-area-pointer)
sap-stack-sc-number return-pc-save-offset))
;;; because we want to be able to assume it's always there. Besides,
;;; the x86 doesn't have enough registers to really make it profitable
;;; to pass it in a register.
-(!def-vm-support-routine make-old-fp-passing-location (standard)
+(defun make-old-fp-passing-location (standard)
(declare (ignore standard))
(make-wired-tn *fixnum-primitive-type* control-stack-sc-number
ocfp-save-offset))
;;;
;;; Without using a save-tn - which does not make much sense if it is
;;; wired to the stack?
-(!def-vm-support-routine make-old-fp-save-location (physenv)
+(defun make-old-fp-save-location (physenv)
(physenv-debug-live-tn (make-wired-tn *fixnum-primitive-type*
control-stack-sc-number
ocfp-save-offset)
physenv))
-(!def-vm-support-routine make-return-pc-save-location (physenv)
+(defun make-return-pc-save-location (physenv)
(physenv-debug-live-tn
(make-wired-tn (primitive-type-or-lose 'system-area-pointer)
sap-stack-sc-number return-pc-save-offset)
;;; Make a TN for the standard argument count passing location. We only
;;; need to make the standard location, since a count is never passed when we
;;; are using non-standard conventions.
-(!def-vm-support-routine make-arg-count-location ()
+(defun make-arg-count-location ()
(make-wired-tn *fixnum-primitive-type* any-reg-sc-number rcx-offset))
;;; Make a TN to hold the number-stack frame pointer. This is allocated
;;; once per component, and is component-live.
-(!def-vm-support-routine make-nfp-tn ()
+(defun make-nfp-tn ()
(make-restricted-tn *fixnum-primitive-type* ignore-me-sc-number))
-(!def-vm-support-routine make-stack-pointer-tn ()
+(defun make-stack-pointer-tn ()
(make-normal-tn *fixnum-primitive-type*))
-(!def-vm-support-routine make-number-stack-pointer-tn ()
+(defun make-number-stack-pointer-tn ()
(make-restricted-tn *fixnum-primitive-type* ignore-me-sc-number))
;;; Return a list of TNs that can be used to represent an unknown-values
;;; continuation within a function.
-(!def-vm-support-routine make-unknown-values-locations ()
+(defun make-unknown-values-locations ()
(list (make-stack-pointer-tn)
(make-normal-tn *fixnum-primitive-type*)))
;;; VM-dependent initialization of the IR2-COMPONENT structure. We
;;; push placeholder entries in the CONSTANTS to leave room for
;;; additional noise in the code object header.
-(!def-vm-support-routine select-component-format (component)
+(defun select-component-format (component)
(declare (type component component))
- ;; The 1+ here is because for the x86 the first constant is a
- ;; pointer to a list of fixups, or NIL if the code object has none.
- ;; (If I understand correctly, the fixups are needed at GC copy
- ;; time because the X86 code isn't relocatable.)
- ;;
- ;; KLUDGE: It'd be cleaner to have the fixups entry be a named
- ;; element of the CODE (aka component) primitive object. However,
- ;; it's currently a large, tricky, error-prone chore to change
- ;; the layout of any primitive object, so for the foreseeable future
- ;; we'll just live with this ugliness. -- WHN 2002-01-02
- (dotimes (i (1+ code-constants-offset))
+ (dotimes (i code-constants-offset)
(vector-push-extend nil
(ir2-component-constants (component-info component))))
(values))
: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
(emit-label trampoline-label)
(popw rbp-tn (frame-word-offset return-pc-save-offset)))
(when alignp
- (emit-alignment n-lowtag-bits #x90))
+ (emit-alignment n-lowtag-bits :long-nop))
(emit-label start-label))
;;; Non-TR local call for a fixed number of values passed according to
;; 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
(move rsi args)
(move rax function)
;; And jump to the assembly routine.
- (inst lea call-target
- (make-ea :qword
- :disp (make-fixup 'tail-call-variable :assembly-routine)))
+ (inst mov call-target (make-fixup 'tail-call-variable :assembly-routine))
(inst jmp call-target)))
\f
;;;; unknown values return
(emit-label not-single)))
(move rsi vals)
(move rcx nvals)
- (inst lea return-asm
- (make-ea :qword :disp (make-fixup 'return-multiple
- :assembly-routine)))
+ (inst mov return-asm (make-fixup 'return-multiple :assembly-routine))
(inst jmp return-asm)
(trace-table-entry trace-table-normal)))
\f
(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
;; We must stop when we run out of stack args, not when we
;; run out of more args.
;; Number to copy = nargs-3
- (inst sub rcx-tn (fixnumize register-arg-count))
+ (inst sub rbx-tn (fixnumize register-arg-count))
;; Everything of interest in registers.
(inst jmp :be DO-REGS))
(t
;; Number to copy = nargs-fixed
- (inst sub rcx-tn (fixnumize fixed))))
+ (inst sub rbx-tn (fixnumize 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
- ;; and RCX as the loop counter, rather than using RCX for both.
+ ;; and RBX as the loop counter, rather than using RBX for both.
(zeroize copy-index)
;; We used to use REP MOVS here, but on modern x86 it performs
(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 rbx-tn (fixnumize 1))
(inst jmp :nz COPY-LOOP)
DO-REGS
- ;; Restore RCX
- (inst mov rcx-tn rbx-tn)
-
;; Here: nargs>=1 && nargs>fixed
(when (< fixed register-arg-count)
;; Now we have to deposit any more args that showed up in
(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)
- (:translate sb!c::%more-arg)
+ (:translate sb!c::%more-arg)
(:policy :fast-safe)
(:args (object :scs (descriptor-reg) :to (:result 1))
(index :scs (any-reg) :to (:result 1) :target value))
(: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 std)
;; Set up the result.
(move result dst)
;; Jump into the middle of the loop, 'cause that's where we want
(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)
- (inst cld))
+ (storew nil-value dst 1 list-pointer-lowtag))
(emit-label done))))
;;; Return the location and size of the &MORE arg glob created by
;; 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)))))
projects / sbcl.git / blobdiff