1 #define LANGUAGE_ASSEMBLY
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"
16 #ifdef LISP_FEATURE_DARWIN
17 #define CSYMBOL(x) _ ## x
22 #if defined LISP_FEATURE_DARWIN
23 #define FUNCDEF(x) .text @ \
27 #define GFUNCDEF(x) .globl _ ## x @ \
30 #define FUNCDEF(x) .text ; \
35 #define GFUNCDEF(x) .globl x ; \
39 #if defined LISP_FEATURE_DARWIN
42 #define SET_SIZE(x) .size x,.-x
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
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)
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)
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)
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)
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)
93 #ifdef LISP_FEATURE_DARWIN
94 #define C_FULL_PROLOG \
98 stw REG(0),4(REG(1)) @ \
100 stw REG(0),8(REG(1)) @ \
101 mr REG(11),REG(1) @ \
102 stwu REG(1),-FULL_FRAME_SIZE(REG(1)) @ \
121 la REG(11),-NFPR_SAVE_BYTES(FIRST_SAVE_FPR)(REG(11)) @ \
143 #define C_FULL_EPILOG \
144 la REG(11),FULL_FRAME_SIZE-NFPR_SAVE_BYTES(FIRST_SAVE_FPR)(REG(1)) @ \
164 la REG(11),NFPR_SAVE_BYTES(FIRST_SAVE_FPR)(REG(11)) @ \
183 lwz REG(1),0(REG(1)) @ \
184 lwz REG(0),4(REG(1)) @ \
186 lwz REG(0),8(REG(1)) @ \
191 #define C_FULL_PROLOG \
195 stwu 1,-FULL_FRAME_SIZE(1) ; \
214 la 11,-NFPR_SAVE_BYTES(FIRST_SAVE_FPR)(11) ; \
236 #define C_FULL_EPILOG \
239 la 11,FULL_FRAME_SIZE-NFPR_SAVE_BYTES(FIRST_SAVE_FPR)(1) ; \
258 la 11,NFPR_SAVE_BYTES(FIRST_SAVE_FPR)(11) ; \
283 /* gas can't parse nnnnLU; redefine */
284 #if BACKEND_PAGE_BYTES == 65536
285 # undef BACKEND_PAGE_BYTES
286 # define BACKEND_PAGE_BYTES 65536
287 #elif BACKEND_PAGE_BYTES == 4096
288 # undef BACKEND_PAGE_BYTES
289 # define BACKEND_PAGE_BYTES 4096
291 # error BACKEND_PAGE_BYTES mismatch
294 #ifdef LISP_FEATURE_SB_SAFEPOINT
295 /* OAOOM because we don't have the C headers here. */
296 # define THREAD_CSP_PAGE_SIZE 4096
298 /* the CSP page sits right before the thread */
299 # define THREAD_SAVED_CSP_OFFSET (-THREAD_CSP_PAGE_SIZE)
305 * Function to transfer control into lisp. The lisp object to invoke is
306 * passed as the first argument, which puts it in NL0
309 GFUNCDEF(call_into_lisp)
311 /* NL0 - function, NL1 - frame pointer, NL2 - nargs. */
312 #if defined(LISP_FEATURE_SB_THREAD)
313 /* We need to obtain a pointer to our TLS block before we do
314 * anything else. For this, we call pthread_getspecific().
315 * We've preserved all of the callee-saves registers, so we
316 * can use them to stash our arguments temporarily while we
322 /* Call out to obtain our TLS block. */
323 load(reg_NL0,CSYMBOL(specials))
324 /* This won't work on darwin: wrong fixup style. And is it
325 * supposed to be lis/ori or lis/addi? Or does it differ
326 * between darwin and everything else again? */
327 lis reg_CFUNC,CSYMBOL(pthread_getspecific)@h
328 ori reg_CFUNC,reg_CFUNC,CSYMBOL(pthread_getspecific)@l
331 mr reg_THREAD, reg_NL0
333 /* Restore our original parameters. */
338 /* store(reg_POLL,11,saver2) */
339 /* Initialize tagged registers */
353 #if !defined(LISP_FEATURE_SB_THREAD)
357 #ifdef LISP_FEATURE_DARWIN
358 lis reg_NULL,hi16(NIL)
359 ori reg_NULL,reg_NULL,lo16(NIL)
362 ori reg_NULL,reg_NULL,NIL@l
364 /* Turn on pseudo-atomic */
366 li reg_ALLOC,flag_PseudoAtomic
367 #if defined(LISP_FEATURE_SB_THREAD)
368 stw reg_ZERO,THREAD_FOREIGN_FUNCTION_CALL_ACTIVE_OFFSET(reg_THREAD)
369 lwz reg_BSP,THREAD_BINDING_STACK_POINTER_OFFSET(reg_THREAD)
370 lwz reg_CSP,THREAD_CONTROL_STACK_POINTER_OFFSET(reg_THREAD)
371 lwz reg_OCFP,THREAD_CONTROL_FRAME_POINTER_OFFSET(reg_THREAD)
373 store(reg_ZERO,reg_NL4,CSYMBOL(foreign_function_call_active))
374 load(reg_BSP,CSYMBOL(current_binding_stack_pointer))
375 load(reg_CSP,CSYMBOL(current_control_stack_pointer))
376 load(reg_OCFP,CSYMBOL(current_control_frame_pointer))
378 /* This is important for CHENEYGC: It's the allocation
379 * pointer. It's also important for ROOM on GENCGC:
380 * It's a pointer to the end of dynamic space, used to
381 * determine where to stop in MAP-ALLOCATED-OBJECTS. */
382 load(reg_NL4,CSYMBOL(dynamic_space_free_pointer))
383 add reg_ALLOC,reg_ALLOC,reg_NL4
385 /* No longer atomic, and check for interrupt */
386 subi reg_ALLOC,reg_ALLOC,flag_PseudoAtomic
387 andi. reg_NL3, reg_ALLOC, flag_PseudoAtomicInterrupted
390 /* Pass in the arguments */
393 mr reg_LEXENV,reg_NL0
394 lwz reg_A0,0(reg_CFP)
395 lwz reg_A1,4(reg_CFP)
396 lwz reg_A2,8(reg_CFP)
397 lwz reg_A3,12(reg_CFP)
400 #ifdef LISP_FEATURE_DARWIN
401 lis reg_LRA,ha16(lra)
402 addi reg_LRA,reg_LRA,lo16(lra)
405 ori reg_LRA,reg_LRA,lra@l
407 addi reg_LRA,reg_LRA,OTHER_POINTER_LOWTAG
409 /* Function is an indirect closure */
410 lwz reg_CODE,SIMPLE_FUN_SELF_OFFSET(reg_LEXENV)
411 addi reg_LIP,reg_CODE,SIMPLE_FUN_CODE_OFFSET
413 slwi reg_NARGS,reg_NL2,2
418 .long RETURN_PC_HEADER_WIDETAG
420 /* Blow off any extra values. */
424 /* Return the one value. */
428 /* Turn on pseudo-atomic */
429 la reg_ALLOC,flag_PseudoAtomic(reg_ALLOC)
431 #if defined(LISP_FEATURE_SB_THREAD)
432 /* Store lisp state */
433 stw reg_BSP,THREAD_BINDING_STACK_POINTER_OFFSET(reg_THREAD)
434 stw reg_CSP,THREAD_CONTROL_STACK_POINTER_OFFSET(reg_THREAD)
435 stw reg_CFP,THREAD_CONTROL_FRAME_POINTER_OFFSET(reg_THREAD)
437 /* No longer in Lisp. */
438 stw reg_ALLOC,THREAD_FOREIGN_FUNCTION_CALL_ACTIVE_OFFSET(reg_THREAD)
440 /* Store lisp state */
441 clrrwi reg_NL1,reg_ALLOC,3
442 store(reg_NL1,reg_NL2,CSYMBOL(dynamic_space_free_pointer))
443 /* store(reg_POLL,reg_NL2,poll_flag) */
444 /* load(reg_NL2,current_thread) */
445 store(reg_BSP,reg_NL2,CSYMBOL(current_binding_stack_pointer))
446 store(reg_CSP,reg_NL2,CSYMBOL(current_control_stack_pointer))
447 store(reg_CFP,reg_NL2,CSYMBOL(current_control_frame_pointer))
448 /* load(reg_POLL,saver2) */
450 /* No longer in Lisp. */
451 store(reg_NL1,reg_NL2,CSYMBOL(foreign_function_call_active))
454 /* Check for interrupt */
455 subi reg_ALLOC, reg_ALLOC, flag_PseudoAtomic
456 andi. reg_NL3, reg_ALLOC, flag_PseudoAtomicInterrupted
462 SET_SIZE(call_into_lisp)
465 GFUNCDEF(call_into_c)
466 /* We're kind of low on unboxed, non-dedicated registers here:
467 most of the unboxed registers may have outgoing C args in them.
468 CFUNC is going to have to go in the CTR in a moment, anyway
469 so we'll free it up soon. reg_NFP is preserved by lisp if it
470 has a meaningful value in it, so we can use it. reg_NARGS is
471 free when it's not holding a copy of the "real" reg_NL3, which
472 gets tied up by the pseudo-atomic mechanism */
475 /* Build a lisp stack frame */
478 la reg_CSP,32(reg_CSP)
479 stw reg_OCFP,0(reg_CFP)
480 stw reg_CODE,8(reg_CFP)
481 /* The pseudo-atomic mechanism wants to use reg_NL3, but that
482 may be an outgoing C argument. Copy reg_NL3 to something that's
483 unboxed and -not- one of the C argument registers */
486 /* Turn on pseudo-atomic */
487 la reg_ALLOC,flag_PseudoAtomic(reg_ALLOC)
489 /* Convert the return address to an offset and save it on the stack. */
490 sub reg_NFP,reg_LIP,reg_CODE
491 la reg_NFP,OTHER_POINTER_LOWTAG(reg_NFP)
492 stw reg_NFP,4(reg_CFP)
494 #ifdef LISP_FEATURE_SB_THREAD
495 /* Store Lisp state */
496 stw reg_BSP,THREAD_BINDING_STACK_POINTER_OFFSET(reg_THREAD)
497 stw reg_CSP,THREAD_CONTROL_STACK_POINTER_OFFSET(reg_THREAD)
498 stw reg_CFP,THREAD_CONTROL_FRAME_POINTER_OFFSET(reg_THREAD)
500 /* No longer in Lisp. */
501 stw reg_CSP,THREAD_FOREIGN_FUNCTION_CALL_ACTIVE_OFFSET(reg_THREAD)
503 /* Store Lisp state */
504 clrrwi reg_NFP,reg_ALLOC,3
505 store(reg_NFP,reg_CFUNC,CSYMBOL(dynamic_space_free_pointer))
506 /* load(reg_CFUNC,current_thread) */
508 store(reg_BSP,reg_CFUNC,CSYMBOL(current_binding_stack_pointer))
509 store(reg_CSP,reg_CFUNC,CSYMBOL(current_control_stack_pointer))
510 store(reg_CFP,reg_CFUNC,CSYMBOL(current_control_frame_pointer))
512 /* No longer in Lisp */
513 store(reg_CSP,reg_CFUNC,CSYMBOL(foreign_function_call_active))
515 /* load(reg_POLL,saver2) */
516 /* Disable pseudo-atomic; check pending interrupt */
517 subi reg_ALLOC, reg_ALLOC, flag_PseudoAtomic
518 andi. reg_NL3, reg_ALLOC, flag_PseudoAtomicInterrupted
521 #ifdef LISP_FEATURE_SB_SAFEPOINT
522 /* OK to run GC without stopping this thread from this point on. */
523 stw reg_CSP,THREAD_SAVED_CSP_OFFSET(reg_THREAD)
528 #ifdef LISP_FEATURE_DARWIN
529 /* PowerOpen (i.e. OS X) requires the callee address in r12
530 (a.k.a. CFUNC), so move it back there, too. */
536 /* Re-establish NIL */
537 #ifdef LISP_FEATURE_DARWIN
538 lis reg_NULL,hi16(NIL)
539 ori reg_NULL,reg_NULL,lo16(NIL)
542 ori reg_NULL,reg_NULL,NIL@l
547 /* If we GC'ed during the FF code (as the result of a callback ?)
548 the tagged lisp registers may now contain garbage (since the
549 registers were saved by C and not seen by the GC.) Put something
550 harmless in all such registers before allowing an interrupt */
555 /* reg_OCFP was pointing to a control stack frame & was preserved by C */
563 #if !defined(LISP_FEATURE_SB_THREAD)
564 /* reg_L2 is our TLS block pointer. */
569 # ifdef LISP_FEATURE_SB_SAFEPOINT
570 /* No longer OK to run GC except at safepoints. */
571 stw reg_ZERO,THREAD_SAVED_CSP_OFFSET(reg_THREAD)
575 li reg_ALLOC,flag_PseudoAtomic
577 #if defined(LISP_FEATURE_SB_THREAD)
578 /* No longer in foreign function call. */
579 stw reg_ZERO,THREAD_FOREIGN_FUNCTION_CALL_ACTIVE_OFFSET(reg_THREAD)
581 /* The binding stack pointer isn't preserved by C. */
582 lwz reg_BSP,THREAD_BINDING_STACK_POINTER_OFFSET(reg_THREAD)
584 /* No long in foreign function call. */
585 store(reg_ZERO,reg_NL2,CSYMBOL(foreign_function_call_active))
587 /* The free pointer may have moved */
590 /* The BSP wasn't preserved by C, so load it */
591 load(reg_BSP,CSYMBOL(current_binding_stack_pointer))
593 /* This is important for CHENEYGC: It's the allocation
594 * pointer. It's also important for ROOM on GENCGC:
595 * It's a pointer to the end of dynamic space, used to
596 * determine where to stop in MAP-ALLOCATED-OBJECTS. */
597 load(reg_NL4,CSYMBOL(dynamic_space_free_pointer))
598 add reg_ALLOC,reg_ALLOC,reg_NL4
600 /* Other lisp stack/frame pointers were preserved by C.
601 I can't imagine why they'd have moved */
603 /* Get the return address back. */
604 lwz reg_LIP,4(reg_CFP)
605 lwz reg_CODE,8(reg_CFP)
606 add reg_LIP,reg_CODE,reg_LIP
607 la reg_LIP,-OTHER_POINTER_LOWTAG(reg_LIP)
609 /* No longer atomic */
610 subi reg_ALLOC, reg_ALLOC, flag_PseudoAtomic
611 andi. reg_NL3, reg_ALLOC, flag_PseudoAtomicInterrupted
616 /* Reset the lisp stack. */
620 /* And back into Lisp. */
623 SET_SIZE(call_into_c)
625 /* The fun_end_breakpoint support here is considered by the
626 authors of the other $ARCH-assem.S files to be magic, and it
627 is. It is a small fragment of code that is copied into a heap
628 code-object when needed, and contains an LRA object, code to
629 convert a single-value return to unknown-values format, and a
630 trap_FunEndBreakpoint. */
631 GFUNCDEF(fun_end_breakpoint_guts)
632 .globl CSYMBOL(fun_end_breakpoint_trap)
633 .globl CSYMBOL(fun_end_breakpoint_end)
635 /* Due to pointer verification in MAKE-LISP-OBJ, this must
636 include its header data (the offset from the start of the
637 code-object to the LRA). The code-object header is 4
638 words, there are 1 word of constants, and the instruction
639 space is doubleword-aligned, making an offset of six.
640 This is header data for a widetag, so shift left eight bits
642 /* FIXME: the above is full of magic numbers. */
643 .long RETURN_PC_HEADER_WIDETAG + 0x600
645 /* We are receiving unknown multiple values, thus must deal
646 with the single-value and multiple-value cases separately. */
647 b fun_end_breakpoint_multiple_values
650 /* Compute the correct value for reg_CODE based on the LRA.
651 This is a "simple" matter of subtracting a constant from
652 reg_LRA (where the LRA is stored by the return sequence) to
653 obtain a tagged pointer to the enclosing code component. Both
654 values are tagged OTHER_POINTER_LOWTAG, so we just have to
655 account for the six words (see calculation for
656 RETURN_PC_HEADER_WIDETAG, above) between the two addresses.
657 Restoring reg_CODE doesn't appear to be strictly necessary
658 here, but let's observe the niceties.*/
659 addi reg_CODE, reg_LRA, -24
661 /* Multiple values are stored relative to reg_OCFP, which we
662 set to be the current top-of-stack. */
665 /* Reserve a save location for the one value we have. */
666 addi reg_CSP, reg_CSP, 4
668 /* Record the number of values we have as a FIXNUM. */
671 /* Blank the remaining arg-passing registers. */
676 /* And branch to our trap. */
677 b CSYMBOL(fun_end_breakpoint_trap)
679 fun_end_breakpoint_multiple_values:
680 /* Compute the correct value for reg_CODE. See the
681 explanation for the single-value case, above. */
682 addi reg_CODE, reg_LRA, -24
684 /* The actual magic trap. */
685 CSYMBOL(fun_end_breakpoint_trap):
686 twllei reg_ZERO, trap_FunEndBreakpoint
688 /* Finally, the debugger needs to know where the end of the
689 fun_end_breakpoint_guts are, so that it may calculate its size
690 in order to populate out a suitably-sized code object. */
691 CSYMBOL(fun_end_breakpoint_end):
692 SET_SIZE(fun_end_breakpoint_guts)
695 GFUNCDEF(ppc_flush_cache_line)
702 SET_SIZE(ppc_flush_cache_line)
704 GFUNCDEF(do_pending_interrupt)
707 /* King Nato's branch has a nop here. Do we need this? */
708 SET_SIZE(do_pending_interrupt)