0.8.9.9:
[sbcl.git] / src / runtime / thread.c
index ebdb2e4..83c9e72 100644 (file)
@@ -1,12 +1,10 @@
 #include <stdlib.h>
 #include <stdio.h>
+#include <string.h>
 #include <sched.h>
 #include <signal.h>
 #include <stddef.h>
 #include <errno.h>
-#ifndef CLONE_PARENT           /* lameass glibc 2.2  doesn't define this */
-#define CLONE_PARENT 0x00008000        /* even though the manpage documents it */
-#endif
 #include "runtime.h"
 #include "sbcl.h"
 #include "validate.h"          /* for CONTROL_STACK_SIZE etc */
 #include "target-arch-os.h"
 #include "os.h"
 #include "globals.h"
-#ifdef LISP_FEATURE_GENCGC
-#include "gencgc.h"
-#endif
 #include "dynbind.h"
 #include "genesis/cons.h"
 #define ALIEN_STACK_SIZE (1*1024*1024) /* 1Mb size chosen at random */
 
 int dynamic_values_bytes=4096*sizeof(lispobj); /* same for all threads */
 struct thread *all_threads;
-lispobj all_threads_lock;
-volatile int countdown_to_gc;
+volatile lispobj all_threads_lock;
 extern struct interrupt_data * global_interrupt_data;
 
 void get_spinlock(lispobj *word,int value);
 
+int
+initial_thread_trampoline(struct thread *th)
+{
+    lispobj function;
+    lispobj *args = NULL;
+    function = th->unbound_marker;
+    th->unbound_marker = UNBOUND_MARKER_WIDETAG;
+    if(arch_os_thread_init(th)==0) return 1;
+
+    if(th->pid < 1) lose("th->pid not set up right");
+    th->state=STATE_RUNNING;
+#if defined(LISP_FEATURE_X86)
+    return call_into_lisp_first_time(function,args,0);
+#else
+    return funcall0(function);
+#endif
+}
+
 /* this is the first thing that clone() 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
  */
 
-/* set go to 0 to stop the thread before it starts.  Convenient if you
-* want to attach a debugger to it before it does anything */
-volatile int go=1;             
-
 int
 new_thread_trampoline(struct thread *th)
 {
     lispobj function;
-    lispobj *args = NULL;
     function = th->unbound_marker;
-    if(go==0) {
-       fprintf(stderr, "/pausing 0x%lx(%d,%d) before new_thread_trampoline(0x%lx)\n",
-               (unsigned long)th,th->pid,getpid(),(unsigned long)function);
-       while(go==0) ;
-       fprintf(stderr, "/continue\n");
-    }
     th->unbound_marker = UNBOUND_MARKER_WIDETAG;
-#ifdef LISP_FEATURE_SB_THREAD
+    if(arch_os_thread_init(th)==0) return 1;   
+
     /* wait here until our thread is linked into all_threads: see below */
     while(th->pid<1) sched_yield();
-#else
-    if(th->pid < 1)
-       lose("th->pid not set up right");
-#endif
 
-    if(arch_os_thread_init(th)==0) 
-       return 1;               /* failure.  no, really */
-#if !defined(LISP_FEATURE_SB_THREAD) && defined(LISP_FEATURE_X86)
-    return call_into_lisp_first_time(function,args,0);
-#else
+    th->state=STATE_RUNNING;
     return funcall0(function);
-#endif
 }
 
 /* this is called from any other thread to create the new one, and
@@ -75,11 +68,10 @@ new_thread_trampoline(struct thread *th)
  * thread 
  */
 
