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

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 ...@@ -6,15 +6,17 @@ module GHC.Conc.Signal
, HandlerFun , HandlerFun
, setHandler , setHandler
, runHandlers , runHandlers
, runHandlersPtr
) where ) where
import Control.Concurrent.MVar (MVar, newMVar, withMVar) import Control.Concurrent.MVar (MVar, newMVar, withMVar)
import Data.Dynamic (Dynamic) import Data.Dynamic (Dynamic)
import Foreign.C.Types (CInt) import Foreign.C.Types (CInt)
import Foreign.ForeignPtr (ForeignPtr) import Foreign.ForeignPtr (ForeignPtr, newForeignPtr)
import Foreign.StablePtr (castPtrToStablePtr, castStablePtrToPtr, import Foreign.StablePtr (castPtrToStablePtr, castStablePtrToPtr,
deRefStablePtr, freeStablePtr, newStablePtr) deRefStablePtr, freeStablePtr, newStablePtr)
import Foreign.Ptr (Ptr, castPtr) import Foreign.Ptr (Ptr, castPtr)
import Foreign.Marshal.Alloc (finalizerFree)
import GHC.Arr (inRange) import GHC.Arr (inRange)
import GHC.Base import GHC.Base
import GHC.Conc.Sync (forkIO) import GHC.Conc.Sync (forkIO)
...@@ -70,6 +72,13 @@ runHandlers p_info sig = do ...@@ -70,6 +72,13 @@ runHandlers p_info sig = do
Just (f,_) -> do _ <- forkIO (f p_info) Just (f,_) -> do _ <- forkIO (f p_info)
return () 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 -- 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 -- 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 -- it is when base is dynamically loaded into GHCi. The RTS keeps
......
...@@ -48,7 +48,7 @@ PRELUDE_CLOSURE(base_GHCziEventziThread_blockedOnBadFD_closure); ...@@ -48,7 +48,7 @@ PRELUDE_CLOSURE(base_GHCziEventziThread_blockedOnBadFD_closure);
PRELUDE_CLOSURE(base_GHCziConcziSync_runSparks_closure); PRELUDE_CLOSURE(base_GHCziConcziSync_runSparks_closure);
PRELUDE_CLOSURE(base_GHCziConcziIO_ensureIOManagerIsRunning_closure); PRELUDE_CLOSURE(base_GHCziConcziIO_ensureIOManagerIsRunning_closure);
PRELUDE_CLOSURE(base_GHCziConcziIO_ioManagerCapabilitiesChanged_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); PRELUDE_CLOSURE(base_GHCziTopHandler_flushStdHandles_closure);
...@@ -96,7 +96,7 @@ PRELUDE_INFO(base_GHCziStable_StablePtr_con_info); ...@@ -96,7 +96,7 @@ PRELUDE_INFO(base_GHCziStable_StablePtr_con_info);
#define runSparks_closure DLL_IMPORT_DATA_REF(base_GHCziConcziSync_runSparks_closure) #define runSparks_closure DLL_IMPORT_DATA_REF(base_GHCziConcziSync_runSparks_closure)
#define ensureIOManagerIsRunning_closure DLL_IMPORT_DATA_REF(base_GHCziConcziIO_ensureIOManagerIsRunning_closure) #define ensureIOManagerIsRunning_closure DLL_IMPORT_DATA_REF(base_GHCziConcziIO_ensureIOManagerIsRunning_closure)
#define ioManagerCapabilitiesChanged_closure DLL_IMPORT_DATA_REF(base_GHCziConcziIO_ioManagerCapabilitiesChanged_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) #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) ...@@ -223,7 +223,7 @@ hs_init_ghc(int *argc, char **argv[], RtsConfig rts_config)
getStablePtr((StgPtr)ioManagerCapabilitiesChanged_closure); getStablePtr((StgPtr)ioManagerCapabilitiesChanged_closure);
#ifndef mingw32_HOST_OS #ifndef mingw32_HOST_OS
getStablePtr((StgPtr)blockedOnBadFD_closure); getStablePtr((StgPtr)blockedOnBadFD_closure);
getStablePtr((StgPtr)runHandlers_closure); getStablePtr((StgPtr)runHandlersPtr_closure);
#endif #endif
/* initialise the shared Typeable store */ /* initialise the shared Typeable store */
......
...@@ -109,7 +109,7 @@ ld-options: ...@@ -109,7 +109,7 @@ ld-options:
, "-Wl,-u,_base_GHCziConcziIO_ensureIOManagerIsRunning_closure" , "-Wl,-u,_base_GHCziConcziIO_ensureIOManagerIsRunning_closure"
, "-Wl,-u,_base_GHCziConcziIO_ioManagerCapabilitiesChanged_closure" , "-Wl,-u,_base_GHCziConcziIO_ioManagerCapabilitiesChanged_closure"
, "-Wl,-u,_base_GHCziConcziSync_runSparks_closure" , "-Wl,-u,_base_GHCziConcziSync_runSparks_closure"
, "-Wl,-u,_base_GHCziConcziSignal_runHandlers_closure" , "-Wl,-u,_base_GHCziConcziSignal_runHandlersPtr_closure"
#else #else
"-Wl,-u,ghczmprim_GHCziTypes_Izh_static_info" "-Wl,-u,ghczmprim_GHCziTypes_Izh_static_info"
, "-Wl,-u,ghczmprim_GHCziTypes_Czh_static_info" , "-Wl,-u,ghczmprim_GHCziTypes_Czh_static_info"
...@@ -151,7 +151,7 @@ ld-options: ...@@ -151,7 +151,7 @@ ld-options:
, "-Wl,-u,base_GHCziConcziIO_ensureIOManagerIsRunning_closure" , "-Wl,-u,base_GHCziConcziIO_ensureIOManagerIsRunning_closure"
, "-Wl,-u,base_GHCziConcziIO_ioManagerCapabilitiesChanged_closure" , "-Wl,-u,base_GHCziConcziIO_ioManagerCapabilitiesChanged_closure"
, "-Wl,-u,base_GHCziConcziSync_runSparks_closure" , "-Wl,-u,base_GHCziConcziSync_runSparks_closure"
, "-Wl,-u,base_GHCziConcziSignal_runHandlers_closure" , "-Wl,-u,base_GHCziConcziSignal_runHandlersPtr_closure"
#endif #endif
/* Pick up static libraries in preference over dynamic if in earlier search /* Pick up static libraries in preference over dynamic if in earlier search
......
...@@ -473,7 +473,7 @@ startSignalHandlers(Capability *cap) ...@@ -473,7 +473,7 @@ startSignalHandlers(Capability *cap)
RtsFlags.GcFlags.initialStkSize, RtsFlags.GcFlags.initialStkSize,
rts_apply(cap, rts_apply(cap,
rts_apply(cap, rts_apply(cap,
&base_GHCziConcziSignal_runHandlers_closure, &base_GHCziConcziSignal_runHandlersPtr_closure,
rts_mkPtr(cap, info)), rts_mkPtr(cap, info)),
rts_mkInt(cap, info->si_signo)))); 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