From: simonmar <unknown>
Date: Fri, 11 Nov 2005 10:37:35 +0000 (+0000)
Subject: [project @ 2005-11-11 10:37:35 by simonmar]
X-Git-Tag: Initial_conversion_from_CVS_complete~24
X-Git-Url: http://git.megacz.com/?p=ghc-base.git;a=commitdiff_plain;h=42687af2c43217b778a64cf836a4c63a99a5243f

[project @ 2005-11-11 10:37:35 by simonmar]
Fix bugs in new signal handling machinery
---

diff --git a/GHC/Conc.lhs b/GHC/Conc.lhs
index f1b4d61..c447060 100644
--- a/GHC/Conc.lhs
+++ b/GHC/Conc.lhs
@@ -619,8 +619,9 @@ service_loop wakeup readfds writefds ptimeval old_reqs old_delays = do
 	    s <- peek p		
 	    if (s == 0xff) 
 	      then return ()
-	      else do sp <- peekElemOff handlers (fromIntegral s)
-		      quickForkIO (deRefStablePtr sp)
+	      else do handler_tbl <- peek handlers
+		      sp <- peekElemOff handler_tbl (fromIntegral s)
+		      quickForkIO (do io <- deRefStablePtr sp; io)
 		      return ()
 
   takeMVar prodding
@@ -646,7 +647,7 @@ prodServiceThread = do
     else return ()
   putMVar prodding True
 
-foreign import ccall "&signal_handlers" handlers :: Ptr (StablePtr (IO ()))
+foreign import ccall "&signal_handlers" handlers :: Ptr (Ptr (StablePtr (IO ())))
 
 foreign import ccall "setIOManagerPipe"
   c_setIOManagerPipe :: CInt -> IO ()