Hannes Siebenhandl pushed to branch wip/fendor/ghc-debug-baseline at Glasgow Haskell Compiler / GHC Commits: 62e7aadc by Matthew Pickering at 2025-07-31T16:44:12+02:00 Add support for ghc-debug to ghc executable - - - - - 9ecd4a78 by Fendor at 2025-07-31T16:44:14+02:00 Bump ghc-debug submodule - - - - - 8 changed files: - .gitmodules - + ghc-debug - ghc/Main.hs - ghc/ghc-bin.cabal.in - hadrian/src/Packages.hs - hadrian/src/Settings/Default.hs - hadrian/src/Settings/Packages.hs - + instructions.md Changes: ===================================== .gitmodules ===================================== @@ -118,3 +118,6 @@ [submodule "libraries/file-io"] path = libraries/file-io url = https://gitlab.haskell.org/ghc/packages/file-io.git +[submodule "ghc-debug"] + path = ghc-debug + url = git@gitlab.haskell.org:ghc/ghc-debug.git ===================================== ghc-debug ===================================== @@ -0,0 +1 @@ +Subproject commit 971dca0d4b9e2636c8e3acebda1c45f8e7467278 ===================================== ghc/Main.hs ===================================== @@ -33,6 +33,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.Host @@ -92,6 +93,10 @@ import Data.List ( isPrefixOf, partition, intercalate ) import Prelude import qualified Data.List.NonEmpty as NE +#if defined(GHC_DEBUG) +import GHC.Debug.Stub +#endif + ----------------------------------------------------------------------------- -- ToDo: @@ -104,6 +109,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 @@ -152,8 +164,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 () ===================================== 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 @@ -45,6 +50,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.15 else ===================================== hadrian/src/Packages.hs ===================================== @@ -12,7 +12,7 @@ module Packages ( runGhc, semaphoreCompat, stm, templateHaskell, terminfo, text, time, timeout, transformers, unlit, unix, win32, xhtml, lintersCommon, lintNotes, lintCodes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace, - ghcPackages, isGhcPackage, + ghcPackages, isGhcPackage, ghc_debug_convention, ghc_debug_stub, -- * Package information crossPrefix, programName, nonHsMainPackage, programPath, timeoutPath, @@ -43,7 +43,9 @@ ghcPackages = , terminfo, text, time, transformers, unlit, unix, win32, xhtml, fileio , timeout , lintersCommon - , lintNotes, lintCodes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace ] + , lintNotes, lintCodes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace + , ghc_debug_convention + , ghc_debug_stub ] -- TODO: Optimise by switching to sets of packages. isGhcPackage :: Package -> Bool @@ -133,6 +135,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" ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -173,6 +173,8 @@ stage1Packages = do , unlit , xhtml , if winTarget then win32 else unix + , ghc_debug_convention + , ghc_debug_stub ] , when (not cross) [ hpcBin ===================================== hadrian/src/Settings/Packages.hs ===================================== @@ -107,6 +107,7 @@ packageArgs = do , builder (Cabal Flags) ? mconcat [ (expr (ghcWithInterpreter stage)) `cabalFlag` "internal-interpreter" + , notStage0 `cabalFlag` "ghc-debug" , ifM stage0 -- We build a threaded stage 1 if the bootstrapping compiler -- supports it. ===================================== 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. + + View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d032964c17e82cf04f1a72c5b836e07... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d032964c17e82cf04f1a72c5b836e07... You're receiving this email because of your account on gitlab.haskell.org.