0.7.4.18: Fixing Alpha fixes
[sbcl.git] / src / runtime / ppc-assem.S
1 #define LANGUAGE_ASSEMBLY
2
3 #include "sbcl.h" 
4 #include "lispregs.h"
5 #include "globals.h"
6
7
8 #define FUNCDEF(x)      .text ; \
9                         .align 3 ; \
10                         .type x,@function ; \
11 x:
12 #define GFUNCDEF(x)     .globl x ; \
13         FUNCDEF(x)
14
15 #define SET_SIZE(x) .size x,.-x
16
17 /* Load a register from a global, using the register as an intermediary */
18 /* The register will be a fixnum for one instruction, so this is gc-safe */
19
20 #define load(reg,global) \
21         lis reg,global@ha; lwz reg,global@l(reg)
22 #define store(reg,temp,global) \
23         lis temp,global@ha; stw reg,global@l(temp)
24         
25 #define FIRST_SAVE_FPR  14      /* lowest-numbered non-volatile FPR */
26 #define FIRST_SAVE_GPR  14      /* lowest-numbered non-volatile GPR */
27 #define NFPR_SAVE_BYTES(n) ((32-(n))*8)
28 #define NGPR_SAVE_BYTES(n) ((32-(~1&((n)+1)))*4)
29 #define FRAME_ARG_BYTES(n)  (((((n)+2)*4)+15)&~15)
30
31 #define FRAME_SIZE(first_g,first_f,out_arg_words,savecr) \
32 (NFPR_SAVE_BYTES(first_f)+ NGPR_SAVE_BYTES(first_g)+ FRAME_ARG_BYTES(out_arg_words+savecr))
33 #define SAVE_FPR(n) stfd n,-8*(32-(n))(11)
34 #define SAVE_GPR(n) stw n,-4*(32-(n))(11)
35 #define FULL_FRAME_SIZE FRAME_SIZE(FIRST_SAVE_GPR,FIRST_SAVE_FPR,0,1)
36
37 #define RESTORE_FPR(n) lfd n,-8*(32-(n))(11)
38 #define RESTORE_GPR(n) lwz n,-4*(32-(n))(11)
39 #define C_FULL_PROLOG \
40         mflr 0 ; \
41         stw 0,4(1) ; \
42         mr 11,1 ; \
43         stwu 1,-FULL_FRAME_SIZE(1) ; \
44         SAVE_FPR(14) ; \
45         SAVE_FPR(15) ; \
46         SAVE_FPR(16) ; \
47         SAVE_FPR(17) ; \
48         SAVE_FPR(18) ; \
49         SAVE_FPR(19) ; \
50         SAVE_FPR(20) ; \
51         SAVE_FPR(21) ; \
52         SAVE_FPR(22) ; \
53         SAVE_FPR(23) ; \
54         SAVE_FPR(24) ; \
55         SAVE_FPR(25) ; \
56         SAVE_FPR(26) ; \
57         SAVE_FPR(27) ; \
58         SAVE_FPR(28) ; \
59         SAVE_FPR(29) ; \
60         SAVE_FPR(30) ; \
61         SAVE_FPR(31) ; \
62         la 11,-NFPR_SAVE_BYTES(FIRST_SAVE_FPR)(11) ; \
63         SAVE_GPR(14) ; \
64         SAVE_GPR(15) ; \
65         SAVE_GPR(16) ; \
66         SAVE_GPR(17) ; \
67         SAVE_GPR(18) ; \
68         SAVE_GPR(19) ; \
69         SAVE_GPR(20) ; \
70         SAVE_GPR(21) ; \
71         SAVE_GPR(22) ; \
72         SAVE_GPR(23) ; \
73         SAVE_GPR(24) ; \
74         SAVE_GPR(25) ; \
75         SAVE_GPR(26) ; \
76         SAVE_GPR(27) ; \
77         SAVE_GPR(28) ; \
78         SAVE_GPR(29) ; \
79         SAVE_GPR(30) ; \
80         SAVE_GPR(31)
81
82
83 #define C_FULL_EPILOG \
84         la 11,FULL_FRAME_SIZE-NFPR_SAVE_BYTES(FIRST_SAVE_FPR)(1) ; \
85         RESTORE_GPR(14) ; \
86         RESTORE_GPR(15) ; \
87         RESTORE_GPR(16) ; \
88         RESTORE_GPR(17) ; \
89         RESTORE_GPR(18) ; \
90         RESTORE_GPR(19) ; \
91         RESTORE_GPR(20) ; \
92         RESTORE_GPR(21) ; \
93         RESTORE_GPR(22) ; \
94         RESTORE_GPR(23) ; \
95         RESTORE_GPR(24) ; \
96         RESTORE_GPR(25) ; \
97         RESTORE_GPR(26) ; \
98         RESTORE_GPR(27) ; \
99         RESTORE_GPR(28) ; \
100         RESTORE_GPR(29) ; \
101         RESTORE_GPR(30) ; \
102         RESTORE_GPR(31) ; \
103         la 11,NFPR_SAVE_BYTES(FIRST_SAVE_FPR)(11) ; \
104         RESTORE_FPR(14) ; \
105         RESTORE_FPR(15) ; \
106         RESTORE_FPR(16) ; \
107         RESTORE_FPR(17) ; \
108         RESTORE_FPR(18) ; \
109         RESTORE_FPR(19) ; \
110         RESTORE_FPR(20) ; \
111         RESTORE_FPR(21) ; \
112         RESTORE_FPR(22) ; \
113         RESTORE_FPR(23) ; \
114         RESTORE_FPR(24) ; \
115         RESTORE_FPR(25) ; \
116         RESTORE_FPR(26) ; \
117         RESTORE_FPR(27) ; \
118         RESTORE_FPR(28) ; \
119         RESTORE_FPR(29) ; \
120         RESTORE_FPR(30) ; \
121         RESTORE_FPR(31) ; \
122         lwz 1,0(1) ; \
123         lwz 0,4(1) ; \
124         mtlr 0 ; \
125         
126
127
128         
129         .text
130
131 /*
132  * Function to transfer control into lisp.  The lisp object to invoke is
133  * passed as the first argument, which puts it in NL0
134  */
135
136         GFUNCDEF(call_into_lisp)
137         C_FULL_PROLOG
138         mfcr 0
139         stw 0,8(1)
140         /* store(reg_POLL,11,saver2) */
141         /* Initialize tagged registers */
142         li reg_ZERO,0
143         li reg_CODE,0
144         li reg_CNAME,0
145         li reg_LEXENV,0
146         li reg_FDEFN,0
147         li reg_OCFP,0
148         li reg_LRA,0
149         li reg_A0,0
150         li reg_A1,0
151         li reg_A2,0
152         li reg_A3,0
153         li reg_L0,0
154         li reg_L1,0
155         li reg_L2,0
156         li reg_LIP,0
157         lis reg_NULL,NIL@h
158         ori reg_NULL,reg_NULL,NIL@l
159
160         /* Turn on pseudo-atomic */
161
162         li reg_NL3,-4
163         li reg_ALLOC,4
164         store(reg_ZERO,reg_NL4,foreign_function_call_active)
165         load(reg_NL4,dynamic_space_free_pointer)
166         add reg_ALLOC,reg_ALLOC,reg_NL4
167         load(reg_BSP,current_binding_stack_pointer)
168         load(reg_CSP,current_control_stack_pointer)
169         load(reg_OCFP,current_control_frame_pointer)
170
171         /* No longer atomic, and check for interrupt */
172         add reg_ALLOC,reg_ALLOC,reg_NL3
173         twlti reg_ALLOC,0
174
175         /* Pass in the arguments */
176
177         mr reg_CFP,reg_NL1
178         mr reg_LEXENV,reg_NL0
179         lwz reg_A0,0(reg_CFP)
180         lwz reg_A1,4(reg_CFP)
181         lwz reg_A2,8(reg_CFP)
182         lwz reg_A3,12(reg_CFP)
183
184         /* Calculate LRA */
185         lis reg_LRA,lra@ha
186         addi reg_LRA,reg_LRA,lra@l
187         addi reg_LRA,reg_LRA,OTHER_POINTER_LOWTAG
188
189         /* Function is an indirect closure */
190         lwz reg_CODE,SIMPLE_FUN_SELF_OFFSET(reg_LEXENV)
191         addi reg_LIP,reg_CODE,6*4-FUN_POINTER_LOWTAG
192         mtctr reg_LIP
193         slwi reg_NARGS,reg_NL2,2
194         bctr                    
195         
196         .align 3
197 lra:
198         .long RETURN_PC_HEADER_WIDETAG 
199
200         /* Blow off any extra values. */
201         mr reg_CSP,reg_OCFP
202         nop
203
204         /* Return the one value. */
205
206         mr 3,reg_A0
207
208         /* Turn on  pseudo-atomic */
209         li reg_NL3,-4
210         la reg_ALLOC,4(reg_ALLOC)
211
212         /* Store lisp state */
213         clrrwi reg_NL1,reg_ALLOC,3
214         store(reg_NL1,reg_NL2,dynamic_space_free_pointer)
215         /* store(reg_POLL,reg_NL2,poll_flag) */
216         /* load(reg_NL2,current_thread) */
217         store(reg_BSP,reg_NL2,current_binding_stack_pointer)
218         store(reg_CSP,reg_NL2,current_control_stack_pointer)
219         store(reg_CFP,reg_NL2,current_control_frame_pointer)
220         /* load(reg_POLL,saver2) */
221
222         /* No longer in Lisp. */
223         store(reg_NL1,reg_NL2,foreign_function_call_active)
224
225         /* Check for interrupt */
226         add reg_ALLOC,reg_ALLOC,reg_NL3
227         twlti reg_ALLOC,0
228
229         /* Back to C */
230         lwz 5,8(1)
231         mtcrf 255,5
232         C_FULL_EPILOG
233         blr
234         SET_SIZE(call_into_lisp)
235 \f
236
237         GFUNCDEF(call_into_c)
238         /* We're kind of low on unboxed, non-dedicated registers here:
239         most of the unboxed registers may have outgoing C args in them.
240         CFUNC is going to have to go in the CTR in a moment, anyway
241         so we'll free it up soon.  reg_NFP is preserved by lisp if it
242         has a meaningful value in it, so we can use it.  reg_NARGS is
243         free when it's not holding a copy of the "real" reg_NL3, which
244         gets tied up by the pseudo-atomic mechanism */
245         mtctr reg_CFUNC
246         mflr reg_LIP
247         /* Build a lisp stack frame */
248         mr reg_OCFP,reg_CFP
249         mr reg_CFP,reg_CSP
250         la reg_CSP,32(reg_CSP)
251         stw reg_OCFP,0(reg_CFP)
252         stw reg_CODE,8(reg_CFP)
253         /* The pseudo-atomic mechanism wants to use reg_NL3, but that
254         may be an outgoing C argument.  Copy reg_NL3 to something that's
255         unboxed and -not- one of the C argument registers */
256         mr reg_NARGS,reg_NL3
257
258         /* Turn on pseudo-atomic */
259         li reg_NL3,-4
260         la reg_ALLOC,4(reg_ALLOC)
261
262         /* Convert the return address to an offset and save it on the stack. */
263         sub reg_NFP,reg_LIP,reg_CODE
264         la reg_NFP,OTHER_POINTER_LOWTAG(reg_NFP)
265         stw reg_NFP,4(reg_CFP)
266
267         /* Store Lisp state */
268         clrrwi reg_NFP,reg_ALLOC,3
269         store(reg_NFP,reg_CFUNC,dynamic_space_free_pointer)
270         /* load(reg_CFUNC,current_thread) */
271         
272         store(reg_BSP,reg_CFUNC,current_binding_stack_pointer)
273         store(reg_CSP,reg_CFUNC,current_control_stack_pointer)
274         store(reg_CFP,reg_CFUNC,current_control_frame_pointer)
275
276         /* No longer in Lisp */
277         store(reg_CSP,reg_CFUNC,foreign_function_call_active)
278         /* load(reg_POLL,saver2) */
279         /* Disable pseudo-atomic; check pending interrupt */
280         add reg_ALLOC,reg_ALLOC,reg_NL3
281         twlti reg_ALLOC,0
282         mr reg_NL3,reg_NARGS
283
284         /* Into C we go. */
285         bctrl
286
287         /* Re-establish NIL */
288         lis reg_NULL,NIL@h
289         ori reg_NULL,reg_NULL,NIL@l
290         /* And reg_ZERO */
291         li reg_ZERO,0
292
293         /* If we GC'ed during the FF code (as the result of a callback ?)
294         the tagged lisp registers may now contain garbage (since the
295         registers were saved by C and not seen by the GC.)  Put something
296         harmless in all such registers before allowing an interrupt */
297         li reg_CODE,0
298         li reg_CNAME,0
299         li reg_LEXENV,0
300         /* reg_OCFP was pointing to a control stack frame & was preserved by C */
301         li reg_LRA,0
302         li reg_A0,0
303         li reg_A1,0
304         li reg_A2,0
305         li reg_A3,0
306         li reg_L0,0
307         li reg_L1,0
308         li reg_L2,0
309         li reg_LIP,0
310
311         /* Atomic ... */
312         li reg_NL3,-4
313         li reg_ALLOC,4
314
315         /* No long in foreign function call. */
316         store(reg_ZERO,reg_NL2,foreign_function_call_active)
317
318         /* The free pointer may have moved */
319         load(reg_NL4,dynamic_space_free_pointer)
320         add reg_ALLOC,reg_ALLOC,reg_NL4
321
322         /* The BSP wasn't preserved by C, so load it */
323         load(reg_BSP,current_binding_stack_pointer)
324
325         /* Other lisp stack/frame pointers were preserved by C.
326         I can't imagine why they'd have moved */
327
328         /* Get the return address back. */
329         lwz reg_LIP,4(reg_CFP)
330         lwz reg_CODE,8(reg_CFP)
331         add reg_LIP,reg_CODE,reg_LIP
332         la reg_LIP,-OTHER_POINTER_LOWTAG(reg_LIP)
333
334         /* No longer atomic */
335         add reg_ALLOC,reg_ALLOC,reg_NL3
336         twlti reg_ALLOC,0
337         mtlr reg_LIP
338         
339         /* Reset the lisp stack. */
340         mr reg_CSP,reg_CFP
341         mr reg_CFP,reg_OCFP
342         
343         /* And back into Lisp. */
344         blr
345
346         SET_SIZE(call_into_c)
347
348         GFUNCDEF(xundefined_tramp)
349         .globl undefined_tramp
350         .byte 0,0,0,SIMPLE_FUN_HEADER_WIDETAG /* type_FunctionHeader */
351
352         .byte 18<<2
353 undefined_tramp:
354         .byte 0,0,24
355         .long undefined_tramp
356         .long NIL
357         .long NIL
358         .long NIL
359         .long NIL
360         twllei reg_ZERO,trap_Cerror
361         .byte 4
362         .byte UNDEFINED_FUN_ERROR
363         .byte 254, 140, 2       /* 140?  sparc says sc_descriptorReg */
364         .align 2
365 1:      lwz reg_CODE,FDEFN_RAW_ADDR_OFFSET(reg_FDEFN)
366         la reg_LIP,SIMPLE_FUN_CODE_OFFSET(reg_CODE)
367         mtctr reg_LIP
368         bctr
369         
370         SET_SIZE(xundefined_tramp)
371
372         GFUNCDEF(xclosure_tramp)
373         .globl closure_tramp
374         .byte 0,0,0,SIMPLE_FUN_HEADER_WIDETAG
375         .byte 18<<2
376 closure_tramp:
377         .byte 0,0,24
378         .long closure_tramp
379         .long NIL 
380         .long NIL
381         .long NIL
382         .long NIL
383         lwz reg_LEXENV,FDEFN_FUN_OFFSET(reg_FDEFN)
384         lwz reg_CODE,CLOSURE_FUN_OFFSET(reg_LEXENV)
385         la reg_LIP,SIMPLE_FUN_CODE_OFFSET(reg_CODE)
386         mtctr reg_LIP
387         bctr
388
389         SET_SIZE(xclosure_tramp)
390
391         GFUNCDEF(fun_end_breakpoint_trap)
392         .long 0
393         SET_SIZE(fun_end_breakpoint_trap)
394
395         GFUNCDEF(fun_end_breakpoint)
396         .long 0
397         SET_SIZE(fun_end_breakpoint)
398
399         GFUNCDEF(fun_end_breakpoint_guts)
400         .long 0
401         SET_SIZE(fun_end_breakpoint_guts)
402
403         GFUNCDEF(fun_end_breakpoint_end)
404         .long 0
405         SET_SIZE(fun_end_breakpoint_end)
406
407
408         GFUNCDEF(ppc_flush_cache_line)
409         dcbf 0,3
410         sync
411         icbi 0,3
412         sync
413         isync
414         blr
415         SET_SIZE(ppc_flush_cache_line)
416