Skip to content

Navigation Menu

Sign in
Appearance settings

Search code, repositories, users, issues, pull requests...

Provide feedback

We read every piece of feedback, and take your input very seriously.

Saved searches

Use saved searches to filter your results more quickly
Sign up
Appearance settings

Commit a4b0c92

Browse files
rework region design to support region stack tied to threads and event defined regions
1 parent 0724fbd commit a4b0c92

File tree

5 files changed

+102
-70
lines changed

5 files changed

+102
-70
lines changed

‎external-stg-interpreter/lib/Stg/Interpreter/Base.hs‎

Lines changed: 24 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -310,6 +310,9 @@ type Heap = IntMap HeapObject
310310
type Env = Map Id (StaticOrigin, Atom) -- NOTE: must contain only the defined local variables
311311
type Stack = [StackContinuation]
312312

313+
envToAtoms :: Env -> [Atom]
314+
envToAtoms = map snd . Map.elems
315+
313316
data StaticOrigin
314317
= SO_CloArg
315318
| SO_Let
@@ -410,6 +413,7 @@ data StgState
410413

411414
-- debug
412415
, ssIsQuiet :: Bool
416+
, ssLocalEnv :: [Atom]
413417
, ssCurrentClosureEnv :: Env
414418
, ssCurrentClosure :: Maybe Id
415419
, ssCurrentClosureAddr :: Int
@@ -437,7 +441,9 @@ data StgState
437441

438442
-- region tracker
439443
, ssMarkers :: !(Map Name (Set Region))
440-
, ssRegions :: !(Map Region (Maybe AddressState, CallGraph, [(AddressState, AddressState)]) )
444+
, ssRegionStack :: !(Map (Int, Region) [(Int, AddressState, CallGraph)]) -- HINT: key = threadId + region ; value = index + start + call-graph
445+
, ssRegionInstances :: !(Map Region (IntMap (AddressState, AddressState))) -- region => instance-index => start end
446+
, ssRegionCounter :: !(Map Region Int)
441447

442448
-- retainer db
443449
, ssReferenceMap :: !(Map GCSymbol (Set GCSymbol))
@@ -455,7 +461,7 @@ data StgState
455461

456462
-- tracing primops
457463
, ssTraceEvents :: ![(String, AddressState)]
458-
, ssTraceMarkers :: ![(String, AddressState)]
464+
, ssTraceMarkers :: ![(String, Int, AddressState)]
459465

460466
-- internal dev mode debug settings
461467
, ssDebugSettings :: DebugSettings
@@ -546,6 +552,7 @@ emptyStgState now isQuiet stateStore dl dbgChan dbgState tracingState debugSetti
546552

547553
-- debug
548554
, ssIsQuiet = isQuiet
555+
, ssLocalEnv = mempty
549556
, ssCurrentClosureEnv = mempty
550557
, ssCurrentClosure = Nothing
551558
, ssCurrentClosureAddr = -1
@@ -573,7 +580,9 @@ emptyStgState now isQuiet stateStore dl dbgChan dbgState tracingState debugSetti
573580

574581
-- region tracker
575582
, ssMarkers = mempty
576-
, ssRegions = mempty
583+
, ssRegionStack = mempty
584+
, ssRegionInstances = mempty
585+
, ssRegionCounter = mempty
577586

