diff options
author | Mikael Djurfeldt <djurfeldt@nada.kth.se> | 1998-01-30 21:05:53 +0000 |
---|---|---|
committer | Mikael Djurfeldt <djurfeldt@nada.kth.se> | 1998-01-30 21:05:53 +0000 |
commit | 13dc0cae2fab2f8295aa6b6e831795b1e5e377f0 (patch) | |
tree | 1c1e668d3a1ea1f2f5c073342f7209b06287fd27 | |
parent | a3ec616e4298ab0675a86f0097ca9f152fd6785f (diff) | |
download | guile-13dc0cae2fab2f8295aa6b6e831795b1e5e377f0.tar.gz |
* threads.scm: Added simple error and signal handler.
(make-thread, begin-handler): Use this handler. The most
important effect of this is that signals get unmasked.
Previously, when a signal was thrown signals remained masked
(signals get masked when a signal is taken) which influenced other
threads.
-rw-r--r-- | ice-9/ChangeLog | 9 | ||||
-rw-r--r-- | ice-9/threads.scm | 27 |
2 files changed, 34 insertions, 2 deletions
diff --git a/ice-9/ChangeLog b/ice-9/ChangeLog index e2c7b3232..da7093b8b 100644 --- a/ice-9/ChangeLog +++ b/ice-9/ChangeLog @@ -1,3 +1,12 @@ +1998-01-30 Mikael Djurfeldt <mdj@mdj.nada.kth.se> + + * threads.scm: Added simple error and signal handler. + (make-thread, begin-handler): Use this handler. The most + important effect of this is that signals get unmasked. + Previously, when a signal was thrown signals remained masked + (signals get masked when a signal is taken) which influenced other + threads. + 1998-01-01 Tim Pierce <twp@skepsis.com> A better fix to the SLIB identity problem -- thanks to Marius Vollmer. diff --git a/ice-9/threads.scm b/ice-9/threads.scm index cdc8eba30..09c69259c 100644 --- a/ice-9/threads.scm +++ b/ice-9/threads.scm @@ -29,18 +29,41 @@ ; --- MACROS ------------------------------------------------------- +(define-public (%thread-handler tag . args) + (fluid-set! the-last-stack #f) + (unmask-signals) + (let ((n (length args)) + (p (current-error-port))) + (display "In thread:" p) + (newline p) + (if (>= n 3) + (display-error #f + p + (car args) + (cadr args) + (caddr args) + (if (= n 4) + (cadddr args) + '())) + (begin + (display "uncaught throw to " p) + (display tag p) + (display ": " p) + (display args p) + (newline p))))) + (defmacro-public make-thread (fn . args) `(call-with-new-thread (lambda () (,fn ,@args)) - (lambda args args))) + %thread-handler)) (defmacro-public begin-thread (first . thunk) `(call-with-new-thread (lambda () (begin ,first ,@thunk)) - (lambda args args))) + %thread-handler)) (defmacro-public with-mutex (m . thunk) `(dynamic-wind |