Add :application-type parameter for save-lisp-and-die on Windows.
[sbcl.git] / src / runtime / ppc-assem.S
index 72838ca..3b6e53f 100644 (file)
@@ -279,7 +279,26 @@ x:
        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
 
 /*
@@ -344,12 +363,12 @@ x:
 #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_L2)
-       lwz reg_BSP,THREAD_BINDING_STACK_POINTER_OFFSET(reg_L2)
-       lwz reg_CSP,THREAD_CONTROL_STACK_POINTER_OFFSET(reg_L2)
-       lwz reg_OCFP,THREAD_CONTROL_FRAME_POINTER_OFFSET(reg_L2)
+       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_BSP,CSYMBOL(current_binding_stack_pointer))
@@ -364,8 +383,8 @@ x:
        add reg_ALLOC,reg_ALLOC,reg_NL4
 
        /* No longer atomic, and check for interrupt */
-       subi reg_ALLOC,reg_ALLOC,4
-       andi. reg_NL3, reg_ALLOC, 1
+       subi reg_ALLOC,reg_ALLOC,flag_PseudoAtomic
+       andi. reg_NL3, reg_ALLOC, flag_PseudoAtomicInterrupted
        twnei reg_NL3, 0
 
        /* Pass in the arguments */
@@ -407,16 +426,16 @@ lra:
        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_L2)
-       stw reg_CSP,THREAD_CONTROL_STACK_POINTER_OFFSET(reg_L2)
-       stw reg_CFP,THREAD_CONTROL_FRAME_POINTER_OFFSET(reg_L2)
+       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_L2)
+       stw reg_ALLOC,THREAD_FOREIGN_FUNCTION_CALL_ACTIVE_OFFSET(reg_THREAD)
 #else
        /* Store lisp state */
        clrrwi reg_NL1,reg_ALLOC,3
@@ -433,8 +452,8 @@ lra:
 #endif
 
        /* Check for interrupt */
-       subi reg_ALLOC, reg_ALLOC, 4
-       andi. reg_NL3, reg_ALLOC, 1
+       subi reg_ALLOC, reg_ALLOC, flag_PseudoAtomic
+       andi. reg_NL3, reg_ALLOC, flag_PseudoAtomicInterrupted
        twnei reg_NL3,0
        
        /* Back to C */
@@ -465,7 +484,7 @@ lra:
        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
@@ -474,12 +493,12 @@ lra:
 
 #ifdef LISP_FEATURE_SB_THREAD
        /* Store Lisp state */
-       stw reg_BSP,THREAD_BINDING_STACK_POINTER_OFFSET(reg_L2)
-       stw reg_CSP,THREAD_CONTROL_STACK_POINTER_OFFSET(reg_L2)
-       stw reg_CFP,THREAD_CONTROL_FRAME_POINTER_OFFSET(reg_L2)
+       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_L2)
+       stw reg_CSP,THREAD_FOREIGN_FUNCTION_CALL_ACTIVE_OFFSET(reg_THREAD)
 #else
        /* Store Lisp state */
        clrrwi reg_NFP,reg_ALLOC,3
@@ -495,10 +514,15 @@ lra:
 #endif
        /* load(reg_POLL,saver2) */
        /* Disable pseudo-atomic; check pending interrupt */
-       subi reg_ALLOC, reg_ALLOC, 4
-       andi. reg_NL3, reg_ALLOC, 1
+       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
@@ -541,16 +565,20 @@ lra:
 #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_L2)
+       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_L2)
+       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))
@@ -578,8 +606,8 @@ lra:
        la reg_LIP,-OTHER_POINTER_LOWTAG(reg_LIP)
 
        /* No longer atomic */
-       subi reg_ALLOC, reg_ALLOC, 4
-       andi. reg_NL3, reg_ALLOC, 1
+       subi reg_ALLOC, reg_ALLOC, flag_PseudoAtomic
+       andi. reg_NL3, reg_ALLOC, flag_PseudoAtomicInterrupted
        twnei reg_NL3, 0
 
        mtlr reg_LIP
@@ -606,14 +634,27 @@ 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.  */
-       bcl 20,31,.+4                  /* get address of the next instruction */
-       mflr reg_CODE                  /* header 1 extra word back from here */
-       addi reg_CODE,reg_CODE,-(SIMPLE_FUN_CODE_OFFSET+4)
-       
+       /* 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
@@ -664,13 +705,13 @@ CSYMBOL(funcallable_instance_tramp) = . + 1
        .globl CSYMBOL(fun_end_breakpoint_trap)
        .globl CSYMBOL(fun_end_breakpoint_end)
 
-       /* Due to pointer verification in MAKE-LISP-OBJ on GENCGC
-       targets, which includes PPC, 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. */
+       /* 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