ghc-debug-common 0.2.1.0 → 0.3.0.0

raw patch · 8 files changed

+110/−14 lines, 8 filesdep ~ghc-debug-conventionPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: ghc-debug-convention

API changes (from Hackage documentation)

Files

• CHANGELOG.md +6/−0
• ghc-debug-common.cabal +4/−3
• src/GHC/Debug/Decode.hs +69/−3
• src/GHC/Debug/Decode/Convert.hs +7/−1
• src/GHC/Debug/Types.hs +4/−2
• src/GHC/Debug/Types/Closures.hs +5/−4
• src/GHC/Debug/Types/Ptr.hs +8/−1
• src/GHC/Debug/Types/Version.hs +7/−0

@@ -1,5 +1,11 @@ # Revision history for ghc-debug-common +## 0.3.0.0 -- 2022-10-06++* Support changes to TSO decoding on GHC HEAD+* Improvements to ARR_WORDS decoding+* Improvements to WeakPtr decoding.+ ## 0.2.1.0 -- 2022-05-06  * Internal refactoring to give better error message on decoding failure

@@ -1,6 +1,6 @@ cabal-version:       3.0 name:                ghc-debug-common-version:             0.2.1.0+version:             0.3.0.0 synopsis:            Connect to a socket created by ghc-debug-stub and analyse                      the heap of the debuggee program. description:         Connect to a socket created by ghc-debug-stub and analyse@@ -23,7 +23,8 @@                        GHC.Debug.Types.Closures,                        GHC.Debug.Types.Graph,                        GHC.Debug.Utils,-                       GHC.Debug.Types.Ptr+                       GHC.Debug.Types.Ptr,+                       GHC.Debug.Types.Version   build-depends:       base >=4.16 && < 5,                        bytestring ^>=0.11,                        binary ^>=0.8,@@ -37,7 +38,7 @@                        transformers ^>= 0.5,                        dom-lt ^>= 0.2,                        unordered-containers ^>= 0.2,-                       ghc-debug-convention == 0.2.0.0,+                       ghc-debug-convention == 0.3.0.0,                        deepseq ^>= 1.4    hs-source-dirs:      src

