2 ;;; Written by Rob MacLachlan
4 ;;; Converted for SPARC by William Lott.
9 (define-vop (reset-stack-pointer)
10 (:args (ptr :scs (any-reg)))
14 (define-vop (%%pop-dx)
15 (:args (ptr :scs (any-reg)))
18 (bug "VOP %%POP-DX is not implemented.")))
20 (define-vop (%%nip-dx)
21 (:args (last-nipped-ptr :scs (any-reg) :target dest)
22 (last-preserved-ptr :scs (any-reg) :target src)
23 (moved-ptrs :scs (any-reg) :more t))
24 (:results (r-moved-ptrs :scs (any-reg) :more t))
25 (:temporary (:sc any-reg) src)
26 (:temporary (:sc any-reg) dest)
27 (:temporary (:sc non-descriptor-reg) temp)
29 last-nipped-ptr last-preserved-ptr moved-ptrs
32 (bug "VOP %%NIP-DX is not implemented.")))
34 ;;; sparc version translated to ppc by David Steuber with help from #lisp.
35 (define-vop (%%nip-values)
36 (:args (last-nipped-ptr :scs (any-reg) :target dest)
37 (last-preserved-ptr :scs (any-reg) :target src)
38 (moved-ptrs :scs (any-reg) :more t))
39 (:results (r-moved-ptrs :scs (any-reg) :more t))
40 (:temporary (:sc any-reg) src)
41 (:temporary (:sc any-reg) dest)
42 (:temporary (:sc non-descriptor-reg) temp)
43 (:ignore r-moved-ptrs)
45 (inst mr dest last-nipped-ptr)
46 (inst mr src last-preserved-ptr)
47 (inst cmplw csp-tn src)
51 (inst addi dest dest n-word-bytes)
52 (inst addi src src n-word-bytes)
54 (inst cmplw csp-tn src)
58 (inst sub src src dest)
59 (loop for moved = moved-ptrs then (tn-ref-across moved)
61 do (sc-case (tn-ref-tn moved)
62 ((descriptor-reg any-reg)
63 (inst sub (tn-ref-tn moved) (tn-ref-tn moved) src))
65 (load-stack-tn temp (tn-ref-tn moved))
66 (inst sub temp temp src)
67 (store-stack-tn (tn-ref-tn moved) temp))))))
70 ;;; Push some values onto the stack, returning the start and number of values
71 ;;; pushed as results. It is assumed that the Vals are wired to the standard
72 ;;; argument locations. Nvals is the number of values to push.
74 ;;; The generator cost is pseudo-random. We could get it right by defining a
75 ;;; bogus SC that reflects the costs of the memory-to-memory moves for each
76 ;;; operand, but this seems unworthwhile.
78 (define-vop (push-values)
79 (:args (vals :more t))
80 (:results (start :scs (any-reg) :from :load)
81 (count :scs (any-reg)))
83 (:temporary (:scs (descriptor-reg)) temp)
85 (inst mr start csp-tn)
86 (inst addi csp-tn csp-tn (* nvals n-word-bytes))
87 (do ((val vals (tn-ref-across val))
90 (let ((tn (tn-ref-tn val)))
95 (load-stack-tn temp tn)
96 (storew temp start i)))))
97 (inst lr count (fixnumize nvals))))
99 ;;; Push a list of values on the stack, returning Start and Count as used in
100 ;;; unknown values continuations.
102 (define-vop (values-list)
103 (:args (arg :scs (descriptor-reg) :target list))
106 (:results (start :scs (any-reg))
107 (count :scs (any-reg)))
108 (:temporary (:scs (descriptor-reg) :type list :from (:argument 0)) list)
109 (:temporary (:scs (descriptor-reg)) temp)
110 (:temporary (:scs (non-descriptor-reg)) ndescr)
112 (:save-p :compute-only)
114 (let ((loop (gen-label))
121 (inst cmpw list null-tn)
122 (loadw temp list cons-car-slot list-pointer-lowtag)
124 (loadw list list cons-cdr-slot list-pointer-lowtag)
125 (inst addi csp-tn csp-tn n-word-bytes)
126 (storew temp csp-tn -1)
127 (test-type list loop nil (list-pointer-lowtag) :temp ndescr)
128 (error-call vop bogus-arg-to-values-list-error list)
131 (inst sub count csp-tn start))))
134 ;;; Copy the more arg block to the top of the stack so we can use them
135 ;;; as function arguments.
137 (define-vop (%more-arg-values)
138 (:args (context :scs (descriptor-reg any-reg) :target src)
139 (skip :scs (any-reg zero immediate))
140 (num :scs (any-reg) :target count))
141 (:arg-types * positive-fixnum positive-fixnum)
142 (:temporary (:sc any-reg :from (:argument 0)) src)
143 (:temporary (:sc any-reg :from (:argument 2)) dst)
144 (:temporary (:sc descriptor-reg :from (:argument 1)) temp)
145 (:temporary (:sc any-reg) i)
146 (:results (start :scs (any-reg))
147 (count :scs (any-reg)))
151 (inst mr src context))
153 (inst addi src context (* (tn-value skip) n-word-bytes)))
155 (inst add src context skip)))
157 (inst mr start csp-tn)
160 (inst add csp-tn csp-tn count)
165 (inst lwzx temp src i)
166 (inst stwx temp dst i)