[Git][ghc/ghc][master] Add -fbreak-points to control breakpoint insertion
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Mon Jul 3 07:27:49 UTC 2023
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
083794b1 by Torsten Schmits at 2023-07-03T03:27:27-04:00
Add -fbreak-points to control breakpoint insertion
Rather than statically enabling breakpoints only for the interpreter,
this adds a new flag.
Tracking ticket: #23057
MR: !10466
- - - - -
15 changed files:
- compiler/GHC/Driver/Backend.hs
- compiler/GHC/Driver/Config/HsToCore/Ticks.hs
- compiler/GHC/Driver/Flags.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/HsToCore.hs
- docs/users_guide/debug-info.rst
- docs/users_guide/ghci.rst
- docs/users_guide/phases.rst
- ghc/Main.hs
- + testsuite/tests/ghci.debugger/scripts/T23057.hs
- + testsuite/tests/ghci.debugger/scripts/T23057.script
- + testsuite/tests/ghci.debugger/scripts/T23057.stdout
- testsuite/tests/ghci.debugger/scripts/all.T
- testsuite/tests/ghci/scripts/ghci024.stdout
- testsuite/tests/ghci/scripts/ghci024.stdout-mingw32
Changes:
=====================================
compiler/GHC/Driver/Backend.hs
=====================================
@@ -1,4 +1,4 @@
-{-# LANGUAGE MultiWayIf #-}
+{-# LANGUAGE MultiWayIf, LambdaCase #-}
{-|
Module : GHC.Driver.Backend
@@ -85,7 +85,7 @@ module GHC.Driver.Backend
, backendUnregisterisedAbiOnly
, backendGeneratesHc
, backendSptIsDynamic
- , backendWantsBreakpointTicks
+ , backendSupportsBreakpoints
, backendForcesOptimization0
, backendNeedsFullWays
, backendSpecialModuleSource
@@ -650,16 +650,16 @@ backendSptIsDynamic (Named JavaScript) = False
backendSptIsDynamic (Named Interpreter) = True
backendSptIsDynamic (Named NoBackend) = False
--- | If this flag is set, then "GHC.HsToCore.Ticks"
--- inserts `Breakpoint` ticks. Used only for the
--- interpreter.
-backendWantsBreakpointTicks :: Backend -> Bool
-backendWantsBreakpointTicks (Named NCG) = False
-backendWantsBreakpointTicks (Named LLVM) = False
-backendWantsBreakpointTicks (Named ViaC) = False
-backendWantsBreakpointTicks (Named JavaScript) = False
-backendWantsBreakpointTicks (Named Interpreter) = True
-backendWantsBreakpointTicks (Named NoBackend) = False
+-- | If this flag is unset, then the driver ignores the flag @-fbreak-points@,
+-- since backends other than the interpreter tend to panic on breakpoints.
+backendSupportsBreakpoints :: Backend -> Bool
+backendSupportsBreakpoints = \case
+ Named NCG -> False
+ Named LLVM -> False
+ Named ViaC -> False
+ Named JavaScript -> False
+ Named Interpreter -> True
+ Named NoBackend -> False
-- | If this flag is set, then the driver forces the
-- optimization level to 0, issuing a warning message if
=====================================
compiler/GHC/Driver/Config/HsToCore/Ticks.hs
=====================================
@@ -1,5 +1,6 @@
module GHC.Driver.Config.HsToCore.Ticks
( initTicksConfig
+ , breakpointsAllowed
)
where
@@ -18,9 +19,14 @@ initTicksConfig dflags = TicksConfig
, ticks_countEntries = gopt Opt_ProfCountEntries dflags
}
+breakpointsAllowed :: DynFlags -> Bool
+breakpointsAllowed dflags =
+ gopt Opt_InsertBreakpoints dflags &&
+ backendSupportsBreakpoints (backend dflags)
+
coveragePasses :: DynFlags -> [TickishType]
coveragePasses dflags = catMaybes
- [ ifA Breakpoints $ backendWantsBreakpointTicks $ backend dflags
+ [ ifA Breakpoints $ breakpointsAllowed dflags
, ifA HpcTicks $ gopt Opt_Hpc dflags
, ifA ProfNotes $ sccProfilingEnabled dflags && profAuto dflags /= NoProfAuto
, ifA SourceNotes $ needSourceNotes dflags
=====================================
compiler/GHC/Driver/Flags.hs
=====================================
@@ -355,6 +355,7 @@ data GeneralFlag
| Opt_BuildingCabalPackage
| Opt_IgnoreDotGhci
| Opt_GhciSandbox
+ | Opt_InsertBreakpoints
| Opt_GhciHistory
| Opt_GhciLeakCheck
| Opt_ValidateHie
=====================================
compiler/GHC/Driver/Session.hs
=====================================
@@ -2470,7 +2470,8 @@ fFlagsDeps = [
return dflags)),
flagSpec "show-error-context" Opt_ShowErrorContext,
flagSpec "cmm-thread-sanitizer" Opt_CmmThreadSanitizer,
- flagSpec "split-sections" Opt_SplitSections
+ flagSpec "split-sections" Opt_SplitSections,
+ flagSpec "break-points" Opt_InsertBreakpoints
]
++ fHoleFlags
=====================================
compiler/GHC/HsToCore.hs
=====================================
@@ -167,7 +167,7 @@ deSugar hsc_env
[ (i, s)
| i <- hsc_interp hsc_env
, (_, s) <- m_tickInfo
- , backendWantsBreakpointTicks (backend dflags)
+ , breakpointsAllowed dflags
]
$ \(interp, specs) -> mkModBreaks interp mod specs
=====================================
docs/users_guide/debug-info.rst
=====================================
@@ -1,9 +1,9 @@
Debugging compiled programs
===========================
-Since the 7.10 release GHC can emit a debugging information to help debugging
+Since the 7.10 release GHC can emit debugging information to help debugging
tools understand the code that GHC produces. This debugging information is
-useable by most UNIX debugging tools.
+usable by most UNIX debugging tools.
.. ghc-flag:: -g
-g⟨n⟩
=====================================
docs/users_guide/ghci.rst
=====================================
@@ -541,7 +541,7 @@ including entities that are in scope in the current module context.
.. warning::
Temporary bindings introduced at the prompt only last until the
- next :ghci-cmd:`:load`, :ghci-cmd:`:reload`, :ghci-cmd:`:add` or
+ next :ghci-cmd:`:load`, :ghci-cmd:`:reload`, :ghci-cmd:`:add` or
:ghci-cmd:`:unadd` command, at which time they will be simply lost.
However, they do survive a change of context with
:ghci-cmd:`:module`: the temporary bindings just move to the new location.
@@ -1312,6 +1312,17 @@ is possible to break automatically when an exception is thrown, even if
it is thrown from within compiled code (see
:ref:`ghci-debugger-exceptions`).
+.. ghc-flag:: -fbreak-points
+ :shortdesc: :ref:`Insert breakpoints in the GHCi debugger <ghci-debugger>`
+ :type: dynamic
+ :reverse: -fno-break-points
+ :category: interactive
+
+ :default: enabled for GHCi
+
+ This flag's purpose is to allow disabling breakpoint insertion with
+ the reverse form.
+
.. _breakpoints:
Breakpoints and inspecting variables
@@ -3172,7 +3183,7 @@ example, to turn on :ghc-flag:`-Wmissing-signatures`, you would say:
ghci> :set -Wmissing-signatures
-GHCi will also accept any file-header pragmas it finds, such as
+GHCi will also accept any file-header pragmas it finds, such as
``{-# OPTIONS_GHC ... #-}`` and ``{-# LANGUAGE ... #-}`` (see :ref:`pragmas`). For example,
instead of using :ghci-cmd:`:set` to enable :ghc-flag:`-Wmissing-signatures`,
you could instead write:
=====================================
docs/users_guide/phases.rst
=====================================
@@ -619,8 +619,8 @@ Options affecting code generation
useful if you're only interested in type checking code.
If a module contains a Template Haskell splice then in ``--make`` mode, code
- generation will be automatically turned on for all dependencies. By default
- object files are generated but if ghc-flag:`-fprefer-byte-code` is enable then
+ generation will be automatically turned on for all dependencies. By default,
+ object files are generated, but if ghc-flag:`-fprefer-byte-code` is enabled,
byte-code will be generated instead.
.. ghc-flag:: -fwrite-interface
@@ -777,7 +777,7 @@ Options affecting code generation
:category: codegen
If a home package module has byte-code available then use that instead of
- and object file (if that's available) to evaluate and run TH splices.
+ an object file (if that's available) to evaluate and run TH splices.
This is useful with flags such as :ghc-flag:`-fbyte-code-and-object-code`, which
tells the compiler to generate byte-code, and :ghc-flag:`-fwrite-if-simplified-core` which
=====================================
ghc/Main.hs
=====================================
@@ -216,6 +216,8 @@ main' postLoadMode units dflags0 args flagWarnings = do
-- object code but has little other effect unless you are also using
-- fat interface files.
`gopt_set` Opt_UseBytecodeRatherThanObjects
+ -- By default enable the debugger by inserting breakpoints
+ `gopt_set` Opt_InsertBreakpoints
logger1 <- getLogger
let logger2 = setLogFlags logger1 (initLogFlags dflags2)
=====================================
testsuite/tests/ghci.debugger/scripts/T23057.hs
=====================================
@@ -0,0 +1,4 @@
+module T23057 where
+
+main :: IO ()
+main = putStrLn "done"
=====================================
testsuite/tests/ghci.debugger/scripts/T23057.script
=====================================
@@ -0,0 +1,3 @@
+:load T23057
+:break main
+main
=====================================
testsuite/tests/ghci.debugger/scripts/T23057.stdout
=====================================
@@ -0,0 +1,2 @@
+Cannot set breakpoint on ‘main’: No breakpoint found for ‘main’ in module ‘T23057’
+done
=====================================
testsuite/tests/ghci.debugger/scripts/all.T
=====================================
@@ -139,3 +139,4 @@ test('break030',
ghci_script,
['break030.script'],
)
+test('T23057', [only_ghci, extra_hc_opts('-fno-break-points')], ghci_script, ['T23057.script'])
=====================================
testsuite/tests/ghci/scripts/ghci024.stdout
=====================================
@@ -14,6 +14,7 @@ other dynamic, non-language, flag settings:
-fkeep-going
-fshow-warning-groups
-fprefer-byte-code
+ -fbreak-points
warning settings:
-Wsemigroup
-Wcompat-unqualified-imports
=====================================
testsuite/tests/ghci/scripts/ghci024.stdout-mingw32
=====================================
@@ -13,6 +13,7 @@ other dynamic, non-language, flag settings:
-fkeep-going
-fshow-warning-groups
-fprefer-byte-code
+ -fbreak-points
warning settings:
-Wsemigroup
-Wcompat-unqualified-imports
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/083794b10dc27e9d97b62cc8b8eb4e1da162bf66
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/083794b10dc27e9d97b62cc8b8eb4e1da162bf66
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20230703/2b3ced96/attachment-0001.html>
More information about the ghc-commits
mailing list