Hannes Siebenhandl pushed to branch wip/fendor/full-eventlog-live at Glasgow Haskell Compiler / GHC Commits: 6b613b77 by fendor at 2026-09-11T15:48:13+02:00 Support for `ghc-stack-profiler` This adds the +ghc-stack-profiler feature flag. If set, GHC is instrumented with GHC Stack Profiler. - - - - - 10 changed files: - .gitmodules - + ghc-stack-profiler - ghc/Main.hs - ghc/ghc-bin.cabal.in - hadrian/src/Packages.hs - hadrian/src/Settings/Default.hs - hadrian/src/Settings/Packages.hs - + libraries/async - + libraries/hashable - + libraries/unordered-containers Changes: ===================================== .gitmodules ===================================== @@ -125,3 +125,15 @@ [submodule "eventlog-socket"] path = eventlog-socket url = https://github.com/well-typed/eventlog-socket.git +[submodule "ghc-stack-profiler"] + path = ghc-stack-profiler + url = https://github.com/well-typed/ghc-stack-profiler +[submodule "libraries/async"] + path = libraries/async + url = https://github.com/fendor/async.git +[submodule "libraries/unordered-containers"] + path = libraries/unordered-containers + url = https://github.com/fendor/unordered-containers.git +[submodule "libraries/hashable"] + path = libraries/hashable + url = https://github.com/fendor/hashable ===================================== ghc-stack-profiler ===================================== @@ -0,0 +1 @@ +Subproject commit 389d886a1494cd019ee93c72c8f19cf7f9dc1664 ===================================== ghc/Main.hs ===================================== @@ -97,6 +97,10 @@ import qualified Data.List.NonEmpty as NE import qualified GHC.Eventlog.Socket #endif +#if defined(GHC_STACK_PROFILER) +import qualified GHC.Stack.Profiler +#endif + startEventlogSocketFromEnv :: IO () #if defined(EVENTLOG_SOCKET) startEventlogSocketFromEnv = GHC.Eventlog.Socket.startFromEnv @@ -104,6 +108,13 @@ startEventlogSocketFromEnv = GHC.Eventlog.Socket.startFromEnv startEventlogSocketFromEnv = pure () #endif +startGhcStackProfilerFromEnv :: IO () -> IO () +#if defined(GHC_STACK_PROFILER) +startGhcStackProfilerFromEnv act = GHC.Stack.Profiler.withProfilerFromEnv (const act) +#else +startGhcStackProfilerFromEnv = id +#endif + ----------------------------------------------------------------------------- -- ToDo: @@ -117,7 +128,7 @@ startEventlogSocketFromEnv = pure () -- GHC's command-line interface main :: IO () -main = do +main = startGhcStackProfilerFromEnv $ do startEventlogSocketFromEnv hSetBuffering stdout LineBuffering ===================================== ghc/ghc-bin.cabal.in ===================================== @@ -37,6 +37,11 @@ Flag threaded Default: True Manual: True +Flag ghc-stack-profiler + Description: Build with support for ghc-stack-profiler + Default: False + Manual: True + Executable ghc Default-Language: GHC2024 @@ -102,6 +107,10 @@ Executable ghc build-depends: eventlog-socket CPP-OPTIONS: -DEVENTLOG_SOCKET + if flag(ghc-stack-profiler) + build-depends: ghc-stack-profiler + CPP-OPTIONS: -DGHC_STACK_PROFILER + Other-Extensions: CPP NondecreasingIndentation ===================================== hadrian/src/Packages.hs ===================================== @@ -14,6 +14,7 @@ module Packages ( lintersCommon, lintNotes, lintCodes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace, eventlogSocket, eventlogSocketControl, ghcPackages, isGhcPackage, + async, hashable, unorderedContainers, ghc_stack_profiler, ghc_stack_profiler_core, -- * Package information crossPrefix, programBasename, programName, nonHsMainPackage, programPath, timeoutPath, @@ -44,7 +45,9 @@ ghcPackages = , timeout , eventlogSocketControl, eventlogSocket , lintersCommon - , lintNotes, lintCodes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace ] + , lintNotes, lintCodes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace + , async, hashable, unorderedContainers, ghc_stack_profiler_core, ghc_stack_profiler + ] -- TODO: Optimise by switching to sets of packages. isGhcPackage :: Package -> Bool @@ -139,6 +142,11 @@ win32 = lib "Win32" xhtml = lib "xhtml" eventlogSocket = lib "eventlog-socket" `setPath` "eventlog-socket/eventlog-socket" eventlogSocketControl = lib "eventlog-socket-control" `setPath` "eventlog-socket/eventlog-socket-control" +async = lib "async" +hashable = lib "hashable" +unorderedContainers = lib "unordered-containers" +ghc_stack_profiler = lib "ghc-stack-profiler" `setPath` "ghc-stack-profiler/ghc-stack-profiler" +ghc_stack_profiler_core = lib "ghc-stack-profiler-core" `setPath` "ghc-stack-profiler/ghc-stack-profiler-core" lintersCommon = lib "linters-common" `setPath` "linters/linters-common" lintNotes = linter "lint-notes" ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -192,6 +192,11 @@ stagedPackages stage = do , hpcBin , if winTarget then win32 else unix , runGhc + , ghc_stack_profiler + , ghc_stack_profiler_core + , async + , hashable + , unorderedContainers ] , when (winTarget && not cross) [ -- See Note [Hadrian's ghci-wrapper package] ===================================== hadrian/src/Settings/Packages.hs ===================================== @@ -105,6 +105,14 @@ packageArgs = do , builder (Haddock BuildPackage) ? arg ("--optghc=-I" ++ path) ] + , package ghc_stack_profiler ? mconcat + [ builder (Cabal Flags) ? mconcat + [ arg "-use-ghc-trace-events" + -- Add support for eventlog-socket commands + , arg "+control" + ] + ] + , package eventlogSocket ? mconcat [ builder (Cabal Flags) ? mconcat [ @@ -123,6 +131,7 @@ packageArgs = do [ andM [expr (ghcWithInterpreter stage), orM [expr (notM cross), stage1]] `cabalFlag` "interpreter" , andM [expr (ghcWithInterpreter stage), notM (expr cross)] `cabalFlag` "internal-interpreter" , notStage0 `cabalFlag` "eventlog-socket" + , notStage0 `cabalFlag` "ghc-stack-profiler" , ifM stage0 -- We build a threaded stage 1 if the bootstrapping compiler -- supports it. ===================================== libraries/async ===================================== @@ -0,0 +1 @@ +Subproject commit 474fc7f612b74e73e24e91474fa75af18eede7b7 ===================================== libraries/hashable ===================================== @@ -0,0 +1 @@ +Subproject commit d56d62eb2a9ff4376e7119d925ececa60959d9ec ===================================== libraries/unordered-containers ===================================== @@ -0,0 +1 @@ +Subproject commit 368ea40488bf3c644e9c36d996302029fb0fc227 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6b613b772c45ade12c6f3456581405f0... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6b613b772c45ade12c6f3456581405f0... You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help