@@ -5,6 +5,8 @@ {-# LANGUAGE UnliftedFFITypes #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE TypeApplications #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-} -- | Low-level functions for decoding a closure representation from the raw -- bytes module GHC.Debug.Decode ( decodeClosure@@ -27,6 +29,7 @@ import qualified GHC.Exts.Heap.InfoTableProf as ItblProf  import GHC.Debug.Types.Ptr+import GHC.Debug.Types.Version import GHC.Debug.Types.Closures import GHC.Debug.Decode.Convert import Foreign.Marshal.Alloc    (allocaBytes)@@ -36,6 +39,7 @@ import Control.Monad import Data.Void import Control.DeepSeq+import GHC.Exts.Heap.FFIClosures  import qualified Data.ByteString as B @@ -216,18 +220,73 @@   cwords <- replicateM (fromIntegral (nptrs (decodedTable infot))) getWord   return $ k pts (map fromIntegral cwords) -decodeClosure :: (StgInfoTableWithPtr, RawInfoTable) -> (ClosurePtr, RawClosure) ->  SizedClosure-decodeClosure i@(itb, _) c+decodeArrWords :: (StgInfoTableWithPtr, b)+               -> (a, RawClosure) -> DebugClosureWithExtra Size pap string s b1+decodeArrWords  (infot, _) (_, rc) = decodeFromBS rc $ do+  _itbl <- skipClosureHeader+  bytes <- getWord64le+  payload <- replicateM (ceiling (fromIntegral bytes / 8)) getWord+  return $ GHC.Debug.Types.Closures.ArrWordsClosure infot (fromIntegral bytes) (map fromIntegral payload)++tsoVersionChanged :: Version+tsoVersionChanged = Version 905 20220925++decodeTSO :: Version+          -> (StgInfoTableWithPtr, RawInfoTable)+          -> (a, RawClosure)+          -> SizedClosure+decodeTSO ver it@(infot, _) c@(_, rc) = decodeFromBS rc $ do+  _itbl <- skipClosureHeader+  link <- getClosurePtr+  global_link <- getClosurePtr+  tsoStack <- getClosurePtr+  what_next <- parseWhatNext <$> getWord16le+  why_blocked <- parseWhyBlocked <$> getWord16le+  flags <- parseTsoFlags <$> getWord32le+  _block_info <- getClosurePtr+  threadId <- getWord64le+  saved_errno <- getWord32le+  dirty       <- getWord32le++  _bound       <- getClosurePtr+  _cap         <- getClosurePtr+  trec           <- getClosurePtr+  threadLabel <-+    if ver >= tsoVersionChanged+      then do+        thread_label <- getClosurePtr+        return $ if thread_label == mkClosurePtr 0 then Nothing else Just thread_label+      else return Nothing+  blocked_exceptions <- getClosurePtr+  bq             <- getClosurePtr+  alloc_limit    <- getInt64le+  tot_stack_size <- getWord32le+  let res :: Closure = (GHC.Debug.Types.Closures.TSOClosure+            { info = infot+            , _link = link+            , prof = Nothing+            , .. })+  return res++++++decodeClosure :: Version -> (StgInfoTableWithPtr, RawInfoTable) -> (ClosurePtr, RawClosure) -> SizedClosure+decodeClosure ver i@(itb, _) c   -- MP: It was far easier to implement the decoding of these closures in   -- ghc-heap using binary rather than patching GHC and going through that   -- dance. I think in the future it's better to do this for all the   -- closures... it's simpler and probably much faster.+--  | traceShow itb False = undefined+  | (StgInfoTable { tipe = ARR_WORDS }) <- decodedTable itb = decodeArrWords i c   | (StgInfoTable { tipe = PAP }) <- decodedTable itb = decodePAPClosure i c   | (StgInfoTable { tipe = AP }) <- decodedTable itb = decodeAPClosure i c   | (StgInfoTable { tipe = TVAR }) <- decodedTable itb = decodeTVarClosure i c   | (StgInfoTable { tipe = MUT_PRIM }) <- decodedTable itb = decodeMutPrim i c   | (StgInfoTable { tipe = TREC_CHUNK }) <- decodedTable itb = decodeTrecChunk i c   | (StgInfoTable { tipe = BLOCKING_QUEUE }) <- decodedTable itb = decodeBlockingQueue i c+  | (StgInfoTable { tipe = TSO }) <- decodedTable itb = decodeTSO ver i c   | (StgInfoTable { tipe = STACK }) <- decodedTable itb = decodeStack i c   | (StgInfoTable { tipe = AP_STACK }) <- decodedTable itb = decodeAPStack i c   | (StgInfoTable { tipe = ty }) <- decodedTable itb@@ -242,7 +301,14 @@   | (StgInfoTable { tipe = ty }) <- decodedTable itb   , THUNK <= ty && ty <= THUNK_0_2 =       decodeStandardLayout (() <$ getWord) (ThunkClosure itb) i c-decodeClosure (itb, RawInfoTable rit) (_, (RawClosure clos)) = unsafePerformIO $ do+decodeClosure _ rit rc =+  decodeWithLibrary rit rc+++decodeWithLibrary :: (StgInfoTableWithPtr, RawInfoTable)+                      -> (a, RawClosure)+                      -> SizedClosure+decodeWithLibrary (itb, RawInfoTable rit) (_, (RawClosure clos)) = unsafePerformIO $ do     allocate rit $ \itblPtr -> do       allocate clos $ \closPtr -> do         let ptr_to_itbl_ptr :: Ptr (Ptr StgInfoTable)

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {- Convert a GenClosure to a DebugClosure -} module GHC.Debug.Decode.Convert where @@ -27,7 +28,8 @@     GHC.MVarClosure _ a2 a3 a4         -> MVarClosure itb a2 a3 a4     GHC.MutVarClosure _ a2             -> MutVarClosure itb a2     GHC.BlockingQueueClosure _ a2 a3 a4 a5 -> BlockingQueueClosure itb a2 a3 a4 a5-    GHC.TSOClosure _ a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 -> TSOClosure itb a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16+ --   GHC.TSOClosure _ a2 a3 a4 a5 a6 a7 _ a8 a9 a10 a11 a12 a13 a14 a15 a16 -> TSOClosure itb a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16+    GHC.TSOClosure _ a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 -> TSOClosure itb a2 a3 a4 a5 a6 a7 Nothing a8 a9 a10 a11 a12 a13 a14 a15 a16 --    GHC.StackClosure _ a2 a3 a4 a5      -> StackClosure itb a2 a3 a4 (a2, (StackPtr a5)) {-     GHC.IntClosure a1 a2                -> IntClosure a1 a2@@ -40,10 +42,14 @@     -}     GHC.OtherClosure _ a2 a3           -> OtherClosure itb a2 a3     GHC.WeakClosure _ a2 a3 a4 a5 a6   ->+#if __GLASGOW_HASKELL__ >= 905+      let w_link = a6+#else       -- nullPtr check       let w_link = if a6 == 0                   then Nothing                   else Just a6+#endif       in WeakClosure itb a2 a3 a4 a5 w_link     GHC.UnsupportedClosure _           -> UnsupportedClosure itb     c -> error ("Unexpected closure type: " ++ show c)

@@ -22,6 +22,7 @@                       , CommandId(..)                       , SourceInformation(..)                       , ClosureType(..)+                      , Version(..)                        -- * Serialisation functions                       , getIPE@@ -47,6 +48,7 @@  import GHC.Debug.Types.Closures as T import GHC.Debug.Types.Ptr as T+import GHC.Debug.Types.Version import GHC.Debug.Utils import GHC.Exts.Heap.ClosureTypes import GHC.Debug.Decode@@ -71,7 +73,7 @@ -- | A request sent from the debugger to the debuggee parametrized on the result type. data Request a where     -- | Request protocol version-    RequestVersion :: Request Word32+    RequestVersion :: Request Version     -- | Pause the debuggee.     RequestPause :: ForkOrPause -> Request ()     -- | Resume the debuggee.@@ -333,7 +335,7 @@   getResponse :: Request a -> Get a-getResponse RequestVersion       = getWord32be+getResponse RequestVersion       = Version <$> get <*> get getResponse RequestPause {}      = get getResponse RequestResume        = get getResponse RequestRoots         = many get

@@ -91,7 +91,7 @@ type ConstrDescCont = InfoTablePtr  -- | Information needed to decode a PAP payload-data PayloadCont = PayloadCont ClosurePtr [Word64] deriving Show+data PayloadCont = PayloadCont ClosurePtr [Word64] deriving (Show, Eq)  type DebugClosureWithSize = DebugClosureWithExtra Size @@ -297,6 +297,7 @@       , trec :: !b       , blocked_exceptions :: !b       , bq :: !b+      , threadLabel :: !(Maybe b)       -- values       , what_next :: GHC.WhatNext       , why_blocked :: GHC.WhyBlocked@@ -377,7 +378,7 @@ -- | Information needed to decode a set of stack frames data StackCont = StackCont StackPtr -- Address of start of frames                            RawStack -- The raw frames-                           deriving Show+                           deriving (Show, Eq, Ord)  type StackFrames = GenStackFrames ClosurePtr newtype GenStackFrames b = GenStackFrames { getFrames :: [DebugStackFrame b] }@@ -473,8 +474,8 @@       MutVarClosure a1 b -> MutVarClosure a1 <$> g b       BlockingQueueClosure a1 b1 b2 b3 b4 ->         BlockingQueueClosure a1 <$> g b1 <*> g b2 <*> g b3 <*> g b4-      TSOClosure a1 b1 b2 b3 b4 b5 b6 a2 a3 a4 a5 a6 a7 a8 a9 a10 ->-        (\c1 c2 c3 c4 c5 c6 -> TSOClosure a1 c1 c2 c3 c4 c5 c6 a2 a3 a4 a5 a6 a7 a8 a9 a10) <$> g b1 <*> g b2 <*> g b3 <*> g b4 <*> g b5 <*> g b6+      TSOClosure a1 b1 b2 b3 b4 b5 b6 b7 a2 a3 a4 a5 a6 a7 a8 a9 a10 ->+        (\c1 c2 c3 c4 c5 c6 c7 -> TSOClosure a1 c1 c2 c3 c4 c5 c6 c7 a2 a3 a4 a5 a6 a7 a8 a9 a10) <$> g b1 <*> g b2 <*> g b3 <*> g b4 <*> g b5 <*> g b6 <*> traverse g b7       StackClosure a1 a2 a3 a4 a5 -> StackClosure a1 a2 a3 a4 <$> f a5       WeakClosure a1 a2 a3 a4 a5 a6 ->         WeakClosure a1 <$> g a2 <*> g a3 <*> g a4 <*> g a5 <*> traverse g a6

@@ -22,6 +22,7 @@                           -- * Closures                           , ClosurePtr(..,ClosurePtr)                           , mkClosurePtr+                          , readClosurePtr                           , RawClosure(..)                           , rawClosureSize                           , getInfoTblPtr@@ -79,7 +80,7 @@ import Data.Binary.Put import System.Endian -import Numeric (showHex)+import Numeric (showHex, readHex) import Data.Coerce import Data.Bits import GHC.Stack@@ -118,6 +119,12 @@  mkClosurePtr :: Word64 -> ClosurePtr mkClosurePtr = untagClosurePtr . UntaggedClosurePtr++readClosurePtr :: String -> Maybe ClosurePtr+readClosurePtr ('0':'x':s) = case readHex s of+                               [(res, "")] -> Just (mkClosurePtr res)+                               _ -> Nothing+readClosurePtr _ = Nothing  instance Binary ClosurePtr where   put (ClosurePtr p) = putWord64be (toBE64 p)

@@ -0,0 +1,7 @@+module GHC.Debug.Types.Version where++import Data.Word++data Version = Version { v_major :: Word32+                       , v_patch :: Word32+                       } deriving (Show, Ord, Eq)