diff options
| -rw-r--r-- | .gitmodules | 3 | ||||
| m--------- | ghc-debug | 0 | ||||
| -rw-r--r-- | ghc/Main.hs | 18 | ||||
| -rw-r--r-- | ghc/ghc-bin.cabal.in | 9 | ||||
| -rw-r--r-- | hadrian/src/Packages.hs | 8 | ||||
| -rw-r--r-- | hadrian/src/Settings/Default.hs | 2 | ||||
| -rw-r--r-- | hadrian/src/Settings/Packages.hs | 1 | ||||
| -rw-r--r-- | instructions.md | 45 |
8 files changed, 82 insertions, 4 deletions
diff --git a/.gitmodules b/.gitmodules index 2994d6e31f..4cc97daa75 100644 --- a/.gitmodules +++ b/.gitmodules @@ -113,3 +113,6 @@ [submodule "utils/hpc"] path = utils/hpc url = https://gitlab.haskell.org/hpc/hpc-bin.git +[submodule "ghc-debug"] + path = ghc-debug + url = git@gitlab.haskell.org:ghc/ghc-debug.git diff --git a/ghc-debug b/ghc-debug new file mode 160000 +Subproject 537e462a5c987537725d95caa10fa6d7b30abf3 diff --git a/ghc/Main.hs b/ghc/Main.hs index ae862a7014..5f854b6565 100644 --- a/ghc/Main.hs +++ b/ghc/Main.hs @@ -32,6 +32,7 @@ import GHC.Driver.Backpack ( doBackpack ) import GHC.Driver.Plugins import GHC.Driver.Config.Logger (initLogFlags) import GHC.Driver.Config.Diagnostic +import GHC.Driver.Monad import GHC.Platform import GHC.Platform.Ways @@ -99,6 +100,10 @@ import Data.Bifunctor import GHC.Data.Graph.Directed import qualified Data.List.NonEmpty as NE +#if defined(GHC_DEBUG) +import GHC.Debug.Stub +#endif + ----------------------------------------------------------------------------- -- ToDo: @@ -111,6 +116,13 @@ import qualified Data.List.NonEmpty as NE ----------------------------------------------------------------------------- -- GHC's command-line interface +debugWrapper :: IO a -> IO a +#if defined(GHC_DEBUG) +debugWrapper = withGhcDebug +#else +debugWrapper = id +#endif + main :: IO () main = do hSetBuffering stdout LineBuffering @@ -159,8 +171,10 @@ main = do ShowGhcUsage -> showGhcUsage dflags ShowGhciUsage -> showGhciUsage dflags PrintWithDynFlags f -> putStrLn (f dflags) - Right postLoadMode -> - main' postLoadMode units dflags argv3 flagWarnings + Right postLoadMode -> do + reifyGhc $ \session -> debugWrapper $ + reflectGhc (main' postLoadMode units dflags argv3 flagWarnings) session + main' :: PostLoadMode -> [String] -> DynFlags -> [Located String] -> [Warn] -> Ghc () diff --git a/ghc/ghc-bin.cabal.in b/ghc/ghc-bin.cabal.in index 88e559048c..5cde07bc6a 100644 --- a/ghc/ghc-bin.cabal.in +++ b/ghc/ghc-bin.cabal.in @@ -22,6 +22,11 @@ Flag internal-interpreter Default: False Manual: True +Flag ghc-debug + Description: Build with support for ghc-debug. + Default: False + Manual: True + Flag threaded Description: Link the ghc executable against the threaded RTS Default: True @@ -42,6 +47,10 @@ Executable ghc ghc-boot == @ProjectVersionMunged@, ghc == @ProjectVersionMunged@ + if flag(ghc-debug) + build-depends: ghc-debug-stub + CPP-OPTIONS: -DGHC_DEBUG + if os(windows) Build-Depends: Win32 >= 2.3 && < 2.14 else diff --git a/hadrian/src/Packages.hs b/hadrian/src/Packages.hs index 6dbeb6ed14..5df998e6a1 100644 --- a/hadrian/src/Packages.hs +++ b/hadrian/src/Packages.hs @@ -11,7 +11,7 @@ module Packages ( runGhc, stm, templateHaskell, terminfo, text, time, timeout, touchy, transformers, unlit, unix, win32, xhtml, lintersCommon, lintNotes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace, - ghcPackages, isGhcPackage, + ghcPackages, isGhcPackage, ghc_debug_convention, ghc_debug_stub, -- * Package information crossPrefix, programName, nonHsMainPackage, autogenPath, programPath, timeoutPath, @@ -43,7 +43,9 @@ ghcPackages = , terminfo, text, time, touchy, transformers, unlit, unix, win32, xhtml , timeout , lintersCommon - , lintNotes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace ] + , lintNotes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace + , ghc_debug_convention + , ghc_debug_stub ] -- TODO: Optimise by switching to sets of packages. isGhcPackage :: Package -> Bool @@ -122,6 +124,8 @@ unlit = util "unlit" unix = lib "unix" win32 = lib "Win32" xhtml = lib "xhtml" +ghc_debug_convention = lib "ghc-debug-convention" `setPath` "ghc-debug/convention" +ghc_debug_stub = lib "ghc-debug-stub" `setPath` "ghc-debug/stub" lintersCommon = lib "linters-common" `setPath` "linters/linters-common" lintNotes = linter "lint-notes" diff --git a/hadrian/src/Settings/Default.hs b/hadrian/src/Settings/Default.hs index 5996924096..54ec6cfb8b 100644 --- a/hadrian/src/Settings/Default.hs +++ b/hadrian/src/Settings/Default.hs @@ -146,6 +146,8 @@ stage1Packages = do , unlit , xhtml , if winTarget then win32 else unix + , ghc_debug_convention + , ghc_debug_stub ] , when (not cross) [ haddock diff --git a/hadrian/src/Settings/Packages.hs b/hadrian/src/Settings/Packages.hs index e2afd72ee5..2d34ab4f43 100644 --- a/hadrian/src/Settings/Packages.hs +++ b/hadrian/src/Settings/Packages.hs @@ -89,6 +89,7 @@ packageArgs = do , builder (Cabal Flags) ? mconcat [ andM [expr ghcWithInterpreter, notStage0] `cabalFlag` "internal-interpreter" + , notStage0 `cabalFlag` "ghc-debug" , ifM stage0 -- We build a threaded stage 1 if the bootstrapping compiler -- supports it. diff --git a/instructions.md b/instructions.md new file mode 100644 index 0000000000..6c8c4c6796 --- /dev/null +++ b/instructions.md @@ -0,0 +1,45 @@ +# Building GHC + +* Add the following to _build/hadrian.settings + +``` +stage1.*.ghc.hs.opts += -finfo-table-map -fdistinct-constructor-tables +``` + +* Build GHC as normal + +``` +./hadrian/build -j8 +``` + +* The result is a ghc-debug enabled compiler + +# Building a debugger + +* Use the compiler you just built to build ghc-debug + +``` +cd ghc-debug +cabal update +cabal new-build debugger -w ../_build/stage1/bin/ghc +``` + +# Running the debugger + +Modify `test/Test.hs` to implement the debugging thing you want to do. Perhaps +start with `p30`, which is a program to generate a profile. + + +* Start the process you want to debug +``` +GHC_DEBUG_SOCKET=/tmp/ghc-debug build-cabal +``` + +* Start the debugger +``` +cabal new-run debugger -w ... +``` + +* Open a ticket about the memory issue you find. + + |