1 ;;;; the MIPS implementation of unknown-values VOPs
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 (%%pop-dx)
20 (:args (ptr :scs (any-reg)))
23 (bug "VOP %%POP-DX is not implemented.")))
25 (define-vop (%%nip-dx)
26 (:args (last-nipped-ptr :scs (any-reg) :target dest)
27 (last-preserved-ptr :scs (any-reg) :target src)
28 (moved-ptrs :scs (any-reg) :more t))
29 (:results (r-moved-ptrs :scs (any-reg) :more t))
30 (:temporary (:sc any-reg) src)
31 (:temporary (:sc any-reg) dest)
32 (:temporary (:sc non-descriptor-reg) temp)
34 last-nipped-ptr last-preserved-ptr moved-ptrs
37 (bug "VOP %%NIP-DX is not implemented.")))
39 (define-vop (%%nip-values)
40 (:args (last-nipped-ptr :scs (any-reg) :target dest)
41 (last-preserved-ptr :scs (any-reg) :target src)
42 (moved-ptrs :scs (any-reg) :more t))
43 (:results (r-moved-ptrs :scs (any-reg) :more t))
44 (:temporary (:sc any-reg) src)
45 (:temporary (:sc any-reg) dest)
46 (:temporary (:sc non-descriptor-reg) temp)
47 (:ignore r-moved-ptrs)
49 (move src last-preserved-ptr)
50 (move dest last-nipped-ptr)
52 (inst sltu temp src csp-tn)
53 (inst beq temp zero-tn DONE)
54 (inst nop) ; not strictly necessary
57 (inst add dest dest n-word-bytes)
58 (inst add src src n-word-bytes)
60 (inst sltu temp src csp-tn)
61 (inst bne temp zero-tn LOOP)
65 (inst sub src src dest)
66 (loop for moved = moved-ptrs then (tn-ref-across moved)
68 do (sc-case (tn-ref-tn moved)
69 ((descriptor-reg any-reg)
70 (inst sub (tn-ref-tn moved) (tn-ref-tn moved) src))
72 (load-stack-tn temp (tn-ref-tn moved))
73 (inst sub temp temp src)
74 (store-stack-tn (tn-ref-tn moved) temp))))))
76 ;;; Push some values onto the stack, returning the start and number of values
77 ;;; pushed as results. It is assumed that the Vals are wired to the standard
78 ;;; argument locations. Nvals is the number of values to push.
80 ;;; The generator cost is pseudo-random. We could get it right by defining a
81 ;;; bogus SC that reflects the costs of the memory-to-memory moves for each
82 ;;; operand, but this seems unworthwhile.
84 (define-vop (push-values)
88 (start :scs (any-reg))
89 (count :scs (any-reg)))
91 (:temporary (:scs (descriptor-reg)) temp)
92 (:temporary (:scs (descriptor-reg)
97 (move start-temp csp-tn)
98 (inst addu csp-tn csp-tn (* nvals n-word-bytes))
99 (do ((val vals (tn-ref-across val))
102 (let ((tn (tn-ref-tn val)))
105 (storew tn start-temp i))
107 (load-stack-tn temp tn)
108 (storew temp start-temp i)))))
109 (move start start-temp)
110 (inst li count (fixnumize nvals))))
112 ;;; Push a list of values on the stack, returning Start and Count as used in
113 ;;; unknown values continuations.
114 (define-vop (values-list)
115 (:args (arg :scs (descriptor-reg) :target list))
118 (:results (start :scs (any-reg))
119 (count :scs (any-reg)))
120 (:temporary (:scs (descriptor-reg) :type list :from (:argument 0)) list)
121 (:temporary (:scs (descriptor-reg)) temp)
122 (:temporary (:scs (non-descriptor-reg)) ndescr)
124 (:save-p :compute-only)
130 (inst beq list null-tn done)
131 (loadw temp list cons-car-slot list-pointer-lowtag)
132 (loadw list list cons-cdr-slot list-pointer-lowtag)
133 (inst addu csp-tn csp-tn n-word-bytes)
134 (storew temp csp-tn -1)
135 (inst and ndescr list lowtag-mask)
136 (inst xor ndescr list-pointer-lowtag)
137 (inst beq ndescr zero-tn loop)
139 (error-call vop bogus-arg-to-values-list-error list)
142 (inst subu count csp-tn start)))
144 ;;; Copy the more arg block to the top of the stack so we can use them
145 ;;; as function arguments.
146 (define-vop (%more-arg-values)
147 (:args (context :scs (descriptor-reg any-reg) :target src)
148 (skip :scs (any-reg zero immediate))
149 (num :scs (any-reg) :target count))
150 (:arg-types * positive-fixnum positive-fixnum)
151 (:temporary (:sc any-reg :from (:argument 0)) src)
152 (:temporary (:sc any-reg :from (:argument 2)) dst)
153 (:temporary (:sc descriptor-reg :from (:argument 1)) temp)
154 (:results (start :scs (any-reg))
155 (count :scs (any-reg)))
161 (inst addu src context (* (tn-value skip) n-word-bytes)))
163 (inst addu src context skip)))
165 (inst beq num zero-tn done)
166 (move start csp-tn t)
168 (inst addu csp-tn count)
173 (inst bne dst csp-tn loop)
174 (inst sw temp dst -4)