changes in sbcl-0.9.2 relative to sbcl-0.9.1:
* numerous signal handling fixes to increase stability
* Support for EUC-JP external format. (thanks to NIIMI Satoshi)
- * bug fix: interrupt-thread restores the eflags register on x86
* minor incompatible change: we now correctly canonize default
initargs, making them be a list of (INITARG INITFORM INITFUNCTION)
as per the MOP, rather than the historical (INITARG INITFUNCTION
* TRUENAME and PROBE-FILE now correctly resolve symlinks even if the
pathname is a directory pathname.
* SB-SPROF now works (more) reliably on non-GENCGC platforms.
- * fixed some lockups due to gc/thread interaction
* dynamic space size on PPC has been increased to 768Mb. (thanks to
Cyrus Harmon)
* SB-MOP:ENSURE-CLASS-USING-CLASS now accepts a class as the
* contrib improvement: it's harder to cause SOCKET-CLOSE to close()
the wrong file descriptor; implementation of SOCKET-OPEN-P.
(thanks to Tony Martinez)
+ * threads
+ ** gcing a dead thread can no longer lead to lockups
+ ** threads block signals until they are set up properly
+ ** errno is no longer shared by threads
+ ** interrupt-thread restores the eflags register on x86
+ ** fixed some lockups due to gc/thread interaction
* fixed some bugs revealed by Paul Dietz' test suite:
** invalid dotted lists no longer raise a read error when
*READ-SUPPRESS* is T
#+sb-thread
(defun thread-pids ()
"Return a list of the pids for all threads"
- (let ((offset (* 4 sb-vm::thread-pid-slot)))
+ (let ((offset (* 4 sb-vm::thread-os-thread-slot)))
(sb-thread::mapcar-threads
#'(lambda (sap) (sb-sys:sap-ref-32 sap offset)))))
(in-package "SB!KERNEL")
(define-alien-routine ("protect_control_stack_guard_page"
%protect-control-stack-guard-page)
- sb!alien:int (thread-id sb!alien:int) (protect-p sb!alien:int))
+ sb!alien:void
+ (thread-id #!+sb-thread sb!alien:unsigned-long
+ #!-sb-thread sb!alien:int)
+ (protect-p sb!alien:int))
(defun protect-control-stack-guard-page (n)
(%protect-control-stack-guard-page
(sb!thread:current-thread-id) (if n 1 0)))
;; of things and not a bug.
(when (plusp freed)
(incf *n-bytes-freed-or-purified* freed)))
- (sb!thread::reap-dead-threads)))
+ (sb!thread::reap-dead-threads)))
;; Outside the mutex, these may cause another GC. FIXME: it can
;; potentially exceed maximum interrupt nesting by triggering
;; GCs.
;;; SIGINT in --disable-debugger mode will cleanly terminate the system
;;; (by respecting the *DEBUGGER-HOOK* established in that mode).
(defun sigint-%break (format-string &rest format-arguments)
+ #!+sb-thread
+ (let ((foreground-thread (sb!thread::foreground-thread)))
+ (if (eql foreground-thread (sb!thread:current-thread-id))
+ (apply #'%break 'sigint format-string format-arguments)
+ (sb!thread:interrupt-thread
+ foreground-thread
+ (lambda () (apply #'%break 'sigint format-string format-arguments)))))
+ #!-sb-thread
(apply #'%break 'sigint format-string format-arguments))
(eval-when (:compile-toplevel :execute)
unsigned-long
(lisp-fun-address unsigned-long))
-(define-alien-routine "signal_thread_to_dequeue"
- unsigned-int
- (thread-id unsigned-long))
-
(define-alien-routine reap-dead-threads void)
(defvar *session* nil)
;; 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)
(catch 'sb!impl::%end-of-the-world
(with-simple-restart
- (destroy-thread
- (format nil "~~@<Destroy this thread (~A)~~@:>"
+ (terminate-thread
+ (format nil "~~@<Terminate this thread (~A)~~@:>"
(current-thread-id)))
+ ;; now that most things have a chance to work
+ ;; properly without messing up other threads, it's
+ ;; time to enable signals
+ (sb!unix::reset-signal-mask)
(funcall real-function))
0))
(values))))))
(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))
-
-
-
+ "Deprecated. Soon to be removed or reimplemented using pthread_cancel."
+ (terminate-thread thread-id))
;;; a moderate degree of care is expected for use of interrupt-thread,
;;; due to its nature: if you interrupt a thread that was holding
(defun interrupt-thread (thread function)
"Interrupt THREAD and make it run FUNCTION."
(let ((function (coerce function 'function)))
- ;; FIXME: FUNCTION is pinned only for the signalling of the
- ;; SIG_INTERRUPT_THREAD signal.
- (sb!sys:with-pinned-objects
- (function)
- (multiple-value-bind (res err)
- (sb!unix::syscall ("interrupt_thread"
- sb!alien:unsigned-long sb!alien:unsigned-long)
- thread
- thread
- (sb!kernel:get-lisp-obj-address function))
- (unless res
- (error 'interrupt-thread-error :thread thread :errno err))))))
+ (multiple-value-bind (res err)
+ (sb!unix::syscall ("interrupt_thread"
+ sb!alien:unsigned-long sb!alien:unsigned-long)
+ thread
+ thread
+ (sb!kernel:get-lisp-obj-address function))
+ (unless res
+ (error 'interrupt-thread-error :thread thread :errno err)))))
(defun terminate-thread (thread-id)
(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))))
+ (sb!sys:sap-int
+ (sb!vm::current-thread-offset-sap sb!vm::thread-os-thread-slot)))
;;;; iterate over the in-memory threads
(let ((thread (alien-sap (extern-alien "all_threads" (* t)))))
(loop
(when (sb!sys:sap= thread (sb!sys:int-sap 0)) (return nil))
+ ;; FIXME: 32/64 bit
(let ((pid (sb!sys:sap-ref-32 thread (* sb!vm:n-word-bytes
- sb!vm::thread-pid-slot))))
+ sb!vm::thread-os-thread-slot))))
(when (= pid id) (return thread))
(setf thread (sb!sys:sap-ref-sap thread (* sb!vm:n-word-bytes
sb!vm::thread-next-slot)))))))
;;;; job control, independent listeners
(defstruct session
- (lock (make-mutex))
+ (lock (make-mutex :name "session lock"))
(threads nil)
(interactive-threads nil)
(interactive-threads-queue (make-waitqueue)))
(call-with-new-session (function ,fb-name)))))
;;; Remove thread id TID from its session, if it has one. This is
-;;; called from C reap_dead_threads() so is run in the context of
-;;; whichever thread called that (usually after a GC), which may not have
-;;; any meaningful parent/child/sibling relationship with the dead thread
+;;; called from C mark_thread_dead().
(defun handle-thread-exit (tid)
- (let ((session (symbol-value-in-thread '*session* tid)))
- (and session (%delete-thread-from-session tid session))))
-
+ (when *session*
+ (%delete-thread-from-session tid *session*)))
+
(defun terminate-session ()
"Kill all threads in session except for this one. Does nothing if current
thread is not the foreground thread"
(reap-dead-threads)
+ ;; FIXME: threads created in other threads may escape termination
(let* ((tid (current-thread-id))
(to-kill
(with-mutex ((session-lock *session*))
;; do the kill after dropping the mutex; unwind forms in dying
;; threads may want to do session things
(dolist (p to-kill)
- (unless (eql p tid) (terminate-thread p)))))
+ (unless (eql p tid)
+ ;; terminate the thread but don't be surprised if it has
+ ;; exited in the meantime
+ (handler-case (terminate-thread p)
+ (interrupt-thread-error ()))))))
;;; called from top of invoke-debugger
(defun debugger-wait-until-foreground-thread (stream)
(when (eql (car int-t) tid)
(unless was-foreground
(format *query-io* "Resuming thread ~A~%" tid))
- (sb!sys:enable-interrupt sb!unix:sigint #'sb!unix::sigint-handler)
(return-from get-foreground t))
(setf was-foreground nil)
(unless (member tid int-t)
(let ((tid (current-thread-id)))
(setf (session-interactive-threads *session*)
(delete tid (session-interactive-threads *session*)))
- (sb!sys:enable-interrupt sb!unix:sigint :ignore)
(when next
(setf (session-interactive-threads *session*)
(list* next
(delete next (session-interactive-threads *session*)))))
(condition-broadcast (session-interactive-threads-queue *session*)))))
+(defun foreground-thread ()
+ (car (session-interactive-threads *session*)))
+
(defun make-listener-thread (tty-name)
(assert (probe-file tty-name))
(let* ((in (sb!unix:unix-open (namestring tty-name) sb!unix:o_rdwr #o666))
(sb!sys:make-fd-stream err :input t :output t :buffering :line :dual-channel-p t))
(sb!impl::*descriptor-handlers* nil))
(with-new-session ()
- (sb!sys:enable-interrupt sb!unix:sigint #'sb!unix::sigint-handler)
(unwind-protect
(sb!impl::toplevel-repl nil)
(sb!int:flush-standard-output-streams))))))
(* n sb!vm:n-word-bytes)))
(defun current-thread-id ()
+ ;; FIXME: 32/64
(sb!sys:sap-ref-32 (alien-sap (extern-alien "all_threads" (* t)))
- (* sb!vm::thread-pid-slot sb!vm:n-word-bytes)))
+ (* sb!vm::thread-os-thread-slot sb!vm:n-word-bytes)))
(defun reap-dead-threads ())
;; unbound_marker is borrowed very briefly at thread startup to
;; pass the address of initial-function into new_thread_trampoline
(unbound-marker :init :unbound) ; tls[0] = UNBOUND_MARKER_WIDETAG
- (pid :c-type "pid_t")
+ (os-thread :c-type "os_thread_t")
(binding-stack-start :c-type "lispobj *" :length #!+alpha 2 #!-alpha 1)
(binding-stack-pointer :c-type "lispobj *" :length #!+alpha 2 #!-alpha 1)
(control-stack-start :c-type "lispobj *" :length #!+alpha 2 #!-alpha 1)
#!+gencgc (alloc-region :c-type "struct alloc_region" :length 5)
(tls-cookie) ; on x86, the LDT index
(this :c-type "struct thread *" :length #!+alpha 2 #!-alpha 1)
+ (prev :c-type "struct thread *" :length #!+alpha 2 #!-alpha 1)
(next :c-type "struct thread *" :length #!+alpha 2 #!-alpha 1)
(state) ; running, stopping, stopped, dead
#!+(or x86 x86-64) (pseudo-atomic-atomic)
#!+(or x86 x86-64) (pseudo-atomic-interrupted)
+ (interrupt-fun)
+ (interrupt-fun-lock)
(interrupt-data :c-type "struct interrupt_data *"
:length #!+alpha 2 #!-alpha 1)
(interrupt-contexts :c-type "os_context_t *" :rest-p t))
# interface, though.:-| As far as I (WHN 2002-05-19) know, no one is
# working on one and it would be a nice thing to have.)
LINKFLAGS += -Wl,--export-dynamic
-OS_LIBS = -ldl
+OS_LIBS = -lpthread -ldl
GC_SRC = gencgc.c
#include "os.h"
#include "signal.h"
+#include "thread.h"
/* Do anything we need to do when starting up the runtime environment
* on this architecture. */
extern void arch_install_interrupt_handlers(void);
extern void arch_do_displaced_inst(os_context_t *context,
unsigned int orig_inst);
+
+extern int arch_os_thread_init(struct thread *thread);
+extern int arch_os_thread_cleanup(struct thread *thread);
+
extern lispobj funcall0(lispobj function);
extern lispobj funcall1(lispobj function, lispobj arg0);
extern lispobj funcall2(lispobj function, lispobj arg0, lispobj arg1);
/* Don't disallow recursive breakpoint traps. Otherwise, we can't
* use debugger breakpoints anywhere in here. */
- sigprocmask(SIG_SETMASK, os_context_sigmask_addr(context), 0);
+ thread_sigmask(SIG_SETMASK, os_context_sigmask_addr(context), 0);
funcall3(SymbolFunction(HANDLE_BREAKPOINT),
compute_offset(context, code),
/* Don't disallow recursive breakpoint traps. Otherwise, we can't
* use debugger breakpoints anywhere in here. */
- sigprocmask(SIG_SETMASK, os_context_sigmask_addr(context), 0);
+ thread_sigmask(SIG_SETMASK, os_context_sigmask_addr(context), 0);
funcall3(SymbolFunction(HANDLE_BREAKPOINT),
compute_offset(context, code),
/* Don't disallow recursive breakpoint traps. Otherwise, we can't
* use debugger breakpoints anywhere in here. */
- sigprocmask(SIG_SETMASK, os_context_sigmask_addr(context), 0);
+ thread_sigmask(SIG_SETMASK, os_context_sigmask_addr(context), 0);
funcall3(SymbolFunction(HANDLE_BREAKPOINT),
compute_offset(context, code),
* from a signal handler (e.g. with the sigsegv gc_trigger stuff) */
sigemptyset(&tmp);
sigaddset_blockable(&tmp);
- sigprocmask(SIG_BLOCK, &tmp, &old);
+ thread_sigmask(SIG_BLOCK, &tmp, &old);
current_static_space_free_pointer =
(lispobj *) ((unsigned long)
#endif
zero_stack();
set_auto_gc_trigger(size_retained+bytes_consed_between_gcs);
- sigprocmask(SIG_SETMASK, &old, 0);
+ thread_sigmask(SIG_SETMASK, &old, 0);
#ifdef PRINTNOISE
* e.g. boxed/unboxed, generation, ages; there may need to be many
* allocation regions.
*
- * Each allocation region may be start within a partly used page. Many
+ * Each allocation region may start within a partly used page. Many
* features of memory use are noted on a page wise basis, e.g. the
* generation; so if a region starts within an existing allocated page
* it must be consistent with this page.
#ifdef LISP_FEATURE_SB_THREAD
if(!SymbolValue(PSEUDO_ATOMIC_ATOMIC,th)) {
register u32 fs;
- fprintf(stderr, "fatal error in thread 0x%x, pid=%d\n",
- th,getpid());
+ fprintf(stderr, "fatal error in thread 0x%x, tid=%ld\n",
+ th,th->os_thread);
__asm__("movl %fs,%0" : "=r" (fs) : );
fprintf(stderr, "fs is %x, th->tls_cookie=%x \n",
debug_get_fs(),th->tls_cookie);
sigset_t new_mask,old_mask;
sigemptyset(&new_mask);
sigaddset_blockable(&new_mask);
- sigprocmask(SIG_BLOCK,&new_mask,&old_mask);
+ thread_sigmask(SIG_BLOCK,&new_mask,&old_mask);
if((!data->pending_handler) &&
maybe_defer_handler(interrupt_maybe_gc_int,data,0,0,0)) {
sigcopyset(&(data->pending_mask),&old_mask);
SetSymbolValue(NEED_TO_COLLECT_GARBAGE,T,thread);
} else {
- sigprocmask(SIG_SETMASK,&old_mask,0);
+ thread_sigmask(SIG_SETMASK,&old_mask,0);
}
}
}
* is done). For the GENCGC, it always points to DYNAMIC_SPACE_START. */
lispobj *current_dynamic_space;
+#if defined(LISP_FEATURE_SB_THREAD)
+pthread_key_t specials=0;
+#endif
+
void globals_init(void)
{
/* Space, stack, and free pointer vars are initialized by
/* Set foreign function call active. */
foreign_function_call_active = 1;
+#if defined(LISP_FEATURE_SB_THREAD)
+ pthread_key_create(&specials,0);
+#endif
}
extern int foreign_function_call_active;
extern boolean stop_the_world;
+#if defined(LISP_FEATURE_SB_THREAD)
+extern pthread_key_t specials;
+#endif
+
extern lispobj *current_control_stack_pointer;
extern lispobj *current_control_frame_pointer;
# if !defined(LISP_FEATURE_X86) && !defined(LISP_FEATURE_X86_64)
{
va_list ap;
fprintf(stderr, "fatal error encountered in SBCL pid %d",getpid());
- /* freeze all the other threads, so we have a chance of debugging them
- */
- if(all_threads) {
- struct thread *th1,*th=arch_os_get_current_thread();
- for_each_thread(th1) {
- if(th1!=th) kill(th1->pid,SIGSTOP);
- }
- }
-
+#if defined(LISP_FEATURE_SB_THREAD)
+ fprintf(stderr, "(tid %ld)",thread_self());
+#endif
if (fmt) {
fprintf(stderr, ":\n");
va_start(ap, fmt);
#include <signal.h>
#include <sys/types.h>
#include <sys/wait.h>
+#include <errno.h>
#include "sbcl.h"
#include "runtime.h"
#include "interr.h"
#include "genesis/fdefn.h"
#include "genesis/simple-fun.h"
+#include "genesis/cons.h"
sigset_t empty,current;
int i;
sigemptyset(&empty);
- sigprocmask(SIG_BLOCK, &empty, ¤t);
+ thread_sigmask(SIG_BLOCK, &empty, ¤t);
for(i=0;i<NSIG;i++) {
if (sigismember(&blockable_sigset, i) && !sigismember(¤t, i))
lose("blockable signal %d not blocked",i);
{
sigset_t new;
sigemptyset(&new);
- sigprocmask(SIG_SETMASK,&new,0);
+ thread_sigmask(SIG_SETMASK,&new,0);
}
sigset_t block;
sigemptyset(&block);
sigaddset_blockable(&block);
- sigprocmask(SIG_BLOCK, &block, 0);
+ thread_sigmask(SIG_BLOCK, &block, 0);
/* going back into Lisp */
foreign_function_call_active = 0;
context_sap = alloc_sap(context);
}
- sigprocmask(SIG_SETMASK, os_context_sigmask_addr(context), 0);
+ thread_sigmask(SIG_SETMASK, os_context_sigmask_addr(context), 0);
if (internal_errors_enabled) {
SHOW("in interrupt_internal_error");
lispobj info_sap,context_sap = alloc_sap(context);
info_sap = alloc_sap(info);
/* Allow signals again. */
- sigprocmask(SIG_SETMASK, os_context_sigmask_addr(context), 0);
+ thread_sigmask(SIG_SETMASK, os_context_sigmask_addr(context), 0);
#ifdef QSHOW_SIGNALS
SHOW("calling Lisp-level handler");
#endif
/* Allow signals again. */
- sigprocmask(SIG_SETMASK, os_context_sigmask_addr(context), 0);
+ thread_sigmask(SIG_SETMASK, os_context_sigmask_addr(context), 0);
(*handler.c)(signal, info, void_context);
}
SetSymbolValue(INTERRUPT_PENDING, T,thread);
#ifdef QSHOW_SIGNALS
FSHOW((stderr,
- "/maybe_defer_handler(%x,%d),thread=%d: deferred\n",
- (unsigned int)handler,signal,thread->pid));
+ "/maybe_defer_handler(%x,%d),thread=%ld: deferred\n",
+ (unsigned int)handler,signal,thread->os_thread));
#endif
return 1;
}
arch_set_pseudo_atomic_interrupted(context);
#ifdef QSHOW_SIGNALS
FSHOW((stderr,
- "/maybe_defer_handler(%x,%d),thread=%d: deferred(PA)\n",
- (unsigned int)handler,signal,thread->pid));
+ "/maybe_defer_handler(%x,%d),thread=%ld: deferred(PA)\n",
+ (unsigned int)handler,signal,thread->os_thread));
#endif
return 1;
}
#ifdef QSHOW_SIGNALS
FSHOW((stderr,
- "/maybe_defer_handler(%x,%d),thread=%d: not deferred\n",
- (unsigned int)handler,signal,thread->pid));
+ "/maybe_defer_handler(%x,%d),thread=%ld: not deferred\n",
+ (unsigned int)handler,signal,thread->os_thread));
#endif
return 0;
}
sigemptyset(&ss);
for(i=1;i<NSIG;i++) sigaddset(&ss,i); /* Block everything. */
- sigprocmask(SIG_BLOCK,&ss,0);
+ thread_sigmask(SIG_BLOCK,&ss,0);
/* The GC can't tell if a thread is a zombie, so this would be a
* good time to let the kernel reap any of our children in that
* awful state, to stop them from being waited for indefinitely.
* Userland reaping is done later when GC is finished */
- mark_dead_threads();
if(thread->state!=STATE_STOPPING) {
lose("sig_stop_for_gc_handler: wrong thread state: %ld\n",
fixnum_value(thread->state));
* user's backtrace makes (as much) sense (as usual) */
/* FIXME: what about restoring fp state? */
+ /* FIXME: what about restoring errno? */
#ifdef LISP_FEATURE_X86
/* Suppose the existence of some function that saved all
* registers, called call_into_lisp, then restored GP registers and
push ebp
mov ebp esp
- pushad
+ pushfl
+ pushal
push $0
push $0
pushl {address of function to call}
call 0x8058db0 <call_into_lisp>
addl $12,%esp
- popa
+ popal
+ popfl
leave
ret
void interrupt_thread_handler(int num, siginfo_t *info, void *v_context)
{
os_context_t *context = (os_context_t*)arch_os_get_context(&v_context);
- arrange_return_to_lisp_function(context,info->si_value.sival_int);
+ /* The order of interrupt execution is peculiar. If thread A
+ * interrupts thread B with I1, I2 and B for some reason recieves
+ * I1 when FUN2 is already on the list, then it is FUN2 that gets
+ * to run first. But when FUN2 is run SIG_INTERRUPT_THREAD is
+ * enabled again and I2 hits pretty soon in FUN2 and run
+ * FUN1. This is of course just one scenario, and the order of
+ * thread interrupt execution is undefined. */
+ struct thread *th=arch_os_get_current_thread();
+ struct cons *c;
+ get_spinlock(&th->interrupt_fun_lock,(long)th);
+ c=((struct cons *)native_pointer(th->interrupt_fun));
+ arrange_return_to_lisp_function(context,c->car);
+ th->interrupt_fun=(lispobj *)(c->cdr);
+ release_spinlock(&th->interrupt_fun_lock);
}
-void thread_exit_handler(int num, siginfo_t *info, void *v_context)
-{ /* called when a child thread exits */
- mark_dead_threads();
-}
-
#endif
/* KLUDGE: Theoretically the approach we use for undefined alien
* protection so the error handler has some headroom, protect the
* previous page so that we can catch returns from the guard page
* and restore it. */
- protect_control_stack_guard_page(th->pid,0);
- protect_control_stack_return_guard_page(th->pid,1);
+ protect_control_stack_guard_page(th->os_thread,0);
+ protect_control_stack_return_guard_page(th->os_thread,1);
arrange_return_to_lisp_function
(context, SymbolFunction(CONTROL_STACK_EXHAUSTED_ERROR));
* unprotect this one. This works even if we somehow missed
* the return-guard-page, and hit it on our way to new
* exhaustion instead. */
- protect_control_stack_guard_page(th->pid,1);
- protect_control_stack_return_guard_page(th->pid,0);
+ protect_control_stack_guard_page(th->os_thread,1);
+ protect_control_stack_return_guard_page(th->os_thread,0);
return 1;
}
else if (addr >= undefined_alien_address &&
/* restore the signal mask from the interrupted context before
* calling into Lisp */
if (context)
- sigprocmask(SIG_SETMASK, os_context_sigmask_addr(context), 0);
+ thread_sigmask(SIG_SETMASK, os_context_sigmask_addr(context), 0);
funcall0(SymbolFunction(SUB_GC));
sigemptyset(&new);
sigaddset(&new, signal);
- sigprocmask(SIG_BLOCK, &new, &old);
+ thread_sigmask(SIG_BLOCK, &new, &old);
sigemptyset(&new);
sigaddset_blockable(&new);
oldhandler = data->interrupt_handlers[signal];
data->interrupt_handlers[signal].c = handler;
- sigprocmask(SIG_SETMASK, &old, 0);
+ thread_sigmask(SIG_SETMASK, &old, 0);
FSHOW((stderr, "/leaving POSIX install_handler(%d, ..)\n", signal));
#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
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);
#endif
}
#define SIG_INTERRUPT_THREAD (SIGRTMIN)
#define SIG_STOP_FOR_GC (SIGRTMIN+1)
-#define SIG_DEQUEUE (SIGRTMIN+2)
-#define SIG_THREAD_EXIT (SIGRTMIN+3)
/* this is an integral type the same length as a machine pointer */
typedef unsigned long pointer_sized_uint_t ;
+#include <sys/types.h>
+
+#if defined(LISP_FEATURE_SB_THREAD)
+#include <pthread.h>
+typedef pthread_t os_thread_t;
+#else
+typedef pid_t os_thread_t;
+#endif
+
/* FIXME: we do things this way because of the alpha32 port. once
alpha64 has arrived, all this nastiness can go away */
#if 64 == N_WORD_BITS
#include "sbcl.h"
#include "runtime.h"
#include "validate.h" /* for CONTROL_STACK_SIZE etc */
+#include "alloc.h"
#include "thread.h"
#include "arch.h"
#include "target-arch-os.h"
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");
+ if(th->os_thread < 1) lose("th->os_thread not set up right");
th->state=STATE_RUNNING;
#if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
return call_into_lisp_first_time(function,args,0);
#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
- */
-
#ifdef LISP_FEATURE_SB_THREAD
+void mark_thread_dead(struct thread *th) {
+ funcall1(SymbolFunction(HANDLE_THREAD_EXIT),alloc_number(th->os_thread));
+ /* I hope it's safe for a thread to detach itself inside a
+ * cancellation cleanup */
+ pthread_detach(th->os_thread);
+ th->state=STATE_DEAD;
+ /* FIXME: if gc hits here it will rip the stack from under us */
+}
+
+/* this is the first thing that 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
+ */
int
new_thread_trampoline(struct thread *th)
{
- lispobj function;
+ lispobj function,ret;
function = th->unbound_marker;
th->unbound_marker = UNBOUND_MARKER_WIDETAG;
+ pthread_cleanup_push((void (*) (void *))mark_thread_dead,th);
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();
+ while(th->os_thread<1) sched_yield();
th->state=STATE_RUNNING;
- return funcall0(function);
+ ret = funcall0(function);
+ /* execute cleanup */
+ pthread_cleanup_pop(1);
+ return ret;
}
#endif /* LISP_FEATURE_SB_THREAD */
(lispobj*)((void*)th->binding_stack_start+BINDING_STACK_SIZE);
th->binding_stack_pointer=th->binding_stack_start;
th->this=th;
- th->pid=0;
+ th->os_thread=0;
+ th->interrupt_fun=NIL;
+ th->interrupt_fun_lock=0;
th->state=STATE_STARTING;
#ifdef LISP_FEATURE_STACK_GROWS_DOWNWARD_NOT_UPWARD
th->alien_stack_pointer=((void *)th->alien_stack_start
bind_variable(INTERRUPT_PENDING, NIL,th);
bind_variable(INTERRUPTS_ENABLED,T,th);
- th->interrupt_data =
- os_validate(0,(sizeof (struct interrupt_data)));
+ th->interrupt_data = (struct interrupt_data *)
+ os_validate(0,(sizeof (struct interrupt_data)));
if(all_threads)
memcpy(th->interrupt_data,
arch_os_get_current_thread()->interrupt_data,
return th;
}
-void link_thread(struct thread *th,pid_t kid_pid)
+void link_thread(struct thread *th,os_thread_t kid_tid)
{
sigset_t newset,oldset;
sigemptyset(&newset);
sigaddset_blockable(&newset);
- sigprocmask(SIG_BLOCK, &newset, &oldset);
+ thread_sigmask(SIG_BLOCK, &newset, &oldset);
- get_spinlock(&all_threads_lock,kid_pid);
+ get_spinlock(&all_threads_lock,kid_tid);
+ if (all_threads) all_threads->prev=th;
th->next=all_threads;
+ th->prev=0;
all_threads=th;
- /* note that th->pid is 0 at this time. We rely on all_threads_lock
- * to ensure that we don't have >1 thread with pid=0 on the list at once
+ /* note that th->os_thread is 0 at this time. We rely on
+ * all_threads_lock to ensure that we don't have >1 thread with
+ * os_thread=0 on the list at once
*/
- protect_control_stack_guard_page(th->pid,1);
- th->pid=kid_pid; /* child will not start until this is set */
+ protect_control_stack_guard_page(th->os_thread,1);
+ /* child will not start until this is set */
+ th->os_thread=kid_tid;
release_spinlock(&all_threads_lock);
- sigprocmask(SIG_SETMASK,&oldset,0);
+ thread_sigmask(SIG_SETMASK,&oldset,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);
+ os_thread_t kid_tid=thread_self();
+ if(th && kid_tid>0) {
+ link_thread(th,kid_tid);
initial_thread_trampoline(all_threads); /* no return */
} else lose("can't create initial thread");
}
#ifdef LISP_FEATURE_SB_THREAD
-pid_t create_thread(lispobj initial_function) {
+os_thread_t create_thread(lispobj initial_function) {
struct thread *th;
- pid_t kid_pid=0;
+ os_thread_t kid_tid=0;
+ pthread_attr_t attr;
if(linux_no_threads_p) return 0;
th=create_thread_struct(initial_function);
#ifdef QSHOW_SIGNALS
SHOW("create_thread:waiting on lock");
#endif
- get_spinlock(&thread_start_lock,arch_os_get_current_thread()->pid);
+ get_spinlock(&thread_start_lock,arch_os_get_current_thread()->os_thread);
#ifdef QSHOW_SIGNALS
SHOW("create_thread:got lock");
#endif
- kid_pid=clone(new_thread_trampoline,
- (((void*)th->control_stack_start)+
- THREAD_CONTROL_STACK_SIZE-16),
- CLONE_FILES|SIG_THREAD_EXIT|CLONE_VM,th);
-
- if(kid_pid>0) {
- link_thread(th,kid_pid);
- /* wait here until our thread is started: see new_thread_trampoline */
- while(th->state==STATE_STARTING) sched_yield();
+ /* The new thread inherits the restrictive signal mask set here,
+ * and enables signals again when it is set up properly. */
+ {
+ sigset_t newset,oldset;
+ sigemptyset(&newset);
+ sigaddset_blockable(&newset);
+ thread_sigmask(SIG_BLOCK, &newset, &oldset);
+ if((pthread_attr_init(&attr)) ||
+ (pthread_attr_setstack(&attr,th->control_stack_start,
+ THREAD_CONTROL_STACK_SIZE-16)) ||
+ (pthread_create
+ (&kid_tid,&attr,(void *(*)(void *))new_thread_trampoline,th)))
+ kid_tid=0;
+ thread_sigmask(SIG_SETMASK,&oldset,0);
+ }
+ if(kid_tid>0) {
+ link_thread(th,kid_tid);
/* it's started and initialized, it's safe to gc */
release_spinlock(&thread_start_lock);
#ifdef QSHOW_SIGNALS
SHOW("create_thread:released lock");
#endif
- return th->pid;
+ /* by now the kid might have already exited */
+ return kid_tid;
} else {
release_spinlock(&thread_start_lock);
#ifdef QSHOW_SIGNALS
}
#endif
-struct thread *find_thread_by_pid(pid_t pid)
+struct thread *find_thread_by_os_thread(os_thread_t tid)
{
struct thread *th;
for_each_thread(th)
- if(th->pid==pid) return th;
+ if(th->os_thread==tid) return th;
return 0;
}
/* This is not needed unless #+SB-THREAD, as there's a trivial null
* unithread definition. */
-void mark_dead_threads()
-{
- pid_t kid;
- int status;
- while(1) {
- kid=waitpid(-1,&status,__WALL|WNOHANG);
- if(kid<=0) break;
- if(WIFEXITED(status) || WIFSIGNALED(status)) {
- struct thread *th=find_thread_by_pid(kid);
- if(th) th->state=STATE_DEAD;
- }
- }
-}
-
void reap_dead_threads()
{
struct thread *th,*next,*prev=0;
while(th) {
next=th->next;
if(th->state==STATE_DEAD) {
- funcall1(SymbolFunction(HANDLE_THREAD_EXIT),make_fixnum(th->pid));
#ifdef LISP_FEATURE_GENCGC
gc_alloc_update_page_tables(0, &th->alloc_region);
#endif
- get_spinlock(&all_threads_lock,th->pid);
+ get_spinlock(&all_threads_lock,th->os_thread);
if(prev) prev->next=next;
else all_threads=next;
release_spinlock(&all_threads_lock);
}
}
-int interrupt_thread(pid_t pid, lispobj function)
+int interrupt_thread(os_thread_t tid, lispobj function)
{
- union sigval sigval;
struct thread *th;
- sigval.sival_int=function;
for_each_thread(th)
- if((th->pid==pid) && (th->state != STATE_DEAD))
- return sigqueue(pid, SIG_INTERRUPT_THREAD, sigval);
+ if((th->os_thread==tid) && (th->state != STATE_DEAD)) {
+ /* In clone_threads, if A and B both interrupt C at approximately
+ * the same time, it does not matter: the second signal will be
+ * masked until the handler has returned from the first one.
+ * In pthreads though, we can't put the knowledge of what function
+ * to call into the siginfo, so we have to store it in the
+ * destination thread, and do it in such a way that A won't
+ * clobber B's interrupt. Hence this stupid linked list.
+ *
+ * This does depend on SIG_INTERRUPT_THREAD being queued
+ * (as POSIX RT signals are): we need to keep
+ * interrupt_fun data for exactly as many signals as are
+ * going to be received by the destination thread.
+ */
+ struct cons *c;
+ int kill_status;
+ /* mask the signals in case this thread is being interrupted */
+ sigset_t newset,oldset;
+ sigemptyset(&newset);
+ sigaddset_blockable(&newset);
+ thread_sigmask(SIG_BLOCK, &newset, &oldset);
+
+ get_spinlock(&th->interrupt_fun_lock,
+ (int)arch_os_get_current_thread());
+ kill_status=thread_kill(th->os_thread,SIG_INTERRUPT_THREAD);
+ if(kill_status==0) {
+ c=alloc_cons(function,th->interrupt_fun);
+ th->interrupt_fun=c;
+ }
+ release_spinlock(&th->interrupt_fun_lock);
+ thread_sigmask(SIG_SETMASK,&oldset,0);
+ return (kill_status ? -1 : 0);
+ }
errno=EPERM; return -1;
}
-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 signal does
* the usual pseudo-atomic checks (we don't want to stop a thread while
void gc_stop_the_world()
{
+ struct thread *p,*th=arch_os_get_current_thread();
#ifdef QSHOW_SIGNALS
SHOW("gc_stop_the_world:begin");
#endif
- struct thread *p,*th=arch_os_get_current_thread();
/* keep threads from starting while the world is stopped. */
- get_spinlock(&thread_start_lock,th->pid);
+ get_spinlock(&thread_start_lock,th->os_thread);
#ifdef QSHOW_SIGNALS
SHOW("gc_stop_the_world:locked");
#endif
/* stop all other threads by sending them SIG_STOP_FOR_GC */
for(p=all_threads; p; p=p->next) {
- if((p!=th) && (p->pid!=0) && (p->state==STATE_RUNNING)) {
+ while(p->state==STATE_STARTING) sched_yield();
+ if((p!=th) && (p->os_thread!=0) && (p->state==STATE_RUNNING)) {
p->state=STATE_STOPPING;
- if(kill(p->pid,SIG_STOP_FOR_GC)==-1) {
- /* we can't kill the process; assume because it
- * died already (and its parent is dead so never
- * saw the SIGCHLD) */
+ if(thread_kill(p->os_thread,SIG_STOP_FOR_GC)==-1) {
+ /* FIXME: we can't kill the thread; assume because it died
+ * already */
p->state=STATE_DEAD;
}
}
#endif
/* wait for the running threads to stop */
for(p=all_threads;p;) {
- if((p==th) || (p->pid==0) || (p->state==STATE_STARTING) ||
+ if((p==th) || (p->os_thread==0) || (p->state==STATE_STARTING) ||
(p->state==STATE_DEAD) || (p->state==STATE_STOPPED)) {
p=p->next;
}
SHOW("gc_start_the_world:begin");
#endif
for(p=all_threads;p;p=p->next) {
- if((p!=th) && (p->pid!=0) && (p->state!=STATE_STARTING) &&
+ if((p!=th) && (p->os_thread!=0) && (p->state!=STATE_STARTING) &&
(p->state!=STATE_DEAD)) {
if(p->state!=STATE_STOPPED) {
lose("gc_start_the_world: wrong thread state is %ld\n",
fixnum_value(p->state));
}
- kill(p->pid,SIG_STOP_FOR_GC);
+ thread_kill(p->os_thread,SIG_STOP_FOR_GC);
}
}
/* we must wait for all threads to leave stopped state else we
* thread->state */
for(p=all_threads;p;) {
gc_assert(p->state!=STATE_STOPPING);
- if((p==th) || (p->pid==0) || (p->state!=STATE_STOPPED)) {
+ if((p==th) || (p->os_thread==0) || (p->state!=STATE_STOPPED)) {
p=p->next;
}
}
extern struct thread *all_threads;
extern int dynamic_values_bytes;
-extern struct thread *find_thread_by_pid(pid_t pid);
+extern struct thread *find_thread_by_os_thread(os_thread_t tid);
#ifdef LISP_FEATURE_SB_THREAD
#define for_each_thread(th) for(th=all_threads;th;th=th->next)
* usually aren't by that time. So, it's here instead. Sorry */
static inline struct thread *arch_os_get_current_thread() {
-#if defined(LISP_FEATURE_SB_THREAD) && defined (LISP_FEATURE_X86)
+#if defined(LISP_FEATURE_SB_THREAD)
+#if defined(LISP_FEATURE_X86)
register struct thread *me=0;
if(all_threads)
__asm__ __volatile__ ("movl %%fs:%c1,%0" : "=r" (me)
: "i" (offsetof (struct thread,this)));
return me;
#else
- return all_threads;
+ return pthread_getspecific(specials);
+#endif /* x86 */
+#else
+ return all_threads;
#endif
}
+#if defined(LISP_FEATURE_SB_THREAD)
+#define thread_self pthread_self
+#define thread_kill pthread_kill
+#define thread_sigmask pthread_sigmask
+#else
+#define thread_self getpid
+#define thread_kill kill
+#define thread_sigmask sigprocmask
+#endif
-int arch_os_thread_init(struct thread *thread);
extern void create_initial_thread(lispobj);
#endif /* _INCLUDE_THREAD_H_ */
}
void
-protect_control_stack_guard_page(pid_t t_id, int protect_p) {
- struct thread *th = find_thread_by_pid(t_id);
+protect_control_stack_guard_page(os_thread_t t_id, int protect_p) {
+ struct thread *th = find_thread_by_os_thread(t_id);
os_protect(CONTROL_STACK_GUARD_PAGE(th),
os_vm_page_size,protect_p ?
(OS_VM_PROT_READ|OS_VM_PROT_EXECUTE) : OS_VM_PROT_ALL);
}
void
-protect_control_stack_return_guard_page(pid_t t_id, int protect_p) {
- struct thread *th = find_thread_by_pid(t_id);
+protect_control_stack_return_guard_page(os_thread_t t_id, int protect_p) {
+ struct thread *th = find_thread_by_os_thread(t_id);
os_protect(CONTROL_STACK_RETURN_GUARD_PAGE(th),
os_vm_page_size,protect_p ?
(OS_VM_PROT_READ|OS_VM_PROT_EXECUTE) : OS_VM_PROT_ALL);
#endif
extern void validate(void);
-extern void protect_control_stack_guard_page(pid_t t_id, int protect_p);
-extern void protect_control_stack_return_guard_page(pid_t t_id, int protect_p);
+extern void protect_control_stack_guard_page(os_thread_t t_id, int protect_p);
+extern void protect_control_stack_return_guard_page(os_thread_t t_id,
+ int protect_p);
extern os_vm_address_t undefined_alien_address;
#endif
1, MODIFY_LDT_CONTENTS_DATA, 0, 0, 0, 1
};
int n;
- get_spinlock(&modify_ldt_lock,thread);
+ /* thread->os_thread is not set yet*/
+ get_spinlock(&modify_ldt_lock,(int)thread);
n=modify_ldt(0,local_ldt_copy,sizeof local_ldt_copy);
/* get next free ldt entry */
modify_ldt_lock=0;
if(n<0) return 0;
+ pthread_setspecific(specials,thread);
#endif
#ifdef LISP_FEATURE_C_STACK_IS_CONTROL_STACK
/* Signal handlers are run on the control stack, so if it is exhausted
sigstack.ss_flags=0;
sigstack.ss_size = 32*SIGSTKSZ;
sigaltstack(&sigstack,0);
+ if(sigaltstack(&sigstack,0)<0) {
+ lose("Cannot sigaltstack: %s\n",strerror(errno));
+ }
#endif
return 1;
}
(test-interrupt #'loop-forever :quit)
(let ((child (test-interrupt (lambda () (loop (sleep 2000))))))
- ;; Interrupting a sleep form causes it to return early. Welcome to Unix.
- ;; Just to be sure our LOOP form works, let's check the child is still
- ;; there
- (assert (zerop (sb-unix:unix-kill child 0)))
(terminate-thread child))
(let ((lock (make-mutex :name "loctite"))
(princ ".") (force-output)
(assert (zerop SB-KERNEL:*PSEUDO-ATOMIC-ATOMIC*)))))
(terminate-thread c))
+(terpri)
(defparameter *interrupt-count* 0)
(when (and a-done b-done) (return))
(sleep 1)))
+(terpri)
+
(defun waste (&optional (n 100000))
(loop repeat n do (make-string 16384)))
(loop for i below 100 do
- (format t "LOOP:~A~%" i)
+ (princ "!")
(force-output)
(sb-thread:make-thread
#'(lambda ()
(waste)
(sb-ext:gc))
+(terpri)
+
(defparameter *aaa* nil)
(loop for i below 100 do
- (format t "LOOP:~A~%" i)
+ (princ "!")
(force-output)
(sb-thread:make-thread
#'(lambda ()
(format t "~&gc test done~%")
+;; this used to deadlock on session-lock
+(sb-thread:make-thread (lambda () (sb-ext:gc)))
+;; expose thread creation races by exiting quickly
+(sb-thread:make-thread (lambda ()))
+
+(defun exercise-syscall (fn reference-errno)
+ (sb-thread:make-thread
+ (lambda ()
+ (loop do
+ (funcall fn)
+ (let ((errno (sb-unix::get-errno)))
+ (sleep (random 1.0))
+ (unless (eql errno reference-errno)
+ (format t "Got errno: ~A (~A) instead of ~A~%"
+ errno
+ (sb-unix::strerror)
+ reference-errno)
+ (force-output)
+ (sb-ext:quit :unix-status 1)))))))
+
+(let* ((nanosleep-errno (progn
+ (sb-unix:nanosleep -1 0)
+ (sb-unix::get-errno)))
+ (open-errno (progn
+ (open "no-such-file"
+ :if-does-not-exist nil)
+ (sb-unix::get-errno)))
+ (threads
+ (list
+ (exercise-syscall (lambda () (sb-unix:nanosleep -1 0)) nanosleep-errno)
+ (exercise-syscall (lambda () (open "no-such-file"
+ :if-does-not-exist nil))
+ open-errno)
+ (sb-thread:make-thread (lambda () (loop (sb-ext:gc) (sleep 1)))))))
+ (sleep 10)
+ (princ "terminating threads")
+ (dolist (thread threads)
+ (sb-thread:terminate-thread thread)))
+
+(format t "~&errno test done~%")
+
+(loop repeat 100 do
+ (let ((thread (sb-thread:make-thread (lambda () (sleep 0.1)))))
+ (sb-thread:interrupt-thread
+ thread
+ (lambda ()
+ (assert (find-restart 'sb-thread:terminate-thread))))))
+
+(sb-ext:gc :full t)
+
+(format t "~&thread startup sigmask test done~%")
+
#| ;; a cll post from eric marsden
| (defun crash ()
| (setq *debugger-hook*
;;; 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.9.1.58"
+"0.9.1.59"
projects / sbcl.git / commitdiff