X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fruntime%2Fthread.c;h=26f6de6790536f16f768921e10a43808479dce6f;hb=c8617f57d0413beb2890e94dabe227cef9c5ddad;hp=838a187cdbd02a6678a7c4a8f7128b5b17ea0f52;hpb=d1a2fa597f993d56bcfa73a64509465d56b4ffac;p=sbcl.git

diff --git a/src/runtime/thread.c b/src/runtime/thread.c
index 838a187..26f6de6 100644
--- a/src/runtime/thread.c
+++ b/src/runtime/thread.c
@@ -349,32 +349,21 @@ schedule_thread_post_mortem(struct thread *corpse)
 
 # endif /* !IMMEDIATE_POST_MORTEM */
 
-/* this is the first thing that runs in the child (which is why the
- * silly calling convention).  Basically it calls the user's requested
- * lisp function after doing arch_os_thread_init and whatever other
- * bookkeeping needs to be done
- */
-int
-new_thread_trampoline(struct thread *th)
+/* Note: scribble must be stack-allocated */
+static void
+init_new_thread(struct thread *th, init_thread_data *scribble, int guardp)
 {
-    lispobj function;
-    int result, lock_ret;
+    int lock_ret;
 
-    FSHOW((stderr,"/creating thread %lu\n", thread_self()));
-    check_deferrables_blocked_or_lose(0);
-#ifndef LISP_FEATURE_SB_SAFEPOINT
-    check_gc_signals_unblocked_or_lose(0);
-#endif
     pthread_setspecific(lisp_thread, (void *)1);
-    function = th->no_tls_value_marker;
-    th->no_tls_value_marker = NO_TLS_VALUE_MARKER_WIDETAG;
     if(arch_os_thread_init(th)==0) {
         /* FIXME: handle error */
         lose("arch_os_thread_init failed\n");
     }
 
     th->os_thread=thread_self();
-    protect_control_stack_guard_page(1, NULL);
+    if (guardp)
+        protect_control_stack_guard_page(1, NULL);
     protect_binding_stack_guard_page(1, NULL);
     protect_alien_stack_guard_page(1, NULL);
     /* Since GC can only know about this thread from the all_threads
@@ -382,7 +371,7 @@ new_thread_trampoline(struct thread *th)
      * danger of deadlocking even with SIG_STOP_FOR_GC blocked (which
      * it is not). */
 #ifdef LISP_FEATURE_SB_SAFEPOINT
-    *th->csp_around_foreign_call = (lispobj)&function;
+    *th->csp_around_foreign_call = (lispobj)scribble;
 #endif
     lock_ret = pthread_mutex_lock(&all_threads_lock);
     gc_assert(lock_ret == 0);
@@ -397,19 +386,31 @@ new_thread_trampoline(struct thread *th)
     gc_state_lock();
     gc_state_wait(GC_NONE);
     gc_state_unlock();
-    WITH_GC_AT_SAFEPOINTS_ONLY() {
-        result = funcall0(function);
-        block_blockable_signals(0, 0);
-        gc_alloc_update_page_tables(BOXED_PAGE_FLAG, &th->alloc_region);
-    }
+    push_gcing_safety(&scribble->safety);
+#endif
+}
+
+static void
+undo_init_new_thread(struct thread *th, init_thread_data *scribble)
+{
+    int lock_ret;
+
+    /* Kludge: Changed the order of some steps between the safepoint/
+     * non-safepoint versions of this code.  Can we unify this more?
+     */
+#ifdef LISP_FEATURE_SB_SAFEPOINT
+    block_blockable_signals(0, 0);
+    gc_alloc_update_page_tables(BOXED_PAGE_FLAG, &th->alloc_region);
+#if defined(LISP_FEATURE_SB_SAFEPOINT_STRICTLY) && !defined(LISP_FEATURE_WIN32)
+    gc_alloc_update_page_tables(BOXED_PAGE_FLAG, &th->sprof_alloc_region);
+#endif
+    pop_gcing_safety(&scribble->safety);
     lock_ret = pthread_mutex_lock(&all_threads_lock);
     gc_assert(lock_ret == 0);
     unlink_thread(th);
     lock_ret = pthread_mutex_unlock(&all_threads_lock);
     gc_assert(lock_ret == 0);
 #else
-    result = funcall0(function);
-
     /* Block GC */
     block_blockable_signals(0, 0);
     set_thread_state(th, STATE_DEAD);
@@ -420,6 +421,9 @@ new_thread_trampoline(struct thread *th)
     gc_assert(lock_ret == 0);
 
     gc_alloc_update_page_tables(BOXED_PAGE_FLAG, &th->alloc_region);
+#if defined(LISP_FEATURE_SB_SAFEPOINT_STRICTLY) && !defined(LISP_FEATURE_WIN32)
+    gc_alloc_update_page_tables(BOXED_PAGE_FLAG, &th->sprof_alloc_region);
+#endif
     unlink_thread(th);
     pthread_mutex_unlock(&all_threads_lock);
     gc_assert(lock_ret == 0);
@@ -453,11 +457,106 @@ new_thread_trampoline(struct thread *th)
     TlsSetValue(OUR_TLS_INDEX,NULL);
 #endif
 
+    /* Undo the association of the current pthread to its `struct thread',
+     * such that we can call arch_os_get_current_thread() later in this
+     * thread and cleanly get back NULL. */
+#ifdef LISP_FEATURE_GCC_TLS
+    current_thread = NULL;
+#else
+    pthread_setspecific(specials, NULL);
+#endif
+
     schedule_thread_post_mortem(th);
+}
+
+/* this is the first thing that runs in the child (which is why the
+ * silly calling convention).  Basically it calls the user's requested
+ * lisp function after doing arch_os_thread_init and whatever other
+ * bookkeeping needs to be done
+ */
+int
+new_thread_trampoline(struct thread *th)
+{
+    int result;
+    init_thread_data scribble;
+
+    FSHOW((stderr,"/creating thread %lu\n", thread_self()));
+    check_deferrables_blocked_or_lose(0);
+#ifndef LISP_FEATURE_SB_SAFEPOINT
+    check_gc_signals_unblocked_or_lose(0);
+#endif
+
+    lispobj function = th->no_tls_value_marker;
+    th->no_tls_value_marker = NO_TLS_VALUE_MARKER_WIDETAG;
+    init_new_thread(th, &scribble, 1);
+    result = funcall0(function);
+    undo_init_new_thread(th, &scribble);
+
     FSHOW((stderr,"/exiting thread %lu\n", thread_self()));
     return result;
 }
 
