(:generator 1
(move esp-tn ptr)))
+(define-vop (%%nip-values)
+ (:args (last-nipped-ptr :scs (any-reg) :target edi)
+ (last-preserved-ptr :scs (any-reg) :target esi)
+ (moved-ptrs :scs (any-reg) :more t))
+ (:results (r-moved-ptrs :scs (any-reg) :more t)
+ ;; same as MOVED-PTRS
+ )
+ (:temporary (:sc any-reg :offset esi-offset) esi)
+ (:temporary (:sc any-reg :offset edi-offset) edi)
+ (:ignore r-moved-ptrs)
+ (:generator 1
+ (move edi last-nipped-ptr)
+ (move esi last-preserved-ptr)
+ (inst sub esi n-word-bytes)
+ (inst sub edi n-word-bytes)
+ (inst cmp esp-tn esi)
+ (inst jmp :a done)
+ (inst std)
+ LOOP
+ (inst movs :dword)
+ (inst cmp esp-tn esi)
+ (inst jmp :be loop)
+ DONE
+ ;; solaris requires DF being zero.
+ #!+sunos (inst cld)
+ (inst lea esp-tn (make-ea :dword :base edi :disp n-word-bytes))
+ (inst sub edi esi)
+ (loop for moved = moved-ptrs then (tn-ref-across moved)
+ while moved
+ do (inst add (tn-ref-tn moved) edi))))
+
;;; Push some values onto the stack, returning the start and number of values
;;; pushed as results. It is assumed that the Vals are wired to the standard
;;; argument locations. Nvals is the number of values to push.
(:results (start) (count))
(:info nvals)
(:generator 20
- (move temp esp-tn) ; WARN pointing 1 below
+ (move temp esp-tn) ; WARN pointing 1 below
(do ((val vals (tn-ref-across val)))
- ((null val))
+ ((null val))
(inst push (tn-ref-tn val)))
(move start temp)
(inst mov count (fixnumize nvals))))
(:arg-types list)
(:policy :fast-safe)
(:results (start :scs (any-reg))
- (count :scs (any-reg)))
+ (count :scs (any-reg)))
(:temporary (:sc descriptor-reg :from (:argument 0) :to (:result 1)) list)
(:temporary (:sc descriptor-reg :to (:result 1)) nil-temp)
(:temporary (:sc unsigned-reg :offset eax-offset :to (:result 1)) eax)
(:save-p :compute-only)
(:generator 0
(move list arg)
- (move start esp-tn) ; WARN pointing 1 below
+ (move start esp-tn) ; WARN pointing 1 below
(inst mov nil-temp nil-value)
LOOP
(inst and al-tn lowtag-mask)
(inst cmp al-tn list-pointer-lowtag)
(inst jmp :e loop)
- (error-call vop bogus-argument-to-values-list-error list)
+ (error-call vop bogus-arg-to-values-list-error list)
DONE
- (inst mov count start) ; start is high address
- (inst sub count esp-tn))) ; stackp is low address
+ (inst mov count start) ; start is high address
+ (inst sub count esp-tn))) ; stackp is low address
;;; Copy the more arg block to the top of the stack so we can use them
;;; as function arguments.
;;; defining a new stack frame.
(define-vop (%more-arg-values)
(:args (context :scs (descriptor-reg any-reg) :target src)
- (skip :scs (any-reg immediate))
- (num :scs (any-reg) :target count))
+ (skip :scs (any-reg immediate))
+ (num :scs (any-reg) :target count))
(:arg-types * positive-fixnum positive-fixnum)
(:temporary (:sc any-reg :offset esi-offset :from (:argument 0)) src)
(:temporary (:sc descriptor-reg :offset eax-offset) temp)
- (:temporary (:sc unsigned-reg :offset ecx-offset) temp1)
+ (:temporary (:sc unsigned-reg :offset ecx-offset) loop-index)
(:results (start :scs (any-reg))
- (count :scs (any-reg)))
+ (count :scs (any-reg)))
(:generator 20
(sc-case skip
(immediate
(cond ((zerop (tn-value skip))
- (move src context)
- (move count num))
- (t
- (inst lea src (make-ea :dword :base context
- :disp (- (* (tn-value skip)
- n-word-bytes))))
- (move count num)
- (inst sub count (* (tn-value skip) n-word-bytes)))))
+ (move src context)
+ (move count num))
+ (t
+ (inst lea src (make-ea :dword :base context
+ :disp (- (* (tn-value skip)
+ n-word-bytes))))
+ (move count num)
+ (inst sub count (* (tn-value skip) n-word-bytes)))))
(any-reg
(move src context)
(move count num)
(inst sub count skip)))
- (move temp1 count)
+ (move loop-index count)
(inst mov start esp-tn)
(inst jecxz done) ; check for 0 count?
- (inst shr temp1 word-shift) ; convert the fixnum to a count.
+ (inst sub esp-tn count)
+ (inst sub src count)
- (inst std) ; move down the stack as more value are copied to the bottom.
LOOP
- (inst lods temp)
- (inst push temp)
- (inst loop loop)
+ (inst mov temp (make-ea :dword :base src :index loop-index))
+ (inst sub loop-index n-word-bytes)
+ (inst mov (make-ea :dword :base esp-tn :index loop-index) temp)
+ (inst jmp :nz LOOP)
- DONE))
+ DONE
+ ;; solaris requires DF being zero.
+ #!+sunos (inst cld)))