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.

diff --git a/src/runtime/Config.ppc-linux b/src/runtime/Config.ppc-linux
index d2fe76c..f8ceded 100644 (file)
--- a/src/runtime/Config.ppc-linux
+++ b/src/runtime/Config.ppc-linux
@@ -25,6 +25,10 @@ else
   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:

diff --git a/src/runtime/ppc-arch.c b/src/runtime/ppc-arch.c
index bdd1a40..a4df6f5 100644 (file)
--- a/src/runtime/ppc-arch.c
+++ b/src/runtime/ppc-arch.c
@@ -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 @@ arch_internal_error_arguments(os_context_t *context)
 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 @@ arch_pseudo_atomic_atomic(os_context_t *context)
      * 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 @@ handle_allocation_trap(os_context_t * context)
 #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);

diff --git a/src/runtime/ppc-arch.h b/src/runtime/ppc-arch.h
index b225869..515335f 100644 (file)
--- a/src/runtime/ppc-arch.h
+++ b/src/runtime/ppc-arch.h
@@ -32,6 +32,21 @@ release_spinlock(lispobj *word)
     *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
 

diff --git a/src/runtime/ppc-assem.S b/src/runtime/ppc-assem.S
index ec19ad5..72838ca 100644 (file)
--- a/src/runtime/ppc-assem.S
+++ b/src/runtime/ppc-assem.S
@@ -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 @@ x:
 
        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 @@ x:
        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 @@ x:
        /* 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 @@ lra:
        /* 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 @@ lra:
 
        /* 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 @@ lra:
        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 @@ lra:
 
        /* 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 @@ lra:
        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 */

diff --git a/src/runtime/ppc-linux-os.c b/src/runtime/ppc-linux-os.c
index a2e72b4..c2dc019 100644 (file)
--- a/src/runtime/ppc-linux-os.c
+++ b/src/runtime/ppc-linux-os.c
@@ -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

diff --git a/src/runtime/thread.c b/src/runtime/thread.c
index 8e3f7fd..535263a 100644 (file)
--- a/src/runtime/thread.c
+++ b/src/runtime/thread.c
@@ -131,6 +131,10 @@ initial_thread_trampoline(struct thread *th)
 #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;

diff --git a/version.lisp-expr b/version.lisp-expr
index b85c36c..0b23bc7 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.41.37"
+"1.0.41.38"