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"
13 #ifdef LISP_FEATURE_DARWIN
14 #define CSYMBOL(x) _ ## x
19 #if defined LISP_FEATURE_DARWIN
20 #define FUNCDEF(x) .text @ \
24 #define GFUNCDEF(x) .globl _ ## x @ \
27 #define FUNCDEF(x) .text ; \
32 #define GFUNCDEF(x) .globl x ; \
36 #if defined LISP_FEATURE_DARWIN
39 #define SET_SIZE(x) .size x,.-x
42 /* Load a register from a global, using the register as an intermediary */
43 /* The register will be a fixnum for one instruction, so this is gc-safe */
45 #if defined LISP_FEATURE_DARWIN
46 #define load(reg,global) \
47 lis reg,ha16(global) @ \
48 lwz reg,lo16(global)(reg) ; Comment
49 #define store(reg,temp,global) \
50 lis temp,ha16(global) @\
51 stw reg,lo16(global)(temp) ; Comment
53 #define load(reg,global) \
54 lis reg,global@ha; lwz reg,global@l(reg)
55 #define store(reg,temp,global) \
56 lis temp,global@ha; stw reg,global@l(temp)
59 #define FIRST_SAVE_FPR 14 /* lowest-numbered non-volatile FPR */
60 #ifdef LISP_FEATURE_DARWIN
61 #define FIRST_SAVE_GPR 13 /* lowest-numbered non-volatile GPR */
62 #define NGPR_SAVE_BYTES(n) ((32-(n))*4)
63 #define FRAME_ARG_BYTES(n) (((((n)+6)*4)+15)&~15)
65 #define FIRST_SAVE_GPR 14 /* lowest-numbered non-volatile GPR */
66 #define NGPR_SAVE_BYTES(n) ((32-(~1&((n)+1)))*4)
67 #define FRAME_ARG_BYTES(n) (((((n)+2)*4)+15)&~15)
69 #define NFPR_SAVE_BYTES(n) ((32-(n))*8)
71 #ifdef LISP_FEATURE_DARWIN
72 #define FRAME_SIZE(first_g,first_f,out_arg_words,savecr) \
73 (NFPR_SAVE_BYTES(first_f)+ NGPR_SAVE_BYTES(first_g)+ FRAME_ARG_BYTES(out_arg_words))
74 #define SAVE_FPR(n) stfd f##n,-8*(32- n)(r11)
75 #define SAVE_GPR(n) stw r##n,-4*(32- n)(r11)
76 #define FULL_FRAME_SIZE (FRAME_SIZE(FIRST_SAVE_GPR,FIRST_SAVE_FPR,8,1)+15&~15)
77 #define RESTORE_FPR(n) lfd f##n,-8*(32- n)(r11)
78 #define RESTORE_GPR(n) lwz r##n,-4*(32- n)(r11)
80 #define FRAME_SIZE(first_g,first_f,out_arg_words,savecr) \
81 (NFPR_SAVE_BYTES(first_f)+ NGPR_SAVE_BYTES(first_g)+ FRAME_ARG_BYTES(out_arg_words+savecr))
82 #define SAVE_FPR(n) stfd n,-8*(32-(n))(11)
83 #define SAVE_GPR(n) stw n,-4*(32-(n))(11)
84 #define FULL_FRAME_SIZE FRAME_SIZE(FIRST_SAVE_GPR,FIRST_SAVE_FPR,0,1)
86 #define RESTORE_FPR(n) lfd n,-8*(32-(n))(11)
87 #define RESTORE_GPR(n) lwz n,-4*(32-(n))(11)
90 #ifdef LISP_FEATURE_DARWIN
91 #define C_FULL_PROLOG \
95 stw REG(0),4(REG(1)) @ \
97 stw REG(0),8(REG(1)) @ \
99 stwu REG(1),-FULL_FRAME_SIZE(REG(1)) @ \
118 la REG(11),-NFPR_SAVE_BYTES(FIRST_SAVE_FPR)(REG(11)) @ \
140 #define C_FULL_EPILOG \
141 la REG(11),FULL_FRAME_SIZE-NFPR_SAVE_BYTES(FIRST_SAVE_FPR)(REG(1)) @ \
161 la REG(11),NFPR_SAVE_BYTES(FIRST_SAVE_FPR)(REG(11)) @ \
180 lwz REG(1),0(REG(1)) @ \
181 lwz REG(0),4(REG(1)) @ \
183 lwz REG(0),8(REG(1)) @ \
188 #define C_FULL_PROLOG \
192 stwu 1,-FULL_FRAME_SIZE(1) ; \
211 la 11,-NFPR_SAVE_BYTES(FIRST_SAVE_FPR)(11) ; \
233 #define C_FULL_EPILOG \
236 la 11,FULL_FRAME_SIZE-NFPR_SAVE_BYTES(FIRST_SAVE_FPR)(1) ; \
255 la 11,NFPR_SAVE_BYTES(FIRST_SAVE_FPR)(11) ; \
283 * Function to transfer control into lisp. The lisp object to invoke is
284 * passed as the first argument, which puts it in NL0
287 GFUNCDEF(call_into_lisp)
289 /* store(reg_POLL,11,saver2) */
290 /* Initialize tagged registers */
306 #ifdef LISP_FEATURE_DARWIN
307 lis reg_NULL,hi16(NIL)
308 ori reg_NULL,reg_NULL,lo16(NIL)
311 ori reg_NULL,reg_NULL,NIL@l
313 /* Turn on pseudo-atomic */
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))
323 /* No longer atomic, and check for interrupt */
324 andi. reg_NL3, reg_ALLOC, 1
325 subi reg_ALLOC,reg_ALLOC,4
328 /* Pass in the arguments */
331 mr reg_LEXENV,reg_NL0
332 lwz reg_A0,0(reg_CFP)
333 lwz reg_A1,4(reg_CFP)
334 lwz reg_A2,8(reg_CFP)
335 lwz reg_A3,12(reg_CFP)
338 #ifdef LISP_FEATURE_DARWIN
339 lis reg_LRA,ha16(lra)
340 addi reg_LRA,reg_LRA,lo16(lra)
343 ori reg_LRA,reg_LRA,lra@l
345 addi reg_LRA,reg_LRA,OTHER_POINTER_LOWTAG
347 /* Function is an indirect closure */
348 lwz reg_CODE,SIMPLE_FUN_SELF_OFFSET(reg_LEXENV)
349 addi reg_LIP,reg_CODE,SIMPLE_FUN_CODE_OFFSET
351 slwi reg_NARGS,reg_NL2,2
356 .long RETURN_PC_HEADER_WIDETAG
358 /* Blow off any extra values. */
362 /* Return the one value. */
366 /* Turn on pseudo-atomic */
367 la reg_ALLOC,4(reg_ALLOC)
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) */
379 /* No longer in Lisp. */
380 store(reg_NL1,reg_NL2,CSYMBOL(foreign_function_call_active))
382 /* Check for interrupt */
383 andi. reg_NL3, reg_ALLOC, 1
384 subi reg_ALLOC, reg_ALLOC, 4
390 SET_SIZE(call_into_lisp)
393 GFUNCDEF(call_into_c)
394 /* We're kind of low on unboxed, non-dedicated registers here:
395 most of the unboxed registers may have outgoing C args in them.
396 CFUNC is going to have to go in the CTR in a moment, anyway
397 so we'll free it up soon. reg_NFP is preserved by lisp if it
398 has a meaningful value in it, so we can use it. reg_NARGS is
399 free when it's not holding a copy of the "real" reg_NL3, which
400 gets tied up by the pseudo-atomic mechanism */
403 /* Build a lisp stack frame */
406 la reg_CSP,32(reg_CSP)
407 stw reg_OCFP,0(reg_CFP)
408 stw reg_CODE,8(reg_CFP)
409 /* The pseudo-atomic mechanism wants to use reg_NL3, but that
410 may be an outgoing C argument. Copy reg_NL3 to something that's
411 unboxed and -not- one of the C argument registers */
414 /* Turn on pseudo-atomic */
415 la reg_ALLOC,4(reg_ALLOC)
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)
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) */
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))
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 andi. reg_NL3, reg_ALLOC, 1
436 subi reg_ALLOC, reg_ALLOC, 4
441 #ifdef LISP_FEATURE_DARWIN
442 /* PowerOpen (i.e. OS X) requires the callee address in r12
443 (a.k.a. CFUNC), so move it back there, too. */
449 /* Re-establish NIL */
450 #ifdef LISP_FEATURE_DARWIN
451 lis reg_NULL,hi16(NIL)
452 ori reg_NULL,reg_NULL,lo16(NIL)
455 ori reg_NULL,reg_NULL,NIL@l
460 /* If we GC'ed during the FF code (as the result of a callback ?)
461 the tagged lisp registers may now contain garbage (since the
462 registers were saved by C and not seen by the GC.) Put something
463 harmless in all such registers before allowing an interrupt */
467 /* reg_OCFP was pointing to a control stack frame & was preserved by C */
482 /* No long in foreign function call. */
483 store(reg_ZERO,reg_NL2,CSYMBOL(foreign_function_call_active))
485 /* The free pointer may have moved */
486 load(reg_NL4,CSYMBOL(dynamic_space_free_pointer))
487 add reg_ALLOC,reg_ALLOC,reg_NL4
489 /* The BSP wasn't preserved by C, so load it */
490 load(reg_BSP,CSYMBOL(current_binding_stack_pointer))
492 /* Other lisp stack/frame pointers were preserved by C.
493 I can't imagine why they'd have moved */
495 /* Get the return address back. */
496 lwz reg_LIP,4(reg_CFP)
497 lwz reg_CODE,8(reg_CFP)
498 add reg_LIP,reg_CODE,reg_LIP
499 la reg_LIP,-OTHER_POINTER_LOWTAG(reg_LIP)
501 /* No longer atomic */
502 andi. reg_NL3, reg_ALLOC, 1
503 subi reg_ALLOC, reg_ALLOC, 4
508 /* Reset the lisp stack. */
512 /* And back into Lisp. */
515 SET_SIZE(call_into_c)
517 GFUNCDEF(xundefined_tramp)
518 .globl CSYMBOL(undefined_tramp)
519 .long SIMPLE_FUN_HEADER_WIDETAG /* header */
520 .long CSYMBOL(undefined_tramp) - SIMPLE_FUN_CODE_OFFSET /* self */
523 .long NIL /* arglist */
526 CSYMBOL(undefined_tramp):
527 /* Point reg_CODE to the header and tag it as function, since
528 the debugger regards a function pointer in reg_CODE which
529 doesn't point to a code object as undefined function. */
530 bcl 20,31,.+4 /* get address of the next instruction */
531 mflr reg_CODE /* header 1 extra word back from here */
532 addi reg_CODE,reg_CODE,-(SIMPLE_FUN_CODE_OFFSET+4)
534 twllei reg_ZERO,trap_Cerror
536 .byte UNDEFINED_FUN_ERROR
537 .byte 254, sc_DescriptorReg+0x40, 1 /* 140? sparc says sc_descriptorReg */
538 /* This stuff is for the continuable error. I don't think there's
539 * any support for it on the lisp side */
541 1: lwz reg_CODE,FDEFN_RAW_ADDR_OFFSET(reg_FDEFN)
542 la reg_LIP,SIMPLE_FUN_CODE_OFFSET(reg_CODE)
548 SET_SIZE(xundefined_tramp)
550 GFUNCDEF(xclosure_tramp)
551 .globl CSYMBOL(closure_tramp)
552 CSYMBOL(closure_tramp):
553 lwz reg_LEXENV,FDEFN_FUN_OFFSET(reg_FDEFN)
554 lwz reg_CODE,CLOSURE_FUN_OFFSET(reg_LEXENV)
555 la reg_LIP,SIMPLE_FUN_CODE_OFFSET(reg_CODE)
559 SET_SIZE(xclosure_tramp)
561 GFUNCDEF(xfuncallable_instance_tramp)
562 .globl CSYMBOL(funcallable_instance_tramp)
563 .long SIMPLE_FUN_HEADER_WIDETAG
564 CSYMBOL(funcallable_instance_tramp) = . + 1
565 .long CSYMBOL(funcallable_instance_tramp)
571 lwz reg_LEXENV,FUNCALLABLE_INSTANCE_FUNCTION_OFFSET(reg_LEXENV)
572 lwz reg_FDEFN,CLOSURE_FUN_OFFSET(reg_LEXENV)
573 addi reg_LIP,reg_FDEFN,SIMPLE_FUN_CODE_OFFSET
576 SET_SIZE(funcallable_instance_tramp)
578 /* The fun_end_breakpoint support here is considered by the
579 authors of the other $ARCH-assem.S files to be magic, and it
580 is. It is a small fragment of code that is copied into a heap
581 code-object when needed, and contains an LRA object, code to
582 convert a single-value return to unknown-values format, and a
583 trap_FunEndBreakpoint. */
584 GFUNCDEF(fun_end_breakpoint_guts)
585 .globl CSYMBOL(fun_end_breakpoint_trap)
586 .globl CSYMBOL(fun_end_breakpoint_end)
588 /* Due to pointer verification in MAKE-LISP-OBJ on GENCGC
589 targets, which includes PPC, this must include its header data
590 (the offset from the start of the code-object to the LRA).
591 The code-object header is five words, there are two words of
592 constants, and the instruction space is doubleword-aligned,
593 making an offset of eight. This is header data for a widetag,
594 so shift left eight bits and add. */
595 .long RETURN_PC_HEADER_WIDETAG + 0x800
597 /* We are receiving unknown multiple values, thus must deal
598 with the single-value and multiple-value cases separately. */
599 b fun_end_breakpoint_multiple_values
602 /* Compute the correct value for reg_CODE based on the LRA.
603 This is a "simple" matter of subtracting a constant from
604 reg_LRA (where the LRA is stored by the return sequence) to
605 obtain a tagged pointer to the enclosing code component. Both
606 values are tagged OTHER_POINTER_LOWTAG, so we just have to
607 account for the eight words (see calculation for
608 RETURN_PC_HEADER_WIDETAG, above) between the two addresses.
609 Restoring reg_CODE doesn't appear to be strictly necessary
610 here, but let's observe the niceties.*/
611 addi reg_CODE, reg_LRA, -32
613 /* Multiple values are stored relative to reg_OCFP, which we
614 set to be the current top-of-stack. */
617 /* Reserve a save location for the one value we have. */
618 addi reg_CSP, reg_CSP, 4
620 /* Record the number of values we have as a FIXNUM. */
623 /* Blank the remaining arg-passing registers. */
628 /* And branch to our trap. */
629 b CSYMBOL(fun_end_breakpoint_trap)
631 fun_end_breakpoint_multiple_values:
632 /* Compute the correct value for reg_CODE. See the
633 explanation for the single-value case, above. */
634 addi reg_CODE, reg_LRA, -32
636 /* The actual magic trap. */
637 CSYMBOL(fun_end_breakpoint_trap):
638 twllei reg_ZERO, trap_FunEndBreakpoint
640 /* Finally, the debugger needs to know where the end of the
641 fun_end_breakpoint_guts are, so that it may calculate its size
642 in order to populate out a suitably-sized code object. */
643 CSYMBOL(fun_end_breakpoint_end):
644 SET_SIZE(fun_end_breakpoint_guts)
647 GFUNCDEF(ppc_flush_cache_line)
654 SET_SIZE(ppc_flush_cache_line)
656 GFUNCDEF(do_pending_interrupt)
657 twllei reg_ZERO, trap_PendingInterrupt
659 /* King Nato's branch has a nop here. Do we need this? */
660 SET_SIZE(do_pending_interrupt)
662 #if defined LISP_FEATURE_GENCGC
665 stfd FREG(1), 0(REG(3))
666 stfd FREG(2), 8(REG(3))
667 stfd FREG(3), 16(REG(3))
668 stfd FREG(4), 24(REG(3))
669 stfd FREG(5), 32(REG(3))
670 stfd FREG(6), 40(REG(3))
671 stfd FREG(7), 48(REG(3))
672 stfd FREG(8), 56(REG(3))
673 stfd FREG(9), 64(REG(3))
674 stfd FREG(10), 72(REG(3))
675 stfd FREG(11), 80(REG(3))
676 stfd FREG(12), 88(REG(3))
677 stfd FREG(13), 96(REG(3))
678 stfd FREG(14), 104(REG(3))
679 stfd FREG(15), 112(REG(3))
680 stfd FREG(16), 120(REG(3))
681 stfd FREG(17), 128(REG(3))
682 stfd FREG(18), 136(REG(3))
683 stfd FREG(19), 144(REG(3))
684 stfd FREG(20), 152(REG(3))
685 stfd FREG(21), 160(REG(3))
686 stfd FREG(22), 168(REG(3))
687 stfd FREG(23), 176(REG(3))
688 stfd FREG(24), 184(REG(3))
689 stfd FREG(25), 192(REG(3))
690 stfd FREG(26), 200(REG(3))
691 stfd FREG(27), 208(REG(3))
692 stfd FREG(28), 216(REG(3))
693 stfd FREG(29), 224(REG(3))
694 stfd FREG(30), 232(REG(3))
695 stfd FREG(31), 240(REG(3))
699 GFUNCDEF(fpu_restore)
700 lfd FREG(1), 0(REG(3))
701 lfd FREG(2), 8(REG(3))
702 lfd FREG(3), 16(REG(3))
703 lfd FREG(4), 24(REG(3))
704 lfd FREG(5), 32(REG(3))
705 lfd FREG(6), 40(REG(3))
706 lfd FREG(7), 48(REG(3))
707 lfd FREG(8), 56(REG(3))
708 lfd FREG(9), 64(REG(3))
709 lfd FREG(10), 72(REG(3))
710 lfd FREG(11), 80(REG(3))
711 lfd FREG(12), 88(REG(3))
712 lfd FREG(13), 96(REG(3))
713 lfd FREG(14), 104(REG(3))
714 lfd FREG(15), 112(REG(3))
715 lfd FREG(16), 120(REG(3))
716 lfd FREG(17), 128(REG(3))
717 lfd FREG(18), 136(REG(3))
718 lfd FREG(19), 144(REG(3))
719 lfd FREG(20), 152(REG(3))
720 lfd FREG(21), 160(REG(3))
721 lfd FREG(22), 168(REG(3))
722 lfd FREG(23), 176(REG(3))
723 lfd FREG(24), 184(REG(3))
724 lfd FREG(25), 192(REG(3))
725 lfd FREG(26), 200(REG(3))
726 lfd FREG(27), 208(REG(3))
727 lfd FREG(28), 216(REG(3))
728 lfd FREG(29), 224(REG(3))
729 lfd FREG(30), 232(REG(3))
730 lfd FREG(31), 240(REG(3))
732 SET_SIZE(fpu_restore)