diff options
| author | David Eichmann <EichmannD@gmail.com> | 2020-11-09 19:58:37 +0000 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2020-11-28 15:41:37 -0500 |
| commit | 625726f988852f5779825a954609d187d9865dc1 (patch) | |
| tree | 2a871fce2ebd45d445e99914139155a068da995f /libraries/ghci | |
| parent | 698d3d9648e9cb6b3757269e21ce4fa1692a1a3b (diff) | |
| download | haskell-625726f988852f5779825a954609d187d9865dc1.tar.gz | |
ghc-heap: partial TSO/STACK decoding
Co-authored-by: Sven Tennie <sven.tennie@gmail.com>
Co-authored-by: Matthew Pickering <matthewtpickering@gmail.com>
Co-authored-by: Ben Gamari <bgamari.foss@gmail.com>
Diffstat (limited to 'libraries/ghci')
| -rw-r--r-- | libraries/ghci/GHCi/Message.hs | 27 | ||||
| -rw-r--r-- | libraries/ghci/GHCi/Run.hs | 6 |
2 files changed, 22 insertions, 11 deletions
diff --git a/libraries/ghci/GHCi/Message.hs b/libraries/ghci/GHCi/Message.hs index ad94776a9f..d21686a326 100644 --- a/libraries/ghci/GHCi/Message.hs +++ b/libraries/ghci/GHCi/Message.hs @@ -1,5 +1,6 @@ {-# LANGUAGE GADTs, DeriveGeneric, StandaloneDeriving, ScopedTypeVariables, - GeneralizedNewtypeDeriving, ExistentialQuantification, RecordWildCards #-} + GeneralizedNewtypeDeriving, ExistentialQuantification, RecordWildCards, + CPP #-} {-# OPTIONS_GHC -fno-warn-name-shadowing -fno-warn-orphans #-} -- | @@ -29,7 +30,7 @@ import GHCi.TH.Binary () -- For Binary instances import GHCi.BreakArray import GHC.LanguageExtensions -import GHC.Exts.Heap +import qualified GHC.Exts.Heap as Heap import GHC.ForeignSrcLang import GHC.Fingerprint import Control.Concurrent @@ -110,7 +111,7 @@ data Message a where -> Int -- constr tag -> Int -- pointer tag -> ByteString -- constructor desccription - -> Message (RemotePtr StgInfoTable) + -> Message (RemotePtr Heap.StgInfoTable) -- | Evaluate a statement EvalStmt @@ -211,7 +212,7 @@ data Message a where -- type reconstruction. GetClosure :: HValueRef - -> Message (GenClosure HValueRef) + -> Message (Heap.GenClosure HValueRef) -- | Evaluate something. This is used to support :force in GHCi. Seq @@ -449,10 +450,20 @@ instance Binary (FunPtr a) where get = castPtrToFunPtr <$> get -- Binary instances to support the GetClosure message -instance Binary StgInfoTable -instance Binary ClosureType -instance Binary PrimType -instance Binary a => Binary (GenClosure a) +#if MIN_VERSION_ghc_heap(8,11,0) +instance Binary Heap.StgTSOProfInfo +instance Binary Heap.CostCentreStack +instance Binary Heap.CostCentre +instance Binary Heap.IndexTable +instance Binary Heap.WhatNext +instance Binary Heap.WhyBlocked +instance Binary Heap.TsoFlags +#endif + +instance Binary Heap.StgInfoTable +instance Binary Heap.ClosureType +instance Binary Heap.PrimType +instance Binary a => Binary (Heap.GenClosure a) data Msg = forall a . (Binary a, Show a) => Msg (Message a) diff --git a/libraries/ghci/GHCi/Run.hs b/libraries/ghci/GHCi/Run.hs index 0a99845966..858c312b34 100644 --- a/libraries/ghci/GHCi/Run.hs +++ b/libraries/ghci/GHCi/Run.hs @@ -32,7 +32,7 @@ import Data.Binary.Get import Data.ByteString (ByteString) import qualified Data.ByteString.Unsafe as B import GHC.Exts -import GHC.Exts.Heap +import qualified GHC.Exts.Heap as Heap import GHC.Stack import Foreign hiding (void) import Foreign.C @@ -93,8 +93,8 @@ run m = case m of toRemotePtr <$> mkConInfoTable tc ptrs nptrs tag ptrtag desc StartTH -> startTH GetClosure ref -> do - clos <- getClosureData =<< localRef ref - mapM (\(Box x) -> mkRemoteRef (HValue x)) clos + clos <- Heap.getClosureData =<< localRef ref + mapM (\(Heap.Box x) -> mkRemoteRef (HValue x)) clos Seq ref -> doSeq ref ResumeSeq ref -> resumeSeq ref _other -> error "GHCi.Run.run" |