X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fruntime%2Fruntime.c;h=32cad8a1bf48a8c382055d2063d929d6c8ead441;hb=a93dc34ed9e7f5c7162e9c18961e6cce23941b46;hp=b4a8f165bd557204e252fa6c194c08095fd90b2f;hpb=ab811c7aaca82ba6f86584f736071a28e24353d3;p=sbcl.git

diff --git a/src/runtime/runtime.c b/src/runtime/runtime.c
index b4a8f16..32cad8a 100644
--- a/src/runtime/runtime.c
+++ b/src/runtime/runtime.c
@@ -13,15 +13,24 @@
  * files for more information.
  */
 
+#include "sbcl.h"
+
 #include <stdio.h>
 #include <string.h>
 #include <libgen.h>
 #include <sys/types.h>
+#include <sys/wait.h>
 #include <stdlib.h>
 #include <unistd.h>
 #include <sys/file.h>
 #include <sys/param.h>
 #include <sys/stat.h>
+#include <signal.h>
+#ifdef LISP_FEATURE_SB_THREAD
+#include <sys/ptrace.h>
+#endif
+#include <sched.h>
+#include <errno.h>
 
 #if defined(SVR4) || defined(__linux__)
 #include <time.h>
@@ -30,7 +39,6 @@
 #include "signal.h"
 
 #include "runtime.h"
-#include "sbcl.h"
 #include "alloc.h"
 #include "vars.h"
 #include "globals.h"
@@ -44,6 +52,11 @@
 #include "core.h"
 #include "save.h"
 #include "lispregs.h"
+#include "thread.h"
+
+#include "genesis/static-symbols.h"
+#include "genesis/symbol.h"
+
 
 #ifdef irix
 #include <string.h>
@@ -102,13 +115,13 @@ copied_existing_filename_or_null(char *filename)
 }
 
 /* Convert a null-terminated array of null-terminated strings (e.g.
- * argv or envp) into a Lisp list of Lisp strings. */
+ * argv or envp) into a Lisp list of Lisp base-strings. */
 static lispobj
-alloc_string_list(char *array_ptr[])
+alloc_base_string_list(char *array_ptr[])
 {
     if (*array_ptr) {
-	return alloc_cons(alloc_string(*array_ptr),
-			  alloc_string_list(1 + array_ptr));
+	return alloc_cons(alloc_base_string(*array_ptr),
+			  alloc_base_string_list(1 + array_ptr));
     } else {
 	return NIL;
     }
@@ -171,6 +184,10 @@ More information about SBCL is available at <http://sbcl.sourceforge.net/>.\n\
 ", SBCL_VERSION_STRING);
 }
 
+int gc_thread_pid;
+FILE *stdlog;
+
+
 int
 main(int argc, char *argv[], char *envp[])
 {
@@ -329,35 +346,87 @@ main(int argc, char *argv[], char *envp[])
 
     gc_initialize_pointers();
 
-#ifdef BINDING_STACK_POINTER
-    SetSymbolValue(BINDING_STACK_POINTER, BINDING_STACK_START);
-#endif
-
     interrupt_init();
-
     arch_install_interrupt_handlers();
     os_install_interrupt_handlers();
 
-#ifdef PSEUDO_ATOMIC_ATOMIC
-    /* Turn on pseudo atomic for when we call into Lisp. */
-    SHOW("turning on pseudo atomic");
-    SetSymbolValue(PSEUDO_ATOMIC_ATOMIC, make_fixnum(1));
-    SetSymbolValue(PSEUDO_ATOMIC_INTERRUPTED, make_fixnum(0));
-#endif
-
     /* Convert remaining argv values to something that Lisp can grok. */
     SHOW("setting POSIX-ARGV symbol value");
-    SetSymbolValue(POSIX_ARGV, alloc_string_list(argv));
+    SetSymbolValue(POSIX_ARGV, alloc_base_string_list(argv),0);
 
     /* Install a handler to pick off SIGINT until the Lisp system gets
      * far enough along to install its own handler. */
     sigint_init();
 
     FSHOW((stderr, "/funcalling initial_function=0x%lx\n", initial_function));
-    funcall0(initial_function);
+    create_thread(initial_function);
+    /* in a unithread build, create_thread never returns */
+#ifdef LISP_FEATURE_SB_THREAD
+    gc_thread_pid=getpid();
+    parent_loop();
+#endif
+}
 
-    /* initial_function() is not supposed to return. */
-    lose("Lisp initial_function gave up control.");
-    return 0; /* dummy value: return something */
+static void parent_sighandler(int signum,siginfo_t *info, void *void_context) 
+{
+#if 0
+    os_context_t *context = (os_context_t*)void_context;
+    fprintf(stderr,
+	    "parent thread got signal %d from %d, maybe_gc_pending=%d\n",
+	    signum, info->si_pid,
+	    maybe_gc_pending);
+#endif
 }
 
+#ifdef LISP_FEATURE_SB_THREAD
+
+static void /* noreturn */ parent_loop(void)
+{
+    struct sigaction sa;
+    sigset_t sigset;
+    int status;
+    pid_t pid=0;
+
+    sigemptyset(&sigset);
+
+    sigaddset(&sigset, SIGALRM);
+    sigaddset(&sigset, SIGCHLD);
+    sigprocmask(SIG_UNBLOCK,&sigset,0);
+    sa.sa_handler=parent_sighandler;
+    sa.sa_mask=sigset;
+    sa.sa_flags=SA_SIGINFO;
+    sigaction(SIGALRM, &sa, 0);
+    sigaction(SIGCHLD, &sa, 0);
+
+    sigemptyset(&sigset);
+    sa.sa_handler=SIG_IGN;
+    sa.sa_mask=sigset;
+    sa.sa_flags=0;
+    sigaction(SIGINT, &sa, 0);
+
+    while(!all_threads) {
+	sched_yield();
+    }
+    while(all_threads && (pid=waitpid(-1,&status,__WALL|WUNTRACED))) {
+	struct thread *th;
+	int real_errno=errno;
+	if(pid==-1) {
+	    if(real_errno == EINTR) {
+		continue;
+	    }
+	    if(real_errno == ECHILD) break;
+	    fprintf(stderr,"waitpid: %s\n",strerror(real_errno));
+	    continue;
+	}
+	th=find_thread_by_pid(pid);
+	if(!th) continue;
+	if(WIFEXITED(status) || WIFSIGNALED(status)) {
+	    fprintf(stderr,"waitpid : child %d %x exited \n", pid,th);
+	    destroy_thread(th);
+	    if(!all_threads) break;
+	}
+    }
+    exit(WEXITSTATUS(status));
+}
+
+#endif