0.8.6.11
[sbcl.git] / src / runtime / thread.c
index 1de8a20..c0166d0 100644 (file)
@@ -3,9 +3,7 @@
 #include <sched.h>
 #include <signal.h>
 #include <stddef.h>
-#ifndef CLONE_PARENT           /* lameass glibc 2.2  doesn't define this */
-#define CLONE_PARENT 0x00008000        /* even though the manpage documents it */
-#endif
+#include <errno.h>
 #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 lispobj all_threads_lock;
+volatile int countdown_to_gc;
 extern struct interrupt_data * global_interrupt_data;
 
 void get_spinlock(lispobj *word,int value);
@@ -51,6 +47,8 @@ new_thread_trampoline(struct thread *th)
        fprintf(stderr, "/continue\n");
     }
     th->unbound_marker = UNBOUND_MARKER_WIDETAG;
+    if(arch_os_thread_init(th)==0) 
+       return 1;               /* failure.  no, really */
 #ifdef LISP_FEATURE_SB_THREAD
     /* wait here until our thread is linked into all_threads: see below */
     while(th->pid<1) sched_yield();
@@ -59,8 +57,7 @@ new_thread_trampoline(struct thread *th)
        lose("th->pid not set up right");
 #endif
 
-    if(arch_os_thread_init(th)==0) 
-       return 1;               /* failure.  no, really */
+    th->state=STATE_RUNNING;
 #if !defined(LISP_FEATURE_SB_THREAD) && defined(LISP_FEATURE_X86)
     return call_into_lisp_first_time(function,args,0);
 #else
@@ -137,6 +134,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 */
@@ -145,9 +143,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);
@@ -194,8 +190,7 @@ pid_t create_thread(lispobj initial_function) {
     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);
+             CLONE_FILES|SIG_THREAD_EXIT|CLONE_VM,th);
     if(kid_pid<=0) 
        goto cleanup;
 #else
@@ -211,7 +206,7 @@ pid_t create_thread(lispobj initial_function) {
      * to ensure that we don't have >1 thread with pid=0 on the list at once
      */
     protect_control_stack_guard_page(th->pid,1);
-    all_threads_lock=0;
+    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 */
@@ -235,6 +230,8 @@ 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 {
@@ -242,11 +239,12 @@ void destroy_thread (struct thread *th)
        while(th1->next!=th) th1=th1->next;
        th1->next=th->next;     /* unlink */
     }
-    all_threads_lock=0;
+    release_spinlock(&all_threads_lock);
     if(th && th->tls_cookie>=0) arch_os_thread_cleanup(th); 
     os_invalidate((os_vm_address_t) th->control_stack_start,
-                 THREAD_CONTROL_STACK_SIZE+BINDING_STACK_SIZE+
-                 ALIEN_STACK_SIZE+dynamic_values_bytes+
+                 ((sizeof (lispobj))
+                  * (th->control_stack_end-th->control_stack_start)) +
+                 BINDING_STACK_SIZE+ALIEN_STACK_SIZE+dynamic_values_bytes+
                  32*SIGSTKSZ);
 }
 
@@ -259,6 +257,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
@@ -266,20 +268,90 @@ 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);
-    sigwaitinfo(&set,0);
+    sigaddset(&set,SIG_DEQUEUE);
+    do {
+       errno=0;
+       sigwaitinfo(&set,0);
+    }while(errno==EINTR);
     sigprocmask(SIG_UNBLOCK,&set,0);
 }
+
+int interrupt_thread(pid_t pid, lispobj function)
+{
+    union sigval sigval;
+    sigval.sival_int=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.
+ * At any given time, countdown_to_gc should reflect the number of threads
+ * signalled but which haven't yet come to rest
+ */
+
+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();
+    pid_t old_pid;
+    int finished=0;
+    do {
+       get_spinlock(&all_threads_lock,th->pid);
+       for(p=all_threads,old_pid=p->pid; p; p=p->next) {
+           if(p==th) continue;
+           if(p->state!=STATE_RUNNING) continue;
+           countdown_to_gc++;
+           p->state=STATE_STOPPING;
+           /* Note no return value check from kill().  If the
+            * thread had been reaped already, we kill it and
+            * increment countdown_to_gc anyway.  This is to avoid
+            * complicating the logic in destroy_thread, which would 
+            * otherwise have to know whether the thread died before or
+            * after it was killed
+            */
+           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);
+}
+
+void gc_start_the_world()
+{
+    struct thread *p,*th=arch_os_get_current_thread();
+    get_spinlock(&all_threads_lock,th->pid);
+    for(p=all_threads;p;p=p->next) {
+       if(p==th) continue;
+       p->state=STATE_RUNNING;
+       kill(p->pid,SIGCONT);
+    }
+    release_spinlock(&all_threads_lock);
+}
 #endif