Commit 7ca5bb09 authored by Marios Titas's avatar Marios Titas Committed by Austin Seipp

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
parent 4d1c452d
......@@ -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
......
......@@ -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)
......
......@@ -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 */
......
......@@ -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
......
......@@ -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))));
}
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment