4 ;;;; Return-multiple with other than one value
6 (define-assembly-routine
10 ;; These four are really arguments.
11 ((:temp nvals any-reg nargs-offset)
12 (:temp vals any-reg nl0-offset)
13 (:temp ocfp any-reg nl1-offset)
14 (:temp lra descriptor-reg lra-offset)
16 ;; These are just needed to facilitate the transfer
17 (:temp lip interior-reg lip-offset)
18 (:temp count any-reg nl2-offset)
19 (:temp src any-reg nl3-offset)
20 (:temp dst any-reg cfunc-offset)
21 (:temp temp descriptor-reg l0-offset)
24 ;; These are needed so we can get at the register args.
25 (:temp a0 descriptor-reg a0-offset)
26 (:temp a1 descriptor-reg a1-offset)
27 (:temp a2 descriptor-reg a2-offset)
28 (:temp a3 descriptor-reg a3-offset))
30 ;; Note, because of the way the return-multiple vop is written, we can
31 ;; assume that we are never called with nvals == 1 and that a0 has already
35 (inst ble default-a0-and-on)
36 (inst cmpwi nvals (fixnumize 2))
37 (inst lwz a1 vals (* 1 n-word-bytes))
38 (inst ble default-a2-and-on)
39 (inst cmpwi nvals (fixnumize 3))
40 (inst lwz a2 vals (* 2 n-word-bytes))
41 (inst ble default-a3-and-on)
42 (inst cmpwi nvals (fixnumize 4))
43 (inst lwz a3 vals (* 3 n-word-bytes))
46 ;; Copy the remaining args to the top of the stack.
47 (inst addi src vals (* 4 n-word-bytes))
48 (inst addi dst cfp-tn (* 4 n-word-bytes))
49 (inst addic. count nvals (- (fixnumize 4)))
52 (inst subic. count count (fixnumize 1))
54 (inst addi src src n-word-bytes)
56 (inst addi dst dst n-word-bytes)
73 (inst add csp-tn ocfp-tn nvals)
76 (lisp-return lra lip))
79 ;;;; tail-call-variable.
81 #+sb-assembling ;; no vop for this one either.
82 (define-assembly-routine
84 (:return-style :none))
86 ;; These are really args.
87 ((:temp args any-reg nl0-offset)
88 (:temp lexenv descriptor-reg lexenv-offset)
90 ;; We need to compute this
91 (:temp nargs any-reg nargs-offset)
93 ;; These are needed by the blitting code.
94 (:temp src any-reg nl1-offset)
95 (:temp dst any-reg nl2-offset)
96 (:temp count any-reg nl3-offset)
97 (:temp temp descriptor-reg l0-offset)
98 (:temp lip interior-reg lip-offset)
100 ;; These are needed so we can get at the register args.
101 (:temp a0 descriptor-reg a0-offset)
102 (:temp a1 descriptor-reg a1-offset)
103 (:temp a2 descriptor-reg a2-offset)
104 (:temp a3 descriptor-reg a3-offset))
107 ;; Calculate NARGS (as a fixnum)
108 (inst sub nargs csp-tn args)
110 ;; Load the argument regs (must do this now, 'cause the blt might
111 ;; trash these locations)
112 (inst lwz a0 args (* 0 n-word-bytes))
113 (inst lwz a1 args (* 1 n-word-bytes))
114 (inst lwz a2 args (* 2 n-word-bytes))
115 (inst lwz a3 args (* 3 n-word-bytes))
117 ;; Calc SRC, DST, and COUNT
118 (inst addic. count nargs (fixnumize (- register-arg-count)))
119 (inst addi src args (* n-word-bytes register-arg-count))
121 (inst addi dst cfp-tn (* n-word-bytes register-arg-count))
125 (inst lwz temp src 0)
126 (inst addi src src n-word-bytes)
127 (inst stw temp dst 0)
128 (inst addic. count count (fixnumize -1))
129 (inst addi dst dst n-word-bytes)
133 ;; We are done. Do the jump.
134 (loadw temp lexenv closure-fun-slot fun-pointer-lowtag)
135 (lisp-jump temp lip))
139 ;;;; Non-local exit noise.
141 (define-assembly-routine (unwind
142 (:return-style :none)
143 (:translate %continue-unwind)
144 (:policy :fast-safe))
145 ((:arg block (any-reg descriptor-reg) a0-offset)
146 (:arg start (any-reg descriptor-reg) ocfp-offset)
147 (:arg count (any-reg descriptor-reg) nargs-offset)
148 (:temp lra descriptor-reg lra-offset)
149 (:temp lip interior-reg lip-offset)
150 (:temp cur-uwp any-reg nl0-offset)
151 (:temp next-uwp any-reg nl1-offset)
152 (:temp target-uwp any-reg nl2-offset))
153 (declare (ignore start count))
155 (let ((error (generate-error-code nil invalid-unwind-error)))
159 (load-symbol-value cur-uwp *current-unwind-protect-block*)
160 (loadw target-uwp block unwind-block-current-uwp-slot)
161 (inst cmpw cur-uwp target-uwp)
168 (loadw cfp-tn cur-uwp unwind-block-current-cont-slot)
169 (loadw code-tn cur-uwp unwind-block-current-code-slot)
170 (loadw lra cur-uwp unwind-block-entry-pc-slot)
171 (lisp-return lra lip :frob-code nil)
175 (loadw next-uwp cur-uwp unwind-block-current-uwp-slot)
176 (store-symbol-value next-uwp *current-unwind-protect-block*)
179 (define-assembly-routine (throw
180 (:return-style :none))
181 ((:arg target descriptor-reg a0-offset)
182 (:arg start any-reg ocfp-offset)
183 (:arg count any-reg nargs-offset)
184 (:temp catch any-reg a1-offset)
185 (:temp tag descriptor-reg a2-offset))
187 (declare (ignore start count))
189 (load-symbol-value catch *current-catch-block*)
193 (let ((error (generate-error-code nil unseen-throw-tag-error target)))
197 (loadw tag catch catch-block-tag-slot)
198 (inst cmpw tag target)
200 (loadw catch catch catch-block-previous-catch-slot)
206 (inst ba (make-fixup 'unwind :assembly-routine)))