-pid_t create_thread(lispobj initial_function) {
+struct thread * create_thread_struct(lispobj initial_function) {
     union per_thread_data *per_thread;
     struct thread *th=0;       /*  subdue gcc */
     void *spaces=0;
-    pid_t kid_pid;
 
     /* may as well allocate all the spaces at once: it saves us from
      * having to decide what to do if only some of the allocations
@@ -139,6 +131,7 @@ pid_t create_thread(lispobj initial_function) {
     th->binding_stack_pointer=th->binding_stack_start;
     th->this=th;
     th->pid=0;
+    th->state=STATE_STOPPED;
 #ifdef LISP_FEATURE_STACK_GROWS_DOWNWARD_NOT_UPWARD
     th->alien_stack_pointer=((void *)th->alien_stack_start
                             + ALIEN_STACK_SIZE-4); /* naked 4.  FIXME */
@@ -147,9 +140,7 @@ pid_t create_thread(lispobj initial_function) {
 #endif
 #ifdef LISP_FEATURE_X86
     th->pseudo_atomic_interrupted=0;
-    /* runtime.c used to set PSEUDO_ATOMIC_ATOMIC =1 globally.  I'm not
-     * sure why, but it appears to help */
-    th->pseudo_atomic_atomic=make_fixnum(1);
+    th->pseudo_atomic_atomic=0;
 #endif
 #ifdef LISP_FEATURE_GENCGC
     gc_set_region_empty(&th->alloc_region);
@@ -191,21 +182,17 @@ pid_t create_thread(lispobj initial_function) {
               sizeof (struct interrupt_data));
 
     th->unbound_marker=initial_function;
-#ifdef LISP_FEATURE_SB_THREAD
-#if defined(LISP_FEATURE_X86) && defined (LISP_FEATURE_LINUX)
-    kid_pid=
-       clone(new_thread_trampoline,
-             (((void*)th->control_stack_start)+THREAD_CONTROL_STACK_SIZE-4),
-             (((getpid()!=parent_pid)?(CLONE_PARENT):0)
-              |CLONE_FILES|SIGALRM|CLONE_VM),th);
-    if(kid_pid<=0) 
-       goto cleanup;
-#else
-#error this stuff presently only works on x86 Linux
-#endif
-#else
-    kid_pid=getpid();
-#endif
+    return th;
+ cleanup:
+    /* if(th && th->tls_cookie>=0) os_free_tls_pointer(th); */
+    if(spaces) os_invalidate(spaces,
+                            THREAD_CONTROL_STACK_SIZE+BINDING_STACK_SIZE+
+                            ALIEN_STACK_SIZE+dynamic_values_bytes);
+    return 0;
+}
+
+void link_thread(struct thread *th,pid_t kid_pid)
+{
     get_spinlock(&all_threads_lock,kid_pid);
     th->next=all_threads;
     all_threads=th;
@@ -215,20 +202,35 @@ pid_t create_thread(lispobj initial_function) {
     protect_control_stack_guard_page(th->pid,1);
     release_spinlock(&all_threads_lock);
     th->pid=kid_pid;           /* child will not start until this is set */
-#ifndef LISP_FEATURE_SB_THREAD
-    new_thread_trampoline(all_threads);        /*  call_into_lisp */
-    lose("Clever child?  Idiot savant, verging on the.");
-#endif
+}
 
-    return th->pid;
- cleanup:
-    /* if(th && th->tls_cookie>=0) os_free_tls_pointer(th); */
-    if(spaces) os_invalidate(spaces,
-                            THREAD_CONTROL_STACK_SIZE+BINDING_STACK_SIZE+
-                            ALIEN_STACK_SIZE+dynamic_values_bytes);
-    return 0;
+void create_initial_thread(lispobj initial_function) {
+    struct thread *th=create_thread_struct(initial_function);
+    pid_t kid_pid=getpid();
+    if(th && kid_pid>0) {
+       link_thread(th,kid_pid);
+       initial_thread_trampoline(all_threads); /* no return */
+    } else lose("can't create initial thread");
 }
 
+#ifdef LISP_FEATURE_LINUX
+pid_t create_thread(lispobj initial_function) {
+    struct thread *th=create_thread_struct(initial_function);
+    pid_t kid_pid=clone(new_thread_trampoline,
+                       (((void*)th->control_stack_start)+
+                        THREAD_CONTROL_STACK_SIZE-4),
+                       CLONE_FILES|SIG_THREAD_EXIT|CLONE_VM,th);
+
+    if(th && kid_pid>0) {
+       link_thread(th,kid_pid);
+       return th->pid;
+    } else {
+       destroy_thread(th);
+       return 0;
+    }
+}
+#endif
+
 void destroy_thread (struct thread *th)
 {
     /* precondition: the unix task has already been killed and exited.
@@ -237,13 +239,13 @@ void destroy_thread (struct thread *th)
     gc_alloc_update_page_tables(0, &th->alloc_region);
 #endif
     get_spinlock(&all_threads_lock,th->pid);
-    if(countdown_to_gc>0) countdown_to_gc--;
+    th->state=STATE_STOPPED;
     if(th==all_threads) 
        all_threads=th->next;
     else {
        struct thread *th1=all_threads;
-       while(th1->next!=th) th1=th1->next;
-       th1->next=th->next;     /* unlink */
+       while(th1 && th1->next!=th) th1=th1->next;
+       if(th1) th1->next=th->next;     /* unlink */
     }
     release_spinlock(&all_threads_lock);
     if(th && th->tls_cookie>=0) arch_os_thread_cleanup(th); 
@@ -263,6 +265,10 @@ struct thread *find_thread_by_pid(pid_t pid)
     return 0;
 }
 
+/* These are not needed unless #+SB-THREAD, and since sigwaitinfo()
+ * doesn't seem to be easily available everywhere (OpenBSD...) it's
+ * more trouble than it's worth to compile it when not needed. */
+#if defined LISP_FEATURE_SB_THREAD
 void block_sigcont(void)
 {
     /* don't allow ourselves to receive SIGCONT while we're in the
@@ -270,19 +276,15 @@ void block_sigcont(void)
      */
     sigset_t newset;
     sigemptyset(&newset);
-    sigaddset(&newset,SIGCONT);
+    sigaddset(&newset,SIG_DEQUEUE);
     sigprocmask(SIG_BLOCK, &newset, 0); 
 }
 
-/* This is not needed unless #+SB-THREAD, and since sigwaitinfo()
- * doesn't seem to be easily available everywhere (OpenBSD...) it's
- * more trouble than it's worth to compile it when not needed. */
-#if defined LISP_FEATURE_SB_THREAD
 void unblock_sigcont_and_sleep(void)
 {
     sigset_t set;
     sigemptyset(&set);
-    sigaddset(&set,SIGCONT);
+    sigaddset(&set,SIG_DEQUEUE);
     do {
        errno=0;
        sigwaitinfo(&set,0);
@@ -298,30 +300,44 @@ int interrupt_thread(pid_t pid, lispobj function)
     return sigqueue(pid, SIG_INTERRUPT_THREAD, sigval);
 }
 
+int signal_thread_to_dequeue (pid_t pid)
+{
+    return kill (pid, SIG_DEQUEUE);
+}
+
+
+/* stopping the world is a two-stage process.  From this thread we signal 
+ * all the others with SIG_STOP_FOR_GC.  The handler for this thread does
+ * the usual pseudo-atomic checks (we don't want to stop a thread while 
+ * it's in the middle of allocation) then kills _itself_ with SIGSTOP.
+ */
+
 void gc_stop_the_world()
 {
     /* stop all other threads by sending them SIG_STOP_FOR_GC */
     struct thread *p,*th=arch_os_get_current_thread();
-    struct thread *tail=0;
+    pid_t old_pid;
     int finished=0;
     do {
        get_spinlock(&all_threads_lock,th->pid);
-       if(tail!=all_threads) {
-           /* new threads always get consed onto the front of all_threads,
-            * and may be created by any thread that we haven't signalled
-            * yet or hasn't received our signal and stopped yet.  So, check
-            * for them on each time around */
-           for(p=all_threads;p!=tail;p=p->next) {
-               if(p==th) continue;
-               countdown_to_gc++;
-               kill(p->pid,SIG_STOP_FOR_GC);
-           }
-           tail=all_threads;
-       } else {
-           finished=(countdown_to_gc==0);
+       for(p=all_threads,old_pid=p->pid; p; p=p->next) {
+           if(p==th) continue;
+           if(p->state!=STATE_RUNNING) continue;
+           p->state=STATE_STOPPING;
+           kill(p->pid,SIG_STOP_FOR_GC);
        }
        release_spinlock(&all_threads_lock);
        sched_yield();
+       /* if everything has stopped, and there is no possibility that
+        * a new thread has been created, we're done.  Otherwise go
+        * round again and signal anything that sprang up since last
+        * time  */
+       if(old_pid==all_threads->pid) {
+           finished=1;
+           for_each_thread(p) 
+               finished = finished &&
+               ((p==th) || (p->state==STATE_STOPPED));
+       }
     } while(!finished);
 }
 
@@ -331,7 +347,8 @@ void gc_start_the_world()
     get_spinlock(&all_threads_lock,th->pid);
     for(p=all_threads;p;p=p->next) {
        if(p==th) continue;
-       kill(p->pid,SIGCONT);
+       p->state=STATE_RUNNING;
+       kill(p->pid,SIG_STOP_FOR_GC);
     }
     release_spinlock(&all_threads_lock);
 }