Hannes Siebenhandl pushed to branch wip/fendor/full-eventlog-live at Glasgow Haskell Compiler / GHC

Commits:

10 changed files:

Changes:

  • .gitmodules
    ... ... @@ -126,3 +126,15 @@
    126 126 
     [submodule "eventlog-socket"]
    127 127 
     	path = eventlog-socket
    128 128 
     	url = https://github.com/well-typed/eventlog-socket.git
    129 
    +[submodule "ghc-stack-profiler"]
    130 
    +	path = ghc-stack-profiler
    131 
    +	url = https://github.com/well-typed/ghc-stack-profiler
    132 
    +[submodule "libraries/async"]
    133 
    +	path = libraries/async
    134 
    +	url = https://github.com/fendor/async.git
    135 
    +[submodule "libraries/unordered-containers"]
    136 
    +	path = libraries/unordered-containers
    137 
    +	url = https://github.com/fendor/unordered-containers.git
    138 
    +[submodule "libraries/hashable"]
    139 
    +	path = libraries/hashable
    140 
    +	url = https://github.com/fendor/hashable

  • ghc-stack-profiler
    1 
    +Subproject commit d8edeeef0b5f0babdcffc008f249a35e19cc0c8b

  • ghc/Main.hs
    ... ... @@ -79,6 +79,7 @@ import GHC.Iface.Errors.Ppr
    79 79 
     import GHC.Driver.Session.Mode
    80 80 
     import GHC.Driver.Session.Lint
    81 81 
     import GHC.Driver.Session.Units
    82 
    +import GHC.Driver.Monad
    82 83
    83 84 
     -- Standard Haskell libraries
    84 85 
     import System.IO
    ... ... @@ -90,11 +91,24 @@ import Control.Monad.Trans.Except (throwE, runExceptT)
    90 91 
     import Data.List ( isPrefixOf, partition, intercalate )
    91 92 
     import Prelude
    92 93 
     import qualified Data.List.NonEmpty as NE
    94 
    +#if defined(SAMPLE_TRACER)
    95 
    +import qualified GHC.Stack.Profiler as Profiler
    96 
    +#endif
    93 97
    94 98 
     #if defined(EVENTLOG_SOCKET)
    95 99 
     import GHC.Eventlog.Socket
    96 100 
     #endif
    97 101
    102 
    +runWithStackProfiler :: IO () -> IO ()
    103 
    +runWithStackProfiler act =
    104 
    +#if defined(SAMPLE_TRACER)
    105 
    +  Profiler.setupRootStackProfiler True $ \manager -> do
    106 
    +    Profiler.withStackProfiler manager (Profiler.SampleIntervalMs 10) $ do
    107 
    +      act
    108 
    +#else
    109 
    +  act
    110 
    +#endif
    111 
    +
    98 112 
     -----------------------------------------------------------------------------
    99 113 
     -- ToDo:
    100 114
    ... ... @@ -166,7 +180,8 @@ main = do
    166 180 
                                 ShowGhciUsage          -> showGhciUsage dflags
    167 181 
                                 PrintWithDynFlags f    -> putStrLn (f dflags)
    168 182 
                     Right postLoadMode ->
    169 
    -                    main' postLoadMode units dflags argv3 flagWarnings
    183 
    +                  reifyGhc $ \session -> runWithStackProfiler $
    184 
    +                      reflectGhc (main' postLoadMode units dflags argv3 flagWarnings) session
    170 185
    171 186 
     main' :: PostLoadMode -> [String] -> DynFlags -> [Located String] -> [Warn]
    172 187 
           -> Ghc ()

  • ghc/ghc-bin.cabal.in
    ... ... @@ -32,6 +32,11 @@ Flag threaded
    32 32 
         Default: True
    33 33 
         Manual: True
    34 34
    35 
    +Flag sampleTracer
    36 
    +    Description: Whether we instrument the ghc binary with sample tracer when the eventlog is enabled
    37 
    +    Default: False
    38 
    +    Manual: True
    39 
    +
    35 40 
     Executable ghc
    36 41 
         Default-Language: GHC2024
    37 42
    ... ... @@ -50,6 +55,10 @@ Executable ghc
    50 55 
                        ghc-boot      == @ProjectVersionMunged@,
    51 56 
                        ghc           == @ProjectVersionMunged@
    52 57
    58 
    +    if flag(sampleTracer)
    59 
    +        build-depends: ghc-stack-profiler
    60 
    +        CPP-OPTIONS: -DSAMPLE_TRACER
    61 
    +
    53 62 
         if os(windows)
    54 63 
             Build-Depends: Win32  >= 2.3 && < 2.15
    55 64 
         else

  • hadrian/src/Packages.hs
    ... ... @@ -14,6 +14,7 @@ module Packages (
    14 14 
         lintersCommon, lintNotes, lintCodes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace,
    15 15 
         eventlogSocket, eventlogSocketControl,
    16 16 
         ghcPackages, isGhcPackage,
    17 
    +    async, hashable, unorderedContainers, ghc_stack_profiler, ghc_stack_profiler_core,
    17 18
    18 19 
         -- * Package information
    19 20 
         crossPrefix, programName, nonHsMainPackage, programPath, timeoutPath,
    ... ... @@ -45,7 +46,9 @@ ghcPackages =
    45 46 
         , timeout
    46 47 
         , eventlogSocketControl, eventlogSocket
    47 48 
         , lintersCommon
    48 
    -    , lintNotes, lintCodes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace ]
    49 
    +    , lintNotes, lintCodes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace
    50 
    +    , async, hashable, unorderedContainers, ghc_stack_profiler_core, ghc_stack_profiler
    51 
    +    ]
    49 52
    50 53 
     -- TODO: Optimise by switching to sets of packages.
    51 54 
     isGhcPackage :: Package -> Bool
    ... ... @@ -139,6 +142,11 @@ win32 = lib "Win32"
    139 142 
     xhtml               = lib  "xhtml"
    140 143 
     eventlogSocket      = lib "eventlog-socket" `setPath` "eventlog-socket/eventlog-socket"
    141 144 
     eventlogSocketControl = lib "eventlog-socket-control" `setPath` "eventlog-socket/eventlog-socket-control"
    145 
    +async               = lib "async"
    146 
    +hashable            = lib "hashable"
    147 
    +unorderedContainers = lib "unordered-containers"
    148 
    +ghc_stack_profiler = lib "ghc-stack-profiler" `setPath` "ghc-stack-profiler/ghc-stack-profiler"
    149 
    +ghc_stack_profiler_core = lib "ghc-stack-profiler-core" `setPath` "ghc-stack-profiler/ghc-stack-profiler-core"
    142 150
    143 151 
     lintersCommon       = lib     "linters-common"      `setPath` "linters/linters-common"
    144 152 
     lintNotes           = linter  "lint-notes"

  • hadrian/src/Settings/Default.hs
    ... ... @@ -184,6 +184,11 @@ stage1Packages = do
    184 184 
             , unlit
    185 185 
             , xhtml
    186 186 
             , if winTarget then win32 else unix
    187 
    +        , ghc_stack_profiler
    188 
    +        , ghc_stack_profiler_core
    189 
    +        , async
    190 
    +        , hashable
    191 
    +        , unorderedContainers
    187 192 
             ]
    188 193 
           , when (not cross)
    189 194 
             [ hpcBin

  • hadrian/src/Settings/Packages.hs
    ... ... @@ -132,6 +132,7 @@ packageArgs = do
    132 132 
               , builder (Cabal Flags) ? mconcat
    133 133 
                 [ (expr (ghcWithInterpreter stage)) `cabalFlag` "internal-interpreter"
    134 134 
                 , notStage0 `cabalFlag` "eventlog-socket"
    135 
    +            , notStage0 `cabalFlag` "sampleTracer"
    135 136 
                 , ifM stage0
    136 137 
                       -- We build a threaded stage 1 if the bootstrapping compiler
    137 138 
                       -- supports it.

  • libraries/async
    1 
    +Subproject commit d5fdfb9117a983a3f07b213a8a4f8b1256a80f8c

  • libraries/hashable
    1 
    +Subproject commit 535d33ef02bcabd06758f0ec6920ff9c02ef158f

  • libraries/unordered-containers
    1 
    +Subproject commit 207901b4ded4799e41e0d4d45c3b198424ea4d17

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications · Help