@@ -3,6 +3,7 @@ module Stg.Interpreter.Debugger.Region where
33
44import Text.Printf
55import Control.Monad.State
6+ import Data.Maybe
67import qualified Data.List as List
78import qualified Data.Set as Set
89import qualified Data.Map as Map
@@ -18,6 +19,14 @@ import Stg.Syntax
1819import qualified Stg.Interpreter.GC as GC
1920import qualified Stg.Interpreter.GC.GCRef as GC
2021
22+ evalRegionCommand :: String -> M ()
23+ evalRegionCommand cmd = do
24+ tid <- gets ssCurrentThreadId
25+ case words cmd of
26+ [" estgi.debug.region.start" -> startRegion tid . EventRegion $ BS8. pack name
27+ [" estgi.debug.region.end" -> endRegion tid . EventRegion $ BS8. pack name
28+ _ -> pure ()
29+
2130dumpHeapObject :: Int -> HeapObject -> String
2231dumpHeapObject i o = printf " %-8d %3s %s" GC. ppLNE o) (debugPrintHeapObject o)
2332
@@ -49,15 +58,15 @@ getRegionHeap start end = do
4958
5059showRegion :: Bool -> String -> String -> M ()
5160showRegion doHeapDump start end = do
52- regions <- gets ssRegions
53- let r = Region (BS8. pack start) (BS8. pack end)
61+ instances <- gets ssRegionInstances
62+ let r = IRRegion (BS8. pack start) (BS8. pack end)
5463 printDelimiter = when doHeapDump $ liftIO $ putStrLn " \n ==============================================================================\n "
55- case Map. lookup r regions of
64+ case Map. lookup r instances of
5665 Nothing -> pure ()
57- Just (cur, _curCallGraph, l) -> do
58- liftIO $ putStrLn $ " region data count: " ++ show (length l)
66+ Just l -> do
67+ liftIO $ putStrLn $ " region data count: " ++ show (IntMap. size l)
5968 liftIO $ putStrLn $ " order: OLD -> NEW"
60- forM_ (reverse l) $ \ (s, e) -> do
69+ forM_ (IntMap. elems l) $ \ (s, e) -> do
6170 printDelimiter
6271 let sAddr = asNextHeapAddr s
6372 eAddr = asNextHeapAddr e
@@ -71,23 +80,21 @@ showRegion doHeapDump start end = do
7180
7281addRegion :: String -> String -> M ()
7382addRegion start end = do
74- regions <- gets ssRegions
83+ regions <- gets ssRegionCounter
7584 let s = BS8. pack start
7685 e = BS8. pack end
77- r = Region s e
86+ r = IRRegion s e
7887 unless (Map. member r regions) $ do
79- modify $ \ s@ StgState {.. } -> s {ssRegions = Map. insert r (Nothing , emptyCallGraph, [] ) ssRegions}
8088 addMarker s r
8189 addMarker e r
8290
8391delRegion :: String -> String -> M ()
8492delRegion start end = do
85- regions <- gets ssRegions
93+ regions <- gets ssRegionCounter
8694 let s = BS8. pack start
8795 e = BS8. pack end
88- r = Region s e
96+ r = IRRegion s e
8997 when (Map. member r regions) $ do
90- modify $ \ s@ StgState {.. } -> s {ssRegions = Map. delete r ssRegions}
9198 delMarker s r
9299 delMarker e r
93100
@@ -102,34 +109,41 @@ delMarker m r = do
102109
103110checkRegion :: Name -> M ()
104111checkRegion markerName = do
112+ tid <- gets ssCurrentThreadId
105113 markers <- gets ssMarkers
106114 case Map. lookup markerName markers of
107115 Nothing -> pure ()
108116 Just rl -> do
109- forM_ rl $ \ r@ (Region s e) -> case r of
110- _ | markerName == s && markerName == e -> startEndRegion r
111- _ | markerName == s -> startRegion r
112- _ | markerName == e -> endRegion r
113-
114- startRegion :: Region -> M ()
115- startRegion r = do
116- a <- getAddressState
117- let start (Nothing , _, l) = (Just a, emptyCallGraph, l)
118- start x = x -- HINT: multiple start is allowed to support more flexible debugging
119- modify $ \ s@ StgState {.. } -> s {ssRegions = Map. adjust start r ssRegions}
120-
121- endRegion :: Region -> M ()
122- endRegion r = do
123- exportRegionCallGraph r
124- a <- getAddressState
125- let end (Just s, _, l) = (Nothing , emptyCallGraph, (s, a) : l)
126- end x = x -- HINT: if the region was not started then there is nothing to do
127- modify $ \ s@ StgState {.. } -> s {ssRegions = Map. adjust end r ssRegions}
128-
129- startEndRegion :: Region -> M ()
130- startEndRegion r = do
131- exportRegionCallGraph r
132- a <- getAddressState
133- let fun (Nothing , _, l) = (Just a, emptyCallGraph, l)
134- fun (Just s, _, l) = (Just a, emptyCallGraph, (s, a) : l)
135- modify $ \ s@ StgState {.. } -> s {ssRegions = Map. adjust fun r ssRegions}
117+ forM_ rl $ \ r@ (IRRegion s e) -> case r of
118+ _ | markerName == s && markerName == e -> endRegion tid r >> startRegion tid r
119+ _ | markerName == s -> startRegion tid r
120+ _ | markerName == e -> endRegion tid r
121+
122+ nextRegionIndex :: Region -> M Int
123+ nextRegionIndex r = do
124+ idx <- fromMaybe 0 <$> gets (Map. lookup r . ssRegionCounter)
125+ modify' $ \ s@ StgState {.. } -> s {ssRegionCounter = Map. insert r (succ idx) ssRegionCounter}
126+ pure idx
127+
128+ startRegion :: Int -> Region -> M ()
129+ startRegion threadId r = do
130+ idx <- nextRegionIndex r
131+ startAddr <- getAddressState
132+ modify $ \ s@ StgState {.. } -> s {ssRegionStack = Map. insertWith (++) (threadId, r) [(idx, startAddr, emptyCallGraph)] ssRegionStack}
133+
134+ endRegion :: Int -> Region -> M ()
135+ endRegion threadId r = do
136+ -- pop region
137+ gets (Map. lookup (threadId, r) . ssRegionStack) >>= \ case
138+ Just ((idx, startAddr, callGraph) : stackTail) -> do
139+ exportRegionCallGraph idx r callGraph
140+ endAddr <- getAddressState
141+ modify $ \ s@ StgState {.. } -> s { ssRegionInstances = Map. insertWith IntMap. union r (IntMap. singleton idx (startAddr, endAddr)) ssRegionInstances }
142+ case stackTail of
143+ [] -> do
144+ -- HINT: keep ssRegionStack small, to make call graph update fast
145+ modify $ \ s@ StgState {.. } -> s { ssRegionStack = Map. delete (threadId, r) ssRegionStack }
146+ (o, a, cg) : l -> do
147+ let mergedStackTail = (o, a, joinCallGraph cg callGraph) : l -- HINT: merge callgraphs for nested regions
148+ modify $ \ s@ StgState {.. } -> s { ssRegionStack = Map. insert (threadId, r) mergedStackTail ssRegionStack}
149+ _ -> pure ()
0 commit comments