Add :application-type parameter for save-lisp-and-die on Windows.
[sbcl.git] / src / runtime / thread.c
index 053f486..1889213 100644 (file)
@@ -349,8 +349,9 @@ schedule_thread_post_mortem(struct thread *corpse)
 
 # endif /* !IMMEDIATE_POST_MORTEM */
 
+/* Note: scribble must be stack-allocated */
 static void
-init_new_thread(struct thread *th, init_thread_data *scribble)
+init_new_thread(struct thread *th, init_thread_data *scribble, int guardp)
 {
     int lock_ret;
 
@@ -361,7 +362,8 @@ init_new_thread(struct thread *th, init_thread_data *scribble)
     }
 
     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
@@ -369,7 +371,7 @@ init_new_thread(struct thread *th, init_thread_data *scribble)
      * 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)&lock_ret;
+    *th->csp_around_foreign_call = (lispobj)scribble;
 #endif
     lock_ret = pthread_mutex_lock(&all_threads_lock);
     gc_assert(lock_ret == 0);
@@ -399,6 +401,9 @@ undo_init_new_thread(struct thread *th, init_thread_data *scribble)
 #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);
@@ -416,6 +421,9 @@ undo_init_new_thread(struct thread *th, init_thread_data *scribble)
     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);
@@ -449,6 +457,15 @@ undo_init_new_thread(struct thread *th, init_thread_data *scribble)
     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);
 }
 
@@ -471,7 +488,7 @@ new_thread_trampoline(struct thread *th)
 
     lispobj function = th->no_tls_value_marker;
     th->no_tls_value_marker = NO_TLS_VALUE_MARKER_WIDETAG;
-    init_new_thread(th, &scribble);
+    init_new_thread(th, &scribble, 1);
     result = funcall0(function);
     undo_init_new_thread(th, &scribble);
 
@@ -479,6 +496,67 @@ new_thread_trampoline(struct thread *th)
     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
@@ -617,7 +695,7 @@ create_thread_struct(lispobj initial_function) {
     th->state_not_stopped_waitcount = 0;
 #endif
     th->state=STATE_RUNNING;
-#ifdef LISP_FEATURE_STACK_GROWS_DOWNWARD_NOT_UPWARD
+#ifdef ALIEN_STACK_GROWS_DOWNWARD
     th->alien_stack_pointer=((void *)th->alien_stack_start
                              + ALIEN_STACK_SIZE-N_WORD_BYTES);
 #else
@@ -628,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
@@ -754,8 +835,13 @@ boolean create_os_thread(struct thread *th,os_thread_t *kid_tid)
 #if defined(LISP_FEATURE_WIN32)
        (pthread_attr_setstacksize(th->os_attr, thread_control_stack_size)) ||
 #else
+# if defined(LISP_FEATURE_C_STACK_IS_CONTROL_STACK)
        (pthread_attr_setstack(th->os_attr,th->control_stack_start,
                               thread_control_stack_size)) ||
+# else
+       (pthread_attr_setstack(th->os_attr,th->alien_stack_start,
+                              ALIEN_STACK_SIZE)) ||
+# endif
 #endif
        (retcode = pthread_create
         (kid_tid,th->os_attr,(void *(*)(void *))new_thread_trampoline,th))) {