From: Alastair B. <lis...@us...> - 2010-08-08 01:13:46
|
Update of /cvsroot/sbcl/sbcl/src/runtime In directory sfp-cvsdas-3.v30.ch3.sourceforge.com:/tmp/cvs-serv28811/src/runtime Modified Files: Config.ppc-linux ppc-arch.c ppc-arch.h ppc-assem.S ppc-linux-os.c thread.c Log Message: 1.0.41.38: ppc: Runtime damage for threads. * Call out to pthread_getspecific() from call_into_lisp in order to obtain the TLS block for lisp operation. * Tie together the runtime / gencgc version of pseudo-atomic and the arch-specific / interrupt context version of pseudo- atomic, to fulfill the requirements of the earlier pseudo- atomic restructuring. * Generally use the thread structure instead of global variables where appropriate. * Save our TLS block in the pthread per-thread storage area. * SIG_STOP_FOR_GC appears to default to masked on PPC, so unblock it in initial_thread_trampoline(). * Link with -lpthread when appropriate. Index: Config.ppc-linux =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/runtime/Config.ppc-linux,v retrieving revision 1.9 retrieving revision 1.10 diff -u -d -r1.9 -r1.10 --- Config.ppc-linux 19 Nov 2006 11:26:16 -0000 1.9 +++ Config.ppc-linux 8 Aug 2010 01:13:36 -0000 1.10 @@ -25,6 +25,10 @@ GC_SRC = cheneygc.c endif +ifdef LISP_FEATURE_SB_THREAD + OS_LIBS += -lpthread +endif + # Nothing to do for after-grovel-headers. .PHONY: after-grovel-headers after-grovel-headers: Index: ppc-arch.c =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/runtime/ppc-arch.c,v retrieving revision 1.34 retrieving revision 1.35 diff -u -d -r1.34 -r1.35 --- ppc-arch.c 7 Aug 2010 13:42:41 -0000 1.34 +++ ppc-arch.c 8 Aug 2010 01:13:36 -0000 1.35 @@ -28,6 +28,10 @@ #include "gencgc-alloc-region.h" #endif +#ifdef LISP_FEATURE_SB_THREAD +#include "pseudo-atomic.h" +#endif + /* The header files may not define PT_DAR/PT_DSISR. This definition is correct for all versions of ppc linux >= 2.0.30 @@ -89,6 +93,13 @@ boolean arch_pseudo_atomic_atomic(os_context_t *context) { +#ifdef LISP_FEATURE_SB_THREAD + struct thread *thread = arch_os_get_current_thread(); + + if (foreign_function_call_active_p(thread)) { + return get_pseudo_atomic_atomic(thread); + } else return +#else /* FIXME: this foreign_function_call_active test is dubious at * best. If a foreign call is made in a pseudo atomic section * (?) or more likely a pseudo atomic section is in a foreign @@ -99,20 +110,37 @@ * The foreign_function_call_active used to live at each call-site * to arch_pseudo_atomic_atomic, but this seems clearer. * --NS 2007-05-15 */ - return (!foreign_function_call_active_p(arch_os_get_current_thread())) - && ((*os_context_register_addr(context,reg_ALLOC)) & 4); + return (!foreign_function_call_active_p(arch_os_get_current_thread())) && +#endif + ((*os_context_register_addr(context,reg_ALLOC)) & flag_PseudoAtomic); } void arch_set_pseudo_atomic_interrupted(os_context_t *context) { - *os_context_register_addr(context,reg_ALLOC) |= 1; +#ifdef LISP_FEATURE_SB_THREAD + struct thread *thread = arch_os_get_current_thread(); + + if (foreign_function_call_active_p(thread)) { + set_pseudo_atomic_interrupted(thread); + } else +#endif + *os_context_register_addr(context,reg_ALLOC) + |= flag_PseudoAtomicInterrupted; } void arch_clear_pseudo_atomic_interrupted(os_context_t *context) { - *os_context_register_addr(context,reg_ALLOC) &= ~1; +#ifdef LISP_FEATURE_SB_THREAD + struct thread *thread = arch_os_get_current_thread(); + + if (foreign_function_call_active_p(thread)) { + clear_pseudo_atomic_interrupted(thread); + } else +#endif + *os_context_register_addr(context,reg_ALLOC) + &= ~flag_PseudoAtomicInterrupted; } unsigned int @@ -450,10 +478,14 @@ #endif *os_context_register_addr(context, target) = (unsigned long) memory; +#ifndef LISP_FEATURE_SB_THREAD + /* This is handled by the fake_foreign_function_call machinery on + * threaded targets. */ *os_context_register_addr(context, reg_ALLOC) = (unsigned long) dynamic_space_free_pointer | (*os_context_register_addr(context, reg_ALLOC) & LOWTAG_MASK); +#endif if (were_in_lisp) { undo_fake_foreign_function_call(context); Index: ppc-arch.h =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/runtime/ppc-arch.h,v retrieving revision 1.7 retrieving revision 1.8 diff -u -d -r1.7 -r1.8 --- ppc-arch.h 8 Aug 2010 01:12:28 -0000 1.7 +++ ppc-arch.h 8 Aug 2010 01:13:36 -0000 1.8 @@ -32,6 +32,21 @@ *word=0; } +#ifdef LISP_FEATURE_SB_THREAD +static inline lispobj +swap_lispobjs(volatile lispobj *dest, lispobj value) +{ + lispobj old_value; + asm volatile ("1: lwarx %0,0,%1;" + " stwcx. %2,0,%1;" + " bne- 1b;" + " isync" + : "=&r" (old_value) + : "r" (dest), "r" (value) + : "cr0", "memory"); + return old_value; +} +#endif #define ARCH_HAS_LINK_REGISTER Index: ppc-assem.S =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/runtime/ppc-assem.S,v retrieving revision 1.16 retrieving revision 1.17 diff -u -d -r1.16 -r1.17 --- ppc-assem.S 7 Aug 2010 15:23:10 -0000 1.16 +++ ppc-assem.S 8 Aug 2010 01:13:36 -0000 1.17 @@ -9,6 +9,9 @@ #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 @@ -286,6 +289,33 @@ 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 @@ -301,7 +331,9 @@ 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) @@ -313,12 +345,23 @@ /* Turn on pseudo-atomic */ li reg_ALLOC,4 +#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) +#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 */ subi reg_ALLOC,reg_ALLOC,4 @@ -366,6 +409,15 @@ /* Turn on pseudo-atomic */ la reg_ALLOC,4(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) + + /* No longer in Lisp. */ + stw reg_ALLOC,THREAD_FOREIGN_FUNCTION_CALL_ACTIVE_OFFSET(reg_L2) +#else /* Store lisp state */ clrrwi reg_NL1,reg_ALLOC,3 store(reg_NL1,reg_NL2,CSYMBOL(dynamic_space_free_pointer)) @@ -378,6 +430,7 @@ /* No longer in Lisp. */ store(reg_NL1,reg_NL2,CSYMBOL(foreign_function_call_active)) +#endif /* Check for interrupt */ subi reg_ALLOC, reg_ALLOC, 4 @@ -419,6 +472,15 @@ 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_L2) + stw reg_CSP,THREAD_CONTROL_STACK_POINTER_OFFSET(reg_L2) + stw reg_CFP,THREAD_CONTROL_FRAME_POINTER_OFFSET(reg_L2) + + /* No longer in Lisp. */ + stw reg_CSP,THREAD_FOREIGN_FUNCTION_CALL_ACTIVE_OFFSET(reg_L2) +#else /* Store Lisp state */ clrrwi reg_NFP,reg_ALLOC,3 store(reg_NFP,reg_CFUNC,CSYMBOL(dynamic_space_free_pointer)) @@ -430,6 +492,7 @@ /* 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 */ subi reg_ALLOC, reg_ALLOC, 4 @@ -472,22 +535,38 @@ 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 /* Atomic ... */ li reg_NL3,-4 li reg_ALLOC,4 +#if defined(LISP_FEATURE_SB_THREAD) + /* No longer in foreign function call. */ + stw reg_ZERO,THREAD_FOREIGN_FUNCTION_CALL_ACTIVE_OFFSET(reg_L2) + + /* The binding stack pointer isn't preserved by C. */ + lwz reg_BSP,THREAD_BINDING_STACK_POINTER_OFFSET(reg_L2) +#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 */ Index: ppc-linux-os.c =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/runtime/ppc-linux-os.c,v retrieving revision 1.16 retrieving revision 1.17 diff -u -d -r1.16 -r1.17 --- ppc-linux-os.c 6 Jun 2010 19:41:10 -0000 1.16 +++ ppc-linux-os.c 8 Aug 2010 01:13:36 -0000 1.17 @@ -42,6 +42,10 @@ size_t os_vm_page_size; int arch_os_thread_init(struct thread *thread) { +#if defined(LISP_FEATURE_SB_THREAD) + pthread_setspecific(specials,thread); +#endif + /* For some reason, PPC Linux appears to default to not generating * floating point exceptions. PR_SET_FPEXC is a PPC-specific * option new in kernel 2.4.21 and 2.5.32 that allows us to Index: thread.c =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/runtime/thread.c,v retrieving revision 1.112 retrieving revision 1.113 diff -u -d -r1.112 -r1.113 --- thread.c 7 Aug 2010 13:46:26 -0000 1.112 +++ thread.c 8 Aug 2010 01:13:36 -0000 1.113 @@ -131,6 +131,10 @@ #ifdef LISP_FEATURE_SB_THREAD pthread_setspecific(lisp_thread, (void *)1); #endif +#if defined(LISP_FEATURE_SB_THREAD) && defined(LISP_FEATURE_PPC) + /* SIG_STOP_FOR_GC defaults to blocked on PPC? */ + unblock_gc_signals(0,0); +#endif function = th->no_tls_value_marker; th->no_tls_value_marker = NO_TLS_VALUE_MARKER_WIDETAG; if(arch_os_thread_init(th)==0) return 1; |