From 13dc0cae2fab2f8295aa6b6e831795b1e5e377f0 Mon Sep 17 00:00:00 2001
From: Mikael Djurfeldt <djurfeldt@nada.kth.se>
Date: Fri, 30 Jan 1998 21:05:53 +0000
Subject: [PATCH] * 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.

---
 ice-9/ChangeLog   |  9 +++++++++
 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