0.7.7.9:
[sbcl.git] / src / assembly / mips / assem-rtns.lisp
1 (in-package "SB!VM")
2
3 \f
4 ;;;; Return-multiple with other than one value
5
6 #+sb-assembling ;; we don't want a vop for this one.
7 (define-assembly-routine
8     (return-multiple
9      (:return-style :none))
10
11      ;; These four are really arguments.
12     ((:temp nvals any-reg nargs-offset)
13      (:temp vals any-reg nl0-offset)
14      (:temp ocfp any-reg nl1-offset)
15      (:temp lra descriptor-reg lra-offset)
16
17      ;; These are just needed to facilitate the transfer
18      (:temp lip interior-reg lip-offset)
19      (:temp count any-reg nl2-offset)
20      (:temp dst any-reg nl4-offset)
21      (:temp temp descriptor-reg l0-offset)
22
23      ;; These are needed so we can get at the register args.
24      (:temp a0 descriptor-reg a0-offset)
25      (:temp a1 descriptor-reg a1-offset)
26      (:temp a2 descriptor-reg a2-offset)
27      (:temp a3 descriptor-reg a3-offset)
28      (:temp a4 descriptor-reg a4-offset)
29      (:temp a5 descriptor-reg a5-offset))
30
31   ;; Note, because of the way the return-multiple vop is written, we can
32   ;; assume that we are never called with nvals == 1 and that a0 has already
33   ;; been loaded.
34   (inst blez nvals default-a0-and-on)
35   (inst subu count nvals (fixnumize 2))
36   (inst blez count default-a2-and-on)
37   (inst lw a1 vals (* 1 n-word-bytes))
38   (inst subu count (fixnumize 1))
39   (inst blez count default-a3-and-on)
40   (inst lw a2 vals (* 2 n-word-bytes))
41   (inst subu count (fixnumize 1))
42   (inst blez count default-a4-and-on)
43   (inst lw a3 vals (* 3 n-word-bytes))
44   (inst subu count (fixnumize 1))
45   (inst blez count default-a5-and-on)
46   (inst lw a4 vals (* 4 n-word-bytes))
47   (inst subu count (fixnumize 1))
48   (inst blez count done)
49   (inst lw a5 vals (* 5 n-word-bytes))
50
51   ;; Copy the remaining args to the top of the stack.
52   (inst addu vals vals (* 6 n-word-bytes))
53   (inst addu dst cfp-tn (* 6 n-word-bytes))
54
55   LOOP
56   (inst lw temp vals)
57   (inst addu vals n-word-bytes)
58   (inst sw temp dst)
59   (inst subu count (fixnumize 1))
60   (inst bne count zero-tn loop)
61   (inst addu dst n-word-bytes)
62                 
63   (inst b done)
64   (inst nop)
65
66   DEFAULT-A0-AND-ON
67   (inst move a0 null-tn)
68   (inst move a1 null-tn)
69   DEFAULT-A2-AND-ON
70   (inst move a2 null-tn)
71   DEFAULT-A3-AND-ON
72   (inst move a3 null-tn)
73   DEFAULT-A4-AND-ON
74   (inst move a4 null-tn)
75   DEFAULT-A5-AND-ON
76   (inst move a5 null-tn)
77   DONE
78   
79   ;; Clear the stack.
80   (move ocfp-tn cfp-tn)
81   (move cfp-tn ocfp)
82   (inst addu csp-tn ocfp-tn nvals)
83   
84   ;; Return.
85   (lisp-return lra lip))
86
87 \f
88 ;;;; tail-call-variable.
89
90 #+sb-assembling ;; no vop for this one either.
91 (define-assembly-routine
92     (tail-call-variable
93      (:return-style :none))
94
95     ;; These are really args.
96     ((:temp args any-reg nl0-offset)
97      (:temp lexenv descriptor-reg lexenv-offset)
98
99      ;; We need to compute this
100      (:temp nargs any-reg nargs-offset)
101
102      ;; These are needed by the blitting code.
103      (:temp src any-reg nl1-offset)
104      (:temp dst any-reg nl2-offset)
105      (:temp count any-reg cfunc-offset)
106      (:temp temp descriptor-reg l0-offset)
107
108      ;; Needed for the jump
109      (:temp lip interior-reg lip-offset)
110
111      ;; These are needed so we can get at the register args.
112      (:temp a0 descriptor-reg a0-offset)
113      (:temp a1 descriptor-reg a1-offset)
114      (:temp a2 descriptor-reg a2-offset)
115      (:temp a3 descriptor-reg a3-offset)
116      (:temp a4 descriptor-reg a4-offset)
117      (:temp a5 descriptor-reg a5-offset))
118
119
120   ;; Calculate NARGS (as a fixnum)
121   (inst subu nargs csp-tn args)
122      
123   ;; Load the argument regs (must do this now, 'cause the blt might
124   ;; trash these locations)
125   (inst lw a0 args (* 0 n-word-bytes))
126   (inst lw a1 args (* 1 n-word-bytes))
127   (inst lw a2 args (* 2 n-word-bytes))
128   (inst lw a3 args (* 3 n-word-bytes))
129   (inst lw a4 args (* 4 n-word-bytes))
130   (inst lw a5 args (* 5 n-word-bytes))
131
132   ;; Calc SRC, DST, and COUNT
133   (inst addu count nargs (fixnumize (- register-arg-count)))
134   (inst blez count done)
135   (inst addu src args (* n-word-bytes register-arg-count))
136   (inst addu dst cfp-tn (* n-word-bytes register-arg-count))
137         
138   LOOP
139   ;; Copy one arg.
140   (inst lw temp src)
141   (inst addu src src n-word-bytes)
142   (inst sw temp dst)
143   (inst addu count (fixnumize -1))
144   (inst bgtz count loop)
145   (inst addu dst dst n-word-bytes)
146         
147   DONE
148   ;; We are done.  Do the jump.
149   (progn
150     (loadw temp lexenv closure-fun-slot fun-pointer-lowtag)
151     (lisp-jump temp lip)))
152
153 \f
154 ;;;; Non-local exit noise.
155
156 (define-assembly-routine
157     (unwind
158      (:translate %continue-unwind)
159      (:policy :fast-safe))
160     ((:arg block (any-reg descriptor-reg) a0-offset)
161      (:arg start (any-reg descriptor-reg) ocfp-offset)
162      (:arg count (any-reg descriptor-reg) nargs-offset)
163      (:temp lip interior-reg lip-offset)
164      (:temp lra descriptor-reg lra-offset)
165      (:temp cur-uwp any-reg nl0-offset)
166      (:temp next-uwp any-reg nl1-offset)
167      (:temp target-uwp any-reg nl2-offset))
168   (declare (ignore start count))
169
170   (let ((error (generate-error-code nil invalid-unwind-error)))
171     (inst beq block zero-tn error))
172   
173   (load-symbol-value cur-uwp *current-unwind-protect-block*)
174   (loadw target-uwp block unwind-block-current-uwp-slot)
175   (inst bne cur-uwp target-uwp do-uwp)
176   (inst nop)
177       
178   (move cur-uwp block)
179
180   do-exit
181       
182   (loadw cfp-tn cur-uwp unwind-block-current-cont-slot)
183   (loadw code-tn cur-uwp unwind-block-current-code-slot)
184   (progn
185     (loadw lra cur-uwp unwind-block-entry-pc-slot)
186     (lisp-return lra lip :frob-code nil))
187
188   do-uwp
189
190   (loadw next-uwp cur-uwp unwind-block-current-uwp-slot)
191   (inst b do-exit)
192   (store-symbol-value next-uwp *current-unwind-protect-block*))
193
194 (define-assembly-routine
195     throw
196     ((:arg target descriptor-reg a0-offset)
197      (:arg start any-reg ocfp-offset)
198      (:arg count any-reg nargs-offset)
199      (:temp catch any-reg a1-offset)
200      (:temp tag descriptor-reg a2-offset))
201   
202   (progn start count) ; We just need them in the registers.
203
204   (load-symbol-value catch *current-catch-block*)
205   
206   loop
207   
208   (let ((error (generate-error-code nil unseen-throw-tag-error target)))
209     (inst beq catch zero-tn error)
210     (inst nop))
211   
212   (loadw tag catch catch-block-tag-slot)
213   (inst beq tag target exit)
214   (inst nop)
215   (loadw catch catch catch-block-previous-catch-slot)
216   (inst b loop)
217   (inst nop)
218   
219   exit
220   
221   (move target catch)
222   (inst j (make-fixup 'unwind :assembly-routine))
223   (inst nop))