Skip to content

Commit 573d184

Browse files
authored
Produce heap profiles the old fashioned way, from .hp files (#1261)
The -eventlog runtime is not reliable when combined with +RTS -h leading to undiagnosed crashes and infinite loops. The crashes are sporadic and seem to arise more frequently in the lsp-types example, although we have not investigated deeply since there is a simple alternative that doesn't crash: the vanilla runtime.
1 parent 0c9dd30 commit 573d184

File tree

3 files changed

+14
-14
lines changed

3 files changed

+14
-14
lines changed

ghcide/bench/hist/Main.hs

+1-3
Original file line numberDiff line numberDiff line change
@@ -74,7 +74,7 @@ main = shakeArgs shakeOptions {shakeChange = ChangeModtimeAndDigest, shakeThread
7474
benchRules build resource (MkBenchRules (askOracle $ GetSamples ()) benchGhcide "ghcide")
7575
csvRules build
7676
svgRules build
77-
eventlogRules build
77+
heapProfileRules build
7878
action $ allTargets build
7979

8080
ghcideBuildRules :: MkBuildRules BuildSystem
@@ -123,7 +123,6 @@ buildGhcide Cabal args out = do
123123
,"--install-method=copy"
124124
,"--overwrite-policy=always"
125125
,"--ghc-options=-rtsopts"
126-
,"--ghc-options=-eventlog"
127126
]
128127

129128
buildGhcide Stack args out =
@@ -133,7 +132,6 @@ buildGhcide Stack args out =
133132
,"ghcide:ghcide"
134133
,"--copy-bins"
135134
,"--ghc-options=-rtsopts"
136-
,"--ghc-options=-eventlog"
137135
]
138136

139137
benchGhcide

ghcide/ghcide.cabal

+1-1
Original file line numberDiff line numberDiff line change
@@ -221,7 +221,7 @@ benchmark benchHist
221221
other-modules: Experiments.Types
222222
build-tool-depends:
223223
ghcide:ghcide-bench,
224-
eventlog2html:eventlog2html
224+
hp2pretty:hp2pretty
225225
default-extensions:
226226
BangPatterns
227227
DeriveFunctor

shake-bench/src/Development/Benchmark/Rules.hs

+12-10
Original file line numberDiff line numberDiff line change
@@ -49,7 +49,7 @@ module Development.Benchmark.Rules
4949
benchRules, MkBenchRules(..), BenchProject(..),
5050
csvRules,
5151
svgRules,
52-
eventlogRules,
52+
heapProfileRules,
5353
allTargets,
5454
GetExample(..), GetExamples(..),
5555
IsExample(..), RuleResultForExample,
@@ -139,7 +139,7 @@ allTargets buildFolder = do
139139
| e <- experiments,
140140
ex <- examples,
141141
ver <- versions,
142-
mode <- ["svg", "diff.svg","eventlog.html"]
142+
mode <- ["svg", "diff.svg","heap.svg"]
143143
]
144144

145145
--------------------------------------------------------------------------------
@@ -225,19 +225,18 @@ benchRules build benchResource MkBenchRules{..} = do
225225
priority 0 $
226226
[ build -/- "*/*/*.csv",
227227
build -/- "*/*/*.benchmark-gcStats",
228-
build -/- "*/*/*.eventlog",
229228
build -/- "*/*/*.hp",
230229
build -/- "*/*/*.log"
231230
]
232-
&%> \[outcsv, outGc, outEventLog, outHp, outLog] -> do
231+
&%> \[outcsv, outGc, outHp, outLog] -> do
233232
let [_, exampleName, ver, exp] = splitDirectories outcsv
234233
example <- fromMaybe (error $ "Unknown example " <> exampleName)
235234
<$> askOracle (GetExample exampleName)
236235
buildSystem <- askOracle $ GetBuildSystem ()
237236
setupRes <- setupProject
238237
liftIO $ createDirectoryIfMissing True $ dropFileName outcsv
239238
let exePath = build </> "binaries" </> ver </> executableName
240-
exeExtraArgs = ["+RTS", "-l-a", "-h", "-ol" <> outEventLog, "-S" <> outGc, "-RTS"]
239+
exeExtraArgs = ["+RTS", "-h", "-S" <> outGc, "-RTS"]
241240
ghcPath = build </> "binaries" </> ver </> "ghc.path"
242241
experiment = Escaped $ dropExtension exp
243242
need [exePath, ghcPath]
@@ -381,11 +380,14 @@ svgRules build = do
381380
title = show (unescapeExperiment exp) <> " - live bytes over time"
382381
plotDiagram False diagram out
383382

384-
eventlogRules :: FilePattern -> Rules ()
385-
eventlogRules build = do
386-
build -/- "*/*/*.eventlog.html" %> \out -> do
387-
need [dropExtension out]
388-
cmd_ ("eventlog2html" :: String) [dropExtension out]
383+
heapProfileRules :: FilePattern -> Rules ()
384+
heapProfileRules build = do
385+
priority 3 $
386+
build -/- "*/*/*.heap.svg" %> \out -> do
387+
let hpFile = dropExtension (dropExtension out) <.> "hp"
388+
need [hpFile]
389+
cmd_ ("hp2pretty" :: String) [hpFile]
390+
liftIO $ renameFile (dropExtension hpFile <.> "svg") out
389391

390392
--------------------------------------------------------------------------------
391393
--------------------------------------------------------------------------------

0 commit comments

Comments
 (0)