X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86%2Fvalues.lisp;h=082ad2c6b074ad71a83cef04abc2d37830392f1c;hb=a6b91f356da1b5ae2987f79db9bd137970512959;hp=6c68c32fa31198d949bc264fa73d72761c56f679;hpb=cea4896b2482b7b2b429c1631d774b4cfbc0efba;p=sbcl.git diff --git a/src/compiler/x86/values.lisp b/src/compiler/x86/values.lisp index 6c68c32..082ad2c 100644 --- a/src/compiler/x86/values.lisp +++ b/src/compiler/x86/values.lisp @@ -16,6 +16,36 @@ (: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) + (inst cld) + DONE + (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. @@ -29,9 +59,9 @@ (: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)))) @@ -43,7 +73,7 @@ (: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) @@ -51,23 +81,23 @@ (: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 cmp list nil-temp) (inst jmp :e done) - (pushw list cons-car-slot list-pointer-type) - (loadw list list cons-cdr-slot list-pointer-type) + (pushw list cons-car-slot list-pointer-lowtag) + (loadw list list cons-cdr-slot list-pointer-lowtag) (inst mov eax list) (inst and al-tn lowtag-mask) - (inst cmp al-tn list-pointer-type) + (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. @@ -79,25 +109,26 @@ ;;; 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) word-bytes)))) - (move count num) - (inst sub count (* (tn-value skip) 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) @@ -105,17 +136,19 @@ (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 + ))