0.9.6.23:
[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 #include "genesis/simple-fun.h"
8 #include "genesis/fdefn.h"
9 #include "genesis/closure.h"
10 #include "genesis/static-symbols.h"
11
12 #ifdef LISP_FEATURE_DARWIN
13 #define CSYMBOL(x) _ ## x
14 #else
15 #define CSYMBOL(x) x
16 #endif
17
18 #if defined LISP_FEATURE_DARWIN
19 #define FUNCDEF(x)      .text @ \
20                         .align 3 @ \
21 _##x:
22
23 #define GFUNCDEF(x)     .globl _/**/x @ \
24         FUNCDEF(x)
25 #else
26 #define FUNCDEF(x)      .text ; \
27                         .align 3 ; \
28                         .type x,@function ; \
29 x:
30
31 #define GFUNCDEF(x)     .globl x ; \
32         FUNCDEF(x)
33 #endif
34
35 #if defined LISP_FEATURE_DARWIN
36 #define SET_SIZE(x)
37 #else
38 #define SET_SIZE(x) .size x,.-x
39 #endif
40
41 /* Load a register from a global, using the register as an intermediary */
42 /* The register will be a fixnum for one instruction, so this is gc-safe */
43
44 #if defined LISP_FEATURE_DARWIN
45 #define load(reg,global) \
46         lis reg,ha16(global) @ \
47         lwz reg,lo16(global)(reg) ; Comment
48 #define store(reg,temp,global) \
49         lis temp,ha16(global) @\
50         stw reg,lo16(global)(temp) ; Comment
51 #else
52 #define load(reg,global) \
53         lis reg,global@ha; lwz reg,global@l(reg)
54 #define store(reg,temp,global) \
55         lis temp,global@ha; stw reg,global@l(temp)
56 #endif
57         
58 #define FIRST_SAVE_FPR  14      /* lowest-numbered non-volatile FPR */
59 #ifdef LISP_FEATURE_DARWIN
60 #define FIRST_SAVE_GPR  13      /* lowest-numbered non-volatile GPR */
61 #define NGPR_SAVE_BYTES(n) ((32-(n))*4)
62 #define FRAME_ARG_BYTES(n)  (((((n)+6)*4)+15)&~15)
63 #else
64 #define FIRST_SAVE_GPR  14      /* lowest-numbered non-volatile GPR */
65 #define NGPR_SAVE_BYTES(n) ((32-(~1&((n)+1)))*4)
66 #define FRAME_ARG_BYTES(n)  (((((n)+2)*4)+15)&~15)
67 #endif
68 #define NFPR_SAVE_BYTES(n) ((32-(n))*8)
69
70 #ifdef LISP_FEATURE_DARWIN
71 #define FRAME_SIZE(first_g,first_f,out_arg_words,savecr) \
72 (NFPR_SAVE_BYTES(first_f)+ NGPR_SAVE_BYTES(first_g)+ FRAME_ARG_BYTES(out_arg_words))
73 #define SAVE_FPR(n) stfd f##n,-8*(32- n)(r11)
74 #define SAVE_GPR(n) stw r##n,-4*(32- n)(r11)
75 #define FULL_FRAME_SIZE (FRAME_SIZE(FIRST_SAVE_GPR,FIRST_SAVE_FPR,8,1)+15&~15)
76 #define RESTORE_FPR(n) lfd f##n,-8*(32- n)(r11)
77 #define RESTORE_GPR(n) lwz r##n,-4*(32- n)(r11)
78 #else
79 #define FRAME_SIZE(first_g,first_f,out_arg_words,savecr) \
80 (NFPR_SAVE_BYTES(first_f)+ NGPR_SAVE_BYTES(first_g)+ FRAME_ARG_BYTES(out_arg_words+savecr))
81 #define SAVE_FPR(n) stfd n,-8*(32-(n))(11)
82 #define SAVE_GPR(n) stw n,-4*(32-(n))(11)
83 #define FULL_FRAME_SIZE FRAME_SIZE(FIRST_SAVE_GPR,FIRST_SAVE_FPR,0,1)
84
85 #define RESTORE_FPR(n) lfd n,-8*(32-(n))(11)
86 #define RESTORE_GPR(n) lwz n,-4*(32-(n))(11)
87 #endif
88
89 #ifdef LISP_FEATURE_DARWIN
90 #define C_FULL_PROLOG \
91         nop @\
92         nop @ \
93         mfcr REG(0) @ \
94         stw REG(0),4(REG(1)) @ \
95         mflr REG(0) @ \
96         stw REG(0),8(REG(1)) @ \
97         mr REG(11),REG(1) @ \
98         stwu REG(1),-FULL_FRAME_SIZE(REG(1)) @ \
99         SAVE_FPR(14) @ \
100         SAVE_FPR(15) @ \
101         SAVE_FPR(16) @ \
102         SAVE_FPR(17) @ \
103         SAVE_FPR(18) @ \
104         SAVE_FPR(19) @ \
105         SAVE_FPR(20) @ \
106         SAVE_FPR(21) @ \
107         SAVE_FPR(22) @ \
108         SAVE_FPR(23) @ \
109         SAVE_FPR(24) @ \
110         SAVE_FPR(25) @ \
111         SAVE_FPR(26) @ \
112         SAVE_FPR(27) @ \
113         SAVE_FPR(28) @ \
114         SAVE_FPR(29) @ \
115         SAVE_FPR(30) @ \
116         SAVE_FPR(31) @ \
117         la REG(11),-NFPR_SAVE_BYTES(FIRST_SAVE_FPR)(REG(11)) @ \
118         SAVE_GPR(13) @ \
119         SAVE_GPR(14) @ \
120         SAVE_GPR(15) @ \
121         SAVE_GPR(16) @ \
122         SAVE_GPR(17) @ \
123         SAVE_GPR(18) @ \
124         SAVE_GPR(19) @ \
125         SAVE_GPR(20) @ \
126         SAVE_GPR(21) @ \
127         SAVE_GPR(22) @ \
128         SAVE_GPR(23) @ \
129         SAVE_GPR(24) @ \
130         SAVE_GPR(25) @ \
131         SAVE_GPR(26) @ \
132         SAVE_GPR(27) @ \
133         SAVE_GPR(28) @ \
134         SAVE_GPR(29) @ \
135         SAVE_GPR(30) @ \
136         SAVE_GPR(31)
137
138
139 #define C_FULL_EPILOG \
140         la REG(11),FULL_FRAME_SIZE-NFPR_SAVE_BYTES(FIRST_SAVE_FPR)(REG(1)) @ \
141         RESTORE_GPR(13) @ \
142         RESTORE_GPR(14) @ \
143         RESTORE_GPR(15) @ \
144         RESTORE_GPR(16) @ \
145         RESTORE_GPR(17) @ \
146         RESTORE_GPR(18) @ \
147         RESTORE_GPR(19) @ \
148         RESTORE_GPR(20) @ \
149         RESTORE_GPR(21) @ \
150         RESTORE_GPR(22) @ \
151         RESTORE_GPR(23) @ \
152         RESTORE_GPR(24) @ \
153         RESTORE_GPR(25) @ \
154         RESTORE_GPR(26) @ \
155         RESTORE_GPR(27) @ \
156         RESTORE_GPR(28) @ \
157         RESTORE_GPR(29) @ \
158         RESTORE_GPR(30) @ \
159         RESTORE_GPR(31) @ \
160         la REG(11),NFPR_SAVE_BYTES(FIRST_SAVE_FPR)(REG(11)) @ \
161         RESTORE_FPR(14) @ \
162         RESTORE_FPR(15) @ \
163         RESTORE_FPR(16) @ \
164         RESTORE_FPR(17) @ \
165         RESTORE_FPR(18) @ \
166         RESTORE_FPR(19) @ \
167         RESTORE_FPR(20) @ \
168         RESTORE_FPR(21) @ \
169         RESTORE_FPR(22) @ \
170         RESTORE_FPR(23) @ \
171         RESTORE_FPR(24) @ \
172         RESTORE_FPR(25) @ \
173         RESTORE_FPR(26) @ \
174         RESTORE_FPR(27) @ \
175         RESTORE_FPR(28) @ \
176         RESTORE_FPR(29) @ \
177         RESTORE_FPR(30) @ \
178         RESTORE_FPR(31) @ \
179         lwz REG(1),0(REG(1)) @ \
180         lwz REG(0),4(REG(1)) @ \
181         mtcr REG(0) @ \
182         lwz REG(0),8(REG(1)) @ \
183         mtlr REG(0) @ \
184         
185 #else   
186
187 #define C_FULL_PROLOG \
188         mflr 0 ; \
189         stw 0,4(1) ; \
190         mr 11,1 ; \
191         stwu 1,-FULL_FRAME_SIZE(1) ; \
192         SAVE_FPR(14) ; \
193         SAVE_FPR(15) ; \
194         SAVE_FPR(16) ; \
195         SAVE_FPR(17) ; \
196         SAVE_FPR(18) ; \
197         SAVE_FPR(19) ; \
198         SAVE_FPR(20) ; \
199         SAVE_FPR(21) ; \
200         SAVE_FPR(22) ; \
201         SAVE_FPR(23) ; \
202         SAVE_FPR(24) ; \
203         SAVE_FPR(25) ; \
204         SAVE_FPR(26) ; \
205         SAVE_FPR(27) ; \
206         SAVE_FPR(28) ; \
207         SAVE_FPR(29) ; \
208         SAVE_FPR(30) ; \
209         SAVE_FPR(31) ; \
210         la 11,-NFPR_SAVE_BYTES(FIRST_SAVE_FPR)(11) ; \
211         SAVE_GPR(14) ; \
212         SAVE_GPR(15) ; \
213         SAVE_GPR(16) ; \
214         SAVE_GPR(17) ; \
215         SAVE_GPR(18) ; \
216         SAVE_GPR(19) ; \
217         SAVE_GPR(20) ; \
218         SAVE_GPR(21) ; \
219         SAVE_GPR(22) ; \
220         SAVE_GPR(23) ; \
221         SAVE_GPR(24) ; \
222         SAVE_GPR(25) ; \
223         SAVE_GPR(26) ; \
224         SAVE_GPR(27) ; \
225         SAVE_GPR(28) ; \
226         SAVE_GPR(29) ; \
227         SAVE_GPR(30) ; \
228         SAVE_GPR(31) ; \
229         mfcr 0  ; \
230         stw 0,8(1)
231
232 #define C_FULL_EPILOG \
233         lwz 5,8(1) ; \
234         mtcrf 255,5 ; \
235         la 11,FULL_FRAME_SIZE-NFPR_SAVE_BYTES(FIRST_SAVE_FPR)(1) ; \
236         RESTORE_GPR(14) ; \
237         RESTORE_GPR(15) ; \
238         RESTORE_GPR(16) ; \
239         RESTORE_GPR(17) ; \
240         RESTORE_GPR(18) ; \
241         RESTORE_GPR(19) ; \
242         RESTORE_GPR(20) ; \
243         RESTORE_GPR(21) ; \
244         RESTORE_GPR(22) ; \
245         RESTORE_GPR(23) ; \
246         RESTORE_GPR(24) ; \
247         RESTORE_GPR(25) ; \
248         RESTORE_GPR(26) ; \
249         RESTORE_GPR(27) ; \
250         RESTORE_GPR(28) ; \
251         RESTORE_GPR(29) ; \
252         RESTORE_GPR(30) ; \
253         RESTORE_GPR(31) ; \
254         la 11,NFPR_SAVE_BYTES(FIRST_SAVE_FPR)(11) ; \
255         RESTORE_FPR(14) ; \
256         RESTORE_FPR(15) ; \
257         RESTORE_FPR(16) ; \
258         RESTORE_FPR(17) ; \
259         RESTORE_FPR(18) ; \
260         RESTORE_FPR(19) ; \
261         RESTORE_FPR(20) ; \
262         RESTORE_FPR(21) ; \
263         RESTORE_FPR(22) ; \
264         RESTORE_FPR(23) ; \
265         RESTORE_FPR(24) ; \
266         RESTORE_FPR(25) ; \
267         RESTORE_FPR(26) ; \
268         RESTORE_FPR(27) ; \
269         RESTORE_FPR(28) ; \
270         RESTORE_FPR(29) ; \
271         RESTORE_FPR(30) ; \
272         RESTORE_FPR(31) ; \
273         lwz 1,0(1) ; \
274         lwz 0,4(1) ; \
275         mtlr 0 ; \
276         
277 #endif
278         
279         .text
280
281 /*
282  * Function to transfer control into lisp.  The lisp object to invoke is
283  * passed as the first argument, which puts it in NL0
284  */
285
286         GFUNCDEF(call_into_lisp)
287         C_FULL_PROLOG
288         /* store(reg_POLL,11,saver2) */
289         /* Initialize tagged registers */
290         li reg_ZERO,0
291         li reg_CODE,0
292         li reg_CNAME,0
293         li reg_LEXENV,0
294         li reg_FDEFN,0
295         li reg_OCFP,0
296         li reg_LRA,0
297         li reg_A0,0
298         li reg_A1,0
299         li reg_A2,0
300         li reg_A3,0
301         li reg_L0,0
302         li reg_L1,0
303         li reg_L2,0
304         li reg_LIP,0
305 #ifdef LISP_FEATURE_DARWIN      
306         lis reg_NULL,hi16(NIL)
307         ori reg_NULL,reg_NULL,lo16(NIL)
308 #else
309         lis reg_NULL,NIL@h
310         ori reg_NULL,reg_NULL,NIL@l
311 #endif
312         /* Turn on pseudo-atomic */
313
314         li reg_NL3,-4
315         li reg_ALLOC,4
316         store(reg_ZERO,reg_NL4,CSYMBOL(foreign_function_call_active))
317         load(reg_NL4,CSYMBOL(dynamic_space_free_pointer))
318         add reg_ALLOC,reg_ALLOC,reg_NL4
319         load(reg_BSP,CSYMBOL(current_binding_stack_pointer))
320         load(reg_CSP,CSYMBOL(current_control_stack_pointer))
321         load(reg_OCFP,CSYMBOL(current_control_frame_pointer))
322
323         /* No longer atomic, and check for interrupt */
324         add reg_ALLOC,reg_ALLOC,reg_NL3
325         twlti reg_ALLOC,0
326
327         /* Pass in the arguments */
328
329         mr reg_CFP,reg_NL1
330         mr reg_LEXENV,reg_NL0
331         lwz reg_A0,0(reg_CFP)
332         lwz reg_A1,4(reg_CFP)
333         lwz reg_A2,8(reg_CFP)
334         lwz reg_A3,12(reg_CFP)
335
336         /* Calculate LRA */
337 #ifdef LISP_FEATURE_DARWIN
338         lis reg_LRA,ha16(lra)
339         addi reg_LRA,reg_LRA,lo16(lra)
340 #else
341         lis reg_LRA,lra@h
342         addi reg_LRA,reg_LRA,lra@l
343 #endif
344         addi reg_LRA,reg_LRA,OTHER_POINTER_LOWTAG
345
346         /* Function is an indirect closure */
347         lwz reg_CODE,SIMPLE_FUN_SELF_OFFSET(reg_LEXENV)
348         addi reg_LIP,reg_CODE,6*4-FUN_POINTER_LOWTAG
349         mtctr reg_LIP
350         slwi reg_NARGS,reg_NL2,2
351         bctr                    
352         
353         .align 3
354 lra:
355         .long RETURN_PC_HEADER_WIDETAG 
356
357         /* Blow off any extra values. */
358         mr reg_CSP,reg_OCFP
359         nop
360
361         /* Return the one value. */
362
363         mr REG(3),reg_A0
364
365         /* Turn on  pseudo-atomic */
366         li reg_NL3,-4
367         la reg_ALLOC,4(reg_ALLOC)
368
369         /* Store lisp state */
370         clrrwi reg_NL1,reg_ALLOC,3
371         store(reg_NL1,reg_NL2,CSYMBOL(dynamic_space_free_pointer))
372         /* store(reg_POLL,reg_NL2,poll_flag) */
373         /* load(reg_NL2,current_thread) */
374         store(reg_BSP,reg_NL2,CSYMBOL(current_binding_stack_pointer))
375         store(reg_CSP,reg_NL2,CSYMBOL(current_control_stack_pointer))
376         store(reg_CFP,reg_NL2,CSYMBOL(current_control_frame_pointer))
377         /* load(reg_POLL,saver2) */
378
379         /* No longer in Lisp. */
380         store(reg_NL1,reg_NL2,CSYMBOL(foreign_function_call_active))
381
382         /* Check for interrupt */
383         add reg_ALLOC,reg_ALLOC,reg_NL3
384         twlti reg_ALLOC,0
385
386         /* Back to C */
387         C_FULL_EPILOG
388         blr
389         SET_SIZE(call_into_lisp)
390 \f
391
392         GFUNCDEF(call_into_c)
393         /* We're kind of low on unboxed, non-dedicated registers here:
394         most of the unboxed registers may have outgoing C args in them.
395         CFUNC is going to have to go in the CTR in a moment, anyway
396         so we'll free it up soon.  reg_NFP is preserved by lisp if it
397         has a meaningful value in it, so we can use it.  reg_NARGS is
398         free when it's not holding a copy of the "real" reg_NL3, which
399         gets tied up by the pseudo-atomic mechanism */
400         mtctr reg_CFUNC
401         mflr reg_LIP
402         /* Build a lisp stack frame */
403         mr reg_OCFP,reg_CFP
404         mr reg_CFP,reg_CSP
405         la reg_CSP,32(reg_CSP)
406         stw reg_OCFP,0(reg_CFP)
407         stw reg_CODE,8(reg_CFP)
408         /* The pseudo-atomic mechanism wants to use reg_NL3, but that
409         may be an outgoing C argument.  Copy reg_NL3 to something that's
410         unboxed and -not- one of the C argument registers */
411         mr reg_NARGS,reg_NL3
412
413         /* Turn on pseudo-atomic */
414         li reg_NL3,-4
415         la reg_ALLOC,4(reg_ALLOC)
416
417         /* Convert the return address to an offset and save it on the stack. */
418         sub reg_NFP,reg_LIP,reg_CODE
419         la reg_NFP,OTHER_POINTER_LOWTAG(reg_NFP)
420         stw reg_NFP,4(reg_CFP)
421
422         /* Store Lisp state */
423         clrrwi reg_NFP,reg_ALLOC,3
424         store(reg_NFP,reg_CFUNC,CSYMBOL(dynamic_space_free_pointer))
425         /* load(reg_CFUNC,current_thread) */
426         
427         store(reg_BSP,reg_CFUNC,CSYMBOL(current_binding_stack_pointer))
428         store(reg_CSP,reg_CFUNC,CSYMBOL(current_control_stack_pointer))
429         store(reg_CFP,reg_CFUNC,CSYMBOL(current_control_frame_pointer))
430
431         /* No longer in Lisp */
432         store(reg_CSP,reg_CFUNC,CSYMBOL(foreign_function_call_active))
433         /* load(reg_POLL,saver2) */
434         /* Disable pseudo-atomic; check pending interrupt */
435         add reg_ALLOC,reg_ALLOC,reg_NL3
436         twlti reg_ALLOC,0
437         mr reg_NL3,reg_NARGS
438
439 #ifdef LISP_FEATURE_DARWIN
440         /* PowerOpen (i.e. OS X) requires the callee address in r12
441            (a.k.a. CFUNC), so move it back there, too. */
442         mfctr reg_CFUNC
443 #endif
444         /* Into C we go. */
445         bctrl
446
447         /* Re-establish NIL */
448 #ifdef LISP_FEATURE_DARWIN
449         lis reg_NULL,hi16(NIL)
450         ori reg_NULL,reg_NULL,lo16(NIL)
451 #else
452         lis reg_NULL,NIL@h
453         ori reg_NULL,reg_NULL,NIL@l
454 #endif
455         /* And reg_ZERO */
456         li reg_ZERO,0
457
458         /* If we GC'ed during the FF code (as the result of a callback ?)
459         the tagged lisp registers may now contain garbage (since the
460         registers were saved by C and not seen by the GC.)  Put something
461         harmless in all such registers before allowing an interrupt */
462         li reg_CODE,0
463         li reg_CNAME,0
464         li reg_LEXENV,0
465         /* reg_OCFP was pointing to a control stack frame & was preserved by C */
466         li reg_LRA,0
467         li reg_A0,0
468         li reg_A1,0
469         li reg_A2,0
470         li reg_A3,0
471         li reg_L0,0
472         li reg_L1,0
473         li reg_L2,0
474         li reg_LIP,0
475
476         /* Atomic ... */
477         li reg_NL3,-4
478         li reg_ALLOC,4
479
480         /* No long in foreign function call. */
481         store(reg_ZERO,reg_NL2,CSYMBOL(foreign_function_call_active))
482
483         /* The free pointer may have moved */
484         load(reg_NL4,CSYMBOL(dynamic_space_free_pointer))
485         add reg_ALLOC,reg_ALLOC,reg_NL4
486
487         /* The BSP wasn't preserved by C, so load it */
488         load(reg_BSP,CSYMBOL(current_binding_stack_pointer))
489
490         /* Other lisp stack/frame pointers were preserved by C.
491         I can't imagine why they'd have moved */
492
493         /* Get the return address back. */
494         lwz reg_LIP,4(reg_CFP)
495         lwz reg_CODE,8(reg_CFP)
496         add reg_LIP,reg_CODE,reg_LIP
497         la reg_LIP,-OTHER_POINTER_LOWTAG(reg_LIP)
498
499         /* No longer atomic */
500         add reg_ALLOC,reg_ALLOC,reg_NL3
501         twlti reg_ALLOC,0
502         mtlr reg_LIP
503         
504         /* Reset the lisp stack. */
505         mr reg_CSP,reg_CFP
506         mr reg_CFP,reg_OCFP
507         
508         /* And back into Lisp. */
509         blr
510
511         SET_SIZE(call_into_c)
512
513         GFUNCDEF(xundefined_tramp)
514         .globl CSYMBOL(undefined_tramp)
515         .byte 0,0,0,SIMPLE_FUN_HEADER_WIDETAG
516         .byte 18<<2
517 CSYMBOL(undefined_tramp):       
518         .byte 0,0,48
519         .long CSYMBOL(undefined_tramp)
520         .long NIL
521         .long NIL
522         .long NIL
523         twllei reg_ZERO,trap_Cerror
524         .byte 4
525         .byte UNDEFINED_FUN_ERROR
526         .byte 254, sc_DescriptorReg+0x40, 1     /* 140?  sparc says sc_descriptorReg */
527         .align 2
528 1:      lwz reg_CODE,FDEFN_RAW_ADDR_OFFSET(reg_FDEFN)
529         la reg_LIP,SIMPLE_FUN_CODE_OFFSET(reg_CODE)
530         mtctr reg_LIP
531         bctr
532         mr reg_CSP,reg_CFP
533         b 1b
534
535         SET_SIZE(xundefined_tramp)
536
537         GFUNCDEF(xclosure_tramp)
538         .globl CSYMBOL(closure_tramp)
539         .byte 0,0,0,SIMPLE_FUN_HEADER_WIDETAG
540         .byte 18<<2
541 CSYMBOL(closure_tramp):
542         .byte 0,0,24
543         .long CSYMBOL(closure_tramp)
544         .long NIL 
545         .long NIL
546         .long NIL
547         .long NIL
548         lwz reg_LEXENV,FDEFN_FUN_OFFSET(reg_FDEFN)
549         lwz reg_CODE,CLOSURE_FUN_OFFSET(reg_LEXENV)
550         la reg_LIP,SIMPLE_FUN_CODE_OFFSET(reg_CODE)
551         mtctr reg_LIP
552         bctr
553
554         SET_SIZE(xclosure_tramp)
555
556         GFUNCDEF(fun_end_breakpoint_trap)
557         .long 0
558         SET_SIZE(fun_end_breakpoint_trap)
559
560         GFUNCDEF(fun_end_breakpoint)
561         .long 0
562         SET_SIZE(fun_end_breakpoint)
563
564         GFUNCDEF(fun_end_breakpoint_guts)
565         .long 0
566         SET_SIZE(fun_end_breakpoint_guts)
567
568         GFUNCDEF(fun_end_breakpoint_end)
569         .long 0
570         SET_SIZE(fun_end_breakpoint_end)
571
572
573         GFUNCDEF(ppc_flush_cache_line)
574         dcbf 0,REG(3)
575         sync
576         icbi 0,REG(3)
577         sync
578         isync
579         blr
580         SET_SIZE(ppc_flush_cache_line)
581