578587
-- retainer db
579588
, ssReferenceMap = mempty
@@ -935,22 +944,24 @@ addInterClosureCallGraphEdge :: StaticOrigin -> ProgramPoint -> ProgramPoint ->
935944
addInterClosureCallGraphEdge so from to = do
936945
let addEdge g@CallGraph{..} = g {cgInterClosureCallGraph = StrictMap.insertWith (+) (so, from, to) 1 cgInterClosureCallGraph}
937946
updateRegion = \case
938-
(a@Just{}, regionCallGraph, l) -> (a, addEdge regionCallGraph, l)
947+
-- HINT: collect edges for regions on stack top only, the call graph will be merged for nested regions at close
948+
(i, a, regionCallGraph) : l -> (i, a, addEdge regionCallGraph) : l
939949
r -> r
940950
modify' $ \s@StgState{..} -> s
941-
{ ssCallGraph = addEdge ssCallGraph
942-
, ssRegions = fmap updateRegion ssRegions
951+
{ ssCallGraph = addEdge ssCallGraph
952+
, ssRegionStack = fmap updateRegion ssRegionStack
943953
}
944954

945955
addIntraClosureCallGraphEdge :: ProgramPoint -> StaticOrigin -> ProgramPoint -> M ()
946956
addIntraClosureCallGraphEdge from so to = do
947957
let addEdge g@CallGraph{..} = g {cgIntraClosureCallGraph = StrictMap.insertWith (+) (from, so, to) 1 cgIntraClosureCallGraph}
948958
updateRegion = \case
949-
(a@Just{}, regionCallGraph, l) -> (a, addEdge regionCallGraph, l)
959+
-- HINT: collect edges for regions on stack top only, the call graph will be merged for nested regions at close
960+
(i, a, regionCallGraph) : l -> (i, a, addEdge regionCallGraph) : l
950961
r -> r
951962
modify' $ \s@StgState{..} -> s
952-
{ ssCallGraph = addEdge ssCallGraph
953-
, ssRegions = fmap updateRegion ssRegions
963+
{ ssCallGraph = addEdge ssCallGraph
964+
, ssRegionStack = fmap updateRegion ssRegionStack
954965
}
955966

956967
setProgramPoint :: ProgramPoint -> M ()
@@ -1391,10 +1402,13 @@ convertAddressState StgState{..} = AddressState
13911402
}
13921403

13931404
data Region
1394-
= Region
1405+
= IRRegion
13951406
{ regionStart :: Name
13961407
, regionEnd :: Name
13971408
}
1409+
| EventRegion
1410+
{ regionName :: Name
1411+
}
13981412
deriving (Eq, Ord, Show)
13991413

14001414
-- let-no-escape statistics

‎external-stg-interpreter/lib/Stg/Interpreter/Debug.hs‎

Lines changed: 13 additions & 17 deletions
Original file line numberDiff line numberDiff line change
@@ -135,23 +135,19 @@ exportCallGraph = do
135135
writeCallGraph (rtsProgName ++ "-call-graph.tsv") globalCallGraph
136136
writeCallGraphSummary (rtsProgName ++ "-call-graph-summary") globalCallGraph
137137

138-
exportRegionCallGraph :: Region -> M ()
139-
exportRegionCallGraph r@Region{..} = do
140-
regions <- gets ssRegions
141-
case Map.lookup r regions of
142-
Just (Just{}, callGraph, l) -> do
143-
Rts{..} <- gets ssRtsSupport
144-
let regionName = BS8.unpack regionStart ++ "-" ++ BS8.unpack regionEnd
145-
dirName = "." ++ rtsProgName ++ "-call-graph" </> regionName
146-
idx = length l
147-
liftIO $ do
148-
regionPath <- makeAbsolute dirName
149-
createDirectoryIfMissing True regionPath
150-
putStrLn $ "save call graphs to: " ++ regionPath
151-
writeCallGraph (regionPath </> printf "%04d" idx ++ ".tsv") callGraph
152-
writeCallGraphSummary (regionPath </> printf "%04d" idx ++ "-summary") callGraph
153-
154-
_ -> pure () -- HINT: ignore missing regions or non-open regions
138+
exportRegionCallGraph :: Int -> Region -> CallGraph -> M ()
139+
exportRegionCallGraph idx r callGraph = do
140+
Rts{..} <- gets ssRtsSupport
141+
let name = case r of
142+
IRRegion{..} -> BS8.unpack regionStart ++ "-" ++ BS8.unpack regionEnd
143+
EventRegion{..} -> BS8.unpack regionName
144+
dirName = "." ++ rtsProgName ++ "-call-graph" </> name
145+
liftIO $ do
146+
regionPath <- makeAbsolute dirName
147+
createDirectoryIfMissing True regionPath
148+
putStrLn $ "save call graphs to: " ++ regionPath
149+
writeCallGraph (regionPath </> printf "%04d" idx ++ ".tsv") callGraph
150+
writeCallGraphSummary (regionPath </> printf "%04d" idx ++ "-summary") callGraph
155151

156152
writeCallGraph :: FilePath -> CallGraph -> IO ()
157153
writeCallGraph fname CallGraph{..} = do

‎external-stg-interpreter/lib/Stg/Interpreter/Debugger/Datalog.hs‎

Lines changed: 6 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -236,13 +236,16 @@ exportStgStateM stgState@StgState{..} = do
236236
forM_ (genAddressState a) $ \(ns, value) -> do
237237
addFact "TraceEvent" [S n, I i, S ns, I value]
238238

239-
forM_ (zip [0..] $ reverse ssTraceMarkers) $ \(i, (n, a)) -> do
239+
forM_ (zip [0..] $ reverse ssTraceMarkers) $ \(i, (n, _tid, a)) -> do
240240
forM_ (genAddressState a) $ \(ns, value) -> do
241241
addFact "TraceMarker" [S n, I i, S ns, I value]
242242

243243
-- regions
244-
forM_ (Map.toList ssRegions) $ \(Region start_name end_name, (_, _curCallGraph, l)) -> do
245-
forM_ (zip [0..] (reverse l)) $ \(idx, (s, e)) -> do
244+
forM_ (Map.toList ssRegionInstances) $ \(r, l) -> do
245+
let (start_name, end_name) = case r of
246+
IRRegion{..} -> (regionStart, regionEnd)
247+
EventRegion{..} -> (regionName, regionName)
248+
forM_ (IntMap.toList l) $ \(idx, (s, e)) -> do
246249
forM_ (zip (genAddressState s) (genAddressState e)) $ \((start_ns, start_value), (end_ns, end_value)) -> do
247250
addFact "Region" [N start_name, N end_name, I idx, S start_ns, I start_value, I end_value]
248251

‎external-stg-interpreter/lib/Stg/Interpreter/Debugger/Region.hs‎

Lines changed: 53 additions & 39 deletions
Original file line numberDiff line numberDiff line change
@@ -3,6 +3,7 @@ module Stg.Interpreter.Debugger.Region where
33

44
import Text.Printf
55
import Control.Monad.State
6+
import Data.Maybe
67
import qualified Data.List as List
78
import qualified Data.Set as Set
89
import qualified Data.Map as Map
@@ -18,6 +19,14 @@ import Stg.Syntax
1819
import qualified Stg.Interpreter.GC as GC
1920
import 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", name] -> startRegion tid . EventRegion $ BS8.pack name
27+
["estgi.debug.region.end", name] -> endRegion tid . EventRegion $ BS8.pack name
28+
_ -> pure ()
29+
2130
dumpHeapObject :: Int -> HeapObject -> String
2231
dumpHeapObject i o = printf "%-8d %3s %s" i (GC.ppLNE o) (debugPrintHeapObject o)
2332

@@ -49,15 +58,15 @@ getRegionHeap start end = do
4958

5059
showRegion :: Bool -> String -> String -> M ()
5160
showRegion 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

7281
addRegion :: String -> String -> M ()
7382
addRegion 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

8391
delRegion :: String -> String -> M ()
8492
delRegion 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

103110
checkRegion :: Name -> M ()
104111
checkRegion 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 ()

‎external-stg-interpreter/lib/Stg/Interpreter/PrimOp/MiscEtc.hs‎

Lines changed: 6 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -7,6 +7,7 @@ import Foreign.Ptr
77

88
import Stg.Syntax
99
import Stg.Interpreter.Base
10+
import Stg.Interpreter.Debugger.Region (evalRegionCommand)
1011

1112
pattern Int64V i = IntAtom i
1213

@@ -28,6 +29,7 @@ evalPrimOp fallback op args t tc = case (op, args) of
2829
-- traceEvent# :: Addr# -> State# s -> State# s
2930
( "traceEvent#", [PtrAtom _ p, _s]) -> do
3031
msg <- liftIO $ peekCString $ castPtr p
32+
evalRegionCommand msg
3133
addrState <- getAddressState
3234
modify' $ \s@StgState{..} -> s {ssTraceEvents = (msg, addrState) : ssTraceEvents}
3335
pure []
@@ -37,8 +39,11 @@ evalPrimOp fallback op args t tc = case (op, args) of
3739
-- traceMarker# :: Addr# -> State# s -> State# s
3840
( "traceMarker#", [PtrAtom _ p, _s]) -> do
3941
msg <- liftIO $ peekCString $ castPtr p
42+
evalRegionCommand msg
43+
tid <- gets ssCurrentThreadId
44+
liftIO $ print (tid, msg)
4045
addrState <- getAddressState
41-
modify' $ \s@StgState{..} -> s {ssTraceMarkers = (msg, addrState) : ssTraceMarkers}
46+
modify' $ \s@StgState{..} -> s {ssTraceMarkers = (msg, tid, addrState) : ssTraceMarkers}
4247
pure []
4348

4449
-- setThreadAllocationCounter# :: Int64# -> State# RealWorld -> State# RealWorld

0 commit comments

Comments
(0)

AltStyle によって変換されたページ (->オリジナル) /