summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMikael Djurfeldt <djurfeldt@nada.kth.se>1998-01-30 21:05:53 +0000
committerMikael Djurfeldt <djurfeldt@nada.kth.se>1998-01-30 21:05:53 +0000
commit13dc0cae2fab2f8295aa6b6e831795b1e5e377f0 (patch)
tree1c1e668d3a1ea1f2f5c073342f7209b06287fd27
parenta3ec616e4298ab0675a86f0097ca9f152fd6785f (diff)
downloadguile-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/ChangeLog9
-rw-r--r--ice-9/threads.scm27
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