1.0.41.19: runtime: Fix pseudo-atomic on non-x86oid gencgc.

  * Pseudo-atomic is per-thread state, add it to struct thread.

  * Pass the correct pointer for accessing p-a in dynbind.c.

  * In {undo_,}fake_foreign_function_call(), stash reg_ALLOC as
pseudo-atomic-bits on threaded targets.

  * In pseudo-atomic.h, the ppc gencgc code is really non-x86oid
gencgc code.

  * Also in pseudo-atomic.h, update the non-x86oid gencgc code
to do the right thing with threaded pseudo-atomic-bits.

  * Due to the way dynamic binding works on threaded targets, it
is now a requirement that the arch_* pseudo_atomic functions call
the generic versions if foreign_function_call_active_p() is true
on threaded targets (in short, C code needs to be able to enter
pseudo-atomic, not just lisp code).

diff --git a/src/compiler/generic/objdef.lisp b/src/compiler/generic/objdef.lisp
index 7863096..0d23165 100644 (file)
--- a/src/compiler/generic/objdef.lisp
+++ b/src/compiler/generic/objdef.lisp
@@ -410,7 +410,7 @@
   ;; starting, running, suspended, dead
   (state :c-type "lispobj")
   (tls-cookie)                          ;  on x86, the LDT index
-  #!+(or x86 x86-64) (pseudo-atomic-bits)
+  #!+(or x86 x86-64 sb-thread) (pseudo-atomic-bits)
   (interrupt-data :c-type "struct interrupt_data *"
                   :length #!+alpha 2 #!-alpha 1)
   (stepping)

diff --git a/src/runtime/dynbind.c b/src/runtime/dynbind.c
index 9a64a0a..6f20b63 100644 (file)
--- a/src/runtime/dynbind.c
+++ b/src/runtime/dynbind.c
@@ -48,7 +48,7 @@ void bind_variable(lispobj symbol, lispobj value, void *th)
             lispobj *tls_index_lock=
                 &((struct symbol *)native_pointer(TLS_INDEX_LOCK))->value;
             FSHOW_SIGNAL((stderr, "entering dynbind tls alloc\n"));
-            set_pseudo_atomic_atomic(th);
+            set_pseudo_atomic_atomic(thread);
             get_spinlock(tls_index_lock,(long)th);
             if(!sym->tls_index) {
                 sym->tls_index=SymbolValue(FREE_TLS_INDEX,0);
@@ -60,8 +60,8 @@ void bind_variable(lispobj symbol, lispobj value, void *th)
             }
             release_spinlock(tls_index_lock);
             FSHOW_SIGNAL((stderr, "exiting dynbind tls alloc\n"));
-            clear_pseudo_atomic_atomic(th);
-            if (get_pseudo_atomic_interrupted(th))
+            clear_pseudo_atomic_atomic(thread);
+            if (get_pseudo_atomic_interrupted(thread))
                 do_pending_interrupt();
         }
     }

diff --git a/src/runtime/interrupt.c b/src/runtime/interrupt.c
index 0d426fa..4db3cb2 100644 (file)
--- a/src/runtime/interrupt.c
+++ b/src/runtime/interrupt.c
@@ -666,8 +666,12 @@ fake_foreign_function_call(os_context_t *context)
 
     /* Get current Lisp state from context. */
 #ifdef reg_ALLOC
+#ifdef LISP_FEATURE_SB_THREAD
+    thread->pseudo_atomic_bits =
+#else
     dynamic_space_free_pointer =
         (lispobj *)(unsigned long)
+#endif
             (*os_context_register_addr(context, reg_ALLOC));
 /*     fprintf(stderr,"dynamic_space_free_pointer: %p\n", */
 /*             dynamic_space_free_pointer); */
@@ -728,7 +732,7 @@ undo_fake_foreign_function_call(os_context_t *context)
     /* Undo dynamic binding of FREE_INTERRUPT_CONTEXT_INDEX */
     unbind(thread);
 
-#ifdef reg_ALLOC
+#if defined(reg_ALLOC) && !defined(LISP_FEATURE_SB_THREAD)
     /* Put the dynamic space free pointer back into the context. */
     *os_context_register_addr(context, reg_ALLOC) =
         (unsigned long) dynamic_space_free_pointer
