#include "genesis/closure.h"
#include "genesis/funcallable-instance.h"
#include "genesis/static-symbols.h"
+#ifdef LISP_FEATURE_SB_THREAD
+#include "genesis/thread.h"
+#endif
#ifdef LISP_FEATURE_DARWIN
#define CSYMBOL(x) _ ## x
.align 3 @ \
_##x:
-#define GFUNCDEF(x) .globl _/**/x @ \
+#define GFUNCDEF(x) .globl _ ## x @ \
FUNCDEF(x)
#else
#define FUNCDEF(x) .text ; \
mtlr 0 ; \
#endif
-
+
+/* gas can't parse nnnnLU; redefine */
+#if BACKEND_PAGE_BYTES == 65536
+# undef BACKEND_PAGE_BYTES
+# define BACKEND_PAGE_BYTES 65536
+#elif BACKEND_PAGE_BYTES == 4096
+# undef BACKEND_PAGE_BYTES
+# define BACKEND_PAGE_BYTES 4096
+#else
+# error BACKEND_PAGE_BYTES mismatch
+#endif
+
+#ifdef LISP_FEATURE_SB_SAFEPOINT
+/* OAOOM because we don't have the C headers here. */
+# define THREAD_CSP_PAGE_SIZE 4096
+
+/* the CSP page sits right before the thread */
+# define THREAD_SAVED_CSP_OFFSET (-THREAD_CSP_PAGE_SIZE)
+#endif
+
.text
/*
GFUNCDEF(call_into_lisp)
C_FULL_PROLOG
+ /* NL0 - function, NL1 - frame pointer, NL2 - nargs. */
+#if defined(LISP_FEATURE_SB_THREAD)
+ /* We need to obtain a pointer to our TLS block before we do
+ * anything else. For this, we call pthread_getspecific().
+ * We've preserved all of the callee-saves registers, so we
+ * can use them to stash our arguments temporarily while we
+ * make the call. */
+ mr reg_A0, reg_NL0
+ mr reg_A1, reg_NL1
+ mr reg_A2, reg_NL2
+
+ /* Call out to obtain our TLS block. */
+ load(reg_NL0,CSYMBOL(specials))
+ /* This won't work on darwin: wrong fixup style. And is it
+ * supposed to be lis/ori or lis/addi? Or does it differ
+ * between darwin and everything else again? */
+ lis reg_CFUNC,CSYMBOL(pthread_getspecific)@h
+ ori reg_CFUNC,reg_CFUNC,CSYMBOL(pthread_getspecific)@l
+ mtctr reg_CFUNC
+ bctrl
+ mr reg_THREAD, reg_NL0
+
+ /* Restore our original parameters. */
+ mr reg_NL2, reg_A2
+ mr reg_NL1, reg_A1
+ mr reg_NL0, reg_A0
+#endif
/* store(reg_POLL,11,saver2) */
/* Initialize tagged registers */
li reg_ZERO,0
li reg_A3,0
li reg_L0,0
li reg_L1,0
+#if !defined(LISP_FEATURE_SB_THREAD)
li reg_L2,0
+#endif
li reg_LIP,0
#ifdef LISP_FEATURE_DARWIN
lis reg_NULL,hi16(NIL)
#endif
/* Turn on pseudo-atomic */
- li reg_ALLOC,4
+ li reg_ALLOC,flag_PseudoAtomic
+#if defined(LISP_FEATURE_SB_THREAD)
+ stw reg_ZERO,THREAD_FOREIGN_FUNCTION_CALL_ACTIVE_OFFSET(reg_THREAD)
+ lwz reg_BSP,THREAD_BINDING_STACK_POINTER_OFFSET(reg_THREAD)
+ lwz reg_CSP,THREAD_CONTROL_STACK_POINTER_OFFSET(reg_THREAD)
+ lwz reg_OCFP,THREAD_CONTROL_FRAME_POINTER_OFFSET(reg_THREAD)
+#else
store(reg_ZERO,reg_NL4,CSYMBOL(foreign_function_call_active))
- load(reg_NL4,CSYMBOL(dynamic_space_free_pointer))
- add reg_ALLOC,reg_ALLOC,reg_NL4
load(reg_BSP,CSYMBOL(current_binding_stack_pointer))
load(reg_CSP,CSYMBOL(current_control_stack_pointer))
load(reg_OCFP,CSYMBOL(current_control_frame_pointer))
+#endif
+ /* This is important for CHENEYGC: It's the allocation
+ * pointer. It's also important for ROOM on GENCGC:
+ * It's a pointer to the end of dynamic space, used to
+ * determine where to stop in MAP-ALLOCATED-OBJECTS. */
+ load(reg_NL4,CSYMBOL(dynamic_space_free_pointer))
+ add reg_ALLOC,reg_ALLOC,reg_NL4
/* No longer atomic, and check for interrupt */
- andi. reg_NL3, reg_ALLOC, 1
- subi reg_ALLOC,reg_ALLOC,4
+ subi reg_ALLOC,reg_ALLOC,flag_PseudoAtomic
+ andi. reg_NL3, reg_ALLOC, flag_PseudoAtomicInterrupted
twnei reg_NL3, 0
/* Pass in the arguments */
/* Function is an indirect closure */
lwz reg_CODE,SIMPLE_FUN_SELF_OFFSET(reg_LEXENV)
- addi reg_LIP,reg_CODE,6*4-FUN_POINTER_LOWTAG
+ addi reg_LIP,reg_CODE,SIMPLE_FUN_CODE_OFFSET
mtctr reg_LIP
slwi reg_NARGS,reg_NL2,2
bctr
mr REG(3),reg_A0
/* Turn on pseudo-atomic */
- la reg_ALLOC,4(reg_ALLOC)
+ la reg_ALLOC,flag_PseudoAtomic(reg_ALLOC)
+#if defined(LISP_FEATURE_SB_THREAD)
+ /* Store lisp state */
+ stw reg_BSP,THREAD_BINDING_STACK_POINTER_OFFSET(reg_THREAD)
+ stw reg_CSP,THREAD_CONTROL_STACK_POINTER_OFFSET(reg_THREAD)
+ stw reg_CFP,THREAD_CONTROL_FRAME_POINTER_OFFSET(reg_THREAD)
+
+ /* No longer in Lisp. */
+ stw reg_ALLOC,THREAD_FOREIGN_FUNCTION_CALL_ACTIVE_OFFSET(reg_THREAD)
+#else
/* Store lisp state */
clrrwi reg_NL1,reg_ALLOC,3
store(reg_NL1,reg_NL2,CSYMBOL(dynamic_space_free_pointer))
/* No longer in Lisp. */
store(reg_NL1,reg_NL2,CSYMBOL(foreign_function_call_active))
+#endif
/* Check for interrupt */
- andi. reg_NL3, reg_ALLOC, 1
- subi reg_ALLOC, reg_ALLOC, 4
+ subi reg_ALLOC, reg_ALLOC, flag_PseudoAtomic
+ andi. reg_NL3, reg_ALLOC, flag_PseudoAtomicInterrupted
twnei reg_NL3,0
/* Back to C */
mr reg_NARGS,reg_NL3
/* Turn on pseudo-atomic */
- la reg_ALLOC,4(reg_ALLOC)
+ la reg_ALLOC,flag_PseudoAtomic(reg_ALLOC)
/* Convert the return address to an offset and save it on the stack. */
sub reg_NFP,reg_LIP,reg_CODE
la reg_NFP,OTHER_POINTER_LOWTAG(reg_NFP)
stw reg_NFP,4(reg_CFP)
+#ifdef LISP_FEATURE_SB_THREAD
+ /* Store Lisp state */
+ stw reg_BSP,THREAD_BINDING_STACK_POINTER_OFFSET(reg_THREAD)
+ stw reg_CSP,THREAD_CONTROL_STACK_POINTER_OFFSET(reg_THREAD)
+ stw reg_CFP,THREAD_CONTROL_FRAME_POINTER_OFFSET(reg_THREAD)
+
+ /* No longer in Lisp. */
+ stw reg_CSP,THREAD_FOREIGN_FUNCTION_CALL_ACTIVE_OFFSET(reg_THREAD)
+#else
/* Store Lisp state */
clrrwi reg_NFP,reg_ALLOC,3
store(reg_NFP,reg_CFUNC,CSYMBOL(dynamic_space_free_pointer))
/* No longer in Lisp */
store(reg_CSP,reg_CFUNC,CSYMBOL(foreign_function_call_active))
+#endif
/* load(reg_POLL,saver2) */
/* Disable pseudo-atomic; check pending interrupt */
- andi. reg_NL3, reg_ALLOC, 1
- subi reg_ALLOC, reg_ALLOC, 4
+ subi reg_ALLOC, reg_ALLOC, flag_PseudoAtomic
+ andi. reg_NL3, reg_ALLOC, flag_PseudoAtomicInterrupted
twnei reg_NL3, 0
+#ifdef LISP_FEATURE_SB_SAFEPOINT
+ /* OK to run GC without stopping this thread from this point on. */
+ stw reg_CSP,THREAD_SAVED_CSP_OFFSET(reg_THREAD)
+#endif
+
mr reg_NL3,reg_NARGS
#ifdef LISP_FEATURE_DARWIN
li reg_A3,0
li reg_L0,0
li reg_L1,0
+#if !defined(LISP_FEATURE_SB_THREAD)
+ /* reg_L2 is our TLS block pointer. */
li reg_L2,0
+#endif
li reg_LIP,0
+# ifdef LISP_FEATURE_SB_SAFEPOINT
+ /* No longer OK to run GC except at safepoints. */
+ stw reg_ZERO,THREAD_SAVED_CSP_OFFSET(reg_THREAD)
+# endif
+
/* Atomic ... */
- li reg_NL3,-4
- li reg_ALLOC,4
+ li reg_ALLOC,flag_PseudoAtomic
+
+#if defined(LISP_FEATURE_SB_THREAD)
+ /* No longer in foreign function call. */
+ stw reg_ZERO,THREAD_FOREIGN_FUNCTION_CALL_ACTIVE_OFFSET(reg_THREAD)
+ /* The binding stack pointer isn't preserved by C. */
+ lwz reg_BSP,THREAD_BINDING_STACK_POINTER_OFFSET(reg_THREAD)
+#else
/* No long in foreign function call. */
store(reg_ZERO,reg_NL2,CSYMBOL(foreign_function_call_active))
/* The free pointer may have moved */
- load(reg_NL4,CSYMBOL(dynamic_space_free_pointer))
- add reg_ALLOC,reg_ALLOC,reg_NL4
+ /* (moved below) */
/* The BSP wasn't preserved by C, so load it */
load(reg_BSP,CSYMBOL(current_binding_stack_pointer))
+#endif
+ /* This is important for CHENEYGC: It's the allocation
+ * pointer. It's also important for ROOM on GENCGC:
+ * It's a pointer to the end of dynamic space, used to
+ * determine where to stop in MAP-ALLOCATED-OBJECTS. */
+ load(reg_NL4,CSYMBOL(dynamic_space_free_pointer))
+ add reg_ALLOC,reg_ALLOC,reg_NL4
/* Other lisp stack/frame pointers were preserved by C.
I can't imagine why they'd have moved */
la reg_LIP,-OTHER_POINTER_LOWTAG(reg_LIP)
/* No longer atomic */
- andi. reg_NL3, reg_ALLOC, 1
- subi reg_ALLOC, reg_ALLOC, 4
+ subi reg_ALLOC, reg_ALLOC, flag_PseudoAtomic
+ andi. reg_NL3, reg_ALLOC, flag_PseudoAtomicInterrupted
twnei reg_NL3, 0
mtlr reg_LIP
GFUNCDEF(xundefined_tramp)
.globl CSYMBOL(undefined_tramp)
-CSYMBOL(undefined_tramp):
+ .long SIMPLE_FUN_HEADER_WIDETAG /* header */
+ .long CSYMBOL(undefined_tramp) - SIMPLE_FUN_CODE_OFFSET /* self */
+ .long NIL /* next */
+ .long NIL /* name */
+ .long NIL /* arglist */
+ .long NIL /* type */
+ .long NIL /* xref */
+CSYMBOL(undefined_tramp):
+ /* Point reg_CODE to the header and tag it as function, since
+ the debugger regards a function pointer in reg_CODE which
+ doesn't point to a code object as undefined function. */
+ /* We are given that reg_LIP points to undefined_tramp by
+ virtue of the calling convention. */
+ addi reg_CODE,reg_LIP,-SIMPLE_FUN_CODE_OFFSET
+
+ /* If we are called with stack arguments (or in a tail-call
+ scenario), we end up with an allocated stack frame, but the
+ frame link information is uninitialized. Fix things by
+ allocating and initializing our stack frame "properly". */
+ cmpwi cr0,reg_NARGS,16
+ bt gt,1f
+ addi reg_CSP,reg_CFP,16
+ b 2f
+1: add reg_CSP,reg_CFP,reg_NARGS
+2: stw reg_OCFP,0(reg_CFP)
+ stw reg_LRA,4(reg_CFP)
+
+ /* Now that the preliminaries are dealt with, actually trap. */
twllei reg_ZERO,trap_Cerror
.byte 4
.byte UNDEFINED_FUN_ERROR
- .byte 254, sc_DescriptorReg+0x40, 1 /* 140? sparc says sc_descriptorReg */
+ .byte 254, sc_DescriptorReg+0x80, 0x2 /* 280 */
/* This stuff is for the continuable error. I don't think there's
* any support for it on the lisp side */
.align 2
.long NIL
.long NIL
.long NIL
+ .long NIL
lwz reg_LEXENV,FUNCALLABLE_INSTANCE_FUNCTION_OFFSET(reg_LEXENV)
lwz reg_FDEFN,CLOSURE_FUN_OFFSET(reg_LEXENV)
addi reg_LIP,reg_FDEFN,SIMPLE_FUN_CODE_OFFSET
mtctr reg_LIP
bctr
SET_SIZE(funcallable_instance_tramp)
-
- GFUNCDEF(fun_end_breakpoint_trap)
- .long 0
- SET_SIZE(fun_end_breakpoint_trap)
-
- GFUNCDEF(fun_end_breakpoint)
- .long 0
- SET_SIZE(fun_end_breakpoint)
-
+\f
+ /* The fun_end_breakpoint support here is considered by the
+ authors of the other $ARCH-assem.S files to be magic, and it
+ is. It is a small fragment of code that is copied into a heap
+ code-object when needed, and contains an LRA object, code to
+ convert a single-value return to unknown-values format, and a
+ trap_FunEndBreakpoint. */
GFUNCDEF(fun_end_breakpoint_guts)
- .long 0
- SET_SIZE(fun_end_breakpoint_guts)
-
- GFUNCDEF(fun_end_breakpoint_end)
- .long 0
- SET_SIZE(fun_end_breakpoint_end)
+ .globl CSYMBOL(fun_end_breakpoint_trap)
+ .globl CSYMBOL(fun_end_breakpoint_end)
+
+ /* Due to pointer verification in MAKE-LISP-OBJ, this must
+ include its header data (the offset from the start of the
+ code-object to the LRA). The code-object header is five
+ words, there are two words of constants, and the instruction
+ space is doubleword-aligned, making an offset of eight.
+ This is header data for a widetag, so shift left eight bits
+ and add. */
+ .long RETURN_PC_HEADER_WIDETAG + 0x800
+
+ /* We are receiving unknown multiple values, thus must deal
+ with the single-value and multiple-value cases separately. */
+ b fun_end_breakpoint_multiple_values
+ nop
+ /* Compute the correct value for reg_CODE based on the LRA.
+ This is a "simple" matter of subtracting a constant from
+ reg_LRA (where the LRA is stored by the return sequence) to
+ obtain a tagged pointer to the enclosing code component. Both
+ values are tagged OTHER_POINTER_LOWTAG, so we just have to
+ account for the eight words (see calculation for
+ RETURN_PC_HEADER_WIDETAG, above) between the two addresses.
+ Restoring reg_CODE doesn't appear to be strictly necessary
+ here, but let's observe the niceties.*/
+ addi reg_CODE, reg_LRA, -32
+
+ /* Multiple values are stored relative to reg_OCFP, which we
+ set to be the current top-of-stack. */
+ mr reg_OCFP, reg_CSP
+
+ /* Reserve a save location for the one value we have. */
+ addi reg_CSP, reg_CSP, 4
+
+ /* Record the number of values we have as a FIXNUM. */
+ li reg_NARGS, 4
+
+ /* Blank the remaining arg-passing registers. */
+ mr reg_A1, reg_NULL
+ mr reg_A2, reg_NULL
+ mr reg_A3, reg_NULL
+
+ /* And branch to our trap. */
+ b CSYMBOL(fun_end_breakpoint_trap)
+
+fun_end_breakpoint_multiple_values:
+ /* Compute the correct value for reg_CODE. See the
+ explanation for the single-value case, above. */
+ addi reg_CODE, reg_LRA, -32
+
+ /* The actual magic trap. */
+CSYMBOL(fun_end_breakpoint_trap):
+ twllei reg_ZERO, trap_FunEndBreakpoint
+
+ /* Finally, the debugger needs to know where the end of the
+ fun_end_breakpoint_guts are, so that it may calculate its size
+ in order to populate out a suitably-sized code object. */
+CSYMBOL(fun_end_breakpoint_end):
+ SET_SIZE(fun_end_breakpoint_guts)
+\f
GFUNCDEF(ppc_flush_cache_line)
dcbf 0,REG(3)