1 ;;; Written by Rob MacLachlan
5 ;;; Make an environment-live stack TN for saving the SP for NLX entry.
6 (!def-vm-support-routine make-nlx-sp-tn (env)
8 (make-representation-tn *fixnum-primitive-type* immediate-arg-scn)
11 ;;; Make a TN for the argument count passing location for a
13 (!def-vm-support-routine make-nlx-entry-arg-start-location ()
14 (make-wired-tn *fixnum-primitive-type* immediate-arg-scn ocfp-offset))
17 ;;; These VOPs are used in the reentered function to restore the
18 ;;; appropriate dynamic environment. Currently we only save the
19 ;;; CURRENT-CATCH and binding stack pointer. We don't need to
20 ;;; save/restore the current unwind-protect, since UNWIND-PROTECTs are
21 ;;; implicitly processed during unwinding. If there were any
22 ;;; additional stacks, then this would be the place to restore the top
25 (define-vop (save-dynamic-state)
26 (:results (catch :scs (descriptor-reg))
27 (nfp :scs (descriptor-reg))
28 (nsp :scs (descriptor-reg)))
31 (load-symbol-value catch *current-catch-block*)
32 (let ((cur-nfp (current-nfp-tn vop)))
37 (define-vop (restore-dynamic-state)
38 (:args (catch :scs (descriptor-reg))
39 (nfp :scs (descriptor-reg))
40 (nsp :scs (descriptor-reg)))
43 (store-symbol-value catch *current-catch-block*)
44 (let ((cur-nfp (current-nfp-tn vop)))
49 (define-vop (current-stack-pointer)
50 (:results (res :scs (any-reg descriptor-reg)))
54 (define-vop (current-binding-pointer)
55 (:results (res :scs (any-reg descriptor-reg)))
61 ;;;; Unwind block hackery:
63 ;;; Compute the address of the catch block from its TN, then store into the
64 ;;; block the current Fp, Env, Unwind-Protect, and the entry PC.
66 (define-vop (make-unwind-block)
69 (:results (block :scs (any-reg)))
70 (:temporary (:scs (descriptor-reg)) temp)
71 (:temporary (:scs (non-descriptor-reg)) ndescr)
73 (inst addi block cfp-tn (* (tn-offset tn) sb!vm:n-word-bytes))
74 (load-symbol-value temp *current-unwind-protect-block*)
75 (storew temp block sb!vm:unwind-block-current-uwp-slot)
76 (storew cfp-tn block sb!vm:unwind-block-current-cont-slot)
77 (storew code-tn block sb!vm:unwind-block-current-code-slot)
78 (inst compute-lra-from-code temp code-tn entry-label ndescr)
79 (storew temp block sb!vm:catch-block-entry-pc-slot)))
82 ;;; Like Make-Unwind-Block, except that we also store in the specified tag, and
83 ;;; link the block into the Current-Catch list.
85 (define-vop (make-catch-block)
87 (tag :scs (any-reg descriptor-reg)))
89 (:results (block :scs (any-reg)))
90 (:temporary (:scs (descriptor-reg)) temp)
91 (:temporary (:scs (descriptor-reg) :target block :to (:result 0)) result)
92 (:temporary (:scs (non-descriptor-reg)) ndescr)
94 (inst addi result cfp-tn (* (tn-offset tn) sb!vm:n-word-bytes))
95 (load-symbol-value temp *current-unwind-protect-block*)
96 (storew temp result sb!vm:catch-block-current-uwp-slot)
97 (storew cfp-tn result sb!vm:catch-block-current-cont-slot)
98 (storew code-tn result sb!vm:catch-block-current-code-slot)
99 (inst compute-lra-from-code temp code-tn entry-label ndescr)
100 (storew temp result sb!vm:catch-block-entry-pc-slot)
102 (storew tag result sb!vm:catch-block-tag-slot)
103 (load-symbol-value temp *current-catch-block*)
104 (storew temp result sb!vm:catch-block-previous-catch-slot)
105 (store-symbol-value result *current-catch-block*)
107 (move block result)))
110 ;;; Just set the current unwind-protect to TN's address. This instantiates an
111 ;;; unwind block as an unwind-protect.
113 (define-vop (set-unwind-protect)
115 (:temporary (:scs (descriptor-reg)) new-uwp)
117 (inst addi new-uwp cfp-tn (* (tn-offset tn) sb!vm:n-word-bytes))
118 (store-symbol-value new-uwp *current-unwind-protect-block*)))
121 (define-vop (unlink-catch-block)
122 (:temporary (:scs (any-reg)) block)
124 (:translate %catch-breakup)
126 (load-symbol-value block *current-catch-block*)
127 (loadw block block sb!vm:catch-block-previous-catch-slot)
128 (store-symbol-value block *current-catch-block*)))
130 (define-vop (unlink-unwind-protect)
131 (:temporary (:scs (any-reg)) block)
133 (:translate %unwind-protect-breakup)
135 (load-symbol-value block *current-unwind-protect-block*)
136 (loadw block block sb!vm:unwind-block-current-uwp-slot)
137 (store-symbol-value block *current-unwind-protect-block*)))
143 (define-vop (nlx-entry)
144 (:args (sp) ; Note: we can't list an sc-restriction, 'cause any load vops
145 ; would be inserted before the LRA.
148 (:results (values :more t))
149 (:temporary (:scs (descriptor-reg)) move-temp)
151 (:save-p :force-to-stack)
154 (emit-return-pc label)
155 (note-this-location vop :non-local-entry)
156 (cond ((zerop nvals))
158 (let ((no-values (gen-label)))
160 (move (tn-ref-tn values) null-tn)
162 (loadw (tn-ref-tn values) start)
163 (emit-label no-values)))
165 (collect ((defaults))
166 (inst addic. count count (- (fixnumize 1)))
168 (tn-ref values (tn-ref-across tn-ref)))
170 (let ((default-lab (gen-label))
171 (tn (tn-ref-tn tn-ref)))
172 (defaults (cons default-lab tn))
174 (inst subi count count (fixnumize 1))
175 (inst blt default-lab)
177 ((descriptor-reg any-reg)
180 (loadw move-temp start i)
181 (store-stack-tn tn move-temp)))
182 (inst cmpwi count 0)))
184 (let ((defaulting-done (gen-label)))
186 (emit-label defaulting-done)
188 (assemble (*elsewhere*)
189 (dolist (def (defaults))
190 (emit-label (car def))
191 (let ((tn (cdr def)))
193 ((descriptor-reg any-reg)
196 (store-stack-tn tn null-tn)))))
197 (inst b defaulting-done))))))
198 (load-stack-tn csp-tn sp)))
201 (define-vop (nlx-entry-multiple)
202 (:args (top :target result) (src) (count))
203 ;; Again, no SC restrictions for the args, 'cause the loading would
204 ;; happen before the entry label.
206 (:temporary (:scs (any-reg)) dst)
207 (:temporary (:scs (descriptor-reg)) temp)
208 (:results (result :scs (any-reg) :from (:argument 0))
209 (num :scs (any-reg) :from (:argument 0)))
210 (:save-p :force-to-stack)
213 (emit-return-pc label)
214 (note-this-location vop :non-local-entry)
215 (let ((loop (gen-label))
218 ;; Setup results, and test for the zero value case.
219 (load-stack-tn result top)
224 ;; Compute dst as one slot down from result, because we inc the index
226 (inst subi dst result 4)
228 ;; Copy stuff down the stack.
230 (inst lwzx temp src num)
231 (inst addi num num (fixnumize 1))
232 (inst cmpw num count)
233 (inst stwx temp dst num)
238 (inst add csp-tn result num))))
241 ;;; This VOP is just to force the TNs used in the cleanup onto the stack.
243 (define-vop (uwp-entry)
245 (:save-p :force-to-stack)
246 (:results (block) (start) (count))
247 (:ignore block start count)
250 (emit-return-pc label)
251 (note-this-location vop :non-local-entry)))