Rewrite of signal-handling.

The API is the same (for now).  The new implementation has the
capability to define signal handlers that have access to the siginfo
of the signal (#592), but this functionality is not exposed in this
patch.

#2451 is the ticket for the new API.

The main purpose of bringing this in now is to fix race conditions in
the old signal handling code (#2858).  Later we can enable the new
API in the HEAD.

Implementation differences:

 - More of the signal-handling is moved into Haskell.  We store the
   table of signal handlers in an MVar, rather than having a table of
   StablePtrs in the RTS.

 - In the threaded RTS, the siginfo of the signal is passed down the
   pipe to the IO manager thread, which manages the business of
   starting up new signal handler threads.  In the non-threaded RTS,
   the siginfo of caught signals is stored in the RTS, and the
   scheduler starts new signal handler threads.

2 files changed, 26 insertions, 0 deletions

diff --git a/tests/all.T b/tests/all.T
index 8647812..6746643 100644
--- a/tests/all.T
+++ b/tests/all.T
@@ -24,3 +24,5 @@ test('getGroupEntryForName', compose(conf, expect_fail), compile_and_run,
 test('getUserEntryForName', compose(conf, expect_fail), compile_and_run,
      ['-package unix'])
 
+
+test('signals004', normal, compile_and_run, ['-package unix'])
diff --git a/tests/signals004.hs b/tests/signals004.hs
new file mode 100644
index 0000000..711a6eb
--- /dev/null
+++ b/tests/signals004.hs
@@ -0,0 +1,24 @@
+import Control.Concurrent
+import System.Posix
+import Control.Monad
+
+-- signal stress test: threads installing signal handlers while
+-- signals are being constantly thrown and caught.
+
+installers = 50
+sigs = 10000
+
+main = do
+  c <- newChan
+  m <- newEmptyMVar
+  installHandler sigUSR1 (handler c) Nothing
+  replicateM_ installers (forkIO $ do replicateM_ 1000 (install c); putMVar m ())
+  replicateM_ sigs (forkIO $ raiseSignal sigUSR1)
+  replicateM_ installers (takeMVar m)
+  replicateM_ sigs (readChan c)
+
+handler c = Catch (writeChan c ())
+
+install c = do
+  old <- installHandler sigUSR1 (handler c) Nothing
+  installHandler sigUSR1 old Nothing