@@ -740,6 +744,17 @@ undo_fake_foreign_function_call(os_context_t *context)
       | ((unsigned long) dynamic_space_free_pointer & LOWTAG_MASK);
     */
 #endif
+#if defined(reg_ALLOC) && defined(LISP_FEATURE_SB_THREAD)
+    /* Put the pseudo-atomic bits and dynamic space free pointer back
+     * into the context (p-a-bits for p-a, and dynamic space free
+     * pointer for ROOM). */
+    *os_context_register_addr(context, reg_ALLOC) =
+        (unsigned long) dynamic_space_free_pointer
+        | (thread->pseudo_atomic_bits & LOWTAG_MASK);
+    /* And clear them so we don't get bit later by call-in/call-out
+     * not updating them. */
+    thread->pseudo_atomic_bits = 0;
+#endif
 }
 
 /* a handler for the signal caused by execution of a trap opcode

diff --git a/src/runtime/pseudo-atomic.h b/src/runtime/pseudo-atomic.h
index 40898c7..8556e0c 100644 (file)
--- a/src/runtime/pseudo-atomic.h
+++ b/src/runtime/pseudo-atomic.h
@@ -95,7 +95,7 @@ clear_pseudo_atomic_interrupted(struct thread *thread)
 
 #undef LISPOBJ_SUFFIX
 
-#elif defined(LISP_FEATURE_PPC) && defined(LISP_FEATURE_GENCGC)
+#elif defined(LISP_FEATURE_GENCGC)
 
 /* FIXME: Are these async signal safe? Compiler reordering? */
 
@@ -106,6 +106,23 @@ clear_pseudo_atomic_interrupted(struct thread *thread)
 
 #define get_alloc_pointer()                                     \
     ((unsigned long) dynamic_space_free_pointer & ~LOWTAG_MASK)
+
+#ifdef LISP_FEATURE_SB_THREAD
+#define get_binding_stack_pointer(thread)       \
+    ((thread)->binding_stack_pointer)
+#define get_pseudo_atomic_atomic(thread) \
+    ((thread)->pseudo_atomic_bits & flag_PseudoAtomic)
+#define set_pseudo_atomic_atomic(thread) \
+    ((thread)->pseudo_atomic_bits |= flag_PseudoAtomic)
+#define clear_pseudo_atomic_atomic(thread) \
+    ((thread)->pseudo_atomic_bits &= ~flag_PseudoAtomic)
+#define get_pseudo_atomic_interrupted(thread) \
+    ((thread)->pseudo_atomic_bits & flag_PseudoAtomicInterrupted)
+#define set_pseudo_atomic_interrupted(thread) \
+    ((thread)->pseudo_atomic_bits |= flag_PseudoAtomicInterrupted)
+#define clear_pseudo_atomic_interrupted(thread) \
+    ((thread)->pseudo_atomic_bits &= ~flag_PseudoAtomicInterrupted)
+#else
 #define get_binding_stack_pointer(thread)       \
     (current_binding_stack_pointer)
 #define get_pseudo_atomic_atomic(thread)                                \
@@ -124,6 +141,7 @@ clear_pseudo_atomic_interrupted(struct thread *thread)
 #define set_pseudo_atomic_interrupted(thread)                           \
     (dynamic_space_free_pointer                                         \
      = (lispobj*) ((unsigned long) dynamic_space_free_pointer | flag_PseudoAtomicInterrupted))
+#endif
 
 #endif
 

diff --git a/src/runtime/thread.c b/src/runtime/thread.c
index 7ee7d2f..b71eba0 100644 (file)
--- a/src/runtime/thread.c
+++ b/src/runtime/thread.c
@@ -439,7 +439,7 @@ create_thread_struct(lispobj initial_function) {
 #else
     th->alien_stack_pointer=((void *)th->alien_stack_start);
 #endif
-#if defined(LISP_FEATURE_X86) || defined (LISP_FEATURE_X86_64)
+#if defined(LISP_FEATURE_X86) || defined (LISP_FEATURE_X86_64) || defined(LISP_FEATURE_SB_THREAD)
     th->pseudo_atomic_bits=0;
 #endif
 #ifdef LISP_FEATURE_GENCGC

diff --git a/version.lisp-expr b/version.lisp-expr
index d82c631..ecb0493 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.18"
+"1.0.41.19"