From: Daniel B. <da...@us...> - 2003-02-19 06:16:28
|
Update of /cvsroot/sbcl/sbcl/src/runtime In directory sc8-pr-cvs1:/tmp/cvs-serv16343/src/runtime Modified Files: Tag: dan_native_threads_2_branch GNUmakefile runtime.c thread.c Log Message: 0.7.11.10.thread.8 Looking marginally more believable now Stripped all the unix process group stuff I could find At various important places when we are shortly about to do input (e.g. printing the toplevel prompt, or entering the debugger) we need to check that we own the stream we're going to read from. fd-stream gets a new slot that contains a sb-thread:mutex MAYBE-WAIT-UNTIL-FOREGROUND-THREAD (bad name) does this for the debugger. For the repl, at the moment we just hook it with something unnamed. That needs fixing Fixed thinko in hastily-commited target-error.lisp changes made last time. Rewrote mutex to use an actual queue (and signals) instead of having each waiting thread sleep a bit and retest and sleep a bit and ... (note, broke timeouts in the process. But that can be fixed, we just need to pass timeout info down to sigtimedwait()) There's some fairly icky code duplication between C and Lisp, and a fill-in-the-gaping-hole stub routine for spinlock acquiring on the C side. The ideal here would be to teach Lisp the necessary signal mask manipulation stuff and avoid having to do C at all. Still need to enable/disable SIGINT handlers when things go into/out of foreground For your entertainment: here's how to make it dance - (load "src/cold/chill") (in-package :sb-thread) (sb!impl::fd-stream-owner-thread sb!sys::*stdin*) (setf (sb!impl::fd-stream-owner-thread sb!sys::*stdin*) (sb!thread::make-mutex :name "lock for stdin" )) (trace get-mutex add-thread-to-queue get-spinlock maybe-wait-until-foreground-thread ) (defun foo () (sleep 3) (break) (dotimes (i 10) (format t "hello ~A~%" 2))) (defun thread-prompt-fun (stream) (unless (eql (mutex-value (sb!impl::fd-stream-owner-thread sb!sys::*stdin*)) (CURRENT-THREAD-ID)) (get-mutex (sb!impl::fd-stream-owner-thread sb!sys::*stdin*))) (SB!IMPL::REPL-PROMPT-FUN stream)) (setf SB!INT:*REPL-PROMPT-FUN* #'thread-prompt-fun) (sb-thread:make-thread 'foo) ;;; wait 3s or slightly more. now background this thread in favour of the ;;; stopped one (progn (free-mutex (sb!impl::fd-stream-owner-thread sb!sys::*stdin*)) (sleep 1)) Index: GNUmakefile =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/runtime/GNUmakefile,v retrieving revision 1.14.6.2 retrieving revision 1.14.6.3 diff -u -d -r1.14.6.2 -r1.14.6.3 --- GNUmakefile 18 Feb 2003 17:09:06 -0000 1.14.6.2 +++ GNUmakefile 19 Feb 2003 06:16:24 -0000 1.14.6.3 @@ -39,7 +39,7 @@ dynbind.c gc-common.c globals.c interr.c interrupt.c \ monitor.c parse.c print.c purify.c \ regnames.c run-program.c runtime.c save.c search.c \ - thread.c tty.c time.c util.c validate.c vars.c wrap.c + thread.c time.c util.c validate.c vars.c wrap.c SRCS= $(C_SRCS) ${ARCH_SRC} ${ASSEM_SRC} ${OS_SRC} ${GC_SRC} Index: runtime.c =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/runtime/runtime.c,v retrieving revision 1.17.4.7 retrieving revision 1.17.4.8 diff -u -d -r1.17.4.7 -r1.17.4.8 --- runtime.c 18 Feb 2003 17:09:09 -0000 1.17.4.7 +++ runtime.c 19 Feb 2003 06:16:25 -0000 1.17.4.8 @@ -286,54 +286,19 @@ * far enough along to install its own handler. */ sigint_init(); - stty_tostop(0,0); /* ensure that all threads can print - error messages without getting stopped */ FSHOW((stderr, "/funcalling initial_function=0x%lx\n", initial_function)); create_thread(initial_function); - if(setpgid(all_threads->pid,0)==-1) perror("setpgid child"); - - /* we'd like to be able to print debug, error, and "thread - * stopped" messages from the runtime without getting mixed up in - * the "which is the foreground thread" mess - */ - - stdlog=fopen("/tmp/stderr","w"); - setvbuf(stdlog,0,_IONBF,0); - if(isatty(fileno(stderr))) { -#if 0 - int err_no_ctty; - err_no_ctty=open(ttyname(fileno(stderr)),O_RDWR|O_NOCTTY,0666); - if(err_no_ctty>0) { - fclose(stderr); - dup2(err_no_ctty,2); - stderr=fdopen(2,"w"); - } else { - fprintf(stderr,"Warning: can't reopen stderr in no-ctty mode\n"); - } -#endif - /* now we can start worrying about job control. The first - lisp thread should be the foreground process, not us */ - stty_tostop(0,1); - thread_to_foreground(all_threads->pid); - } - gc_thread_pid=getpid(); parent_loop(); } static void parent_sighandler(int signum) { - fprintf(stdlog,"parent thread got signal %d , maybe_gc_pending=%d\n", + fprintf(stderr,"parent thread got signal %d , maybe_gc_pending=%d\n", signum, maybe_gc_pending); } -void log_perror(char *msg) -{ - fprintf(stdlog,"%s: %s\n",msg,strerror(errno)); - fflush(stdlog); -} - static void parent_do_garbage_collect(void) { int waiting_threads=0; @@ -341,9 +306,9 @@ int status,p; for_each_thread(th) { - fprintf(stdlog,"attaching to %d ...",th->pid); + fprintf(stderr,"attaching to %d ...",th->pid); if(ptrace(PTRACE_ATTACH,th->pid,0,0)) - log_perror("PTRACE_ATTACH"); + perror("PTRACE_ATTACH"); else waiting_threads++; } stop_the_world=1; @@ -357,7 +322,7 @@ if(WIFEXITED(status) || WIFSIGNALED(status)) destroy_thread(find_thread_by_pid(p)); else { - fprintf(stdlog, "wait returned pid %d\n",p); + fprintf(stderr, "wait returned pid %d\n",p); waiting_threads--; } } @@ -367,10 +332,10 @@ /* restart the child, sending it a signal that will cause it * to go into interrupt_handle_pending as soon as it's * finished being pseudo_atomic */ - fprintf(stdlog, "%d was pseudo-atomic, letting it resume\n", + fprintf(stderr, "%d was pseudo-atomic, letting it resume\n", th->pid); if(ptrace(PTRACE_CONT,th->pid,0,SIGCONT)) - log_perror("PTRACE_CONT"); + perror("PTRACE_CONT"); waiting_threads++; } } @@ -381,7 +346,7 @@ stop_the_world=0; for_each_thread(th) if(ptrace(PTRACE_DETACH,th->pid,0,0)) - log_perror("PTRACE_DETACH"); + perror("PTRACE_DETACH"); } static void /* noreturn */ parent_loop(void) @@ -391,7 +356,6 @@ sigemptyset(&sigset); - sigemptyset(&sigset); sigaddset(&sigset, SIGALRM); sigaddset(&sigset, SIGCHLD); sigprocmask(SIG_UNBLOCK,&sigset,0); @@ -399,13 +363,14 @@ sa.sa_mask=sigset; sa.sa_flags=0; sigaction(SIGALRM, &sa, 0); - sigaction(SIGTTIN, &sa, 0); - sigaction(SIGTTOU, &sa, 0); sigaction(SIGCHLD, &sa, 0); - /* renounce sin, the world, and a controlling tty */ - if(setpgid(0,0)==-1) - fprintf(stdlog,"setgid parent : %s\n",strerror(errno)); + sigemptyset(&sigset); + sa.sa_handler=SIG_IGN; + sa.sa_mask=sigset; + sa.sa_flags=0; + sigaction(SIGINT, &sa, 0); + while(all_threads) { int status; pid_t pid=0; @@ -415,32 +380,21 @@ if(pid==-1) { if(errno == EINTR) continue; if(errno == ECHILD) break; - fprintf(stdlog,"waitpid: %s\n",strerror(errno)); + fprintf(stderr,"waitpid: %s\n",strerror(errno)); continue; } th=find_thread_by_pid(pid); if(!th) continue; if(WIFEXITED(status) || WIFSIGNALED(status)) { struct thread *next=th->next; - fprintf(stdlog,"waitpid : child %d %x exited \n", pid,th); + fprintf(stderr,"waitpid : child %d %x exited \n", pid,th); destroy_thread(th); /* FIXME lock all_threads */ /* resume something, if anything can be found to resume */ +#if 0 if(!next) next=all_threads; if(next) thread_to_foreground(next->pid); - }else { - if(WIFSTOPPED(status)) { - int signal=WSTOPSIG(status); - fprintf(stdlog, - "waitpid : child %d stopped on signal: %d\n", - pid, signal); - if(signal==SIGTSTP) { - kill(0,signal); - thread_to_foreground(pid); - } else { - th->stopped_p=T; - } - } +#endif } status=0; } Index: thread.c =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/runtime/Attic/thread.c,v retrieving revision 1.1.4.4 retrieving revision 1.1.4.5 diff -u -d -r1.1.4.4 -r1.1.4.5 --- thread.c 18 Feb 2003 17:09:09 -0000 1.1.4.4 +++ thread.c 19 Feb 2003 06:16:25 -0000 1.1.4.5 @@ -13,6 +13,7 @@ #include "target-arch-os.h" #include "os.h" #include "globals.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; @@ -33,9 +34,8 @@ new_thread_trampoline(struct thread *th) { lispobj function; - /* tcsetpgrp(0,getpid()); */ function = th->unbound_marker; - if(1 || go==0) { + 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) ; @@ -194,3 +194,38 @@ if(th->pid==pid) return th; return 0; } + + +struct mutex { + lispobj header,type,*name,*value,*queuelock, *queue; +}; + +void spinlock_get(lispobj *word,int value) +{ + /* FIXME have to spend some time figuring out the gcc inline + * assembly syntax here. Obviously this should be using + * some kind of atomic test and set */ +#if 0 + while(*word) + ; +#endif + *word=value; /* XXX !!! FIXME @@@##### */ +} + +void add_thread_to_queue(int pid, lispobj mutex_p) +{ + sigset_t oldset,newset; + struct mutex *mutex=native_pointer(mutex_p); + struct cons *cons; + sigemptyset(&newset); + sigaddset(&newset,SIGALRM); + sigprocmask(SIG_BLOCK, &newset, &oldset); + + spinlock_get(&(mutex->queuelock),pid); + cons=alloc_cons(make_fixnum(pid),mutex->queue); + mutex->queue=cons; + mutex->queuelock=0; + sigwaitinfo(&newset,0); + sigprocmask(SIG_SETMASK,&oldset,0); +} + |