{-# LANGUAGE Trustworthy #-}{-# LANGUAGE NoImplicitPrelude #-}moduleGHC.Conc.Signal(Signal ,HandlerFun ,setHandler ,runHandlers ,runHandlersPtr )whereimportControl.Concurrent.MVar (MVar ,newMVar ,withMVar )importData.Dynamic (Dynamic )importForeign.C.Types (CInt )importForeign.ForeignPtr (ForeignPtr ,newForeignPtr )importForeign.StablePtr (castPtrToStablePtr ,castStablePtrToPtr ,deRefStablePtr ,freeStablePtr ,newStablePtr )importForeign.Ptr (Ptr ,castPtr )importForeign.Marshal.Alloc (finalizerFree )importGHC.Arr (inRange )importGHC.Base importGHC.Conc.Sync (forkIO )importGHC.IO (mask_ ,unsafePerformIO )importGHC.IOArray (IOArray ,boundsIOArray ,newIOArray ,unsafeReadIOArray ,unsafeWriteIOArray )importGHC.Real (fromIntegral )importGHC.Word (Word8 )-------------------------------------------------------------------------- Signal handlingtypeSignal =CInt maxSig::IntmaxSig =64typeHandlerFun =ForeignPtr Word8 ->IO()-- Lock used to protect concurrent access to signal_handlers. Symptom-- of this race condition is GHC bug #1922, although that bug was on-- Windows a similar bug also exists on Unix.signal_handlers::MVar (IOArray Int(Maybe (HandlerFun ,Dynamic )))signal_handlers =unsafePerformIO $ doarr <-newIOArray (0,maxSig )Nothing m <-newMVar arr sharedCAF m getOrSetGHCConcSignalSignalHandlerStore {-# NOINLINEsignal_handlers#-}foreignimportccallunsafe"getOrSetGHCConcSignalSignalHandlerStore"getOrSetGHCConcSignalSignalHandlerStore::Ptr a ->IO(Ptr a )setHandler::Signal ->Maybe (HandlerFun ,Dynamic )->IO(Maybe (HandlerFun ,Dynamic ))setHandler sig handler =doletint =fromIntegral sig withMVar signal_handlers $ \arr ->ifnot(inRange (boundsIOArray arr )int )thenerrorWithoutStackTrace "GHC.Conc.setHandler: signal out of range"elsedoold <-unsafeReadIOArray arr int unsafeWriteIOArray arr int handler return old runHandlers::ForeignPtr Word8 ->Signal ->IO()runHandlers p_info sig =doletint =fromIntegral sig withMVar signal_handlers $ \arr ->ifnot(inRange (boundsIOArray arr )int )thenreturn ()elsedohandler <-unsafeReadIOArray arr int casehandler ofNothing ->return ()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 =dofp <-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-- track of the single true value of the CAF, so even when the CAFs in-- the dynamically-loaded base package are reverted, nothing bad-- happens.--sharedCAF::a ->(Ptr a ->IO(Ptr a ))->IOa sharedCAF a get_or_set =mask_ $ dostable_ref <-newStablePtr a letref =castPtr (castStablePtrToPtr stable_ref )ref2 <-get_or_set ref ifref ==ref2 thenreturn a elsedofreeStablePtr stable_ref deRefStablePtr (castPtrToStablePtr (castPtr ref2 ))