From ce0a49644dce03ca07008e8073897e4ed7b247df Mon Sep 17 00:00:00 2001 From: Daniel Barlow Date: Sat, 29 Nov 2003 00:35:40 +0000 Subject: [PATCH] 0.8.6.11 Some clean up with unix signals possible now that we denote them with numbers instead of keywords Juggled the order in target-thread.lisp to make it compile without warning Threads now signal SIG_THREAD_EXIT in the parent, not SIGALRM. CLONE_PARENT is no longer used, so the creating Lisp thread gets this signal instead of the original C process thread-exit_handler is the SIG_THREAD_EXIT handler. It calls the new static function HANDLE-THREAD-EXIT to manipulate *SESSION* SB!THREAD::*FOREGROUND-THREAD-STACK* ius dead, remove from static variables list --- src/code/target-signal.lisp | 18 ++-- src/code/target-thread.lisp | 194 +++++++++++++++++++------------------ src/compiler/generic/genesis.lisp | 3 +- src/compiler/x86/parms.lisp | 2 +- src/runtime/interrupt.c | 28 ++++++ src/runtime/interrupt.h | 1 + src/runtime/linux-os.c | 2 + src/runtime/linux-os.h | 1 + src/runtime/runtime.c | 4 +- src/runtime/thread.c | 6 +- version.lisp-expr | 2 +- 11 files changed, 147 insertions(+), 114 deletions(-) diff --git a/src/code/target-signal.lisp b/src/code/target-signal.lisp index a920f15..cdcae59 100644 --- a/src/code/target-signal.lisp +++ b/src/code/target-signal.lisp @@ -17,26 +17,20 @@ ;;;; system calls that deal with signals +;;; Send the signal SIGNAL to the process with process id PID. SIGNAL +;;; should be a valid signal number #!-sb-fluid (declaim (inline real-unix-kill)) -(sb!alien:define-alien-routine ("kill" real-unix-kill) sb!alien:int +(sb!alien:define-alien-routine ("kill" unix-kill) sb!alien:int (pid sb!alien:int) (signal sb!alien:int)) -;;; Send the signal SIGNAL to the process with process id PID. SIGNAL -;;; should be a valid signal number -(defun unix-kill (pid signal) - (real-unix-kill pid signal)) - +;;; Send the signal SIGNAL to the all the process in process group +;;; PGRP. SIGNAL should be a valid signal number #!-sb-fluid (declaim (inline real-unix-killpg)) -(sb!alien:define-alien-routine ("killpg" real-unix-killpg) sb!alien:int +(sb!alien:define-alien-routine ("killpg" unix-killpg) sb!alien:int (pgrp sb!alien:int) (signal sb!alien:int)) -;;; Send the signal SIGNAL to the all the process in process group -;;; PGRP. SIGNAL should be a valid signal number -(defun unix-killpg (pgrp signal) - (real-unix-killpg pgrp signal)) - ;;; Reset the current set of masked signals (those being blocked from ;;; delivery). ;;; diff --git a/src/code/target-thread.lisp b/src/code/target-thread.lisp index 59e96ad..2390437 100644 --- a/src/code/target-thread.lisp +++ b/src/code/target-thread.lisp @@ -10,88 +10,10 @@ (sb!alien::define-alien-routine "signal_thread_to_dequeue" sb!alien:unsigned-int - (thread-pid sb!alien:unsigned-long)) + (thread-id sb!alien:unsigned-long)) (defvar *session* nil) -(defun make-thread (function) - (let* ((real-function (coerce function 'function)) - (tid - (%create-thread - (sb!kernel:get-lisp-obj-address - (lambda () - ;; in time we'll move some of the binding presently done in C - ;; here too - (let ((sb!kernel::*restart-clusters* nil) - (sb!impl::*descriptor-handlers* nil) ; serve-event - (sb!impl::*available-buffers* nil)) ;for fd-stream - ;; can't use handling-end-of-the-world, because that flushes - ;; output streams, and we don't necessarily have any (or we - ;; could be sharing them) - (sb!sys:enable-interrupt sb!unix:sigint :ignore) - (sb!unix:unix-exit - (catch 'sb!impl::%end-of-the-world - (with-simple-restart - (destroy-thread - (format nil "~~@" - (current-thread-id))) - (funcall real-function)) - 0)))))))) - (with-mutex ((session-lock *session*)) - (pushnew tid (session-threads *session*))) - tid)) - -;;; Really, you don't want to use these: they'll get into trouble with -;;; garbage collection. Use a lock or a waitqueue instead -(defun suspend-thread (thread-id) - (sb!unix:unix-kill thread-id sb!unix:sigstop)) -(defun resume-thread (thread-id) - (sb!unix:unix-kill thread-id sb!unix:sigcont)) -;;; Note warning about cleanup forms -(defun destroy-thread (thread-id) - "Destroy the thread identified by THREAD-ID abruptly, without running cleanup forms" - (sb!unix:unix-kill thread-id sb!unix:sigterm) - ;; may have been stopped for some reason, so now wake it up to - ;; deliver the TERM - (sb!unix:unix-kill thread-id sb!unix:sigcont)) - - -;;; a moderate degree of care is expected for use of interrupt-thread, -;;; due to its nature: if you interrupt a thread that was holding -;;; important locks then do something that turns out to need those -;;; locks, you probably won't like the effect. Used with thought -;;; though, it's a good deal gentler than the last-resort functions above - -(defun interrupt-thread (thread function) - "Interrupt THREAD and make it run FUNCTION. " - (sb!unix::syscall* ("interrupt_thread" - sb!alien:unsigned-long sb!alien:unsigned-long) - thread - thread (sb!kernel:get-lisp-obj-address - (coerce function 'function)))) -(defun terminate-thread (thread-id) - "Terminate the thread identified by THREAD-ID, by causing it to run -SB-EXT:QUIT - the usual cleanup forms will be evaluated" - (interrupt-thread thread-id 'sb!ext:quit)) - -(declaim (inline current-thread-id)) -(defun current-thread-id () - (logand - (sb!sys:sap-int - (sb!vm::current-thread-offset-sap sb!vm::thread-pid-slot)) - ;; KLUDGE pids are 16 bit really. Avoid boxing the return value - (1- (ash 1 16)))) - -;;;; iterate over the in-memory threads - -(defun mapcar-threads (function) - "Call FUNCTION once for each known thread, giving it the thread structure as argument" - (let ((function (coerce function 'function))) - (loop for thread = (alien-sap (extern-alien "all_threads" (* t))) - then (sb!sys:sap-ref-sap thread (* 4 sb!vm::thread-next-slot)) - until (sb!sys:sap= thread (sb!sys:int-sap 0)) - collect (funcall function thread)))) - ;;;; queues, locks ;; spinlocks use 0 as "free" value: higher-level locks use NIL @@ -158,6 +80,7 @@ SB-EXT:QUIT - the usual cleanup forms will be evaluated" (sb!alien:define-alien-routine "futex_wake" int (word unsigned-long) (n unsigned-long)) + ;;; this should only be called while holding the queue spinlock. ;;; it releases the spinlock before sleeping (defun wait-on-queue (queue &optional lock) @@ -325,6 +248,86 @@ time we reacquire LOCK and return to the caller." (fdefinition 'condition-notify) #'condition-notify/futex) t)) +(defun make-thread (function) + (let* ((real-function (coerce function 'function)) + (tid + (%create-thread + (sb!kernel:get-lisp-obj-address + (lambda () + ;; in time we'll move some of the binding presently done in C + ;; here too + (let ((sb!kernel::*restart-clusters* nil) + (sb!impl::*descriptor-handlers* nil) ; serve-event + (sb!impl::*available-buffers* nil)) ;for fd-stream + ;; can't use handling-end-of-the-world, because that flushes + ;; output streams, and we don't necessarily have any (or we + ;; could be sharing them) + (sb!sys:enable-interrupt sb!unix:sigint :ignore) + (sb!unix:unix-exit + (catch 'sb!impl::%end-of-the-world + (with-simple-restart + (destroy-thread + (format nil "~~@" + (current-thread-id))) + (funcall real-function)) + 0)))))))) + (with-mutex ((session-lock *session*)) + (pushnew tid (session-threads *session*))) + tid)) + +;;; Really, you don't want to use these: they'll get into trouble with +;;; garbage collection. Use a lock or a waitqueue instead +(defun suspend-thread (thread-id) + (sb!unix:unix-kill thread-id sb!unix:sigstop)) +(defun resume-thread (thread-id) + (sb!unix:unix-kill thread-id sb!unix:sigcont)) +;;; Note warning about cleanup forms +(defun destroy-thread (thread-id) + "Destroy the thread identified by THREAD-ID abruptly, without running cleanup forms" + (sb!unix:unix-kill thread-id sb!unix:sigterm) + ;; may have been stopped for some reason, so now wake it up to + ;; deliver the TERM + (sb!unix:unix-kill thread-id sb!unix:sigcont)) + + + + +;;; a moderate degree of care is expected for use of interrupt-thread, +;;; due to its nature: if you interrupt a thread that was holding +;;; important locks then do something that turns out to need those +;;; locks, you probably won't like the effect. Used with thought +;;; though, it's a good deal gentler than the last-resort functions above + +(defun interrupt-thread (thread function) + "Interrupt THREAD and make it run FUNCTION. " + (sb!unix::syscall* ("interrupt_thread" + sb!alien:unsigned-long sb!alien:unsigned-long) + thread + thread (sb!kernel:get-lisp-obj-address + (coerce function 'function)))) +(defun terminate-thread (thread-id) + "Terminate the thread identified by THREAD-ID, by causing it to run +SB-EXT:QUIT - the usual cleanup forms will be evaluated" + (interrupt-thread thread-id 'sb!ext:quit)) + +(declaim (inline current-thread-id)) +(defun current-thread-id () + (logand + (sb!sys:sap-int + (sb!vm::current-thread-offset-sap sb!vm::thread-pid-slot)) + ;; KLUDGE pids are 16 bit really. Avoid boxing the return value + (1- (ash 1 16)))) + +;;;; iterate over the in-memory threads + +(defun mapcar-threads (function) + "Call FUNCTION once for each known thread, giving it the thread structure as argument" + (let ((function (coerce function 'function))) + (loop for thread = (alien-sap (extern-alien "all_threads" (* t))) + then (sb!sys:sap-ref-sap thread (* 4 sb!vm::thread-next-slot)) + until (sb!sys:sap= thread (sb!sys:int-sap 0)) + collect (funcall function thread)))) + ;;;; job control, independent listeners (defstruct session @@ -341,15 +344,16 @@ time we reacquire LOCK and return to the caller." (defun init-job-control () (setf *session* (new-session))) +(defun %delete-thread-from-session (tid) + (with-mutex ((session-lock *session*)) + (setf (session-threads *session*) + (delete tid (session-threads *session*)) + (session-interactive-threads *session*) + (delete tid (session-interactive-threads *session*))))) + (defun call-with-new-session (fn) - (let ((tid (current-thread-id))) - (with-mutex ((session-lock *session*)) - (setf (session-threads *session*) - (delete tid (session-threads *session*)) - (session-interactive-threads *session*) - (delete tid (session-interactive-threads *session*)))) - (let ((*session* (new-session))) - (funcall fn)))) + (%delete-thread-from-session (current-thread-id)) + (let ((*session* (new-session))) (funcall fn))) (defmacro with-new-session (args &body forms) (declare (ignore args)) ;for extensibility @@ -357,6 +361,11 @@ time we reacquire LOCK and return to the caller." `(labels ((,fb-name () ,@forms)) (call-with-new-session (function ,fb-name))))) +;;; this is called from a C signal handler: some signals may be masked +(defun handle-thread-exit (tid) + "Remove thread id TID from the session, if it's there" + (%delete-thread-from-session tid)) + (defun terminate-session () "Kill all threads in session exept for this one. Does nothing if current thread is not the foreground thread" @@ -390,12 +399,13 @@ interactive." (defun get-foreground () (loop (with-mutex ((session-lock *session*)) - (let ((tid (current-thread-id))) - (when (eql (car (session-interactive-threads *session*)) tid) + (let ((tid (current-thread-id)) + (int-t (session-interactive-threads *session*))) + (when (eql (car int-t) tid) (sb!sys:enable-interrupt sb!unix:sigint #'sb!unix::sigint-handler) (return-from get-foreground t)) - (unless (member tid *interactive-threads*) - (setf (cdr (last (session-interactive-threads *session*))) + (unless (member tid int-t) + (setf (cdr (last int-t)) (list tid))) (condition-wait (session-interactive-threads-queue *session*) @@ -406,7 +416,7 @@ interactive." (with-mutex ((session-lock *session*)) (let ((tid (current-thread-id))) (setf (session-interactive-threads *session*) - (delete tid *interactive-threads*)) + (delete tid (session-interactive-threads *session*))) (sb!sys:enable-interrupt sb!unix:sigint :ignore) (when next (setf (session-interactive-threads *session*) diff --git a/src/compiler/generic/genesis.lisp b/src/compiler/generic/genesis.lisp index 7a06d2b..485d71b 100644 --- a/src/compiler/generic/genesis.lisp +++ b/src/compiler/generic/genesis.lisp @@ -1257,7 +1257,8 @@ (frob internal-error) (frob sb!kernel::control-stack-exhausted-error) (frob sb!di::handle-breakpoint) - (frob sb!di::handle-fun-end-breakpoint)) + (frob sb!di::handle-fun-end-breakpoint) + (frob sb!thread::handle-thread-exit)) (cold-set '*current-catch-block* (make-fixnum-descriptor 0)) (cold-set '*current-unwind-protect-block* (make-fixnum-descriptor 0)) diff --git a/src/compiler/x86/parms.lisp b/src/compiler/x86/parms.lisp index 234421d..701b42f 100644 --- a/src/compiler/x86/parms.lisp +++ b/src/compiler/x86/parms.lisp @@ -226,6 +226,7 @@ sb!kernel::control-stack-exhausted-error sb!di::handle-breakpoint fdefinition-object + #!+sb-thread sb!thread::handle-thread-exit ;; free pointers ;; @@ -250,7 +251,6 @@ *free-interrupt-context-index* *free-tls-index* - sb!thread::*foreground-thread-stack* *allocation-pointer* *binding-stack-pointer* diff --git a/src/runtime/interrupt.c b/src/runtime/interrupt.c index d7f4a42..7239528 100644 --- a/src/runtime/interrupt.c +++ b/src/runtime/interrupt.c @@ -45,6 +45,8 @@ #include #include #include +#include +#include #include "runtime.h" #include "arch.h" @@ -62,6 +64,8 @@ #include "genesis/fdefn.h" #include "genesis/simple-fun.h" + + void run_deferred_handler(struct interrupt_data *data, void *v_context) ; static void store_signal_data_for_later (struct interrupt_data *data, void *handler, int signal, @@ -105,6 +109,7 @@ void sigaddset_blockable(sigset_t *s) #ifdef LISP_FEATURE_SB_THREAD sigaddset(s, SIG_STOP_FOR_GC); sigaddset(s, SIG_INTERRUPT_THREAD); + sigaddset(s, SIG_THREAD_EXIT); #endif } @@ -666,6 +671,29 @@ void interrupt_thread_handler(int num, siginfo_t *info, void *v_context) } arrange_return_to_lisp_function(context,info->si_value.sival_int); } + +void thread_exit_handler(int num, siginfo_t *info, void *v_context) +{ /* called when a child thread exits */ + os_context_t *context = (os_context_t*)arch_os_get_context(&v_context); + struct thread *th=arch_os_get_current_thread(); + pid_t kid; + int *status; + struct interrupt_data *data= + th ? th->interrupt_data : global_interrupt_data; + if(maybe_defer_handler(thread_exit_handler,data,num,info,context)){ + return ; + } + while(1) { + kid=waitpid(-1,&status,__WALL|WNOHANG); + if(kid<1) break; + if(WIFEXITED(status) || WIFSIGNALED(status)) { + struct thread *th=find_thread_by_pid(kid); + if(!th) continue; + funcall1(SymbolFunction(HANDLE_THREAD_EXIT),make_fixnum(kid)); + destroy_thread(th); + } + } +} #endif boolean handle_control_stack_guard_triggered(os_context_t *context,void *addr){ diff --git a/src/runtime/interrupt.h b/src/runtime/interrupt.h index 11eca74..cb71475 100644 --- a/src/runtime/interrupt.h +++ b/src/runtime/interrupt.h @@ -53,6 +53,7 @@ extern boolean interrupt_maybe_gc(int, siginfo_t*, void*); #ifdef LISP_FEATURE_SB_THREAD extern void interrupt_thread_handler(int, siginfo_t*, void*); extern void sig_stop_for_gc_handler(int, siginfo_t*, void*); +extern void thread_exit_handler(int, siginfo_t*, void*); #endif extern void undoably_install_low_level_interrupt_handler (int signal, void diff --git a/src/runtime/linux-os.c b/src/runtime/linux-os.c index 03d950f..a958224 100644 --- a/src/runtime/linux-os.c +++ b/src/runtime/linux-os.c @@ -280,6 +280,8 @@ os_install_interrupt_handlers(void) interrupt_thread_handler); undoably_install_low_level_interrupt_handler(SIG_STOP_FOR_GC, sig_stop_for_gc_handler); + undoably_install_low_level_interrupt_handler(SIG_THREAD_EXIT, + thread_exit_handler); if(!linux_supports_futex) undoably_install_low_level_interrupt_handler(SIG_DEQUEUE, sigcont_handler); diff --git a/src/runtime/linux-os.h b/src/runtime/linux-os.h index 05729ae..d0f1781 100644 --- a/src/runtime/linux-os.h +++ b/src/runtime/linux-os.h @@ -41,4 +41,5 @@ typedef int os_vm_prot_t; #define SIG_INTERRUPT_THREAD (SIGRTMIN) #define SIG_STOP_FOR_GC (SIGRTMIN+1) #define SIG_DEQUEUE (SIGRTMIN+2) +#define SIG_THREAD_EXIT (SIGRTMIN+3) diff --git a/src/runtime/runtime.c b/src/runtime/runtime.c index ec0d5bc..6799033 100644 --- a/src/runtime/runtime.c +++ b/src/runtime/runtime.c @@ -385,13 +385,12 @@ static void /* noreturn */ parent_loop(void) sigemptyset(&sigset); - sigaddset(&sigset, SIGALRM); sigaddset(&sigset, SIGCHLD); + sigaddset(&sigset, SIG_THREAD_EXIT); 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); @@ -399,6 +398,7 @@ static void /* noreturn */ parent_loop(void) sa.sa_mask=sigset; sa.sa_flags=0; sigaction(SIGINT, &sa, 0); + sigaction(SIG_THREAD_EXIT, &sa, 0); while(!all_threads) { sched_yield(); diff --git a/src/runtime/thread.c b/src/runtime/thread.c index 8ac0519..c0166d0 100644 --- a/src/runtime/thread.c +++ b/src/runtime/thread.c @@ -4,9 +4,6 @@ #include #include #include -#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 */ @@ -193,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 diff --git a/version.lisp-expr b/version.lisp-expr index dcab66f..f4e83db 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.8.6.10" +"0.8.6.11" -- 1.7.10.4