| blob | 32ec9123af3bd5c5db5bfe1726dfe418b0199c27 |
1 #define LANGUAGE_ASSEMBLY
3 #include "sbcl.h"
4 #include "lispregs.h"
5 #include "globals.h"
7 #include "genesis/simple-fun.h"
8 #include "genesis/fdefn.h"
9 #include "genesis/closure.h"
10 #include "genesis/funcallable-instance.h"
11 #include "genesis/static-symbols.h"
12 #ifdef LISP_FEATURE_SB_THREAD
13 #include "genesis/thread.h"
14 #endif
16 #ifdef LISP_FEATURE_DARWIN
17 #define CSYMBOL(x) _ ## x
18 #else
19 #define CSYMBOL(x) x
20 #endif
22 #if defined LISP_FEATURE_DARWIN
23 #define FUNCDEF(x) .text @ \
24 .align 3 @ \
25 _##x:
27 #define GFUNCDEF(x) .globl _ ## x @ \
28 FUNCDEF(x)
29 #else
30 #define FUNCDEF(x) .text ; \
31 .align 3 ; \
32 .type x,@function ; \
33 x:
35 #define GFUNCDEF(x) .globl x ; \
36 FUNCDEF(x)
37 #endif
39 #if defined LISP_FEATURE_DARWIN
40 #define SET_SIZE(x)
41 #else
42 #define SET_SIZE(x) .size x,.-x
43 #endif
45 /* Load a register from a global, using the register as an intermediary */
46 /* The register will be a fixnum for one instruction, so this is gc-safe */
48 #if defined LISP_FEATURE_DARWIN
49 #define load(reg,global) \
50 lis reg,ha16(global) @ \
51 lwz reg,lo16(global)(reg) ; Comment
52 #define store(reg,temp,global) \
53 lis temp,ha16(global) @\
54 stw reg,lo16(global)(temp) ; Comment
55 #else
56 #define load(reg,global) \
57 lis reg,global@ha; lwz reg,global@l(reg)
58 #define store(reg,temp,global) \
59 lis temp,global@ha; stw reg,global@l(temp)
60 #endif
62 #define FIRST_SAVE_FPR 14 /* lowest-numbered non-volatile FPR */
63 #ifdef LISP_FEATURE_DARWIN
64 #define FIRST_SAVE_GPR 13 /* lowest-numbered non-volatile GPR */
65 #define NGPR_SAVE_BYTES(n) ((32-(n))*4)
66 #define FRAME_ARG_BYTES(n) (((((n)+6)*4)+15)&~15)
67 #else
68 #define FIRST_SAVE_GPR 14 /* lowest-numbered non-volatile GPR */
69 #define NGPR_SAVE_BYTES(n) ((32-(~1&((n)+1)))*4)
70 #define FRAME_ARG_BYTES(n) (((((n)+2)*4)+15)&~15)
71 #endif
72 #define NFPR_SAVE_BYTES(n) ((32-(n))*8)
74 #ifdef LISP_FEATURE_DARWIN
75 #define FRAME_SIZE(first_g,first_f,out_arg_words,savecr) \
76 (NFPR_SAVE_BYTES(first_f)+ NGPR_SAVE_BYTES(first_g)+ FRAME_ARG_BYTES(out_arg_words))
77 #define SAVE_FPR(n) stfd f##n,-8*(32- n)(r11)
78 #define SAVE_GPR(n) stw r##n,-4*(32- n)(r11)
79 #define FULL_FRAME_SIZE (FRAME_SIZE(FIRST_SAVE_GPR,FIRST_SAVE_FPR,8,1)+15&~15)
80 #define RESTORE_FPR(n) lfd f##n,-8*(32- n)(r11)
81 #define RESTORE_GPR(n) lwz r##n,-4*(32- n)(r11)
82 #else
83 #define FRAME_SIZE(first_g,first_f,out_arg_words,savecr) \
84 (NFPR_SAVE_BYTES(first_f)+ NGPR_SAVE_BYTES(first_g)+ FRAME_ARG_BYTES(out_arg_words+savecr))
85 #define SAVE_FPR(n) stfd n,-8*(32-(n))(11)
86 #define SAVE_GPR(n) stw n,-4*(32-(n))(11)
87 #define FULL_FRAME_SIZE FRAME_SIZE(FIRST_SAVE_GPR,FIRST_SAVE_FPR,0,1)
89 #define RESTORE_FPR(n) lfd n,-8*(32-(n))(11)
90 #define RESTORE_GPR(n) lwz n,-4*(32-(n))(11)
91 #endif
93 #ifdef LISP_FEATURE_DARWIN
94 #define C_FULL_PROLOG \
95 nop @\
96 nop @ \
97 mfcr REG(0) @ \
98 stw REG(0),4(REG(1)) @ \
99 mflr REG(0) @ \
100 stw REG(0),8(REG(1)) @ \
101 mr REG(11),REG(1) @ \
102 stwu REG(1),-FULL_FRAME_SIZE(REG(1)) @ \
103 SAVE_FPR(14) @ \
104 SAVE_FPR(15) @ \
105 SAVE_FPR(16) @ \
106 SAVE_FPR(17) @ \
107 SAVE_FPR(18) @ \
108 SAVE_FPR(19) @ \
109 SAVE_FPR(20) @ \
110 SAVE_FPR(21) @ \
111 SAVE_FPR(22) @ \
112 SAVE_FPR(23) @ \
113 SAVE_FPR(24) @ \
114 SAVE_FPR(25) @ \
115 SAVE_FPR(26) @ \
116 SAVE_FPR(27) @ \
117 SAVE_FPR(28) @ \
118 SAVE_FPR(29) @ \
119 SAVE_FPR(30) @ \
120 SAVE_FPR(31) @ \
121 la REG(11),-NFPR_SAVE_BYTES(FIRST_SAVE_FPR)(REG(11)) @ \
122 SAVE_GPR(13) @ \
123 SAVE_GPR(14) @ \
124 SAVE_GPR(15) @ \
125 SAVE_GPR(16) @ \
126 SAVE_GPR(17) @ \
127 SAVE_GPR(18) @ \
128 SAVE_GPR(19) @ \
129 SAVE_GPR(20) @ \
130 SAVE_GPR(21) @ \
131 SAVE_GPR(22) @ \
132 SAVE_GPR(23) @ \
133 SAVE_GPR(24) @ \
134 SAVE_GPR(25) @ \
135 SAVE_GPR(26) @ \
136 SAVE_GPR(27) @ \
137 SAVE_GPR(28) @ \
138 SAVE_GPR(29) @ \
139 SAVE_GPR(30) @ \
140 SAVE_GPR(31)
143 #define C_FULL_EPILOG \
144 la REG(11),FULL_FRAME_SIZE-NFPR_SAVE_BYTES(FIRST_SAVE_FPR)(REG(1)) @ \
145 RESTORE_GPR(13) @ \
146 RESTORE_GPR(14) @ \
147 RESTORE_GPR(15) @ \
148 RESTORE_GPR(16) @ \
149 RESTORE_GPR(17) @ \
150 RESTORE_GPR(18) @ \
151 RESTORE_GPR(19) @ \
152 RESTORE_GPR(20) @ \
153 RESTORE_GPR(21) @ \
154 RESTORE_GPR(22) @ \
155 RESTORE_GPR(23) @ \
156 RESTORE_GPR(24) @ \
157 RESTORE_GPR(25) @ \
158 RESTORE_GPR(26) @ \
159 RESTORE_GPR(27) @ \
160 RESTORE_GPR(28) @ \
161 RESTORE_GPR(29) @ \
162 RESTORE_GPR(30) @ \
163 RESTORE_GPR(31) @ \
164 la REG(11),NFPR_SAVE_BYTES(FIRST_SAVE_FPR)(REG(11)) @ \
165 RESTORE_FPR(14) @ \
166 RESTORE_FPR(15) @ \
167 RESTORE_FPR(16) @ \
168 RESTORE_FPR(17) @ \
169 RESTORE_FPR(18) @ \
170 RESTORE_FPR(19) @ \
171 RESTORE_FPR(20) @ \
172 RESTORE_FPR(21) @ \
173 RESTORE_FPR(22) @ \
174 RESTORE_FPR(23) @ \
175 RESTORE_FPR(24) @ \
176 RESTORE_FPR(25) @ \
177 RESTORE_FPR(26) @ \
178 RESTORE_FPR(27) @ \
179 RESTORE_FPR(28) @ \
180 RESTORE_FPR(29) @ \
181 RESTORE_FPR(30) @ \
182 RESTORE_FPR(31) @ \
183 lwz REG(1),0(REG(1)) @ \
184 lwz REG(0),4(REG(1)) @ \
185 mtcr REG(0) @ \
186 lwz REG(0),8(REG(1)) @ \
187 mtlr REG(0) @ \
189 #else
191 #define C_FULL_PROLOG \
192 mflr 0 ; \
193 stw 0,4(1) ; \
194 mr 11,1 ; \
195 stwu 1,-FULL_FRAME_SIZE(1) ; \
196 SAVE_FPR(14) ; \
197 SAVE_FPR(15) ; \
198 SAVE_FPR(16) ; \
199 SAVE_FPR(17) ; \
200 SAVE_FPR(18) ; \
201 SAVE_FPR(19) ; \
202 SAVE_FPR(20) ; \
203 SAVE_FPR(21) ; \
204 SAVE_FPR(22) ; \
205 SAVE_FPR(23) ; \
206 SAVE_FPR(24) ; \
207 SAVE_FPR(25) ; \
208 SAVE_FPR(26) ; \
209 SAVE_FPR(27) ; \
210 SAVE_FPR(28) ; \
211 SAVE_FPR(29) ; \
212 SAVE_FPR(30) ; \
213 SAVE_FPR(31) ; \
214 la 11,-NFPR_SAVE_BYTES(FIRST_SAVE_FPR)(11) ; \
215 SAVE_GPR(14) ; \
216 SAVE_GPR(15) ; \
217 SAVE_GPR(16) ; \
218 SAVE_GPR(17) ; \
219 SAVE_GPR(18) ; \
220 SAVE_GPR(19) ; \
221 SAVE_GPR(20) ; \
222 SAVE_GPR(21) ; \
223 SAVE_GPR(22) ; \
224 SAVE_GPR(23) ; \
225 SAVE_GPR(24) ; \
226 SAVE_GPR(25) ; \
227 SAVE_GPR(26) ; \
228 SAVE_GPR(27) ; \
229 SAVE_GPR(28) ; \
230 SAVE_GPR(29) ; \
231 SAVE_GPR(30) ; \
232 SAVE_GPR(31) ; \
233 mfcr 0 ; \
234 stw 0,8(1)
236 #define C_FULL_EPILOG \
237 lwz 5,8(1) ; \
238 mtcrf 255,5 ; \
239 la 11,FULL_FRAME_SIZE-NFPR_SAVE_BYTES(FIRST_SAVE_FPR)(1) ; \
240 RESTORE_GPR(14) ; \
241 RESTORE_GPR(15) ; \
242 RESTORE_GPR(16) ; \
243 RESTORE_GPR(17) ; \
244 RESTORE_GPR(18) ; \
245 RESTORE_GPR(19) ; \
246 RESTORE_GPR(20) ; \
247 RESTORE_GPR(21) ; \
248 RESTORE_GPR(22) ; \
249 RESTORE_GPR(23) ; \
250 RESTORE_GPR(24) ; \
251 RESTORE_GPR(25) ; \
252 RESTORE_GPR(26) ; \
253 RESTORE_GPR(27) ; \
254 RESTORE_GPR(28) ; \
255 RESTORE_GPR(29) ; \
256 RESTORE_GPR(30) ; \
257 RESTORE_GPR(31) ; \
258 la 11,NFPR_SAVE_BYTES(FIRST_SAVE_FPR)(11) ; \
259 RESTORE_FPR(14) ; \
260 RESTORE_FPR(15) ; \
261 RESTORE_FPR(16) ; \
262 RESTORE_FPR(17) ; \
263 RESTORE_FPR(18) ; \
264 RESTORE_FPR(19) ; \
265 RESTORE_FPR(20) ; \
266 RESTORE_FPR(21) ; \
267 RESTORE_FPR(22) ; \
268 RESTORE_FPR(23) ; \
269 RESTORE_FPR(24) ; \
270 RESTORE_FPR(25) ; \
271 RESTORE_FPR(26) ; \
272 RESTORE_FPR(27) ; \
273 RESTORE_FPR(28) ; \
274 RESTORE_FPR(29) ; \
275 RESTORE_FPR(30) ; \
276 RESTORE_FPR(31) ; \
277 lwz 1,0(1) ; \
278 lwz 0,4(1) ; \
279 mtlr 0 ; \
281 #endif
283 .text
285 /*
286 * Function to transfer control into lisp. The lisp object to invoke is
287 * passed as the first argument, which puts it in NL0
288 */
290 GFUNCDEF(call_into_lisp)
291 C_FULL_PROLOG
292 /* NL0 - function, NL1 - frame pointer, NL2 - nargs. */
293 #if defined(LISP_FEATURE_SB_THREAD)
294 /* We need to obtain a pointer to our TLS block before we do
295 * anything else. For this, we call pthread_getspecific().
296 * We've preserved all of the callee-saves registers, so we
297 * can use them to stash our arguments temporarily while we
298 * make the call. */
299 mr reg_A0, reg_NL0
300 mr reg_A1, reg_NL1
301 mr reg_A2, reg_NL2
303 /* Call out to obtain our TLS block. */
304 load(reg_NL0,CSYMBOL(specials))
305 /* This won't work on darwin: wrong fixup style. And is it
306 * supposed to be lis/ori or lis/addi? Or does it differ
307 * between darwin and everything else again? */
308 lis reg_CFUNC,CSYMBOL(pthread_getspecific)@h
309 ori reg_CFUNC,reg_CFUNC,CSYMBOL(pthread_getspecific)@l
310 mtctr reg_CFUNC
311 bctrl
312 mr reg_THREAD, reg_NL0
314 /* Restore our original parameters. */
315 mr reg_NL2, reg_A2
316 mr reg_NL1, reg_A1
317 mr reg_NL0, reg_A0
318 #endif
319 /* store(reg_POLL,11,saver2) */
320 /* Initialize tagged registers */
321 li reg_ZERO,0
322 li reg_CODE,0
323 li reg_CNAME,0
324 li reg_LEXENV,0
325 li reg_FDEFN,0
326 li reg_OCFP,0
327 li reg_LRA,0
328 li reg_A0,0
329 li reg_A1,0
330 li reg_A2,0
331 li reg_A3,0
332 li reg_L0,0
333 li reg_L1,0
334 #if !defined(LISP_FEATURE_SB_THREAD)
335 li reg_L2,0
336 #endif
337 li reg_LIP,0
338 #ifdef LISP_FEATURE_DARWIN
339 lis reg_NULL,hi16(NIL)
340 ori reg_NULL,reg_NULL,lo16(NIL)
341 #else
342 lis reg_NULL,NIL@h
343 ori reg_NULL,reg_NULL,NIL@l
344 #endif
345 /* Turn on pseudo-atomic */
347 li reg_ALLOC,flag_PseudoAtomic
348 #if defined(LISP_FEATURE_SB_THREAD)
349 stw reg_ZERO,THREAD_FOREIGN_FUNCTION_CALL_ACTIVE_OFFSET(reg_THREAD)
350 lwz reg_BSP,THREAD_BINDING_STACK_POINTER_OFFSET(reg_THREAD)
351 lwz reg_CSP,THREAD_CONTROL_STACK_POINTER_OFFSET(reg_THREAD)
352 lwz reg_OCFP,THREAD_CONTROL_FRAME_POINTER_OFFSET(reg_THREAD)
353 #else
354 store(reg_ZERO,reg_NL4,CSYMBOL(foreign_function_call_active))
355 load(reg_BSP,CSYMBOL(current_binding_stack_pointer))
356 load(reg_CSP,CSYMBOL(current_control_stack_pointer))
357 load(reg_OCFP,CSYMBOL(current_control_frame_pointer))
358 #endif
359 /* This is important for CHENEYGC: It's the allocation
360 * pointer. It's also important for ROOM on GENCGC:
361 * It's a pointer to the end of dynamic space, used to
362 * determine where to stop in MAP-ALLOCATED-OBJECTS. */
363 load(reg_NL4,CSYMBOL(dynamic_space_free_pointer))
364 add reg_ALLOC,reg_ALLOC,reg_NL4
366 /* No longer atomic, and check for interrupt */
367 subi reg_ALLOC,reg_ALLOC,flag_PseudoAtomic
368 andi. reg_NL3, reg_ALLOC, flag_PseudoAtomicInterrupted
369 twnei reg_NL3, 0
371 /* Pass in the arguments */
373 mr reg_CFP,reg_NL1
374 mr reg_LEXENV,reg_NL0
375 lwz reg_A0,0(reg_CFP)
376 lwz reg_A1,4(reg_CFP)
377 lwz reg_A2,8(reg_CFP)
378 lwz reg_A3,12(reg_CFP)
380 /* Calculate LRA */
381 #ifdef LISP_FEATURE_DARWIN
382 lis reg_LRA,ha16(lra)
383 addi reg_LRA,reg_LRA,lo16(lra)
384 #else
385 lis reg_LRA,lra@h
386 ori reg_LRA,reg_LRA,lra@l
387 #endif
388 addi reg_LRA,reg_LRA,OTHER_POINTER_LOWTAG
390 /* Function is an indirect closure */
391 lwz reg_CODE,SIMPLE_FUN_SELF_OFFSET(reg_LEXENV)
392 addi reg_LIP,reg_CODE,SIMPLE_FUN_CODE_OFFSET
393 mtctr reg_LIP
394 slwi reg_NARGS,reg_NL2,2
395 bctr
397 .align 3
398 lra:
399 .long RETURN_PC_HEADER_WIDETAG
401 /* Blow off any extra values. */
402 mr reg_CSP,reg_OCFP
403 nop
405 /* Return the one value. */
407 mr REG(3),reg_A0
409 /* Turn on pseudo-atomic */
410 la reg_ALLOC,flag_PseudoAtomic(reg_ALLOC)
412 #if defined(LISP_FEATURE_SB_THREAD)
413 /* Store lisp state */
414 stw reg_BSP,THREAD_BINDING_STACK_POINTER_OFFSET(reg_THREAD)
415 stw reg_CSP,THREAD_CONTROL_STACK_POINTER_OFFSET(reg_THREAD)
416 stw reg_CFP,THREAD_CONTROL_FRAME_POINTER_OFFSET(reg_THREAD)
418 /* No longer in Lisp. */
419 stw reg_ALLOC,THREAD_FOREIGN_FUNCTION_CALL_ACTIVE_OFFSET(reg_THREAD)
420 #else
421 /* Store lisp state */
422 clrrwi reg_NL1,reg_ALLOC,3
423 store(reg_NL1,reg_NL2,CSYMBOL(dynamic_space_free_pointer))
424 /* store(reg_POLL,reg_NL2,poll_flag) */
425 /* load(reg_NL2,current_thread) */
426 store(reg_BSP,reg_NL2,CSYMBOL(current_binding_stack_pointer))
427 store(reg_CSP,reg_NL2,CSYMBOL(current_control_stack_pointer))
428 store(reg_CFP,reg_NL2,CSYMBOL(current_control_frame_pointer))
429 /* load(reg_POLL,saver2) */
431 /* No longer in Lisp. */
432 store(reg_NL1,reg_NL2,CSYMBOL(foreign_function_call_active))
433 #endif
435 /* Check for interrupt */
436 subi reg_ALLOC, reg_ALLOC, flag_PseudoAtomic
437 andi. reg_NL3, reg_ALLOC, flag_PseudoAtomicInterrupted
438 twnei reg_NL3,0
440 /* Back to C */
441 C_FULL_EPILOG
442 blr
443 SET_SIZE(call_into_lisp)
444 \f
446 GFUNCDEF(call_into_c)
447 /* We're kind of low on unboxed, non-dedicated registers here:
448 most of the unboxed registers may have outgoing C args in them.
449 CFUNC is going to have to go in the CTR in a moment, anyway
450 so we'll free it up soon. reg_NFP is preserved by lisp if it
451 has a meaningful value in it, so we can use it. reg_NARGS is
452 free when it's not holding a copy of the "real" reg_NL3, which
453 gets tied up by the pseudo-atomic mechanism */
454 mtctr reg_CFUNC
455 mflr reg_LIP
456 /* Build a lisp stack frame */
457 mr reg_OCFP,reg_CFP
458 mr reg_CFP,reg_CSP
459 la reg_CSP,32(reg_CSP)
460 stw reg_OCFP,0(reg_CFP)
461 stw reg_CODE,8(reg_CFP)
462 /* The pseudo-atomic mechanism wants to use reg_NL3, but that
463 may be an outgoing C argument. Copy reg_NL3 to something that's
464 unboxed and -not- one of the C argument registers */
465 mr reg_NARGS,reg_NL3
467 /* Turn on pseudo-atomic */
468 la reg_ALLOC,flag_PseudoAtomic(reg_ALLOC)
470 /* Convert the return address to an offset and save it on the stack. */
471 sub reg_NFP,reg_LIP,reg_CODE
472 la reg_NFP,OTHER_POINTER_LOWTAG(reg_NFP)
473 stw reg_NFP,4(reg_CFP)
475 #ifdef LISP_FEATURE_SB_THREAD
476 /* Store Lisp state */
477 stw reg_BSP,THREAD_BINDING_STACK_POINTER_OFFSET(reg_THREAD)
478 stw reg_CSP,THREAD_CONTROL_STACK_POINTER_OFFSET(reg_THREAD)
479 stw reg_CFP,THREAD_CONTROL_FRAME_POINTER_OFFSET(reg_THREAD)
481 /* No longer in Lisp. */
482 stw reg_CSP,THREAD_FOREIGN_FUNCTION_CALL_ACTIVE_OFFSET(reg_THREAD)
483 #else
484 /* Store Lisp state */
485 clrrwi reg_NFP,reg_ALLOC,3
486 store(reg_NFP,reg_CFUNC,CSYMBOL(dynamic_space_free_pointer))
487 /* load(reg_CFUNC,current_thread) */
489 store(reg_BSP,reg_CFUNC,CSYMBOL(current_binding_stack_pointer))
490 store(reg_CSP,reg_CFUNC,CSYMBOL(current_control_stack_pointer))
491 store(reg_CFP,reg_CFUNC,CSYMBOL(current_control_frame_pointer))
493 /* No longer in Lisp */
494 store(reg_CSP,reg_CFUNC,CSYMBOL(foreign_function_call_active))
495 #endif
496 /* load(reg_POLL,saver2) */
497 /* Disable pseudo-atomic; check pending interrupt */
498 subi reg_ALLOC, reg_ALLOC, flag_PseudoAtomic
499 andi. reg_NL3, reg_ALLOC, flag_PseudoAtomicInterrupted
500 twnei reg_NL3, 0
502 mr reg_NL3,reg_NARGS
504 #ifdef LISP_FEATURE_DARWIN
505 /* PowerOpen (i.e. OS X) requires the callee address in r12
506 (a.k.a. CFUNC), so move it back there, too. */
507 mfctr reg_CFUNC
508 #endif
509 /* Into C we go. */
510 bctrl
512 /* Re-establish NIL */
513 #ifdef LISP_FEATURE_DARWIN
514 lis reg_NULL,hi16(NIL)
515 ori reg_NULL,reg_NULL,lo16(NIL)
516 #else
517 lis reg_NULL,NIL@h
518 ori reg_NULL,reg_NULL,NIL@l
519 #endif
520 /* And reg_ZERO */
521 li reg_ZERO,0
523 /* If we GC'ed during the FF code (as the result of a callback ?)
524 the tagged lisp registers may now contain garbage (since the
525 registers were saved by C and not seen by the GC.) Put something
526 harmless in all such registers before allowing an interrupt */
527 li reg_CODE,0
528 li reg_CNAME,0
529 li reg_LEXENV,0
530 /* reg_OCFP was pointing to a control stack frame & was preserved by C */
531 li reg_LRA,0
532 li reg_A0,0
533 li reg_A1,0
534 li reg_A2,0
535 li reg_A3,0
536 li reg_L0,0
537 li reg_L1,0
538 #if !defined(LISP_FEATURE_SB_THREAD)
539 /* reg_L2 is our TLS block pointer. */
540 li reg_L2,0
541 #endif
542 li reg_LIP,0
544 /* Atomic ... */
545 li reg_ALLOC,flag_PseudoAtomic
547 #if defined(LISP_FEATURE_SB_THREAD)
548 /* No longer in foreign function call. */
549 stw reg_ZERO,THREAD_FOREIGN_FUNCTION_CALL_ACTIVE_OFFSET(reg_THREAD)
551 /* The binding stack pointer isn't preserved by C. */
552 lwz reg_BSP,THREAD_BINDING_STACK_POINTER_OFFSET(reg_THREAD)
553 #else
554 /* No long in foreign function call. */
555 store(reg_ZERO,reg_NL2,CSYMBOL(foreign_function_call_active))
557 /* The free pointer may have moved */
558 /* (moved below) */
560 /* The BSP wasn't preserved by C, so load it */
561 load(reg_BSP,CSYMBOL(current_binding_stack_pointer))
562 #endif
563 /* This is important for CHENEYGC: It's the allocation
564 * pointer. It's also important for ROOM on GENCGC:
565 * It's a pointer to the end of dynamic space, used to
566 * determine where to stop in MAP-ALLOCATED-OBJECTS. */
567 load(reg_NL4,CSYMBOL(dynamic_space_free_pointer))
568 add reg_ALLOC,reg_ALLOC,reg_NL4
570 /* Other lisp stack/frame pointers were preserved by C.
571 I can't imagine why they'd have moved */
573 /* Get the return address back. */
574 lwz reg_LIP,4(reg_CFP)
575 lwz reg_CODE,8(reg_CFP)
576 add reg_LIP,reg_CODE,reg_LIP
577 la reg_LIP,-OTHER_POINTER_LOWTAG(reg_LIP)
579 /* No longer atomic */
580 subi reg_ALLOC, reg_ALLOC, flag_PseudoAtomic
581 andi. reg_NL3, reg_ALLOC, flag_PseudoAtomicInterrupted
582 twnei reg_NL3, 0
584 mtlr reg_LIP
586 /* Reset the lisp stack. */
587 mr reg_CSP,reg_CFP
588 mr reg_CFP,reg_OCFP
590 /* And back into Lisp. */
591 blr
593 SET_SIZE(call_into_c)
595 GFUNCDEF(xundefined_tramp)
596 .globl CSYMBOL(undefined_tramp)
597 .long SIMPLE_FUN_HEADER_WIDETAG /* header */
598 .long CSYMBOL(undefined_tramp) - SIMPLE_FUN_CODE_OFFSET /* self */
599 .long NIL /* next */
600 .long NIL /* name */
601 .long NIL /* arglist */
602 .long NIL /* type */
603 .long NIL /* xref */
604 CSYMBOL(undefined_tramp):
605 /* Point reg_CODE to the header and tag it as function, since
606 the debugger regards a function pointer in reg_CODE which
607 doesn't point to a code object as undefined function. */
608 /* We are given that reg_LIP points to undefined_tramp by
609 virtue of the calling convention. */
610 addi reg_CODE,reg_LIP,-SIMPLE_FUN_CODE_OFFSET
612 /* If we are called with stack arguments (or in a tail-call
613 scenario), we end up with an allocated stack frame, but the
614 frame link information is uninitialized. Fix things by
615 allocating and initializing our stack frame "properly". */
616 cmpwi cr0,reg_NARGS,16
617 bt gt,1f
618 addi reg_CSP,reg_CFP,16
619 b 2f
620 1: add reg_CSP,reg_CFP,reg_NARGS
621 2: stw reg_OCFP,0(reg_CFP)
622 stw reg_LRA,4(reg_CFP)
624 /* Now that the preliminaries are dealt with, actually trap. */
625 twllei reg_ZERO,trap_Cerror
626 .byte 4
627 .byte UNDEFINED_FUN_ERROR
628 .byte 254, sc_DescriptorReg+0x40, 1 /* 140? sparc says sc_descriptorReg */
629 /* This stuff is for the continuable error. I don't think there's
630 * any support for it on the lisp side */
631 .align 2
632 1: lwz reg_CODE,FDEFN_RAW_ADDR_OFFSET(reg_FDEFN)
633 la reg_LIP,SIMPLE_FUN_CODE_OFFSET(reg_CODE)
634 mtctr reg_LIP
635 bctr
636 mr reg_CSP,reg_CFP
637 b 1b
639 SET_SIZE(xundefined_tramp)
641 GFUNCDEF(xclosure_tramp)
642 .globl CSYMBOL(closure_tramp)
643 CSYMBOL(closure_tramp):
644 lwz reg_LEXENV,FDEFN_FUN_OFFSET(reg_FDEFN)
645 lwz reg_CODE,CLOSURE_FUN_OFFSET(reg_LEXENV)
646 la reg_LIP,SIMPLE_FUN_CODE_OFFSET(reg_CODE)
647 mtctr reg_LIP
648 bctr
650 SET_SIZE(xclosure_tramp)
652 GFUNCDEF(xfuncallable_instance_tramp)
653 .globl CSYMBOL(funcallable_instance_tramp)
654 .long SIMPLE_FUN_HEADER_WIDETAG
655 CSYMBOL(funcallable_instance_tramp) = . + 1
656 .long CSYMBOL(funcallable_instance_tramp)
657 .long NIL
658 .long NIL
659 .long NIL
660 .long NIL
661 .long NIL
662 lwz reg_LEXENV,FUNCALLABLE_INSTANCE_FUNCTION_OFFSET(reg_LEXENV)
663 lwz reg_FDEFN,CLOSURE_FUN_OFFSET(reg_LEXENV)
664 addi reg_LIP,reg_FDEFN,SIMPLE_FUN_CODE_OFFSET
665 mtctr reg_LIP
666 bctr
667 SET_SIZE(funcallable_instance_tramp)
668 \f
669 /* The fun_end_breakpoint support here is considered by the
670 authors of the other $ARCH-assem.S files to be magic, and it
671 is. It is a small fragment of code that is copied into a heap
672 code-object when needed, and contains an LRA object, code to
673 convert a single-value return to unknown-values format, and a
674 trap_FunEndBreakpoint. */
675 GFUNCDEF(fun_end_breakpoint_guts)
676 .globl CSYMBOL(fun_end_breakpoint_trap)
677 .globl CSYMBOL(fun_end_breakpoint_end)
679 /* Due to pointer verification in MAKE-LISP-OBJ, this must
680 include its header data (the offset from the start of the
681 code-object to the LRA). The code-object header is five
682 words, there are two words of constants, and the instruction
683 space is doubleword-aligned, making an offset of eight.
684 This is header data for a widetag, so shift left eight bits
685 and add. */
686 .long RETURN_PC_HEADER_WIDETAG + 0x800
688 /* We are receiving unknown multiple values, thus must deal
689 with the single-value and multiple-value cases separately. */
690 b fun_end_breakpoint_multiple_values
691 nop
693 /* Compute the correct value for reg_CODE based on the LRA.
694 This is a "simple" matter of subtracting a constant from
695 reg_LRA (where the LRA is stored by the return sequence) to
696 obtain a tagged pointer to the enclosing code component. Both
697 values are tagged OTHER_POINTER_LOWTAG, so we just have to
698 account for the eight words (see calculation for
699 RETURN_PC_HEADER_WIDETAG, above) between the two addresses.
700 Restoring reg_CODE doesn't appear to be strictly necessary
701 here, but let's observe the niceties.*/
702 addi reg_CODE, reg_LRA, -32
704 /* Multiple values are stored relative to reg_OCFP, which we
705 set to be the current top-of-stack. */
706 mr reg_OCFP, reg_CSP
708 /* Reserve a save location for the one value we have. */
709 addi reg_CSP, reg_CSP, 4
711 /* Record the number of values we have as a FIXNUM. */
712 li reg_NARGS, 4
714 /* Blank the remaining arg-passing registers. */
715 mr reg_A1, reg_NULL
716 mr reg_A2, reg_NULL
717 mr reg_A3, reg_NULL
719 /* And branch to our trap. */
720 b CSYMBOL(fun_end_breakpoint_trap)
722 fun_end_breakpoint_multiple_values:
723 /* Compute the correct value for reg_CODE. See the
724 explanation for the single-value case, above. */
725 addi reg_CODE, reg_LRA, -32
727 /* The actual magic trap. */
728 CSYMBOL(fun_end_breakpoint_trap):
729 twllei reg_ZERO, trap_FunEndBreakpoint
731 /* Finally, the debugger needs to know where the end of the
732 fun_end_breakpoint_guts are, so that it may calculate its size
733 in order to populate out a suitably-sized code object. */
734 CSYMBOL(fun_end_breakpoint_end):
735 SET_SIZE(fun_end_breakpoint_guts)
736 \f
738 GFUNCDEF(ppc_flush_cache_line)
739 dcbf 0,REG(3)
740 sync
741 icbi 0,REG(3)
742 sync
743 isync
744 blr
745 SET_SIZE(ppc_flush_cache_line)
747 GFUNCDEF(do_pending_interrupt)
748 twllei reg_ZERO, trap_PendingInterrupt
749 blr
750 /* King Nato's branch has a nop here. Do we need this? */
751 SET_SIZE(do_pending_interrupt)
753 #if defined LISP_FEATURE_GENCGC
755 GFUNCDEF(fpu_save)
756 stfd FREG(1), 0(REG(3))
757 stfd FREG(2), 8(REG(3))
758 stfd FREG(3), 16(REG(3))
759 stfd FREG(4), 24(REG(3))
760 stfd FREG(5), 32(REG(3))
761 stfd FREG(6), 40(REG(3))
762 stfd FREG(7), 48(REG(3))
763 stfd FREG(8), 56(REG(3))
764 stfd FREG(9), 64(REG(3))
765 stfd FREG(10), 72(REG(3))
766 stfd FREG(11), 80(REG(3))
767 stfd FREG(12), 88(REG(3))
768 stfd FREG(13), 96(REG(3))
769 stfd FREG(14), 104(REG(3))
770 stfd FREG(15), 112(REG(3))
771 stfd FREG(16), 120(REG(3))
772 stfd FREG(17), 128(REG(3))
773 stfd FREG(18), 136(REG(3))
774 stfd FREG(19), 144(REG(3))
775 stfd FREG(20), 152(REG(3))
776 stfd FREG(21), 160(REG(3))
777 stfd FREG(22), 168(REG(3))
778 stfd FREG(23), 176(REG(3))
779 stfd FREG(24), 184(REG(3))
780 stfd FREG(25), 192(REG(3))
781 stfd FREG(26), 200(REG(3))
782 stfd FREG(27), 208(REG(3))
783 stfd FREG(28), 216(REG(3))
784 stfd FREG(29), 224(REG(3))
785 stfd FREG(30), 232(REG(3))
786 stfd FREG(31), 240(REG(3))
787 blr
788 SET_SIZE(fpu_save)
790 GFUNCDEF(fpu_restore)
791 lfd FREG(1), 0(REG(3))
792 lfd FREG(2), 8(REG(3))
793 lfd FREG(3), 16(REG(3))
794 lfd FREG(4), 24(REG(3))
795 lfd FREG(5), 32(REG(3))
796 lfd FREG(6), 40(REG(3))
797 lfd FREG(7), 48(REG(3))
798 lfd FREG(8), 56(REG(3))
799 lfd FREG(9), 64(REG(3))
800 lfd FREG(10), 72(REG(3))
801 lfd FREG(11), 80(REG(3))
802 lfd FREG(12), 88(REG(3))
803 lfd FREG(13), 96(REG(3))
804 lfd FREG(14), 104(REG(3))
805 lfd FREG(15), 112(REG(3))
806 lfd FREG(16), 120(REG(3))
807 lfd FREG(17), 128(REG(3))
808 lfd FREG(18), 136(REG(3))
809 lfd FREG(19), 144(REG(3))
810 lfd FREG(20), 152(REG(3))
811 lfd FREG(21), 160(REG(3))
812 lfd FREG(22), 168(REG(3))
813 lfd FREG(23), 176(REG(3))
814 lfd FREG(24), 184(REG(3))
815 lfd FREG(25), 192(REG(3))
816 lfd FREG(26), 200(REG(3))
817 lfd FREG(27), 208(REG(3))
818 lfd FREG(28), 216(REG(3))
819 lfd FREG(29), 224(REG(3))
820 lfd FREG(30), 232(REG(3))
821 lfd FREG(31), 240(REG(3))
822 blr
823 SET_SIZE(fpu_restore)
825 #endif