+# ifdef LISP_FEATURE_SB_SAFEPOINT
+static struct thread *create_thread_struct(lispobj);
+
+void
+attach_os_thread(init_thread_data *scribble)
+{
+    os_thread_t os = pthread_self();
+    odxprint(misc, "attach_os_thread: attaching to %p", os);
+
+    struct thread *th = create_thread_struct(NIL);
+    block_deferrable_signals(0, &scribble->oldset);
+    th->no_tls_value_marker = NO_TLS_VALUE_MARKER_WIDETAG;
+    /* We don't actually want a pthread_attr here, but rather than add
+     * `if's to the post-mostem, let's just keep that code happy by
+     * keeping it initialized: */
+    pthread_attr_init(th->os_attr);
+
+#ifndef LISP_FEATURE_WIN32
+    /* On windows, arch_os_thread_init will take care of finding the
+     * stack. */
+    pthread_attr_t attr;
+    int pthread_getattr_np(pthread_t, pthread_attr_t *);
+    pthread_getattr_np(os, &attr);
+    void *stack_addr;
+    size_t stack_size;
+    pthread_attr_getstack(&attr, &stack_addr, &stack_size);
+    th->control_stack_start = stack_addr;
+    th->control_stack_end = (void *) (((uintptr_t) stack_addr) + stack_size);
+#endif
+
+    init_new_thread(th, scribble, 0);
+
+    /* We will be calling into Lisp soon, and the functions being called
+     * recklessly ignore the comment in target-thread which says that we
+     * must be careful to not cause GC while initializing a new thread.
+     * Since we first need to create a fresh thread object, it's really
+     * tempting to just perform such unsafe allocation though.  So let's
+     * at least try to suppress GC before consing, and hope that it
+     * works: */
+    bind_variable(GC_INHIBIT, T, th);
+
+    uword_t stacksize
+        = (uword_t) th->control_stack_end - (uword_t) th->control_stack_start;
+    odxprint(misc, "attach_os_thread: attached %p as %p (0x%lx bytes stack)",
+             os, th, (long) stacksize);
+}
+
+void
+detach_os_thread(init_thread_data *scribble)
+{
+    struct thread *th = arch_os_get_current_thread();
+    odxprint(misc, "detach_os_thread: detaching");
+
+    undo_init_new_thread(th, scribble);
+
+    odxprint(misc, "deattach_os_thread: detached");
+    pthread_setspecific(lisp_thread, (void *)0);
+    thread_sigmask(SIG_SETMASK, &scribble->oldset, 0);
+}
+# endif /* safepoint */
+
 #endif /* LISP_FEATURE_SB_THREAD */
 
 static void
@@ -607,6 +706,9 @@ create_thread_struct(lispobj initial_function) {
 #endif
 #ifdef LISP_FEATURE_GENCGC
     gc_set_region_empty(&th->alloc_region);
+# if defined(LISP_FEATURE_SB_SAFEPOINT_STRICTLY) && !defined(LISP_FEATURE_WIN32)
+    gc_set_region_empty(&th->sprof_alloc_region);
+# endif
 #endif
 #ifdef LISP_FEATURE_SB_THREAD
     /* This parallels the same logic in globals.c for the