From: Simon Marlow <marlowsd@gmail.com>
Date: Thu, 23 Apr 2009 11:28:37 +0000 (+0000)
Subject: FIX #3171: make sure we have only one table of signal handlers
X-Git-Tag: 2009-06-25~38
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=3c75227f4383ee93e207c48ac6d1c6acdb48062b;p=ghc-base.git

FIX #3171: make sure we have only one table of signal handlers
---

diff --git a/GHC/Conc.lhs b/GHC/Conc.lhs
index 8ed61fe..d6622dd 100644
--- a/GHC/Conc.lhs
+++ b/GHC/Conc.lhs
@@ -1225,7 +1225,18 @@ type HandlerFun = ForeignPtr Word8 -> IO ()
 signal_handlers :: MVar (IOArray Int (Maybe (HandlerFun,Dynamic)))
 signal_handlers = unsafePerformIO $ do
    arr <- newIOArray (0,maxSig) Nothing
-   newMVar arr
+   m <- newMVar arr
+   block $ do
+     stable_ref <- newStablePtr m
+     let ref = castStablePtrToPtr stable_ref
+     ref2 <- getOrSetSignalHandlerStore ref
+     if ref==ref2
+        then return m
+        else do freeStablePtr stable_ref
+                deRefStablePtr (castPtrToStablePtr ref2)
+
+foreign import ccall unsafe "getOrSetSignalHandlerStore"
+    getOrSetSignalHandlerStore :: Ptr a -> IO (Ptr a)
 
 setHandler :: Signal -> Maybe (HandlerFun,Dynamic) -> IO (Maybe (HandlerFun,Dynamic))
 setHandler sig handler = do