diff options
Diffstat (limited to 'libraries/ghci/GHCi/Run.hs')
| -rw-r--r-- | libraries/ghci/GHCi/Run.hs | 26 |
1 files changed, 23 insertions, 3 deletions
diff --git a/libraries/ghci/GHCi/Run.hs b/libraries/ghci/GHCi/Run.hs index fc142a2043..8934437a10 100644 --- a/libraries/ghci/GHCi/Run.hs +++ b/libraries/ghci/GHCi/Run.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE GADTs, RecordWildCards, MagicHash, ScopedTypeVariables #-} +{-# LANGUAGE GADTs, RecordWildCards, MagicHash, ScopedTypeVariables, CPP #-} {-# OPTIONS_GHC -fno-warn-name-shadowing #-} -- | @@ -24,6 +24,7 @@ import Control.Monad import Data.ByteString (ByteString) import qualified Data.ByteString.Unsafe as B import GHC.Exts +import GHC.Stack import Foreign import Foreign.C import GHC.Conc.Sync @@ -56,6 +57,9 @@ run m = case m of EvalString r -> evalString r EvalStringToString r s -> evalStringToString r s EvalIO r -> evalIO r + MkCostCentre name mod src -> + toRemotePtr <$> mkCostCentre (fromRemotePtr name) mod src + CostCentreStackInfo ptr -> ccsToStrings (fromRemotePtr ptr) MallocData bs -> mkString bs PrepFFI conv args res -> toRemotePtr <$> prepForeignCall conv args res FreeFFI p -> freeForeignCallInfo (fromRemotePtr p) @@ -112,7 +116,7 @@ sandboxIO opts io = do breakMVar <- newEmptyMVar statusMVar <- newEmptyMVar withBreakAction opts breakMVar statusMVar $ do - let runIt = measureAlloc $ tryEval $ rethrow opts io + let runIt = measureAlloc $ tryEval $ rethrow opts $ clearCCS io if useSandboxThread opts then do tid <- forkIO $ do unsafeUnmask runIt >>= putMVar statusMVar @@ -237,7 +241,8 @@ withBreakAction opts breakMVar statusMVar act resume_r <- mkHValueRef (unsafeCoerce resume) apStack_r <- mkHValueRef apStack info_r <- mkHValueRef info - putMVar statusMVar (EvalBreak is_exception apStack_r info_r resume_r) + ccs <- toRemotePtr <$> getCCSOf apStack + putMVar statusMVar $ EvalBreak is_exception apStack_r info_r resume_r ccs takeMVar breakMVar resetBreakAction stablePtr = do @@ -305,3 +310,18 @@ mkString bs = B.unsafeUseAsCStringLen bs $ \(cstr,len) -> do ptr <- mallocBytes len copyBytes ptr cstr len return (toRemotePtr ptr) + +data CCostCentre + +mkCostCentre :: Ptr CChar -> String -> String -> IO (Ptr CCostCentre) +#if defined(PROFILING) +mkCostCentre c_module srcspan decl_path = do + c_name <- newCString decl_path + c_srcspan <- newCString srcspan + c_mkCostCentre c_name c_module c_srcspan + +foreign import ccall unsafe "mkCostCentre" + c_mkCostCentre :: Ptr CChar -> Ptr CChar -> Ptr CChar -> IO (Ptr CCostCentre) +#else +mkCostCentre _ _ _ = return nullPtr +#endif |