1;;;; unknown-values VOPs for the x86 VM 2 3;;;; This software is part of the SBCL system. See the README file for 4;;;; more information. 5;;;; 6;;;; This software is derived from the CMU CL system, which was 7;;;; written at Carnegie Mellon University and released into the 8;;;; public domain. The software is in the public domain and is 9;;;; provided with absolutely no warranty. See the COPYING and CREDITS 10;;;; files for more information. 11 12(in-package "SB!VM") 13 14(define-vop (reset-stack-pointer) 15 (:args (ptr :scs (any-reg))) 16 (:generator 1 17 (move esp-tn ptr))) 18 19(define-vop (%%nip-values) 20 (:args (last-nipped-ptr :scs (any-reg) :target edi) 21 (last-preserved-ptr :scs (any-reg) :target esi) 22 (moved-ptrs :scs (any-reg) :more t)) 23 (:results (r-moved-ptrs :scs (any-reg) :more t) 24 ;; same as MOVED-PTRS 25 ) 26 (:temporary (:sc any-reg :offset esi-offset) esi) 27 (:temporary (:sc any-reg :offset edi-offset) edi) 28 (:ignore r-moved-ptrs) 29 (:generator 1 30 (move edi last-nipped-ptr) 31 (move esi last-preserved-ptr) 32 (inst sub esi n-word-bytes) 33 (inst sub edi n-word-bytes) 34 (inst cmp esp-tn esi) 35 (inst jmp :a done) 36 (inst std) 37 LOOP 38 (inst movs :dword) 39 (inst cmp esp-tn esi) 40 (inst jmp :be loop) 41 (inst cld) 42 DONE 43 (inst lea esp-tn (make-ea :dword :base edi :disp n-word-bytes)) 44 (inst sub edi esi) 45 (loop for moved = moved-ptrs then (tn-ref-across moved) 46 while moved 47 do (inst add (tn-ref-tn moved) edi)))) 48 49;;; Push some values onto the stack, returning the start and number of values 50;;; pushed as results. It is assumed that the Vals are wired to the standard 51;;; argument locations. Nvals is the number of values to push. 52;;; 53;;; The generator cost is pseudo-random. We could get it right by defining a 54;;; bogus SC that reflects the costs of the memory-to-memory moves for each 55;;; operand, but this seems unworthwhile. 56(define-vop (push-values) 57 (:args (vals :more t)) 58 (:temporary (:sc unsigned-reg :to (:result 0) :target start) temp) 59 (:results (start) (count)) 60 (:info nvals) 61 (:generator 20 62 (move temp esp-tn) ; WARN pointing 1 below 63 (do ((val vals (tn-ref-across val))) 64 ((null val)) 65 (inst push (tn-ref-tn val))) 66 (move start temp) 67 (inst mov count (fixnumize nvals)))) 68 69;;; Push a list of values on the stack, returning Start and Count as used in 70;;; unknown values continuations. 71(define-vop (values-list) 72 (:args (arg :scs (descriptor-reg) :target list)) 73 (:arg-types list) 74 (:policy :fast-safe) 75 (:results (start :scs (any-reg)) 76 (count :scs (any-reg))) 77 (:temporary (:sc descriptor-reg :from (:argument 0) :to (:result 1)) list) 78 (:temporary (:sc descriptor-reg :to (:result 1)) nil-temp) 79 (:temporary (:sc unsigned-reg :offset eax-offset :to (:result 1)) eax) 80 (:vop-var vop) 81 (:save-p :compute-only) 82 (:generator 0 83 (move list arg) 84 (move start esp-tn) ; WARN pointing 1 below 85 (inst mov nil-temp nil-value) 86 87 LOOP 88 (inst cmp list nil-temp) 89 (inst jmp :e done) 90 (pushw list cons-car-slot list-pointer-lowtag) 91 (loadw list list cons-cdr-slot list-pointer-lowtag) 92 (inst mov eax list) 93 (inst and al-tn lowtag-mask) 94 (inst cmp al-tn list-pointer-lowtag) 95 (inst jmp :e loop) 96 (error-call vop 'bogus-arg-to-values-list-error list) 97 98 DONE 99 (inst mov count start) ; start is high address 100 (inst sub count esp-tn))) ; stackp is low address 101 102;;; Copy the more arg block to the top of the stack so we can use them 103;;; as function arguments. 104;;; 105;;; Accepts a context as produced by more-arg-context; points to the first 106;;; value on the stack, not 4 bytes above as in other contexts. 107;;; 108;;; Return a context that is 4 bytes above the first value, suitable for 109;;; defining a new stack frame. 110(define-vop (%more-arg-values) 111 (:args (context :scs (descriptor-reg any-reg) :target src) 112 (skip :scs (any-reg immediate)) 113 (num :scs (any-reg) :target count)) 114 (:arg-types * positive-fixnum positive-fixnum) 115 (:temporary (:sc any-reg :offset esi-offset :from (:argument 0)) src) 116 (:temporary (:sc descriptor-reg :offset eax-offset) temp) 117 (:temporary (:sc unsigned-reg :offset ecx-offset) loop-index) 118 (:results (start :scs (any-reg)) 119 (count :scs (any-reg))) 120 (:generator 20 121 (sc-case skip 122 (immediate 123 (if (zerop (tn-value skip)) 124 (move src context) 125 (inst lea src (make-ea :dword :base context 126 :disp (- (* (tn-value skip) 127 n-word-bytes)))))) 128 (any-reg 129 (move src context) 130 (inst sub src skip))) 131 (move count num) 132 133 (move loop-index count) 134 (inst mov start esp-tn) 135 (inst jecxz done) ; check for 0 count? 136 137 (inst sub esp-tn count) 138 (inst sub src count) 139 140 LOOP 141 (inst mov temp (make-ea :dword :base src :index loop-index)) 142 (inst sub loop-index n-word-bytes) 143 (inst mov (make-ea :dword :base esp-tn :index loop-index) temp) 144 (inst jmp :nz LOOP) 145 146 DONE 147 )) 148 149