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