diff options
| -rw-r--r-- | libraries/base/GHC/Conc/Signal.hs | 11 | ||||
| -rw-r--r-- | rts/Prelude.h | 4 | ||||
| -rw-r--r-- | rts/RtsStartup.c | 2 | ||||
| -rw-r--r-- | rts/package.conf.in | 4 | ||||
| -rw-r--r-- | 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 3f5eacb572..4afccf2496 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 614c255af5..ae1e9cb266 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 490f2ead38..190088274e 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 ce44a09651..2670faeb57 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 36a72a5c8e..44bd0b6d9c 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)))); } |