[commit: packages/base] ghc-7.8: Fix base component of #9817 (ghc-7.8 7be1eb7) (c738f99)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/base

On branch  : ghc-7.8
Link       : http://ghc.haskell.org/trac/ghc/changeset/c738f9933c64cda99eda6edf0ed2178ba8376f35/base

>---------------------------------------------------------------

commit c738f9933c64cda99eda6edf0ed2178ba8376f35
Author: Austin Seipp <austin at well-typed.com>
Date:   Mon Dec 15 08:46:00 2014 -0600

    Fix base component of #9817 (ghc-7.8 7be1eb7)
    
    Signed-off-by: Austin Seipp <austin at well-typed.com>


>---------------------------------------------------------------

c738f9933c64cda99eda6edf0ed2178ba8376f35
 GHC/Conc/Signal.hs | 11 ++++++++++-
 1 file changed, 10 insertions(+), 1 deletion(-)

diff --git a/GHC/Conc/Signal.hs b/GHC/Conc/Signal.hs
index 2d70419..4e2c8ee 100644
--- a/GHC/Conc/Signal.hs
+++ b/GHC/Conc/Signal.hs
@@ -6,16 +6,18 @@ module GHC.Conc.Signal
         , HandlerFun
         , setHandler
         , runHandlers
+        , runHandlersPtr
         ) where
 
 import Control.Concurrent.MVar (MVar, newMVar, withMVar)
 import Data.Dynamic (Dynamic)
 import Data.Maybe (Maybe(..))
 import Foreign.C.Types (CInt)
-import Foreign.ForeignPtr (ForeignPtr)
+import Foreign.ForeignPtr (ForeignPtr, newForeignPtr)
 import Foreign.StablePtr (castPtrToStablePtr, castStablePtrToPtr,
                           deRefStablePtr, freeStablePtr, newStablePtr)
 import Foreign.Ptr (Ptr, castPtr)
+import Foreign.Marshal.Alloc (finalizerFree)
 import GHC.Arr (inRange)
 import GHC.Base
 import GHC.Conc.Sync (forkIO)
@@ -71,6 +73,13 @@ runHandlers p_info sig = do
                 Just (f,_)  -> do _ <- forkIO (f p_info)
                                   return ()
 
+-- It is our responsibility to free the memory buffer, so we create a
+-- foreignPtr.
+runHandlersPtr :: Ptr Word8 -> Signal -> IO ()
+runHandlersPtr p s = do
+  fp <- newForeignPtr finalizerFree p
+  runHandlers fp s
+
 -- Machinery needed to ensure that we only have one copy of certain
 -- CAFs in this module even when the base package is present twice, as
 -- it is when base is dynamically loaded into GHCi.  The RTS keeps