1 ;;;; unknown-values VOPs for the x86 VM
3 ;;;; This software is part of the SBCL system. See the README file for
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.
14 (define-vop (reset-stack-pointer)
15 (:args
(ptr :scs
(any-reg)))
19 (define-vop (%%nip-values
)
20 (:args
(last-nipped-ptr :scs
(any-reg) :target rdi
)
21 (last-preserved-ptr :scs
(any-reg) :target rsi
)
22 (moved-ptrs :scs
(any-reg) :more t
))
23 (:results
(r-moved-ptrs :scs
(any-reg) :more t
)
26 (:temporary
(:sc any-reg
:offset rsi-offset
) rsi
)
27 (:temporary
(:sc any-reg
:offset rdi-offset
) rdi
)
28 (:ignore r-moved-ptrs
)
30 (move rdi last-nipped-ptr
)
31 (move rsi last-preserved-ptr
)
32 (inst sub rsi n-word-bytes
)
33 (inst sub rdi n-word-bytes
)
42 (inst lea rsp-tn
(make-ea :qword
:base rdi
:disp n-word-bytes
))
44 (loop for moved
= moved-ptrs then
(tn-ref-across moved
)
46 do
(inst add
(tn-ref-tn moved
) rdi
))))
48 ;;; Push some values onto the stack, returning the start and number of values
49 ;;; pushed as results. It is assumed that the Vals are wired to the standard
50 ;;; argument locations. Nvals is the number of values to push.
52 ;;; The generator cost is pseudo-random. We could get it right by defining a
53 ;;; bogus SC that reflects the costs of the memory-to-memory moves for each
54 ;;; operand, but this seems unworthwhile.
55 (define-vop (push-values)
56 (:args
(vals :more t
))
57 (:temporary
(:sc unsigned-reg
:to
(:result
0) :target start
) temp
)
58 (:results
(start) (count))
61 (move temp rsp-tn
) ; WARN pointing 1 below
62 (do ((val vals
(tn-ref-across val
)))
64 (inst push
(tn-ref-tn val
)))
66 (inst mov count
(fixnumize nvals
))))
68 ;;; Push a list of values on the stack, returning Start and Count as used in
69 ;;; unknown values continuations.
70 (define-vop (values-list)
71 (:args
(arg :scs
(descriptor-reg) :target list
))
74 (:results
(start :scs
(any-reg))
75 (count :scs
(any-reg)))
76 (:temporary
(:sc descriptor-reg
:from
(:argument
0) :to
(:result
1)) list
)
77 (:temporary
(:sc descriptor-reg
:to
(:result
1)) nil-temp
)
78 (:temporary
(:sc unsigned-reg
:offset rax-offset
:to
(:result
1)) rax
)
80 (:save-p
:compute-only
)
83 (move start rsp-tn
) ; WARN pointing 1 below
84 (inst mov nil-temp nil-value
)
87 (inst cmp list nil-temp
)
89 (pushw list cons-car-slot list-pointer-lowtag
)
90 (loadw list list cons-cdr-slot list-pointer-lowtag
)
92 (inst and al-tn lowtag-mask
)
93 (inst cmp al-tn list-pointer-lowtag
)
95 (error-call vop bogus-arg-to-values-list-error list
)
98 (inst mov count start
) ; start is high address
99 (inst sub count rsp-tn
))) ; stackp is low address
101 ;;; Copy the more arg block to the top of the stack so we can use them
102 ;;; as function arguments.
104 ;;; Accepts a context as produced by more-arg-context; points to the first
105 ;;; value on the stack, not 4 bytes above as in other contexts.
107 ;;; Return a context that is 4 bytes above the first value, suitable for
108 ;;; defining a new stack frame.
109 (define-vop (%more-arg-values
)
110 (:args
(context :scs
(descriptor-reg any-reg
) :target src
)
111 (skip :scs
(any-reg immediate
))
112 (num :scs
(any-reg) :target count
))
113 (:arg-types
* positive-fixnum positive-fixnum
)
114 (:temporary
(:sc any-reg
:offset rsi-offset
:from
(:argument
0)) src
)
115 (:temporary
(:sc descriptor-reg
:offset rax-offset
) temp
)
116 (:temporary
(:sc unsigned-reg
:offset rcx-offset
) loop-index
)
117 (:results
(start :scs
(any-reg))
118 (count :scs
(any-reg)))
122 (cond ((zerop (tn-value skip
))
126 (inst lea src
(make-ea :dword
:base context
127 :disp
(- (* (tn-value skip
)
130 (inst sub count
(* (tn-value skip
) n-word-bytes
)))))
136 (inst sub count skip
)))
138 (move loop-index count
)
139 (inst mov start rsp-tn
)
140 (inst jecxz DONE
) ; check for 0 count?
142 (inst sub rsp-tn count
)
146 (inst mov temp
(make-ea :qword
:base src
:index loop-index
))
147 (inst sub loop-index n-word-bytes
)
148 (inst mov
(make-ea :qword
:base rsp-tn
:index loop-index
) temp
)