[commit: ghc] master: compiler: fix trac issue #9817 (7ca5bb0)

[git at git.haskell.org]

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

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/7ca5bb090ff78141fbe275b058a9e35ee496bd58/ghc

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

commit 7ca5bb090ff78141fbe275b058a9e35ee496bd58
Author: Marios Titas <geopoul at gmail.com>
Date:   Wed Dec 10 04:17:22 2014 -0600

    compiler: fix trac issue #9817
    
    Summary:
    When we call runHandlers, we must pass it a ForeignPtr. To ensure that
    this happens, we introduce a wrapper that receives a plain Ptr and
    converts it into a ForeignPtr. Then we adjust startSignalHandlers in
    rts/posix/Signals.c to call the wrapper instead of calling runHandlers
    directly.
    
    Reviewers: hvr, austin, rwbarton, simonmar
    
    Reviewed By: austin, simonmar
    
    Subscribers: simonmar, thomie, carter
    
    Differential Revision: https://phabricator.haskell.org/D515
    
    GHC Trac Issues: #9817


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

7ca5bb090ff78141fbe275b058a9e35ee496bd58
 libraries/base/GHC/Conc/Signal.hs | 11 ++++++++++-
 rts/Prelude.h                     |  4 ++--
 rts/RtsStartup.c                  |  2 +-
 rts/package.conf.in               |  4 ++--
 rts/posix/Signals.c               |  2 +-
 5 files changed, 16 insertions(+), 7 deletions(-)

diff --git a/libraries/base/GHC/Conc/Signal.hs b/libraries/base/GHC/Conc/Signal.hs
index 3f5eacb..4afccf2 100644
--- a/libraries/base/GHC/Conc/Signal.hs
+++ b/libraries/base/GHC/Conc/Signal.hs
@@ -6,15 +6,17 @@ module GHC.Conc.Signal
         , HandlerFun
         , setHandler
         , runHandlers
+        , runHandlersPtr
         ) where
 
 import Control.Concurrent.MVar (MVar, newMVar, withMVar)
 import Data.Dynamic (Dynamic)
 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)
@@ -70,6 +72,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
diff --git a/rts/Prelude.h b/rts/Prelude.h
index 614c255..ae1e9cb 100644
--- a/rts/Prelude.h
+++ b/rts/Prelude.h
@@ -48,7 +48,7 @@ PRELUDE_CLOSURE(base_GHCziEventziThread_blockedOnBadFD_closure);
 PRELUDE_CLOSURE(base_GHCziConcziSync_runSparks_closure);
 PRELUDE_CLOSURE(base_GHCziConcziIO_ensureIOManagerIsRunning_closure);
 PRELUDE_CLOSURE(base_GHCziConcziIO_ioManagerCapabilitiesChanged_closure);
-PRELUDE_CLOSURE(base_GHCziConcziSignal_runHandlers_closure);
+PRELUDE_CLOSURE(base_GHCziConcziSignal_runHandlersPtr_closure);
 
 PRELUDE_CLOSURE(base_GHCziTopHandler_flushStdHandles_closure);
 
@@ -96,7 +96,7 @@ PRELUDE_INFO(base_GHCziStable_StablePtr_con_info);
 #define runSparks_closure         DLL_IMPORT_DATA_REF(base_GHCziConcziSync_runSparks_closure)
 #define ensureIOManagerIsRunning_closure DLL_IMPORT_DATA_REF(base_GHCziConcziIO_ensureIOManagerIsRunning_closure)
 #define ioManagerCapabilitiesChanged_closure DLL_IMPORT_DATA_REF(base_GHCziConcziIO_ioManagerCapabilitiesChanged_closure)
-#define runHandlers_closure       DLL_IMPORT_DATA_REF(base_GHCziConcziSignal_runHandlers_closure)
+#define runHandlersPtr_closure       DLL_IMPORT_DATA_REF(base_GHCziConcziSignal_runHandlersPtr_closure)
 
 #define flushStdHandles_closure   DLL_IMPORT_DATA_REF(base_GHCziTopHandler_flushStdHandles_closure)
 
diff --git a/rts/RtsStartup.c b/rts/RtsStartup.c
index 490f2ea..1900882 100644
--- a/rts/RtsStartup.c
+++ b/rts/RtsStartup.c
@@ -223,7 +223,7 @@ hs_init_ghc(int *argc, char **argv[], RtsConfig rts_config)
     getStablePtr((StgPtr)ioManagerCapabilitiesChanged_closure);
 #ifndef mingw32_HOST_OS
     getStablePtr((StgPtr)blockedOnBadFD_closure);
-    getStablePtr((StgPtr)runHandlers_closure);
+    getStablePtr((StgPtr)runHandlersPtr_closure);
 #endif
 
     /* initialise the shared Typeable store */
diff --git a/rts/package.conf.in b/rts/package.conf.in
index ce44a09..2670fae 100644
--- a/rts/package.conf.in
+++ b/rts/package.conf.in
@@ -109,7 +109,7 @@ ld-options:
          , "-Wl,-u,_base_GHCziConcziIO_ensureIOManagerIsRunning_closure"
          , "-Wl,-u,_base_GHCziConcziIO_ioManagerCapabilitiesChanged_closure"
          , "-Wl,-u,_base_GHCziConcziSync_runSparks_closure"
-         , "-Wl,-u,_base_GHCziConcziSignal_runHandlers_closure"
+         , "-Wl,-u,_base_GHCziConcziSignal_runHandlersPtr_closure"
 #else
            "-Wl,-u,ghczmprim_GHCziTypes_Izh_static_info"
          , "-Wl,-u,ghczmprim_GHCziTypes_Czh_static_info"
@@ -151,7 +151,7 @@ ld-options:
          , "-Wl,-u,base_GHCziConcziIO_ensureIOManagerIsRunning_closure"
          , "-Wl,-u,base_GHCziConcziIO_ioManagerCapabilitiesChanged_closure"
          , "-Wl,-u,base_GHCziConcziSync_runSparks_closure"
-         , "-Wl,-u,base_GHCziConcziSignal_runHandlers_closure"
+         , "-Wl,-u,base_GHCziConcziSignal_runHandlersPtr_closure"
 #endif
 
 /*  Pick up static libraries in preference over dynamic if in earlier search
diff --git a/rts/posix/Signals.c b/rts/posix/Signals.c
index 36a72a5..44bd0b6 100644
--- a/rts/posix/Signals.c
+++ b/rts/posix/Signals.c
@@ -473,7 +473,7 @@ startSignalHandlers(Capability *cap)
           RtsFlags.GcFlags.initialStkSize,
               rts_apply(cap,
                   rts_apply(cap,
-                      &base_GHCziConcziSignal_runHandlers_closure,
+                      &base_GHCziConcziSignal_runHandlersPtr_closure,
                       rts_mkPtr(cap, info)),
                   rts_mkInt(cap, info->si_signo))));
   }