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