[Git][ghc/ghc][wip/romes/step-out-11] 12 commits: Update comments on `OptKind` to reflect the code reality
by Rodrigo Mesquita (＠alt-romes) 01 Aug '25
by Rodrigo Mesquita (＠alt-romes) 01 Aug '25
01 Aug '25
Rodrigo Mesquita pushed to branch wip/romes/step-out-11 at Glasgow Haskell Compiler / GHC
Commits:
ee2dc248 by Simon Hengel at 2025-07-31T06:25:35-04:00
Update comments on `OptKind` to reflect the code reality
- - - - -
b029633a by Wen Kokke at 2025-07-31T06:26:21-04:00
rts: Disable --eventlog-flush-interval unless compiled with -threaded.
This commit fixes issue #26222:
Using --eventlog-flush-interval with the non-threaded RTS leads to eventlog corruption.
https://gitlab.haskell.org/ghc/ghc/-/issues/26222
This commit makes three changes when code is compiled against the non-threaded RTS:
1. It disables the --eventlog-flush-interval flag.
2. It disables the documentation for the --eventlog-flush-interval flag.
3. It disables the relevant state from RtsConfig and code from Timer.
4. It updates the entry for --eventlog-flush-interval in the users guide.
- - - - -
31159f1d by Wen Kokke at 2025-07-31T06:26:21-04:00
rts: Split T20006 into tests with and without -threaded
- - - - -
618687ef by Simon Hengel at 2025-07-31T06:27:03-04:00
docs/users_guide/win32-dlls.rst: Remove references to `readline`
- - - - -
083e40f1 by Rodrigo Mesquita at 2025-08-01T04:38:23-04:00
debugger: Uniquely identify breakpoints by internal id
Since b85b11994e0130ff2401dd4bbdf52330e0bcf776 (support inlining
breakpoints), a breakpoint has been identified at runtime by *two* pairs
of <module,index>.
- The first, aka a 'BreakpointId', uniquely identifies a breakpoint in
the source of a module by using the Tick index. A Tick index can index
into ModBreaks.modBreaks_xxx to fetch source-level information about
where that tick originated.
- When a user specifies e.g. a line breakpoint using :break, we'll reverse
engineer what a Tick index for that line
- We update the `BreakArray` of that module (got from the
LoaderState) at that tick index to `breakOn`.
- A BCO we can stop at is headed by a BRK_FUN instruction. This
instruction stores in an operand the `tick index` it is associated
to. We look it up in the associated `BreakArray` (also an operand)
and check wheter it was set to `breakOn`.
- The second, aka the `ibi_info_mod` + `ibi_info_ix` of the
`InternalBreakpointId`, uniquely index into the `imodBreaks_breakInfo`
-- the information we gathered during code generation about the
existing breakpoint *ocurrences*.
- Note that with optimisation there may be many occurrences of the
same source-tick-breakpoint across different modules. The
`ibi_info_ix` is unique per occurrence, but the `bi_tick_ix` may be
shared. See Note [Breakpoint identifiers] about this.
- Note that besides the tick ids, info ids are also stored in
`BRK_FUN` so the break handler can refer to the associated
`CgBreakInfo`.
In light of that, the driving changes come from the desire to have the
info_id uniquely identify the breakpoint at runtime, and the source tick
id being derived from it:
- An InternalBreakpointId should uniquely identify a breakpoint just
from the code-generation identifiers of `ibi_info_ix` and `ibi_info_mod`.
So we drop `ibi_tick_mod` and `ibi_tick_ix`.
- A BRK_FUN instruction need only record the "internal breakpoint id",
not the tick-level id.
So we drop the tick mod and tick index operands.
- A BreakArray should be indexed by InternalBreakpointId rather than
BreakpointId
That means we need to do some more work when setting a breakpoint.
Specifically, we need to figure out the internal ids (occurrences of a
breakpoint) from the source-level BreakpointId we want to set the
breakpoint at (recall :break refers to breaks at the source level).
Besides this change being an improvement to the handling of breakpoints
(it's clearer to have a single unique identifier than two competing
ones), it unlocks the possibility of generating "internal" breakpoints
during Cg (needed for #26042).
It should also be easier to introduce multi-threaded-aware `BreakArrays`
following this change (needed for #26064).
Se also the new Note [ModBreaks vs InternalModBreaks]
On i386-linux:
-------------------------
Metric Decrease:
interpreter_steplocal
-------------------------
- - - - -
bf03bbaa by Simon Hengel at 2025-08-01T04:39:05-04:00
Don't use MCDiagnostic for `ghcExit`
This changes the error message of `ghcExit` from
```
<no location info>: error:
Compilation had errors
```
to
```
Compilation had errors
```
- - - - -
a889ec75 by Simon Hengel at 2025-08-01T04:39:05-04:00
Respect `-fdiagnostics-as-json` for driver diagnostics (see #24113)
- - - - -
32d8c808 by Rodrigo Mesquita at 2025-08-01T10:45:19+01:00
cleanup: Move dehydrateCgBreakInfo to Stg2Bc
This no longer has anything to do with Core.
- - - - -
0189ad2b by Rodrigo Mesquita at 2025-08-01T10:45:19+01:00
rts/Disassembler: Fix spacing of BRK_FUN
- - - - -
1ef4fa39 by Rodrigo Mesquita at 2025-08-01T10:45:19+01:00
debugger: Fix bciPtr in Step-out
We need to use `BCO_NEXT` to move bciPtr to ix=1, because ix=0 points to
the instruction itself!
I do not understand how this didn't crash before.
- - - - -
3a667156 by Rodrigo Mesquita at 2025-08-01T10:45:19+01:00
debugger: Allow BRK_FUNs to head case continuation BCOs
When we start executing a BCO, we may want to yield to the scheduler:
this may be triggered by a heap/stack check, context switch, or a
breakpoint. To yield, we need to put the stack in a state such that
when execution is resumed we are back to where we yielded from.
Previously, a BKR_FUN could only head a function BCO because we only
knew how to construct a valid stack for yielding from one -- simply add
`apply_interp_info` + the BCO to resume executing. This is valid because
the stack at the start of run_BCO is headed by that BCO's arguments.
However, in case continuation BCOs (as per Note [Case continuation BCOs]),
we couldn't easily reconstruct a valid stack that could be resumed
because we dropped too soon the stack frames regarding the value
returned (stg_ret) and received (stg_ctoi) by that continuation.
This is especially tricky because of the variable type and size return
frames (e.g. pointer ret_p/ctoi_R1p vs a tuple ret_t/ctoi_t2).
The trick to being able to yield from a BRK_FUN at the start of a case
cont BCO is to stop removing the ret frame headers eagerly and instead
keep them until the BCO starts executing. The new layout at the start of
a case cont. BCO is described by the new Note [Stack layout when entering run_BCO].
Now, we keep the ret_* and ctoi_* frames when entering run_BCO.
A BRK_FUN is then executed if found, and the stack is yielded as-is with
the preserved ret and ctoi frames.
Then, a case cont BCO's instructions always SLIDE off the headers of the
ret and ctoi frames, in StgToByteCode.doCase, turning a stack like
| .... |
+---------------+
| fv2 |
+---------------+
| fv1 |
+---------------+
| BCO |
+---------------+
| stg_ctoi_ret_ |
+---------------+
| retval |
+---------------+
| stg_ret_..... |
+---------------+
into
| .... |
+---------------+
| fv2 |
+---------------+
| fv1 |
+---------------+
| retval |
+---------------+
for the remainder of the BCO.
Moreover, this more uniform approach of keeping the ret and ctoi frames
means we need less ad-hoc logic concerning the variable size of
ret_tuple vs ret_p/np frames in the code generator and interpreter:
Always keep the return to cont. stack intact at the start of run_BCO,
and the statically generated instructions will take care of adjusting
it.
Unlocks BRK_FUNs at the start of case cont. BCOs which will enable a
better user-facing step-out (#26042) which is free of the bugs the
current BRK_ALTS implementation suffers from (namely, using BRK_FUN
rather than BRK_ALTS in a case cont. means we'll never accidentally end
up in a breakpoint "deeper" than the continuation, because we stop at
the case cont itself rather than on the first breakpoint we evaluate
after it).
- - - - -
75599f78 by Rodrigo Mesquita at 2025-08-01T10:45:19+01:00
BRK_FUN with InternalBreakLocs for code-generation time breakpoints
At the start of a case continuation BCO, place a BRK_FUN.
This BRK_FUN uses the new "internal breakpoint location" -- allowing us
to come up with a valid source location for this breakpoint that is not associated with a source-level tick.
For case continuation BCOs, we use the last tick seen before it as the
source location. The reasoning is described in Note [Debugger: Stepout internal break locs].
Note how T26042c, which was broken because it displayed the incorrect
behavior of the previous step out when we'd end up at a deeper level
than the one from which we initiated step-out, is now fixed.
As of this commit, BRK_ALTS is now dead code and is thus dropped.
Note [Debugger: Stepout internal break locs]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Step-out tells the interpreter to run until the current function
returns to where it was called from, and stop there.
This is achieved by enabling the BRK_FUN found on the first RET_BCO
frame on the stack (See [Note Debugger: Step-out]).
Case continuation BCOs (which select an alternative branch) must
therefore be headed by a BRK_FUN. An example:
f x = case g x of <--- end up here
1 -> ...
2 -> ...
g y = ... <--- step out from here
- `g` will return a value to the case continuation BCO in `f`
- The case continuation BCO will receive the value returned from g
- Match on it and push the alternative continuation for that branch
- And then enter that alternative.
If we step-out of `g`, the first RET_BCO on the stack is the case
continuation of `f` -- execution should stop at its start, before
selecting an alternative. (One might ask, "why not enable the breakpoint
in the alternative instead?", because the alternative continuation is
only pushed to the stack *after* it is selected by the case cont. BCO)
However, the case cont. BCO is not associated with any source-level
tick, it is merely the glue code which selects alternatives which do
have source level ticks. Therefore, we have to come up at code
generation time with a breakpoint location ('InternalBreakLoc') to
display to the user when it is stopped there.
Our solution is to use the last tick seen just before reaching the case
continuation. This is robust because a case continuation will thus
always have a relevant breakpoint location:
- The source location will be the last source-relevant expression
executed before the continuation is pushed
- So the source location will point to the thing you've just stepped
out of
- Doing :step-local from there will put you on the selected
alternative (which at the source level may also be the e.g. next
line in a do-block)
Examples, using angle brackets (<<...>>) to denote the breakpoint span:
f x = case <<g x>> {- step in here -} of
1 -> ...
2 -> ...>
g y = <<...>> <--- step out from here
...
f x = <<case g x of <--- end up here, whole case highlighted
1 -> ...
2 -> ...>>
doing :step-local ...
f x = case g x of
1 -> <<...>> <--- stop in the alternative
2 -> ...
A second example based on T26042d2, where the source is a do-block IO
action, optimised to a chain of `case expressions`.
main = do
putStrLn "hello1"
<<f>> <--- step-in here
putStrLn "hello3"
putStrLn "hello4"
f = do
<<putStrLn "hello2.1">> <--- step-out from here
putStrLn "hello2.2"
...
main = do
putStrLn "hello1"
<<f>> <--- end up here again, the previously executed expression
putStrLn "hello3"
putStrLn "hello4"
doing step/step-local ...
main = do
putStrLn "hello1"
f
<<putStrLn "hello3">> <--- straight to the next line
putStrLn "hello4"
Finishes #26042
- - - - -
45 changed files:
- compiler/GHC/ByteCode/Asm.hs
- compiler/GHC/ByteCode/Breakpoints.hs
- compiler/GHC/ByteCode/Instr.hs
- compiler/GHC/ByteCode/Linker.hs
- compiler/GHC/ByteCode/Types.hs
- compiler/GHC/CoreToIface.hs
- compiler/GHC/Driver/CmdLine.hs
- compiler/GHC/Driver/Make.hs
- compiler/GHC/HsToCore/Breakpoints.hs
- compiler/GHC/Linker/Loader.hs
- compiler/GHC/Runtime/Debugger/Breakpoints.hs
- compiler/GHC/Runtime/Eval.hs
- compiler/GHC/Runtime/Interpreter.hs
- compiler/GHC/StgToByteCode.hs
- compiler/GHC/SysTools/Tasks.hs
- compiler/GHC/Utils/Error.hs
- docs/users_guide/runtime_control.rst
- docs/users_guide/win32-dlls.rst
- ghc/GHCi/UI.hs
- ghc/GHCi/UI/Monad.hs
- libraries/ghci/GHCi/Debugger.hs
- libraries/ghci/GHCi/Message.hs
- libraries/ghci/GHCi/Run.hs
- rts/Disassembler.c
- rts/Exception.cmm
- rts/Interpreter.c
- rts/Profiling.c
- rts/RtsFlags.c
- rts/Timer.c
- rts/include/rts/Bytecodes.h
- rts/include/rts/Flags.h
- testsuite/tests/corelint/T21115b.stderr
- testsuite/tests/count-deps/CountDepsAst.stdout
- testsuite/tests/count-deps/CountDepsParser.stdout
- testsuite/tests/ghci.debugger/scripts/T26042b.stdout
- testsuite/tests/ghci.debugger/scripts/T26042c.script
- testsuite/tests/ghci.debugger/scripts/T26042c.stdout
- + testsuite/tests/ghci.debugger/scripts/T26042d2.hs
- + testsuite/tests/ghci.debugger/scripts/T26042d2.script
- + testsuite/tests/ghci.debugger/scripts/T26042d2.stdout
- testsuite/tests/ghci.debugger/scripts/T26042e.stdout
- testsuite/tests/ghci.debugger/scripts/T26042f2.stdout
- testsuite/tests/ghci.debugger/scripts/T26042g.stdout
- testsuite/tests/ghci.debugger/scripts/all.T
- testsuite/tests/rts/flags/all.T
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/21f1d8c3bfe075fdc1d110b0c94106…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/21f1d8c3bfe075fdc1d110b0c94106…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/fendor/ann-frame] Add primop to annotate the call stack with arbitrary data
by Hannes Siebenhandl (＠fendor) 01 Aug '25
by Hannes Siebenhandl (＠fendor) 01 Aug '25
01 Aug '25
Hannes Siebenhandl pushed to branch wip/fendor/ann-frame at Glasgow Haskell Compiler / GHC
Commits:
f43a2e1f by Ben Gamari at 2025-08-01T11:27:40+02:00
Add primop to annotate the call stack with arbitrary data
We introduce a new primop `annotateStack#` which allows us to push
arbitrary data onto the call-stack.
This allows us to extract the data later when decoding the stack, for
example when an exception is thrown, showing more information to the
user without having to annotate the full call-stack with `HasCallStack`
constraints.
A new stack frame value is introduced `AnnFrame`, which consists of
nothing but a generic payload.
The primop has a small wrapper API that allows users to annotate their
call-stack in programs.
There is a pure API and an IO-based one. The former is a little bit
dubious, as it affects the evaluation of a program, so use with care.
The latter is "safe", as it doesn't change the evaluation of the
program.
The stack annotation mechanism is similarly implemented to the
`ExceptionAnnotation` and `Exception`, there is a typeclass to indicate
something can be pushed onto the call-stack and all values are wrapped
in the existential `SomeStackAnnotation`, which recover the type of the
annotation payload.
There is currently no builtin way to show the stack annotations when
`Backtraces` are displayed (i.e., when showing stack traces to the user),
which we will address in a follow-up MR.
-------------------------
Metric Increase:
ghc_experimental_so
-------------------------
We increase the size of the package, so this is not unreasonable.
Co-Authored-By: fendor <fendor(a)posteo.de>
Co-Authored-By: Ben Gamari <bgamari.foss(a)gmail.com>
- - - - -
47 changed files:
- compiler/GHC/Builtin/primops.txt.pp
- compiler/GHC/StgToCmm/Prim.hs
- compiler/GHC/StgToJS/Prim.hs
- libraries/ghc-experimental/ghc-experimental.cabal.in
- + libraries/ghc-experimental/src/GHC/Stack/Annotation/Experimental.hs
- libraries/ghc-heap/GHC/Exts/Heap/ClosureTypes.hs
- libraries/ghc-heap/GHC/Exts/Heap/Closures.hs
- libraries/ghc-heap/GHC/Exts/Stack.hs
- libraries/ghc-heap/GHC/Exts/Stack/Constants.hsc
- libraries/ghc-heap/GHC/Exts/Stack/Decode.hs
- + libraries/ghc-heap/tests/stack-annotation/Makefile
- + libraries/ghc-heap/tests/stack-annotation/TestUtils.hs
- + libraries/ghc-heap/tests/stack-annotation/all.T
- + libraries/ghc-heap/tests/stack-annotation/ann_frame001.hs
- + libraries/ghc-heap/tests/stack-annotation/ann_frame001.stdout
- + libraries/ghc-heap/tests/stack-annotation/ann_frame002.hs
- + libraries/ghc-heap/tests/stack-annotation/ann_frame002.stdout
- + libraries/ghc-heap/tests/stack-annotation/ann_frame003.hs
- + libraries/ghc-heap/tests/stack-annotation/ann_frame003.stdout
- + libraries/ghc-heap/tests/stack-annotation/ann_frame004.hs
- + libraries/ghc-heap/tests/stack-annotation/ann_frame004.stdout
- libraries/ghc-internal/src/GHC/Internal/ClosureTypes.hs
- rts/ClosureFlags.c
- rts/LdvProfile.c
- rts/PrimOps.cmm
- rts/Printer.c
- rts/RetainerProfile.c
- rts/RtsSymbols.c
- rts/TraverseHeap.c
- rts/include/rts/storage/ClosureTypes.h
- rts/include/rts/storage/Closures.h
- rts/include/stg/MiscClosures.h
- rts/js/profiling.js
- rts/sm/Compact.c
- rts/sm/Evac.c
- rts/sm/NonMovingMark.c
- rts/sm/Sanity.c
- rts/sm/Scav.c
- testsuite/tests/interface-stability/base-exports.stdout
- testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
- testsuite/tests/interface-stability/base-exports.stdout-mingw32
- testsuite/tests/interface-stability/base-exports.stdout-ws-32
- testsuite/tests/interface-stability/ghc-experimental-exports.stdout
- testsuite/tests/interface-stability/ghc-experimental-exports.stdout-mingw32
- testsuite/tests/interface-stability/ghc-prim-exports.stdout
- testsuite/tests/interface-stability/ghc-prim-exports.stdout-mingw32
- utils/deriveConstants/Main.hs
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f43a2e1fd623fef1139fe2c6fbe321c…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f43a2e1fd623fef1139fe2c6fbe321c…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/andreask/linker_fix] 4 commits: debugger: Uniquely identify breakpoints by internal id
by Andreas Klebinger (＠AndreasK) 01 Aug '25
by Andreas Klebinger (＠AndreasK) 01 Aug '25
01 Aug '25
Andreas Klebinger pushed to branch wip/andreask/linker_fix at Glasgow Haskell Compiler / GHC
Commits:
083e40f1 by Rodrigo Mesquita at 2025-08-01T04:38:23-04:00
debugger: Uniquely identify breakpoints by internal id
Since b85b11994e0130ff2401dd4bbdf52330e0bcf776 (support inlining
breakpoints), a breakpoint has been identified at runtime by *two* pairs
of <module,index>.
- The first, aka a 'BreakpointId', uniquely identifies a breakpoint in
the source of a module by using the Tick index. A Tick index can index
into ModBreaks.modBreaks_xxx to fetch source-level information about
where that tick originated.
- When a user specifies e.g. a line breakpoint using :break, we'll reverse
engineer what a Tick index for that line
- We update the `BreakArray` of that module (got from the
LoaderState) at that tick index to `breakOn`.
- A BCO we can stop at is headed by a BRK_FUN instruction. This
instruction stores in an operand the `tick index` it is associated
to. We look it up in the associated `BreakArray` (also an operand)
and check wheter it was set to `breakOn`.
- The second, aka the `ibi_info_mod` + `ibi_info_ix` of the
`InternalBreakpointId`, uniquely index into the `imodBreaks_breakInfo`
-- the information we gathered during code generation about the
existing breakpoint *ocurrences*.
- Note that with optimisation there may be many occurrences of the
same source-tick-breakpoint across different modules. The
`ibi_info_ix` is unique per occurrence, but the `bi_tick_ix` may be
shared. See Note [Breakpoint identifiers] about this.
- Note that besides the tick ids, info ids are also stored in
`BRK_FUN` so the break handler can refer to the associated
`CgBreakInfo`.
In light of that, the driving changes come from the desire to have the
info_id uniquely identify the breakpoint at runtime, and the source tick
id being derived from it:
- An InternalBreakpointId should uniquely identify a breakpoint just
from the code-generation identifiers of `ibi_info_ix` and `ibi_info_mod`.
So we drop `ibi_tick_mod` and `ibi_tick_ix`.
- A BRK_FUN instruction need only record the "internal breakpoint id",
not the tick-level id.
So we drop the tick mod and tick index operands.
- A BreakArray should be indexed by InternalBreakpointId rather than
BreakpointId
That means we need to do some more work when setting a breakpoint.
Specifically, we need to figure out the internal ids (occurrences of a
breakpoint) from the source-level BreakpointId we want to set the
breakpoint at (recall :break refers to breaks at the source level).
Besides this change being an improvement to the handling of breakpoints
(it's clearer to have a single unique identifier than two competing
ones), it unlocks the possibility of generating "internal" breakpoints
during Cg (needed for #26042).
It should also be easier to introduce multi-threaded-aware `BreakArrays`
following this change (needed for #26064).
Se also the new Note [ModBreaks vs InternalModBreaks]
On i386-linux:
-------------------------
Metric Decrease:
interpreter_steplocal
-------------------------
- - - - -
bf03bbaa by Simon Hengel at 2025-08-01T04:39:05-04:00
Don't use MCDiagnostic for `ghcExit`
This changes the error message of `ghcExit` from
```
<no location info>: error:
Compilation had errors
```
to
```
Compilation had errors
```
- - - - -
a889ec75 by Simon Hengel at 2025-08-01T04:39:05-04:00
Respect `-fdiagnostics-as-json` for driver diagnostics (see #24113)
- - - - -
8e4e328a by Andreas Klebinger at 2025-08-01T09:10:51+00:00
rts: Support COFF BigObj files in archives.
- - - - -
25 changed files:
- compiler/GHC/ByteCode/Asm.hs
- compiler/GHC/ByteCode/Breakpoints.hs
- compiler/GHC/ByteCode/Instr.hs
- compiler/GHC/ByteCode/Linker.hs
- compiler/GHC/ByteCode/Types.hs
- compiler/GHC/CoreToIface.hs
- compiler/GHC/Driver/Make.hs
- compiler/GHC/HsToCore/Breakpoints.hs
- compiler/GHC/Linker/Loader.hs
- compiler/GHC/Runtime/Debugger/Breakpoints.hs
- compiler/GHC/Runtime/Eval.hs
- compiler/GHC/Runtime/Interpreter.hs
- compiler/GHC/StgToByteCode.hs
- compiler/GHC/SysTools/Tasks.hs
- compiler/GHC/Utils/Error.hs
- ghc/GHCi/UI.hs
- ghc/GHCi/UI/Monad.hs
- libraries/ghci/GHCi/Debugger.hs
- libraries/ghci/GHCi/Message.hs
- libraries/ghci/GHCi/Run.hs
- rts/Disassembler.c
- rts/Exception.cmm
- rts/Interpreter.c
- rts/linker/LoadArchive.c
- testsuite/tests/corelint/T21115b.stderr
Changes:
=====================================
compiler/GHC/ByteCode/Asm.hs
=====================================
@@ -841,24 +841,18 @@ assembleI platform i = case i of
W8 -> emit_ bci_OP_INDEX_ADDR_08 []
_ -> unsupported_width
- BRK_FUN (InternalBreakpointId tick_mod tickx info_mod infox) -> do
+ BRK_FUN ibi@(InternalBreakpointId info_mod infox) -> do
+ p1 <- ptr $ BCOPtrBreakArray info_mod
let -- cast that checks that round-tripping through Word16 doesn't change the value
toW16 x = let r = fromIntegral x :: Word16
in if fromIntegral r == x
then r
else pprPanic "schemeER_wrk: breakpoint tick/info index too large!" (ppr x)
- p1 <- ptr $ BCOPtrBreakArray tick_mod
- tick_addr <- lit1 $ BCONPtrFS $ moduleNameFS $ moduleName tick_mod
- info_addr <- lit1 $ BCONPtrFS $ moduleNameFS $ moduleName info_mod
- tick_unitid_addr <- lit1 $ BCONPtrFS $ unitIdFS $ moduleUnitId $ tick_mod
- info_unitid_addr <- lit1 $ BCONPtrFS $ unitIdFS $ moduleUnitId $ info_mod
- np <- lit1 $ BCONPtrCostCentre (BreakpointId tick_mod tickx)
- emit_ bci_BRK_FUN [ Op p1
- , Op tick_addr, Op info_addr
- , Op tick_unitid_addr, Op info_unitid_addr
- , SmallOp (toW16 tickx), SmallOp (toW16 infox)
- , Op np
- ]
+ info_addr <- lit1 $ BCONPtrFS $ moduleNameFS $ moduleName info_mod
+ info_unitid_addr <- lit1 $ BCONPtrFS $ unitIdFS $ moduleUnitId info_mod
+ np <- lit1 $ BCONPtrCostCentre ibi
+ emit_ bci_BRK_FUN [ Op p1, Op info_addr, Op info_unitid_addr
+ , SmallOp (toW16 infox), Op np ]
BRK_ALTS active -> emit_ bci_BRK_ALTS [SmallOp (if active then 1 else 0)]
=====================================
compiler/GHC/ByteCode/Breakpoints.hs
=====================================
@@ -7,23 +7,23 @@
-- 'InternalModBreaks', and is uniquely identified at runtime by an
-- 'InternalBreakpointId'.
--
--- See Note [Breakpoint identifiers]
+-- See Note [ModBreaks vs InternalModBreaks] and Note [Breakpoint identifiers]
module GHC.ByteCode.Breakpoints
( -- * Internal Mod Breaks
InternalModBreaks(..), CgBreakInfo(..)
- , mkInternalModBreaks
+ , mkInternalModBreaks, imodBreaks_module
-- ** Internal breakpoint identifier
, InternalBreakpointId(..), BreakInfoIndex
-- * Operations
- , toBreakpointId
-- ** Internal-level operations
- , getInternalBreak, addInternalBreak
+ , getInternalBreak
-- ** Source-level information operations
, getBreakLoc, getBreakVars, getBreakDecls, getBreakCCS
+ , getBreakSourceId
-- * Utils
, seqInternalModBreaks
@@ -47,6 +47,31 @@ import GHC.Utils.Panic
import Data.Array
{-
+Note [ModBreaks vs InternalModBreaks]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+'ModBreaks' and 'BreakpointId's must not to be confused with
+'InternalModBreaks' and 'InternalBreakId's.
+
+'ModBreaks' is constructed once during HsToCore from the information attached
+to source-level breakpoint ticks and is never changed afterwards. A 'ModBreaks'
+can be queried using 'BreakpointId's, which uniquely identifies a breakpoint
+within the list of breakpoint information for a given module's 'ModBreaks'.
+
+'InternalModBreaks' are constructed during bytecode generation and are indexed
+by a 'InternalBreakpointId'. They contain all the information relevant to a
+breakpoint for code generation that can be accessed during runtime execution
+(such as a 'BreakArray' for triggering breakpoints). 'InternalBreakpointId's
+are used at runtime to trigger and inspect breakpoints -- a 'BRK_FUN'
+instruction receives 'InternalBreakpointId' as an argument.
+
+We keep a mapping from 'InternalModBreaks' to a 'BreakpointId', which can then be used
+to get source-level information about a breakpoint via the corresponding 'ModBreaks'.
+
+Notably, 'InternalModBreaks' can contain entries for so-called internal
+breakpoints, which do not necessarily have a source-level location attached to
+it (i.e. do not have a matching entry in 'ModBreaks'). We may leverage this to
+introduce breakpoints during code generation for features such as stepping-out.
+
Note [Breakpoint identifiers]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Before optimization a breakpoint is identified uniquely with a tick module
@@ -64,6 +89,10 @@ So every breakpoint occurrence gets assigned a module-unique *info index* and
we store it alongside the occurrence module (*info module*) in the
'InternalBreakpointId' datatype. This is the index that we use at runtime to
identify a breakpoint.
+
+When the internal breakpoint has a matching tick-level breakpoint we can fetch
+the related tick-level information by first looking up a mapping
+@'InternalBreakpointId' -> 'BreakpointId'@ in @'CgBreakInfo'@.
-}
--------------------------------------------------------------------------------
@@ -78,19 +107,11 @@ type BreakInfoIndex = Int
-- Indexes into the structures in the @'InternalModBreaks'@ produced during ByteCode generation.
-- See Note [Breakpoint identifiers]
data InternalBreakpointId = InternalBreakpointId
- { ibi_tick_mod :: !Module -- ^ Breakpoint tick module
- , ibi_tick_index :: !Int -- ^ Breakpoint tick index
- , ibi_info_mod :: !Module -- ^ Breakpoint tick module
- , ibi_info_index :: !BreakInfoIndex -- ^ Breakpoint tick index
+ { ibi_info_mod :: !Module -- ^ Breakpoint info module
+ , ibi_info_index :: !BreakInfoIndex -- ^ Breakpoint info index
}
deriving (Eq, Ord)
-toBreakpointId :: InternalBreakpointId -> BreakpointId
-toBreakpointId ibi = BreakpointId
- { bi_tick_mod = ibi_tick_mod ibi
- , bi_tick_index = ibi_tick_index ibi
- }
-
--------------------------------------------------------------------------------
-- * Internal Mod Breaks
--------------------------------------------------------------------------------
@@ -107,18 +128,34 @@ data InternalModBreaks = InternalModBreaks
-- 'InternalBreakpointId'.
, imodBreaks_modBreaks :: !ModBreaks
- -- ^ Store the original ModBreaks for this module, unchanged.
- -- Allows us to query about source-level breakpoint information using
- -- an internal breakpoint id.
+ -- ^ Store the ModBreaks for this module
+ --
+ -- Recall Note [Breakpoint identifiers]: for some module A, an
+ -- *occurrence* of a breakpoint in A may have been inlined from some
+ -- breakpoint *defined* in module B.
+ --
+ -- This 'ModBreaks' contains information regarding all the breakpoints
+ -- defined in the module this 'InternalModBreaks' corresponds to. It
+ -- /does not/ necessarily have information regarding all the breakpoint
+ -- occurrences registered in 'imodBreaks_breakInfo'. Some of those
+ -- occurrences may refer breakpoints inlined from other modules.
}
--- | Construct an 'InternalModBreaks'
+-- | Construct an 'InternalModBreaks'.
+--
+-- INVARIANT: The given 'ModBreaks' correspond to the same module as this
+-- 'InternalModBreaks' module (the first argument) and its breakpoint infos
+-- (the @IntMap CgBreakInfo@ argument)
mkInternalModBreaks :: Module -> IntMap CgBreakInfo -> ModBreaks -> InternalModBreaks
mkInternalModBreaks mod im mbs =
assertPpr (mod == modBreaks_module mbs)
(text "Constructing InternalModBreaks with the ModBreaks of a different module!") $
InternalModBreaks im mbs
+-- | Get the module to which these 'InternalModBreaks' correspond
+imodBreaks_module :: InternalModBreaks -> Module
+imodBreaks_module = modBreaks_module . imodBreaks_modBreaks
+
-- | Information about a breakpoint that we know at code-generation time
-- In order to be used, this needs to be hydrated relative to the current HscEnv by
-- 'hydrateCgBreakInfo'. Everything here can be fully forced and that's critical for
@@ -128,20 +165,22 @@ data CgBreakInfo
{ cgb_tyvars :: ![IfaceTvBndr] -- ^ Type variables in scope at the breakpoint
, cgb_vars :: ![Maybe (IfaceIdBndr, Word)]
, cgb_resty :: !IfaceType
+ , cgb_tick_id :: !BreakpointId
+ -- ^ This field records the original breakpoint tick identifier for this
+ -- internal breakpoint info. It is used to convert a breakpoint
+ -- *occurrence* index ('InternalBreakpointId') into a *definition* index
+ -- ('BreakpointId').
+ --
+ -- The modules of breakpoint occurrence and breakpoint definition are not
+ -- necessarily the same: See Note [Breakpoint identifiers].
}
-- See Note [Syncing breakpoint info] in GHC.Runtime.Eval
-- | Get an internal breakpoint info by 'InternalBreakpointId'
getInternalBreak :: InternalBreakpointId -> InternalModBreaks -> CgBreakInfo
-getInternalBreak (InternalBreakpointId _ _ info_mod info_ix) imbs =
- assert_modules_match info_mod (modBreaks_module $ imodBreaks_modBreaks imbs) $
- imodBreaks_breakInfo imbs IM.! info_ix
-
--- | Add a CgBreakInfo to an 'InternalModBreaks' at 'InternalBreakpointId'
-addInternalBreak :: InternalBreakpointId -> CgBreakInfo -> InternalModBreaks -> InternalModBreaks
-addInternalBreak (InternalBreakpointId _ _ info_mod info_ix) info imbs =
- assert_modules_match info_mod (modBreaks_module $ imodBreaks_modBreaks imbs) $
- imbs{imodBreaks_breakInfo = IM.insert info_ix info (imodBreaks_breakInfo imbs)}
+getInternalBreak (InternalBreakpointId mod ix) imbs =
+ assert_modules_match mod (imodBreaks_module imbs) $
+ imodBreaks_breakInfo imbs IM.! ix
-- | Assert that the module in the 'InternalBreakpointId' and in
-- 'InternalModBreaks' match.
@@ -155,27 +194,56 @@ assert_modules_match ibi_mod imbs_mod =
-- Tick-level Breakpoint information
--------------------------------------------------------------------------------
+-- | Get the source module and tick index for this breakpoint
+-- (as opposed to the module where this breakpoint occurs, which is in 'InternalBreakpointId')
+getBreakSourceId :: InternalBreakpointId -> InternalModBreaks -> BreakpointId
+getBreakSourceId (InternalBreakpointId ibi_mod ibi_ix) imbs =
+ assert_modules_match ibi_mod (imodBreaks_module imbs) $
+ let cgb = imodBreaks_breakInfo imbs IM.! ibi_ix
+ in cgb_tick_id cgb
+
-- | Get the source span for this breakpoint
-getBreakLoc :: InternalBreakpointId -> InternalModBreaks -> SrcSpan
+getBreakLoc :: (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO SrcSpan
getBreakLoc = getBreakXXX modBreaks_locs
-- | Get the vars for this breakpoint
-getBreakVars :: InternalBreakpointId -> InternalModBreaks -> [OccName]
+getBreakVars :: (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO [OccName]
getBreakVars = getBreakXXX modBreaks_vars
-- | Get the decls for this breakpoint
-getBreakDecls :: InternalBreakpointId -> InternalModBreaks -> [String]
+getBreakDecls :: (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO [String]
getBreakDecls = getBreakXXX modBreaks_decls
-- | Get the decls for this breakpoint
-getBreakCCS :: InternalBreakpointId -> InternalModBreaks -> (String, String)
+getBreakCCS :: (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO (String, String)
getBreakCCS = getBreakXXX modBreaks_ccs
-- | Internal utility to access a ModBreaks field at a particular breakpoint index
-getBreakXXX :: (ModBreaks -> Array BreakTickIndex a) -> InternalBreakpointId -> InternalModBreaks -> a
-getBreakXXX view (InternalBreakpointId tick_mod tick_id _ _) imbs =
- assert_modules_match tick_mod (modBreaks_module $ imodBreaks_modBreaks imbs) $ do
- view (imodBreaks_modBreaks imbs) ! tick_id
+--
+-- Recall Note [Breakpoint identifiers]: the internal breakpoint module (the
+-- *occurrence* module) doesn't necessarily match the module where the
+-- tick breakpoint was defined with the relevant 'ModBreaks'.
+--
+-- When the tick module is the same as the internal module, we use the stored
+-- 'ModBreaks'. When the tick module is different, we need to look up the
+-- 'ModBreaks' in the HUG for that other module.
+--
+-- To avoid cyclic dependencies, we instead receive a function that looks up
+-- the 'ModBreaks' given a 'Module'
+getBreakXXX :: (ModBreaks -> Array BreakTickIndex a) -> (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO a
+getBreakXXX view lookupModule (InternalBreakpointId ibi_mod ibi_ix) imbs =
+ assert_modules_match ibi_mod (imodBreaks_module imbs) $ do
+ let cgb = imodBreaks_breakInfo imbs IM.! ibi_ix
+ case cgb_tick_id cgb of
+ BreakpointId{bi_tick_mod, bi_tick_index}
+ | bi_tick_mod == ibi_mod
+ -> do
+ let these_mbs = imodBreaks_modBreaks imbs
+ return $ view these_mbs ! bi_tick_index
+ | otherwise
+ -> do
+ other_mbs <- lookupModule bi_tick_mod
+ return $ view other_mbs ! bi_tick_index
--------------------------------------------------------------------------------
-- Instances
@@ -190,7 +258,8 @@ seqInternalModBreaks InternalModBreaks{..} =
seqCgBreakInfo CgBreakInfo{..} =
rnf cgb_tyvars `seq`
rnf cgb_vars `seq`
- rnf cgb_resty
+ rnf cgb_resty `seq`
+ rnf cgb_tick_id
instance Outputable InternalBreakpointId where
ppr InternalBreakpointId{..} =
@@ -203,4 +272,5 @@ instance NFData InternalBreakpointId where
instance Outputable CgBreakInfo where
ppr info = text "CgBreakInfo" <+>
parens (ppr (cgb_vars info) <+>
- ppr (cgb_resty info))
+ ppr (cgb_resty info) <+>
+ ppr (cgb_tick_id info))
=====================================
compiler/GHC/ByteCode/Instr.hs
=====================================
@@ -454,9 +454,8 @@ instance Outputable BCInstr where
ppr ENTER = text "ENTER"
ppr (RETURN pk) = text "RETURN " <+> ppr pk
ppr (RETURN_TUPLE) = text "RETURN_TUPLE"
- ppr (BRK_FUN (InternalBreakpointId tick_mod tickx info_mod infox))
+ ppr (BRK_FUN (InternalBreakpointId info_mod infox))
= text "BRK_FUN" <+> text "<breakarray>"
- <+> ppr tick_mod <+> ppr tickx
<+> ppr info_mod <+> ppr infox
<+> text "<cc>"
ppr (BRK_ALTS active) = text "BRK_ALTS" <+> ppr active
=====================================
compiler/GHC/ByteCode/Linker.hs
=====================================
@@ -98,9 +98,9 @@ lookupLiteral interp pkgs_loaded le lb ptr = case ptr of
BCONPtrFFIInfo (FFIInfo {..}) -> do
RemotePtr p <- interpCmd interp $ PrepFFI ffiInfoArgs ffiInfoRet
pure $ fromIntegral p
- BCONPtrCostCentre BreakpointId{..}
+ BCONPtrCostCentre InternalBreakpointId{..}
| interpreterProfiled interp -> do
- case expectJust (lookupModuleEnv (ccs_env lb) bi_tick_mod) ! bi_tick_index of
+ case expectJust (lookupModuleEnv (ccs_env lb) ibi_info_mod) ! ibi_info_index of
RemotePtr p -> pure $ fromIntegral p
| otherwise ->
case toRemotePtr nullPtr of
=====================================
compiler/GHC/ByteCode/Types.hs
=====================================
@@ -285,7 +285,7 @@ data BCONPtr
-- | A libffi ffi_cif function prototype.
| BCONPtrFFIInfo !FFIInfo
-- | A 'CostCentre' remote pointer array's respective 'BreakpointId'
- | BCONPtrCostCentre !BreakpointId
+ | BCONPtrCostCentre !InternalBreakpointId
instance NFData BCONPtr where
rnf x = x `seq` ()
=====================================
compiler/GHC/CoreToIface.hs
=====================================
@@ -704,12 +704,13 @@ toIfaceLFInfo nm lfi = case lfi of
-- Dehydrating CgBreakInfo
-dehydrateCgBreakInfo :: [TyVar] -> [Maybe (Id, Word)] -> Type -> CgBreakInfo
-dehydrateCgBreakInfo ty_vars idOffSets tick_ty =
+dehydrateCgBreakInfo :: [TyVar] -> [Maybe (Id, Word)] -> Type -> BreakpointId -> CgBreakInfo
+dehydrateCgBreakInfo ty_vars idOffSets tick_ty bid =
CgBreakInfo
{ cgb_tyvars = map toIfaceTvBndr ty_vars
, cgb_vars = map (fmap (\(i, offset) -> (toIfaceIdBndr i, offset))) idOffSets
, cgb_resty = toIfaceType tick_ty
+ , cgb_tick_id = bid
}
{- Note [Inlining and hs-boot files]
=====================================
compiler/GHC/Driver/Make.hs
=====================================
@@ -1552,7 +1552,7 @@ wrapAction msg_wrapper hsc_env k = do
-- ThreadKilled in particular needs to actually kill the thread.
-- So rethrow that and the other async exceptions
Just (err :: SomeAsyncException) -> throwIO err
- _ -> errorMsg lcl_logger (text (show exc))
+ _ -> reportError lcl_logger neverQualify emptyDiagOpts noSrcSpan (text (show exc))
return Nothing
=====================================
compiler/GHC/HsToCore/Breakpoints.hs
=====================================
@@ -12,7 +12,7 @@
-- 'InternalModBreaks' and 'InternalBreakId's. The latter are constructed
-- during bytecode generation and can be found in 'GHC.ByteCode.Breakpoints'.
--
--- See Note [Breakpoint identifiers]
+-- See Note [ModBreaks vs InternalModBreaks] and Note [Breakpoint identifiers]
module GHC.HsToCore.Breakpoints
( -- * ModBreaks
mkModBreaks, ModBreaks(..)
=====================================
compiler/GHC/Linker/Loader.hs
=====================================
@@ -43,6 +43,7 @@ import GHC.Settings
import GHC.Platform
import GHC.Platform.Ways
+import GHC.Driver.Errors
import GHC.Driver.Phases
import GHC.Driver.Env
import GHC.Driver.Session
@@ -50,7 +51,7 @@ import GHC.Driver.Ppr
import GHC.Driver.Config.Diagnostic
import GHC.Driver.Config.Finder
-import GHC.Tc.Utils.Monad
+import GHC.Tc.Utils.Monad hiding (reportDiagnostic)
import GHC.Runtime.Interpreter
import GHCi.BreakArray
@@ -124,7 +125,9 @@ import GHC.Utils.Exception
import GHC.Unit.Home.Graph (lookupHug, unitEnv_foldWithKey)
import GHC.Driver.Downsweep
import qualified GHC.Runtime.Interpreter as GHCi
-import Data.Array.Base (numElements)
+import qualified Data.IntMap.Strict as IM
+import qualified Data.Map.Strict as M
+import Foreign.Ptr (nullPtr)
-- Note [Linkers and loaders]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -1307,9 +1310,9 @@ load_dyn interp hsc_env crash_early dll = do
then cmdLineErrorIO err
else do
when (diag_wopt Opt_WarnMissedExtraSharedLib diag_opts)
- $ logMsg logger
- (mkMCDiagnostic diag_opts (WarningWithFlag Opt_WarnMissedExtraSharedLib) Nothing)
- noSrcSpan $ withPprStyle defaultUserStyle (note err)
+ $ reportDiagnostic logger
+ neverQualify diag_opts
+ noSrcSpan (WarningWithFlag Opt_WarnMissedExtraSharedLib) $ withPprStyle defaultUserStyle (note err)
pure Nothing
where
diag_opts = initDiagOpts (hsc_dflags hsc_env)
@@ -1497,8 +1500,7 @@ locateLib interp hsc_env is_hs lib_dirs gcc_dirs lib0
, not loading_dynamic_hs_libs
, interpreterProfiled interp
= do
- let diag = mkMCDiagnostic diag_opts WarningWithoutFlag Nothing
- logMsg logger diag noSrcSpan $ withPprStyle defaultErrStyle $
+ reportDiagnostic logger neverQualify diag_opts noSrcSpan WarningWithoutFlag $ withPprStyle defaultErrStyle $
text "Interpreter failed to load profiled static library" <+> text lib <> char '.' $$
text " \tTrying dynamic library instead. If this fails try to rebuild" <+>
text "libraries with profiling support."
@@ -1666,10 +1668,10 @@ allocateBreakArrays ::
IO (ModuleEnv (ForeignRef BreakArray))
allocateBreakArrays interp =
foldlM
- ( \be0 InternalModBreaks{imodBreaks_modBreaks=ModBreaks {..}} -> do
+ ( \be0 InternalModBreaks{imodBreaks_breakInfo, imodBreaks_modBreaks=ModBreaks {..}} -> do
-- If no BreakArray is assigned to this module yet, create one
if not $ elemModuleEnv modBreaks_module be0 then do
- let count = numElements modBreaks_locs
+ let count = maybe 0 ((+1) . fst) $ IM.lookupMax imodBreaks_breakInfo
breakArray <- GHCi.newBreakArray interp count
evaluate $ extendModuleEnv be0 modBreaks_module breakArray
else
@@ -1679,29 +1681,51 @@ allocateBreakArrays interp =
-- | Given a list of 'InternalModBreaks' collected from a list
-- of 'CompiledByteCode', allocate the 'CostCentre' arrays when profiling is
-- enabled.
+--
+-- Note that the resulting arrays are indexed by 'BreakInfoIndex' (internal
+-- breakpoint index), not by tick index
allocateCCS ::
Interp ->
- ModuleEnv (Array BreakTickIndex (RemotePtr CostCentre)) ->
+ ModuleEnv (Array BreakInfoIndex (RemotePtr CostCentre)) ->
[InternalModBreaks] ->
- IO (ModuleEnv (Array BreakTickIndex (RemotePtr CostCentre)))
+ IO (ModuleEnv (Array BreakInfoIndex (RemotePtr CostCentre)))
allocateCCS interp ce mbss
- | interpreterProfiled interp =
- foldlM
- ( \ce0 InternalModBreaks{imodBreaks_modBreaks=ModBreaks {..}} -> do
- ccs <-
+ | interpreterProfiled interp = do
+ -- 1. Create a mapping from source BreakpointId to CostCentre ptr
+ ccss <- M.unions <$> mapM
+ ( \InternalModBreaks{imodBreaks_modBreaks=ModBreaks{..}} -> do
+ ccs <- {- one ccs ptr per tick index -}
mkCostCentres
interp
(moduleNameString $ moduleName modBreaks_module)
(elems modBreaks_ccs)
- if not $ elemModuleEnv modBreaks_module ce0 then do
- evaluate $
- extendModuleEnv ce0 modBreaks_module $
- listArray
- (0, length ccs - 1)
- ccs
+ return $ M.fromList $
+ zipWith (\el ix -> (BreakpointId modBreaks_module ix, el)) ccs [0..]
+ )
+ mbss
+ -- 2. Create an array with one element for every InternalBreakpointId,
+ -- where every element has the CCS for the corresponding BreakpointId
+ foldlM
+ (\ce0 InternalModBreaks{imodBreaks_breakInfo, imodBreaks_modBreaks=ModBreaks{..}} -> do
+ if not $ elemModuleEnv modBreaks_module ce then do
+ let count = maybe 0 ((+1) . fst) $ IM.lookupMax imodBreaks_breakInfo
+ let ccs = IM.map
+ (\info ->
+ fromMaybe (toRemotePtr nullPtr)
+ (M.lookup (cgb_tick_id info) ccss)
+ )
+ imodBreaks_breakInfo
+ assertPpr (count == length ccs)
+ (text "expected CgBreakInfo map to have one entry per valid ix") $
+ evaluate $
+ extendModuleEnv ce0 modBreaks_module $
+ listArray
+ (0, count)
+ (IM.elems ccs)
else
return ce0
)
ce
mbss
+
| otherwise = pure ce
=====================================
compiler/GHC/Runtime/Debugger/Breakpoints.hs
=====================================
@@ -31,6 +31,9 @@ import GHC.Unit.Module.ModSummary
import GHC.Utils.Outputable
import GHC.Utils.Panic
import qualified GHC.Data.Strict as Strict
+import qualified Data.IntMap.Strict as IntMap
+import qualified GHC.Unit.Home.Graph as HUG
+import qualified GHC.Unit.Home.PackageTable as HPT
--------------------------------------------------------------------------------
-- Finding Module breakpoints
@@ -213,6 +216,47 @@ getModBreak m = do
mod_info <- fromMaybe (panic "getModBreak") <$> getModuleInfo m
pure $ imodBreaks_modBreaks <$> modInfoModBreaks mod_info
+--------------------------------------------------------------------------------
+-- Mapping source-level BreakpointIds to IBI occurrences
+-- (See Note [Breakpoint identifiers])
+--------------------------------------------------------------------------------
+
+-- | A source-level breakpoint may have been inlined into many occurrences, now
+-- referred by 'InternalBreakpointId'. When a breakpoint is set on a certain
+-- source breakpoint, it means all *ocurrences* of that breakpoint across
+-- modules should be stopped at -- hence we keep a trie from BreakpointId to
+-- the list of internal break ids using it.
+-- See also Note [Breakpoint identifiers]
+type BreakpointOccurrences = ModuleEnv (IntMap.IntMap [InternalBreakpointId])
+
+-- | Lookup all InternalBreakpointIds matching the given BreakpointId
+-- Nothing if BreakpointId not in map
+lookupBreakpointOccurrences :: BreakpointOccurrences -> BreakpointId -> Maybe [InternalBreakpointId]
+lookupBreakpointOccurrences bmp (BreakpointId md tick) =
+ lookupModuleEnv bmp md >>= IntMap.lookup tick
+
+-- | Construct a mapping from Source 'BreakpointId's to 'InternalBreakpointId's from the given list of 'ModInfo's
+mkBreakpointOccurrences :: forall m. GhcMonad m => m BreakpointOccurrences
+mkBreakpointOccurrences = do
+ hug <- hsc_HUG <$> getSession
+ liftIO $ foldr go (pure emptyModuleEnv) hug
+ where
+ go :: HUG.HomeUnitEnv -> IO BreakpointOccurrences -> IO BreakpointOccurrences
+ go hue mbmp = do
+ bmp <- mbmp
+ ibrkss <- HPT.concatHpt (\hmi -> maybeToList (getModBreaks hmi))
+ (HUG.homeUnitEnv_hpt hue)
+ return $ foldr addBreakToMap bmp ibrkss
+
+ addBreakToMap :: InternalModBreaks -> BreakpointOccurrences -> BreakpointOccurrences
+ addBreakToMap ibrks bmp0 = do
+ let imod = modBreaks_module $ imodBreaks_modBreaks ibrks
+ IntMap.foldrWithKey (\info_ix cgi bmp -> do
+ let ibi = InternalBreakpointId imod info_ix
+ let BreakpointId tick_mod tick_ix = cgb_tick_id cgi
+ extendModuleEnvWith (IntMap.unionWith (S.<>)) bmp tick_mod (IntMap.singleton tick_ix [ibi])
+ ) bmp0 (imodBreaks_breakInfo ibrks)
+
--------------------------------------------------------------------------------
-- Getting current breakpoint information
--------------------------------------------------------------------------------
@@ -235,9 +279,15 @@ getCurrentBreakSpan = do
getCurrentBreakModule :: GhcMonad m => m (Maybe Module)
getCurrentBreakModule = do
resumes <- getResumeContext
- return $ case resumes of
- [] -> Nothing
+ hug <- hsc_HUG <$> getSession
+ liftIO $ case resumes of
+ [] -> pure Nothing
(r:_) -> case resumeHistoryIx r of
- 0 -> ibi_tick_mod <$> resumeBreakpointId r
- ix -> Just $ getHistoryModule $ resumeHistory r !! (ix-1)
+ 0 -> case resumeBreakpointId r of
+ Nothing -> pure Nothing
+ Just ibi -> do
+ brks <- readIModBreaks hug ibi
+ return $ Just $ bi_tick_mod $ getBreakSourceId ibi brks
+ ix ->
+ Just <$> getHistoryModule hug (resumeHistory r !! (ix-1))
=====================================
compiler/GHC/Runtime/Eval.hs
=====================================
@@ -18,7 +18,7 @@ module GHC.Runtime.Eval (
abandon, abandonAll,
getResumeContext,
getHistorySpan,
- getModBreaks, readModBreaks,
+ getModBreaks, readIModBreaks, readIModModBreaks,
getHistoryModule,
setupBreakpoint,
back, forward,
@@ -147,14 +147,17 @@ getResumeContext = withSession (return . ic_resume . hsc_IC)
mkHistory :: HUG.HomeUnitGraph -> ForeignHValue -> InternalBreakpointId -> IO History
mkHistory hug hval ibi = History hval ibi <$> findEnclosingDecls hug ibi
-getHistoryModule :: History -> Module
-getHistoryModule = ibi_tick_mod . historyBreakpointId
+getHistoryModule :: HUG.HomeUnitGraph -> History -> IO Module
+getHistoryModule hug hist = do
+ let ibi = historyBreakpointId hist
+ brks <- readIModBreaks hug ibi
+ return $ bi_tick_mod $ getBreakSourceId ibi brks
getHistorySpan :: HUG.HomeUnitGraph -> History -> IO SrcSpan
getHistorySpan hug hist = do
let ibi = historyBreakpointId hist
- brks <- readModBreaks hug (ibi_tick_mod ibi)
- return $ getBreakLoc ibi brks
+ brks <- readIModBreaks hug ibi
+ getBreakLoc (readIModModBreaks hug) ibi brks
{- | Finds the enclosing top level function name -}
-- ToDo: a better way to do this would be to keep hold of the decl_path computed
@@ -162,8 +165,8 @@ getHistorySpan hug hist = do
-- for each tick.
findEnclosingDecls :: HUG.HomeUnitGraph -> InternalBreakpointId -> IO [String]
findEnclosingDecls hug ibi = do
- brks <- readModBreaks hug (ibi_tick_mod ibi)
- return $ getBreakDecls ibi brks
+ brks <- readIModBreaks hug ibi
+ getBreakDecls (readIModModBreaks hug) ibi brks
-- | Update fixity environment in the current interactive context.
updateFixityEnv :: GhcMonad m => FixityEnv -> m ()
@@ -350,15 +353,14 @@ handleRunStatus step expr bindings final_ids status history0 = do
EvalBreak apStack_ref (Just eval_break) resume_ctxt ccs -> do
let ibi = evalBreakpointToId eval_break
let hug = hsc_HUG hsc_env
- tick_brks <- liftIO $ readModBreaks hug (ibi_tick_mod ibi)
- let
- span = getBreakLoc ibi tick_brks
- decl = intercalate "." $ getBreakDecls ibi tick_brks
+ info_brks <- liftIO $ readIModBreaks hug ibi
+ span <- liftIO $ getBreakLoc (readIModModBreaks hug) ibi info_brks
+ decl <- liftIO $ intercalate "." <$> getBreakDecls (readIModModBreaks hug) ibi info_brks
-- Was this breakpoint explicitly enabled (ie. in @BreakArray@)?
bactive <- liftIO $ do
- breakArray <- getBreakArray interp (toBreakpointId ibi) tick_brks
- breakpointStatus interp breakArray (ibi_tick_index ibi)
+ breakArray <- getBreakArray interp ibi info_brks
+ breakpointStatus interp breakArray (ibi_info_index ibi)
apStack_fhv <- liftIO $ mkFinalizedHValue interp apStack_ref
resume_ctxt_fhv <- liftIO $ mkFinalizedHValue interp resume_ctxt
@@ -446,7 +448,7 @@ resumeExec step mbCnt
-- When the user specified a break ignore count, set it
-- in the interpreter
case (mb_brkpt, mbCnt) of
- (Just brkpt, Just cnt) -> setupBreakpoint interp (toBreakpointId brkpt) cnt
+ (Just brkpt, Just cnt) -> setupBreakpoint interp brkpt cnt
_ -> return ()
let eval_opts = initEvalOpts dflags (enableGhcStepMode step)
@@ -462,17 +464,18 @@ resumeExec step mbCnt
| otherwise -> pure prevHistoryLst
handleRunStatus step expr bindings final_ids status =<< hist'
-setupBreakpoint :: GhcMonad m => Interp -> BreakpointId -> Int -> m () -- #19157
-setupBreakpoint interp bi cnt = do
+setupBreakpoint :: GhcMonad m => Interp -> InternalBreakpointId -> Int -> m () -- #19157
+setupBreakpoint interp ibi cnt = do
hug <- hsc_HUG <$> getSession
- modBreaks <- liftIO $ readModBreaks hug (bi_tick_mod bi)
- breakArray <- liftIO $ getBreakArray interp bi modBreaks
- liftIO $ GHCi.storeBreakpoint interp breakArray (bi_tick_index bi) cnt
+ liftIO $ do
+ modBreaks <- readIModBreaks hug ibi
+ breakArray <- getBreakArray interp ibi modBreaks
+ GHCi.storeBreakpoint interp breakArray (ibi_info_index ibi) cnt
-getBreakArray :: Interp -> BreakpointId -> InternalModBreaks -> IO (ForeignRef BreakArray)
-getBreakArray interp BreakpointId{bi_tick_mod} imbs = do
+getBreakArray :: Interp -> InternalBreakpointId -> InternalModBreaks -> IO (ForeignRef BreakArray)
+getBreakArray interp InternalBreakpointId{ibi_info_mod} imbs = do
breaks0 <- linked_breaks . fromMaybe (panic "Loader not initialised") <$> getLoaderState interp
- case lookupModuleEnv (breakarray_env breaks0) bi_tick_mod of
+ case lookupModuleEnv (breakarray_env breaks0) ibi_info_mod of
Just ba -> return ba
Nothing -> do
modifyLoaderState interp $ \ld_st -> do
@@ -483,13 +486,12 @@ getBreakArray interp BreakpointId{bi_tick_mod} imbs = do
ba_env <- allocateBreakArrays interp (breakarray_env lb) [imbs]
let ld_st' = ld_st { linked_breaks = lb{breakarray_env = ba_env} }
- let ba = expectJust {- just computed -} $ lookupModuleEnv ba_env bi_tick_mod
+ let ba = expectJust {- just computed -} $ lookupModuleEnv ba_env ibi_info_mod
return
( ld_st'
, ba
)
-
back :: GhcMonad m => Int -> m ([Name], Int, SrcSpan)
back n = moveHist (+n)
@@ -517,8 +519,9 @@ moveHist fn = do
span <- case mb_info of
Nothing -> return $ mkGeneralSrcSpan (fsLit "<unknown>")
Just ibi -> liftIO $ do
- brks <- readModBreaks (hsc_HUG hsc_env) (ibi_tick_mod ibi)
- return $ getBreakLoc ibi brks
+ let hug = hsc_HUG hsc_env
+ brks <- readIModBreaks hug ibi
+ getBreakLoc (readIModModBreaks hug) ibi brks
(hsc_env1, names) <-
liftIO $ bindLocalsAtBreakpoint hsc_env apStack span mb_info
let ic = hsc_IC hsc_env1
@@ -579,11 +582,10 @@ bindLocalsAtBreakpoint hsc_env apStack span Nothing = do
-- of the breakpoint and the free variables of the expression.
bindLocalsAtBreakpoint hsc_env apStack_fhv span (Just ibi) = do
let hug = hsc_HUG hsc_env
- info_brks <- readModBreaks hug (ibi_info_mod ibi)
- tick_brks <- readModBreaks hug (ibi_tick_mod ibi)
- let info = getInternalBreak ibi (info_brks)
+ info_brks <- readIModBreaks hug ibi
+ let info = getInternalBreak ibi info_brks
interp = hscInterp hsc_env
- occs = getBreakVars ibi tick_brks
+ occs <- getBreakVars (readIModModBreaks hug) ibi info_brks
-- Rehydrate to understand the breakpoint info relative to the current environment.
-- This design is critical to preventing leaks (#22530)
=====================================
compiler/GHC/Runtime/Interpreter.hs
=====================================
@@ -27,7 +27,9 @@ module GHC.Runtime.Interpreter
, getClosure
, whereFrom
, getModBreaks
- , readModBreaks
+ , readIModBreaks
+ , readIModBreaksMaybe
+ , readIModModBreaks
, seqHValue
, evalBreakpointToId
@@ -92,7 +94,6 @@ import GHC.Utils.Fingerprint
import GHC.Unit.Module
import GHC.Unit.Home.ModInfo
-import GHC.Unit.Home.Graph (lookupHugByModule)
import GHC.Unit.Env
#if defined(HAVE_INTERNAL_INTERPRETER)
@@ -411,15 +412,10 @@ evalBreakpointToId :: EvalBreakpoint -> InternalBreakpointId
evalBreakpointToId eval_break =
let
mkUnitId u = fsToUnit $ mkFastStringShortByteString u
-
toModule u n = mkModule (mkUnitId u) (mkModuleName n)
- tickl = toModule (eb_tick_mod_unit eval_break) (eb_tick_mod eval_break)
- infol = toModule (eb_info_mod_unit eval_break) (eb_info_mod eval_break)
in
InternalBreakpointId
- { ibi_tick_mod = tickl
- , ibi_tick_index = eb_tick_index eval_break
- , ibi_info_mod = infol
+ { ibi_info_mod = toModule (eb_info_mod_unit eval_break) (eb_info_mod eval_break)
, ibi_info_index = eb_info_index eval_break
}
@@ -440,17 +436,18 @@ handleSeqHValueStatus interp unit_env eval_status =
-- Reason: Setting of flags in libraries/ghci/GHCi/Run.hs:evalOptsSeq
Just break -> do
- let bi = evalBreakpointToId break
+ let ibi = evalBreakpointToId break
+ hug = ue_home_unit_graph unit_env
-- Just case: Stopped at a breakpoint, extract SrcSpan information
-- from the breakpoint.
- mb_modbreaks <- getModBreaks . expectJust <$>
- lookupHugByModule (ibi_tick_mod bi) (ue_home_unit_graph unit_env)
+ mb_modbreaks <- readIModBreaksMaybe hug (ibi_info_mod ibi)
case mb_modbreaks of
-- Nothing case - should not occur! We should have the appropriate
-- breakpoint information
Nothing -> nothing_case
- Just modbreaks -> put $ brackets . ppr $ getBreakLoc bi modbreaks
+ Just modbreaks -> put . brackets . ppr =<<
+ getBreakLoc (readIModModBreaks hug) ibi modbreaks
-- resume the seq (:force) processing in the iserv process
withForeignRef resume_ctxt_fhv $ \hval -> do
@@ -745,10 +742,18 @@ getModBreaks hmi
| otherwise
= Nothing -- probably object code
--- | Read the 'InternalModBreaks' and 'ModBreaks' of the given home 'Module'
--- from the 'HomeUnitGraph'.
-readModBreaks :: HomeUnitGraph -> Module -> IO InternalModBreaks
-readModBreaks hug modl = expectJust . getModBreaks . expectJust <$> HUG.lookupHugByModule modl hug
+-- | Read the 'InternalModBreaks' of the given home 'Module' (via
+-- 'InternalBreakpointId') from the 'HomeUnitGraph'.
+readIModBreaks :: HomeUnitGraph -> InternalBreakpointId -> IO InternalModBreaks
+readIModBreaks hug ibi = expectJust <$> readIModBreaksMaybe hug (ibi_info_mod ibi)
+
+-- | Read the 'InternalModBreaks' of the given home 'Module' from the 'HomeUnitGraph'.
+readIModBreaksMaybe :: HomeUnitGraph -> Module -> IO (Maybe InternalModBreaks)
+readIModBreaksMaybe hug mod = getModBreaks . expectJust <$> HUG.lookupHugByModule mod hug
+
+-- | Read the 'ModBreaks' from the given module's 'InternalModBreaks'
+readIModModBreaks :: HUG.HomeUnitGraph -> Module -> IO ModBreaks
+readIModModBreaks hug mod = imodBreaks_modBreaks . expectJust <$> readIModBreaksMaybe hug mod
-- -----------------------------------------------------------------------------
-- Misc utils
=====================================
compiler/GHC/StgToByteCode.hs
=====================================
@@ -31,7 +31,6 @@ import GHC.Cmm.Utils
import GHC.Platform
import GHC.Platform.Profile
-import GHC.Runtime.Interpreter
import GHCi.FFI
import GHC.Types.Basic
import GHC.Utils.Outputable
@@ -64,6 +63,7 @@ import GHC.StgToCmm.Closure ( NonVoid(..), fromNonVoid, idPrimRepU,
assertNonVoidIds, assertNonVoidStgArgs )
import GHC.StgToCmm.Layout
import GHC.Runtime.Heap.Layout hiding (WordOff, ByteOff, wordsToBytes)
+import GHC.Runtime.Interpreter ( interpreterProfiled )
import GHC.Data.Bitmap
import GHC.Data.FlatBag as FlatBag
import GHC.Data.OrdList
@@ -79,7 +79,6 @@ import Control.Monad
import Data.Char
import GHC.Unit.Module
-import qualified GHC.Unit.Home.Graph as HUG
import Data.Coerce (coerce)
#if MIN_VERSION_rts(1,0,3)
@@ -394,65 +393,28 @@ schemeR_wrk fvs nm original_body (args, body)
-- | Introduce break instructions for ticked expressions.
-- If no breakpoint information is available, the instruction is omitted.
schemeER_wrk :: StackDepth -> BCEnv -> CgStgExpr -> BcM BCInstrList
-schemeER_wrk d p (StgTick (Breakpoint tick_ty (BreakpointId tick_mod tick_no) fvs) rhs) = do
+schemeER_wrk d p (StgTick (Breakpoint tick_ty tick_id fvs) rhs) = do
code <- schemeE d 0 p rhs
- hsc_env <- getHscEnv
- current_mod <- getCurrentModule
mb_current_mod_breaks <- getCurrentModBreaks
case mb_current_mod_breaks of
-- if we're not generating ModBreaks for this module for some reason, we
-- can't store breakpoint occurrence information.
Nothing -> pure code
- Just current_mod_breaks -> break_info hsc_env tick_mod current_mod mb_current_mod_breaks >>= \case
- Nothing -> pure code
- Just ModBreaks{modBreaks_module = tick_mod} -> do
- platform <- profilePlatform <$> getProfile
- let idOffSets = getVarOffSets platform d p fvs
- ty_vars = tyCoVarsOfTypesWellScoped (tick_ty:map idType fvs)
- toWord :: Maybe (Id, WordOff) -> Maybe (Id, Word)
- toWord = fmap (\(i, wo) -> (i, fromIntegral wo))
- breakInfo = dehydrateCgBreakInfo ty_vars (map toWord idOffSets) tick_ty
+ Just current_mod_breaks -> do
+ platform <- profilePlatform <$> getProfile
+ let idOffSets = getVarOffSets platform d p fvs
+ ty_vars = tyCoVarsOfTypesWellScoped (tick_ty:map idType fvs)
+ toWord :: Maybe (Id, WordOff) -> Maybe (Id, Word)
+ toWord = fmap (\(i, wo) -> (i, fromIntegral wo))
+ breakInfo = dehydrateCgBreakInfo ty_vars (map toWord idOffSets) tick_ty tick_id
- let info_mod = modBreaks_module current_mod_breaks
- infox <- newBreakInfo breakInfo
+ let info_mod = modBreaks_module current_mod_breaks
+ infox <- newBreakInfo breakInfo
- let breakInstr = BRK_FUN (InternalBreakpointId tick_mod tick_no info_mod infox)
- return $ breakInstr `consOL` code
+ let breakInstr = BRK_FUN (InternalBreakpointId info_mod infox)
+ return $ breakInstr `consOL` code
schemeER_wrk d p rhs = schemeE d 0 p rhs
--- | Determine the GHCi-allocated 'BreakArray' and module pointer for the module
--- from which the breakpoint originates.
--- These are stored in 'ModBreaks' as remote pointers in order to allow the BCOs
--- to refer to pointers in GHCi's address space.
--- They are initialized in 'GHC.HsToCore.Breakpoints.mkModBreaks', called by
--- 'GHC.HsToCore.deSugar'.
---
--- Breakpoints might be disabled because we're in TH, because
--- @-fno-break-points@ was specified, or because a module was reloaded without
--- reinitializing 'ModBreaks'.
---
--- If the module stored in the breakpoint is the currently processed module, use
--- the 'ModBreaks' from the state.
--- If that is 'Nothing', consider breakpoints to be disabled and skip the
--- instruction.
---
--- If the breakpoint is inlined from another module, look it up in the HUG (home unit graph).
--- If the module doesn't exist there, or if the 'ModBreaks' value is
--- uninitialized, skip the instruction (i.e. return Nothing).
-break_info ::
- HscEnv ->
- Module ->
- Module ->
- Maybe ModBreaks ->
- BcM (Maybe ModBreaks)
-break_info hsc_env mod current_mod current_mod_breaks
- | mod == current_mod
- = pure current_mod_breaks
- | otherwise
- = liftIO (HUG.lookupHugByModule mod (hsc_HUG hsc_env)) >>= \case
- Just hp -> pure $ imodBreaks_modBreaks <$> getModBreaks hp
- Nothing -> pure Nothing
-
getVarOffSets :: Platform -> StackDepth -> BCEnv -> [Id] -> [Maybe (Id, WordOff)]
getVarOffSets platform depth env = map getOffSet
where
=====================================
compiler/GHC/SysTools/Tasks.hs
=====================================
@@ -55,7 +55,7 @@ import GHC.Driver.Config.Diagnostic
import GHC.Driver.Errors
import GHC.Driver.Errors.Types (GhcMessage(..), DriverMessage (DriverNoConfiguredLLVMToolchain))
import GHC.Driver.CmdLine (warnsToMessages)
-import GHC.Types.SrcLoc (noLoc)
+import GHC.Types.SrcLoc (noLoc, noSrcSpan)
{-
************************************************************************
@@ -346,7 +346,7 @@ figureLlvmVersion logger dflags = traceSystoolCommand logger "llc" $ do
debugTraceMsg logger 2
(text "Error (figuring out LLVM version):" <+>
text (show err))
- errorMsg logger $ vcat
+ reportError logger neverQualify emptyDiagOpts noSrcSpan $ vcat
[ text "Warning:", nest 9 $
text "Couldn't figure out LLVM version!" $$
text ("Make sure you have installed LLVM between ["
=====================================
compiler/GHC/Utils/Error.hs
=====================================
@@ -32,7 +32,7 @@ module GHC.Utils.Error (
emptyMessages, mkDecorated, mkLocMessage,
mkMsgEnvelope, mkPlainMsgEnvelope, mkPlainErrorMsgEnvelope,
mkErrorMsgEnvelope,
- mkMCDiagnostic, errorDiagnostic, diagReasonSeverity,
+ mkMCDiagnostic, diagReasonSeverity,
mkPlainError,
mkPlainDiagnostic,
@@ -46,7 +46,6 @@ module GHC.Utils.Error (
-- * Issuing messages during compilation
putMsg, printInfoForUser, printOutputForUser,
logInfo, logOutput,
- errorMsg,
fatalErrorMsg,
compilationProgressMsg,
showPass,
@@ -168,11 +167,6 @@ mkMCDiagnostic opts reason code = MCDiagnostic sev reason' code
where
(sev, reason') = diag_reason_severity opts reason
--- | Varation of 'mkMCDiagnostic' which can be used when we are /sure/ the
--- input 'DiagnosticReason' /is/ 'ErrorWithoutFlag' and there is no diagnostic code.
-errorDiagnostic :: MessageClass
-errorDiagnostic = MCDiagnostic SevError (ResolvedDiagnosticReason ErrorWithoutFlag) Nothing
-
--
-- Creating MsgEnvelope(s)
--
@@ -318,17 +312,12 @@ sortMsgBag mopts = maybeLimit . sortBy (cmp `on` errMsgSpan) . bagToList
ghcExit :: Logger -> Int -> IO ()
ghcExit logger val
| val == 0 = exitWith ExitSuccess
- | otherwise = do errorMsg logger (text "\nCompilation had errors\n\n")
+ | otherwise = do fatalErrorMsg logger (text "\nCompilation had errors\n\n")
exitWith (ExitFailure val)
-- -----------------------------------------------------------------------------
-- Outputting messages from the compiler
-errorMsg :: Logger -> SDoc -> IO ()
-errorMsg logger msg
- = logMsg logger errorDiagnostic noSrcSpan $
- withPprStyle defaultErrStyle msg
-
fatalErrorMsg :: Logger -> SDoc -> IO ()
fatalErrorMsg logger msg =
logMsg logger MCFatal noSrcSpan $ withPprStyle defaultErrStyle msg
=====================================
ghc/GHCi/UI.hs
=====================================
@@ -45,7 +45,7 @@ import GHC.Runtime.Eval (mkTopLevEnv)
import GHC.Runtime.Eval.Utils
-- The GHC interface
-import GHC.ByteCode.Breakpoints (imodBreaks_modBreaks)
+import GHC.ByteCode.Breakpoints (imodBreaks_modBreaks, InternalBreakpointId(..), getBreakSourceId)
import GHC.Runtime.Interpreter
import GHCi.RemoteTypes
import GHCi.BreakArray( breakOn, breakOff )
@@ -68,7 +68,7 @@ import GHC ( LoadHowMuch(..), Target(..), TargetId(..),
Resume, SingleStep, Ghc,
GetDocsFailure(..), pushLogHookM,
getModuleGraph, handleSourceError,
- InternalBreakpointId(..) )
+ BreakpointId(..) )
import GHC.Driver.Main (hscParseModuleWithLocation, hscParseStmtWithLocation)
import GHC.Hs.ImpExp
import GHC.Hs
@@ -546,6 +546,7 @@ interactiveUI config srcs maybe_exprs = do
break_ctr = 0,
breaks = IntMap.empty,
tickarrays = emptyModuleEnv,
+ internalBreaks = emptyModuleEnv,
ghci_commands = availableCommands config,
ghci_macros = [],
last_command = Nothing,
@@ -1616,13 +1617,15 @@ toBreakIdAndLocation :: GhciMonad m
toBreakIdAndLocation Nothing = return Nothing
toBreakIdAndLocation (Just inf) = do
st <- getGHCiState
+ hug <- hsc_HUG <$> GHC.getSession
+ brks <- liftIO $ readIModBreaks hug inf
+ let bi = getBreakSourceId inf brks
return $ listToMaybe [ id_loc | id_loc@(_,loc) <- IntMap.assocs (breaks st),
- breakModule loc == ibi_tick_mod inf,
- breakTick loc == ibi_tick_index inf ]
+ breakId loc == bi ]
printStoppedAtBreakInfo :: GHC.GhcMonad m => Resume -> [Name] -> m ()
printStoppedAtBreakInfo res names = do
- printForUser $ pprStopped res
+ printForUser =<< pprStopped res
-- printTypeOfNames session names
let namesSorted = sortBy compareNames names
tythings <- catMaybes `liftM` mapM GHC.lookupName namesSorted
@@ -3804,22 +3807,32 @@ showBkptTable = do
showContext :: GHC.GhcMonad m => m ()
showContext = do
resumes <- GHC.getResumeContext
- printForUser $ vcat (map pp_resume (reverse resumes))
+ docs <- mapM pp_resume (reverse resumes)
+ printForUser $ vcat docs
where
- pp_resume res =
- text "--> " <> text (GHC.resumeStmt res)
- $$ nest 2 (pprStopped res)
-
-pprStopped :: GHC.Resume -> SDoc
-pprStopped res =
- text "Stopped in"
- <+> ((case mb_mod_name of
- Nothing -> empty
- Just mod_name -> ftext (moduleNameFS mod_name) <> char '.')
- <> text (GHC.resumeDecl res))
- <> char ',' <+> ppr (GHC.resumeSpan res)
- where
- mb_mod_name = moduleName <$> ibi_tick_mod <$> GHC.resumeBreakpointId res
+ pp_resume res = do
+ stopped <- pprStopped res
+ return $
+ text "--> " <> text (GHC.resumeStmt res)
+ $$ nest 2 stopped
+
+pprStopped :: GHC.GhcMonad m => GHC.Resume -> m SDoc
+pprStopped res = do
+ let mibi = GHC.resumeBreakpointId res
+ mb_mod_name <- case mibi of
+ Nothing -> pure Nothing
+ Just ibi -> do
+ hug <- hsc_HUG <$> GHC.getSession
+ brks <- liftIO $ readIModBreaks hug ibi
+ return $ Just $ moduleName $
+ bi_tick_mod $ getBreakSourceId ibi brks
+ return $
+ text "Stopped in"
+ <+> ((case mb_mod_name of
+ Nothing -> empty
+ Just mod_name -> ftext (moduleNameFS mod_name) <> char '.')
+ <> text (GHC.resumeDecl res))
+ <> char ',' <+> ppr (GHC.resumeSpan res)
showUnits :: GHC.GhcMonad m => m ()
showUnits = mapNonInteractiveHomeUnitsM $ \dflags -> do
@@ -4373,12 +4386,8 @@ ignoreCmd argLine = withSandboxOnly ":ignore" $ do
result <- ignoreSwitch (words argLine)
case result of
Left sdoc -> printForUser sdoc
- Right (loc, count) -> do
- let bi = GHC.BreakpointId
- { bi_tick_mod = breakModule loc
- , bi_tick_index = breakTick loc
- }
- setupBreakpoint bi count
+ Right (loc, count) -> do
+ setupBreakpoint (breakId loc) count
ignoreSwitch :: GhciMonad m => [String] -> m (Either SDoc (BreakLocation, Int))
ignoreSwitch [break, count] = do
@@ -4395,10 +4404,13 @@ getIgnoreCount str =
where
sdocIgnore = text "Ignore count" <+> quotes (text str)
-setupBreakpoint :: GhciMonad m => GHC.BreakpointId -> Int -> m()
-setupBreakpoint loc count = do
+setupBreakpoint :: GhciMonad m => GHC.BreakpointId -> Int -> m ()
+setupBreakpoint bi count = do
hsc_env <- GHC.getSession
- GHC.setupBreakpoint (hscInterp hsc_env) loc count
+ -- Trigger all internal breaks that match this source break id
+ internal_break_ids <- getInternalBreaksOf bi
+ forM_ internal_break_ids $ \ibi -> do
+ GHC.setupBreakpoint (hscInterp hsc_env) ibi count
backCmd :: GhciMonad m => String -> m ()
backCmd arg
@@ -4489,20 +4501,20 @@ findBreakAndSet md lookupTickTree = do
some -> mapM_ breakAt some
where
breakAt (tick, pan) = do
- setBreakFlag md tick True
- (alreadySet, nm) <-
- recordBreak $ BreakLocation
- { breakModule = md
- , breakLoc = RealSrcSpan pan Strict.Nothing
- , breakTick = tick
- , onBreakCmd = ""
- , breakEnabled = True
- }
- printForUser $
- text "Breakpoint " <> ppr nm <>
- if alreadySet
- then text " was already set at " <> ppr pan
- else text " activated at " <> ppr pan
+ let bi = BreakpointId md tick
+ setBreakFlag bi True
+ (alreadySet, nm) <-
+ recordBreak $ BreakLocation
+ { breakLoc = RealSrcSpan pan Strict.Nothing
+ , breakId = bi
+ , onBreakCmd = ""
+ , breakEnabled = True
+ }
+ printForUser $
+ text "Breakpoint " <> ppr nm <>
+ if alreadySet
+ then text " was already set at " <> ppr pan
+ else text " activated at " <> ppr pan
-- For now, use ANSI bold on terminals that we know support it.
-- Otherwise, we add a line of carets under the active expression instead.
@@ -4749,14 +4761,32 @@ turnBreakOnOff :: GhciMonad m => Bool -> BreakLocation -> m BreakLocation
turnBreakOnOff onOff loc
| onOff == breakEnabled loc = return loc
| otherwise = do
- setBreakFlag (breakModule loc) (breakTick loc) onOff
+ setBreakFlag (breakId loc) onOff
return loc { breakEnabled = onOff }
-setBreakFlag :: GhciMonad m => Module -> Int -> Bool ->m ()
-setBreakFlag md ix enaDisa = do
+setBreakFlag :: GhciMonad m => GHC.BreakpointId -> Bool -> m ()
+setBreakFlag (BreakpointId md ix) enaDisa = do
let enaDisaToCount True = breakOn
enaDisaToCount False = breakOff
- setupBreakpoint (GHC.BreakpointId md ix) $ enaDisaToCount enaDisa
+ setupBreakpoint (BreakpointId md ix) $ enaDisaToCount enaDisa
+
+-- --------------------------------------------------------------------------
+-- Find matching Internal Breakpoints
+
+-- | Find all the internal breakpoints that use the given source-level breakpoint id
+getInternalBreaksOf :: GhciMonad m => BreakpointId -> m [InternalBreakpointId]
+getInternalBreaksOf bi = do
+ st <- getGHCiState
+ let ibrks = internalBreaks st
+ case lookupBreakpointOccurrences ibrks bi of
+ Just bs -> return bs
+ Nothing -> do
+ -- Refresh the internal breakpoints map
+ bs <- mkBreakpointOccurrences
+ setGHCiState st{internalBreaks = bs}
+ return $
+ fromMaybe [] {- still not found after refresh -} $
+ lookupBreakpointOccurrences bs bi
-- ---------------------------------------------------------------------------
-- User code exception handling
=====================================
ghc/GHCi/UI/Monad.hs
=====================================
@@ -100,6 +100,14 @@ data GHCiState = GHCiState
-- ^ 'tickarrays' caches the 'TickArray' for loaded modules,
-- so that we don't rebuild it each time the user sets
-- a breakpoint.
+
+ internalBreaks :: BreakpointOccurrences,
+ -- ^ Keep a mapping from the source-level 'BreakpointId' to the
+ -- occurrences of that breakpoint across modules.
+ -- When we want to stop at a source 'BreakpointId', we essentially
+ -- trigger a breakpoint for all 'InternalBreakpointId's matching
+ -- the same source-id.
+
ghci_commands :: [Command],
-- ^ available ghci commands
ghci_macros :: [Command],
@@ -238,16 +246,15 @@ data LocalConfigBehaviour
data BreakLocation
= BreakLocation
- { breakModule :: !GHC.Module
- , breakLoc :: !SrcSpan
- , breakTick :: {-# UNPACK #-} !Int
+ { breakLoc :: !SrcSpan
+ , breakId :: !GHC.BreakpointId
+ -- ^ The 'BreakpointId' uniquely identifies a source-level breakpoint
, breakEnabled:: !Bool
, onBreakCmd :: String
}
instance Eq BreakLocation where
- loc1 == loc2 = breakModule loc1 == breakModule loc2 &&
- breakTick loc1 == breakTick loc2
+ loc1 == loc2 = breakId loc1 == breakId loc2
prettyLocations :: IntMap.IntMap BreakLocation -> SDoc
prettyLocations locs =
@@ -256,7 +263,7 @@ prettyLocations locs =
False -> vcat $ map (\(i, loc) -> brackets (int i) <+> ppr loc) $ IntMap.toAscList locs
instance Outputable BreakLocation where
- ppr loc = (ppr $ breakModule loc) <+> ppr (breakLoc loc) <+> pprEnaDisa <+>
+ ppr loc = (ppr $ GHC.bi_tick_mod $ breakId loc) <+> ppr (breakLoc loc) <+> pprEnaDisa <+>
if null (onBreakCmd loc)
then empty
else doubleQuotes (text (onBreakCmd loc))
=====================================
libraries/ghci/GHCi/Debugger.hs
=====================================
@@ -65,10 +65,7 @@ foreign import ccall "&rts_stop_on_exception" exceptionFlag :: Ptr CInt
--------------------------------------------------------------------------------
type BreakpointCallback
- = Addr# -- pointer to the breakpoint tick module name
- -> Addr# -- pointer to the breakpoint tick module unit id
- -> Int# -- breakpoint tick index
- -> Addr# -- pointer to the breakpoint info module name
+ = Addr# -- pointer to the breakpoint info module name
-> Addr# -- pointer to the breakpoint info module unit id
-> Int# -- breakpoint info index
-> Bool -- exception?
=====================================
libraries/ghci/GHCi/Message.hs
=====================================
@@ -418,10 +418,7 @@ data EvalStatus_ a b
instance Binary a => Binary (EvalStatus_ a b)
data EvalBreakpoint = EvalBreakpoint
- { eb_tick_mod :: String -- ^ Breakpoint tick module
- , eb_tick_mod_unit :: BS.ShortByteString -- ^ Breakpoint tick module unit id
- , eb_tick_index :: Int -- ^ Breakpoint tick index
- , eb_info_mod :: String -- ^ Breakpoint info module
+ { eb_info_mod :: String -- ^ Breakpoint info module
, eb_info_mod_unit :: BS.ShortByteString -- ^ Breakpoint tick module unit id
, eb_info_index :: Int -- ^ Breakpoint info index
}
=====================================
libraries/ghci/GHCi/Run.hs
=====================================
@@ -345,7 +345,7 @@ withBreakAction opts breakMVar statusMVar mtid act
-- as soon as it is hit, or in resetBreakAction below.
onBreak :: BreakpointCallback
- onBreak tick_mod# tick_mod_uid# tickx# info_mod# info_mod_uid# infox# is_exception apStack = do
+ onBreak info_mod# info_mod_uid# infox# is_exception apStack = do
tid <- myThreadId
let resume = ResumeContext
{ resumeBreakMVar = breakMVar
@@ -358,11 +358,9 @@ withBreakAction opts breakMVar statusMVar mtid act
if is_exception
then pure Nothing
else do
- tick_mod <- peekCString (Ptr tick_mod#)
- tick_mod_uid <- BS.packCString (Ptr tick_mod_uid#)
info_mod <- peekCString (Ptr info_mod#)
info_mod_uid <- BS.packCString (Ptr info_mod_uid#)
- pure (Just (EvalBreakpoint tick_mod tick_mod_uid (I# tickx#) info_mod info_mod_uid (I# infox#)))
+ pure (Just (EvalBreakpoint info_mod info_mod_uid (I# infox#)))
putMVar statusMVar $ EvalBreak apStack_r breakpoint resume_r ccs
takeMVar breakMVar
@@ -409,8 +407,8 @@ noBreakStablePtr :: StablePtr BreakpointCallback
noBreakStablePtr = unsafePerformIO $ newStablePtr noBreakAction
noBreakAction :: BreakpointCallback
-noBreakAction _ _ _ _ _ _ False _ = putStrLn "*** Ignoring breakpoint"
-noBreakAction _ _ _ _ _ _ True _ = return () -- exception: just continue
+noBreakAction _ _ _ False _ = putStrLn "*** Ignoring breakpoint"
+noBreakAction _ _ _ True _ = return () -- exception: just continue
-- Malloc and copy the bytes. We don't have any way to monitor the
-- lifetime of this memory, so it just leaks.
=====================================
rts/Disassembler.c
=====================================
@@ -84,16 +84,23 @@ disInstr ( StgBCO *bco, int pc )
switch (instr & 0xff) {
- case bci_BRK_FUN:
- debugBelch ("BRK_FUN " ); printPtr( ptrs[instrs[pc]] );
- debugBelch (" %d ", instrs[pc+1]); printPtr( ptrs[instrs[pc+2]] );
- CostCentre* cc = (CostCentre*)literals[instrs[pc+5]];
+ case bci_BRK_FUN: {
+ W_ p1, info_mod, info_unit_id, info_wix, np;
+ p1 = BCO_GET_LARGE_ARG;
+ info_mod = BCO_GET_LARGE_ARG;
+ info_unit_id = BCO_GET_LARGE_ARG;
+ info_wix = BCO_NEXT;
+ np = BCO_GET_LARGE_ARG;
+ debugBelch ("BRK_FUN " ); printPtr( ptrs[p1] );
+ debugBelch("%" FMT_Word, literals[info_mod] );
+ debugBelch("%" FMT_Word, literals[info_unit_id] );
+ debugBelch("%" FMT_Word, info_wix );
+ CostCentre* cc = (CostCentre*)literals[np];
if (cc) {
debugBelch(" %s", cc->label);
}
debugBelch("\n");
- pc += 6;
- break;
+ break; }
case bci_BRK_ALTS:
debugBelch ("BRK_ALTS %d\n", BCO_NEXT);
break;
=====================================
rts/Exception.cmm
=====================================
@@ -535,23 +535,17 @@ retry_pop_stack:
// be per-thread.
CInt[rts_stop_on_exception] = 0;
("ptr" ioAction) = ccall deRefStablePtr (W_[rts_breakpoint_io_action] "ptr");
- Sp = Sp - WDS(17);
- Sp(16) = exception;
- Sp(15) = stg_raise_ret_info;
- Sp(14) = exception;
- Sp(13) = ghczminternal_GHCziInternalziTypes_True_closure; // True <=> an exception
- Sp(12) = stg_ap_ppv_info;
- Sp(11) = 0;
- Sp(10) = stg_ap_n_info;
- Sp(9) = 0;
- Sp(8) = stg_ap_n_info;
- Sp(7) = 0;
- Sp(6) = stg_ap_n_info;
- Sp(5) = 0;
- Sp(4) = stg_ap_n_info;
- Sp(3) = 0;
- Sp(2) = stg_ap_n_info;
- Sp(1) = 0;
+ Sp = Sp - WDS(11);
+ Sp(10) = exception;
+ Sp(9) = stg_raise_ret_info;
+ Sp(8) = exception;
+ Sp(7) = ghczminternal_GHCziInternalziTypes_True_closure; // True <=> an exception
+ Sp(6) = stg_ap_ppv_info;
+ Sp(5) = 0;
+ Sp(4) = stg_ap_n_info;
+ Sp(3) = 0;
+ Sp(2) = stg_ap_n_info;
+ Sp(1) = 0;
R1 = ioAction;
jump RET_LBL(stg_ap_n) [R1];
}
=====================================
rts/Interpreter.c
=====================================
@@ -685,8 +685,6 @@ interpretBCO (Capability* cap)
*/
if (cap->r.rCurrentTSO->flags & TSO_STOP_AFTER_RETURN) {
- StgBCO* bco;
- StgWord16* bco_instrs;
StgHalfWord type;
/* Store the entry Sp; traverse the stack modifying Sp (using Sp macros);
@@ -706,28 +704,33 @@ interpretBCO (Capability* cap)
ASSERT(type == RET_BCO || type == STOP_FRAME);
if (type == RET_BCO) {
- bco = (StgBCO*)(SpW(1)); // BCO is first arg of a RET_BCO
+ StgBCO* bco = (StgBCO*)(SpW(1)); // BCO is first arg of a RET_BCO
ASSERT(get_itbl((StgClosure*)bco)->type == BCO);
- bco_instrs = (StgWord16*)(bco->instrs->payload);
+
+ StgWord16* instrs = (StgWord16*)(bco->instrs->payload);
+ StgWord16 bci = instrs[0];
/* A breakpoint instruction (BRK_FUN or BRK_ALTS) is always the first
* instruction in a BCO */
- if ((bco_instrs[0] & 0xFF) == bci_BRK_FUN) {
- int brk_array, tick_index;
- StgArrBytes *breakPoints;
- StgPtr* ptrs;
+ if ((bci & 0xFF) == bci_BRK_FUN) {
+ // Define rest of variables used by BCO_* Macros
+ int bciPtr = 0;
+
+ W_ arg1_brk_array, arg4_info_index;
+ arg1_brk_array = BCO_GET_LARGE_ARG;
+ /* info_mod_name = */ BCO_GET_LARGE_ARG;
+ /* info_mod_id = */ BCO_GET_LARGE_ARG;
+ arg4_info_index = BCO_NEXT;
- ptrs = (StgPtr*)(&bco->ptrs->payload[0]);
- brk_array = bco_instrs[1];
- tick_index = bco_instrs[6];
+ StgPtr* ptrs = (StgPtr*)(&bco->ptrs->payload[0]);
+ StgArrBytes* breakPoints = (StgArrBytes *) BCO_PTR(arg1_brk_array);
- breakPoints = (StgArrBytes *) BCO_PTR(brk_array);
// ACTIVATE the breakpoint by tick index
- ((StgInt*)breakPoints->payload)[tick_index] = 0;
+ ((StgInt*)breakPoints->payload)[arg4_info_index] = 0;
}
- else if ((bco_instrs[0] & 0xFF) == bci_BRK_ALTS) {
+ else if ((bci & 0xFF) == bci_BRK_ALTS) {
// ACTIVATE BRK_ALTS by setting its only argument to ON
- bco_instrs[1] = 1;
+ instrs[1] = 1;
}
// else: if there is no BRK instruction perhaps we should keep
// traversing; that said, the continuation should always have a BRK
@@ -1520,9 +1523,9 @@ run_BCO:
/* check for a breakpoint on the beginning of a let binding */
case bci_BRK_FUN:
{
- int arg1_brk_array, arg2_tick_mod, arg3_info_mod, arg4_tick_mod_id, arg5_info_mod_id, arg6_tick_index, arg7_info_index;
+ W_ arg1_brk_array, arg2_info_mod_name, arg3_info_mod_id, arg4_info_index;
#if defined(PROFILING)
- int arg8_cc;
+ W_ arg5_cc;
#endif
StgArrBytes *breakPoints;
int returning_from_break, stop_next_breakpoint;
@@ -1537,14 +1540,11 @@ run_BCO:
int size_words;
arg1_brk_array = BCO_GET_LARGE_ARG;
- arg2_tick_mod = BCO_GET_LARGE_ARG;
- arg3_info_mod = BCO_GET_LARGE_ARG;
- arg4_tick_mod_id = BCO_GET_LARGE_ARG;
- arg5_info_mod_id = BCO_GET_LARGE_ARG;
- arg6_tick_index = BCO_NEXT;
- arg7_info_index = BCO_NEXT;
+ arg2_info_mod_name = BCO_GET_LARGE_ARG;
+ arg3_info_mod_id = BCO_GET_LARGE_ARG;
+ arg4_info_index = BCO_NEXT;
#if defined(PROFILING)
- arg8_cc = BCO_GET_LARGE_ARG;
+ arg5_cc = BCO_GET_LARGE_ARG;
#else
BCO_GET_LARGE_ARG;
#endif
@@ -1564,7 +1564,7 @@ run_BCO:
#if defined(PROFILING)
cap->r.rCCCS = pushCostCentre(cap->r.rCCCS,
- (CostCentre*)BCO_LIT(arg8_cc));
+ (CostCentre*)BCO_LIT(arg5_cc));
#endif
// if we are returning from a break then skip this section
@@ -1575,11 +1575,11 @@ run_BCO:
// stop the current thread if either `stop_next_breakpoint` is
// true OR if the ignore count for this particular breakpoint is zero
- StgInt ignore_count = ((StgInt*)breakPoints->payload)[arg6_tick_index];
+ StgInt ignore_count = ((StgInt*)breakPoints->payload)[arg4_info_index];
if (stop_next_breakpoint == false && ignore_count > 0)
{
// decrement and write back ignore count
- ((StgInt*)breakPoints->payload)[arg6_tick_index] = --ignore_count;
+ ((StgInt*)breakPoints->payload)[arg4_info_index] = --ignore_count;
}
else if (stop_next_breakpoint == true || ignore_count == 0)
{
@@ -1613,10 +1613,7 @@ run_BCO:
// Arrange the stack to call the breakpoint IO action, and
// continue execution of this BCO when the IO action returns.
//
- // ioAction :: Addr# -- the breakpoint tick module
- // -> Addr# -- the breakpoint tick module unit id
- // -> Int# -- the breakpoint tick index
- // -> Addr# -- the breakpoint info module
+ // ioAction :: Addr# -- the breakpoint info module
// -> Addr# -- the breakpoint info module unit id
// -> Int# -- the breakpoint info index
// -> Bool -- exception?
@@ -1626,23 +1623,17 @@ run_BCO:
ioAction = (StgClosure *) deRefStablePtr (
rts_breakpoint_io_action);
- Sp_subW(19);
- SpW(18) = (W_)obj;
- SpW(17) = (W_)&stg_apply_interp_info;
- SpW(16) = (W_)new_aps;
- SpW(15) = (W_)False_closure; // True <=> an exception
- SpW(14) = (W_)&stg_ap_ppv_info;
- SpW(13) = (W_)arg7_info_index;
- SpW(12) = (W_)&stg_ap_n_info;
- SpW(11) = (W_)BCO_LIT(arg5_info_mod_id);
- SpW(10) = (W_)&stg_ap_n_info;
- SpW(9) = (W_)BCO_LIT(arg3_info_mod);
- SpW(8) = (W_)&stg_ap_n_info;
- SpW(7) = (W_)arg6_tick_index;
+ Sp_subW(13);
+ SpW(12) = (W_)obj;
+ SpW(11) = (W_)&stg_apply_interp_info;
+ SpW(10) = (W_)new_aps;
+ SpW(9) = (W_)False_closure; // True <=> an exception
+ SpW(8) = (W_)&stg_ap_ppv_info;
+ SpW(7) = (W_)arg4_info_index;
SpW(6) = (W_)&stg_ap_n_info;
- SpW(5) = (W_)BCO_LIT(arg4_tick_mod_id);
+ SpW(5) = (W_)BCO_LIT(arg3_info_mod_id);
SpW(4) = (W_)&stg_ap_n_info;
- SpW(3) = (W_)BCO_LIT(arg2_tick_mod);
+ SpW(3) = (W_)BCO_LIT(arg2_info_mod_name);
SpW(2) = (W_)&stg_ap_n_info;
SpW(1) = (W_)ioAction;
SpW(0) = (W_)&stg_enter_info;
=====================================
rts/linker/LoadArchive.c
=====================================
@@ -140,6 +140,10 @@ static enum ObjectFileFormat identifyObjectFile_(char* buf, size_t sz)
if (sz > 4 && ((uint32_t*)buf)[0] == 0xfeedfacf) {
return MachO64;
}
+ // BigObj COFF files ...
+ if (sz > 8 && ((uint64_t*)buf)[0] == 0x86640002ffff0000) {
+ return COFFAmd64;
+ }
return NotObject;
}
=====================================
testsuite/tests/corelint/T21115b.stderr
=====================================
@@ -30,6 +30,6 @@ end Rec }
*** End of Offense ***
-
-<no location info>: error:
Compilation had errors
+
+
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/dfed1a962cc300be5735646e52be36…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/dfed1a962cc300be5735646e52be36…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/fendor/remove-stg_stackDecode] 25 commits: Refactor GHC.Driver.Errors.printMessages
by Hannes Siebenhandl (＠fendor) 01 Aug '25
by Hannes Siebenhandl (＠fendor) 01 Aug '25
01 Aug '25
Hannes Siebenhandl pushed to branch wip/fendor/remove-stg_stackDecode at Glasgow Haskell Compiler / GHC
Commits:
49a44ab7 by Simon Hengel at 2025-07-23T17:59:55+07:00
Refactor GHC.Driver.Errors.printMessages
- - - - -
84711c39 by Simon Hengel at 2025-07-23T18:27:34+07:00
Respect `-fdiagnostics-as-json` for error messages from pre-processors
(fixes #25480)
- - - - -
d046b5ab by Simon Hengel at 2025-07-24T06:12:05-04:00
Include the rendered message in -fdiagnostics-as-json output
This implements #26173.
- - - - -
d2b89603 by Ben Gamari at 2025-07-24T06:12:47-04:00
rts/Interpreter: Factor out ctoi tuple info tables into data
Instead of a massive case let's put this into data which we can reuse
elsewhere.
- - - - -
4bc78496 by Sebastian Graf at 2025-07-24T16:19:34-04:00
CprAnal: Detect recursive newtypes (#25944)
While `cprTransformDataConWork` handles recursive data con workers, it
did not detect the case when a newtype is responsible for the recursion.
This is now detected in the `Cast` case of `cprAnal`.
The same reproducer made it clear that `isRecDataCon` lacked congruent
handling for `AppTy` and `CastTy`, now fixed.
Furthermore, the new repro case T25944 triggered this bug via an
infinite loop in `cprFix`, caused by the infelicity in `isRecDataCon`.
While it should be much less likely to trigger such an infinite loop now
that `isRecDataCon` has been fixed, I made sure to abort the loop after
10 iterations and emitting a warning instead.
Fixes #25944.
- - - - -
0a583689 by Sylvain Henry at 2025-07-24T16:20:26-04:00
STM: don't create a transaction in the rhs of catchRetry# (#26028)
We don't need to create a transaction for the rhs of (catchRetry#)
because contrary to the lhs we don't need to abort it on retry. Moreover
it is particularly harmful if we have code such as (#26028):
let cN = readTVar vN >> retry
tree = c1 `orElse` (c2 `orElse` (c3 `orElse` ...))
atomically tree
Because it will stack transactions for the rhss and the read-sets of all
the transactions will be iteratively merged in O(n^2) after the
execution of the most nested retry.
- - - - -
a49eca26 by Simon Peyton Jones at 2025-07-25T09:49:58+01:00
Renaming around predicate types
.. we were (as it turned out) abstracting over
type-class selectors in SPECIALISATION rules!
Wibble isEqPred
- - - - -
f80375dd by Simon Peyton Jones at 2025-07-25T09:49:58+01:00
Refactor of Specialise.hs
This patch just tidies up `specHeader` a bit, removing one
of its many results, and adding some comments.
No change in behaviour.
Also add a few more `HasDebugCallStack` contexts.
- - - - -
1bd12371 by Simon Peyton Jones at 2025-07-25T09:49:58+01:00
Improve treatment of SPECIALISE pragmas -- again!
This MR does another major refactor of the way that SPECIALISE
pragmas work, to fix #26115, #26116, #26117.
* We now /always/ solve forall-constraints in an all-or-nothing way.
See Note [Solving a Wanted forall-constraint] in GHC.Tc.Solver.Solve
This means we might have unsolved quantified constraints, which need
to be reported. See `inert_insts` in `getUnsolvedInerts`.
* I refactored the short-cut solver for type classes to work by
recursively calling the solver rather than by having a little baby
solver that kept being not clever enough.
See Note [Shortcut solving] in GHC.Tc.Solver.Dict
* I totally rewrote the desugaring of SPECIALISE pragmas, again.
The new story is in Note [Desugaring new-form SPECIALISE pragmas]
in GHC.HsToCore.Binds
Both old-form and new-form SPECIALISE pragmas now route through the same
function `dsSpec_help`. The tricky function `decomposeRuleLhs` is now used only
for user-written RULES, not for SPECIALISE pragmas.
* I improved `solveOneFromTheOther` to account for rewriter sets. Previously
it would solve a non-rewritten dict from a rewritten one. For equalities
we were already dealing with this, in
Some incidental refactoring
* A small refactor: `ebv_tcvs` in `EvBindsBar` now has a list of coercions, rather
than a set of tyvars. We just delay taking the free vars.
* GHC.Core.FVs.exprFVs now returns /all/ free vars.
Use `exprLocalFVs` for Local vars.
Reason: I wanted another variant for /evidence/ variables.
* Ues `EvId` in preference to `EvVar`. (Evidence variables are always Ids.)
Rename `isEvVar` to `isEvId`.
* I moved `inert_safehask` out of `InertCans` and into `InertSet` where it
more properly belongs.
Compiler-perf changes:
* There was a palpable bug (#26117) which this MR fixes in
newWantedEvVar, which bypassed all the subtle overlapping-Given
and shortcutting logic. (See the new `newWantedEvVar`.) Fixing this
but leads to extra dictionary bindings; they are optimised away quickly
but they made CoOpt_Read allocate 3.6% more.
* Hpapily T15164 improves.
* The net compiler-allocation change is 0.0%
Metric Decrease:
T15164
Metric Increase:
CoOpt_Read
T12425
- - - - -
953fd8f1 by Simon Peyton Jones at 2025-07-25T09:49:58+01:00
Solve forall-constraints immediately, or not at all
This MR refactors the constraint solver to solve forall-constraints immediately,
rather than emitting an implication constraint to be solved later.
The most immediate motivation was that when solving quantified constraints
in SPECIALISE pragmas, we really really don't want to leave behind half-
solved implications. Also it's in tune with the approach of the new
short-cut solver, which recursively invokes the solver.
It /also/ saves quite a bit of plumbing; e.g
- The `wl_implics` field of `WorkList` is gone,
- The types of `solveSimpleWanteds` and friends are simplified.
- An EvFun contains binding, rather than an EvBindsVar ref-cell that
will in the future contain bindings. That makes `evVarsOfTerm`
simpler. Much nicer.
It also improves error messages a bit.
All described in Note [Solving a Wanted forall-constraint] in
GHC.Tc.Solver.Solve.
One tiresome point: in the tricky case of `inferConstraintsCoerceBased`
we make a forall-constraint. This we /do/ want to partially solve, so
we can infer a suitable context. (I'd be quite happy to force the user to
write a context, bt I don't want to change behavior.) So we want to generate
an /implication/ constraint in `emitPredSpecConstraints` rather than a
/forall-constraint/ as we were doing before. Discussed in (WFA3) of
the above Note.
Incidental refactoring
* `GHC.Tc.Deriv.Infer.inferConstraints` was consulting the state monad for
the DerivEnv that the caller had just consulted. Nicer to pass it as an
argument I think, so I have done that. No change in behaviour.
- - - - -
6921ab42 by Simon Peyton Jones at 2025-07-25T09:49:58+01:00
Remove duplicated code in Ast.hs for evTermFreeVars
This is just a tidy up.
- - - - -
1165f587 by Simon Peyton Jones at 2025-07-25T09:49:58+01:00
Small tc-tracing changes only
- - - - -
0776ffe0 by Simon Hengel at 2025-07-26T04:54:20-04:00
Respect `-fdiagnostics-as-json` for core diagnostics (see #24113)
- - - - -
cc1116e0 by Andrew Lelechenko at 2025-07-26T04:55:01-04:00
docs: add since pragma to Data.List.NonEmpty.mapMaybe
- - - - -
ee2dc248 by Simon Hengel at 2025-07-31T06:25:35-04:00
Update comments on `OptKind` to reflect the code reality
- - - - -
b029633a by Wen Kokke at 2025-07-31T06:26:21-04:00
rts: Disable --eventlog-flush-interval unless compiled with -threaded.
This commit fixes issue #26222:
Using --eventlog-flush-interval with the non-threaded RTS leads to eventlog corruption.
https://gitlab.haskell.org/ghc/ghc/-/issues/26222
This commit makes three changes when code is compiled against the non-threaded RTS:
1. It disables the --eventlog-flush-interval flag.
2. It disables the documentation for the --eventlog-flush-interval flag.
3. It disables the relevant state from RtsConfig and code from Timer.
4. It updates the entry for --eventlog-flush-interval in the users guide.
- - - - -
31159f1d by Wen Kokke at 2025-07-31T06:26:21-04:00
rts: Split T20006 into tests with and without -threaded
- - - - -
618687ef by Simon Hengel at 2025-07-31T06:27:03-04:00
docs/users_guide/win32-dlls.rst: Remove references to `readline`
- - - - -
083e40f1 by Rodrigo Mesquita at 2025-08-01T04:38:23-04:00
debugger: Uniquely identify breakpoints by internal id
Since b85b11994e0130ff2401dd4bbdf52330e0bcf776 (support inlining
breakpoints), a breakpoint has been identified at runtime by *two* pairs
of <module,index>.
- The first, aka a 'BreakpointId', uniquely identifies a breakpoint in
the source of a module by using the Tick index. A Tick index can index
into ModBreaks.modBreaks_xxx to fetch source-level information about
where that tick originated.
- When a user specifies e.g. a line breakpoint using :break, we'll reverse
engineer what a Tick index for that line
- We update the `BreakArray` of that module (got from the
LoaderState) at that tick index to `breakOn`.
- A BCO we can stop at is headed by a BRK_FUN instruction. This
instruction stores in an operand the `tick index` it is associated
to. We look it up in the associated `BreakArray` (also an operand)
and check wheter it was set to `breakOn`.
- The second, aka the `ibi_info_mod` + `ibi_info_ix` of the
`InternalBreakpointId`, uniquely index into the `imodBreaks_breakInfo`
-- the information we gathered during code generation about the
existing breakpoint *ocurrences*.
- Note that with optimisation there may be many occurrences of the
same source-tick-breakpoint across different modules. The
`ibi_info_ix` is unique per occurrence, but the `bi_tick_ix` may be
shared. See Note [Breakpoint identifiers] about this.
- Note that besides the tick ids, info ids are also stored in
`BRK_FUN` so the break handler can refer to the associated
`CgBreakInfo`.
In light of that, the driving changes come from the desire to have the
info_id uniquely identify the breakpoint at runtime, and the source tick
id being derived from it:
- An InternalBreakpointId should uniquely identify a breakpoint just
from the code-generation identifiers of `ibi_info_ix` and `ibi_info_mod`.
So we drop `ibi_tick_mod` and `ibi_tick_ix`.
- A BRK_FUN instruction need only record the "internal breakpoint id",
not the tick-level id.
So we drop the tick mod and tick index operands.
- A BreakArray should be indexed by InternalBreakpointId rather than
BreakpointId
That means we need to do some more work when setting a breakpoint.
Specifically, we need to figure out the internal ids (occurrences of a
breakpoint) from the source-level BreakpointId we want to set the
breakpoint at (recall :break refers to breaks at the source level).
Besides this change being an improvement to the handling of breakpoints
(it's clearer to have a single unique identifier than two competing
ones), it unlocks the possibility of generating "internal" breakpoints
during Cg (needed for #26042).
It should also be easier to introduce multi-threaded-aware `BreakArrays`
following this change (needed for #26064).
Se also the new Note [ModBreaks vs InternalModBreaks]
On i386-linux:
-------------------------
Metric Decrease:
interpreter_steplocal
-------------------------
- - - - -
bf03bbaa by Simon Hengel at 2025-08-01T04:39:05-04:00
Don't use MCDiagnostic for `ghcExit`
This changes the error message of `ghcExit` from
```
<no location info>: error:
Compilation had errors
```
to
```
Compilation had errors
```
- - - - -
a889ec75 by Simon Hengel at 2025-08-01T04:39:05-04:00
Respect `-fdiagnostics-as-json` for driver diagnostics (see #24113)
- - - - -
df9705f8 by fendor at 2025-08-01T11:08:56+02:00
Move stack decoding logic from ghc-heap to ghc-internal
The stack decoding logic in `ghc-heap` is more sophisticated than the one
currently employed in `CloneStack`. We want to use the stack decoding
implementation from `ghc-heap` in `base`.
We cannot simply depend on `ghc-heap` in `base` due do bootstrapping
issues.
Thus, we move the code that is necessary to implement stack decoding to
`ghc-internal`. This is the right location, as we don't want to add a
new API to `base`.
Moving the stack decoding logic and re-exposing it in ghc-heap is
insufficient, though, as we have a dependency cycle between.
* ghc-heap depends on stage1:ghc-internal
* stage0:ghc depends on stage0:ghc-heap
To fix this, we remove ghc-heap from the set of `stage0` dependencies.
This is not entirely straight-forward, as a couple of boot dependencies,
such as `ghci` depend on `ghc-heap`.
Luckily, the boot compiler of GHC is now >=9.10, so we can migrate `ghci`
to use `ghc-internal` instead of `ghc-heap`, which already exports the
relevant modules.
However, we cannot 100% remove ghc's dependency on `ghc-heap`, since
when we compile `stage0:ghc`, `stage1:ghc-internal` is not yet
available.
Thus, when we compile with the boot-compiler, we still depend on an
older version of `ghc-heap`, and only use the modules from `ghc-internal`,
if the `ghc-internal` version is recent enough.
-------------------------
Metric Increase:
size_hello_artifact
size_hello_artifact_gzip
size_hello_unicode
size_hello_unicode_gzip
-------------------------
These metric increases are unfortunate, they are most likely caused by
the larger (literally in terms of lines of code) stack decoder implementation
that are now linked into hello-word binaries.
On linux, it is almost a 10% increase, which is considerable.
- - - - -
76626c74 by fendor at 2025-08-01T11:08:56+02:00
Implement `decode` in terms of `decodeStackWithIpe`
Uses the more efficient stack decoder implementation.
- - - - -
bb8add69 by fendor at 2025-08-01T11:08:56+02:00
Remove stg_decodeStackzh
- - - - -
feb003b6 by fendor at 2025-08-01T11:08:56+02:00
Remove ghcHeap from list of toolTargets
- - - - -
171 changed files:
- compiler/GHC/ByteCode/Asm.hs
- compiler/GHC/ByteCode/Breakpoints.hs
- compiler/GHC/ByteCode/Instr.hs
- compiler/GHC/ByteCode/Linker.hs
- compiler/GHC/ByteCode/Types.hs
- compiler/GHC/Core.hs
- compiler/GHC/Core/FVs.hs
- compiler/GHC/Core/Make.hs
- compiler/GHC/Core/Opt/Arity.hs
- compiler/GHC/Core/Opt/CprAnal.hs
- compiler/GHC/Core/Opt/Monad.hs
- compiler/GHC/Core/Opt/SpecConstr.hs
- compiler/GHC/Core/Opt/Specialise.hs
- compiler/GHC/Core/Opt/WorkWrap/Utils.hs
- compiler/GHC/Core/Predicate.hs
- compiler/GHC/Core/Rules.hs
- compiler/GHC/Core/Subst.hs
- compiler/GHC/Core/TyCo/Rep.hs
- compiler/GHC/Core/Unfold/Make.hs
- compiler/GHC/Core/Utils.hs
- compiler/GHC/CoreToIface.hs
- compiler/GHC/Driver/CmdLine.hs
- compiler/GHC/Driver/Errors.hs
- compiler/GHC/Driver/Make.hs
- compiler/GHC/HsToCore/Binds.hs
- compiler/GHC/HsToCore/Breakpoints.hs
- compiler/GHC/HsToCore/Errors/Ppr.hs
- compiler/GHC/HsToCore/Pmc/Solver/Types.hs
- compiler/GHC/Iface/Ext/Ast.hs
- compiler/GHC/Linker/Loader.hs
- compiler/GHC/Runtime/Debugger/Breakpoints.hs
- compiler/GHC/Runtime/Eval.hs
- compiler/GHC/Runtime/Heap/Inspect.hs
- compiler/GHC/Runtime/Interpreter.hs
- compiler/GHC/StgToByteCode.hs
- compiler/GHC/SysTools/Process.hs
- compiler/GHC/SysTools/Tasks.hs
- compiler/GHC/Tc/Deriv.hs
- compiler/GHC/Tc/Deriv/Infer.hs
- compiler/GHC/Tc/Deriv/Utils.hs
- compiler/GHC/Tc/Errors.hs
- compiler/GHC/Tc/Errors/Ppr.hs
- compiler/GHC/Tc/Gen/App.hs
- compiler/GHC/Tc/Gen/Expr.hs
- compiler/GHC/Tc/Gen/Pat.hs
- compiler/GHC/Tc/Gen/Sig.hs
- compiler/GHC/Tc/Solver.hs
- compiler/GHC/Tc/Solver/Default.hs
- compiler/GHC/Tc/Solver/Dict.hs
- compiler/GHC/Tc/Solver/Equality.hs
- compiler/GHC/Tc/Solver/InertSet.hs
- compiler/GHC/Tc/Solver/Monad.hs
- compiler/GHC/Tc/Solver/Rewrite.hs
- compiler/GHC/Tc/Solver/Solve.hs
- + compiler/GHC/Tc/Solver/Solve.hs-boot
- compiler/GHC/Tc/Solver/Types.hs
- compiler/GHC/Tc/TyCl/PatSyn.hs
- compiler/GHC/Tc/Types/Constraint.hs
- compiler/GHC/Tc/Types/Evidence.hs
- compiler/GHC/Tc/Types/Origin.hs
- compiler/GHC/Tc/Utils/Monad.hs
- compiler/GHC/Tc/Utils/TcMType.hs
- compiler/GHC/Tc/Utils/TcType.hs
- compiler/GHC/Tc/Utils/Unify.hs
- compiler/GHC/Tc/Validity.hs
- compiler/GHC/Tc/Zonk/Type.hs
- compiler/GHC/Types/Error.hs
- compiler/GHC/Types/Var.hs
- compiler/GHC/Utils/Error.hs
- compiler/GHC/Utils/Logger.hs
- compiler/ghc.cabal.in
- docs/users_guide/9.14.1-notes.rst
- + docs/users_guide/diagnostics-as-json-schema-1_2.json
- docs/users_guide/runtime_control.rst
- docs/users_guide/using.rst
- docs/users_guide/win32-dlls.rst
- ghc/GHCi/UI.hs
- ghc/GHCi/UI/Monad.hs
- hadrian/src/Rules/ToolArgs.hs
- hadrian/src/Settings/Default.hs
- libraries/base/src/Data/List/NonEmpty.hs
- libraries/base/src/GHC/Stack/CloneStack.hs
- + libraries/ghc-experimental/src/GHC/Stack/Annotation/Experimental.hs
- libraries/ghc-heap/GHC/Exts/Heap/ClosureTypes.hs
- libraries/ghc-heap/GHC/Exts/Heap/Closures.hs
- libraries/ghc-heap/GHC/Exts/Heap/Constants.hsc
- libraries/ghc-heap/GHC/Exts/Heap/InfoTable.hsc
- libraries/ghc-heap/GHC/Exts/Heap/InfoTable/Types.hsc
- libraries/ghc-heap/GHC/Exts/Heap/InfoTableProf.hsc
- libraries/ghc-heap/GHC/Exts/Heap/ProfInfo/Types.hs
- libraries/ghc-heap/GHC/Exts/Stack/Constants.hsc
- libraries/ghc-heap/GHC/Exts/Stack/Decode.hs
- libraries/ghc-heap/ghc-heap.cabal.in
- libraries/ghc-heap/cbits/HeapPrim.cmm → libraries/ghc-internal/cbits/HeapPrim.cmm
- libraries/ghc-heap/cbits/Stack.cmm → libraries/ghc-internal/cbits/Stack.cmm
- libraries/ghc-internal/cbits/StackCloningDecoding.cmm
- libraries/ghc-heap/cbits/Stack_c.c → libraries/ghc-internal/cbits/Stack_c.c
- libraries/ghc-internal/ghc-internal.cabal.in
- libraries/ghc-internal/jsbits/base.js
- libraries/ghc-internal/src/GHC/Internal/Exception/Backtrace.hs
- + libraries/ghc-internal/src/GHC/Internal/Heap/Closures.hs
- + libraries/ghc-internal/src/GHC/Internal/Heap/Constants.hsc
- + libraries/ghc-internal/src/GHC/Internal/Heap/InfoTable.hsc
- + libraries/ghc-internal/src/GHC/Internal/Heap/InfoTable/Types.hsc
- + libraries/ghc-internal/src/GHC/Internal/Heap/InfoTableProf.hsc
- + libraries/ghc-internal/src/GHC/Internal/Heap/ProfInfo/Types.hs
- libraries/ghc-internal/src/GHC/Internal/Stack/CloneStack.hs
- + libraries/ghc-internal/src/GHC/Internal/Stack/Constants.hsc
- + libraries/ghc-internal/src/GHC/Internal/Stack/Decode.hs
- libraries/ghci/GHCi/Debugger.hs
- libraries/ghci/GHCi/Message.hs
- libraries/ghci/GHCi/Run.hs
- libraries/ghci/ghci.cabal.in
- rts/CloneStack.c
- rts/CloneStack.h
- rts/Disassembler.c
- rts/Exception.cmm
- rts/Interpreter.c
- rts/PrimOps.cmm
- rts/RaiseAsync.c
- rts/RtsFlags.c
- rts/RtsSymbols.c
- rts/STM.c
- rts/Timer.c
- rts/include/rts/Flags.h
- testsuite/tests/corelint/T21115b.stderr
- + testsuite/tests/cpranal/sigs/T25944.hs
- + testsuite/tests/cpranal/sigs/T25944.stderr
- testsuite/tests/cpranal/sigs/all.T
- testsuite/tests/deriving/should_compile/T20815.hs
- testsuite/tests/deriving/should_fail/T12768.stderr
- testsuite/tests/deriving/should_fail/T1496.stderr
- testsuite/tests/deriving/should_fail/T5498.stderr
- testsuite/tests/deriving/should_fail/T7148.stderr
- testsuite/tests/deriving/should_fail/T7148a.stderr
- testsuite/tests/driver/json.stderr
- testsuite/tests/driver/json_warn.stderr
- testsuite/tests/hiefile/should_run/HieQueries.stdout
- testsuite/tests/impredicative/T17332.stderr
- testsuite/tests/interface-stability/base-exports.stdout
- testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
- testsuite/tests/interface-stability/base-exports.stdout-mingw32
- testsuite/tests/interface-stability/base-exports.stdout-ws-32
- + testsuite/tests/lib/stm/T26028.hs
- + testsuite/tests/lib/stm/T26028.stdout
- + testsuite/tests/lib/stm/all.T
- testsuite/tests/quantified-constraints/T15290a.stderr
- testsuite/tests/quantified-constraints/T19690.stderr
- testsuite/tests/quantified-constraints/T19921.stderr
- testsuite/tests/quantified-constraints/T21006.stderr
- testsuite/tests/roles/should_fail/RolesIArray.stderr
- testsuite/tests/rts/flags/all.T
- + testsuite/tests/simplCore/should_compile/T26115.hs
- + testsuite/tests/simplCore/should_compile/T26115.stderr
- + testsuite/tests/simplCore/should_compile/T26116.hs
- + testsuite/tests/simplCore/should_compile/T26116.stderr
- + testsuite/tests/simplCore/should_compile/T26117.hs
- + testsuite/tests/simplCore/should_compile/T26117.stderr
- testsuite/tests/simplCore/should_compile/all.T
- testsuite/tests/typecheck/should_compile/T12427a.stderr
- testsuite/tests/typecheck/should_compile/T23171.hs
- testsuite/tests/typecheck/should_compile/TcSpecPragmas.stderr
- testsuite/tests/typecheck/should_fail/T14605.hs
- testsuite/tests/typecheck/should_fail/T14605.stderr
- testsuite/tests/typecheck/should_fail/T15801.stderr
- testsuite/tests/typecheck/should_fail/T18640a.stderr
- testsuite/tests/typecheck/should_fail/T18640b.stderr
- testsuite/tests/typecheck/should_fail/T19627.stderr
- testsuite/tests/typecheck/should_fail/T21530b.stderr
- testsuite/tests/typecheck/should_fail/T22912.stderr
- testsuite/tests/typecheck/should_fail/tcfail174.stderr
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a08f8b995921096c82a9a5781c32bb…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a08f8b995921096c82a9a5781c32bb…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][master] 2 commits: Don't use MCDiagnostic for `ghcExit`
by Marge Bot (＠marge-bot) 01 Aug '25
by Marge Bot (＠marge-bot) 01 Aug '25
01 Aug '25
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
bf03bbaa by Simon Hengel at 2025-08-01T04:39:05-04:00
Don't use MCDiagnostic for `ghcExit`
This changes the error message of `ghcExit` from
```
<no location info>: error:
Compilation had errors
```
to
```
Compilation had errors
```
- - - - -
a889ec75 by Simon Hengel at 2025-08-01T04:39:05-04:00
Respect `-fdiagnostics-as-json` for driver diagnostics (see #24113)
- - - - -
5 changed files:
- compiler/GHC/Driver/Make.hs
- compiler/GHC/Linker/Loader.hs
- compiler/GHC/SysTools/Tasks.hs
- compiler/GHC/Utils/Error.hs
- testsuite/tests/corelint/T21115b.stderr
Changes:
=====================================
compiler/GHC/Driver/Make.hs
=====================================
@@ -1552,7 +1552,7 @@ wrapAction msg_wrapper hsc_env k = do
-- ThreadKilled in particular needs to actually kill the thread.
-- So rethrow that and the other async exceptions
Just (err :: SomeAsyncException) -> throwIO err
- _ -> errorMsg lcl_logger (text (show exc))
+ _ -> reportError lcl_logger neverQualify emptyDiagOpts noSrcSpan (text (show exc))
return Nothing
=====================================
compiler/GHC/Linker/Loader.hs
=====================================
@@ -43,6 +43,7 @@ import GHC.Settings
import GHC.Platform
import GHC.Platform.Ways
+import GHC.Driver.Errors
import GHC.Driver.Phases
import GHC.Driver.Env
import GHC.Driver.Session
@@ -50,7 +51,7 @@ import GHC.Driver.Ppr
import GHC.Driver.Config.Diagnostic
import GHC.Driver.Config.Finder
-import GHC.Tc.Utils.Monad
+import GHC.Tc.Utils.Monad hiding (reportDiagnostic)
import GHC.Runtime.Interpreter
import GHCi.BreakArray
@@ -1309,9 +1310,9 @@ load_dyn interp hsc_env crash_early dll = do
then cmdLineErrorIO err
else do
when (diag_wopt Opt_WarnMissedExtraSharedLib diag_opts)
- $ logMsg logger
- (mkMCDiagnostic diag_opts (WarningWithFlag Opt_WarnMissedExtraSharedLib) Nothing)
- noSrcSpan $ withPprStyle defaultUserStyle (note err)
+ $ reportDiagnostic logger
+ neverQualify diag_opts
+ noSrcSpan (WarningWithFlag Opt_WarnMissedExtraSharedLib) $ withPprStyle defaultUserStyle (note err)
pure Nothing
where
diag_opts = initDiagOpts (hsc_dflags hsc_env)
@@ -1499,8 +1500,7 @@ locateLib interp hsc_env is_hs lib_dirs gcc_dirs lib0
, not loading_dynamic_hs_libs
, interpreterProfiled interp
= do
- let diag = mkMCDiagnostic diag_opts WarningWithoutFlag Nothing
- logMsg logger diag noSrcSpan $ withPprStyle defaultErrStyle $
+ reportDiagnostic logger neverQualify diag_opts noSrcSpan WarningWithoutFlag $ withPprStyle defaultErrStyle $
text "Interpreter failed to load profiled static library" <+> text lib <> char '.' $$
text " \tTrying dynamic library instead. If this fails try to rebuild" <+>
text "libraries with profiling support."
=====================================
compiler/GHC/SysTools/Tasks.hs
=====================================
@@ -55,7 +55,7 @@ import GHC.Driver.Config.Diagnostic
import GHC.Driver.Errors
import GHC.Driver.Errors.Types (GhcMessage(..), DriverMessage (DriverNoConfiguredLLVMToolchain))
import GHC.Driver.CmdLine (warnsToMessages)
-import GHC.Types.SrcLoc (noLoc)
+import GHC.Types.SrcLoc (noLoc, noSrcSpan)
{-
************************************************************************
@@ -346,7 +346,7 @@ figureLlvmVersion logger dflags = traceSystoolCommand logger "llc" $ do
debugTraceMsg logger 2
(text "Error (figuring out LLVM version):" <+>
text (show err))
- errorMsg logger $ vcat
+ reportError logger neverQualify emptyDiagOpts noSrcSpan $ vcat
[ text "Warning:", nest 9 $
text "Couldn't figure out LLVM version!" $$
text ("Make sure you have installed LLVM between ["
=====================================
compiler/GHC/Utils/Error.hs
=====================================
@@ -32,7 +32,7 @@ module GHC.Utils.Error (
emptyMessages, mkDecorated, mkLocMessage,
mkMsgEnvelope, mkPlainMsgEnvelope, mkPlainErrorMsgEnvelope,
mkErrorMsgEnvelope,
- mkMCDiagnostic, errorDiagnostic, diagReasonSeverity,
+ mkMCDiagnostic, diagReasonSeverity,
mkPlainError,
mkPlainDiagnostic,
@@ -46,7 +46,6 @@ module GHC.Utils.Error (
-- * Issuing messages during compilation
putMsg, printInfoForUser, printOutputForUser,
logInfo, logOutput,
- errorMsg,
fatalErrorMsg,
compilationProgressMsg,
showPass,
@@ -168,11 +167,6 @@ mkMCDiagnostic opts reason code = MCDiagnostic sev reason' code
where
(sev, reason') = diag_reason_severity opts reason
--- | Varation of 'mkMCDiagnostic' which can be used when we are /sure/ the
--- input 'DiagnosticReason' /is/ 'ErrorWithoutFlag' and there is no diagnostic code.
-errorDiagnostic :: MessageClass
-errorDiagnostic = MCDiagnostic SevError (ResolvedDiagnosticReason ErrorWithoutFlag) Nothing
-
--
-- Creating MsgEnvelope(s)
--
@@ -318,17 +312,12 @@ sortMsgBag mopts = maybeLimit . sortBy (cmp `on` errMsgSpan) . bagToList
ghcExit :: Logger -> Int -> IO ()
ghcExit logger val
| val == 0 = exitWith ExitSuccess
- | otherwise = do errorMsg logger (text "\nCompilation had errors\n\n")
+ | otherwise = do fatalErrorMsg logger (text "\nCompilation had errors\n\n")
exitWith (ExitFailure val)
-- -----------------------------------------------------------------------------
-- Outputting messages from the compiler
-errorMsg :: Logger -> SDoc -> IO ()
-errorMsg logger msg
- = logMsg logger errorDiagnostic noSrcSpan $
- withPprStyle defaultErrStyle msg
-
fatalErrorMsg :: Logger -> SDoc -> IO ()
fatalErrorMsg logger msg =
logMsg logger MCFatal noSrcSpan $ withPprStyle defaultErrStyle msg
=====================================
testsuite/tests/corelint/T21115b.stderr
=====================================
@@ -30,6 +30,6 @@ end Rec }
*** End of Offense ***
-
-<no location info>: error:
Compilation had errors
+
+
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/083e40f1ea7fa13faac282456c357a…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/083e40f1ea7fa13faac282456c357a…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][master] debugger: Uniquely identify breakpoints by internal id
by Marge Bot (＠marge-bot) 01 Aug '25
by Marge Bot (＠marge-bot) 01 Aug '25
01 Aug '25
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
083e40f1 by Rodrigo Mesquita at 2025-08-01T04:38:23-04:00
debugger: Uniquely identify breakpoints by internal id
Since b85b11994e0130ff2401dd4bbdf52330e0bcf776 (support inlining
breakpoints), a breakpoint has been identified at runtime by *two* pairs
of <module,index>.
- The first, aka a 'BreakpointId', uniquely identifies a breakpoint in
the source of a module by using the Tick index. A Tick index can index
into ModBreaks.modBreaks_xxx to fetch source-level information about
where that tick originated.
- When a user specifies e.g. a line breakpoint using :break, we'll reverse
engineer what a Tick index for that line
- We update the `BreakArray` of that module (got from the
LoaderState) at that tick index to `breakOn`.
- A BCO we can stop at is headed by a BRK_FUN instruction. This
instruction stores in an operand the `tick index` it is associated
to. We look it up in the associated `BreakArray` (also an operand)
and check wheter it was set to `breakOn`.
- The second, aka the `ibi_info_mod` + `ibi_info_ix` of the
`InternalBreakpointId`, uniquely index into the `imodBreaks_breakInfo`
-- the information we gathered during code generation about the
existing breakpoint *ocurrences*.
- Note that with optimisation there may be many occurrences of the
same source-tick-breakpoint across different modules. The
`ibi_info_ix` is unique per occurrence, but the `bi_tick_ix` may be
shared. See Note [Breakpoint identifiers] about this.
- Note that besides the tick ids, info ids are also stored in
`BRK_FUN` so the break handler can refer to the associated
`CgBreakInfo`.
In light of that, the driving changes come from the desire to have the
info_id uniquely identify the breakpoint at runtime, and the source tick
id being derived from it:
- An InternalBreakpointId should uniquely identify a breakpoint just
from the code-generation identifiers of `ibi_info_ix` and `ibi_info_mod`.
So we drop `ibi_tick_mod` and `ibi_tick_ix`.
- A BRK_FUN instruction need only record the "internal breakpoint id",
not the tick-level id.
So we drop the tick mod and tick index operands.
- A BreakArray should be indexed by InternalBreakpointId rather than
BreakpointId
That means we need to do some more work when setting a breakpoint.
Specifically, we need to figure out the internal ids (occurrences of a
breakpoint) from the source-level BreakpointId we want to set the
breakpoint at (recall :break refers to breaks at the source level).
Besides this change being an improvement to the handling of breakpoints
(it's clearer to have a single unique identifier than two competing
ones), it unlocks the possibility of generating "internal" breakpoints
during Cg (needed for #26042).
It should also be easier to introduce multi-threaded-aware `BreakArrays`
following this change (needed for #26064).
Se also the new Note [ModBreaks vs InternalModBreaks]
On i386-linux:
-------------------------
Metric Decrease:
interpreter_steplocal
-------------------------
- - - - -
20 changed files:
- compiler/GHC/ByteCode/Asm.hs
- compiler/GHC/ByteCode/Breakpoints.hs
- compiler/GHC/ByteCode/Instr.hs
- compiler/GHC/ByteCode/Linker.hs
- compiler/GHC/ByteCode/Types.hs
- compiler/GHC/CoreToIface.hs
- compiler/GHC/HsToCore/Breakpoints.hs
- compiler/GHC/Linker/Loader.hs
- compiler/GHC/Runtime/Debugger/Breakpoints.hs
- compiler/GHC/Runtime/Eval.hs
- compiler/GHC/Runtime/Interpreter.hs
- compiler/GHC/StgToByteCode.hs
- ghc/GHCi/UI.hs
- ghc/GHCi/UI/Monad.hs
- libraries/ghci/GHCi/Debugger.hs
- libraries/ghci/GHCi/Message.hs
- libraries/ghci/GHCi/Run.hs
- rts/Disassembler.c
- rts/Exception.cmm
- rts/Interpreter.c
Changes:
=====================================
compiler/GHC/ByteCode/Asm.hs
=====================================
@@ -841,24 +841,18 @@ assembleI platform i = case i of
W8 -> emit_ bci_OP_INDEX_ADDR_08 []
_ -> unsupported_width
- BRK_FUN (InternalBreakpointId tick_mod tickx info_mod infox) -> do
+ BRK_FUN ibi@(InternalBreakpointId info_mod infox) -> do
+ p1 <- ptr $ BCOPtrBreakArray info_mod
let -- cast that checks that round-tripping through Word16 doesn't change the value
toW16 x = let r = fromIntegral x :: Word16
in if fromIntegral r == x
then r
else pprPanic "schemeER_wrk: breakpoint tick/info index too large!" (ppr x)
- p1 <- ptr $ BCOPtrBreakArray tick_mod
- tick_addr <- lit1 $ BCONPtrFS $ moduleNameFS $ moduleName tick_mod
- info_addr <- lit1 $ BCONPtrFS $ moduleNameFS $ moduleName info_mod
- tick_unitid_addr <- lit1 $ BCONPtrFS $ unitIdFS $ moduleUnitId $ tick_mod
- info_unitid_addr <- lit1 $ BCONPtrFS $ unitIdFS $ moduleUnitId $ info_mod
- np <- lit1 $ BCONPtrCostCentre (BreakpointId tick_mod tickx)
- emit_ bci_BRK_FUN [ Op p1
- , Op tick_addr, Op info_addr
- , Op tick_unitid_addr, Op info_unitid_addr
- , SmallOp (toW16 tickx), SmallOp (toW16 infox)
- , Op np
- ]
+ info_addr <- lit1 $ BCONPtrFS $ moduleNameFS $ moduleName info_mod
+ info_unitid_addr <- lit1 $ BCONPtrFS $ unitIdFS $ moduleUnitId info_mod
+ np <- lit1 $ BCONPtrCostCentre ibi
+ emit_ bci_BRK_FUN [ Op p1, Op info_addr, Op info_unitid_addr
+ , SmallOp (toW16 infox), Op np ]
BRK_ALTS active -> emit_ bci_BRK_ALTS [SmallOp (if active then 1 else 0)]
=====================================
compiler/GHC/ByteCode/Breakpoints.hs
=====================================
@@ -7,23 +7,23 @@
-- 'InternalModBreaks', and is uniquely identified at runtime by an
-- 'InternalBreakpointId'.
--
--- See Note [Breakpoint identifiers]
+-- See Note [ModBreaks vs InternalModBreaks] and Note [Breakpoint identifiers]
module GHC.ByteCode.Breakpoints
( -- * Internal Mod Breaks
InternalModBreaks(..), CgBreakInfo(..)
- , mkInternalModBreaks
+ , mkInternalModBreaks, imodBreaks_module
-- ** Internal breakpoint identifier
, InternalBreakpointId(..), BreakInfoIndex
-- * Operations
- , toBreakpointId
-- ** Internal-level operations
- , getInternalBreak, addInternalBreak
+ , getInternalBreak
-- ** Source-level information operations
, getBreakLoc, getBreakVars, getBreakDecls, getBreakCCS
+ , getBreakSourceId
-- * Utils
, seqInternalModBreaks
@@ -47,6 +47,31 @@ import GHC.Utils.Panic
import Data.Array
{-
+Note [ModBreaks vs InternalModBreaks]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+'ModBreaks' and 'BreakpointId's must not to be confused with
+'InternalModBreaks' and 'InternalBreakId's.
+
+'ModBreaks' is constructed once during HsToCore from the information attached
+to source-level breakpoint ticks and is never changed afterwards. A 'ModBreaks'
+can be queried using 'BreakpointId's, which uniquely identifies a breakpoint
+within the list of breakpoint information for a given module's 'ModBreaks'.
+
+'InternalModBreaks' are constructed during bytecode generation and are indexed
+by a 'InternalBreakpointId'. They contain all the information relevant to a
+breakpoint for code generation that can be accessed during runtime execution
+(such as a 'BreakArray' for triggering breakpoints). 'InternalBreakpointId's
+are used at runtime to trigger and inspect breakpoints -- a 'BRK_FUN'
+instruction receives 'InternalBreakpointId' as an argument.
+
+We keep a mapping from 'InternalModBreaks' to a 'BreakpointId', which can then be used
+to get source-level information about a breakpoint via the corresponding 'ModBreaks'.
+
+Notably, 'InternalModBreaks' can contain entries for so-called internal
+breakpoints, which do not necessarily have a source-level location attached to
+it (i.e. do not have a matching entry in 'ModBreaks'). We may leverage this to
+introduce breakpoints during code generation for features such as stepping-out.
+
Note [Breakpoint identifiers]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Before optimization a breakpoint is identified uniquely with a tick module
@@ -64,6 +89,10 @@ So every breakpoint occurrence gets assigned a module-unique *info index* and
we store it alongside the occurrence module (*info module*) in the
'InternalBreakpointId' datatype. This is the index that we use at runtime to
identify a breakpoint.
+
+When the internal breakpoint has a matching tick-level breakpoint we can fetch
+the related tick-level information by first looking up a mapping
+@'InternalBreakpointId' -> 'BreakpointId'@ in @'CgBreakInfo'@.
-}
--------------------------------------------------------------------------------
@@ -78,19 +107,11 @@ type BreakInfoIndex = Int
-- Indexes into the structures in the @'InternalModBreaks'@ produced during ByteCode generation.
-- See Note [Breakpoint identifiers]
data InternalBreakpointId = InternalBreakpointId
- { ibi_tick_mod :: !Module -- ^ Breakpoint tick module
- , ibi_tick_index :: !Int -- ^ Breakpoint tick index
- , ibi_info_mod :: !Module -- ^ Breakpoint tick module
- , ibi_info_index :: !BreakInfoIndex -- ^ Breakpoint tick index
+ { ibi_info_mod :: !Module -- ^ Breakpoint info module
+ , ibi_info_index :: !BreakInfoIndex -- ^ Breakpoint info index
}
deriving (Eq, Ord)
-toBreakpointId :: InternalBreakpointId -> BreakpointId
-toBreakpointId ibi = BreakpointId
- { bi_tick_mod = ibi_tick_mod ibi
- , bi_tick_index = ibi_tick_index ibi
- }
-
--------------------------------------------------------------------------------
-- * Internal Mod Breaks
--------------------------------------------------------------------------------
@@ -107,18 +128,34 @@ data InternalModBreaks = InternalModBreaks
-- 'InternalBreakpointId'.
, imodBreaks_modBreaks :: !ModBreaks
- -- ^ Store the original ModBreaks for this module, unchanged.
- -- Allows us to query about source-level breakpoint information using
- -- an internal breakpoint id.
+ -- ^ Store the ModBreaks for this module
+ --
+ -- Recall Note [Breakpoint identifiers]: for some module A, an
+ -- *occurrence* of a breakpoint in A may have been inlined from some
+ -- breakpoint *defined* in module B.
+ --
+ -- This 'ModBreaks' contains information regarding all the breakpoints
+ -- defined in the module this 'InternalModBreaks' corresponds to. It
+ -- /does not/ necessarily have information regarding all the breakpoint
+ -- occurrences registered in 'imodBreaks_breakInfo'. Some of those
+ -- occurrences may refer breakpoints inlined from other modules.
}
--- | Construct an 'InternalModBreaks'
+-- | Construct an 'InternalModBreaks'.
+--
+-- INVARIANT: The given 'ModBreaks' correspond to the same module as this
+-- 'InternalModBreaks' module (the first argument) and its breakpoint infos
+-- (the @IntMap CgBreakInfo@ argument)
mkInternalModBreaks :: Module -> IntMap CgBreakInfo -> ModBreaks -> InternalModBreaks
mkInternalModBreaks mod im mbs =
assertPpr (mod == modBreaks_module mbs)
(text "Constructing InternalModBreaks with the ModBreaks of a different module!") $
InternalModBreaks im mbs
+-- | Get the module to which these 'InternalModBreaks' correspond
+imodBreaks_module :: InternalModBreaks -> Module
+imodBreaks_module = modBreaks_module . imodBreaks_modBreaks
+
-- | Information about a breakpoint that we know at code-generation time
-- In order to be used, this needs to be hydrated relative to the current HscEnv by
-- 'hydrateCgBreakInfo'. Everything here can be fully forced and that's critical for
@@ -128,20 +165,22 @@ data CgBreakInfo
{ cgb_tyvars :: ![IfaceTvBndr] -- ^ Type variables in scope at the breakpoint
, cgb_vars :: ![Maybe (IfaceIdBndr, Word)]
, cgb_resty :: !IfaceType
+ , cgb_tick_id :: !BreakpointId
+ -- ^ This field records the original breakpoint tick identifier for this
+ -- internal breakpoint info. It is used to convert a breakpoint
+ -- *occurrence* index ('InternalBreakpointId') into a *definition* index
+ -- ('BreakpointId').
+ --
+ -- The modules of breakpoint occurrence and breakpoint definition are not
+ -- necessarily the same: See Note [Breakpoint identifiers].
}
-- See Note [Syncing breakpoint info] in GHC.Runtime.Eval
-- | Get an internal breakpoint info by 'InternalBreakpointId'
getInternalBreak :: InternalBreakpointId -> InternalModBreaks -> CgBreakInfo
-getInternalBreak (InternalBreakpointId _ _ info_mod info_ix) imbs =
- assert_modules_match info_mod (modBreaks_module $ imodBreaks_modBreaks imbs) $
- imodBreaks_breakInfo imbs IM.! info_ix
-
--- | Add a CgBreakInfo to an 'InternalModBreaks' at 'InternalBreakpointId'
-addInternalBreak :: InternalBreakpointId -> CgBreakInfo -> InternalModBreaks -> InternalModBreaks
-addInternalBreak (InternalBreakpointId _ _ info_mod info_ix) info imbs =
- assert_modules_match info_mod (modBreaks_module $ imodBreaks_modBreaks imbs) $
- imbs{imodBreaks_breakInfo = IM.insert info_ix info (imodBreaks_breakInfo imbs)}
+getInternalBreak (InternalBreakpointId mod ix) imbs =
+ assert_modules_match mod (imodBreaks_module imbs) $
+ imodBreaks_breakInfo imbs IM.! ix
-- | Assert that the module in the 'InternalBreakpointId' and in
-- 'InternalModBreaks' match.
@@ -155,27 +194,56 @@ assert_modules_match ibi_mod imbs_mod =
-- Tick-level Breakpoint information
--------------------------------------------------------------------------------
+-- | Get the source module and tick index for this breakpoint
+-- (as opposed to the module where this breakpoint occurs, which is in 'InternalBreakpointId')
+getBreakSourceId :: InternalBreakpointId -> InternalModBreaks -> BreakpointId
+getBreakSourceId (InternalBreakpointId ibi_mod ibi_ix) imbs =
+ assert_modules_match ibi_mod (imodBreaks_module imbs) $
+ let cgb = imodBreaks_breakInfo imbs IM.! ibi_ix
+ in cgb_tick_id cgb
+
-- | Get the source span for this breakpoint
-getBreakLoc :: InternalBreakpointId -> InternalModBreaks -> SrcSpan
+getBreakLoc :: (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO SrcSpan
getBreakLoc = getBreakXXX modBreaks_locs
-- | Get the vars for this breakpoint
-getBreakVars :: InternalBreakpointId -> InternalModBreaks -> [OccName]
+getBreakVars :: (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO [OccName]
getBreakVars = getBreakXXX modBreaks_vars
-- | Get the decls for this breakpoint
-getBreakDecls :: InternalBreakpointId -> InternalModBreaks -> [String]
+getBreakDecls :: (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO [String]
getBreakDecls = getBreakXXX modBreaks_decls
-- | Get the decls for this breakpoint
-getBreakCCS :: InternalBreakpointId -> InternalModBreaks -> (String, String)
+getBreakCCS :: (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO (String, String)
getBreakCCS = getBreakXXX modBreaks_ccs
-- | Internal utility to access a ModBreaks field at a particular breakpoint index
-getBreakXXX :: (ModBreaks -> Array BreakTickIndex a) -> InternalBreakpointId -> InternalModBreaks -> a
-getBreakXXX view (InternalBreakpointId tick_mod tick_id _ _) imbs =
- assert_modules_match tick_mod (modBreaks_module $ imodBreaks_modBreaks imbs) $ do
- view (imodBreaks_modBreaks imbs) ! tick_id
+--
+-- Recall Note [Breakpoint identifiers]: the internal breakpoint module (the
+-- *occurrence* module) doesn't necessarily match the module where the
+-- tick breakpoint was defined with the relevant 'ModBreaks'.
+--
+-- When the tick module is the same as the internal module, we use the stored
+-- 'ModBreaks'. When the tick module is different, we need to look up the
+-- 'ModBreaks' in the HUG for that other module.
+--
+-- To avoid cyclic dependencies, we instead receive a function that looks up
+-- the 'ModBreaks' given a 'Module'
+getBreakXXX :: (ModBreaks -> Array BreakTickIndex a) -> (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO a
+getBreakXXX view lookupModule (InternalBreakpointId ibi_mod ibi_ix) imbs =
+ assert_modules_match ibi_mod (imodBreaks_module imbs) $ do
+ let cgb = imodBreaks_breakInfo imbs IM.! ibi_ix
+ case cgb_tick_id cgb of
+ BreakpointId{bi_tick_mod, bi_tick_index}
+ | bi_tick_mod == ibi_mod
+ -> do
+ let these_mbs = imodBreaks_modBreaks imbs
+ return $ view these_mbs ! bi_tick_index
+ | otherwise
+ -> do
+ other_mbs <- lookupModule bi_tick_mod
+ return $ view other_mbs ! bi_tick_index
--------------------------------------------------------------------------------
-- Instances
@@ -190,7 +258,8 @@ seqInternalModBreaks InternalModBreaks{..} =
seqCgBreakInfo CgBreakInfo{..} =
rnf cgb_tyvars `seq`
rnf cgb_vars `seq`
- rnf cgb_resty
+ rnf cgb_resty `seq`
+ rnf cgb_tick_id
instance Outputable InternalBreakpointId where
ppr InternalBreakpointId{..} =
@@ -203,4 +272,5 @@ instance NFData InternalBreakpointId where
instance Outputable CgBreakInfo where
ppr info = text "CgBreakInfo" <+>
parens (ppr (cgb_vars info) <+>
- ppr (cgb_resty info))
+ ppr (cgb_resty info) <+>
+ ppr (cgb_tick_id info))
=====================================
compiler/GHC/ByteCode/Instr.hs
=====================================
@@ -454,9 +454,8 @@ instance Outputable BCInstr where
ppr ENTER = text "ENTER"
ppr (RETURN pk) = text "RETURN " <+> ppr pk
ppr (RETURN_TUPLE) = text "RETURN_TUPLE"
- ppr (BRK_FUN (InternalBreakpointId tick_mod tickx info_mod infox))
+ ppr (BRK_FUN (InternalBreakpointId info_mod infox))
= text "BRK_FUN" <+> text "<breakarray>"
- <+> ppr tick_mod <+> ppr tickx
<+> ppr info_mod <+> ppr infox
<+> text "<cc>"
ppr (BRK_ALTS active) = text "BRK_ALTS" <+> ppr active
=====================================
compiler/GHC/ByteCode/Linker.hs
=====================================
@@ -98,9 +98,9 @@ lookupLiteral interp pkgs_loaded le lb ptr = case ptr of
BCONPtrFFIInfo (FFIInfo {..}) -> do
RemotePtr p <- interpCmd interp $ PrepFFI ffiInfoArgs ffiInfoRet
pure $ fromIntegral p
- BCONPtrCostCentre BreakpointId{..}
+ BCONPtrCostCentre InternalBreakpointId{..}
| interpreterProfiled interp -> do
- case expectJust (lookupModuleEnv (ccs_env lb) bi_tick_mod) ! bi_tick_index of
+ case expectJust (lookupModuleEnv (ccs_env lb) ibi_info_mod) ! ibi_info_index of
RemotePtr p -> pure $ fromIntegral p
| otherwise ->
case toRemotePtr nullPtr of
=====================================
compiler/GHC/ByteCode/Types.hs
=====================================
@@ -285,7 +285,7 @@ data BCONPtr
-- | A libffi ffi_cif function prototype.
| BCONPtrFFIInfo !FFIInfo
-- | A 'CostCentre' remote pointer array's respective 'BreakpointId'
- | BCONPtrCostCentre !BreakpointId
+ | BCONPtrCostCentre !InternalBreakpointId
instance NFData BCONPtr where
rnf x = x `seq` ()
=====================================
compiler/GHC/CoreToIface.hs
=====================================
@@ -704,12 +704,13 @@ toIfaceLFInfo nm lfi = case lfi of
-- Dehydrating CgBreakInfo
-dehydrateCgBreakInfo :: [TyVar] -> [Maybe (Id, Word)] -> Type -> CgBreakInfo
-dehydrateCgBreakInfo ty_vars idOffSets tick_ty =
+dehydrateCgBreakInfo :: [TyVar] -> [Maybe (Id, Word)] -> Type -> BreakpointId -> CgBreakInfo
+dehydrateCgBreakInfo ty_vars idOffSets tick_ty bid =
CgBreakInfo
{ cgb_tyvars = map toIfaceTvBndr ty_vars
, cgb_vars = map (fmap (\(i, offset) -> (toIfaceIdBndr i, offset))) idOffSets
, cgb_resty = toIfaceType tick_ty
+ , cgb_tick_id = bid
}
{- Note [Inlining and hs-boot files]
=====================================
compiler/GHC/HsToCore/Breakpoints.hs
=====================================
@@ -12,7 +12,7 @@
-- 'InternalModBreaks' and 'InternalBreakId's. The latter are constructed
-- during bytecode generation and can be found in 'GHC.ByteCode.Breakpoints'.
--
--- See Note [Breakpoint identifiers]
+-- See Note [ModBreaks vs InternalModBreaks] and Note [Breakpoint identifiers]
module GHC.HsToCore.Breakpoints
( -- * ModBreaks
mkModBreaks, ModBreaks(..)
=====================================
compiler/GHC/Linker/Loader.hs
=====================================
@@ -124,7 +124,9 @@ import GHC.Utils.Exception
import GHC.Unit.Home.Graph (lookupHug, unitEnv_foldWithKey)
import GHC.Driver.Downsweep
import qualified GHC.Runtime.Interpreter as GHCi
-import Data.Array.Base (numElements)
+import qualified Data.IntMap.Strict as IM
+import qualified Data.Map.Strict as M
+import Foreign.Ptr (nullPtr)
-- Note [Linkers and loaders]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -1666,10 +1668,10 @@ allocateBreakArrays ::
IO (ModuleEnv (ForeignRef BreakArray))
allocateBreakArrays interp =
foldlM
- ( \be0 InternalModBreaks{imodBreaks_modBreaks=ModBreaks {..}} -> do
+ ( \be0 InternalModBreaks{imodBreaks_breakInfo, imodBreaks_modBreaks=ModBreaks {..}} -> do
-- If no BreakArray is assigned to this module yet, create one
if not $ elemModuleEnv modBreaks_module be0 then do
- let count = numElements modBreaks_locs
+ let count = maybe 0 ((+1) . fst) $ IM.lookupMax imodBreaks_breakInfo
breakArray <- GHCi.newBreakArray interp count
evaluate $ extendModuleEnv be0 modBreaks_module breakArray
else
@@ -1679,29 +1681,51 @@ allocateBreakArrays interp =
-- | Given a list of 'InternalModBreaks' collected from a list
-- of 'CompiledByteCode', allocate the 'CostCentre' arrays when profiling is
-- enabled.
+--
+-- Note that the resulting arrays are indexed by 'BreakInfoIndex' (internal
+-- breakpoint index), not by tick index
allocateCCS ::
Interp ->
- ModuleEnv (Array BreakTickIndex (RemotePtr CostCentre)) ->
+ ModuleEnv (Array BreakInfoIndex (RemotePtr CostCentre)) ->
[InternalModBreaks] ->
- IO (ModuleEnv (Array BreakTickIndex (RemotePtr CostCentre)))
+ IO (ModuleEnv (Array BreakInfoIndex (RemotePtr CostCentre)))
allocateCCS interp ce mbss
- | interpreterProfiled interp =
- foldlM
- ( \ce0 InternalModBreaks{imodBreaks_modBreaks=ModBreaks {..}} -> do
- ccs <-
+ | interpreterProfiled interp = do
+ -- 1. Create a mapping from source BreakpointId to CostCentre ptr
+ ccss <- M.unions <$> mapM
+ ( \InternalModBreaks{imodBreaks_modBreaks=ModBreaks{..}} -> do
+ ccs <- {- one ccs ptr per tick index -}
mkCostCentres
interp
(moduleNameString $ moduleName modBreaks_module)
(elems modBreaks_ccs)
- if not $ elemModuleEnv modBreaks_module ce0 then do
- evaluate $
- extendModuleEnv ce0 modBreaks_module $
- listArray
- (0, length ccs - 1)
- ccs
+ return $ M.fromList $
+ zipWith (\el ix -> (BreakpointId modBreaks_module ix, el)) ccs [0..]
+ )
+ mbss
+ -- 2. Create an array with one element for every InternalBreakpointId,
+ -- where every element has the CCS for the corresponding BreakpointId
+ foldlM
+ (\ce0 InternalModBreaks{imodBreaks_breakInfo, imodBreaks_modBreaks=ModBreaks{..}} -> do
+ if not $ elemModuleEnv modBreaks_module ce then do
+ let count = maybe 0 ((+1) . fst) $ IM.lookupMax imodBreaks_breakInfo
+ let ccs = IM.map
+ (\info ->
+ fromMaybe (toRemotePtr nullPtr)
+ (M.lookup (cgb_tick_id info) ccss)
+ )
+ imodBreaks_breakInfo
+ assertPpr (count == length ccs)
+ (text "expected CgBreakInfo map to have one entry per valid ix") $
+ evaluate $
+ extendModuleEnv ce0 modBreaks_module $
+ listArray
+ (0, count)
+ (IM.elems ccs)
else
return ce0
)
ce
mbss
+
| otherwise = pure ce
=====================================
compiler/GHC/Runtime/Debugger/Breakpoints.hs
=====================================
@@ -31,6 +31,9 @@ import GHC.Unit.Module.ModSummary
import GHC.Utils.Outputable
import GHC.Utils.Panic
import qualified GHC.Data.Strict as Strict
+import qualified Data.IntMap.Strict as IntMap
+import qualified GHC.Unit.Home.Graph as HUG
+import qualified GHC.Unit.Home.PackageTable as HPT
--------------------------------------------------------------------------------
-- Finding Module breakpoints
@@ -213,6 +216,47 @@ getModBreak m = do
mod_info <- fromMaybe (panic "getModBreak") <$> getModuleInfo m
pure $ imodBreaks_modBreaks <$> modInfoModBreaks mod_info
+--------------------------------------------------------------------------------
+-- Mapping source-level BreakpointIds to IBI occurrences
+-- (See Note [Breakpoint identifiers])
+--------------------------------------------------------------------------------
+
+-- | A source-level breakpoint may have been inlined into many occurrences, now
+-- referred by 'InternalBreakpointId'. When a breakpoint is set on a certain
+-- source breakpoint, it means all *ocurrences* of that breakpoint across
+-- modules should be stopped at -- hence we keep a trie from BreakpointId to
+-- the list of internal break ids using it.
+-- See also Note [Breakpoint identifiers]
+type BreakpointOccurrences = ModuleEnv (IntMap.IntMap [InternalBreakpointId])
+
+-- | Lookup all InternalBreakpointIds matching the given BreakpointId
+-- Nothing if BreakpointId not in map
+lookupBreakpointOccurrences :: BreakpointOccurrences -> BreakpointId -> Maybe [InternalBreakpointId]
+lookupBreakpointOccurrences bmp (BreakpointId md tick) =
+ lookupModuleEnv bmp md >>= IntMap.lookup tick
+
+-- | Construct a mapping from Source 'BreakpointId's to 'InternalBreakpointId's from the given list of 'ModInfo's
+mkBreakpointOccurrences :: forall m. GhcMonad m => m BreakpointOccurrences
+mkBreakpointOccurrences = do
+ hug <- hsc_HUG <$> getSession
+ liftIO $ foldr go (pure emptyModuleEnv) hug
+ where
+ go :: HUG.HomeUnitEnv -> IO BreakpointOccurrences -> IO BreakpointOccurrences
+ go hue mbmp = do
+ bmp <- mbmp
+ ibrkss <- HPT.concatHpt (\hmi -> maybeToList (getModBreaks hmi))
+ (HUG.homeUnitEnv_hpt hue)
+ return $ foldr addBreakToMap bmp ibrkss
+
+ addBreakToMap :: InternalModBreaks -> BreakpointOccurrences -> BreakpointOccurrences
+ addBreakToMap ibrks bmp0 = do
+ let imod = modBreaks_module $ imodBreaks_modBreaks ibrks
+ IntMap.foldrWithKey (\info_ix cgi bmp -> do
+ let ibi = InternalBreakpointId imod info_ix
+ let BreakpointId tick_mod tick_ix = cgb_tick_id cgi
+ extendModuleEnvWith (IntMap.unionWith (S.<>)) bmp tick_mod (IntMap.singleton tick_ix [ibi])
+ ) bmp0 (imodBreaks_breakInfo ibrks)
+
--------------------------------------------------------------------------------
-- Getting current breakpoint information
--------------------------------------------------------------------------------
@@ -235,9 +279,15 @@ getCurrentBreakSpan = do
getCurrentBreakModule :: GhcMonad m => m (Maybe Module)
getCurrentBreakModule = do
resumes <- getResumeContext
- return $ case resumes of
- [] -> Nothing
+ hug <- hsc_HUG <$> getSession
+ liftIO $ case resumes of
+ [] -> pure Nothing
(r:_) -> case resumeHistoryIx r of
- 0 -> ibi_tick_mod <$> resumeBreakpointId r
- ix -> Just $ getHistoryModule $ resumeHistory r !! (ix-1)
+ 0 -> case resumeBreakpointId r of
+ Nothing -> pure Nothing
+ Just ibi -> do
+ brks <- readIModBreaks hug ibi
+ return $ Just $ bi_tick_mod $ getBreakSourceId ibi brks
+ ix ->
+ Just <$> getHistoryModule hug (resumeHistory r !! (ix-1))
=====================================
compiler/GHC/Runtime/Eval.hs
=====================================
@@ -18,7 +18,7 @@ module GHC.Runtime.Eval (
abandon, abandonAll,
getResumeContext,
getHistorySpan,
- getModBreaks, readModBreaks,
+ getModBreaks, readIModBreaks, readIModModBreaks,
getHistoryModule,
setupBreakpoint,
back, forward,
@@ -147,14 +147,17 @@ getResumeContext = withSession (return . ic_resume . hsc_IC)
mkHistory :: HUG.HomeUnitGraph -> ForeignHValue -> InternalBreakpointId -> IO History
mkHistory hug hval ibi = History hval ibi <$> findEnclosingDecls hug ibi
-getHistoryModule :: History -> Module
-getHistoryModule = ibi_tick_mod . historyBreakpointId
+getHistoryModule :: HUG.HomeUnitGraph -> History -> IO Module
+getHistoryModule hug hist = do
+ let ibi = historyBreakpointId hist
+ brks <- readIModBreaks hug ibi
+ return $ bi_tick_mod $ getBreakSourceId ibi brks
getHistorySpan :: HUG.HomeUnitGraph -> History -> IO SrcSpan
getHistorySpan hug hist = do
let ibi = historyBreakpointId hist
- brks <- readModBreaks hug (ibi_tick_mod ibi)
- return $ getBreakLoc ibi brks
+ brks <- readIModBreaks hug ibi
+ getBreakLoc (readIModModBreaks hug) ibi brks
{- | Finds the enclosing top level function name -}
-- ToDo: a better way to do this would be to keep hold of the decl_path computed
@@ -162,8 +165,8 @@ getHistorySpan hug hist = do
-- for each tick.
findEnclosingDecls :: HUG.HomeUnitGraph -> InternalBreakpointId -> IO [String]
findEnclosingDecls hug ibi = do
- brks <- readModBreaks hug (ibi_tick_mod ibi)
- return $ getBreakDecls ibi brks
+ brks <- readIModBreaks hug ibi
+ getBreakDecls (readIModModBreaks hug) ibi brks
-- | Update fixity environment in the current interactive context.
updateFixityEnv :: GhcMonad m => FixityEnv -> m ()
@@ -350,15 +353,14 @@ handleRunStatus step expr bindings final_ids status history0 = do
EvalBreak apStack_ref (Just eval_break) resume_ctxt ccs -> do
let ibi = evalBreakpointToId eval_break
let hug = hsc_HUG hsc_env
- tick_brks <- liftIO $ readModBreaks hug (ibi_tick_mod ibi)
- let
- span = getBreakLoc ibi tick_brks
- decl = intercalate "." $ getBreakDecls ibi tick_brks
+ info_brks <- liftIO $ readIModBreaks hug ibi
+ span <- liftIO $ getBreakLoc (readIModModBreaks hug) ibi info_brks
+ decl <- liftIO $ intercalate "." <$> getBreakDecls (readIModModBreaks hug) ibi info_brks
-- Was this breakpoint explicitly enabled (ie. in @BreakArray@)?
bactive <- liftIO $ do
- breakArray <- getBreakArray interp (toBreakpointId ibi) tick_brks
- breakpointStatus interp breakArray (ibi_tick_index ibi)
+ breakArray <- getBreakArray interp ibi info_brks
+ breakpointStatus interp breakArray (ibi_info_index ibi)
apStack_fhv <- liftIO $ mkFinalizedHValue interp apStack_ref
resume_ctxt_fhv <- liftIO $ mkFinalizedHValue interp resume_ctxt
@@ -446,7 +448,7 @@ resumeExec step mbCnt
-- When the user specified a break ignore count, set it
-- in the interpreter
case (mb_brkpt, mbCnt) of
- (Just brkpt, Just cnt) -> setupBreakpoint interp (toBreakpointId brkpt) cnt
+ (Just brkpt, Just cnt) -> setupBreakpoint interp brkpt cnt
_ -> return ()
let eval_opts = initEvalOpts dflags (enableGhcStepMode step)
@@ -462,17 +464,18 @@ resumeExec step mbCnt
| otherwise -> pure prevHistoryLst
handleRunStatus step expr bindings final_ids status =<< hist'
-setupBreakpoint :: GhcMonad m => Interp -> BreakpointId -> Int -> m () -- #19157
-setupBreakpoint interp bi cnt = do
+setupBreakpoint :: GhcMonad m => Interp -> InternalBreakpointId -> Int -> m () -- #19157
+setupBreakpoint interp ibi cnt = do
hug <- hsc_HUG <$> getSession
- modBreaks <- liftIO $ readModBreaks hug (bi_tick_mod bi)
- breakArray <- liftIO $ getBreakArray interp bi modBreaks
- liftIO $ GHCi.storeBreakpoint interp breakArray (bi_tick_index bi) cnt
+ liftIO $ do
+ modBreaks <- readIModBreaks hug ibi
+ breakArray <- getBreakArray interp ibi modBreaks
+ GHCi.storeBreakpoint interp breakArray (ibi_info_index ibi) cnt
-getBreakArray :: Interp -> BreakpointId -> InternalModBreaks -> IO (ForeignRef BreakArray)
-getBreakArray interp BreakpointId{bi_tick_mod} imbs = do
+getBreakArray :: Interp -> InternalBreakpointId -> InternalModBreaks -> IO (ForeignRef BreakArray)
+getBreakArray interp InternalBreakpointId{ibi_info_mod} imbs = do
breaks0 <- linked_breaks . fromMaybe (panic "Loader not initialised") <$> getLoaderState interp
- case lookupModuleEnv (breakarray_env breaks0) bi_tick_mod of
+ case lookupModuleEnv (breakarray_env breaks0) ibi_info_mod of
Just ba -> return ba
Nothing -> do
modifyLoaderState interp $ \ld_st -> do
@@ -483,13 +486,12 @@ getBreakArray interp BreakpointId{bi_tick_mod} imbs = do
ba_env <- allocateBreakArrays interp (breakarray_env lb) [imbs]
let ld_st' = ld_st { linked_breaks = lb{breakarray_env = ba_env} }
- let ba = expectJust {- just computed -} $ lookupModuleEnv ba_env bi_tick_mod
+ let ba = expectJust {- just computed -} $ lookupModuleEnv ba_env ibi_info_mod
return
( ld_st'
, ba
)
-
back :: GhcMonad m => Int -> m ([Name], Int, SrcSpan)
back n = moveHist (+n)
@@ -517,8 +519,9 @@ moveHist fn = do
span <- case mb_info of
Nothing -> return $ mkGeneralSrcSpan (fsLit "<unknown>")
Just ibi -> liftIO $ do
- brks <- readModBreaks (hsc_HUG hsc_env) (ibi_tick_mod ibi)
- return $ getBreakLoc ibi brks
+ let hug = hsc_HUG hsc_env
+ brks <- readIModBreaks hug ibi
+ getBreakLoc (readIModModBreaks hug) ibi brks
(hsc_env1, names) <-
liftIO $ bindLocalsAtBreakpoint hsc_env apStack span mb_info
let ic = hsc_IC hsc_env1
@@ -579,11 +582,10 @@ bindLocalsAtBreakpoint hsc_env apStack span Nothing = do
-- of the breakpoint and the free variables of the expression.
bindLocalsAtBreakpoint hsc_env apStack_fhv span (Just ibi) = do
let hug = hsc_HUG hsc_env
- info_brks <- readModBreaks hug (ibi_info_mod ibi)
- tick_brks <- readModBreaks hug (ibi_tick_mod ibi)
- let info = getInternalBreak ibi (info_brks)
+ info_brks <- readIModBreaks hug ibi
+ let info = getInternalBreak ibi info_brks
interp = hscInterp hsc_env
- occs = getBreakVars ibi tick_brks
+ occs <- getBreakVars (readIModModBreaks hug) ibi info_brks
-- Rehydrate to understand the breakpoint info relative to the current environment.
-- This design is critical to preventing leaks (#22530)
=====================================
compiler/GHC/Runtime/Interpreter.hs
=====================================
@@ -27,7 +27,9 @@ module GHC.Runtime.Interpreter
, getClosure
, whereFrom
, getModBreaks
- , readModBreaks
+ , readIModBreaks
+ , readIModBreaksMaybe
+ , readIModModBreaks
, seqHValue
, evalBreakpointToId
@@ -92,7 +94,6 @@ import GHC.Utils.Fingerprint
import GHC.Unit.Module
import GHC.Unit.Home.ModInfo
-import GHC.Unit.Home.Graph (lookupHugByModule)
import GHC.Unit.Env
#if defined(HAVE_INTERNAL_INTERPRETER)
@@ -411,15 +412,10 @@ evalBreakpointToId :: EvalBreakpoint -> InternalBreakpointId
evalBreakpointToId eval_break =
let
mkUnitId u = fsToUnit $ mkFastStringShortByteString u
-
toModule u n = mkModule (mkUnitId u) (mkModuleName n)
- tickl = toModule (eb_tick_mod_unit eval_break) (eb_tick_mod eval_break)
- infol = toModule (eb_info_mod_unit eval_break) (eb_info_mod eval_break)
in
InternalBreakpointId
- { ibi_tick_mod = tickl
- , ibi_tick_index = eb_tick_index eval_break
- , ibi_info_mod = infol
+ { ibi_info_mod = toModule (eb_info_mod_unit eval_break) (eb_info_mod eval_break)
, ibi_info_index = eb_info_index eval_break
}
@@ -440,17 +436,18 @@ handleSeqHValueStatus interp unit_env eval_status =
-- Reason: Setting of flags in libraries/ghci/GHCi/Run.hs:evalOptsSeq
Just break -> do
- let bi = evalBreakpointToId break
+ let ibi = evalBreakpointToId break
+ hug = ue_home_unit_graph unit_env
-- Just case: Stopped at a breakpoint, extract SrcSpan information
-- from the breakpoint.
- mb_modbreaks <- getModBreaks . expectJust <$>
- lookupHugByModule (ibi_tick_mod bi) (ue_home_unit_graph unit_env)
+ mb_modbreaks <- readIModBreaksMaybe hug (ibi_info_mod ibi)
case mb_modbreaks of
-- Nothing case - should not occur! We should have the appropriate
-- breakpoint information
Nothing -> nothing_case
- Just modbreaks -> put $ brackets . ppr $ getBreakLoc bi modbreaks
+ Just modbreaks -> put . brackets . ppr =<<
+ getBreakLoc (readIModModBreaks hug) ibi modbreaks
-- resume the seq (:force) processing in the iserv process
withForeignRef resume_ctxt_fhv $ \hval -> do
@@ -745,10 +742,18 @@ getModBreaks hmi
| otherwise
= Nothing -- probably object code
--- | Read the 'InternalModBreaks' and 'ModBreaks' of the given home 'Module'
--- from the 'HomeUnitGraph'.
-readModBreaks :: HomeUnitGraph -> Module -> IO InternalModBreaks
-readModBreaks hug modl = expectJust . getModBreaks . expectJust <$> HUG.lookupHugByModule modl hug
+-- | Read the 'InternalModBreaks' of the given home 'Module' (via
+-- 'InternalBreakpointId') from the 'HomeUnitGraph'.
+readIModBreaks :: HomeUnitGraph -> InternalBreakpointId -> IO InternalModBreaks
+readIModBreaks hug ibi = expectJust <$> readIModBreaksMaybe hug (ibi_info_mod ibi)
+
+-- | Read the 'InternalModBreaks' of the given home 'Module' from the 'HomeUnitGraph'.
+readIModBreaksMaybe :: HomeUnitGraph -> Module -> IO (Maybe InternalModBreaks)
+readIModBreaksMaybe hug mod = getModBreaks . expectJust <$> HUG.lookupHugByModule mod hug
+
+-- | Read the 'ModBreaks' from the given module's 'InternalModBreaks'
+readIModModBreaks :: HUG.HomeUnitGraph -> Module -> IO ModBreaks
+readIModModBreaks hug mod = imodBreaks_modBreaks . expectJust <$> readIModBreaksMaybe hug mod
-- -----------------------------------------------------------------------------
-- Misc utils
=====================================
compiler/GHC/StgToByteCode.hs
=====================================
@@ -31,7 +31,6 @@ import GHC.Cmm.Utils
import GHC.Platform
import GHC.Platform.Profile
-import GHC.Runtime.Interpreter
import GHCi.FFI
import GHC.Types.Basic
import GHC.Utils.Outputable
@@ -64,6 +63,7 @@ import GHC.StgToCmm.Closure ( NonVoid(..), fromNonVoid, idPrimRepU,
assertNonVoidIds, assertNonVoidStgArgs )
import GHC.StgToCmm.Layout
import GHC.Runtime.Heap.Layout hiding (WordOff, ByteOff, wordsToBytes)
+import GHC.Runtime.Interpreter ( interpreterProfiled )
import GHC.Data.Bitmap
import GHC.Data.FlatBag as FlatBag
import GHC.Data.OrdList
@@ -79,7 +79,6 @@ import Control.Monad
import Data.Char
import GHC.Unit.Module
-import qualified GHC.Unit.Home.Graph as HUG
import Data.Coerce (coerce)
#if MIN_VERSION_rts(1,0,3)
@@ -394,65 +393,28 @@ schemeR_wrk fvs nm original_body (args, body)
-- | Introduce break instructions for ticked expressions.
-- If no breakpoint information is available, the instruction is omitted.
schemeER_wrk :: StackDepth -> BCEnv -> CgStgExpr -> BcM BCInstrList
-schemeER_wrk d p (StgTick (Breakpoint tick_ty (BreakpointId tick_mod tick_no) fvs) rhs) = do
+schemeER_wrk d p (StgTick (Breakpoint tick_ty tick_id fvs) rhs) = do
code <- schemeE d 0 p rhs
- hsc_env <- getHscEnv
- current_mod <- getCurrentModule
mb_current_mod_breaks <- getCurrentModBreaks
case mb_current_mod_breaks of
-- if we're not generating ModBreaks for this module for some reason, we
-- can't store breakpoint occurrence information.
Nothing -> pure code
- Just current_mod_breaks -> break_info hsc_env tick_mod current_mod mb_current_mod_breaks >>= \case
- Nothing -> pure code
- Just ModBreaks{modBreaks_module = tick_mod} -> do
- platform <- profilePlatform <$> getProfile
- let idOffSets = getVarOffSets platform d p fvs
- ty_vars = tyCoVarsOfTypesWellScoped (tick_ty:map idType fvs)
- toWord :: Maybe (Id, WordOff) -> Maybe (Id, Word)
- toWord = fmap (\(i, wo) -> (i, fromIntegral wo))
- breakInfo = dehydrateCgBreakInfo ty_vars (map toWord idOffSets) tick_ty
+ Just current_mod_breaks -> do
+ platform <- profilePlatform <$> getProfile
+ let idOffSets = getVarOffSets platform d p fvs
+ ty_vars = tyCoVarsOfTypesWellScoped (tick_ty:map idType fvs)
+ toWord :: Maybe (Id, WordOff) -> Maybe (Id, Word)
+ toWord = fmap (\(i, wo) -> (i, fromIntegral wo))
+ breakInfo = dehydrateCgBreakInfo ty_vars (map toWord idOffSets) tick_ty tick_id
- let info_mod = modBreaks_module current_mod_breaks
- infox <- newBreakInfo breakInfo
+ let info_mod = modBreaks_module current_mod_breaks
+ infox <- newBreakInfo breakInfo
- let breakInstr = BRK_FUN (InternalBreakpointId tick_mod tick_no info_mod infox)
- return $ breakInstr `consOL` code
+ let breakInstr = BRK_FUN (InternalBreakpointId info_mod infox)
+ return $ breakInstr `consOL` code
schemeER_wrk d p rhs = schemeE d 0 p rhs
--- | Determine the GHCi-allocated 'BreakArray' and module pointer for the module
--- from which the breakpoint originates.
--- These are stored in 'ModBreaks' as remote pointers in order to allow the BCOs
--- to refer to pointers in GHCi's address space.
--- They are initialized in 'GHC.HsToCore.Breakpoints.mkModBreaks', called by
--- 'GHC.HsToCore.deSugar'.
---
--- Breakpoints might be disabled because we're in TH, because
--- @-fno-break-points@ was specified, or because a module was reloaded without
--- reinitializing 'ModBreaks'.
---
--- If the module stored in the breakpoint is the currently processed module, use
--- the 'ModBreaks' from the state.
--- If that is 'Nothing', consider breakpoints to be disabled and skip the
--- instruction.
---
--- If the breakpoint is inlined from another module, look it up in the HUG (home unit graph).
--- If the module doesn't exist there, or if the 'ModBreaks' value is
--- uninitialized, skip the instruction (i.e. return Nothing).
-break_info ::
- HscEnv ->
- Module ->
- Module ->
- Maybe ModBreaks ->
- BcM (Maybe ModBreaks)
-break_info hsc_env mod current_mod current_mod_breaks
- | mod == current_mod
- = pure current_mod_breaks
- | otherwise
- = liftIO (HUG.lookupHugByModule mod (hsc_HUG hsc_env)) >>= \case
- Just hp -> pure $ imodBreaks_modBreaks <$> getModBreaks hp
- Nothing -> pure Nothing
-
getVarOffSets :: Platform -> StackDepth -> BCEnv -> [Id] -> [Maybe (Id, WordOff)]
getVarOffSets platform depth env = map getOffSet
where
=====================================
ghc/GHCi/UI.hs
=====================================
@@ -45,7 +45,7 @@ import GHC.Runtime.Eval (mkTopLevEnv)
import GHC.Runtime.Eval.Utils
-- The GHC interface
-import GHC.ByteCode.Breakpoints (imodBreaks_modBreaks)
+import GHC.ByteCode.Breakpoints (imodBreaks_modBreaks, InternalBreakpointId(..), getBreakSourceId)
import GHC.Runtime.Interpreter
import GHCi.RemoteTypes
import GHCi.BreakArray( breakOn, breakOff )
@@ -68,7 +68,7 @@ import GHC ( LoadHowMuch(..), Target(..), TargetId(..),
Resume, SingleStep, Ghc,
GetDocsFailure(..), pushLogHookM,
getModuleGraph, handleSourceError,
- InternalBreakpointId(..) )
+ BreakpointId(..) )
import GHC.Driver.Main (hscParseModuleWithLocation, hscParseStmtWithLocation)
import GHC.Hs.ImpExp
import GHC.Hs
@@ -546,6 +546,7 @@ interactiveUI config srcs maybe_exprs = do
break_ctr = 0,
breaks = IntMap.empty,
tickarrays = emptyModuleEnv,
+ internalBreaks = emptyModuleEnv,
ghci_commands = availableCommands config,
ghci_macros = [],
last_command = Nothing,
@@ -1616,13 +1617,15 @@ toBreakIdAndLocation :: GhciMonad m
toBreakIdAndLocation Nothing = return Nothing
toBreakIdAndLocation (Just inf) = do
st <- getGHCiState
+ hug <- hsc_HUG <$> GHC.getSession
+ brks <- liftIO $ readIModBreaks hug inf
+ let bi = getBreakSourceId inf brks
return $ listToMaybe [ id_loc | id_loc@(_,loc) <- IntMap.assocs (breaks st),
- breakModule loc == ibi_tick_mod inf,
- breakTick loc == ibi_tick_index inf ]
+ breakId loc == bi ]
printStoppedAtBreakInfo :: GHC.GhcMonad m => Resume -> [Name] -> m ()
printStoppedAtBreakInfo res names = do
- printForUser $ pprStopped res
+ printForUser =<< pprStopped res
-- printTypeOfNames session names
let namesSorted = sortBy compareNames names
tythings <- catMaybes `liftM` mapM GHC.lookupName namesSorted
@@ -3804,22 +3807,32 @@ showBkptTable = do
showContext :: GHC.GhcMonad m => m ()
showContext = do
resumes <- GHC.getResumeContext
- printForUser $ vcat (map pp_resume (reverse resumes))
+ docs <- mapM pp_resume (reverse resumes)
+ printForUser $ vcat docs
where
- pp_resume res =
- text "--> " <> text (GHC.resumeStmt res)
- $$ nest 2 (pprStopped res)
-
-pprStopped :: GHC.Resume -> SDoc
-pprStopped res =
- text "Stopped in"
- <+> ((case mb_mod_name of
- Nothing -> empty
- Just mod_name -> ftext (moduleNameFS mod_name) <> char '.')
- <> text (GHC.resumeDecl res))
- <> char ',' <+> ppr (GHC.resumeSpan res)
- where
- mb_mod_name = moduleName <$> ibi_tick_mod <$> GHC.resumeBreakpointId res
+ pp_resume res = do
+ stopped <- pprStopped res
+ return $
+ text "--> " <> text (GHC.resumeStmt res)
+ $$ nest 2 stopped
+
+pprStopped :: GHC.GhcMonad m => GHC.Resume -> m SDoc
+pprStopped res = do
+ let mibi = GHC.resumeBreakpointId res
+ mb_mod_name <- case mibi of
+ Nothing -> pure Nothing
+ Just ibi -> do
+ hug <- hsc_HUG <$> GHC.getSession
+ brks <- liftIO $ readIModBreaks hug ibi
+ return $ Just $ moduleName $
+ bi_tick_mod $ getBreakSourceId ibi brks
+ return $
+ text "Stopped in"
+ <+> ((case mb_mod_name of
+ Nothing -> empty
+ Just mod_name -> ftext (moduleNameFS mod_name) <> char '.')
+ <> text (GHC.resumeDecl res))
+ <> char ',' <+> ppr (GHC.resumeSpan res)
showUnits :: GHC.GhcMonad m => m ()
showUnits = mapNonInteractiveHomeUnitsM $ \dflags -> do
@@ -4373,12 +4386,8 @@ ignoreCmd argLine = withSandboxOnly ":ignore" $ do
result <- ignoreSwitch (words argLine)
case result of
Left sdoc -> printForUser sdoc
- Right (loc, count) -> do
- let bi = GHC.BreakpointId
- { bi_tick_mod = breakModule loc
- , bi_tick_index = breakTick loc
- }
- setupBreakpoint bi count
+ Right (loc, count) -> do
+ setupBreakpoint (breakId loc) count
ignoreSwitch :: GhciMonad m => [String] -> m (Either SDoc (BreakLocation, Int))
ignoreSwitch [break, count] = do
@@ -4395,10 +4404,13 @@ getIgnoreCount str =
where
sdocIgnore = text "Ignore count" <+> quotes (text str)
-setupBreakpoint :: GhciMonad m => GHC.BreakpointId -> Int -> m()
-setupBreakpoint loc count = do
+setupBreakpoint :: GhciMonad m => GHC.BreakpointId -> Int -> m ()
+setupBreakpoint bi count = do
hsc_env <- GHC.getSession
- GHC.setupBreakpoint (hscInterp hsc_env) loc count
+ -- Trigger all internal breaks that match this source break id
+ internal_break_ids <- getInternalBreaksOf bi
+ forM_ internal_break_ids $ \ibi -> do
+ GHC.setupBreakpoint (hscInterp hsc_env) ibi count
backCmd :: GhciMonad m => String -> m ()
backCmd arg
@@ -4489,20 +4501,20 @@ findBreakAndSet md lookupTickTree = do
some -> mapM_ breakAt some
where
breakAt (tick, pan) = do
- setBreakFlag md tick True
- (alreadySet, nm) <-
- recordBreak $ BreakLocation
- { breakModule = md
- , breakLoc = RealSrcSpan pan Strict.Nothing
- , breakTick = tick
- , onBreakCmd = ""
- , breakEnabled = True
- }
- printForUser $
- text "Breakpoint " <> ppr nm <>
- if alreadySet
- then text " was already set at " <> ppr pan
- else text " activated at " <> ppr pan
+ let bi = BreakpointId md tick
+ setBreakFlag bi True
+ (alreadySet, nm) <-
+ recordBreak $ BreakLocation
+ { breakLoc = RealSrcSpan pan Strict.Nothing
+ , breakId = bi
+ , onBreakCmd = ""
+ , breakEnabled = True
+ }
+ printForUser $
+ text "Breakpoint " <> ppr nm <>
+ if alreadySet
+ then text " was already set at " <> ppr pan
+ else text " activated at " <> ppr pan
-- For now, use ANSI bold on terminals that we know support it.
-- Otherwise, we add a line of carets under the active expression instead.
@@ -4749,14 +4761,32 @@ turnBreakOnOff :: GhciMonad m => Bool -> BreakLocation -> m BreakLocation
turnBreakOnOff onOff loc
| onOff == breakEnabled loc = return loc
| otherwise = do
- setBreakFlag (breakModule loc) (breakTick loc) onOff
+ setBreakFlag (breakId loc) onOff
return loc { breakEnabled = onOff }
-setBreakFlag :: GhciMonad m => Module -> Int -> Bool ->m ()
-setBreakFlag md ix enaDisa = do
+setBreakFlag :: GhciMonad m => GHC.BreakpointId -> Bool -> m ()
+setBreakFlag (BreakpointId md ix) enaDisa = do
let enaDisaToCount True = breakOn
enaDisaToCount False = breakOff
- setupBreakpoint (GHC.BreakpointId md ix) $ enaDisaToCount enaDisa
+ setupBreakpoint (BreakpointId md ix) $ enaDisaToCount enaDisa
+
+-- --------------------------------------------------------------------------
+-- Find matching Internal Breakpoints
+
+-- | Find all the internal breakpoints that use the given source-level breakpoint id
+getInternalBreaksOf :: GhciMonad m => BreakpointId -> m [InternalBreakpointId]
+getInternalBreaksOf bi = do
+ st <- getGHCiState
+ let ibrks = internalBreaks st
+ case lookupBreakpointOccurrences ibrks bi of
+ Just bs -> return bs
+ Nothing -> do
+ -- Refresh the internal breakpoints map
+ bs <- mkBreakpointOccurrences
+ setGHCiState st{internalBreaks = bs}
+ return $
+ fromMaybe [] {- still not found after refresh -} $
+ lookupBreakpointOccurrences bs bi
-- ---------------------------------------------------------------------------
-- User code exception handling
=====================================
ghc/GHCi/UI/Monad.hs
=====================================
@@ -100,6 +100,14 @@ data GHCiState = GHCiState
-- ^ 'tickarrays' caches the 'TickArray' for loaded modules,
-- so that we don't rebuild it each time the user sets
-- a breakpoint.
+
+ internalBreaks :: BreakpointOccurrences,
+ -- ^ Keep a mapping from the source-level 'BreakpointId' to the
+ -- occurrences of that breakpoint across modules.
+ -- When we want to stop at a source 'BreakpointId', we essentially
+ -- trigger a breakpoint for all 'InternalBreakpointId's matching
+ -- the same source-id.
+
ghci_commands :: [Command],
-- ^ available ghci commands
ghci_macros :: [Command],
@@ -238,16 +246,15 @@ data LocalConfigBehaviour
data BreakLocation
= BreakLocation
- { breakModule :: !GHC.Module
- , breakLoc :: !SrcSpan
- , breakTick :: {-# UNPACK #-} !Int
+ { breakLoc :: !SrcSpan
+ , breakId :: !GHC.BreakpointId
+ -- ^ The 'BreakpointId' uniquely identifies a source-level breakpoint
, breakEnabled:: !Bool
, onBreakCmd :: String
}
instance Eq BreakLocation where
- loc1 == loc2 = breakModule loc1 == breakModule loc2 &&
- breakTick loc1 == breakTick loc2
+ loc1 == loc2 = breakId loc1 == breakId loc2
prettyLocations :: IntMap.IntMap BreakLocation -> SDoc
prettyLocations locs =
@@ -256,7 +263,7 @@ prettyLocations locs =
False -> vcat $ map (\(i, loc) -> brackets (int i) <+> ppr loc) $ IntMap.toAscList locs
instance Outputable BreakLocation where
- ppr loc = (ppr $ breakModule loc) <+> ppr (breakLoc loc) <+> pprEnaDisa <+>
+ ppr loc = (ppr $ GHC.bi_tick_mod $ breakId loc) <+> ppr (breakLoc loc) <+> pprEnaDisa <+>
if null (onBreakCmd loc)
then empty
else doubleQuotes (text (onBreakCmd loc))
=====================================
libraries/ghci/GHCi/Debugger.hs
=====================================
@@ -65,10 +65,7 @@ foreign import ccall "&rts_stop_on_exception" exceptionFlag :: Ptr CInt
--------------------------------------------------------------------------------
type BreakpointCallback
- = Addr# -- pointer to the breakpoint tick module name
- -> Addr# -- pointer to the breakpoint tick module unit id
- -> Int# -- breakpoint tick index
- -> Addr# -- pointer to the breakpoint info module name
+ = Addr# -- pointer to the breakpoint info module name
-> Addr# -- pointer to the breakpoint info module unit id
-> Int# -- breakpoint info index
-> Bool -- exception?
=====================================
libraries/ghci/GHCi/Message.hs
=====================================
@@ -418,10 +418,7 @@ data EvalStatus_ a b
instance Binary a => Binary (EvalStatus_ a b)
data EvalBreakpoint = EvalBreakpoint
- { eb_tick_mod :: String -- ^ Breakpoint tick module
- , eb_tick_mod_unit :: BS.ShortByteString -- ^ Breakpoint tick module unit id
- , eb_tick_index :: Int -- ^ Breakpoint tick index
- , eb_info_mod :: String -- ^ Breakpoint info module
+ { eb_info_mod :: String -- ^ Breakpoint info module
, eb_info_mod_unit :: BS.ShortByteString -- ^ Breakpoint tick module unit id
, eb_info_index :: Int -- ^ Breakpoint info index
}
=====================================
libraries/ghci/GHCi/Run.hs
=====================================
@@ -345,7 +345,7 @@ withBreakAction opts breakMVar statusMVar mtid act
-- as soon as it is hit, or in resetBreakAction below.
onBreak :: BreakpointCallback
- onBreak tick_mod# tick_mod_uid# tickx# info_mod# info_mod_uid# infox# is_exception apStack = do
+ onBreak info_mod# info_mod_uid# infox# is_exception apStack = do
tid <- myThreadId
let resume = ResumeContext
{ resumeBreakMVar = breakMVar
@@ -358,11 +358,9 @@ withBreakAction opts breakMVar statusMVar mtid act
if is_exception
then pure Nothing
else do
- tick_mod <- peekCString (Ptr tick_mod#)
- tick_mod_uid <- BS.packCString (Ptr tick_mod_uid#)
info_mod <- peekCString (Ptr info_mod#)
info_mod_uid <- BS.packCString (Ptr info_mod_uid#)
- pure (Just (EvalBreakpoint tick_mod tick_mod_uid (I# tickx#) info_mod info_mod_uid (I# infox#)))
+ pure (Just (EvalBreakpoint info_mod info_mod_uid (I# infox#)))
putMVar statusMVar $ EvalBreak apStack_r breakpoint resume_r ccs
takeMVar breakMVar
@@ -409,8 +407,8 @@ noBreakStablePtr :: StablePtr BreakpointCallback
noBreakStablePtr = unsafePerformIO $ newStablePtr noBreakAction
noBreakAction :: BreakpointCallback
-noBreakAction _ _ _ _ _ _ False _ = putStrLn "*** Ignoring breakpoint"
-noBreakAction _ _ _ _ _ _ True _ = return () -- exception: just continue
+noBreakAction _ _ _ False _ = putStrLn "*** Ignoring breakpoint"
+noBreakAction _ _ _ True _ = return () -- exception: just continue
-- Malloc and copy the bytes. We don't have any way to monitor the
-- lifetime of this memory, so it just leaks.
=====================================
rts/Disassembler.c
=====================================
@@ -84,16 +84,23 @@ disInstr ( StgBCO *bco, int pc )
switch (instr & 0xff) {
- case bci_BRK_FUN:
- debugBelch ("BRK_FUN " ); printPtr( ptrs[instrs[pc]] );
- debugBelch (" %d ", instrs[pc+1]); printPtr( ptrs[instrs[pc+2]] );
- CostCentre* cc = (CostCentre*)literals[instrs[pc+5]];
+ case bci_BRK_FUN: {
+ W_ p1, info_mod, info_unit_id, info_wix, np;
+ p1 = BCO_GET_LARGE_ARG;
+ info_mod = BCO_GET_LARGE_ARG;
+ info_unit_id = BCO_GET_LARGE_ARG;
+ info_wix = BCO_NEXT;
+ np = BCO_GET_LARGE_ARG;
+ debugBelch ("BRK_FUN " ); printPtr( ptrs[p1] );
+ debugBelch("%" FMT_Word, literals[info_mod] );
+ debugBelch("%" FMT_Word, literals[info_unit_id] );
+ debugBelch("%" FMT_Word, info_wix );
+ CostCentre* cc = (CostCentre*)literals[np];
if (cc) {
debugBelch(" %s", cc->label);
}
debugBelch("\n");
- pc += 6;
- break;
+ break; }
case bci_BRK_ALTS:
debugBelch ("BRK_ALTS %d\n", BCO_NEXT);
break;
=====================================
rts/Exception.cmm
=====================================
@@ -535,23 +535,17 @@ retry_pop_stack:
// be per-thread.
CInt[rts_stop_on_exception] = 0;
("ptr" ioAction) = ccall deRefStablePtr (W_[rts_breakpoint_io_action] "ptr");
- Sp = Sp - WDS(17);
- Sp(16) = exception;
- Sp(15) = stg_raise_ret_info;
- Sp(14) = exception;
- Sp(13) = ghczminternal_GHCziInternalziTypes_True_closure; // True <=> an exception
- Sp(12) = stg_ap_ppv_info;
- Sp(11) = 0;
- Sp(10) = stg_ap_n_info;
- Sp(9) = 0;
- Sp(8) = stg_ap_n_info;
- Sp(7) = 0;
- Sp(6) = stg_ap_n_info;
- Sp(5) = 0;
- Sp(4) = stg_ap_n_info;
- Sp(3) = 0;
- Sp(2) = stg_ap_n_info;
- Sp(1) = 0;
+ Sp = Sp - WDS(11);
+ Sp(10) = exception;
+ Sp(9) = stg_raise_ret_info;
+ Sp(8) = exception;
+ Sp(7) = ghczminternal_GHCziInternalziTypes_True_closure; // True <=> an exception
+ Sp(6) = stg_ap_ppv_info;
+ Sp(5) = 0;
+ Sp(4) = stg_ap_n_info;
+ Sp(3) = 0;
+ Sp(2) = stg_ap_n_info;
+ Sp(1) = 0;
R1 = ioAction;
jump RET_LBL(stg_ap_n) [R1];
}
=====================================
rts/Interpreter.c
=====================================
@@ -685,8 +685,6 @@ interpretBCO (Capability* cap)
*/
if (cap->r.rCurrentTSO->flags & TSO_STOP_AFTER_RETURN) {
- StgBCO* bco;
- StgWord16* bco_instrs;
StgHalfWord type;
/* Store the entry Sp; traverse the stack modifying Sp (using Sp macros);
@@ -706,28 +704,33 @@ interpretBCO (Capability* cap)
ASSERT(type == RET_BCO || type == STOP_FRAME);
if (type == RET_BCO) {
- bco = (StgBCO*)(SpW(1)); // BCO is first arg of a RET_BCO
+ StgBCO* bco = (StgBCO*)(SpW(1)); // BCO is first arg of a RET_BCO
ASSERT(get_itbl((StgClosure*)bco)->type == BCO);
- bco_instrs = (StgWord16*)(bco->instrs->payload);
+
+ StgWord16* instrs = (StgWord16*)(bco->instrs->payload);
+ StgWord16 bci = instrs[0];
/* A breakpoint instruction (BRK_FUN or BRK_ALTS) is always the first
* instruction in a BCO */
- if ((bco_instrs[0] & 0xFF) == bci_BRK_FUN) {
- int brk_array, tick_index;
- StgArrBytes *breakPoints;
- StgPtr* ptrs;
+ if ((bci & 0xFF) == bci_BRK_FUN) {
+ // Define rest of variables used by BCO_* Macros
+ int bciPtr = 0;
+
+ W_ arg1_brk_array, arg4_info_index;
+ arg1_brk_array = BCO_GET_LARGE_ARG;
+ /* info_mod_name = */ BCO_GET_LARGE_ARG;
+ /* info_mod_id = */ BCO_GET_LARGE_ARG;
+ arg4_info_index = BCO_NEXT;
- ptrs = (StgPtr*)(&bco->ptrs->payload[0]);
- brk_array = bco_instrs[1];
- tick_index = bco_instrs[6];
+ StgPtr* ptrs = (StgPtr*)(&bco->ptrs->payload[0]);
+ StgArrBytes* breakPoints = (StgArrBytes *) BCO_PTR(arg1_brk_array);
- breakPoints = (StgArrBytes *) BCO_PTR(brk_array);
// ACTIVATE the breakpoint by tick index
- ((StgInt*)breakPoints->payload)[tick_index] = 0;
+ ((StgInt*)breakPoints->payload)[arg4_info_index] = 0;
}
- else if ((bco_instrs[0] & 0xFF) == bci_BRK_ALTS) {
+ else if ((bci & 0xFF) == bci_BRK_ALTS) {
// ACTIVATE BRK_ALTS by setting its only argument to ON
- bco_instrs[1] = 1;
+ instrs[1] = 1;
}
// else: if there is no BRK instruction perhaps we should keep
// traversing; that said, the continuation should always have a BRK
@@ -1520,9 +1523,9 @@ run_BCO:
/* check for a breakpoint on the beginning of a let binding */
case bci_BRK_FUN:
{
- int arg1_brk_array, arg2_tick_mod, arg3_info_mod, arg4_tick_mod_id, arg5_info_mod_id, arg6_tick_index, arg7_info_index;
+ W_ arg1_brk_array, arg2_info_mod_name, arg3_info_mod_id, arg4_info_index;
#if defined(PROFILING)
- int arg8_cc;
+ W_ arg5_cc;
#endif
StgArrBytes *breakPoints;
int returning_from_break, stop_next_breakpoint;
@@ -1537,14 +1540,11 @@ run_BCO:
int size_words;
arg1_brk_array = BCO_GET_LARGE_ARG;
- arg2_tick_mod = BCO_GET_LARGE_ARG;
- arg3_info_mod = BCO_GET_LARGE_ARG;
- arg4_tick_mod_id = BCO_GET_LARGE_ARG;
- arg5_info_mod_id = BCO_GET_LARGE_ARG;
- arg6_tick_index = BCO_NEXT;
- arg7_info_index = BCO_NEXT;
+ arg2_info_mod_name = BCO_GET_LARGE_ARG;
+ arg3_info_mod_id = BCO_GET_LARGE_ARG;
+ arg4_info_index = BCO_NEXT;
#if defined(PROFILING)
- arg8_cc = BCO_GET_LARGE_ARG;
+ arg5_cc = BCO_GET_LARGE_ARG;
#else
BCO_GET_LARGE_ARG;
#endif
@@ -1564,7 +1564,7 @@ run_BCO:
#if defined(PROFILING)
cap->r.rCCCS = pushCostCentre(cap->r.rCCCS,
- (CostCentre*)BCO_LIT(arg8_cc));
+ (CostCentre*)BCO_LIT(arg5_cc));
#endif
// if we are returning from a break then skip this section
@@ -1575,11 +1575,11 @@ run_BCO:
// stop the current thread if either `stop_next_breakpoint` is
// true OR if the ignore count for this particular breakpoint is zero
- StgInt ignore_count = ((StgInt*)breakPoints->payload)[arg6_tick_index];
+ StgInt ignore_count = ((StgInt*)breakPoints->payload)[arg4_info_index];
if (stop_next_breakpoint == false && ignore_count > 0)
{
// decrement and write back ignore count
- ((StgInt*)breakPoints->payload)[arg6_tick_index] = --ignore_count;
+ ((StgInt*)breakPoints->payload)[arg4_info_index] = --ignore_count;
}
else if (stop_next_breakpoint == true || ignore_count == 0)
{
@@ -1613,10 +1613,7 @@ run_BCO:
// Arrange the stack to call the breakpoint IO action, and
// continue execution of this BCO when the IO action returns.
//
- // ioAction :: Addr# -- the breakpoint tick module
- // -> Addr# -- the breakpoint tick module unit id
- // -> Int# -- the breakpoint tick index
- // -> Addr# -- the breakpoint info module
+ // ioAction :: Addr# -- the breakpoint info module
// -> Addr# -- the breakpoint info module unit id
// -> Int# -- the breakpoint info index
// -> Bool -- exception?
@@ -1626,23 +1623,17 @@ run_BCO:
ioAction = (StgClosure *) deRefStablePtr (
rts_breakpoint_io_action);
- Sp_subW(19);
- SpW(18) = (W_)obj;
- SpW(17) = (W_)&stg_apply_interp_info;
- SpW(16) = (W_)new_aps;
- SpW(15) = (W_)False_closure; // True <=> an exception
- SpW(14) = (W_)&stg_ap_ppv_info;
- SpW(13) = (W_)arg7_info_index;
- SpW(12) = (W_)&stg_ap_n_info;
- SpW(11) = (W_)BCO_LIT(arg5_info_mod_id);
- SpW(10) = (W_)&stg_ap_n_info;
- SpW(9) = (W_)BCO_LIT(arg3_info_mod);
- SpW(8) = (W_)&stg_ap_n_info;
- SpW(7) = (W_)arg6_tick_index;
+ Sp_subW(13);
+ SpW(12) = (W_)obj;
+ SpW(11) = (W_)&stg_apply_interp_info;
+ SpW(10) = (W_)new_aps;
+ SpW(9) = (W_)False_closure; // True <=> an exception
+ SpW(8) = (W_)&stg_ap_ppv_info;
+ SpW(7) = (W_)arg4_info_index;
SpW(6) = (W_)&stg_ap_n_info;
- SpW(5) = (W_)BCO_LIT(arg4_tick_mod_id);
+ SpW(5) = (W_)BCO_LIT(arg3_info_mod_id);
SpW(4) = (W_)&stg_ap_n_info;
- SpW(3) = (W_)BCO_LIT(arg2_tick_mod);
+ SpW(3) = (W_)BCO_LIT(arg2_info_mod_name);
SpW(2) = (W_)&stg_ap_n_info;
SpW(1) = (W_)ioAction;
SpW(0) = (W_)&stg_enter_info;
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/083e40f1ea7fa13faac282456c357a8…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/083e40f1ea7fa13faac282456c357a8…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc] Pushed new branch wip/fendor/dont-expose-backtraces-fields
by Hannes Siebenhandl (＠fendor) 01 Aug '25
by Hannes Siebenhandl (＠fendor) 01 Aug '25
01 Aug '25
Hannes Siebenhandl pushed new branch wip/fendor/dont-expose-backtraces-fields at Glasgow Haskell Compiler / GHC
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/fendor/dont-expose-backtraces…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 3 commits: debugger: Uniquely identify breakpoints by internal id
by Marge Bot (＠marge-bot) 31 Jul '25
by Marge Bot (＠marge-bot) 31 Jul '25
31 Jul '25
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
99061362 by Rodrigo Mesquita at 2025-07-31T20:27:54-04:00
debugger: Uniquely identify breakpoints by internal id
Since b85b11994e0130ff2401dd4bbdf52330e0bcf776 (support inlining
breakpoints), a breakpoint has been identified at runtime by *two* pairs
of <module,index>.
- The first, aka a 'BreakpointId', uniquely identifies a breakpoint in
the source of a module by using the Tick index. A Tick index can index
into ModBreaks.modBreaks_xxx to fetch source-level information about
where that tick originated.
- When a user specifies e.g. a line breakpoint using :break, we'll reverse
engineer what a Tick index for that line
- We update the `BreakArray` of that module (got from the
LoaderState) at that tick index to `breakOn`.
- A BCO we can stop at is headed by a BRK_FUN instruction. This
instruction stores in an operand the `tick index` it is associated
to. We look it up in the associated `BreakArray` (also an operand)
and check wheter it was set to `breakOn`.
- The second, aka the `ibi_info_mod` + `ibi_info_ix` of the
`InternalBreakpointId`, uniquely index into the `imodBreaks_breakInfo`
-- the information we gathered during code generation about the
existing breakpoint *ocurrences*.
- Note that with optimisation there may be many occurrences of the
same source-tick-breakpoint across different modules. The
`ibi_info_ix` is unique per occurrence, but the `bi_tick_ix` may be
shared. See Note [Breakpoint identifiers] about this.
- Note that besides the tick ids, info ids are also stored in
`BRK_FUN` so the break handler can refer to the associated
`CgBreakInfo`.
In light of that, the driving changes come from the desire to have the
info_id uniquely identify the breakpoint at runtime, and the source tick
id being derived from it:
- An InternalBreakpointId should uniquely identify a breakpoint just
from the code-generation identifiers of `ibi_info_ix` and `ibi_info_mod`.
So we drop `ibi_tick_mod` and `ibi_tick_ix`.
- A BRK_FUN instruction need only record the "internal breakpoint id",
not the tick-level id.
So we drop the tick mod and tick index operands.
- A BreakArray should be indexed by InternalBreakpointId rather than
BreakpointId
That means we need to do some more work when setting a breakpoint.
Specifically, we need to figure out the internal ids (occurrences of a
breakpoint) from the source-level BreakpointId we want to set the
breakpoint at (recall :break refers to breaks at the source level).
Besides this change being an improvement to the handling of breakpoints
(it's clearer to have a single unique identifier than two competing
ones), it unlocks the possibility of generating "internal" breakpoints
during Cg (needed for #26042).
It should also be easier to introduce multi-threaded-aware `BreakArrays`
following this change (needed for #26064).
Se also the new Note [ModBreaks vs InternalModBreaks]
On i386-linux:
-------------------------
Metric Decrease:
interpreter_steplocal
-------------------------
- - - - -
e4786d76 by Simon Hengel at 2025-07-31T20:27:55-04:00
Don't use MCDiagnostic for `ghcExit`
This changes the error message of `ghcExit` from
```
<no location info>: error:
Compilation had errors
```
to
```
Compilation had errors
```
- - - - -
f6714142 by Simon Hengel at 2025-07-31T20:27:55-04:00
Respect `-fdiagnostics-as-json` for driver diagnostics (see #24113)
- - - - -
24 changed files:
- compiler/GHC/ByteCode/Asm.hs
- compiler/GHC/ByteCode/Breakpoints.hs
- compiler/GHC/ByteCode/Instr.hs
- compiler/GHC/ByteCode/Linker.hs
- compiler/GHC/ByteCode/Types.hs
- compiler/GHC/CoreToIface.hs
- compiler/GHC/Driver/Make.hs
- compiler/GHC/HsToCore/Breakpoints.hs
- compiler/GHC/Linker/Loader.hs
- compiler/GHC/Runtime/Debugger/Breakpoints.hs
- compiler/GHC/Runtime/Eval.hs
- compiler/GHC/Runtime/Interpreter.hs
- compiler/GHC/StgToByteCode.hs
- compiler/GHC/SysTools/Tasks.hs
- compiler/GHC/Utils/Error.hs
- ghc/GHCi/UI.hs
- ghc/GHCi/UI/Monad.hs
- libraries/ghci/GHCi/Debugger.hs
- libraries/ghci/GHCi/Message.hs
- libraries/ghci/GHCi/Run.hs
- rts/Disassembler.c
- rts/Exception.cmm
- rts/Interpreter.c
- testsuite/tests/corelint/T21115b.stderr
Changes:
=====================================
compiler/GHC/ByteCode/Asm.hs
=====================================
@@ -841,24 +841,18 @@ assembleI platform i = case i of
W8 -> emit_ bci_OP_INDEX_ADDR_08 []
_ -> unsupported_width
- BRK_FUN (InternalBreakpointId tick_mod tickx info_mod infox) -> do
+ BRK_FUN ibi@(InternalBreakpointId info_mod infox) -> do
+ p1 <- ptr $ BCOPtrBreakArray info_mod
let -- cast that checks that round-tripping through Word16 doesn't change the value
toW16 x = let r = fromIntegral x :: Word16
in if fromIntegral r == x
then r
else pprPanic "schemeER_wrk: breakpoint tick/info index too large!" (ppr x)
- p1 <- ptr $ BCOPtrBreakArray tick_mod
- tick_addr <- lit1 $ BCONPtrFS $ moduleNameFS $ moduleName tick_mod
- info_addr <- lit1 $ BCONPtrFS $ moduleNameFS $ moduleName info_mod
- tick_unitid_addr <- lit1 $ BCONPtrFS $ unitIdFS $ moduleUnitId $ tick_mod
- info_unitid_addr <- lit1 $ BCONPtrFS $ unitIdFS $ moduleUnitId $ info_mod
- np <- lit1 $ BCONPtrCostCentre (BreakpointId tick_mod tickx)
- emit_ bci_BRK_FUN [ Op p1
- , Op tick_addr, Op info_addr
- , Op tick_unitid_addr, Op info_unitid_addr
- , SmallOp (toW16 tickx), SmallOp (toW16 infox)
- , Op np
- ]
+ info_addr <- lit1 $ BCONPtrFS $ moduleNameFS $ moduleName info_mod
+ info_unitid_addr <- lit1 $ BCONPtrFS $ unitIdFS $ moduleUnitId info_mod
+ np <- lit1 $ BCONPtrCostCentre ibi
+ emit_ bci_BRK_FUN [ Op p1, Op info_addr, Op info_unitid_addr
+ , SmallOp (toW16 infox), Op np ]
BRK_ALTS active -> emit_ bci_BRK_ALTS [SmallOp (if active then 1 else 0)]
=====================================
compiler/GHC/ByteCode/Breakpoints.hs
=====================================
@@ -7,23 +7,23 @@
-- 'InternalModBreaks', and is uniquely identified at runtime by an
-- 'InternalBreakpointId'.
--
--- See Note [Breakpoint identifiers]
+-- See Note [ModBreaks vs InternalModBreaks] and Note [Breakpoint identifiers]
module GHC.ByteCode.Breakpoints
( -- * Internal Mod Breaks
InternalModBreaks(..), CgBreakInfo(..)
- , mkInternalModBreaks
+ , mkInternalModBreaks, imodBreaks_module
-- ** Internal breakpoint identifier
, InternalBreakpointId(..), BreakInfoIndex
-- * Operations
- , toBreakpointId
-- ** Internal-level operations
- , getInternalBreak, addInternalBreak
+ , getInternalBreak
-- ** Source-level information operations
, getBreakLoc, getBreakVars, getBreakDecls, getBreakCCS
+ , getBreakSourceId
-- * Utils
, seqInternalModBreaks
@@ -47,6 +47,31 @@ import GHC.Utils.Panic
import Data.Array
{-
+Note [ModBreaks vs InternalModBreaks]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+'ModBreaks' and 'BreakpointId's must not to be confused with
+'InternalModBreaks' and 'InternalBreakId's.
+
+'ModBreaks' is constructed once during HsToCore from the information attached
+to source-level breakpoint ticks and is never changed afterwards. A 'ModBreaks'
+can be queried using 'BreakpointId's, which uniquely identifies a breakpoint
+within the list of breakpoint information for a given module's 'ModBreaks'.
+
+'InternalModBreaks' are constructed during bytecode generation and are indexed
+by a 'InternalBreakpointId'. They contain all the information relevant to a
+breakpoint for code generation that can be accessed during runtime execution
+(such as a 'BreakArray' for triggering breakpoints). 'InternalBreakpointId's
+are used at runtime to trigger and inspect breakpoints -- a 'BRK_FUN'
+instruction receives 'InternalBreakpointId' as an argument.
+
+We keep a mapping from 'InternalModBreaks' to a 'BreakpointId', which can then be used
+to get source-level information about a breakpoint via the corresponding 'ModBreaks'.
+
+Notably, 'InternalModBreaks' can contain entries for so-called internal
+breakpoints, which do not necessarily have a source-level location attached to
+it (i.e. do not have a matching entry in 'ModBreaks'). We may leverage this to
+introduce breakpoints during code generation for features such as stepping-out.
+
Note [Breakpoint identifiers]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Before optimization a breakpoint is identified uniquely with a tick module
@@ -64,6 +89,10 @@ So every breakpoint occurrence gets assigned a module-unique *info index* and
we store it alongside the occurrence module (*info module*) in the
'InternalBreakpointId' datatype. This is the index that we use at runtime to
identify a breakpoint.
+
+When the internal breakpoint has a matching tick-level breakpoint we can fetch
+the related tick-level information by first looking up a mapping
+@'InternalBreakpointId' -> 'BreakpointId'@ in @'CgBreakInfo'@.
-}
--------------------------------------------------------------------------------
@@ -78,19 +107,11 @@ type BreakInfoIndex = Int
-- Indexes into the structures in the @'InternalModBreaks'@ produced during ByteCode generation.
-- See Note [Breakpoint identifiers]
data InternalBreakpointId = InternalBreakpointId
- { ibi_tick_mod :: !Module -- ^ Breakpoint tick module
- , ibi_tick_index :: !Int -- ^ Breakpoint tick index
- , ibi_info_mod :: !Module -- ^ Breakpoint tick module
- , ibi_info_index :: !BreakInfoIndex -- ^ Breakpoint tick index
+ { ibi_info_mod :: !Module -- ^ Breakpoint info module
+ , ibi_info_index :: !BreakInfoIndex -- ^ Breakpoint info index
}
deriving (Eq, Ord)
-toBreakpointId :: InternalBreakpointId -> BreakpointId
-toBreakpointId ibi = BreakpointId
- { bi_tick_mod = ibi_tick_mod ibi
- , bi_tick_index = ibi_tick_index ibi
- }
-
--------------------------------------------------------------------------------
-- * Internal Mod Breaks
--------------------------------------------------------------------------------
@@ -107,18 +128,34 @@ data InternalModBreaks = InternalModBreaks
-- 'InternalBreakpointId'.
, imodBreaks_modBreaks :: !ModBreaks
- -- ^ Store the original ModBreaks for this module, unchanged.
- -- Allows us to query about source-level breakpoint information using
- -- an internal breakpoint id.
+ -- ^ Store the ModBreaks for this module
+ --
+ -- Recall Note [Breakpoint identifiers]: for some module A, an
+ -- *occurrence* of a breakpoint in A may have been inlined from some
+ -- breakpoint *defined* in module B.
+ --
+ -- This 'ModBreaks' contains information regarding all the breakpoints
+ -- defined in the module this 'InternalModBreaks' corresponds to. It
+ -- /does not/ necessarily have information regarding all the breakpoint
+ -- occurrences registered in 'imodBreaks_breakInfo'. Some of those
+ -- occurrences may refer breakpoints inlined from other modules.
}
--- | Construct an 'InternalModBreaks'
+-- | Construct an 'InternalModBreaks'.
+--
+-- INVARIANT: The given 'ModBreaks' correspond to the same module as this
+-- 'InternalModBreaks' module (the first argument) and its breakpoint infos
+-- (the @IntMap CgBreakInfo@ argument)
mkInternalModBreaks :: Module -> IntMap CgBreakInfo -> ModBreaks -> InternalModBreaks
mkInternalModBreaks mod im mbs =
assertPpr (mod == modBreaks_module mbs)
(text "Constructing InternalModBreaks with the ModBreaks of a different module!") $
InternalModBreaks im mbs
+-- | Get the module to which these 'InternalModBreaks' correspond
+imodBreaks_module :: InternalModBreaks -> Module
+imodBreaks_module = modBreaks_module . imodBreaks_modBreaks
+
-- | Information about a breakpoint that we know at code-generation time
-- In order to be used, this needs to be hydrated relative to the current HscEnv by
-- 'hydrateCgBreakInfo'. Everything here can be fully forced and that's critical for
@@ -128,20 +165,22 @@ data CgBreakInfo
{ cgb_tyvars :: ![IfaceTvBndr] -- ^ Type variables in scope at the breakpoint
, cgb_vars :: ![Maybe (IfaceIdBndr, Word)]
, cgb_resty :: !IfaceType
+ , cgb_tick_id :: !BreakpointId
+ -- ^ This field records the original breakpoint tick identifier for this
+ -- internal breakpoint info. It is used to convert a breakpoint
+ -- *occurrence* index ('InternalBreakpointId') into a *definition* index
+ -- ('BreakpointId').
+ --
+ -- The modules of breakpoint occurrence and breakpoint definition are not
+ -- necessarily the same: See Note [Breakpoint identifiers].
}
-- See Note [Syncing breakpoint info] in GHC.Runtime.Eval
-- | Get an internal breakpoint info by 'InternalBreakpointId'
getInternalBreak :: InternalBreakpointId -> InternalModBreaks -> CgBreakInfo
-getInternalBreak (InternalBreakpointId _ _ info_mod info_ix) imbs =
- assert_modules_match info_mod (modBreaks_module $ imodBreaks_modBreaks imbs) $
- imodBreaks_breakInfo imbs IM.! info_ix
-
--- | Add a CgBreakInfo to an 'InternalModBreaks' at 'InternalBreakpointId'
-addInternalBreak :: InternalBreakpointId -> CgBreakInfo -> InternalModBreaks -> InternalModBreaks
-addInternalBreak (InternalBreakpointId _ _ info_mod info_ix) info imbs =
- assert_modules_match info_mod (modBreaks_module $ imodBreaks_modBreaks imbs) $
- imbs{imodBreaks_breakInfo = IM.insert info_ix info (imodBreaks_breakInfo imbs)}
+getInternalBreak (InternalBreakpointId mod ix) imbs =
+ assert_modules_match mod (imodBreaks_module imbs) $
+ imodBreaks_breakInfo imbs IM.! ix
-- | Assert that the module in the 'InternalBreakpointId' and in
-- 'InternalModBreaks' match.
@@ -155,27 +194,56 @@ assert_modules_match ibi_mod imbs_mod =
-- Tick-level Breakpoint information
--------------------------------------------------------------------------------
+-- | Get the source module and tick index for this breakpoint
+-- (as opposed to the module where this breakpoint occurs, which is in 'InternalBreakpointId')
+getBreakSourceId :: InternalBreakpointId -> InternalModBreaks -> BreakpointId
+getBreakSourceId (InternalBreakpointId ibi_mod ibi_ix) imbs =
+ assert_modules_match ibi_mod (imodBreaks_module imbs) $
+ let cgb = imodBreaks_breakInfo imbs IM.! ibi_ix
+ in cgb_tick_id cgb
+
-- | Get the source span for this breakpoint
-getBreakLoc :: InternalBreakpointId -> InternalModBreaks -> SrcSpan
+getBreakLoc :: (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO SrcSpan
getBreakLoc = getBreakXXX modBreaks_locs
-- | Get the vars for this breakpoint
-getBreakVars :: InternalBreakpointId -> InternalModBreaks -> [OccName]
+getBreakVars :: (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO [OccName]
getBreakVars = getBreakXXX modBreaks_vars
-- | Get the decls for this breakpoint
-getBreakDecls :: InternalBreakpointId -> InternalModBreaks -> [String]
+getBreakDecls :: (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO [String]
getBreakDecls = getBreakXXX modBreaks_decls
-- | Get the decls for this breakpoint
-getBreakCCS :: InternalBreakpointId -> InternalModBreaks -> (String, String)
+getBreakCCS :: (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO (String, String)
getBreakCCS = getBreakXXX modBreaks_ccs
-- | Internal utility to access a ModBreaks field at a particular breakpoint index
-getBreakXXX :: (ModBreaks -> Array BreakTickIndex a) -> InternalBreakpointId -> InternalModBreaks -> a
-getBreakXXX view (InternalBreakpointId tick_mod tick_id _ _) imbs =
- assert_modules_match tick_mod (modBreaks_module $ imodBreaks_modBreaks imbs) $ do
- view (imodBreaks_modBreaks imbs) ! tick_id
+--
+-- Recall Note [Breakpoint identifiers]: the internal breakpoint module (the
+-- *occurrence* module) doesn't necessarily match the module where the
+-- tick breakpoint was defined with the relevant 'ModBreaks'.
+--
+-- When the tick module is the same as the internal module, we use the stored
+-- 'ModBreaks'. When the tick module is different, we need to look up the
+-- 'ModBreaks' in the HUG for that other module.
+--
+-- To avoid cyclic dependencies, we instead receive a function that looks up
+-- the 'ModBreaks' given a 'Module'
+getBreakXXX :: (ModBreaks -> Array BreakTickIndex a) -> (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO a
+getBreakXXX view lookupModule (InternalBreakpointId ibi_mod ibi_ix) imbs =
+ assert_modules_match ibi_mod (imodBreaks_module imbs) $ do
+ let cgb = imodBreaks_breakInfo imbs IM.! ibi_ix
+ case cgb_tick_id cgb of
+ BreakpointId{bi_tick_mod, bi_tick_index}
+ | bi_tick_mod == ibi_mod
+ -> do
+ let these_mbs = imodBreaks_modBreaks imbs
+ return $ view these_mbs ! bi_tick_index
+ | otherwise
+ -> do
+ other_mbs <- lookupModule bi_tick_mod
+ return $ view other_mbs ! bi_tick_index
--------------------------------------------------------------------------------
-- Instances
@@ -190,7 +258,8 @@ seqInternalModBreaks InternalModBreaks{..} =
seqCgBreakInfo CgBreakInfo{..} =
rnf cgb_tyvars `seq`
rnf cgb_vars `seq`
- rnf cgb_resty
+ rnf cgb_resty `seq`
+ rnf cgb_tick_id
instance Outputable InternalBreakpointId where
ppr InternalBreakpointId{..} =
@@ -203,4 +272,5 @@ instance NFData InternalBreakpointId where
instance Outputable CgBreakInfo where
ppr info = text "CgBreakInfo" <+>
parens (ppr (cgb_vars info) <+>
- ppr (cgb_resty info))
+ ppr (cgb_resty info) <+>
+ ppr (cgb_tick_id info))
=====================================
compiler/GHC/ByteCode/Instr.hs
=====================================
@@ -454,9 +454,8 @@ instance Outputable BCInstr where
ppr ENTER = text "ENTER"
ppr (RETURN pk) = text "RETURN " <+> ppr pk
ppr (RETURN_TUPLE) = text "RETURN_TUPLE"
- ppr (BRK_FUN (InternalBreakpointId tick_mod tickx info_mod infox))
+ ppr (BRK_FUN (InternalBreakpointId info_mod infox))
= text "BRK_FUN" <+> text "<breakarray>"
- <+> ppr tick_mod <+> ppr tickx
<+> ppr info_mod <+> ppr infox
<+> text "<cc>"
ppr (BRK_ALTS active) = text "BRK_ALTS" <+> ppr active
=====================================
compiler/GHC/ByteCode/Linker.hs
=====================================
@@ -98,9 +98,9 @@ lookupLiteral interp pkgs_loaded le lb ptr = case ptr of
BCONPtrFFIInfo (FFIInfo {..}) -> do
RemotePtr p <- interpCmd interp $ PrepFFI ffiInfoArgs ffiInfoRet
pure $ fromIntegral p
- BCONPtrCostCentre BreakpointId{..}
+ BCONPtrCostCentre InternalBreakpointId{..}
| interpreterProfiled interp -> do
- case expectJust (lookupModuleEnv (ccs_env lb) bi_tick_mod) ! bi_tick_index of
+ case expectJust (lookupModuleEnv (ccs_env lb) ibi_info_mod) ! ibi_info_index of
RemotePtr p -> pure $ fromIntegral p
| otherwise ->
case toRemotePtr nullPtr of
=====================================
compiler/GHC/ByteCode/Types.hs
=====================================
@@ -285,7 +285,7 @@ data BCONPtr
-- | A libffi ffi_cif function prototype.
| BCONPtrFFIInfo !FFIInfo
-- | A 'CostCentre' remote pointer array's respective 'BreakpointId'
- | BCONPtrCostCentre !BreakpointId
+ | BCONPtrCostCentre !InternalBreakpointId
instance NFData BCONPtr where
rnf x = x `seq` ()
=====================================
compiler/GHC/CoreToIface.hs
=====================================
@@ -704,12 +704,13 @@ toIfaceLFInfo nm lfi = case lfi of
-- Dehydrating CgBreakInfo
-dehydrateCgBreakInfo :: [TyVar] -> [Maybe (Id, Word)] -> Type -> CgBreakInfo
-dehydrateCgBreakInfo ty_vars idOffSets tick_ty =
+dehydrateCgBreakInfo :: [TyVar] -> [Maybe (Id, Word)] -> Type -> BreakpointId -> CgBreakInfo
+dehydrateCgBreakInfo ty_vars idOffSets tick_ty bid =
CgBreakInfo
{ cgb_tyvars = map toIfaceTvBndr ty_vars
, cgb_vars = map (fmap (\(i, offset) -> (toIfaceIdBndr i, offset))) idOffSets
, cgb_resty = toIfaceType tick_ty
+ , cgb_tick_id = bid
}
{- Note [Inlining and hs-boot files]
=====================================
compiler/GHC/Driver/Make.hs
=====================================
@@ -1552,7 +1552,7 @@ wrapAction msg_wrapper hsc_env k = do
-- ThreadKilled in particular needs to actually kill the thread.
-- So rethrow that and the other async exceptions
Just (err :: SomeAsyncException) -> throwIO err
- _ -> errorMsg lcl_logger (text (show exc))
+ _ -> reportError lcl_logger neverQualify emptyDiagOpts noSrcSpan (text (show exc))
return Nothing
=====================================
compiler/GHC/HsToCore/Breakpoints.hs
=====================================
@@ -12,7 +12,7 @@
-- 'InternalModBreaks' and 'InternalBreakId's. The latter are constructed
-- during bytecode generation and can be found in 'GHC.ByteCode.Breakpoints'.
--
--- See Note [Breakpoint identifiers]
+-- See Note [ModBreaks vs InternalModBreaks] and Note [Breakpoint identifiers]
module GHC.HsToCore.Breakpoints
( -- * ModBreaks
mkModBreaks, ModBreaks(..)
=====================================
compiler/GHC/Linker/Loader.hs
=====================================
@@ -43,6 +43,7 @@ import GHC.Settings
import GHC.Platform
import GHC.Platform.Ways
+import GHC.Driver.Errors
import GHC.Driver.Phases
import GHC.Driver.Env
import GHC.Driver.Session
@@ -50,7 +51,7 @@ import GHC.Driver.Ppr
import GHC.Driver.Config.Diagnostic
import GHC.Driver.Config.Finder
-import GHC.Tc.Utils.Monad
+import GHC.Tc.Utils.Monad hiding (reportDiagnostic)
import GHC.Runtime.Interpreter
import GHCi.BreakArray
@@ -124,7 +125,9 @@ import GHC.Utils.Exception
import GHC.Unit.Home.Graph (lookupHug, unitEnv_foldWithKey)
import GHC.Driver.Downsweep
import qualified GHC.Runtime.Interpreter as GHCi
-import Data.Array.Base (numElements)
+import qualified Data.IntMap.Strict as IM
+import qualified Data.Map.Strict as M
+import Foreign.Ptr (nullPtr)
-- Note [Linkers and loaders]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -1307,9 +1310,9 @@ load_dyn interp hsc_env crash_early dll = do
then cmdLineErrorIO err
else do
when (diag_wopt Opt_WarnMissedExtraSharedLib diag_opts)
- $ logMsg logger
- (mkMCDiagnostic diag_opts (WarningWithFlag Opt_WarnMissedExtraSharedLib) Nothing)
- noSrcSpan $ withPprStyle defaultUserStyle (note err)
+ $ reportDiagnostic logger
+ neverQualify diag_opts
+ noSrcSpan (WarningWithFlag Opt_WarnMissedExtraSharedLib) $ withPprStyle defaultUserStyle (note err)
pure Nothing
where
diag_opts = initDiagOpts (hsc_dflags hsc_env)
@@ -1497,8 +1500,7 @@ locateLib interp hsc_env is_hs lib_dirs gcc_dirs lib0
, not loading_dynamic_hs_libs
, interpreterProfiled interp
= do
- let diag = mkMCDiagnostic diag_opts WarningWithoutFlag Nothing
- logMsg logger diag noSrcSpan $ withPprStyle defaultErrStyle $
+ reportDiagnostic logger neverQualify diag_opts noSrcSpan WarningWithoutFlag $ withPprStyle defaultErrStyle $
text "Interpreter failed to load profiled static library" <+> text lib <> char '.' $$
text " \tTrying dynamic library instead. If this fails try to rebuild" <+>
text "libraries with profiling support."
@@ -1666,10 +1668,10 @@ allocateBreakArrays ::
IO (ModuleEnv (ForeignRef BreakArray))
allocateBreakArrays interp =
foldlM
- ( \be0 InternalModBreaks{imodBreaks_modBreaks=ModBreaks {..}} -> do
+ ( \be0 InternalModBreaks{imodBreaks_breakInfo, imodBreaks_modBreaks=ModBreaks {..}} -> do
-- If no BreakArray is assigned to this module yet, create one
if not $ elemModuleEnv modBreaks_module be0 then do
- let count = numElements modBreaks_locs
+ let count = maybe 0 ((+1) . fst) $ IM.lookupMax imodBreaks_breakInfo
breakArray <- GHCi.newBreakArray interp count
evaluate $ extendModuleEnv be0 modBreaks_module breakArray
else
@@ -1679,29 +1681,51 @@ allocateBreakArrays interp =
-- | Given a list of 'InternalModBreaks' collected from a list
-- of 'CompiledByteCode', allocate the 'CostCentre' arrays when profiling is
-- enabled.
+--
+-- Note that the resulting arrays are indexed by 'BreakInfoIndex' (internal
+-- breakpoint index), not by tick index
allocateCCS ::
Interp ->
- ModuleEnv (Array BreakTickIndex (RemotePtr CostCentre)) ->
+ ModuleEnv (Array BreakInfoIndex (RemotePtr CostCentre)) ->
[InternalModBreaks] ->
- IO (ModuleEnv (Array BreakTickIndex (RemotePtr CostCentre)))
+ IO (ModuleEnv (Array BreakInfoIndex (RemotePtr CostCentre)))
allocateCCS interp ce mbss
- | interpreterProfiled interp =
- foldlM
- ( \ce0 InternalModBreaks{imodBreaks_modBreaks=ModBreaks {..}} -> do
- ccs <-
+ | interpreterProfiled interp = do
+ -- 1. Create a mapping from source BreakpointId to CostCentre ptr
+ ccss <- M.unions <$> mapM
+ ( \InternalModBreaks{imodBreaks_modBreaks=ModBreaks{..}} -> do
+ ccs <- {- one ccs ptr per tick index -}
mkCostCentres
interp
(moduleNameString $ moduleName modBreaks_module)
(elems modBreaks_ccs)
- if not $ elemModuleEnv modBreaks_module ce0 then do
- evaluate $
- extendModuleEnv ce0 modBreaks_module $
- listArray
- (0, length ccs - 1)
- ccs
+ return $ M.fromList $
+ zipWith (\el ix -> (BreakpointId modBreaks_module ix, el)) ccs [0..]
+ )
+ mbss
+ -- 2. Create an array with one element for every InternalBreakpointId,
+ -- where every element has the CCS for the corresponding BreakpointId
+ foldlM
+ (\ce0 InternalModBreaks{imodBreaks_breakInfo, imodBreaks_modBreaks=ModBreaks{..}} -> do
+ if not $ elemModuleEnv modBreaks_module ce then do
+ let count = maybe 0 ((+1) . fst) $ IM.lookupMax imodBreaks_breakInfo
+ let ccs = IM.map
+ (\info ->
+ fromMaybe (toRemotePtr nullPtr)
+ (M.lookup (cgb_tick_id info) ccss)
+ )
+ imodBreaks_breakInfo
+ assertPpr (count == length ccs)
+ (text "expected CgBreakInfo map to have one entry per valid ix") $
+ evaluate $
+ extendModuleEnv ce0 modBreaks_module $
+ listArray
+ (0, count)
+ (IM.elems ccs)
else
return ce0
)
ce
mbss
+
| otherwise = pure ce
=====================================
compiler/GHC/Runtime/Debugger/Breakpoints.hs
=====================================
@@ -31,6 +31,9 @@ import GHC.Unit.Module.ModSummary
import GHC.Utils.Outputable
import GHC.Utils.Panic
import qualified GHC.Data.Strict as Strict
+import qualified Data.IntMap.Strict as IntMap
+import qualified GHC.Unit.Home.Graph as HUG
+import qualified GHC.Unit.Home.PackageTable as HPT
--------------------------------------------------------------------------------
-- Finding Module breakpoints
@@ -213,6 +216,47 @@ getModBreak m = do
mod_info <- fromMaybe (panic "getModBreak") <$> getModuleInfo m
pure $ imodBreaks_modBreaks <$> modInfoModBreaks mod_info
+--------------------------------------------------------------------------------
+-- Mapping source-level BreakpointIds to IBI occurrences
+-- (See Note [Breakpoint identifiers])
+--------------------------------------------------------------------------------
+
+-- | A source-level breakpoint may have been inlined into many occurrences, now
+-- referred by 'InternalBreakpointId'. When a breakpoint is set on a certain
+-- source breakpoint, it means all *ocurrences* of that breakpoint across
+-- modules should be stopped at -- hence we keep a trie from BreakpointId to
+-- the list of internal break ids using it.
+-- See also Note [Breakpoint identifiers]
+type BreakpointOccurrences = ModuleEnv (IntMap.IntMap [InternalBreakpointId])
+
+-- | Lookup all InternalBreakpointIds matching the given BreakpointId
+-- Nothing if BreakpointId not in map
+lookupBreakpointOccurrences :: BreakpointOccurrences -> BreakpointId -> Maybe [InternalBreakpointId]
+lookupBreakpointOccurrences bmp (BreakpointId md tick) =
+ lookupModuleEnv bmp md >>= IntMap.lookup tick
+
+-- | Construct a mapping from Source 'BreakpointId's to 'InternalBreakpointId's from the given list of 'ModInfo's
+mkBreakpointOccurrences :: forall m. GhcMonad m => m BreakpointOccurrences
+mkBreakpointOccurrences = do
+ hug <- hsc_HUG <$> getSession
+ liftIO $ foldr go (pure emptyModuleEnv) hug
+ where
+ go :: HUG.HomeUnitEnv -> IO BreakpointOccurrences -> IO BreakpointOccurrences
+ go hue mbmp = do
+ bmp <- mbmp
+ ibrkss <- HPT.concatHpt (\hmi -> maybeToList (getModBreaks hmi))
+ (HUG.homeUnitEnv_hpt hue)
+ return $ foldr addBreakToMap bmp ibrkss
+
+ addBreakToMap :: InternalModBreaks -> BreakpointOccurrences -> BreakpointOccurrences
+ addBreakToMap ibrks bmp0 = do
+ let imod = modBreaks_module $ imodBreaks_modBreaks ibrks
+ IntMap.foldrWithKey (\info_ix cgi bmp -> do
+ let ibi = InternalBreakpointId imod info_ix
+ let BreakpointId tick_mod tick_ix = cgb_tick_id cgi
+ extendModuleEnvWith (IntMap.unionWith (S.<>)) bmp tick_mod (IntMap.singleton tick_ix [ibi])
+ ) bmp0 (imodBreaks_breakInfo ibrks)
+
--------------------------------------------------------------------------------
-- Getting current breakpoint information
--------------------------------------------------------------------------------
@@ -235,9 +279,15 @@ getCurrentBreakSpan = do
getCurrentBreakModule :: GhcMonad m => m (Maybe Module)
getCurrentBreakModule = do
resumes <- getResumeContext
- return $ case resumes of
- [] -> Nothing
+ hug <- hsc_HUG <$> getSession
+ liftIO $ case resumes of
+ [] -> pure Nothing
(r:_) -> case resumeHistoryIx r of
- 0 -> ibi_tick_mod <$> resumeBreakpointId r
- ix -> Just $ getHistoryModule $ resumeHistory r !! (ix-1)
+ 0 -> case resumeBreakpointId r of
+ Nothing -> pure Nothing
+ Just ibi -> do
+ brks <- readIModBreaks hug ibi
+ return $ Just $ bi_tick_mod $ getBreakSourceId ibi brks
+ ix ->
+ Just <$> getHistoryModule hug (resumeHistory r !! (ix-1))
=====================================
compiler/GHC/Runtime/Eval.hs
=====================================
@@ -18,7 +18,7 @@ module GHC.Runtime.Eval (
abandon, abandonAll,
getResumeContext,
getHistorySpan,
- getModBreaks, readModBreaks,
+ getModBreaks, readIModBreaks, readIModModBreaks,
getHistoryModule,
setupBreakpoint,
back, forward,
@@ -147,14 +147,17 @@ getResumeContext = withSession (return . ic_resume . hsc_IC)
mkHistory :: HUG.HomeUnitGraph -> ForeignHValue -> InternalBreakpointId -> IO History
mkHistory hug hval ibi = History hval ibi <$> findEnclosingDecls hug ibi
-getHistoryModule :: History -> Module
-getHistoryModule = ibi_tick_mod . historyBreakpointId
+getHistoryModule :: HUG.HomeUnitGraph -> History -> IO Module
+getHistoryModule hug hist = do
+ let ibi = historyBreakpointId hist
+ brks <- readIModBreaks hug ibi
+ return $ bi_tick_mod $ getBreakSourceId ibi brks
getHistorySpan :: HUG.HomeUnitGraph -> History -> IO SrcSpan
getHistorySpan hug hist = do
let ibi = historyBreakpointId hist
- brks <- readModBreaks hug (ibi_tick_mod ibi)
- return $ getBreakLoc ibi brks
+ brks <- readIModBreaks hug ibi
+ getBreakLoc (readIModModBreaks hug) ibi brks
{- | Finds the enclosing top level function name -}
-- ToDo: a better way to do this would be to keep hold of the decl_path computed
@@ -162,8 +165,8 @@ getHistorySpan hug hist = do
-- for each tick.
findEnclosingDecls :: HUG.HomeUnitGraph -> InternalBreakpointId -> IO [String]
findEnclosingDecls hug ibi = do
- brks <- readModBreaks hug (ibi_tick_mod ibi)
- return $ getBreakDecls ibi brks
+ brks <- readIModBreaks hug ibi
+ getBreakDecls (readIModModBreaks hug) ibi brks
-- | Update fixity environment in the current interactive context.
updateFixityEnv :: GhcMonad m => FixityEnv -> m ()
@@ -350,15 +353,14 @@ handleRunStatus step expr bindings final_ids status history0 = do
EvalBreak apStack_ref (Just eval_break) resume_ctxt ccs -> do
let ibi = evalBreakpointToId eval_break
let hug = hsc_HUG hsc_env
- tick_brks <- liftIO $ readModBreaks hug (ibi_tick_mod ibi)
- let
- span = getBreakLoc ibi tick_brks
- decl = intercalate "." $ getBreakDecls ibi tick_brks
+ info_brks <- liftIO $ readIModBreaks hug ibi
+ span <- liftIO $ getBreakLoc (readIModModBreaks hug) ibi info_brks
+ decl <- liftIO $ intercalate "." <$> getBreakDecls (readIModModBreaks hug) ibi info_brks
-- Was this breakpoint explicitly enabled (ie. in @BreakArray@)?
bactive <- liftIO $ do
- breakArray <- getBreakArray interp (toBreakpointId ibi) tick_brks
- breakpointStatus interp breakArray (ibi_tick_index ibi)
+ breakArray <- getBreakArray interp ibi info_brks
+ breakpointStatus interp breakArray (ibi_info_index ibi)
apStack_fhv <- liftIO $ mkFinalizedHValue interp apStack_ref
resume_ctxt_fhv <- liftIO $ mkFinalizedHValue interp resume_ctxt
@@ -446,7 +448,7 @@ resumeExec step mbCnt
-- When the user specified a break ignore count, set it
-- in the interpreter
case (mb_brkpt, mbCnt) of
- (Just brkpt, Just cnt) -> setupBreakpoint interp (toBreakpointId brkpt) cnt
+ (Just brkpt, Just cnt) -> setupBreakpoint interp brkpt cnt
_ -> return ()
let eval_opts = initEvalOpts dflags (enableGhcStepMode step)
@@ -462,17 +464,18 @@ resumeExec step mbCnt
| otherwise -> pure prevHistoryLst
handleRunStatus step expr bindings final_ids status =<< hist'
-setupBreakpoint :: GhcMonad m => Interp -> BreakpointId -> Int -> m () -- #19157
-setupBreakpoint interp bi cnt = do
+setupBreakpoint :: GhcMonad m => Interp -> InternalBreakpointId -> Int -> m () -- #19157
+setupBreakpoint interp ibi cnt = do
hug <- hsc_HUG <$> getSession
- modBreaks <- liftIO $ readModBreaks hug (bi_tick_mod bi)
- breakArray <- liftIO $ getBreakArray interp bi modBreaks
- liftIO $ GHCi.storeBreakpoint interp breakArray (bi_tick_index bi) cnt
+ liftIO $ do
+ modBreaks <- readIModBreaks hug ibi
+ breakArray <- getBreakArray interp ibi modBreaks
+ GHCi.storeBreakpoint interp breakArray (ibi_info_index ibi) cnt
-getBreakArray :: Interp -> BreakpointId -> InternalModBreaks -> IO (ForeignRef BreakArray)
-getBreakArray interp BreakpointId{bi_tick_mod} imbs = do
+getBreakArray :: Interp -> InternalBreakpointId -> InternalModBreaks -> IO (ForeignRef BreakArray)
+getBreakArray interp InternalBreakpointId{ibi_info_mod} imbs = do
breaks0 <- linked_breaks . fromMaybe (panic "Loader not initialised") <$> getLoaderState interp
- case lookupModuleEnv (breakarray_env breaks0) bi_tick_mod of
+ case lookupModuleEnv (breakarray_env breaks0) ibi_info_mod of
Just ba -> return ba
Nothing -> do
modifyLoaderState interp $ \ld_st -> do
@@ -483,13 +486,12 @@ getBreakArray interp BreakpointId{bi_tick_mod} imbs = do
ba_env <- allocateBreakArrays interp (breakarray_env lb) [imbs]
let ld_st' = ld_st { linked_breaks = lb{breakarray_env = ba_env} }
- let ba = expectJust {- just computed -} $ lookupModuleEnv ba_env bi_tick_mod
+ let ba = expectJust {- just computed -} $ lookupModuleEnv ba_env ibi_info_mod
return
( ld_st'
, ba
)
-
back :: GhcMonad m => Int -> m ([Name], Int, SrcSpan)
back n = moveHist (+n)
@@ -517,8 +519,9 @@ moveHist fn = do
span <- case mb_info of
Nothing -> return $ mkGeneralSrcSpan (fsLit "<unknown>")
Just ibi -> liftIO $ do
- brks <- readModBreaks (hsc_HUG hsc_env) (ibi_tick_mod ibi)
- return $ getBreakLoc ibi brks
+ let hug = hsc_HUG hsc_env
+ brks <- readIModBreaks hug ibi
+ getBreakLoc (readIModModBreaks hug) ibi brks
(hsc_env1, names) <-
liftIO $ bindLocalsAtBreakpoint hsc_env apStack span mb_info
let ic = hsc_IC hsc_env1
@@ -579,11 +582,10 @@ bindLocalsAtBreakpoint hsc_env apStack span Nothing = do
-- of the breakpoint and the free variables of the expression.
bindLocalsAtBreakpoint hsc_env apStack_fhv span (Just ibi) = do
let hug = hsc_HUG hsc_env
- info_brks <- readModBreaks hug (ibi_info_mod ibi)
- tick_brks <- readModBreaks hug (ibi_tick_mod ibi)
- let info = getInternalBreak ibi (info_brks)
+ info_brks <- readIModBreaks hug ibi
+ let info = getInternalBreak ibi info_brks
interp = hscInterp hsc_env
- occs = getBreakVars ibi tick_brks
+ occs <- getBreakVars (readIModModBreaks hug) ibi info_brks
-- Rehydrate to understand the breakpoint info relative to the current environment.
-- This design is critical to preventing leaks (#22530)
=====================================
compiler/GHC/Runtime/Interpreter.hs
=====================================
@@ -27,7 +27,9 @@ module GHC.Runtime.Interpreter
, getClosure
, whereFrom
, getModBreaks
- , readModBreaks
+ , readIModBreaks
+ , readIModBreaksMaybe
+ , readIModModBreaks
, seqHValue
, evalBreakpointToId
@@ -92,7 +94,6 @@ import GHC.Utils.Fingerprint
import GHC.Unit.Module
import GHC.Unit.Home.ModInfo
-import GHC.Unit.Home.Graph (lookupHugByModule)
import GHC.Unit.Env
#if defined(HAVE_INTERNAL_INTERPRETER)
@@ -411,15 +412,10 @@ evalBreakpointToId :: EvalBreakpoint -> InternalBreakpointId
evalBreakpointToId eval_break =
let
mkUnitId u = fsToUnit $ mkFastStringShortByteString u
-
toModule u n = mkModule (mkUnitId u) (mkModuleName n)
- tickl = toModule (eb_tick_mod_unit eval_break) (eb_tick_mod eval_break)
- infol = toModule (eb_info_mod_unit eval_break) (eb_info_mod eval_break)
in
InternalBreakpointId
- { ibi_tick_mod = tickl
- , ibi_tick_index = eb_tick_index eval_break
- , ibi_info_mod = infol
+ { ibi_info_mod = toModule (eb_info_mod_unit eval_break) (eb_info_mod eval_break)
, ibi_info_index = eb_info_index eval_break
}
@@ -440,17 +436,18 @@ handleSeqHValueStatus interp unit_env eval_status =
-- Reason: Setting of flags in libraries/ghci/GHCi/Run.hs:evalOptsSeq
Just break -> do
- let bi = evalBreakpointToId break
+ let ibi = evalBreakpointToId break
+ hug = ue_home_unit_graph unit_env
-- Just case: Stopped at a breakpoint, extract SrcSpan information
-- from the breakpoint.
- mb_modbreaks <- getModBreaks . expectJust <$>
- lookupHugByModule (ibi_tick_mod bi) (ue_home_unit_graph unit_env)
+ mb_modbreaks <- readIModBreaksMaybe hug (ibi_info_mod ibi)
case mb_modbreaks of
-- Nothing case - should not occur! We should have the appropriate
-- breakpoint information
Nothing -> nothing_case
- Just modbreaks -> put $ brackets . ppr $ getBreakLoc bi modbreaks
+ Just modbreaks -> put . brackets . ppr =<<
+ getBreakLoc (readIModModBreaks hug) ibi modbreaks
-- resume the seq (:force) processing in the iserv process
withForeignRef resume_ctxt_fhv $ \hval -> do
@@ -745,10 +742,18 @@ getModBreaks hmi
| otherwise
= Nothing -- probably object code
--- | Read the 'InternalModBreaks' and 'ModBreaks' of the given home 'Module'
--- from the 'HomeUnitGraph'.
-readModBreaks :: HomeUnitGraph -> Module -> IO InternalModBreaks
-readModBreaks hug modl = expectJust . getModBreaks . expectJust <$> HUG.lookupHugByModule modl hug
+-- | Read the 'InternalModBreaks' of the given home 'Module' (via
+-- 'InternalBreakpointId') from the 'HomeUnitGraph'.
+readIModBreaks :: HomeUnitGraph -> InternalBreakpointId -> IO InternalModBreaks
+readIModBreaks hug ibi = expectJust <$> readIModBreaksMaybe hug (ibi_info_mod ibi)
+
+-- | Read the 'InternalModBreaks' of the given home 'Module' from the 'HomeUnitGraph'.
+readIModBreaksMaybe :: HomeUnitGraph -> Module -> IO (Maybe InternalModBreaks)
+readIModBreaksMaybe hug mod = getModBreaks . expectJust <$> HUG.lookupHugByModule mod hug
+
+-- | Read the 'ModBreaks' from the given module's 'InternalModBreaks'
+readIModModBreaks :: HUG.HomeUnitGraph -> Module -> IO ModBreaks
+readIModModBreaks hug mod = imodBreaks_modBreaks . expectJust <$> readIModBreaksMaybe hug mod
-- -----------------------------------------------------------------------------
-- Misc utils
=====================================
compiler/GHC/StgToByteCode.hs
=====================================
@@ -31,7 +31,6 @@ import GHC.Cmm.Utils
import GHC.Platform
import GHC.Platform.Profile
-import GHC.Runtime.Interpreter
import GHCi.FFI
import GHC.Types.Basic
import GHC.Utils.Outputable
@@ -64,6 +63,7 @@ import GHC.StgToCmm.Closure ( NonVoid(..), fromNonVoid, idPrimRepU,
assertNonVoidIds, assertNonVoidStgArgs )
import GHC.StgToCmm.Layout
import GHC.Runtime.Heap.Layout hiding (WordOff, ByteOff, wordsToBytes)
+import GHC.Runtime.Interpreter ( interpreterProfiled )
import GHC.Data.Bitmap
import GHC.Data.FlatBag as FlatBag
import GHC.Data.OrdList
@@ -79,7 +79,6 @@ import Control.Monad
import Data.Char
import GHC.Unit.Module
-import qualified GHC.Unit.Home.Graph as HUG
import Data.Coerce (coerce)
#if MIN_VERSION_rts(1,0,3)
@@ -394,65 +393,28 @@ schemeR_wrk fvs nm original_body (args, body)
-- | Introduce break instructions for ticked expressions.
-- If no breakpoint information is available, the instruction is omitted.
schemeER_wrk :: StackDepth -> BCEnv -> CgStgExpr -> BcM BCInstrList
-schemeER_wrk d p (StgTick (Breakpoint tick_ty (BreakpointId tick_mod tick_no) fvs) rhs) = do
+schemeER_wrk d p (StgTick (Breakpoint tick_ty tick_id fvs) rhs) = do
code <- schemeE d 0 p rhs
- hsc_env <- getHscEnv
- current_mod <- getCurrentModule
mb_current_mod_breaks <- getCurrentModBreaks
case mb_current_mod_breaks of
-- if we're not generating ModBreaks for this module for some reason, we
-- can't store breakpoint occurrence information.
Nothing -> pure code
- Just current_mod_breaks -> break_info hsc_env tick_mod current_mod mb_current_mod_breaks >>= \case
- Nothing -> pure code
- Just ModBreaks{modBreaks_module = tick_mod} -> do
- platform <- profilePlatform <$> getProfile
- let idOffSets = getVarOffSets platform d p fvs
- ty_vars = tyCoVarsOfTypesWellScoped (tick_ty:map idType fvs)
- toWord :: Maybe (Id, WordOff) -> Maybe (Id, Word)
- toWord = fmap (\(i, wo) -> (i, fromIntegral wo))
- breakInfo = dehydrateCgBreakInfo ty_vars (map toWord idOffSets) tick_ty
+ Just current_mod_breaks -> do
+ platform <- profilePlatform <$> getProfile
+ let idOffSets = getVarOffSets platform d p fvs
+ ty_vars = tyCoVarsOfTypesWellScoped (tick_ty:map idType fvs)
+ toWord :: Maybe (Id, WordOff) -> Maybe (Id, Word)
+ toWord = fmap (\(i, wo) -> (i, fromIntegral wo))
+ breakInfo = dehydrateCgBreakInfo ty_vars (map toWord idOffSets) tick_ty tick_id
- let info_mod = modBreaks_module current_mod_breaks
- infox <- newBreakInfo breakInfo
+ let info_mod = modBreaks_module current_mod_breaks
+ infox <- newBreakInfo breakInfo
- let breakInstr = BRK_FUN (InternalBreakpointId tick_mod tick_no info_mod infox)
- return $ breakInstr `consOL` code
+ let breakInstr = BRK_FUN (InternalBreakpointId info_mod infox)
+ return $ breakInstr `consOL` code
schemeER_wrk d p rhs = schemeE d 0 p rhs
--- | Determine the GHCi-allocated 'BreakArray' and module pointer for the module
--- from which the breakpoint originates.
--- These are stored in 'ModBreaks' as remote pointers in order to allow the BCOs
--- to refer to pointers in GHCi's address space.
--- They are initialized in 'GHC.HsToCore.Breakpoints.mkModBreaks', called by
--- 'GHC.HsToCore.deSugar'.
---
--- Breakpoints might be disabled because we're in TH, because
--- @-fno-break-points@ was specified, or because a module was reloaded without
--- reinitializing 'ModBreaks'.
---
--- If the module stored in the breakpoint is the currently processed module, use
--- the 'ModBreaks' from the state.
--- If that is 'Nothing', consider breakpoints to be disabled and skip the
--- instruction.
---
--- If the breakpoint is inlined from another module, look it up in the HUG (home unit graph).
--- If the module doesn't exist there, or if the 'ModBreaks' value is
--- uninitialized, skip the instruction (i.e. return Nothing).
-break_info ::
- HscEnv ->
- Module ->
- Module ->
- Maybe ModBreaks ->
- BcM (Maybe ModBreaks)
-break_info hsc_env mod current_mod current_mod_breaks
- | mod == current_mod
- = pure current_mod_breaks
- | otherwise
- = liftIO (HUG.lookupHugByModule mod (hsc_HUG hsc_env)) >>= \case
- Just hp -> pure $ imodBreaks_modBreaks <$> getModBreaks hp
- Nothing -> pure Nothing
-
getVarOffSets :: Platform -> StackDepth -> BCEnv -> [Id] -> [Maybe (Id, WordOff)]
getVarOffSets platform depth env = map getOffSet
where
=====================================
compiler/GHC/SysTools/Tasks.hs
=====================================
@@ -55,7 +55,7 @@ import GHC.Driver.Config.Diagnostic
import GHC.Driver.Errors
import GHC.Driver.Errors.Types (GhcMessage(..), DriverMessage (DriverNoConfiguredLLVMToolchain))
import GHC.Driver.CmdLine (warnsToMessages)
-import GHC.Types.SrcLoc (noLoc)
+import GHC.Types.SrcLoc (noLoc, noSrcSpan)
{-
************************************************************************
@@ -346,7 +346,7 @@ figureLlvmVersion logger dflags = traceSystoolCommand logger "llc" $ do
debugTraceMsg logger 2
(text "Error (figuring out LLVM version):" <+>
text (show err))
- errorMsg logger $ vcat
+ reportError logger neverQualify emptyDiagOpts noSrcSpan $ vcat
[ text "Warning:", nest 9 $
text "Couldn't figure out LLVM version!" $$
text ("Make sure you have installed LLVM between ["
=====================================
compiler/GHC/Utils/Error.hs
=====================================
@@ -32,7 +32,7 @@ module GHC.Utils.Error (
emptyMessages, mkDecorated, mkLocMessage,
mkMsgEnvelope, mkPlainMsgEnvelope, mkPlainErrorMsgEnvelope,
mkErrorMsgEnvelope,
- mkMCDiagnostic, errorDiagnostic, diagReasonSeverity,
+ mkMCDiagnostic, diagReasonSeverity,
mkPlainError,
mkPlainDiagnostic,
@@ -46,7 +46,6 @@ module GHC.Utils.Error (
-- * Issuing messages during compilation
putMsg, printInfoForUser, printOutputForUser,
logInfo, logOutput,
- errorMsg,
fatalErrorMsg,
compilationProgressMsg,
showPass,
@@ -168,11 +167,6 @@ mkMCDiagnostic opts reason code = MCDiagnostic sev reason' code
where
(sev, reason') = diag_reason_severity opts reason
--- | Varation of 'mkMCDiagnostic' which can be used when we are /sure/ the
--- input 'DiagnosticReason' /is/ 'ErrorWithoutFlag' and there is no diagnostic code.
-errorDiagnostic :: MessageClass
-errorDiagnostic = MCDiagnostic SevError (ResolvedDiagnosticReason ErrorWithoutFlag) Nothing
-
--
-- Creating MsgEnvelope(s)
--
@@ -318,17 +312,12 @@ sortMsgBag mopts = maybeLimit . sortBy (cmp `on` errMsgSpan) . bagToList
ghcExit :: Logger -> Int -> IO ()
ghcExit logger val
| val == 0 = exitWith ExitSuccess
- | otherwise = do errorMsg logger (text "\nCompilation had errors\n\n")
+ | otherwise = do fatalErrorMsg logger (text "\nCompilation had errors\n\n")
exitWith (ExitFailure val)
-- -----------------------------------------------------------------------------
-- Outputting messages from the compiler
-errorMsg :: Logger -> SDoc -> IO ()
-errorMsg logger msg
- = logMsg logger errorDiagnostic noSrcSpan $
- withPprStyle defaultErrStyle msg
-
fatalErrorMsg :: Logger -> SDoc -> IO ()
fatalErrorMsg logger msg =
logMsg logger MCFatal noSrcSpan $ withPprStyle defaultErrStyle msg
=====================================
ghc/GHCi/UI.hs
=====================================
@@ -45,7 +45,7 @@ import GHC.Runtime.Eval (mkTopLevEnv)
import GHC.Runtime.Eval.Utils
-- The GHC interface
-import GHC.ByteCode.Breakpoints (imodBreaks_modBreaks)
+import GHC.ByteCode.Breakpoints (imodBreaks_modBreaks, InternalBreakpointId(..), getBreakSourceId)
import GHC.Runtime.Interpreter
import GHCi.RemoteTypes
import GHCi.BreakArray( breakOn, breakOff )
@@ -68,7 +68,7 @@ import GHC ( LoadHowMuch(..), Target(..), TargetId(..),
Resume, SingleStep, Ghc,
GetDocsFailure(..), pushLogHookM,
getModuleGraph, handleSourceError,
- InternalBreakpointId(..) )
+ BreakpointId(..) )
import GHC.Driver.Main (hscParseModuleWithLocation, hscParseStmtWithLocation)
import GHC.Hs.ImpExp
import GHC.Hs
@@ -546,6 +546,7 @@ interactiveUI config srcs maybe_exprs = do
break_ctr = 0,
breaks = IntMap.empty,
tickarrays = emptyModuleEnv,
+ internalBreaks = emptyModuleEnv,
ghci_commands = availableCommands config,
ghci_macros = [],
last_command = Nothing,
@@ -1616,13 +1617,15 @@ toBreakIdAndLocation :: GhciMonad m
toBreakIdAndLocation Nothing = return Nothing
toBreakIdAndLocation (Just inf) = do
st <- getGHCiState
+ hug <- hsc_HUG <$> GHC.getSession
+ brks <- liftIO $ readIModBreaks hug inf
+ let bi = getBreakSourceId inf brks
return $ listToMaybe [ id_loc | id_loc@(_,loc) <- IntMap.assocs (breaks st),
- breakModule loc == ibi_tick_mod inf,
- breakTick loc == ibi_tick_index inf ]
+ breakId loc == bi ]
printStoppedAtBreakInfo :: GHC.GhcMonad m => Resume -> [Name] -> m ()
printStoppedAtBreakInfo res names = do
- printForUser $ pprStopped res
+ printForUser =<< pprStopped res
-- printTypeOfNames session names
let namesSorted = sortBy compareNames names
tythings <- catMaybes `liftM` mapM GHC.lookupName namesSorted
@@ -3804,22 +3807,32 @@ showBkptTable = do
showContext :: GHC.GhcMonad m => m ()
showContext = do
resumes <- GHC.getResumeContext
- printForUser $ vcat (map pp_resume (reverse resumes))
+ docs <- mapM pp_resume (reverse resumes)
+ printForUser $ vcat docs
where
- pp_resume res =
- text "--> " <> text (GHC.resumeStmt res)
- $$ nest 2 (pprStopped res)
-
-pprStopped :: GHC.Resume -> SDoc
-pprStopped res =
- text "Stopped in"
- <+> ((case mb_mod_name of
- Nothing -> empty
- Just mod_name -> ftext (moduleNameFS mod_name) <> char '.')
- <> text (GHC.resumeDecl res))
- <> char ',' <+> ppr (GHC.resumeSpan res)
- where
- mb_mod_name = moduleName <$> ibi_tick_mod <$> GHC.resumeBreakpointId res
+ pp_resume res = do
+ stopped <- pprStopped res
+ return $
+ text "--> " <> text (GHC.resumeStmt res)
+ $$ nest 2 stopped
+
+pprStopped :: GHC.GhcMonad m => GHC.Resume -> m SDoc
+pprStopped res = do
+ let mibi = GHC.resumeBreakpointId res
+ mb_mod_name <- case mibi of
+ Nothing -> pure Nothing
+ Just ibi -> do
+ hug <- hsc_HUG <$> GHC.getSession
+ brks <- liftIO $ readIModBreaks hug ibi
+ return $ Just $ moduleName $
+ bi_tick_mod $ getBreakSourceId ibi brks
+ return $
+ text "Stopped in"
+ <+> ((case mb_mod_name of
+ Nothing -> empty
+ Just mod_name -> ftext (moduleNameFS mod_name) <> char '.')
+ <> text (GHC.resumeDecl res))
+ <> char ',' <+> ppr (GHC.resumeSpan res)
showUnits :: GHC.GhcMonad m => m ()
showUnits = mapNonInteractiveHomeUnitsM $ \dflags -> do
@@ -4373,12 +4386,8 @@ ignoreCmd argLine = withSandboxOnly ":ignore" $ do
result <- ignoreSwitch (words argLine)
case result of
Left sdoc -> printForUser sdoc
- Right (loc, count) -> do
- let bi = GHC.BreakpointId
- { bi_tick_mod = breakModule loc
- , bi_tick_index = breakTick loc
- }
- setupBreakpoint bi count
+ Right (loc, count) -> do
+ setupBreakpoint (breakId loc) count
ignoreSwitch :: GhciMonad m => [String] -> m (Either SDoc (BreakLocation, Int))
ignoreSwitch [break, count] = do
@@ -4395,10 +4404,13 @@ getIgnoreCount str =
where
sdocIgnore = text "Ignore count" <+> quotes (text str)
-setupBreakpoint :: GhciMonad m => GHC.BreakpointId -> Int -> m()
-setupBreakpoint loc count = do
+setupBreakpoint :: GhciMonad m => GHC.BreakpointId -> Int -> m ()
+setupBreakpoint bi count = do
hsc_env <- GHC.getSession
- GHC.setupBreakpoint (hscInterp hsc_env) loc count
+ -- Trigger all internal breaks that match this source break id
+ internal_break_ids <- getInternalBreaksOf bi
+ forM_ internal_break_ids $ \ibi -> do
+ GHC.setupBreakpoint (hscInterp hsc_env) ibi count
backCmd :: GhciMonad m => String -> m ()
backCmd arg
@@ -4489,20 +4501,20 @@ findBreakAndSet md lookupTickTree = do
some -> mapM_ breakAt some
where
breakAt (tick, pan) = do
- setBreakFlag md tick True
- (alreadySet, nm) <-
- recordBreak $ BreakLocation
- { breakModule = md
- , breakLoc = RealSrcSpan pan Strict.Nothing
- , breakTick = tick
- , onBreakCmd = ""
- , breakEnabled = True
- }
- printForUser $
- text "Breakpoint " <> ppr nm <>
- if alreadySet
- then text " was already set at " <> ppr pan
- else text " activated at " <> ppr pan
+ let bi = BreakpointId md tick
+ setBreakFlag bi True
+ (alreadySet, nm) <-
+ recordBreak $ BreakLocation
+ { breakLoc = RealSrcSpan pan Strict.Nothing
+ , breakId = bi
+ , onBreakCmd = ""
+ , breakEnabled = True
+ }
+ printForUser $
+ text "Breakpoint " <> ppr nm <>
+ if alreadySet
+ then text " was already set at " <> ppr pan
+ else text " activated at " <> ppr pan
-- For now, use ANSI bold on terminals that we know support it.
-- Otherwise, we add a line of carets under the active expression instead.
@@ -4749,14 +4761,32 @@ turnBreakOnOff :: GhciMonad m => Bool -> BreakLocation -> m BreakLocation
turnBreakOnOff onOff loc
| onOff == breakEnabled loc = return loc
| otherwise = do
- setBreakFlag (breakModule loc) (breakTick loc) onOff
+ setBreakFlag (breakId loc) onOff
return loc { breakEnabled = onOff }
-setBreakFlag :: GhciMonad m => Module -> Int -> Bool ->m ()
-setBreakFlag md ix enaDisa = do
+setBreakFlag :: GhciMonad m => GHC.BreakpointId -> Bool -> m ()
+setBreakFlag (BreakpointId md ix) enaDisa = do
let enaDisaToCount True = breakOn
enaDisaToCount False = breakOff
- setupBreakpoint (GHC.BreakpointId md ix) $ enaDisaToCount enaDisa
+ setupBreakpoint (BreakpointId md ix) $ enaDisaToCount enaDisa
+
+-- --------------------------------------------------------------------------
+-- Find matching Internal Breakpoints
+
+-- | Find all the internal breakpoints that use the given source-level breakpoint id
+getInternalBreaksOf :: GhciMonad m => BreakpointId -> m [InternalBreakpointId]
+getInternalBreaksOf bi = do
+ st <- getGHCiState
+ let ibrks = internalBreaks st
+ case lookupBreakpointOccurrences ibrks bi of
+ Just bs -> return bs
+ Nothing -> do
+ -- Refresh the internal breakpoints map
+ bs <- mkBreakpointOccurrences
+ setGHCiState st{internalBreaks = bs}
+ return $
+ fromMaybe [] {- still not found after refresh -} $
+ lookupBreakpointOccurrences bs bi
-- ---------------------------------------------------------------------------
-- User code exception handling
=====================================
ghc/GHCi/UI/Monad.hs
=====================================
@@ -100,6 +100,14 @@ data GHCiState = GHCiState
-- ^ 'tickarrays' caches the 'TickArray' for loaded modules,
-- so that we don't rebuild it each time the user sets
-- a breakpoint.
+
+ internalBreaks :: BreakpointOccurrences,
+ -- ^ Keep a mapping from the source-level 'BreakpointId' to the
+ -- occurrences of that breakpoint across modules.
+ -- When we want to stop at a source 'BreakpointId', we essentially
+ -- trigger a breakpoint for all 'InternalBreakpointId's matching
+ -- the same source-id.
+
ghci_commands :: [Command],
-- ^ available ghci commands
ghci_macros :: [Command],
@@ -238,16 +246,15 @@ data LocalConfigBehaviour
data BreakLocation
= BreakLocation
- { breakModule :: !GHC.Module
- , breakLoc :: !SrcSpan
- , breakTick :: {-# UNPACK #-} !Int
+ { breakLoc :: !SrcSpan
+ , breakId :: !GHC.BreakpointId
+ -- ^ The 'BreakpointId' uniquely identifies a source-level breakpoint
, breakEnabled:: !Bool
, onBreakCmd :: String
}
instance Eq BreakLocation where
- loc1 == loc2 = breakModule loc1 == breakModule loc2 &&
- breakTick loc1 == breakTick loc2
+ loc1 == loc2 = breakId loc1 == breakId loc2
prettyLocations :: IntMap.IntMap BreakLocation -> SDoc
prettyLocations locs =
@@ -256,7 +263,7 @@ prettyLocations locs =
False -> vcat $ map (\(i, loc) -> brackets (int i) <+> ppr loc) $ IntMap.toAscList locs
instance Outputable BreakLocation where
- ppr loc = (ppr $ breakModule loc) <+> ppr (breakLoc loc) <+> pprEnaDisa <+>
+ ppr loc = (ppr $ GHC.bi_tick_mod $ breakId loc) <+> ppr (breakLoc loc) <+> pprEnaDisa <+>
if null (onBreakCmd loc)
then empty
else doubleQuotes (text (onBreakCmd loc))
=====================================
libraries/ghci/GHCi/Debugger.hs
=====================================
@@ -65,10 +65,7 @@ foreign import ccall "&rts_stop_on_exception" exceptionFlag :: Ptr CInt
--------------------------------------------------------------------------------
type BreakpointCallback
- = Addr# -- pointer to the breakpoint tick module name
- -> Addr# -- pointer to the breakpoint tick module unit id
- -> Int# -- breakpoint tick index
- -> Addr# -- pointer to the breakpoint info module name
+ = Addr# -- pointer to the breakpoint info module name
-> Addr# -- pointer to the breakpoint info module unit id
-> Int# -- breakpoint info index
-> Bool -- exception?
=====================================
libraries/ghci/GHCi/Message.hs
=====================================
@@ -418,10 +418,7 @@ data EvalStatus_ a b
instance Binary a => Binary (EvalStatus_ a b)
data EvalBreakpoint = EvalBreakpoint
- { eb_tick_mod :: String -- ^ Breakpoint tick module
- , eb_tick_mod_unit :: BS.ShortByteString -- ^ Breakpoint tick module unit id
- , eb_tick_index :: Int -- ^ Breakpoint tick index
- , eb_info_mod :: String -- ^ Breakpoint info module
+ { eb_info_mod :: String -- ^ Breakpoint info module
, eb_info_mod_unit :: BS.ShortByteString -- ^ Breakpoint tick module unit id
, eb_info_index :: Int -- ^ Breakpoint info index
}
=====================================
libraries/ghci/GHCi/Run.hs
=====================================
@@ -345,7 +345,7 @@ withBreakAction opts breakMVar statusMVar mtid act
-- as soon as it is hit, or in resetBreakAction below.
onBreak :: BreakpointCallback
- onBreak tick_mod# tick_mod_uid# tickx# info_mod# info_mod_uid# infox# is_exception apStack = do
+ onBreak info_mod# info_mod_uid# infox# is_exception apStack = do
tid <- myThreadId
let resume = ResumeContext
{ resumeBreakMVar = breakMVar
@@ -358,11 +358,9 @@ withBreakAction opts breakMVar statusMVar mtid act
if is_exception
then pure Nothing
else do
- tick_mod <- peekCString (Ptr tick_mod#)
- tick_mod_uid <- BS.packCString (Ptr tick_mod_uid#)
info_mod <- peekCString (Ptr info_mod#)
info_mod_uid <- BS.packCString (Ptr info_mod_uid#)
- pure (Just (EvalBreakpoint tick_mod tick_mod_uid (I# tickx#) info_mod info_mod_uid (I# infox#)))
+ pure (Just (EvalBreakpoint info_mod info_mod_uid (I# infox#)))
putMVar statusMVar $ EvalBreak apStack_r breakpoint resume_r ccs
takeMVar breakMVar
@@ -409,8 +407,8 @@ noBreakStablePtr :: StablePtr BreakpointCallback
noBreakStablePtr = unsafePerformIO $ newStablePtr noBreakAction
noBreakAction :: BreakpointCallback
-noBreakAction _ _ _ _ _ _ False _ = putStrLn "*** Ignoring breakpoint"
-noBreakAction _ _ _ _ _ _ True _ = return () -- exception: just continue
+noBreakAction _ _ _ False _ = putStrLn "*** Ignoring breakpoint"
+noBreakAction _ _ _ True _ = return () -- exception: just continue
-- Malloc and copy the bytes. We don't have any way to monitor the
-- lifetime of this memory, so it just leaks.
=====================================
rts/Disassembler.c
=====================================
@@ -84,16 +84,23 @@ disInstr ( StgBCO *bco, int pc )
switch (instr & 0xff) {
- case bci_BRK_FUN:
- debugBelch ("BRK_FUN " ); printPtr( ptrs[instrs[pc]] );
- debugBelch (" %d ", instrs[pc+1]); printPtr( ptrs[instrs[pc+2]] );
- CostCentre* cc = (CostCentre*)literals[instrs[pc+5]];
+ case bci_BRK_FUN: {
+ W_ p1, info_mod, info_unit_id, info_wix, np;
+ p1 = BCO_GET_LARGE_ARG;
+ info_mod = BCO_GET_LARGE_ARG;
+ info_unit_id = BCO_GET_LARGE_ARG;
+ info_wix = BCO_NEXT;
+ np = BCO_GET_LARGE_ARG;
+ debugBelch ("BRK_FUN " ); printPtr( ptrs[p1] );
+ debugBelch("%" FMT_Word, literals[info_mod] );
+ debugBelch("%" FMT_Word, literals[info_unit_id] );
+ debugBelch("%" FMT_Word, info_wix );
+ CostCentre* cc = (CostCentre*)literals[np];
if (cc) {
debugBelch(" %s", cc->label);
}
debugBelch("\n");
- pc += 6;
- break;
+ break; }
case bci_BRK_ALTS:
debugBelch ("BRK_ALTS %d\n", BCO_NEXT);
break;
=====================================
rts/Exception.cmm
=====================================
@@ -535,23 +535,17 @@ retry_pop_stack:
// be per-thread.
CInt[rts_stop_on_exception] = 0;
("ptr" ioAction) = ccall deRefStablePtr (W_[rts_breakpoint_io_action] "ptr");
- Sp = Sp - WDS(17);
- Sp(16) = exception;
- Sp(15) = stg_raise_ret_info;
- Sp(14) = exception;
- Sp(13) = ghczminternal_GHCziInternalziTypes_True_closure; // True <=> an exception
- Sp(12) = stg_ap_ppv_info;
- Sp(11) = 0;
- Sp(10) = stg_ap_n_info;
- Sp(9) = 0;
- Sp(8) = stg_ap_n_info;
- Sp(7) = 0;
- Sp(6) = stg_ap_n_info;
- Sp(5) = 0;
- Sp(4) = stg_ap_n_info;
- Sp(3) = 0;
- Sp(2) = stg_ap_n_info;
- Sp(1) = 0;
+ Sp = Sp - WDS(11);
+ Sp(10) = exception;
+ Sp(9) = stg_raise_ret_info;
+ Sp(8) = exception;
+ Sp(7) = ghczminternal_GHCziInternalziTypes_True_closure; // True <=> an exception
+ Sp(6) = stg_ap_ppv_info;
+ Sp(5) = 0;
+ Sp(4) = stg_ap_n_info;
+ Sp(3) = 0;
+ Sp(2) = stg_ap_n_info;
+ Sp(1) = 0;
R1 = ioAction;
jump RET_LBL(stg_ap_n) [R1];
}
=====================================
rts/Interpreter.c
=====================================
@@ -685,8 +685,6 @@ interpretBCO (Capability* cap)
*/
if (cap->r.rCurrentTSO->flags & TSO_STOP_AFTER_RETURN) {
- StgBCO* bco;
- StgWord16* bco_instrs;
StgHalfWord type;
/* Store the entry Sp; traverse the stack modifying Sp (using Sp macros);
@@ -706,28 +704,33 @@ interpretBCO (Capability* cap)
ASSERT(type == RET_BCO || type == STOP_FRAME);
if (type == RET_BCO) {
- bco = (StgBCO*)(SpW(1)); // BCO is first arg of a RET_BCO
+ StgBCO* bco = (StgBCO*)(SpW(1)); // BCO is first arg of a RET_BCO
ASSERT(get_itbl((StgClosure*)bco)->type == BCO);
- bco_instrs = (StgWord16*)(bco->instrs->payload);
+
+ StgWord16* instrs = (StgWord16*)(bco->instrs->payload);
+ StgWord16 bci = instrs[0];
/* A breakpoint instruction (BRK_FUN or BRK_ALTS) is always the first
* instruction in a BCO */
- if ((bco_instrs[0] & 0xFF) == bci_BRK_FUN) {
- int brk_array, tick_index;
- StgArrBytes *breakPoints;
- StgPtr* ptrs;
+ if ((bci & 0xFF) == bci_BRK_FUN) {
+ // Define rest of variables used by BCO_* Macros
+ int bciPtr = 0;
+
+ W_ arg1_brk_array, arg4_info_index;
+ arg1_brk_array = BCO_GET_LARGE_ARG;
+ /* info_mod_name = */ BCO_GET_LARGE_ARG;
+ /* info_mod_id = */ BCO_GET_LARGE_ARG;
+ arg4_info_index = BCO_NEXT;
- ptrs = (StgPtr*)(&bco->ptrs->payload[0]);
- brk_array = bco_instrs[1];
- tick_index = bco_instrs[6];
+ StgPtr* ptrs = (StgPtr*)(&bco->ptrs->payload[0]);
+ StgArrBytes* breakPoints = (StgArrBytes *) BCO_PTR(arg1_brk_array);
- breakPoints = (StgArrBytes *) BCO_PTR(brk_array);
// ACTIVATE the breakpoint by tick index
- ((StgInt*)breakPoints->payload)[tick_index] = 0;
+ ((StgInt*)breakPoints->payload)[arg4_info_index] = 0;
}
- else if ((bco_instrs[0] & 0xFF) == bci_BRK_ALTS) {
+ else if ((bci & 0xFF) == bci_BRK_ALTS) {
// ACTIVATE BRK_ALTS by setting its only argument to ON
- bco_instrs[1] = 1;
+ instrs[1] = 1;
}
// else: if there is no BRK instruction perhaps we should keep
// traversing; that said, the continuation should always have a BRK
@@ -1520,9 +1523,9 @@ run_BCO:
/* check for a breakpoint on the beginning of a let binding */
case bci_BRK_FUN:
{
- int arg1_brk_array, arg2_tick_mod, arg3_info_mod, arg4_tick_mod_id, arg5_info_mod_id, arg6_tick_index, arg7_info_index;
+ W_ arg1_brk_array, arg2_info_mod_name, arg3_info_mod_id, arg4_info_index;
#if defined(PROFILING)
- int arg8_cc;
+ W_ arg5_cc;
#endif
StgArrBytes *breakPoints;
int returning_from_break, stop_next_breakpoint;
@@ -1537,14 +1540,11 @@ run_BCO:
int size_words;
arg1_brk_array = BCO_GET_LARGE_ARG;
- arg2_tick_mod = BCO_GET_LARGE_ARG;
- arg3_info_mod = BCO_GET_LARGE_ARG;
- arg4_tick_mod_id = BCO_GET_LARGE_ARG;
- arg5_info_mod_id = BCO_GET_LARGE_ARG;
- arg6_tick_index = BCO_NEXT;
- arg7_info_index = BCO_NEXT;
+ arg2_info_mod_name = BCO_GET_LARGE_ARG;
+ arg3_info_mod_id = BCO_GET_LARGE_ARG;
+ arg4_info_index = BCO_NEXT;
#if defined(PROFILING)
- arg8_cc = BCO_GET_LARGE_ARG;
+ arg5_cc = BCO_GET_LARGE_ARG;
#else
BCO_GET_LARGE_ARG;
#endif
@@ -1564,7 +1564,7 @@ run_BCO:
#if defined(PROFILING)
cap->r.rCCCS = pushCostCentre(cap->r.rCCCS,
- (CostCentre*)BCO_LIT(arg8_cc));
+ (CostCentre*)BCO_LIT(arg5_cc));
#endif
// if we are returning from a break then skip this section
@@ -1575,11 +1575,11 @@ run_BCO:
// stop the current thread if either `stop_next_breakpoint` is
// true OR if the ignore count for this particular breakpoint is zero
- StgInt ignore_count = ((StgInt*)breakPoints->payload)[arg6_tick_index];
+ StgInt ignore_count = ((StgInt*)breakPoints->payload)[arg4_info_index];
if (stop_next_breakpoint == false && ignore_count > 0)
{
// decrement and write back ignore count
- ((StgInt*)breakPoints->payload)[arg6_tick_index] = --ignore_count;
+ ((StgInt*)breakPoints->payload)[arg4_info_index] = --ignore_count;
}
else if (stop_next_breakpoint == true || ignore_count == 0)
{
@@ -1613,10 +1613,7 @@ run_BCO:
// Arrange the stack to call the breakpoint IO action, and
// continue execution of this BCO when the IO action returns.
//
- // ioAction :: Addr# -- the breakpoint tick module
- // -> Addr# -- the breakpoint tick module unit id
- // -> Int# -- the breakpoint tick index
- // -> Addr# -- the breakpoint info module
+ // ioAction :: Addr# -- the breakpoint info module
// -> Addr# -- the breakpoint info module unit id
// -> Int# -- the breakpoint info index
// -> Bool -- exception?
@@ -1626,23 +1623,17 @@ run_BCO:
ioAction = (StgClosure *) deRefStablePtr (
rts_breakpoint_io_action);
- Sp_subW(19);
- SpW(18) = (W_)obj;
- SpW(17) = (W_)&stg_apply_interp_info;
- SpW(16) = (W_)new_aps;
- SpW(15) = (W_)False_closure; // True <=> an exception
- SpW(14) = (W_)&stg_ap_ppv_info;
- SpW(13) = (W_)arg7_info_index;
- SpW(12) = (W_)&stg_ap_n_info;
- SpW(11) = (W_)BCO_LIT(arg5_info_mod_id);
- SpW(10) = (W_)&stg_ap_n_info;
- SpW(9) = (W_)BCO_LIT(arg3_info_mod);
- SpW(8) = (W_)&stg_ap_n_info;
- SpW(7) = (W_)arg6_tick_index;
+ Sp_subW(13);
+ SpW(12) = (W_)obj;
+ SpW(11) = (W_)&stg_apply_interp_info;
+ SpW(10) = (W_)new_aps;
+ SpW(9) = (W_)False_closure; // True <=> an exception
+ SpW(8) = (W_)&stg_ap_ppv_info;
+ SpW(7) = (W_)arg4_info_index;
SpW(6) = (W_)&stg_ap_n_info;
- SpW(5) = (W_)BCO_LIT(arg4_tick_mod_id);
+ SpW(5) = (W_)BCO_LIT(arg3_info_mod_id);
SpW(4) = (W_)&stg_ap_n_info;
- SpW(3) = (W_)BCO_LIT(arg2_tick_mod);
+ SpW(3) = (W_)BCO_LIT(arg2_info_mod_name);
SpW(2) = (W_)&stg_ap_n_info;
SpW(1) = (W_)ioAction;
SpW(0) = (W_)&stg_enter_info;
=====================================
testsuite/tests/corelint/T21115b.stderr
=====================================
@@ -30,6 +30,6 @@ end Rec }
*** End of Offense ***
-
-<no location info>: error:
Compilation had errors
+
+
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2ff38e31949ed57c1c1f0af3461f78…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2ff38e31949ed57c1c1f0af3461f78…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/romes/step-out-10] debugger: Uniquely identify breakpoints by internal id
by Rodrigo Mesquita (＠alt-romes) 31 Jul '25
by Rodrigo Mesquita (＠alt-romes) 31 Jul '25
31 Jul '25
Rodrigo Mesquita pushed to branch wip/romes/step-out-10 at Glasgow Haskell Compiler / GHC
Commits:
d701c1f6 by Rodrigo Mesquita at 2025-07-31T23:03:14+01:00
debugger: Uniquely identify breakpoints by internal id
Since b85b11994e0130ff2401dd4bbdf52330e0bcf776 (support inlining
breakpoints), a breakpoint has been identified at runtime by *two* pairs
of <module,index>.
- The first, aka a 'BreakpointId', uniquely identifies a breakpoint in
the source of a module by using the Tick index. A Tick index can index
into ModBreaks.modBreaks_xxx to fetch source-level information about
where that tick originated.
- When a user specifies e.g. a line breakpoint using :break, we'll reverse
engineer what a Tick index for that line
- We update the `BreakArray` of that module (got from the
LoaderState) at that tick index to `breakOn`.
- A BCO we can stop at is headed by a BRK_FUN instruction. This
instruction stores in an operand the `tick index` it is associated
to. We look it up in the associated `BreakArray` (also an operand)
and check wheter it was set to `breakOn`.
- The second, aka the `ibi_info_mod` + `ibi_info_ix` of the
`InternalBreakpointId`, uniquely index into the `imodBreaks_breakInfo`
-- the information we gathered during code generation about the
existing breakpoint *ocurrences*.
- Note that with optimisation there may be many occurrences of the
same source-tick-breakpoint across different modules. The
`ibi_info_ix` is unique per occurrence, but the `bi_tick_ix` may be
shared. See Note [Breakpoint identifiers] about this.
- Note that besides the tick ids, info ids are also stored in
`BRK_FUN` so the break handler can refer to the associated
`CgBreakInfo`.
In light of that, the driving changes come from the desire to have the
info_id uniquely identify the breakpoint at runtime, and the source tick
id being derived from it:
- An InternalBreakpointId should uniquely identify a breakpoint just
from the code-generation identifiers of `ibi_info_ix` and `ibi_info_mod`.
So we drop `ibi_tick_mod` and `ibi_tick_ix`.
- A BRK_FUN instruction need only record the "internal breakpoint id",
not the tick-level id.
So we drop the tick mod and tick index operands.
- A BreakArray should be indexed by InternalBreakpointId rather than
BreakpointId
That means we need to do some more work when setting a breakpoint.
Specifically, we need to figure out the internal ids (occurrences of a
breakpoint) from the source-level BreakpointId we want to set the
breakpoint at (recall :break refers to breaks at the source level).
Besides this change being an improvement to the handling of breakpoints
(it's clearer to have a single unique identifier than two competing
ones), it unlocks the possibility of generating "internal" breakpoints
during Cg (needed for #26042).
It should also be easier to introduce multi-threaded-aware `BreakArrays`
following this change (needed for #26064).
Se also the new Note [ModBreaks vs InternalModBreaks]
On i386-linux:
-------------------------
Metric Decrease:
interpreter_steplocal
-------------------------
- - - - -
20 changed files:
- compiler/GHC/ByteCode/Asm.hs
- compiler/GHC/ByteCode/Breakpoints.hs
- compiler/GHC/ByteCode/Instr.hs
- compiler/GHC/ByteCode/Linker.hs
- compiler/GHC/ByteCode/Types.hs
- compiler/GHC/CoreToIface.hs
- compiler/GHC/HsToCore/Breakpoints.hs
- compiler/GHC/Linker/Loader.hs
- compiler/GHC/Runtime/Debugger/Breakpoints.hs
- compiler/GHC/Runtime/Eval.hs
- compiler/GHC/Runtime/Interpreter.hs
- compiler/GHC/StgToByteCode.hs
- ghc/GHCi/UI.hs
- ghc/GHCi/UI/Monad.hs
- libraries/ghci/GHCi/Debugger.hs
- libraries/ghci/GHCi/Message.hs
- libraries/ghci/GHCi/Run.hs
- rts/Disassembler.c
- rts/Exception.cmm
- rts/Interpreter.c
Changes:
=====================================
compiler/GHC/ByteCode/Asm.hs
=====================================
@@ -841,24 +841,18 @@ assembleI platform i = case i of
W8 -> emit_ bci_OP_INDEX_ADDR_08 []
_ -> unsupported_width
- BRK_FUN (InternalBreakpointId tick_mod tickx info_mod infox) -> do
+ BRK_FUN ibi@(InternalBreakpointId info_mod infox) -> do
+ p1 <- ptr $ BCOPtrBreakArray info_mod
let -- cast that checks that round-tripping through Word16 doesn't change the value
toW16 x = let r = fromIntegral x :: Word16
in if fromIntegral r == x
then r
else pprPanic "schemeER_wrk: breakpoint tick/info index too large!" (ppr x)
- p1 <- ptr $ BCOPtrBreakArray tick_mod
- tick_addr <- lit1 $ BCONPtrFS $ moduleNameFS $ moduleName tick_mod
- info_addr <- lit1 $ BCONPtrFS $ moduleNameFS $ moduleName info_mod
- tick_unitid_addr <- lit1 $ BCONPtrFS $ unitIdFS $ moduleUnitId $ tick_mod
- info_unitid_addr <- lit1 $ BCONPtrFS $ unitIdFS $ moduleUnitId $ info_mod
- np <- lit1 $ BCONPtrCostCentre (BreakpointId tick_mod tickx)
- emit_ bci_BRK_FUN [ Op p1
- , Op tick_addr, Op info_addr
- , Op tick_unitid_addr, Op info_unitid_addr
- , SmallOp (toW16 tickx), SmallOp (toW16 infox)
- , Op np
- ]
+ info_addr <- lit1 $ BCONPtrFS $ moduleNameFS $ moduleName info_mod
+ info_unitid_addr <- lit1 $ BCONPtrFS $ unitIdFS $ moduleUnitId info_mod
+ np <- lit1 $ BCONPtrCostCentre ibi
+ emit_ bci_BRK_FUN [ Op p1, Op info_addr, Op info_unitid_addr
+ , SmallOp (toW16 infox), Op np ]
BRK_ALTS active -> emit_ bci_BRK_ALTS [SmallOp (if active then 1 else 0)]
=====================================
compiler/GHC/ByteCode/Breakpoints.hs
=====================================
@@ -7,23 +7,23 @@
-- 'InternalModBreaks', and is uniquely identified at runtime by an
-- 'InternalBreakpointId'.
--
--- See Note [Breakpoint identifiers]
+-- See Note [ModBreaks vs InternalModBreaks] and Note [Breakpoint identifiers]
module GHC.ByteCode.Breakpoints
( -- * Internal Mod Breaks
InternalModBreaks(..), CgBreakInfo(..)
- , mkInternalModBreaks
+ , mkInternalModBreaks, imodBreaks_module
-- ** Internal breakpoint identifier
, InternalBreakpointId(..), BreakInfoIndex
-- * Operations
- , toBreakpointId
-- ** Internal-level operations
- , getInternalBreak, addInternalBreak
+ , getInternalBreak
-- ** Source-level information operations
, getBreakLoc, getBreakVars, getBreakDecls, getBreakCCS
+ , getBreakSourceId
-- * Utils
, seqInternalModBreaks
@@ -47,6 +47,31 @@ import GHC.Utils.Panic
import Data.Array
{-
+Note [ModBreaks vs InternalModBreaks]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+'ModBreaks' and 'BreakpointId's must not to be confused with
+'InternalModBreaks' and 'InternalBreakId's.
+
+'ModBreaks' is constructed once during HsToCore from the information attached
+to source-level breakpoint ticks and is never changed afterwards. A 'ModBreaks'
+can be queried using 'BreakpointId's, which uniquely identifies a breakpoint
+within the list of breakpoint information for a given module's 'ModBreaks'.
+
+'InternalModBreaks' are constructed during bytecode generation and are indexed
+by a 'InternalBreakpointId'. They contain all the information relevant to a
+breakpoint for code generation that can be accessed during runtime execution
+(such as a 'BreakArray' for triggering breakpoints). 'InternalBreakpointId's
+are used at runtime to trigger and inspect breakpoints -- a 'BRK_FUN'
+instruction receives 'InternalBreakpointId' as an argument.
+
+We keep a mapping from 'InternalModBreaks' to a 'BreakpointId', which can then be used
+to get source-level information about a breakpoint via the corresponding 'ModBreaks'.
+
+Notably, 'InternalModBreaks' can contain entries for so-called internal
+breakpoints, which do not necessarily have a source-level location attached to
+it (i.e. do not have a matching entry in 'ModBreaks'). We may leverage this to
+introduce breakpoints during code generation for features such as stepping-out.
+
Note [Breakpoint identifiers]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Before optimization a breakpoint is identified uniquely with a tick module
@@ -64,6 +89,10 @@ So every breakpoint occurrence gets assigned a module-unique *info index* and
we store it alongside the occurrence module (*info module*) in the
'InternalBreakpointId' datatype. This is the index that we use at runtime to
identify a breakpoint.
+
+When the internal breakpoint has a matching tick-level breakpoint we can fetch
+the related tick-level information by first looking up a mapping
+@'InternalBreakpointId' -> 'BreakpointId'@ in @'CgBreakInfo'@.
-}
--------------------------------------------------------------------------------
@@ -78,19 +107,11 @@ type BreakInfoIndex = Int
-- Indexes into the structures in the @'InternalModBreaks'@ produced during ByteCode generation.
-- See Note [Breakpoint identifiers]
data InternalBreakpointId = InternalBreakpointId
- { ibi_tick_mod :: !Module -- ^ Breakpoint tick module
- , ibi_tick_index :: !Int -- ^ Breakpoint tick index
- , ibi_info_mod :: !Module -- ^ Breakpoint tick module
- , ibi_info_index :: !BreakInfoIndex -- ^ Breakpoint tick index
+ { ibi_info_mod :: !Module -- ^ Breakpoint info module
+ , ibi_info_index :: !BreakInfoIndex -- ^ Breakpoint info index
}
deriving (Eq, Ord)
-toBreakpointId :: InternalBreakpointId -> BreakpointId
-toBreakpointId ibi = BreakpointId
- { bi_tick_mod = ibi_tick_mod ibi
- , bi_tick_index = ibi_tick_index ibi
- }
-
--------------------------------------------------------------------------------
-- * Internal Mod Breaks
--------------------------------------------------------------------------------
@@ -107,18 +128,34 @@ data InternalModBreaks = InternalModBreaks
-- 'InternalBreakpointId'.
, imodBreaks_modBreaks :: !ModBreaks
- -- ^ Store the original ModBreaks for this module, unchanged.
- -- Allows us to query about source-level breakpoint information using
- -- an internal breakpoint id.
+ -- ^ Store the ModBreaks for this module
+ --
+ -- Recall Note [Breakpoint identifiers]: for some module A, an
+ -- *occurrence* of a breakpoint in A may have been inlined from some
+ -- breakpoint *defined* in module B.
+ --
+ -- This 'ModBreaks' contains information regarding all the breakpoints
+ -- defined in the module this 'InternalModBreaks' corresponds to. It
+ -- /does not/ necessarily have information regarding all the breakpoint
+ -- occurrences registered in 'imodBreaks_breakInfo'. Some of those
+ -- occurrences may refer breakpoints inlined from other modules.
}
--- | Construct an 'InternalModBreaks'
+-- | Construct an 'InternalModBreaks'.
+--
+-- INVARIANT: The given 'ModBreaks' correspond to the same module as this
+-- 'InternalModBreaks' module (the first argument) and its breakpoint infos
+-- (the @IntMap CgBreakInfo@ argument)
mkInternalModBreaks :: Module -> IntMap CgBreakInfo -> ModBreaks -> InternalModBreaks
mkInternalModBreaks mod im mbs =
assertPpr (mod == modBreaks_module mbs)
(text "Constructing InternalModBreaks with the ModBreaks of a different module!") $
InternalModBreaks im mbs
+-- | Get the module to which these 'InternalModBreaks' correspond
+imodBreaks_module :: InternalModBreaks -> Module
+imodBreaks_module = modBreaks_module . imodBreaks_modBreaks
+
-- | Information about a breakpoint that we know at code-generation time
-- In order to be used, this needs to be hydrated relative to the current HscEnv by
-- 'hydrateCgBreakInfo'. Everything here can be fully forced and that's critical for
@@ -128,20 +165,22 @@ data CgBreakInfo
{ cgb_tyvars :: ![IfaceTvBndr] -- ^ Type variables in scope at the breakpoint
, cgb_vars :: ![Maybe (IfaceIdBndr, Word)]
, cgb_resty :: !IfaceType
+ , cgb_tick_id :: !BreakpointId
+ -- ^ This field records the original breakpoint tick identifier for this
+ -- internal breakpoint info. It is used to convert a breakpoint
+ -- *occurrence* index ('InternalBreakpointId') into a *definition* index
+ -- ('BreakpointId').
+ --
+ -- The modules of breakpoint occurrence and breakpoint definition are not
+ -- necessarily the same: See Note [Breakpoint identifiers].
}
-- See Note [Syncing breakpoint info] in GHC.Runtime.Eval
-- | Get an internal breakpoint info by 'InternalBreakpointId'
getInternalBreak :: InternalBreakpointId -> InternalModBreaks -> CgBreakInfo
-getInternalBreak (InternalBreakpointId _ _ info_mod info_ix) imbs =
- assert_modules_match info_mod (modBreaks_module $ imodBreaks_modBreaks imbs) $
- imodBreaks_breakInfo imbs IM.! info_ix
-
--- | Add a CgBreakInfo to an 'InternalModBreaks' at 'InternalBreakpointId'
-addInternalBreak :: InternalBreakpointId -> CgBreakInfo -> InternalModBreaks -> InternalModBreaks
-addInternalBreak (InternalBreakpointId _ _ info_mod info_ix) info imbs =
- assert_modules_match info_mod (modBreaks_module $ imodBreaks_modBreaks imbs) $
- imbs{imodBreaks_breakInfo = IM.insert info_ix info (imodBreaks_breakInfo imbs)}
+getInternalBreak (InternalBreakpointId mod ix) imbs =
+ assert_modules_match mod (imodBreaks_module imbs) $
+ imodBreaks_breakInfo imbs IM.! ix
-- | Assert that the module in the 'InternalBreakpointId' and in
-- 'InternalModBreaks' match.
@@ -155,27 +194,56 @@ assert_modules_match ibi_mod imbs_mod =
-- Tick-level Breakpoint information
--------------------------------------------------------------------------------
+-- | Get the source module and tick index for this breakpoint
+-- (as opposed to the module where this breakpoint occurs, which is in 'InternalBreakpointId')
+getBreakSourceId :: InternalBreakpointId -> InternalModBreaks -> BreakpointId
+getBreakSourceId (InternalBreakpointId ibi_mod ibi_ix) imbs =
+ assert_modules_match ibi_mod (imodBreaks_module imbs) $
+ let cgb = imodBreaks_breakInfo imbs IM.! ibi_ix
+ in cgb_tick_id cgb
+
-- | Get the source span for this breakpoint
-getBreakLoc :: InternalBreakpointId -> InternalModBreaks -> SrcSpan
+getBreakLoc :: (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO SrcSpan
getBreakLoc = getBreakXXX modBreaks_locs
-- | Get the vars for this breakpoint
-getBreakVars :: InternalBreakpointId -> InternalModBreaks -> [OccName]
+getBreakVars :: (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO [OccName]
getBreakVars = getBreakXXX modBreaks_vars
-- | Get the decls for this breakpoint
-getBreakDecls :: InternalBreakpointId -> InternalModBreaks -> [String]
+getBreakDecls :: (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO [String]
getBreakDecls = getBreakXXX modBreaks_decls
-- | Get the decls for this breakpoint
-getBreakCCS :: InternalBreakpointId -> InternalModBreaks -> (String, String)
+getBreakCCS :: (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO (String, String)
getBreakCCS = getBreakXXX modBreaks_ccs
-- | Internal utility to access a ModBreaks field at a particular breakpoint index
-getBreakXXX :: (ModBreaks -> Array BreakTickIndex a) -> InternalBreakpointId -> InternalModBreaks -> a
-getBreakXXX view (InternalBreakpointId tick_mod tick_id _ _) imbs =
- assert_modules_match tick_mod (modBreaks_module $ imodBreaks_modBreaks imbs) $ do
- view (imodBreaks_modBreaks imbs) ! tick_id
+--
+-- Recall Note [Breakpoint identifiers]: the internal breakpoint module (the
+-- *occurrence* module) doesn't necessarily match the module where the
+-- tick breakpoint was defined with the relevant 'ModBreaks'.
+--
+-- When the tick module is the same as the internal module, we use the stored
+-- 'ModBreaks'. When the tick module is different, we need to look up the
+-- 'ModBreaks' in the HUG for that other module.
+--
+-- To avoid cyclic dependencies, we instead receive a function that looks up
+-- the 'ModBreaks' given a 'Module'
+getBreakXXX :: (ModBreaks -> Array BreakTickIndex a) -> (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO a
+getBreakXXX view lookupModule (InternalBreakpointId ibi_mod ibi_ix) imbs =
+ assert_modules_match ibi_mod (imodBreaks_module imbs) $ do
+ let cgb = imodBreaks_breakInfo imbs IM.! ibi_ix
+ case cgb_tick_id cgb of
+ BreakpointId{bi_tick_mod, bi_tick_index}
+ | bi_tick_mod == ibi_mod
+ -> do
+ let these_mbs = imodBreaks_modBreaks imbs
+ return $ view these_mbs ! bi_tick_index
+ | otherwise
+ -> do
+ other_mbs <- lookupModule bi_tick_mod
+ return $ view other_mbs ! bi_tick_index
--------------------------------------------------------------------------------
-- Instances
@@ -190,7 +258,8 @@ seqInternalModBreaks InternalModBreaks{..} =
seqCgBreakInfo CgBreakInfo{..} =
rnf cgb_tyvars `seq`
rnf cgb_vars `seq`
- rnf cgb_resty
+ rnf cgb_resty `seq`
+ rnf cgb_tick_id
instance Outputable InternalBreakpointId where
ppr InternalBreakpointId{..} =
@@ -203,4 +272,5 @@ instance NFData InternalBreakpointId where
instance Outputable CgBreakInfo where
ppr info = text "CgBreakInfo" <+>
parens (ppr (cgb_vars info) <+>
- ppr (cgb_resty info))
+ ppr (cgb_resty info) <+>
+ ppr (cgb_tick_id info))
=====================================
compiler/GHC/ByteCode/Instr.hs
=====================================
@@ -454,9 +454,8 @@ instance Outputable BCInstr where
ppr ENTER = text "ENTER"
ppr (RETURN pk) = text "RETURN " <+> ppr pk
ppr (RETURN_TUPLE) = text "RETURN_TUPLE"
- ppr (BRK_FUN (InternalBreakpointId tick_mod tickx info_mod infox))
+ ppr (BRK_FUN (InternalBreakpointId info_mod infox))
= text "BRK_FUN" <+> text "<breakarray>"
- <+> ppr tick_mod <+> ppr tickx
<+> ppr info_mod <+> ppr infox
<+> text "<cc>"
ppr (BRK_ALTS active) = text "BRK_ALTS" <+> ppr active
=====================================
compiler/GHC/ByteCode/Linker.hs
=====================================
@@ -98,9 +98,9 @@ lookupLiteral interp pkgs_loaded le lb ptr = case ptr of
BCONPtrFFIInfo (FFIInfo {..}) -> do
RemotePtr p <- interpCmd interp $ PrepFFI ffiInfoArgs ffiInfoRet
pure $ fromIntegral p
- BCONPtrCostCentre BreakpointId{..}
+ BCONPtrCostCentre InternalBreakpointId{..}
| interpreterProfiled interp -> do
- case expectJust (lookupModuleEnv (ccs_env lb) bi_tick_mod) ! bi_tick_index of
+ case expectJust (lookupModuleEnv (ccs_env lb) ibi_info_mod) ! ibi_info_index of
RemotePtr p -> pure $ fromIntegral p
| otherwise ->
case toRemotePtr nullPtr of
=====================================
compiler/GHC/ByteCode/Types.hs
=====================================
@@ -285,7 +285,7 @@ data BCONPtr
-- | A libffi ffi_cif function prototype.
| BCONPtrFFIInfo !FFIInfo
-- | A 'CostCentre' remote pointer array's respective 'BreakpointId'
- | BCONPtrCostCentre !BreakpointId
+ | BCONPtrCostCentre !InternalBreakpointId
instance NFData BCONPtr where
rnf x = x `seq` ()
=====================================
compiler/GHC/CoreToIface.hs
=====================================
@@ -704,12 +704,13 @@ toIfaceLFInfo nm lfi = case lfi of
-- Dehydrating CgBreakInfo
-dehydrateCgBreakInfo :: [TyVar] -> [Maybe (Id, Word)] -> Type -> CgBreakInfo
-dehydrateCgBreakInfo ty_vars idOffSets tick_ty =
+dehydrateCgBreakInfo :: [TyVar] -> [Maybe (Id, Word)] -> Type -> BreakpointId -> CgBreakInfo
+dehydrateCgBreakInfo ty_vars idOffSets tick_ty bid =
CgBreakInfo
{ cgb_tyvars = map toIfaceTvBndr ty_vars
, cgb_vars = map (fmap (\(i, offset) -> (toIfaceIdBndr i, offset))) idOffSets
, cgb_resty = toIfaceType tick_ty
+ , cgb_tick_id = bid
}
{- Note [Inlining and hs-boot files]
=====================================
compiler/GHC/HsToCore/Breakpoints.hs
=====================================
@@ -12,7 +12,7 @@
-- 'InternalModBreaks' and 'InternalBreakId's. The latter are constructed
-- during bytecode generation and can be found in 'GHC.ByteCode.Breakpoints'.
--
--- See Note [Breakpoint identifiers]
+-- See Note [ModBreaks vs InternalModBreaks] and Note [Breakpoint identifiers]
module GHC.HsToCore.Breakpoints
( -- * ModBreaks
mkModBreaks, ModBreaks(..)
=====================================
compiler/GHC/Linker/Loader.hs
=====================================
@@ -124,7 +124,9 @@ import GHC.Utils.Exception
import GHC.Unit.Home.Graph (lookupHug, unitEnv_foldWithKey)
import GHC.Driver.Downsweep
import qualified GHC.Runtime.Interpreter as GHCi
-import Data.Array.Base (numElements)
+import qualified Data.IntMap.Strict as IM
+import qualified Data.Map.Strict as M
+import Foreign.Ptr (nullPtr)
-- Note [Linkers and loaders]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -1666,10 +1668,10 @@ allocateBreakArrays ::
IO (ModuleEnv (ForeignRef BreakArray))
allocateBreakArrays interp =
foldlM
- ( \be0 InternalModBreaks{imodBreaks_modBreaks=ModBreaks {..}} -> do
+ ( \be0 InternalModBreaks{imodBreaks_breakInfo, imodBreaks_modBreaks=ModBreaks {..}} -> do
-- If no BreakArray is assigned to this module yet, create one
if not $ elemModuleEnv modBreaks_module be0 then do
- let count = numElements modBreaks_locs
+ let count = maybe 0 ((+1) . fst) $ IM.lookupMax imodBreaks_breakInfo
breakArray <- GHCi.newBreakArray interp count
evaluate $ extendModuleEnv be0 modBreaks_module breakArray
else
@@ -1679,29 +1681,51 @@ allocateBreakArrays interp =
-- | Given a list of 'InternalModBreaks' collected from a list
-- of 'CompiledByteCode', allocate the 'CostCentre' arrays when profiling is
-- enabled.
+--
+-- Note that the resulting arrays are indexed by 'BreakInfoIndex' (internal
+-- breakpoint index), not by tick index
allocateCCS ::
Interp ->
- ModuleEnv (Array BreakTickIndex (RemotePtr CostCentre)) ->
+ ModuleEnv (Array BreakInfoIndex (RemotePtr CostCentre)) ->
[InternalModBreaks] ->
- IO (ModuleEnv (Array BreakTickIndex (RemotePtr CostCentre)))
+ IO (ModuleEnv (Array BreakInfoIndex (RemotePtr CostCentre)))
allocateCCS interp ce mbss
- | interpreterProfiled interp =
- foldlM
- ( \ce0 InternalModBreaks{imodBreaks_modBreaks=ModBreaks {..}} -> do
- ccs <-
+ | interpreterProfiled interp = do
+ -- 1. Create a mapping from source BreakpointId to CostCentre ptr
+ ccss <- M.unions <$> mapM
+ ( \InternalModBreaks{imodBreaks_modBreaks=ModBreaks{..}} -> do
+ ccs <- {- one ccs ptr per tick index -}
mkCostCentres
interp
(moduleNameString $ moduleName modBreaks_module)
(elems modBreaks_ccs)
- if not $ elemModuleEnv modBreaks_module ce0 then do
- evaluate $
- extendModuleEnv ce0 modBreaks_module $
- listArray
- (0, length ccs - 1)
- ccs
+ return $ M.fromList $
+ zipWith (\el ix -> (BreakpointId modBreaks_module ix, el)) ccs [0..]
+ )
+ mbss
+ -- 2. Create an array with one element for every InternalBreakpointId,
+ -- where every element has the CCS for the corresponding BreakpointId
+ foldlM
+ (\ce0 InternalModBreaks{imodBreaks_breakInfo, imodBreaks_modBreaks=ModBreaks{..}} -> do
+ if not $ elemModuleEnv modBreaks_module ce then do
+ let count = maybe 0 ((+1) . fst) $ IM.lookupMax imodBreaks_breakInfo
+ let ccs = IM.map
+ (\info ->
+ fromMaybe (toRemotePtr nullPtr)
+ (M.lookup (cgb_tick_id info) ccss)
+ )
+ imodBreaks_breakInfo
+ assertPpr (count == length ccs)
+ (text "expected CgBreakInfo map to have one entry per valid ix") $
+ evaluate $
+ extendModuleEnv ce0 modBreaks_module $
+ listArray
+ (0, count)
+ (IM.elems ccs)
else
return ce0
)
ce
mbss
+
| otherwise = pure ce
=====================================
compiler/GHC/Runtime/Debugger/Breakpoints.hs
=====================================
@@ -31,6 +31,9 @@ import GHC.Unit.Module.ModSummary
import GHC.Utils.Outputable
import GHC.Utils.Panic
import qualified GHC.Data.Strict as Strict
+import qualified Data.IntMap.Strict as IntMap
+import qualified GHC.Unit.Home.Graph as HUG
+import qualified GHC.Unit.Home.PackageTable as HPT
--------------------------------------------------------------------------------
-- Finding Module breakpoints
@@ -213,6 +216,47 @@ getModBreak m = do
mod_info <- fromMaybe (panic "getModBreak") <$> getModuleInfo m
pure $ imodBreaks_modBreaks <$> modInfoModBreaks mod_info
+--------------------------------------------------------------------------------
+-- Mapping source-level BreakpointIds to IBI occurrences
+-- (See Note [Breakpoint identifiers])
+--------------------------------------------------------------------------------
+
+-- | A source-level breakpoint may have been inlined into many occurrences, now
+-- referred by 'InternalBreakpointId'. When a breakpoint is set on a certain
+-- source breakpoint, it means all *ocurrences* of that breakpoint across
+-- modules should be stopped at -- hence we keep a trie from BreakpointId to
+-- the list of internal break ids using it.
+-- See also Note [Breakpoint identifiers]
+type BreakpointOccurrences = ModuleEnv (IntMap.IntMap [InternalBreakpointId])
+
+-- | Lookup all InternalBreakpointIds matching the given BreakpointId
+-- Nothing if BreakpointId not in map
+lookupBreakpointOccurrences :: BreakpointOccurrences -> BreakpointId -> Maybe [InternalBreakpointId]
+lookupBreakpointOccurrences bmp (BreakpointId md tick) =
+ lookupModuleEnv bmp md >>= IntMap.lookup tick
+
+-- | Construct a mapping from Source 'BreakpointId's to 'InternalBreakpointId's from the given list of 'ModInfo's
+mkBreakpointOccurrences :: forall m. GhcMonad m => m BreakpointOccurrences
+mkBreakpointOccurrences = do
+ hug <- hsc_HUG <$> getSession
+ liftIO $ foldr go (pure emptyModuleEnv) hug
+ where
+ go :: HUG.HomeUnitEnv -> IO BreakpointOccurrences -> IO BreakpointOccurrences
+ go hue mbmp = do
+ bmp <- mbmp
+ ibrkss <- HPT.concatHpt (\hmi -> maybeToList (getModBreaks hmi))
+ (HUG.homeUnitEnv_hpt hue)
+ return $ foldr addBreakToMap bmp ibrkss
+
+ addBreakToMap :: InternalModBreaks -> BreakpointOccurrences -> BreakpointOccurrences
+ addBreakToMap ibrks bmp0 = do
+ let imod = modBreaks_module $ imodBreaks_modBreaks ibrks
+ IntMap.foldrWithKey (\info_ix cgi bmp -> do
+ let ibi = InternalBreakpointId imod info_ix
+ let BreakpointId tick_mod tick_ix = cgb_tick_id cgi
+ extendModuleEnvWith (IntMap.unionWith (S.<>)) bmp tick_mod (IntMap.singleton tick_ix [ibi])
+ ) bmp0 (imodBreaks_breakInfo ibrks)
+
--------------------------------------------------------------------------------
-- Getting current breakpoint information
--------------------------------------------------------------------------------
@@ -235,9 +279,15 @@ getCurrentBreakSpan = do
getCurrentBreakModule :: GhcMonad m => m (Maybe Module)
getCurrentBreakModule = do
resumes <- getResumeContext
- return $ case resumes of
- [] -> Nothing
+ hug <- hsc_HUG <$> getSession
+ liftIO $ case resumes of
+ [] -> pure Nothing
(r:_) -> case resumeHistoryIx r of
- 0 -> ibi_tick_mod <$> resumeBreakpointId r
- ix -> Just $ getHistoryModule $ resumeHistory r !! (ix-1)
+ 0 -> case resumeBreakpointId r of
+ Nothing -> pure Nothing
+ Just ibi -> do
+ brks <- readIModBreaks hug ibi
+ return $ Just $ bi_tick_mod $ getBreakSourceId ibi brks
+ ix ->
+ Just <$> getHistoryModule hug (resumeHistory r !! (ix-1))
=====================================
compiler/GHC/Runtime/Eval.hs
=====================================
@@ -18,7 +18,7 @@ module GHC.Runtime.Eval (
abandon, abandonAll,
getResumeContext,
getHistorySpan,
- getModBreaks, readModBreaks,
+ getModBreaks, readIModBreaks, readIModModBreaks,
getHistoryModule,
setupBreakpoint,
back, forward,
@@ -147,14 +147,17 @@ getResumeContext = withSession (return . ic_resume . hsc_IC)
mkHistory :: HUG.HomeUnitGraph -> ForeignHValue -> InternalBreakpointId -> IO History
mkHistory hug hval ibi = History hval ibi <$> findEnclosingDecls hug ibi
-getHistoryModule :: History -> Module
-getHistoryModule = ibi_tick_mod . historyBreakpointId
+getHistoryModule :: HUG.HomeUnitGraph -> History -> IO Module
+getHistoryModule hug hist = do
+ let ibi = historyBreakpointId hist
+ brks <- readIModBreaks hug ibi
+ return $ bi_tick_mod $ getBreakSourceId ibi brks
getHistorySpan :: HUG.HomeUnitGraph -> History -> IO SrcSpan
getHistorySpan hug hist = do
let ibi = historyBreakpointId hist
- brks <- readModBreaks hug (ibi_tick_mod ibi)
- return $ getBreakLoc ibi brks
+ brks <- readIModBreaks hug ibi
+ getBreakLoc (readIModModBreaks hug) ibi brks
{- | Finds the enclosing top level function name -}
-- ToDo: a better way to do this would be to keep hold of the decl_path computed
@@ -162,8 +165,8 @@ getHistorySpan hug hist = do
-- for each tick.
findEnclosingDecls :: HUG.HomeUnitGraph -> InternalBreakpointId -> IO [String]
findEnclosingDecls hug ibi = do
- brks <- readModBreaks hug (ibi_tick_mod ibi)
- return $ getBreakDecls ibi brks
+ brks <- readIModBreaks hug ibi
+ getBreakDecls (readIModModBreaks hug) ibi brks
-- | Update fixity environment in the current interactive context.
updateFixityEnv :: GhcMonad m => FixityEnv -> m ()
@@ -350,15 +353,14 @@ handleRunStatus step expr bindings final_ids status history0 = do
EvalBreak apStack_ref (Just eval_break) resume_ctxt ccs -> do
let ibi = evalBreakpointToId eval_break
let hug = hsc_HUG hsc_env
- tick_brks <- liftIO $ readModBreaks hug (ibi_tick_mod ibi)
- let
- span = getBreakLoc ibi tick_brks
- decl = intercalate "." $ getBreakDecls ibi tick_brks
+ info_brks <- liftIO $ readIModBreaks hug ibi
+ span <- liftIO $ getBreakLoc (readIModModBreaks hug) ibi info_brks
+ decl <- liftIO $ intercalate "." <$> getBreakDecls (readIModModBreaks hug) ibi info_brks
-- Was this breakpoint explicitly enabled (ie. in @BreakArray@)?
bactive <- liftIO $ do
- breakArray <- getBreakArray interp (toBreakpointId ibi) tick_brks
- breakpointStatus interp breakArray (ibi_tick_index ibi)
+ breakArray <- getBreakArray interp ibi info_brks
+ breakpointStatus interp breakArray (ibi_info_index ibi)
apStack_fhv <- liftIO $ mkFinalizedHValue interp apStack_ref
resume_ctxt_fhv <- liftIO $ mkFinalizedHValue interp resume_ctxt
@@ -446,7 +448,7 @@ resumeExec step mbCnt
-- When the user specified a break ignore count, set it
-- in the interpreter
case (mb_brkpt, mbCnt) of
- (Just brkpt, Just cnt) -> setupBreakpoint interp (toBreakpointId brkpt) cnt
+ (Just brkpt, Just cnt) -> setupBreakpoint interp brkpt cnt
_ -> return ()
let eval_opts = initEvalOpts dflags (enableGhcStepMode step)
@@ -462,17 +464,18 @@ resumeExec step mbCnt
| otherwise -> pure prevHistoryLst
handleRunStatus step expr bindings final_ids status =<< hist'
-setupBreakpoint :: GhcMonad m => Interp -> BreakpointId -> Int -> m () -- #19157
-setupBreakpoint interp bi cnt = do
+setupBreakpoint :: GhcMonad m => Interp -> InternalBreakpointId -> Int -> m () -- #19157
+setupBreakpoint interp ibi cnt = do
hug <- hsc_HUG <$> getSession
- modBreaks <- liftIO $ readModBreaks hug (bi_tick_mod bi)
- breakArray <- liftIO $ getBreakArray interp bi modBreaks
- liftIO $ GHCi.storeBreakpoint interp breakArray (bi_tick_index bi) cnt
+ liftIO $ do
+ modBreaks <- readIModBreaks hug ibi
+ breakArray <- getBreakArray interp ibi modBreaks
+ GHCi.storeBreakpoint interp breakArray (ibi_info_index ibi) cnt
-getBreakArray :: Interp -> BreakpointId -> InternalModBreaks -> IO (ForeignRef BreakArray)
-getBreakArray interp BreakpointId{bi_tick_mod} imbs = do
+getBreakArray :: Interp -> InternalBreakpointId -> InternalModBreaks -> IO (ForeignRef BreakArray)
+getBreakArray interp InternalBreakpointId{ibi_info_mod} imbs = do
breaks0 <- linked_breaks . fromMaybe (panic "Loader not initialised") <$> getLoaderState interp
- case lookupModuleEnv (breakarray_env breaks0) bi_tick_mod of
+ case lookupModuleEnv (breakarray_env breaks0) ibi_info_mod of
Just ba -> return ba
Nothing -> do
modifyLoaderState interp $ \ld_st -> do
@@ -483,13 +486,12 @@ getBreakArray interp BreakpointId{bi_tick_mod} imbs = do
ba_env <- allocateBreakArrays interp (breakarray_env lb) [imbs]
let ld_st' = ld_st { linked_breaks = lb{breakarray_env = ba_env} }
- let ba = expectJust {- just computed -} $ lookupModuleEnv ba_env bi_tick_mod
+ let ba = expectJust {- just computed -} $ lookupModuleEnv ba_env ibi_info_mod
return
( ld_st'
, ba
)
-
back :: GhcMonad m => Int -> m ([Name], Int, SrcSpan)
back n = moveHist (+n)
@@ -517,8 +519,9 @@ moveHist fn = do
span <- case mb_info of
Nothing -> return $ mkGeneralSrcSpan (fsLit "<unknown>")
Just ibi -> liftIO $ do
- brks <- readModBreaks (hsc_HUG hsc_env) (ibi_tick_mod ibi)
- return $ getBreakLoc ibi brks
+ let hug = hsc_HUG hsc_env
+ brks <- readIModBreaks hug ibi
+ getBreakLoc (readIModModBreaks hug) ibi brks
(hsc_env1, names) <-
liftIO $ bindLocalsAtBreakpoint hsc_env apStack span mb_info
let ic = hsc_IC hsc_env1
@@ -579,11 +582,10 @@ bindLocalsAtBreakpoint hsc_env apStack span Nothing = do
-- of the breakpoint and the free variables of the expression.
bindLocalsAtBreakpoint hsc_env apStack_fhv span (Just ibi) = do
let hug = hsc_HUG hsc_env
- info_brks <- readModBreaks hug (ibi_info_mod ibi)
- tick_brks <- readModBreaks hug (ibi_tick_mod ibi)
- let info = getInternalBreak ibi (info_brks)
+ info_brks <- readIModBreaks hug ibi
+ let info = getInternalBreak ibi info_brks
interp = hscInterp hsc_env
- occs = getBreakVars ibi tick_brks
+ occs <- getBreakVars (readIModModBreaks hug) ibi info_brks
-- Rehydrate to understand the breakpoint info relative to the current environment.
-- This design is critical to preventing leaks (#22530)
=====================================
compiler/GHC/Runtime/Interpreter.hs
=====================================
@@ -27,7 +27,9 @@ module GHC.Runtime.Interpreter
, getClosure
, whereFrom
, getModBreaks
- , readModBreaks
+ , readIModBreaks
+ , readIModBreaksMaybe
+ , readIModModBreaks
, seqHValue
, evalBreakpointToId
@@ -92,7 +94,6 @@ import GHC.Utils.Fingerprint
import GHC.Unit.Module
import GHC.Unit.Home.ModInfo
-import GHC.Unit.Home.Graph (lookupHugByModule)
import GHC.Unit.Env
#if defined(HAVE_INTERNAL_INTERPRETER)
@@ -411,15 +412,10 @@ evalBreakpointToId :: EvalBreakpoint -> InternalBreakpointId
evalBreakpointToId eval_break =
let
mkUnitId u = fsToUnit $ mkFastStringShortByteString u
-
toModule u n = mkModule (mkUnitId u) (mkModuleName n)
- tickl = toModule (eb_tick_mod_unit eval_break) (eb_tick_mod eval_break)
- infol = toModule (eb_info_mod_unit eval_break) (eb_info_mod eval_break)
in
InternalBreakpointId
- { ibi_tick_mod = tickl
- , ibi_tick_index = eb_tick_index eval_break
- , ibi_info_mod = infol
+ { ibi_info_mod = toModule (eb_info_mod_unit eval_break) (eb_info_mod eval_break)
, ibi_info_index = eb_info_index eval_break
}
@@ -440,17 +436,18 @@ handleSeqHValueStatus interp unit_env eval_status =
-- Reason: Setting of flags in libraries/ghci/GHCi/Run.hs:evalOptsSeq
Just break -> do
- let bi = evalBreakpointToId break
+ let ibi = evalBreakpointToId break
+ hug = ue_home_unit_graph unit_env
-- Just case: Stopped at a breakpoint, extract SrcSpan information
-- from the breakpoint.
- mb_modbreaks <- getModBreaks . expectJust <$>
- lookupHugByModule (ibi_tick_mod bi) (ue_home_unit_graph unit_env)
+ mb_modbreaks <- readIModBreaksMaybe hug (ibi_info_mod ibi)
case mb_modbreaks of
-- Nothing case - should not occur! We should have the appropriate
-- breakpoint information
Nothing -> nothing_case
- Just modbreaks -> put $ brackets . ppr $ getBreakLoc bi modbreaks
+ Just modbreaks -> put . brackets . ppr =<<
+ getBreakLoc (readIModModBreaks hug) ibi modbreaks
-- resume the seq (:force) processing in the iserv process
withForeignRef resume_ctxt_fhv $ \hval -> do
@@ -745,10 +742,18 @@ getModBreaks hmi
| otherwise
= Nothing -- probably object code
--- | Read the 'InternalModBreaks' and 'ModBreaks' of the given home 'Module'
--- from the 'HomeUnitGraph'.
-readModBreaks :: HomeUnitGraph -> Module -> IO InternalModBreaks
-readModBreaks hug modl = expectJust . getModBreaks . expectJust <$> HUG.lookupHugByModule modl hug
+-- | Read the 'InternalModBreaks' of the given home 'Module' (via
+-- 'InternalBreakpointId') from the 'HomeUnitGraph'.
+readIModBreaks :: HomeUnitGraph -> InternalBreakpointId -> IO InternalModBreaks
+readIModBreaks hug ibi = expectJust <$> readIModBreaksMaybe hug (ibi_info_mod ibi)
+
+-- | Read the 'InternalModBreaks' of the given home 'Module' from the 'HomeUnitGraph'.
+readIModBreaksMaybe :: HomeUnitGraph -> Module -> IO (Maybe InternalModBreaks)
+readIModBreaksMaybe hug mod = getModBreaks . expectJust <$> HUG.lookupHugByModule mod hug
+
+-- | Read the 'ModBreaks' from the given module's 'InternalModBreaks'
+readIModModBreaks :: HUG.HomeUnitGraph -> Module -> IO ModBreaks
+readIModModBreaks hug mod = imodBreaks_modBreaks . expectJust <$> readIModBreaksMaybe hug mod
-- -----------------------------------------------------------------------------
-- Misc utils
=====================================
compiler/GHC/StgToByteCode.hs
=====================================
@@ -31,7 +31,6 @@ import GHC.Cmm.Utils
import GHC.Platform
import GHC.Platform.Profile
-import GHC.Runtime.Interpreter
import GHCi.FFI
import GHC.Types.Basic
import GHC.Utils.Outputable
@@ -64,6 +63,7 @@ import GHC.StgToCmm.Closure ( NonVoid(..), fromNonVoid, idPrimRepU,
assertNonVoidIds, assertNonVoidStgArgs )
import GHC.StgToCmm.Layout
import GHC.Runtime.Heap.Layout hiding (WordOff, ByteOff, wordsToBytes)
+import GHC.Runtime.Interpreter ( interpreterProfiled )
import GHC.Data.Bitmap
import GHC.Data.FlatBag as FlatBag
import GHC.Data.OrdList
@@ -79,7 +79,6 @@ import Control.Monad
import Data.Char
import GHC.Unit.Module
-import qualified GHC.Unit.Home.Graph as HUG
import Data.Coerce (coerce)
#if MIN_VERSION_rts(1,0,3)
@@ -394,65 +393,28 @@ schemeR_wrk fvs nm original_body (args, body)
-- | Introduce break instructions for ticked expressions.
-- If no breakpoint information is available, the instruction is omitted.
schemeER_wrk :: StackDepth -> BCEnv -> CgStgExpr -> BcM BCInstrList
-schemeER_wrk d p (StgTick (Breakpoint tick_ty (BreakpointId tick_mod tick_no) fvs) rhs) = do
+schemeER_wrk d p (StgTick (Breakpoint tick_ty tick_id fvs) rhs) = do
code <- schemeE d 0 p rhs
- hsc_env <- getHscEnv
- current_mod <- getCurrentModule
mb_current_mod_breaks <- getCurrentModBreaks
case mb_current_mod_breaks of
-- if we're not generating ModBreaks for this module for some reason, we
-- can't store breakpoint occurrence information.
Nothing -> pure code
- Just current_mod_breaks -> break_info hsc_env tick_mod current_mod mb_current_mod_breaks >>= \case
- Nothing -> pure code
- Just ModBreaks{modBreaks_module = tick_mod} -> do
- platform <- profilePlatform <$> getProfile
- let idOffSets = getVarOffSets platform d p fvs
- ty_vars = tyCoVarsOfTypesWellScoped (tick_ty:map idType fvs)
- toWord :: Maybe (Id, WordOff) -> Maybe (Id, Word)
- toWord = fmap (\(i, wo) -> (i, fromIntegral wo))
- breakInfo = dehydrateCgBreakInfo ty_vars (map toWord idOffSets) tick_ty
+ Just current_mod_breaks -> do
+ platform <- profilePlatform <$> getProfile
+ let idOffSets = getVarOffSets platform d p fvs
+ ty_vars = tyCoVarsOfTypesWellScoped (tick_ty:map idType fvs)
+ toWord :: Maybe (Id, WordOff) -> Maybe (Id, Word)
+ toWord = fmap (\(i, wo) -> (i, fromIntegral wo))
+ breakInfo = dehydrateCgBreakInfo ty_vars (map toWord idOffSets) tick_ty tick_id
- let info_mod = modBreaks_module current_mod_breaks
- infox <- newBreakInfo breakInfo
+ let info_mod = modBreaks_module current_mod_breaks
+ infox <- newBreakInfo breakInfo
- let breakInstr = BRK_FUN (InternalBreakpointId tick_mod tick_no info_mod infox)
- return $ breakInstr `consOL` code
+ let breakInstr = BRK_FUN (InternalBreakpointId info_mod infox)
+ return $ breakInstr `consOL` code
schemeER_wrk d p rhs = schemeE d 0 p rhs
--- | Determine the GHCi-allocated 'BreakArray' and module pointer for the module
--- from which the breakpoint originates.
--- These are stored in 'ModBreaks' as remote pointers in order to allow the BCOs
--- to refer to pointers in GHCi's address space.
--- They are initialized in 'GHC.HsToCore.Breakpoints.mkModBreaks', called by
--- 'GHC.HsToCore.deSugar'.
---
--- Breakpoints might be disabled because we're in TH, because
--- @-fno-break-points@ was specified, or because a module was reloaded without
--- reinitializing 'ModBreaks'.
---
--- If the module stored in the breakpoint is the currently processed module, use
--- the 'ModBreaks' from the state.
--- If that is 'Nothing', consider breakpoints to be disabled and skip the
--- instruction.
---
--- If the breakpoint is inlined from another module, look it up in the HUG (home unit graph).
--- If the module doesn't exist there, or if the 'ModBreaks' value is
--- uninitialized, skip the instruction (i.e. return Nothing).
-break_info ::
- HscEnv ->
- Module ->
- Module ->
- Maybe ModBreaks ->
- BcM (Maybe ModBreaks)
-break_info hsc_env mod current_mod current_mod_breaks
- | mod == current_mod
- = pure current_mod_breaks
- | otherwise
- = liftIO (HUG.lookupHugByModule mod (hsc_HUG hsc_env)) >>= \case
- Just hp -> pure $ imodBreaks_modBreaks <$> getModBreaks hp
- Nothing -> pure Nothing
-
getVarOffSets :: Platform -> StackDepth -> BCEnv -> [Id] -> [Maybe (Id, WordOff)]
getVarOffSets platform depth env = map getOffSet
where
=====================================
ghc/GHCi/UI.hs
=====================================
@@ -45,7 +45,7 @@ import GHC.Runtime.Eval (mkTopLevEnv)
import GHC.Runtime.Eval.Utils
-- The GHC interface
-import GHC.ByteCode.Breakpoints (imodBreaks_modBreaks)
+import GHC.ByteCode.Breakpoints (imodBreaks_modBreaks, InternalBreakpointId(..), getBreakSourceId)
import GHC.Runtime.Interpreter
import GHCi.RemoteTypes
import GHCi.BreakArray( breakOn, breakOff )
@@ -68,7 +68,7 @@ import GHC ( LoadHowMuch(..), Target(..), TargetId(..),
Resume, SingleStep, Ghc,
GetDocsFailure(..), pushLogHookM,
getModuleGraph, handleSourceError,
- InternalBreakpointId(..) )
+ BreakpointId(..) )
import GHC.Driver.Main (hscParseModuleWithLocation, hscParseStmtWithLocation)
import GHC.Hs.ImpExp
import GHC.Hs
@@ -546,6 +546,7 @@ interactiveUI config srcs maybe_exprs = do
break_ctr = 0,
breaks = IntMap.empty,
tickarrays = emptyModuleEnv,
+ internalBreaks = emptyModuleEnv,
ghci_commands = availableCommands config,
ghci_macros = [],
last_command = Nothing,
@@ -1616,13 +1617,15 @@ toBreakIdAndLocation :: GhciMonad m
toBreakIdAndLocation Nothing = return Nothing
toBreakIdAndLocation (Just inf) = do
st <- getGHCiState
+ hug <- hsc_HUG <$> GHC.getSession
+ brks <- liftIO $ readIModBreaks hug inf
+ let bi = getBreakSourceId inf brks
return $ listToMaybe [ id_loc | id_loc@(_,loc) <- IntMap.assocs (breaks st),
- breakModule loc == ibi_tick_mod inf,
- breakTick loc == ibi_tick_index inf ]
+ breakId loc == bi ]
printStoppedAtBreakInfo :: GHC.GhcMonad m => Resume -> [Name] -> m ()
printStoppedAtBreakInfo res names = do
- printForUser $ pprStopped res
+ printForUser =<< pprStopped res
-- printTypeOfNames session names
let namesSorted = sortBy compareNames names
tythings <- catMaybes `liftM` mapM GHC.lookupName namesSorted
@@ -3804,22 +3807,32 @@ showBkptTable = do
showContext :: GHC.GhcMonad m => m ()
showContext = do
resumes <- GHC.getResumeContext
- printForUser $ vcat (map pp_resume (reverse resumes))
+ docs <- mapM pp_resume (reverse resumes)
+ printForUser $ vcat docs
where
- pp_resume res =
- text "--> " <> text (GHC.resumeStmt res)
- $$ nest 2 (pprStopped res)
-
-pprStopped :: GHC.Resume -> SDoc
-pprStopped res =
- text "Stopped in"
- <+> ((case mb_mod_name of
- Nothing -> empty
- Just mod_name -> ftext (moduleNameFS mod_name) <> char '.')
- <> text (GHC.resumeDecl res))
- <> char ',' <+> ppr (GHC.resumeSpan res)
- where
- mb_mod_name = moduleName <$> ibi_tick_mod <$> GHC.resumeBreakpointId res
+ pp_resume res = do
+ stopped <- pprStopped res
+ return $
+ text "--> " <> text (GHC.resumeStmt res)
+ $$ nest 2 stopped
+
+pprStopped :: GHC.GhcMonad m => GHC.Resume -> m SDoc
+pprStopped res = do
+ let mibi = GHC.resumeBreakpointId res
+ mb_mod_name <- case mibi of
+ Nothing -> pure Nothing
+ Just ibi -> do
+ hug <- hsc_HUG <$> GHC.getSession
+ brks <- liftIO $ readIModBreaks hug ibi
+ return $ Just $ moduleName $
+ bi_tick_mod $ getBreakSourceId ibi brks
+ return $
+ text "Stopped in"
+ <+> ((case mb_mod_name of
+ Nothing -> empty
+ Just mod_name -> ftext (moduleNameFS mod_name) <> char '.')
+ <> text (GHC.resumeDecl res))
+ <> char ',' <+> ppr (GHC.resumeSpan res)
showUnits :: GHC.GhcMonad m => m ()
showUnits = mapNonInteractiveHomeUnitsM $ \dflags -> do
@@ -4373,12 +4386,8 @@ ignoreCmd argLine = withSandboxOnly ":ignore" $ do
result <- ignoreSwitch (words argLine)
case result of
Left sdoc -> printForUser sdoc
- Right (loc, count) -> do
- let bi = GHC.BreakpointId
- { bi_tick_mod = breakModule loc
- , bi_tick_index = breakTick loc
- }
- setupBreakpoint bi count
+ Right (loc, count) -> do
+ setupBreakpoint (breakId loc) count
ignoreSwitch :: GhciMonad m => [String] -> m (Either SDoc (BreakLocation, Int))
ignoreSwitch [break, count] = do
@@ -4395,10 +4404,13 @@ getIgnoreCount str =
where
sdocIgnore = text "Ignore count" <+> quotes (text str)
-setupBreakpoint :: GhciMonad m => GHC.BreakpointId -> Int -> m()
-setupBreakpoint loc count = do
+setupBreakpoint :: GhciMonad m => GHC.BreakpointId -> Int -> m ()
+setupBreakpoint bi count = do
hsc_env <- GHC.getSession
- GHC.setupBreakpoint (hscInterp hsc_env) loc count
+ -- Trigger all internal breaks that match this source break id
+ internal_break_ids <- getInternalBreaksOf bi
+ forM_ internal_break_ids $ \ibi -> do
+ GHC.setupBreakpoint (hscInterp hsc_env) ibi count
backCmd :: GhciMonad m => String -> m ()
backCmd arg
@@ -4489,20 +4501,20 @@ findBreakAndSet md lookupTickTree = do
some -> mapM_ breakAt some
where
breakAt (tick, pan) = do
- setBreakFlag md tick True
- (alreadySet, nm) <-
- recordBreak $ BreakLocation
- { breakModule = md
- , breakLoc = RealSrcSpan pan Strict.Nothing
- , breakTick = tick
- , onBreakCmd = ""
- , breakEnabled = True
- }
- printForUser $
- text "Breakpoint " <> ppr nm <>
- if alreadySet
- then text " was already set at " <> ppr pan
- else text " activated at " <> ppr pan
+ let bi = BreakpointId md tick
+ setBreakFlag bi True
+ (alreadySet, nm) <-
+ recordBreak $ BreakLocation
+ { breakLoc = RealSrcSpan pan Strict.Nothing
+ , breakId = bi
+ , onBreakCmd = ""
+ , breakEnabled = True
+ }
+ printForUser $
+ text "Breakpoint " <> ppr nm <>
+ if alreadySet
+ then text " was already set at " <> ppr pan
+ else text " activated at " <> ppr pan
-- For now, use ANSI bold on terminals that we know support it.
-- Otherwise, we add a line of carets under the active expression instead.
@@ -4749,14 +4761,32 @@ turnBreakOnOff :: GhciMonad m => Bool -> BreakLocation -> m BreakLocation
turnBreakOnOff onOff loc
| onOff == breakEnabled loc = return loc
| otherwise = do
- setBreakFlag (breakModule loc) (breakTick loc) onOff
+ setBreakFlag (breakId loc) onOff
return loc { breakEnabled = onOff }
-setBreakFlag :: GhciMonad m => Module -> Int -> Bool ->m ()
-setBreakFlag md ix enaDisa = do
+setBreakFlag :: GhciMonad m => GHC.BreakpointId -> Bool -> m ()
+setBreakFlag (BreakpointId md ix) enaDisa = do
let enaDisaToCount True = breakOn
enaDisaToCount False = breakOff
- setupBreakpoint (GHC.BreakpointId md ix) $ enaDisaToCount enaDisa
+ setupBreakpoint (BreakpointId md ix) $ enaDisaToCount enaDisa
+
+-- --------------------------------------------------------------------------
+-- Find matching Internal Breakpoints
+
+-- | Find all the internal breakpoints that use the given source-level breakpoint id
+getInternalBreaksOf :: GhciMonad m => BreakpointId -> m [InternalBreakpointId]
+getInternalBreaksOf bi = do
+ st <- getGHCiState
+ let ibrks = internalBreaks st
+ case lookupBreakpointOccurrences ibrks bi of
+ Just bs -> return bs
+ Nothing -> do
+ -- Refresh the internal breakpoints map
+ bs <- mkBreakpointOccurrences
+ setGHCiState st{internalBreaks = bs}
+ return $
+ fromMaybe [] {- still not found after refresh -} $
+ lookupBreakpointOccurrences bs bi
-- ---------------------------------------------------------------------------
-- User code exception handling
=====================================
ghc/GHCi/UI/Monad.hs
=====================================
@@ -100,6 +100,14 @@ data GHCiState = GHCiState
-- ^ 'tickarrays' caches the 'TickArray' for loaded modules,
-- so that we don't rebuild it each time the user sets
-- a breakpoint.
+
+ internalBreaks :: BreakpointOccurrences,
+ -- ^ Keep a mapping from the source-level 'BreakpointId' to the
+ -- occurrences of that breakpoint across modules.
+ -- When we want to stop at a source 'BreakpointId', we essentially
+ -- trigger a breakpoint for all 'InternalBreakpointId's matching
+ -- the same source-id.
+
ghci_commands :: [Command],
-- ^ available ghci commands
ghci_macros :: [Command],
@@ -238,16 +246,15 @@ data LocalConfigBehaviour
data BreakLocation
= BreakLocation
- { breakModule :: !GHC.Module
- , breakLoc :: !SrcSpan
- , breakTick :: {-# UNPACK #-} !Int
+ { breakLoc :: !SrcSpan
+ , breakId :: !GHC.BreakpointId
+ -- ^ The 'BreakpointId' uniquely identifies a source-level breakpoint
, breakEnabled:: !Bool
, onBreakCmd :: String
}
instance Eq BreakLocation where
- loc1 == loc2 = breakModule loc1 == breakModule loc2 &&
- breakTick loc1 == breakTick loc2
+ loc1 == loc2 = breakId loc1 == breakId loc2
prettyLocations :: IntMap.IntMap BreakLocation -> SDoc
prettyLocations locs =
@@ -256,7 +263,7 @@ prettyLocations locs =
False -> vcat $ map (\(i, loc) -> brackets (int i) <+> ppr loc) $ IntMap.toAscList locs
instance Outputable BreakLocation where
- ppr loc = (ppr $ breakModule loc) <+> ppr (breakLoc loc) <+> pprEnaDisa <+>
+ ppr loc = (ppr $ GHC.bi_tick_mod $ breakId loc) <+> ppr (breakLoc loc) <+> pprEnaDisa <+>
if null (onBreakCmd loc)
then empty
else doubleQuotes (text (onBreakCmd loc))
=====================================
libraries/ghci/GHCi/Debugger.hs
=====================================
@@ -65,10 +65,7 @@ foreign import ccall "&rts_stop_on_exception" exceptionFlag :: Ptr CInt
--------------------------------------------------------------------------------
type BreakpointCallback
- = Addr# -- pointer to the breakpoint tick module name
- -> Addr# -- pointer to the breakpoint tick module unit id
- -> Int# -- breakpoint tick index
- -> Addr# -- pointer to the breakpoint info module name
+ = Addr# -- pointer to the breakpoint info module name
-> Addr# -- pointer to the breakpoint info module unit id
-> Int# -- breakpoint info index
-> Bool -- exception?
=====================================
libraries/ghci/GHCi/Message.hs
=====================================
@@ -418,10 +418,7 @@ data EvalStatus_ a b
instance Binary a => Binary (EvalStatus_ a b)
data EvalBreakpoint = EvalBreakpoint
- { eb_tick_mod :: String -- ^ Breakpoint tick module
- , eb_tick_mod_unit :: BS.ShortByteString -- ^ Breakpoint tick module unit id
- , eb_tick_index :: Int -- ^ Breakpoint tick index
- , eb_info_mod :: String -- ^ Breakpoint info module
+ { eb_info_mod :: String -- ^ Breakpoint info module
, eb_info_mod_unit :: BS.ShortByteString -- ^ Breakpoint tick module unit id
, eb_info_index :: Int -- ^ Breakpoint info index
}
=====================================
libraries/ghci/GHCi/Run.hs
=====================================
@@ -345,7 +345,7 @@ withBreakAction opts breakMVar statusMVar mtid act
-- as soon as it is hit, or in resetBreakAction below.
onBreak :: BreakpointCallback
- onBreak tick_mod# tick_mod_uid# tickx# info_mod# info_mod_uid# infox# is_exception apStack = do
+ onBreak info_mod# info_mod_uid# infox# is_exception apStack = do
tid <- myThreadId
let resume = ResumeContext
{ resumeBreakMVar = breakMVar
@@ -358,11 +358,9 @@ withBreakAction opts breakMVar statusMVar mtid act
if is_exception
then pure Nothing
else do
- tick_mod <- peekCString (Ptr tick_mod#)
- tick_mod_uid <- BS.packCString (Ptr tick_mod_uid#)
info_mod <- peekCString (Ptr info_mod#)
info_mod_uid <- BS.packCString (Ptr info_mod_uid#)
- pure (Just (EvalBreakpoint tick_mod tick_mod_uid (I# tickx#) info_mod info_mod_uid (I# infox#)))
+ pure (Just (EvalBreakpoint info_mod info_mod_uid (I# infox#)))
putMVar statusMVar $ EvalBreak apStack_r breakpoint resume_r ccs
takeMVar breakMVar
@@ -409,8 +407,8 @@ noBreakStablePtr :: StablePtr BreakpointCallback
noBreakStablePtr = unsafePerformIO $ newStablePtr noBreakAction
noBreakAction :: BreakpointCallback
-noBreakAction _ _ _ _ _ _ False _ = putStrLn "*** Ignoring breakpoint"
-noBreakAction _ _ _ _ _ _ True _ = return () -- exception: just continue
+noBreakAction _ _ _ False _ = putStrLn "*** Ignoring breakpoint"
+noBreakAction _ _ _ True _ = return () -- exception: just continue
-- Malloc and copy the bytes. We don't have any way to monitor the
-- lifetime of this memory, so it just leaks.
=====================================
rts/Disassembler.c
=====================================
@@ -84,16 +84,23 @@ disInstr ( StgBCO *bco, int pc )
switch (instr & 0xff) {
- case bci_BRK_FUN:
- debugBelch ("BRK_FUN " ); printPtr( ptrs[instrs[pc]] );
- debugBelch (" %d ", instrs[pc+1]); printPtr( ptrs[instrs[pc+2]] );
- CostCentre* cc = (CostCentre*)literals[instrs[pc+5]];
+ case bci_BRK_FUN: {
+ W_ p1, info_mod, info_unit_id, info_wix, np;
+ p1 = BCO_GET_LARGE_ARG;
+ info_mod = BCO_GET_LARGE_ARG;
+ info_unit_id = BCO_GET_LARGE_ARG;
+ info_wix = BCO_NEXT;
+ np = BCO_GET_LARGE_ARG;
+ debugBelch ("BRK_FUN " ); printPtr( ptrs[p1] );
+ debugBelch("%" FMT_Word, literals[info_mod] );
+ debugBelch("%" FMT_Word, literals[info_unit_id] );
+ debugBelch("%" FMT_Word, info_wix );
+ CostCentre* cc = (CostCentre*)literals[np];
if (cc) {
debugBelch(" %s", cc->label);
}
debugBelch("\n");
- pc += 6;
- break;
+ break; }
case bci_BRK_ALTS:
debugBelch ("BRK_ALTS %d\n", BCO_NEXT);
break;
=====================================
rts/Exception.cmm
=====================================
@@ -535,23 +535,17 @@ retry_pop_stack:
// be per-thread.
CInt[rts_stop_on_exception] = 0;
("ptr" ioAction) = ccall deRefStablePtr (W_[rts_breakpoint_io_action] "ptr");
- Sp = Sp - WDS(17);
- Sp(16) = exception;
- Sp(15) = stg_raise_ret_info;
- Sp(14) = exception;
- Sp(13) = ghczminternal_GHCziInternalziTypes_True_closure; // True <=> an exception
- Sp(12) = stg_ap_ppv_info;
- Sp(11) = 0;
- Sp(10) = stg_ap_n_info;
- Sp(9) = 0;
- Sp(8) = stg_ap_n_info;
- Sp(7) = 0;
- Sp(6) = stg_ap_n_info;
- Sp(5) = 0;
- Sp(4) = stg_ap_n_info;
- Sp(3) = 0;
- Sp(2) = stg_ap_n_info;
- Sp(1) = 0;
+ Sp = Sp - WDS(11);
+ Sp(10) = exception;
+ Sp(9) = stg_raise_ret_info;
+ Sp(8) = exception;
+ Sp(7) = ghczminternal_GHCziInternalziTypes_True_closure; // True <=> an exception
+ Sp(6) = stg_ap_ppv_info;
+ Sp(5) = 0;
+ Sp(4) = stg_ap_n_info;
+ Sp(3) = 0;
+ Sp(2) = stg_ap_n_info;
+ Sp(1) = 0;
R1 = ioAction;
jump RET_LBL(stg_ap_n) [R1];
}
=====================================
rts/Interpreter.c
=====================================
@@ -619,8 +619,6 @@ interpretBCO (Capability* cap)
*/
if (cap->r.rCurrentTSO->flags & TSO_STOP_AFTER_RETURN) {
- StgBCO* bco;
- StgWord16* bco_instrs;
StgHalfWord type;
/* Store the entry Sp; traverse the stack modifying Sp (using Sp macros);
@@ -640,28 +638,33 @@ interpretBCO (Capability* cap)
ASSERT(type == RET_BCO || type == STOP_FRAME);
if (type == RET_BCO) {
- bco = (StgBCO*)(SpW(1)); // BCO is first arg of a RET_BCO
+ StgBCO* bco = (StgBCO*)(SpW(1)); // BCO is first arg of a RET_BCO
ASSERT(get_itbl((StgClosure*)bco)->type == BCO);
- bco_instrs = (StgWord16*)(bco->instrs->payload);
+
+ StgWord16* instrs = (StgWord16*)(bco->instrs->payload);
+ StgWord16 bci = instrs[0];
/* A breakpoint instruction (BRK_FUN or BRK_ALTS) is always the first
* instruction in a BCO */
- if ((bco_instrs[0] & 0xFF) == bci_BRK_FUN) {
- int brk_array, tick_index;
- StgArrBytes *breakPoints;
- StgPtr* ptrs;
+ if ((bci & 0xFF) == bci_BRK_FUN) {
+ // Define rest of variables used by BCO_* Macros
+ int bciPtr = 0;
+
+ W_ arg1_brk_array, arg4_info_index;
+ arg1_brk_array = BCO_GET_LARGE_ARG;
+ /* info_mod_name = */ BCO_GET_LARGE_ARG;
+ /* info_mod_id = */ BCO_GET_LARGE_ARG;
+ arg4_info_index = BCO_NEXT;
- ptrs = (StgPtr*)(&bco->ptrs->payload[0]);
- brk_array = bco_instrs[1];
- tick_index = bco_instrs[6];
+ StgPtr* ptrs = (StgPtr*)(&bco->ptrs->payload[0]);
+ StgArrBytes* breakPoints = (StgArrBytes *) BCO_PTR(arg1_brk_array);
- breakPoints = (StgArrBytes *) BCO_PTR(brk_array);
// ACTIVATE the breakpoint by tick index
- ((StgInt*)breakPoints->payload)[tick_index] = 0;
+ ((StgInt*)breakPoints->payload)[arg4_info_index] = 0;
}
- else if ((bco_instrs[0] & 0xFF) == bci_BRK_ALTS) {
+ else if ((bci & 0xFF) == bci_BRK_ALTS) {
// ACTIVATE BRK_ALTS by setting its only argument to ON
- bco_instrs[1] = 1;
+ instrs[1] = 1;
}
// else: if there is no BRK instruction perhaps we should keep
// traversing; that said, the continuation should always have a BRK
@@ -1454,9 +1457,9 @@ run_BCO:
/* check for a breakpoint on the beginning of a let binding */
case bci_BRK_FUN:
{
- int arg1_brk_array, arg2_tick_mod, arg3_info_mod, arg4_tick_mod_id, arg5_info_mod_id, arg6_tick_index, arg7_info_index;
+ W_ arg1_brk_array, arg2_info_mod_name, arg3_info_mod_id, arg4_info_index;
#if defined(PROFILING)
- int arg8_cc;
+ W_ arg5_cc;
#endif
StgArrBytes *breakPoints;
int returning_from_break, stop_next_breakpoint;
@@ -1471,14 +1474,11 @@ run_BCO:
int size_words;
arg1_brk_array = BCO_GET_LARGE_ARG;
- arg2_tick_mod = BCO_GET_LARGE_ARG;
- arg3_info_mod = BCO_GET_LARGE_ARG;
- arg4_tick_mod_id = BCO_GET_LARGE_ARG;
- arg5_info_mod_id = BCO_GET_LARGE_ARG;
- arg6_tick_index = BCO_NEXT;
- arg7_info_index = BCO_NEXT;
+ arg2_info_mod_name = BCO_GET_LARGE_ARG;
+ arg3_info_mod_id = BCO_GET_LARGE_ARG;
+ arg4_info_index = BCO_NEXT;
#if defined(PROFILING)
- arg8_cc = BCO_GET_LARGE_ARG;
+ arg5_cc = BCO_GET_LARGE_ARG;
#else
BCO_GET_LARGE_ARG;
#endif
@@ -1498,7 +1498,7 @@ run_BCO:
#if defined(PROFILING)
cap->r.rCCCS = pushCostCentre(cap->r.rCCCS,
- (CostCentre*)BCO_LIT(arg8_cc));
+ (CostCentre*)BCO_LIT(arg5_cc));
#endif
// if we are returning from a break then skip this section
@@ -1509,11 +1509,11 @@ run_BCO:
// stop the current thread if either `stop_next_breakpoint` is
// true OR if the ignore count for this particular breakpoint is zero
- StgInt ignore_count = ((StgInt*)breakPoints->payload)[arg6_tick_index];
+ StgInt ignore_count = ((StgInt*)breakPoints->payload)[arg4_info_index];
if (stop_next_breakpoint == false && ignore_count > 0)
{
// decrement and write back ignore count
- ((StgInt*)breakPoints->payload)[arg6_tick_index] = --ignore_count;
+ ((StgInt*)breakPoints->payload)[arg4_info_index] = --ignore_count;
}
else if (stop_next_breakpoint == true || ignore_count == 0)
{
@@ -1547,10 +1547,7 @@ run_BCO:
// Arrange the stack to call the breakpoint IO action, and
// continue execution of this BCO when the IO action returns.
//
- // ioAction :: Addr# -- the breakpoint tick module
- // -> Addr# -- the breakpoint tick module unit id
- // -> Int# -- the breakpoint tick index
- // -> Addr# -- the breakpoint info module
+ // ioAction :: Addr# -- the breakpoint info module
// -> Addr# -- the breakpoint info module unit id
// -> Int# -- the breakpoint info index
// -> Bool -- exception?
@@ -1560,23 +1557,17 @@ run_BCO:
ioAction = (StgClosure *) deRefStablePtr (
rts_breakpoint_io_action);
- Sp_subW(19);
- SpW(18) = (W_)obj;
- SpW(17) = (W_)&stg_apply_interp_info;
- SpW(16) = (W_)new_aps;
- SpW(15) = (W_)False_closure; // True <=> an exception
- SpW(14) = (W_)&stg_ap_ppv_info;
- SpW(13) = (W_)arg7_info_index;
- SpW(12) = (W_)&stg_ap_n_info;
- SpW(11) = (W_)BCO_LIT(arg5_info_mod_id);
- SpW(10) = (W_)&stg_ap_n_info;
- SpW(9) = (W_)BCO_LIT(arg3_info_mod);
- SpW(8) = (W_)&stg_ap_n_info;
- SpW(7) = (W_)arg6_tick_index;
+ Sp_subW(13);
+ SpW(12) = (W_)obj;
+ SpW(11) = (W_)&stg_apply_interp_info;
+ SpW(10) = (W_)new_aps;
+ SpW(9) = (W_)False_closure; // True <=> an exception
+ SpW(8) = (W_)&stg_ap_ppv_info;
+ SpW(7) = (W_)arg4_info_index;
SpW(6) = (W_)&stg_ap_n_info;
- SpW(5) = (W_)BCO_LIT(arg4_tick_mod_id);
+ SpW(5) = (W_)BCO_LIT(arg3_info_mod_id);
SpW(4) = (W_)&stg_ap_n_info;
- SpW(3) = (W_)BCO_LIT(arg2_tick_mod);
+ SpW(3) = (W_)BCO_LIT(arg2_info_mod_name);
SpW(2) = (W_)&stg_ap_n_info;
SpW(1) = (W_)ioAction;
SpW(0) = (W_)&stg_enter_info;
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d701c1f6cdfca921c02f4cc61a35083…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d701c1f6cdfca921c02f4cc61a35083…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 3 commits: debugger: Uniquely identify breakpoints by internal id
by Marge Bot (＠marge-bot) 31 Jul '25
by Marge Bot (＠marge-bot) 31 Jul '25
31 Jul '25
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
2ea465e0 by Rodrigo Mesquita at 2025-07-31T17:56:52-04:00
debugger: Uniquely identify breakpoints by internal id
Since b85b11994e0130ff2401dd4bbdf52330e0bcf776 (support inlining
breakpoints), a breakpoint has been identified at runtime by *two* pairs
of <module,index>.
- The first, aka a 'BreakpointId', uniquely identifies a breakpoint in
the source of a module by using the Tick index. A Tick index can index
into ModBreaks.modBreaks_xxx to fetch source-level information about
where that tick originated.
- When a user specifies e.g. a line breakpoint using :break, we'll reverse
engineer what a Tick index for that line
- We update the `BreakArray` of that module (got from the
LoaderState) at that tick index to `breakOn`.
- A BCO we can stop at is headed by a BRK_FUN instruction. This
instruction stores in an operand the `tick index` it is associated
to. We look it up in the associated `BreakArray` (also an operand)
and check wheter it was set to `breakOn`.
- The second, aka the `ibi_info_mod` + `ibi_info_ix` of the
`InternalBreakpointId`, uniquely index into the `imodBreaks_breakInfo`
-- the information we gathered during code generation about the
existing breakpoint *ocurrences*.
- Note that with optimisation there may be many occurrences of the
same source-tick-breakpoint across different modules. The
`ibi_info_ix` is unique per occurrence, but the `bi_tick_ix` may be
shared. See Note [Breakpoint identifiers] about this.
- Note that besides the tick ids, info ids are also stored in
`BRK_FUN` so the break handler can refer to the associated
`CgBreakInfo`.
In light of that, the driving changes come from the desire to have the
info_id uniquely identify the breakpoint at runtime, and the source tick
id being derived from it:
- An InternalBreakpointId should uniquely identify a breakpoint just
from the code-generation identifiers of `ibi_info_ix` and `ibi_info_mod`.
So we drop `ibi_tick_mod` and `ibi_tick_ix`.
- A BRK_FUN instruction need only record the "internal breakpoint id",
not the tick-level id.
So we drop the tick mod and tick index operands.
- A BreakArray should be indexed by InternalBreakpointId rather than
BreakpointId
That means we need to do some more work when setting a breakpoint.
Specifically, we need to figure out the internal ids (occurrences of a
breakpoint) from the source-level BreakpointId we want to set the
breakpoint at (recall :break refers to breaks at the source level).
Besides this change being an improvement to the handling of breakpoints
(it's clearer to have a single unique identifier than two competing
ones), it unlocks the possibility of generating "internal" breakpoints
during Cg (needed for #26042).
It should also be easier to introduce multi-threaded-aware `BreakArrays`
following this change (needed for #26064).
Se also the new Note [ModBreaks vs InternalModBreaks]
- - - - -
beecfb55 by Simon Hengel at 2025-07-31T17:56:53-04:00
Don't use MCDiagnostic for `ghcExit`
This changes the error message of `ghcExit` from
```
<no location info>: error:
Compilation had errors
```
to
```
Compilation had errors
```
- - - - -
2ff38e31 by Simon Hengel at 2025-07-31T17:56:53-04:00
Respect `-fdiagnostics-as-json` for driver diagnostics (see #24113)
- - - - -
24 changed files:
- compiler/GHC/ByteCode/Asm.hs
- compiler/GHC/ByteCode/Breakpoints.hs
- compiler/GHC/ByteCode/Instr.hs
- compiler/GHC/ByteCode/Linker.hs
- compiler/GHC/ByteCode/Types.hs
- compiler/GHC/CoreToIface.hs
- compiler/GHC/Driver/Make.hs
- compiler/GHC/HsToCore/Breakpoints.hs
- compiler/GHC/Linker/Loader.hs
- compiler/GHC/Runtime/Debugger/Breakpoints.hs
- compiler/GHC/Runtime/Eval.hs
- compiler/GHC/Runtime/Interpreter.hs
- compiler/GHC/StgToByteCode.hs
- compiler/GHC/SysTools/Tasks.hs
- compiler/GHC/Utils/Error.hs
- ghc/GHCi/UI.hs
- ghc/GHCi/UI/Monad.hs
- libraries/ghci/GHCi/Debugger.hs
- libraries/ghci/GHCi/Message.hs
- libraries/ghci/GHCi/Run.hs
- rts/Disassembler.c
- rts/Exception.cmm
- rts/Interpreter.c
- testsuite/tests/corelint/T21115b.stderr
Changes:
=====================================
compiler/GHC/ByteCode/Asm.hs
=====================================
@@ -841,24 +841,18 @@ assembleI platform i = case i of
W8 -> emit_ bci_OP_INDEX_ADDR_08 []
_ -> unsupported_width
- BRK_FUN (InternalBreakpointId tick_mod tickx info_mod infox) -> do
+ BRK_FUN ibi@(InternalBreakpointId info_mod infox) -> do
+ p1 <- ptr $ BCOPtrBreakArray info_mod
let -- cast that checks that round-tripping through Word16 doesn't change the value
toW16 x = let r = fromIntegral x :: Word16
in if fromIntegral r == x
then r
else pprPanic "schemeER_wrk: breakpoint tick/info index too large!" (ppr x)
- p1 <- ptr $ BCOPtrBreakArray tick_mod
- tick_addr <- lit1 $ BCONPtrFS $ moduleNameFS $ moduleName tick_mod
- info_addr <- lit1 $ BCONPtrFS $ moduleNameFS $ moduleName info_mod
- tick_unitid_addr <- lit1 $ BCONPtrFS $ unitIdFS $ moduleUnitId $ tick_mod
- info_unitid_addr <- lit1 $ BCONPtrFS $ unitIdFS $ moduleUnitId $ info_mod
- np <- lit1 $ BCONPtrCostCentre (BreakpointId tick_mod tickx)
- emit_ bci_BRK_FUN [ Op p1
- , Op tick_addr, Op info_addr
- , Op tick_unitid_addr, Op info_unitid_addr
- , SmallOp (toW16 tickx), SmallOp (toW16 infox)
- , Op np
- ]
+ info_addr <- lit1 $ BCONPtrFS $ moduleNameFS $ moduleName info_mod
+ info_unitid_addr <- lit1 $ BCONPtrFS $ unitIdFS $ moduleUnitId info_mod
+ np <- lit1 $ BCONPtrCostCentre ibi
+ emit_ bci_BRK_FUN [ Op p1, Op info_addr, Op info_unitid_addr
+ , SmallOp (toW16 infox), Op np ]
BRK_ALTS active -> emit_ bci_BRK_ALTS [SmallOp (if active then 1 else 0)]
=====================================
compiler/GHC/ByteCode/Breakpoints.hs
=====================================
@@ -7,23 +7,23 @@
-- 'InternalModBreaks', and is uniquely identified at runtime by an
-- 'InternalBreakpointId'.
--
--- See Note [Breakpoint identifiers]
+-- See Note [ModBreaks vs InternalModBreaks] and Note [Breakpoint identifiers]
module GHC.ByteCode.Breakpoints
( -- * Internal Mod Breaks
InternalModBreaks(..), CgBreakInfo(..)
- , mkInternalModBreaks
+ , mkInternalModBreaks, imodBreaks_module
-- ** Internal breakpoint identifier
, InternalBreakpointId(..), BreakInfoIndex
-- * Operations
- , toBreakpointId
-- ** Internal-level operations
- , getInternalBreak, addInternalBreak
+ , getInternalBreak
-- ** Source-level information operations
, getBreakLoc, getBreakVars, getBreakDecls, getBreakCCS
+ , getBreakSourceId
-- * Utils
, seqInternalModBreaks
@@ -47,6 +47,31 @@ import GHC.Utils.Panic
import Data.Array
{-
+Note [ModBreaks vs InternalModBreaks]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+'ModBreaks' and 'BreakpointId's must not to be confused with
+'InternalModBreaks' and 'InternalBreakId's.
+
+'ModBreaks' is constructed once during HsToCore from the information attached
+to source-level breakpoint ticks and is never changed afterwards. A 'ModBreaks'
+can be queried using 'BreakpointId's, which uniquely identifies a breakpoint
+within the list of breakpoint information for a given module's 'ModBreaks'.
+
+'InternalModBreaks' are constructed during bytecode generation and are indexed
+by a 'InternalBreakpointId'. They contain all the information relevant to a
+breakpoint for code generation that can be accessed during runtime execution
+(such as a 'BreakArray' for triggering breakpoints). 'InternalBreakpointId's
+are used at runtime to trigger and inspect breakpoints -- a 'BRK_FUN'
+instruction receives 'InternalBreakpointId' as an argument.
+
+We keep a mapping from 'InternalModBreaks' to a 'BreakpointId', which can then be used
+to get source-level information about a breakpoint via the corresponding 'ModBreaks'.
+
+Notably, 'InternalModBreaks' can contain entries for so-called internal
+breakpoints, which do not necessarily have a source-level location attached to
+it (i.e. do not have a matching entry in 'ModBreaks'). We may leverage this to
+introduce breakpoints during code generation for features such as stepping-out.
+
Note [Breakpoint identifiers]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Before optimization a breakpoint is identified uniquely with a tick module
@@ -64,6 +89,10 @@ So every breakpoint occurrence gets assigned a module-unique *info index* and
we store it alongside the occurrence module (*info module*) in the
'InternalBreakpointId' datatype. This is the index that we use at runtime to
identify a breakpoint.
+
+When the internal breakpoint has a matching tick-level breakpoint we can fetch
+the related tick-level information by first looking up a mapping
+@'InternalBreakpointId' -> 'BreakpointId'@ in @'CgBreakInfo'@.
-}
--------------------------------------------------------------------------------
@@ -78,19 +107,11 @@ type BreakInfoIndex = Int
-- Indexes into the structures in the @'InternalModBreaks'@ produced during ByteCode generation.
-- See Note [Breakpoint identifiers]
data InternalBreakpointId = InternalBreakpointId
- { ibi_tick_mod :: !Module -- ^ Breakpoint tick module
- , ibi_tick_index :: !Int -- ^ Breakpoint tick index
- , ibi_info_mod :: !Module -- ^ Breakpoint tick module
- , ibi_info_index :: !BreakInfoIndex -- ^ Breakpoint tick index
+ { ibi_info_mod :: !Module -- ^ Breakpoint info module
+ , ibi_info_index :: !BreakInfoIndex -- ^ Breakpoint info index
}
deriving (Eq, Ord)
-toBreakpointId :: InternalBreakpointId -> BreakpointId
-toBreakpointId ibi = BreakpointId
- { bi_tick_mod = ibi_tick_mod ibi
- , bi_tick_index = ibi_tick_index ibi
- }
-
--------------------------------------------------------------------------------
-- * Internal Mod Breaks
--------------------------------------------------------------------------------
@@ -107,18 +128,34 @@ data InternalModBreaks = InternalModBreaks
-- 'InternalBreakpointId'.
, imodBreaks_modBreaks :: !ModBreaks
- -- ^ Store the original ModBreaks for this module, unchanged.
- -- Allows us to query about source-level breakpoint information using
- -- an internal breakpoint id.
+ -- ^ Store the ModBreaks for this module
+ --
+ -- Recall Note [Breakpoint identifiers]: for some module A, an
+ -- *occurrence* of a breakpoint in A may have been inlined from some
+ -- breakpoint *defined* in module B.
+ --
+ -- This 'ModBreaks' contains information regarding all the breakpoints
+ -- defined in the module this 'InternalModBreaks' corresponds to. It
+ -- /does not/ necessarily have information regarding all the breakpoint
+ -- occurrences registered in 'imodBreaks_breakInfo'. Some of those
+ -- occurrences may refer breakpoints inlined from other modules.
}
--- | Construct an 'InternalModBreaks'
+-- | Construct an 'InternalModBreaks'.
+--
+-- INVARIANT: The given 'ModBreaks' correspond to the same module as this
+-- 'InternalModBreaks' module (the first argument) and its breakpoint infos
+-- (the @IntMap CgBreakInfo@ argument)
mkInternalModBreaks :: Module -> IntMap CgBreakInfo -> ModBreaks -> InternalModBreaks
mkInternalModBreaks mod im mbs =
assertPpr (mod == modBreaks_module mbs)
(text "Constructing InternalModBreaks with the ModBreaks of a different module!") $
InternalModBreaks im mbs
+-- | Get the module to which these 'InternalModBreaks' correspond
+imodBreaks_module :: InternalModBreaks -> Module
+imodBreaks_module = modBreaks_module . imodBreaks_modBreaks
+
-- | Information about a breakpoint that we know at code-generation time
-- In order to be used, this needs to be hydrated relative to the current HscEnv by
-- 'hydrateCgBreakInfo'. Everything here can be fully forced and that's critical for
@@ -128,20 +165,22 @@ data CgBreakInfo
{ cgb_tyvars :: ![IfaceTvBndr] -- ^ Type variables in scope at the breakpoint
, cgb_vars :: ![Maybe (IfaceIdBndr, Word)]
, cgb_resty :: !IfaceType
+ , cgb_tick_id :: !BreakpointId
+ -- ^ This field records the original breakpoint tick identifier for this
+ -- internal breakpoint info. It is used to convert a breakpoint
+ -- *occurrence* index ('InternalBreakpointId') into a *definition* index
+ -- ('BreakpointId').
+ --
+ -- The modules of breakpoint occurrence and breakpoint definition are not
+ -- necessarily the same: See Note [Breakpoint identifiers].
}
-- See Note [Syncing breakpoint info] in GHC.Runtime.Eval
-- | Get an internal breakpoint info by 'InternalBreakpointId'
getInternalBreak :: InternalBreakpointId -> InternalModBreaks -> CgBreakInfo
-getInternalBreak (InternalBreakpointId _ _ info_mod info_ix) imbs =
- assert_modules_match info_mod (modBreaks_module $ imodBreaks_modBreaks imbs) $
- imodBreaks_breakInfo imbs IM.! info_ix
-
--- | Add a CgBreakInfo to an 'InternalModBreaks' at 'InternalBreakpointId'
-addInternalBreak :: InternalBreakpointId -> CgBreakInfo -> InternalModBreaks -> InternalModBreaks
-addInternalBreak (InternalBreakpointId _ _ info_mod info_ix) info imbs =
- assert_modules_match info_mod (modBreaks_module $ imodBreaks_modBreaks imbs) $
- imbs{imodBreaks_breakInfo = IM.insert info_ix info (imodBreaks_breakInfo imbs)}
+getInternalBreak (InternalBreakpointId mod ix) imbs =
+ assert_modules_match mod (imodBreaks_module imbs) $
+ imodBreaks_breakInfo imbs IM.! ix
-- | Assert that the module in the 'InternalBreakpointId' and in
-- 'InternalModBreaks' match.
@@ -155,27 +194,56 @@ assert_modules_match ibi_mod imbs_mod =
-- Tick-level Breakpoint information
--------------------------------------------------------------------------------
+-- | Get the source module and tick index for this breakpoint
+-- (as opposed to the module where this breakpoint occurs, which is in 'InternalBreakpointId')
+getBreakSourceId :: InternalBreakpointId -> InternalModBreaks -> BreakpointId
+getBreakSourceId (InternalBreakpointId ibi_mod ibi_ix) imbs =
+ assert_modules_match ibi_mod (imodBreaks_module imbs) $
+ let cgb = imodBreaks_breakInfo imbs IM.! ibi_ix
+ in cgb_tick_id cgb
+
-- | Get the source span for this breakpoint
-getBreakLoc :: InternalBreakpointId -> InternalModBreaks -> SrcSpan
+getBreakLoc :: (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO SrcSpan
getBreakLoc = getBreakXXX modBreaks_locs
-- | Get the vars for this breakpoint
-getBreakVars :: InternalBreakpointId -> InternalModBreaks -> [OccName]
+getBreakVars :: (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO [OccName]
getBreakVars = getBreakXXX modBreaks_vars
-- | Get the decls for this breakpoint
-getBreakDecls :: InternalBreakpointId -> InternalModBreaks -> [String]
+getBreakDecls :: (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO [String]
getBreakDecls = getBreakXXX modBreaks_decls
-- | Get the decls for this breakpoint
-getBreakCCS :: InternalBreakpointId -> InternalModBreaks -> (String, String)
+getBreakCCS :: (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO (String, String)
getBreakCCS = getBreakXXX modBreaks_ccs
-- | Internal utility to access a ModBreaks field at a particular breakpoint index
-getBreakXXX :: (ModBreaks -> Array BreakTickIndex a) -> InternalBreakpointId -> InternalModBreaks -> a
-getBreakXXX view (InternalBreakpointId tick_mod tick_id _ _) imbs =
- assert_modules_match tick_mod (modBreaks_module $ imodBreaks_modBreaks imbs) $ do
- view (imodBreaks_modBreaks imbs) ! tick_id
+--
+-- Recall Note [Breakpoint identifiers]: the internal breakpoint module (the
+-- *occurrence* module) doesn't necessarily match the module where the
+-- tick breakpoint was defined with the relevant 'ModBreaks'.
+--
+-- When the tick module is the same as the internal module, we use the stored
+-- 'ModBreaks'. When the tick module is different, we need to look up the
+-- 'ModBreaks' in the HUG for that other module.
+--
+-- To avoid cyclic dependencies, we instead receive a function that looks up
+-- the 'ModBreaks' given a 'Module'
+getBreakXXX :: (ModBreaks -> Array BreakTickIndex a) -> (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO a
+getBreakXXX view lookupModule (InternalBreakpointId ibi_mod ibi_ix) imbs =
+ assert_modules_match ibi_mod (imodBreaks_module imbs) $ do
+ let cgb = imodBreaks_breakInfo imbs IM.! ibi_ix
+ case cgb_tick_id cgb of
+ BreakpointId{bi_tick_mod, bi_tick_index}
+ | bi_tick_mod == ibi_mod
+ -> do
+ let these_mbs = imodBreaks_modBreaks imbs
+ return $ view these_mbs ! bi_tick_index
+ | otherwise
+ -> do
+ other_mbs <- lookupModule bi_tick_mod
+ return $ view other_mbs ! bi_tick_index
--------------------------------------------------------------------------------
-- Instances
@@ -190,7 +258,8 @@ seqInternalModBreaks InternalModBreaks{..} =
seqCgBreakInfo CgBreakInfo{..} =
rnf cgb_tyvars `seq`
rnf cgb_vars `seq`
- rnf cgb_resty
+ rnf cgb_resty `seq`
+ rnf cgb_tick_id
instance Outputable InternalBreakpointId where
ppr InternalBreakpointId{..} =
@@ -203,4 +272,5 @@ instance NFData InternalBreakpointId where
instance Outputable CgBreakInfo where
ppr info = text "CgBreakInfo" <+>
parens (ppr (cgb_vars info) <+>
- ppr (cgb_resty info))
+ ppr (cgb_resty info) <+>
+ ppr (cgb_tick_id info))
=====================================
compiler/GHC/ByteCode/Instr.hs
=====================================
@@ -454,9 +454,8 @@ instance Outputable BCInstr where
ppr ENTER = text "ENTER"
ppr (RETURN pk) = text "RETURN " <+> ppr pk
ppr (RETURN_TUPLE) = text "RETURN_TUPLE"
- ppr (BRK_FUN (InternalBreakpointId tick_mod tickx info_mod infox))
+ ppr (BRK_FUN (InternalBreakpointId info_mod infox))
= text "BRK_FUN" <+> text "<breakarray>"
- <+> ppr tick_mod <+> ppr tickx
<+> ppr info_mod <+> ppr infox
<+> text "<cc>"
ppr (BRK_ALTS active) = text "BRK_ALTS" <+> ppr active
=====================================
compiler/GHC/ByteCode/Linker.hs
=====================================
@@ -98,9 +98,9 @@ lookupLiteral interp pkgs_loaded le lb ptr = case ptr of
BCONPtrFFIInfo (FFIInfo {..}) -> do
RemotePtr p <- interpCmd interp $ PrepFFI ffiInfoArgs ffiInfoRet
pure $ fromIntegral p
- BCONPtrCostCentre BreakpointId{..}
+ BCONPtrCostCentre InternalBreakpointId{..}
| interpreterProfiled interp -> do
- case expectJust (lookupModuleEnv (ccs_env lb) bi_tick_mod) ! bi_tick_index of
+ case expectJust (lookupModuleEnv (ccs_env lb) ibi_info_mod) ! ibi_info_index of
RemotePtr p -> pure $ fromIntegral p
| otherwise ->
case toRemotePtr nullPtr of
=====================================
compiler/GHC/ByteCode/Types.hs
=====================================
@@ -285,7 +285,7 @@ data BCONPtr
-- | A libffi ffi_cif function prototype.
| BCONPtrFFIInfo !FFIInfo
-- | A 'CostCentre' remote pointer array's respective 'BreakpointId'
- | BCONPtrCostCentre !BreakpointId
+ | BCONPtrCostCentre !InternalBreakpointId
instance NFData BCONPtr where
rnf x = x `seq` ()
=====================================
compiler/GHC/CoreToIface.hs
=====================================
@@ -704,12 +704,13 @@ toIfaceLFInfo nm lfi = case lfi of
-- Dehydrating CgBreakInfo
-dehydrateCgBreakInfo :: [TyVar] -> [Maybe (Id, Word)] -> Type -> CgBreakInfo
-dehydrateCgBreakInfo ty_vars idOffSets tick_ty =
+dehydrateCgBreakInfo :: [TyVar] -> [Maybe (Id, Word)] -> Type -> BreakpointId -> CgBreakInfo
+dehydrateCgBreakInfo ty_vars idOffSets tick_ty bid =
CgBreakInfo
{ cgb_tyvars = map toIfaceTvBndr ty_vars
, cgb_vars = map (fmap (\(i, offset) -> (toIfaceIdBndr i, offset))) idOffSets
, cgb_resty = toIfaceType tick_ty
+ , cgb_tick_id = bid
}
{- Note [Inlining and hs-boot files]
=====================================
compiler/GHC/Driver/Make.hs
=====================================
@@ -1552,7 +1552,7 @@ wrapAction msg_wrapper hsc_env k = do
-- ThreadKilled in particular needs to actually kill the thread.
-- So rethrow that and the other async exceptions
Just (err :: SomeAsyncException) -> throwIO err
- _ -> errorMsg lcl_logger (text (show exc))
+ _ -> reportError lcl_logger neverQualify emptyDiagOpts noSrcSpan (text (show exc))
return Nothing
=====================================
compiler/GHC/HsToCore/Breakpoints.hs
=====================================
@@ -12,7 +12,7 @@
-- 'InternalModBreaks' and 'InternalBreakId's. The latter are constructed
-- during bytecode generation and can be found in 'GHC.ByteCode.Breakpoints'.
--
--- See Note [Breakpoint identifiers]
+-- See Note [ModBreaks vs InternalModBreaks] and Note [Breakpoint identifiers]
module GHC.HsToCore.Breakpoints
( -- * ModBreaks
mkModBreaks, ModBreaks(..)
=====================================
compiler/GHC/Linker/Loader.hs
=====================================
@@ -43,6 +43,7 @@ import GHC.Settings
import GHC.Platform
import GHC.Platform.Ways
+import GHC.Driver.Errors
import GHC.Driver.Phases
import GHC.Driver.Env
import GHC.Driver.Session
@@ -50,7 +51,7 @@ import GHC.Driver.Ppr
import GHC.Driver.Config.Diagnostic
import GHC.Driver.Config.Finder
-import GHC.Tc.Utils.Monad
+import GHC.Tc.Utils.Monad hiding (reportDiagnostic)
import GHC.Runtime.Interpreter
import GHCi.BreakArray
@@ -124,7 +125,9 @@ import GHC.Utils.Exception
import GHC.Unit.Home.Graph (lookupHug, unitEnv_foldWithKey)
import GHC.Driver.Downsweep
import qualified GHC.Runtime.Interpreter as GHCi
-import Data.Array.Base (numElements)
+import qualified Data.IntMap.Strict as IM
+import qualified Data.Map.Strict as M
+import Foreign.Ptr (nullPtr)
-- Note [Linkers and loaders]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -1307,9 +1310,9 @@ load_dyn interp hsc_env crash_early dll = do
then cmdLineErrorIO err
else do
when (diag_wopt Opt_WarnMissedExtraSharedLib diag_opts)
- $ logMsg logger
- (mkMCDiagnostic diag_opts (WarningWithFlag Opt_WarnMissedExtraSharedLib) Nothing)
- noSrcSpan $ withPprStyle defaultUserStyle (note err)
+ $ reportDiagnostic logger
+ neverQualify diag_opts
+ noSrcSpan (WarningWithFlag Opt_WarnMissedExtraSharedLib) $ withPprStyle defaultUserStyle (note err)
pure Nothing
where
diag_opts = initDiagOpts (hsc_dflags hsc_env)
@@ -1497,8 +1500,7 @@ locateLib interp hsc_env is_hs lib_dirs gcc_dirs lib0
, not loading_dynamic_hs_libs
, interpreterProfiled interp
= do
- let diag = mkMCDiagnostic diag_opts WarningWithoutFlag Nothing
- logMsg logger diag noSrcSpan $ withPprStyle defaultErrStyle $
+ reportDiagnostic logger neverQualify diag_opts noSrcSpan WarningWithoutFlag $ withPprStyle defaultErrStyle $
text "Interpreter failed to load profiled static library" <+> text lib <> char '.' $$
text " \tTrying dynamic library instead. If this fails try to rebuild" <+>
text "libraries with profiling support."
@@ -1666,10 +1668,10 @@ allocateBreakArrays ::
IO (ModuleEnv (ForeignRef BreakArray))
allocateBreakArrays interp =
foldlM
- ( \be0 InternalModBreaks{imodBreaks_modBreaks=ModBreaks {..}} -> do
+ ( \be0 InternalModBreaks{imodBreaks_breakInfo, imodBreaks_modBreaks=ModBreaks {..}} -> do
-- If no BreakArray is assigned to this module yet, create one
if not $ elemModuleEnv modBreaks_module be0 then do
- let count = numElements modBreaks_locs
+ let count = maybe 0 ((+1) . fst) $ IM.lookupMax imodBreaks_breakInfo
breakArray <- GHCi.newBreakArray interp count
evaluate $ extendModuleEnv be0 modBreaks_module breakArray
else
@@ -1679,29 +1681,51 @@ allocateBreakArrays interp =
-- | Given a list of 'InternalModBreaks' collected from a list
-- of 'CompiledByteCode', allocate the 'CostCentre' arrays when profiling is
-- enabled.
+--
+-- Note that the resulting arrays are indexed by 'BreakInfoIndex' (internal
+-- breakpoint index), not by tick index
allocateCCS ::
Interp ->
- ModuleEnv (Array BreakTickIndex (RemotePtr CostCentre)) ->
+ ModuleEnv (Array BreakInfoIndex (RemotePtr CostCentre)) ->
[InternalModBreaks] ->
- IO (ModuleEnv (Array BreakTickIndex (RemotePtr CostCentre)))
+ IO (ModuleEnv (Array BreakInfoIndex (RemotePtr CostCentre)))
allocateCCS interp ce mbss
- | interpreterProfiled interp =
- foldlM
- ( \ce0 InternalModBreaks{imodBreaks_modBreaks=ModBreaks {..}} -> do
- ccs <-
+ | interpreterProfiled interp = do
+ -- 1. Create a mapping from source BreakpointId to CostCentre ptr
+ ccss <- M.unions <$> mapM
+ ( \InternalModBreaks{imodBreaks_modBreaks=ModBreaks{..}} -> do
+ ccs <- {- one ccs ptr per tick index -}
mkCostCentres
interp
(moduleNameString $ moduleName modBreaks_module)
(elems modBreaks_ccs)
- if not $ elemModuleEnv modBreaks_module ce0 then do
- evaluate $
- extendModuleEnv ce0 modBreaks_module $
- listArray
- (0, length ccs - 1)
- ccs
+ return $ M.fromList $
+ zipWith (\el ix -> (BreakpointId modBreaks_module ix, el)) ccs [0..]
+ )
+ mbss
+ -- 2. Create an array with one element for every InternalBreakpointId,
+ -- where every element has the CCS for the corresponding BreakpointId
+ foldlM
+ (\ce0 InternalModBreaks{imodBreaks_breakInfo, imodBreaks_modBreaks=ModBreaks{..}} -> do
+ if not $ elemModuleEnv modBreaks_module ce then do
+ let count = maybe 0 ((+1) . fst) $ IM.lookupMax imodBreaks_breakInfo
+ let ccs = IM.map
+ (\info ->
+ fromMaybe (toRemotePtr nullPtr)
+ (M.lookup (cgb_tick_id info) ccss)
+ )
+ imodBreaks_breakInfo
+ assertPpr (count == length ccs)
+ (text "expected CgBreakInfo map to have one entry per valid ix") $
+ evaluate $
+ extendModuleEnv ce0 modBreaks_module $
+ listArray
+ (0, count)
+ (IM.elems ccs)
else
return ce0
)
ce
mbss
+
| otherwise = pure ce
=====================================
compiler/GHC/Runtime/Debugger/Breakpoints.hs
=====================================
@@ -31,6 +31,9 @@ import GHC.Unit.Module.ModSummary
import GHC.Utils.Outputable
import GHC.Utils.Panic
import qualified GHC.Data.Strict as Strict
+import qualified Data.IntMap.Strict as IntMap
+import qualified GHC.Unit.Home.Graph as HUG
+import qualified GHC.Unit.Home.PackageTable as HPT
--------------------------------------------------------------------------------
-- Finding Module breakpoints
@@ -213,6 +216,47 @@ getModBreak m = do
mod_info <- fromMaybe (panic "getModBreak") <$> getModuleInfo m
pure $ imodBreaks_modBreaks <$> modInfoModBreaks mod_info
+--------------------------------------------------------------------------------
+-- Mapping source-level BreakpointIds to IBI occurrences
+-- (See Note [Breakpoint identifiers])
+--------------------------------------------------------------------------------
+
+-- | A source-level breakpoint may have been inlined into many occurrences, now
+-- referred by 'InternalBreakpointId'. When a breakpoint is set on a certain
+-- source breakpoint, it means all *ocurrences* of that breakpoint across
+-- modules should be stopped at -- hence we keep a trie from BreakpointId to
+-- the list of internal break ids using it.
+-- See also Note [Breakpoint identifiers]
+type BreakpointOccurrences = ModuleEnv (IntMap.IntMap [InternalBreakpointId])
+
+-- | Lookup all InternalBreakpointIds matching the given BreakpointId
+-- Nothing if BreakpointId not in map
+lookupBreakpointOccurrences :: BreakpointOccurrences -> BreakpointId -> Maybe [InternalBreakpointId]
+lookupBreakpointOccurrences bmp (BreakpointId md tick) =
+ lookupModuleEnv bmp md >>= IntMap.lookup tick
+
+-- | Construct a mapping from Source 'BreakpointId's to 'InternalBreakpointId's from the given list of 'ModInfo's
+mkBreakpointOccurrences :: forall m. GhcMonad m => m BreakpointOccurrences
+mkBreakpointOccurrences = do
+ hug <- hsc_HUG <$> getSession
+ liftIO $ foldr go (pure emptyModuleEnv) hug
+ where
+ go :: HUG.HomeUnitEnv -> IO BreakpointOccurrences -> IO BreakpointOccurrences
+ go hue mbmp = do
+ bmp <- mbmp
+ ibrkss <- HPT.concatHpt (\hmi -> maybeToList (getModBreaks hmi))
+ (HUG.homeUnitEnv_hpt hue)
+ return $ foldr addBreakToMap bmp ibrkss
+
+ addBreakToMap :: InternalModBreaks -> BreakpointOccurrences -> BreakpointOccurrences
+ addBreakToMap ibrks bmp0 = do
+ let imod = modBreaks_module $ imodBreaks_modBreaks ibrks
+ IntMap.foldrWithKey (\info_ix cgi bmp -> do
+ let ibi = InternalBreakpointId imod info_ix
+ let BreakpointId tick_mod tick_ix = cgb_tick_id cgi
+ extendModuleEnvWith (IntMap.unionWith (S.<>)) bmp tick_mod (IntMap.singleton tick_ix [ibi])
+ ) bmp0 (imodBreaks_breakInfo ibrks)
+
--------------------------------------------------------------------------------
-- Getting current breakpoint information
--------------------------------------------------------------------------------
@@ -235,9 +279,15 @@ getCurrentBreakSpan = do
getCurrentBreakModule :: GhcMonad m => m (Maybe Module)
getCurrentBreakModule = do
resumes <- getResumeContext
- return $ case resumes of
- [] -> Nothing
+ hug <- hsc_HUG <$> getSession
+ liftIO $ case resumes of
+ [] -> pure Nothing
(r:_) -> case resumeHistoryIx r of
- 0 -> ibi_tick_mod <$> resumeBreakpointId r
- ix -> Just $ getHistoryModule $ resumeHistory r !! (ix-1)
+ 0 -> case resumeBreakpointId r of
+ Nothing -> pure Nothing
+ Just ibi -> do
+ brks <- readIModBreaks hug ibi
+ return $ Just $ bi_tick_mod $ getBreakSourceId ibi brks
+ ix ->
+ Just <$> getHistoryModule hug (resumeHistory r !! (ix-1))
=====================================
compiler/GHC/Runtime/Eval.hs
=====================================
@@ -18,7 +18,7 @@ module GHC.Runtime.Eval (
abandon, abandonAll,
getResumeContext,
getHistorySpan,
- getModBreaks, readModBreaks,
+ getModBreaks, readIModBreaks, readIModModBreaks,
getHistoryModule,
setupBreakpoint,
back, forward,
@@ -147,14 +147,17 @@ getResumeContext = withSession (return . ic_resume . hsc_IC)
mkHistory :: HUG.HomeUnitGraph -> ForeignHValue -> InternalBreakpointId -> IO History
mkHistory hug hval ibi = History hval ibi <$> findEnclosingDecls hug ibi
-getHistoryModule :: History -> Module
-getHistoryModule = ibi_tick_mod . historyBreakpointId
+getHistoryModule :: HUG.HomeUnitGraph -> History -> IO Module
+getHistoryModule hug hist = do
+ let ibi = historyBreakpointId hist
+ brks <- readIModBreaks hug ibi
+ return $ bi_tick_mod $ getBreakSourceId ibi brks
getHistorySpan :: HUG.HomeUnitGraph -> History -> IO SrcSpan
getHistorySpan hug hist = do
let ibi = historyBreakpointId hist
- brks <- readModBreaks hug (ibi_tick_mod ibi)
- return $ getBreakLoc ibi brks
+ brks <- readIModBreaks hug ibi
+ getBreakLoc (readIModModBreaks hug) ibi brks
{- | Finds the enclosing top level function name -}
-- ToDo: a better way to do this would be to keep hold of the decl_path computed
@@ -162,8 +165,8 @@ getHistorySpan hug hist = do
-- for each tick.
findEnclosingDecls :: HUG.HomeUnitGraph -> InternalBreakpointId -> IO [String]
findEnclosingDecls hug ibi = do
- brks <- readModBreaks hug (ibi_tick_mod ibi)
- return $ getBreakDecls ibi brks
+ brks <- readIModBreaks hug ibi
+ getBreakDecls (readIModModBreaks hug) ibi brks
-- | Update fixity environment in the current interactive context.
updateFixityEnv :: GhcMonad m => FixityEnv -> m ()
@@ -350,15 +353,14 @@ handleRunStatus step expr bindings final_ids status history0 = do
EvalBreak apStack_ref (Just eval_break) resume_ctxt ccs -> do
let ibi = evalBreakpointToId eval_break
let hug = hsc_HUG hsc_env
- tick_brks <- liftIO $ readModBreaks hug (ibi_tick_mod ibi)
- let
- span = getBreakLoc ibi tick_brks
- decl = intercalate "." $ getBreakDecls ibi tick_brks
+ info_brks <- liftIO $ readIModBreaks hug ibi
+ span <- liftIO $ getBreakLoc (readIModModBreaks hug) ibi info_brks
+ decl <- liftIO $ intercalate "." <$> getBreakDecls (readIModModBreaks hug) ibi info_brks
-- Was this breakpoint explicitly enabled (ie. in @BreakArray@)?
bactive <- liftIO $ do
- breakArray <- getBreakArray interp (toBreakpointId ibi) tick_brks
- breakpointStatus interp breakArray (ibi_tick_index ibi)
+ breakArray <- getBreakArray interp ibi info_brks
+ breakpointStatus interp breakArray (ibi_info_index ibi)
apStack_fhv <- liftIO $ mkFinalizedHValue interp apStack_ref
resume_ctxt_fhv <- liftIO $ mkFinalizedHValue interp resume_ctxt
@@ -446,7 +448,7 @@ resumeExec step mbCnt
-- When the user specified a break ignore count, set it
-- in the interpreter
case (mb_brkpt, mbCnt) of
- (Just brkpt, Just cnt) -> setupBreakpoint interp (toBreakpointId brkpt) cnt
+ (Just brkpt, Just cnt) -> setupBreakpoint interp brkpt cnt
_ -> return ()
let eval_opts = initEvalOpts dflags (enableGhcStepMode step)
@@ -462,17 +464,18 @@ resumeExec step mbCnt
| otherwise -> pure prevHistoryLst
handleRunStatus step expr bindings final_ids status =<< hist'
-setupBreakpoint :: GhcMonad m => Interp -> BreakpointId -> Int -> m () -- #19157
-setupBreakpoint interp bi cnt = do
+setupBreakpoint :: GhcMonad m => Interp -> InternalBreakpointId -> Int -> m () -- #19157
+setupBreakpoint interp ibi cnt = do
hug <- hsc_HUG <$> getSession
- modBreaks <- liftIO $ readModBreaks hug (bi_tick_mod bi)
- breakArray <- liftIO $ getBreakArray interp bi modBreaks
- liftIO $ GHCi.storeBreakpoint interp breakArray (bi_tick_index bi) cnt
+ liftIO $ do
+ modBreaks <- readIModBreaks hug ibi
+ breakArray <- getBreakArray interp ibi modBreaks
+ GHCi.storeBreakpoint interp breakArray (ibi_info_index ibi) cnt
-getBreakArray :: Interp -> BreakpointId -> InternalModBreaks -> IO (ForeignRef BreakArray)
-getBreakArray interp BreakpointId{bi_tick_mod} imbs = do
+getBreakArray :: Interp -> InternalBreakpointId -> InternalModBreaks -> IO (ForeignRef BreakArray)
+getBreakArray interp InternalBreakpointId{ibi_info_mod} imbs = do
breaks0 <- linked_breaks . fromMaybe (panic "Loader not initialised") <$> getLoaderState interp
- case lookupModuleEnv (breakarray_env breaks0) bi_tick_mod of
+ case lookupModuleEnv (breakarray_env breaks0) ibi_info_mod of
Just ba -> return ba
Nothing -> do
modifyLoaderState interp $ \ld_st -> do
@@ -483,13 +486,12 @@ getBreakArray interp BreakpointId{bi_tick_mod} imbs = do
ba_env <- allocateBreakArrays interp (breakarray_env lb) [imbs]
let ld_st' = ld_st { linked_breaks = lb{breakarray_env = ba_env} }
- let ba = expectJust {- just computed -} $ lookupModuleEnv ba_env bi_tick_mod
+ let ba = expectJust {- just computed -} $ lookupModuleEnv ba_env ibi_info_mod
return
( ld_st'
, ba
)
-
back :: GhcMonad m => Int -> m ([Name], Int, SrcSpan)
back n = moveHist (+n)
@@ -517,8 +519,9 @@ moveHist fn = do
span <- case mb_info of
Nothing -> return $ mkGeneralSrcSpan (fsLit "<unknown>")
Just ibi -> liftIO $ do
- brks <- readModBreaks (hsc_HUG hsc_env) (ibi_tick_mod ibi)
- return $ getBreakLoc ibi brks
+ let hug = hsc_HUG hsc_env
+ brks <- readIModBreaks hug ibi
+ getBreakLoc (readIModModBreaks hug) ibi brks
(hsc_env1, names) <-
liftIO $ bindLocalsAtBreakpoint hsc_env apStack span mb_info
let ic = hsc_IC hsc_env1
@@ -579,11 +582,10 @@ bindLocalsAtBreakpoint hsc_env apStack span Nothing = do
-- of the breakpoint and the free variables of the expression.
bindLocalsAtBreakpoint hsc_env apStack_fhv span (Just ibi) = do
let hug = hsc_HUG hsc_env
- info_brks <- readModBreaks hug (ibi_info_mod ibi)
- tick_brks <- readModBreaks hug (ibi_tick_mod ibi)
- let info = getInternalBreak ibi (info_brks)
+ info_brks <- readIModBreaks hug ibi
+ let info = getInternalBreak ibi info_brks
interp = hscInterp hsc_env
- occs = getBreakVars ibi tick_brks
+ occs <- getBreakVars (readIModModBreaks hug) ibi info_brks
-- Rehydrate to understand the breakpoint info relative to the current environment.
-- This design is critical to preventing leaks (#22530)
=====================================
compiler/GHC/Runtime/Interpreter.hs
=====================================
@@ -27,7 +27,9 @@ module GHC.Runtime.Interpreter
, getClosure
, whereFrom
, getModBreaks
- , readModBreaks
+ , readIModBreaks
+ , readIModBreaksMaybe
+ , readIModModBreaks
, seqHValue
, evalBreakpointToId
@@ -92,7 +94,6 @@ import GHC.Utils.Fingerprint
import GHC.Unit.Module
import GHC.Unit.Home.ModInfo
-import GHC.Unit.Home.Graph (lookupHugByModule)
import GHC.Unit.Env
#if defined(HAVE_INTERNAL_INTERPRETER)
@@ -411,15 +412,10 @@ evalBreakpointToId :: EvalBreakpoint -> InternalBreakpointId
evalBreakpointToId eval_break =
let
mkUnitId u = fsToUnit $ mkFastStringShortByteString u
-
toModule u n = mkModule (mkUnitId u) (mkModuleName n)
- tickl = toModule (eb_tick_mod_unit eval_break) (eb_tick_mod eval_break)
- infol = toModule (eb_info_mod_unit eval_break) (eb_info_mod eval_break)
in
InternalBreakpointId
- { ibi_tick_mod = tickl
- , ibi_tick_index = eb_tick_index eval_break
- , ibi_info_mod = infol
+ { ibi_info_mod = toModule (eb_info_mod_unit eval_break) (eb_info_mod eval_break)
, ibi_info_index = eb_info_index eval_break
}
@@ -440,17 +436,18 @@ handleSeqHValueStatus interp unit_env eval_status =
-- Reason: Setting of flags in libraries/ghci/GHCi/Run.hs:evalOptsSeq
Just break -> do
- let bi = evalBreakpointToId break
+ let ibi = evalBreakpointToId break
+ hug = ue_home_unit_graph unit_env
-- Just case: Stopped at a breakpoint, extract SrcSpan information
-- from the breakpoint.
- mb_modbreaks <- getModBreaks . expectJust <$>
- lookupHugByModule (ibi_tick_mod bi) (ue_home_unit_graph unit_env)
+ mb_modbreaks <- readIModBreaksMaybe hug (ibi_info_mod ibi)
case mb_modbreaks of
-- Nothing case - should not occur! We should have the appropriate
-- breakpoint information
Nothing -> nothing_case
- Just modbreaks -> put $ brackets . ppr $ getBreakLoc bi modbreaks
+ Just modbreaks -> put . brackets . ppr =<<
+ getBreakLoc (readIModModBreaks hug) ibi modbreaks
-- resume the seq (:force) processing in the iserv process
withForeignRef resume_ctxt_fhv $ \hval -> do
@@ -745,10 +742,18 @@ getModBreaks hmi
| otherwise
= Nothing -- probably object code
--- | Read the 'InternalModBreaks' and 'ModBreaks' of the given home 'Module'
--- from the 'HomeUnitGraph'.
-readModBreaks :: HomeUnitGraph -> Module -> IO InternalModBreaks
-readModBreaks hug modl = expectJust . getModBreaks . expectJust <$> HUG.lookupHugByModule modl hug
+-- | Read the 'InternalModBreaks' of the given home 'Module' (via
+-- 'InternalBreakpointId') from the 'HomeUnitGraph'.
+readIModBreaks :: HomeUnitGraph -> InternalBreakpointId -> IO InternalModBreaks
+readIModBreaks hug ibi = expectJust <$> readIModBreaksMaybe hug (ibi_info_mod ibi)
+
+-- | Read the 'InternalModBreaks' of the given home 'Module' from the 'HomeUnitGraph'.
+readIModBreaksMaybe :: HomeUnitGraph -> Module -> IO (Maybe InternalModBreaks)
+readIModBreaksMaybe hug mod = getModBreaks . expectJust <$> HUG.lookupHugByModule mod hug
+
+-- | Read the 'ModBreaks' from the given module's 'InternalModBreaks'
+readIModModBreaks :: HUG.HomeUnitGraph -> Module -> IO ModBreaks
+readIModModBreaks hug mod = imodBreaks_modBreaks . expectJust <$> readIModBreaksMaybe hug mod
-- -----------------------------------------------------------------------------
-- Misc utils
=====================================
compiler/GHC/StgToByteCode.hs
=====================================
@@ -31,7 +31,6 @@ import GHC.Cmm.Utils
import GHC.Platform
import GHC.Platform.Profile
-import GHC.Runtime.Interpreter
import GHCi.FFI
import GHC.Types.Basic
import GHC.Utils.Outputable
@@ -64,6 +63,7 @@ import GHC.StgToCmm.Closure ( NonVoid(..), fromNonVoid, idPrimRepU,
assertNonVoidIds, assertNonVoidStgArgs )
import GHC.StgToCmm.Layout
import GHC.Runtime.Heap.Layout hiding (WordOff, ByteOff, wordsToBytes)
+import GHC.Runtime.Interpreter ( interpreterProfiled )
import GHC.Data.Bitmap
import GHC.Data.FlatBag as FlatBag
import GHC.Data.OrdList
@@ -79,7 +79,6 @@ import Control.Monad
import Data.Char
import GHC.Unit.Module
-import qualified GHC.Unit.Home.Graph as HUG
import Data.Coerce (coerce)
#if MIN_VERSION_rts(1,0,3)
@@ -394,65 +393,28 @@ schemeR_wrk fvs nm original_body (args, body)
-- | Introduce break instructions for ticked expressions.
-- If no breakpoint information is available, the instruction is omitted.
schemeER_wrk :: StackDepth -> BCEnv -> CgStgExpr -> BcM BCInstrList
-schemeER_wrk d p (StgTick (Breakpoint tick_ty (BreakpointId tick_mod tick_no) fvs) rhs) = do
+schemeER_wrk d p (StgTick (Breakpoint tick_ty tick_id fvs) rhs) = do
code <- schemeE d 0 p rhs
- hsc_env <- getHscEnv
- current_mod <- getCurrentModule
mb_current_mod_breaks <- getCurrentModBreaks
case mb_current_mod_breaks of
-- if we're not generating ModBreaks for this module for some reason, we
-- can't store breakpoint occurrence information.
Nothing -> pure code
- Just current_mod_breaks -> break_info hsc_env tick_mod current_mod mb_current_mod_breaks >>= \case
- Nothing -> pure code
- Just ModBreaks{modBreaks_module = tick_mod} -> do
- platform <- profilePlatform <$> getProfile
- let idOffSets = getVarOffSets platform d p fvs
- ty_vars = tyCoVarsOfTypesWellScoped (tick_ty:map idType fvs)
- toWord :: Maybe (Id, WordOff) -> Maybe (Id, Word)
- toWord = fmap (\(i, wo) -> (i, fromIntegral wo))
- breakInfo = dehydrateCgBreakInfo ty_vars (map toWord idOffSets) tick_ty
+ Just current_mod_breaks -> do
+ platform <- profilePlatform <$> getProfile
+ let idOffSets = getVarOffSets platform d p fvs
+ ty_vars = tyCoVarsOfTypesWellScoped (tick_ty:map idType fvs)
+ toWord :: Maybe (Id, WordOff) -> Maybe (Id, Word)
+ toWord = fmap (\(i, wo) -> (i, fromIntegral wo))
+ breakInfo = dehydrateCgBreakInfo ty_vars (map toWord idOffSets) tick_ty tick_id
- let info_mod = modBreaks_module current_mod_breaks
- infox <- newBreakInfo breakInfo
+ let info_mod = modBreaks_module current_mod_breaks
+ infox <- newBreakInfo breakInfo
- let breakInstr = BRK_FUN (InternalBreakpointId tick_mod tick_no info_mod infox)
- return $ breakInstr `consOL` code
+ let breakInstr = BRK_FUN (InternalBreakpointId info_mod infox)
+ return $ breakInstr `consOL` code
schemeER_wrk d p rhs = schemeE d 0 p rhs
--- | Determine the GHCi-allocated 'BreakArray' and module pointer for the module
--- from which the breakpoint originates.
--- These are stored in 'ModBreaks' as remote pointers in order to allow the BCOs
--- to refer to pointers in GHCi's address space.
--- They are initialized in 'GHC.HsToCore.Breakpoints.mkModBreaks', called by
--- 'GHC.HsToCore.deSugar'.
---
--- Breakpoints might be disabled because we're in TH, because
--- @-fno-break-points@ was specified, or because a module was reloaded without
--- reinitializing 'ModBreaks'.
---
--- If the module stored in the breakpoint is the currently processed module, use
--- the 'ModBreaks' from the state.
--- If that is 'Nothing', consider breakpoints to be disabled and skip the
--- instruction.
---
--- If the breakpoint is inlined from another module, look it up in the HUG (home unit graph).
--- If the module doesn't exist there, or if the 'ModBreaks' value is
--- uninitialized, skip the instruction (i.e. return Nothing).
-break_info ::
- HscEnv ->
- Module ->
- Module ->
- Maybe ModBreaks ->
- BcM (Maybe ModBreaks)
-break_info hsc_env mod current_mod current_mod_breaks
- | mod == current_mod
- = pure current_mod_breaks
- | otherwise
- = liftIO (HUG.lookupHugByModule mod (hsc_HUG hsc_env)) >>= \case
- Just hp -> pure $ imodBreaks_modBreaks <$> getModBreaks hp
- Nothing -> pure Nothing
-
getVarOffSets :: Platform -> StackDepth -> BCEnv -> [Id] -> [Maybe (Id, WordOff)]
getVarOffSets platform depth env = map getOffSet
where
=====================================
compiler/GHC/SysTools/Tasks.hs
=====================================
@@ -55,7 +55,7 @@ import GHC.Driver.Config.Diagnostic
import GHC.Driver.Errors
import GHC.Driver.Errors.Types (GhcMessage(..), DriverMessage (DriverNoConfiguredLLVMToolchain))
import GHC.Driver.CmdLine (warnsToMessages)
-import GHC.Types.SrcLoc (noLoc)
+import GHC.Types.SrcLoc (noLoc, noSrcSpan)
{-
************************************************************************
@@ -346,7 +346,7 @@ figureLlvmVersion logger dflags = traceSystoolCommand logger "llc" $ do
debugTraceMsg logger 2
(text "Error (figuring out LLVM version):" <+>
text (show err))
- errorMsg logger $ vcat
+ reportError logger neverQualify emptyDiagOpts noSrcSpan $ vcat
[ text "Warning:", nest 9 $
text "Couldn't figure out LLVM version!" $$
text ("Make sure you have installed LLVM between ["
=====================================
compiler/GHC/Utils/Error.hs
=====================================
@@ -32,7 +32,7 @@ module GHC.Utils.Error (
emptyMessages, mkDecorated, mkLocMessage,
mkMsgEnvelope, mkPlainMsgEnvelope, mkPlainErrorMsgEnvelope,
mkErrorMsgEnvelope,
- mkMCDiagnostic, errorDiagnostic, diagReasonSeverity,
+ mkMCDiagnostic, diagReasonSeverity,
mkPlainError,
mkPlainDiagnostic,
@@ -46,7 +46,6 @@ module GHC.Utils.Error (
-- * Issuing messages during compilation
putMsg, printInfoForUser, printOutputForUser,
logInfo, logOutput,
- errorMsg,
fatalErrorMsg,
compilationProgressMsg,
showPass,
@@ -168,11 +167,6 @@ mkMCDiagnostic opts reason code = MCDiagnostic sev reason' code
where
(sev, reason') = diag_reason_severity opts reason
--- | Varation of 'mkMCDiagnostic' which can be used when we are /sure/ the
--- input 'DiagnosticReason' /is/ 'ErrorWithoutFlag' and there is no diagnostic code.
-errorDiagnostic :: MessageClass
-errorDiagnostic = MCDiagnostic SevError (ResolvedDiagnosticReason ErrorWithoutFlag) Nothing
-
--
-- Creating MsgEnvelope(s)
--
@@ -318,17 +312,12 @@ sortMsgBag mopts = maybeLimit . sortBy (cmp `on` errMsgSpan) . bagToList
ghcExit :: Logger -> Int -> IO ()
ghcExit logger val
| val == 0 = exitWith ExitSuccess
- | otherwise = do errorMsg logger (text "\nCompilation had errors\n\n")
+ | otherwise = do fatalErrorMsg logger (text "\nCompilation had errors\n\n")
exitWith (ExitFailure val)
-- -----------------------------------------------------------------------------
-- Outputting messages from the compiler
-errorMsg :: Logger -> SDoc -> IO ()
-errorMsg logger msg
- = logMsg logger errorDiagnostic noSrcSpan $
- withPprStyle defaultErrStyle msg
-
fatalErrorMsg :: Logger -> SDoc -> IO ()
fatalErrorMsg logger msg =
logMsg logger MCFatal noSrcSpan $ withPprStyle defaultErrStyle msg
=====================================
ghc/GHCi/UI.hs
=====================================
@@ -45,7 +45,7 @@ import GHC.Runtime.Eval (mkTopLevEnv)
import GHC.Runtime.Eval.Utils
-- The GHC interface
-import GHC.ByteCode.Breakpoints (imodBreaks_modBreaks)
+import GHC.ByteCode.Breakpoints (imodBreaks_modBreaks, InternalBreakpointId(..), getBreakSourceId)
import GHC.Runtime.Interpreter
import GHCi.RemoteTypes
import GHCi.BreakArray( breakOn, breakOff )
@@ -68,7 +68,7 @@ import GHC ( LoadHowMuch(..), Target(..), TargetId(..),
Resume, SingleStep, Ghc,
GetDocsFailure(..), pushLogHookM,
getModuleGraph, handleSourceError,
- InternalBreakpointId(..) )
+ BreakpointId(..) )
import GHC.Driver.Main (hscParseModuleWithLocation, hscParseStmtWithLocation)
import GHC.Hs.ImpExp
import GHC.Hs
@@ -546,6 +546,7 @@ interactiveUI config srcs maybe_exprs = do
break_ctr = 0,
breaks = IntMap.empty,
tickarrays = emptyModuleEnv,
+ internalBreaks = emptyModuleEnv,
ghci_commands = availableCommands config,
ghci_macros = [],
last_command = Nothing,
@@ -1616,13 +1617,15 @@ toBreakIdAndLocation :: GhciMonad m
toBreakIdAndLocation Nothing = return Nothing
toBreakIdAndLocation (Just inf) = do
st <- getGHCiState
+ hug <- hsc_HUG <$> GHC.getSession
+ brks <- liftIO $ readIModBreaks hug inf
+ let bi = getBreakSourceId inf brks
return $ listToMaybe [ id_loc | id_loc@(_,loc) <- IntMap.assocs (breaks st),
- breakModule loc == ibi_tick_mod inf,
- breakTick loc == ibi_tick_index inf ]
+ breakId loc == bi ]
printStoppedAtBreakInfo :: GHC.GhcMonad m => Resume -> [Name] -> m ()
printStoppedAtBreakInfo res names = do
- printForUser $ pprStopped res
+ printForUser =<< pprStopped res
-- printTypeOfNames session names
let namesSorted = sortBy compareNames names
tythings <- catMaybes `liftM` mapM GHC.lookupName namesSorted
@@ -3804,22 +3807,32 @@ showBkptTable = do
showContext :: GHC.GhcMonad m => m ()
showContext = do
resumes <- GHC.getResumeContext
- printForUser $ vcat (map pp_resume (reverse resumes))
+ docs <- mapM pp_resume (reverse resumes)
+ printForUser $ vcat docs
where
- pp_resume res =
- text "--> " <> text (GHC.resumeStmt res)
- $$ nest 2 (pprStopped res)
-
-pprStopped :: GHC.Resume -> SDoc
-pprStopped res =
- text "Stopped in"
- <+> ((case mb_mod_name of
- Nothing -> empty
- Just mod_name -> ftext (moduleNameFS mod_name) <> char '.')
- <> text (GHC.resumeDecl res))
- <> char ',' <+> ppr (GHC.resumeSpan res)
- where
- mb_mod_name = moduleName <$> ibi_tick_mod <$> GHC.resumeBreakpointId res
+ pp_resume res = do
+ stopped <- pprStopped res
+ return $
+ text "--> " <> text (GHC.resumeStmt res)
+ $$ nest 2 stopped
+
+pprStopped :: GHC.GhcMonad m => GHC.Resume -> m SDoc
+pprStopped res = do
+ let mibi = GHC.resumeBreakpointId res
+ mb_mod_name <- case mibi of
+ Nothing -> pure Nothing
+ Just ibi -> do
+ hug <- hsc_HUG <$> GHC.getSession
+ brks <- liftIO $ readIModBreaks hug ibi
+ return $ Just $ moduleName $
+ bi_tick_mod $ getBreakSourceId ibi brks
+ return $
+ text "Stopped in"
+ <+> ((case mb_mod_name of
+ Nothing -> empty
+ Just mod_name -> ftext (moduleNameFS mod_name) <> char '.')
+ <> text (GHC.resumeDecl res))
+ <> char ',' <+> ppr (GHC.resumeSpan res)
showUnits :: GHC.GhcMonad m => m ()
showUnits = mapNonInteractiveHomeUnitsM $ \dflags -> do
@@ -4373,12 +4386,8 @@ ignoreCmd argLine = withSandboxOnly ":ignore" $ do
result <- ignoreSwitch (words argLine)
case result of
Left sdoc -> printForUser sdoc
- Right (loc, count) -> do
- let bi = GHC.BreakpointId
- { bi_tick_mod = breakModule loc
- , bi_tick_index = breakTick loc
- }
- setupBreakpoint bi count
+ Right (loc, count) -> do
+ setupBreakpoint (breakId loc) count
ignoreSwitch :: GhciMonad m => [String] -> m (Either SDoc (BreakLocation, Int))
ignoreSwitch [break, count] = do
@@ -4395,10 +4404,13 @@ getIgnoreCount str =
where
sdocIgnore = text "Ignore count" <+> quotes (text str)
-setupBreakpoint :: GhciMonad m => GHC.BreakpointId -> Int -> m()
-setupBreakpoint loc count = do
+setupBreakpoint :: GhciMonad m => GHC.BreakpointId -> Int -> m ()
+setupBreakpoint bi count = do
hsc_env <- GHC.getSession
- GHC.setupBreakpoint (hscInterp hsc_env) loc count
+ -- Trigger all internal breaks that match this source break id
+ internal_break_ids <- getInternalBreaksOf bi
+ forM_ internal_break_ids $ \ibi -> do
+ GHC.setupBreakpoint (hscInterp hsc_env) ibi count
backCmd :: GhciMonad m => String -> m ()
backCmd arg
@@ -4489,20 +4501,20 @@ findBreakAndSet md lookupTickTree = do
some -> mapM_ breakAt some
where
breakAt (tick, pan) = do
- setBreakFlag md tick True
- (alreadySet, nm) <-
- recordBreak $ BreakLocation
- { breakModule = md
- , breakLoc = RealSrcSpan pan Strict.Nothing
- , breakTick = tick
- , onBreakCmd = ""
- , breakEnabled = True
- }
- printForUser $
- text "Breakpoint " <> ppr nm <>
- if alreadySet
- then text " was already set at " <> ppr pan
- else text " activated at " <> ppr pan
+ let bi = BreakpointId md tick
+ setBreakFlag bi True
+ (alreadySet, nm) <-
+ recordBreak $ BreakLocation
+ { breakLoc = RealSrcSpan pan Strict.Nothing
+ , breakId = bi
+ , onBreakCmd = ""
+ , breakEnabled = True
+ }
+ printForUser $
+ text "Breakpoint " <> ppr nm <>
+ if alreadySet
+ then text " was already set at " <> ppr pan
+ else text " activated at " <> ppr pan
-- For now, use ANSI bold on terminals that we know support it.
-- Otherwise, we add a line of carets under the active expression instead.
@@ -4749,14 +4761,32 @@ turnBreakOnOff :: GhciMonad m => Bool -> BreakLocation -> m BreakLocation
turnBreakOnOff onOff loc
| onOff == breakEnabled loc = return loc
| otherwise = do
- setBreakFlag (breakModule loc) (breakTick loc) onOff
+ setBreakFlag (breakId loc) onOff
return loc { breakEnabled = onOff }
-setBreakFlag :: GhciMonad m => Module -> Int -> Bool ->m ()
-setBreakFlag md ix enaDisa = do
+setBreakFlag :: GhciMonad m => GHC.BreakpointId -> Bool -> m ()
+setBreakFlag (BreakpointId md ix) enaDisa = do
let enaDisaToCount True = breakOn
enaDisaToCount False = breakOff
- setupBreakpoint (GHC.BreakpointId md ix) $ enaDisaToCount enaDisa
+ setupBreakpoint (BreakpointId md ix) $ enaDisaToCount enaDisa
+
+-- --------------------------------------------------------------------------
+-- Find matching Internal Breakpoints
+
+-- | Find all the internal breakpoints that use the given source-level breakpoint id
+getInternalBreaksOf :: GhciMonad m => BreakpointId -> m [InternalBreakpointId]
+getInternalBreaksOf bi = do
+ st <- getGHCiState
+ let ibrks = internalBreaks st
+ case lookupBreakpointOccurrences ibrks bi of
+ Just bs -> return bs
+ Nothing -> do
+ -- Refresh the internal breakpoints map
+ bs <- mkBreakpointOccurrences
+ setGHCiState st{internalBreaks = bs}
+ return $
+ fromMaybe [] {- still not found after refresh -} $
+ lookupBreakpointOccurrences bs bi
-- ---------------------------------------------------------------------------
-- User code exception handling
=====================================
ghc/GHCi/UI/Monad.hs
=====================================
@@ -100,6 +100,14 @@ data GHCiState = GHCiState
-- ^ 'tickarrays' caches the 'TickArray' for loaded modules,
-- so that we don't rebuild it each time the user sets
-- a breakpoint.
+
+ internalBreaks :: BreakpointOccurrences,
+ -- ^ Keep a mapping from the source-level 'BreakpointId' to the
+ -- occurrences of that breakpoint across modules.
+ -- When we want to stop at a source 'BreakpointId', we essentially
+ -- trigger a breakpoint for all 'InternalBreakpointId's matching
+ -- the same source-id.
+
ghci_commands :: [Command],
-- ^ available ghci commands
ghci_macros :: [Command],
@@ -238,16 +246,15 @@ data LocalConfigBehaviour
data BreakLocation
= BreakLocation
- { breakModule :: !GHC.Module
- , breakLoc :: !SrcSpan
- , breakTick :: {-# UNPACK #-} !Int
+ { breakLoc :: !SrcSpan
+ , breakId :: !GHC.BreakpointId
+ -- ^ The 'BreakpointId' uniquely identifies a source-level breakpoint
, breakEnabled:: !Bool
, onBreakCmd :: String
}
instance Eq BreakLocation where
- loc1 == loc2 = breakModule loc1 == breakModule loc2 &&
- breakTick loc1 == breakTick loc2
+ loc1 == loc2 = breakId loc1 == breakId loc2
prettyLocations :: IntMap.IntMap BreakLocation -> SDoc
prettyLocations locs =
@@ -256,7 +263,7 @@ prettyLocations locs =
False -> vcat $ map (\(i, loc) -> brackets (int i) <+> ppr loc) $ IntMap.toAscList locs
instance Outputable BreakLocation where
- ppr loc = (ppr $ breakModule loc) <+> ppr (breakLoc loc) <+> pprEnaDisa <+>
+ ppr loc = (ppr $ GHC.bi_tick_mod $ breakId loc) <+> ppr (breakLoc loc) <+> pprEnaDisa <+>
if null (onBreakCmd loc)
then empty
else doubleQuotes (text (onBreakCmd loc))
=====================================
libraries/ghci/GHCi/Debugger.hs
=====================================
@@ -65,10 +65,7 @@ foreign import ccall "&rts_stop_on_exception" exceptionFlag :: Ptr CInt
--------------------------------------------------------------------------------
type BreakpointCallback
- = Addr# -- pointer to the breakpoint tick module name
- -> Addr# -- pointer to the breakpoint tick module unit id
- -> Int# -- breakpoint tick index
- -> Addr# -- pointer to the breakpoint info module name
+ = Addr# -- pointer to the breakpoint info module name
-> Addr# -- pointer to the breakpoint info module unit id
-> Int# -- breakpoint info index
-> Bool -- exception?
=====================================
libraries/ghci/GHCi/Message.hs
=====================================
@@ -418,10 +418,7 @@ data EvalStatus_ a b
instance Binary a => Binary (EvalStatus_ a b)
data EvalBreakpoint = EvalBreakpoint
- { eb_tick_mod :: String -- ^ Breakpoint tick module
- , eb_tick_mod_unit :: BS.ShortByteString -- ^ Breakpoint tick module unit id
- , eb_tick_index :: Int -- ^ Breakpoint tick index
- , eb_info_mod :: String -- ^ Breakpoint info module
+ { eb_info_mod :: String -- ^ Breakpoint info module
, eb_info_mod_unit :: BS.ShortByteString -- ^ Breakpoint tick module unit id
, eb_info_index :: Int -- ^ Breakpoint info index
}
=====================================
libraries/ghci/GHCi/Run.hs
=====================================
@@ -345,7 +345,7 @@ withBreakAction opts breakMVar statusMVar mtid act
-- as soon as it is hit, or in resetBreakAction below.
onBreak :: BreakpointCallback
- onBreak tick_mod# tick_mod_uid# tickx# info_mod# info_mod_uid# infox# is_exception apStack = do
+ onBreak info_mod# info_mod_uid# infox# is_exception apStack = do
tid <- myThreadId
let resume = ResumeContext
{ resumeBreakMVar = breakMVar
@@ -358,11 +358,9 @@ withBreakAction opts breakMVar statusMVar mtid act
if is_exception
then pure Nothing
else do
- tick_mod <- peekCString (Ptr tick_mod#)
- tick_mod_uid <- BS.packCString (Ptr tick_mod_uid#)
info_mod <- peekCString (Ptr info_mod#)
info_mod_uid <- BS.packCString (Ptr info_mod_uid#)
- pure (Just (EvalBreakpoint tick_mod tick_mod_uid (I# tickx#) info_mod info_mod_uid (I# infox#)))
+ pure (Just (EvalBreakpoint info_mod info_mod_uid (I# infox#)))
putMVar statusMVar $ EvalBreak apStack_r breakpoint resume_r ccs
takeMVar breakMVar
@@ -409,8 +407,8 @@ noBreakStablePtr :: StablePtr BreakpointCallback
noBreakStablePtr = unsafePerformIO $ newStablePtr noBreakAction
noBreakAction :: BreakpointCallback
-noBreakAction _ _ _ _ _ _ False _ = putStrLn "*** Ignoring breakpoint"
-noBreakAction _ _ _ _ _ _ True _ = return () -- exception: just continue
+noBreakAction _ _ _ False _ = putStrLn "*** Ignoring breakpoint"
+noBreakAction _ _ _ True _ = return () -- exception: just continue
-- Malloc and copy the bytes. We don't have any way to monitor the
-- lifetime of this memory, so it just leaks.
=====================================
rts/Disassembler.c
=====================================
@@ -84,16 +84,23 @@ disInstr ( StgBCO *bco, int pc )
switch (instr & 0xff) {
- case bci_BRK_FUN:
- debugBelch ("BRK_FUN " ); printPtr( ptrs[instrs[pc]] );
- debugBelch (" %d ", instrs[pc+1]); printPtr( ptrs[instrs[pc+2]] );
- CostCentre* cc = (CostCentre*)literals[instrs[pc+5]];
+ case bci_BRK_FUN: {
+ W_ p1, info_mod, info_unit_id, info_wix, np;
+ p1 = BCO_GET_LARGE_ARG;
+ info_mod = BCO_GET_LARGE_ARG;
+ info_unit_id = BCO_GET_LARGE_ARG;
+ info_wix = BCO_NEXT;
+ np = BCO_GET_LARGE_ARG;
+ debugBelch ("BRK_FUN " ); printPtr( ptrs[p1] );
+ debugBelch("%" FMT_Word, literals[info_mod] );
+ debugBelch("%" FMT_Word, literals[info_unit_id] );
+ debugBelch("%" FMT_Word, info_wix );
+ CostCentre* cc = (CostCentre*)literals[np];
if (cc) {
debugBelch(" %s", cc->label);
}
debugBelch("\n");
- pc += 6;
- break;
+ break; }
case bci_BRK_ALTS:
debugBelch ("BRK_ALTS %d\n", BCO_NEXT);
break;
=====================================
rts/Exception.cmm
=====================================
@@ -535,23 +535,17 @@ retry_pop_stack:
// be per-thread.
CInt[rts_stop_on_exception] = 0;
("ptr" ioAction) = ccall deRefStablePtr (W_[rts_breakpoint_io_action] "ptr");
- Sp = Sp - WDS(17);
- Sp(16) = exception;
- Sp(15) = stg_raise_ret_info;
- Sp(14) = exception;
- Sp(13) = ghczminternal_GHCziInternalziTypes_True_closure; // True <=> an exception
- Sp(12) = stg_ap_ppv_info;
- Sp(11) = 0;
- Sp(10) = stg_ap_n_info;
- Sp(9) = 0;
- Sp(8) = stg_ap_n_info;
- Sp(7) = 0;
- Sp(6) = stg_ap_n_info;
- Sp(5) = 0;
- Sp(4) = stg_ap_n_info;
- Sp(3) = 0;
- Sp(2) = stg_ap_n_info;
- Sp(1) = 0;
+ Sp = Sp - WDS(11);
+ Sp(10) = exception;
+ Sp(9) = stg_raise_ret_info;
+ Sp(8) = exception;
+ Sp(7) = ghczminternal_GHCziInternalziTypes_True_closure; // True <=> an exception
+ Sp(6) = stg_ap_ppv_info;
+ Sp(5) = 0;
+ Sp(4) = stg_ap_n_info;
+ Sp(3) = 0;
+ Sp(2) = stg_ap_n_info;
+ Sp(1) = 0;
R1 = ioAction;
jump RET_LBL(stg_ap_n) [R1];
}
=====================================
rts/Interpreter.c
=====================================
@@ -685,8 +685,6 @@ interpretBCO (Capability* cap)
*/
if (cap->r.rCurrentTSO->flags & TSO_STOP_AFTER_RETURN) {
- StgBCO* bco;
- StgWord16* bco_instrs;
StgHalfWord type;
/* Store the entry Sp; traverse the stack modifying Sp (using Sp macros);
@@ -706,28 +704,33 @@ interpretBCO (Capability* cap)
ASSERT(type == RET_BCO || type == STOP_FRAME);
if (type == RET_BCO) {
- bco = (StgBCO*)(SpW(1)); // BCO is first arg of a RET_BCO
+ StgBCO* bco = (StgBCO*)(SpW(1)); // BCO is first arg of a RET_BCO
ASSERT(get_itbl((StgClosure*)bco)->type == BCO);
- bco_instrs = (StgWord16*)(bco->instrs->payload);
+
+ StgWord16* instrs = (StgWord16*)(bco->instrs->payload);
+ StgWord16 bci = instrs[0];
/* A breakpoint instruction (BRK_FUN or BRK_ALTS) is always the first
* instruction in a BCO */
- if ((bco_instrs[0] & 0xFF) == bci_BRK_FUN) {
- int brk_array, tick_index;
- StgArrBytes *breakPoints;
- StgPtr* ptrs;
+ if ((bci & 0xFF) == bci_BRK_FUN) {
+ // Define rest of variables used by BCO_* Macros
+ int bciPtr = 0;
+
+ W_ arg1_brk_array, arg4_info_index;
+ arg1_brk_array = BCO_GET_LARGE_ARG;
+ /* info_mod_name = */ BCO_GET_LARGE_ARG;
+ /* info_mod_id = */ BCO_GET_LARGE_ARG;
+ arg4_info_index = BCO_NEXT;
- ptrs = (StgPtr*)(&bco->ptrs->payload[0]);
- brk_array = bco_instrs[1];
- tick_index = bco_instrs[6];
+ StgPtr* ptrs = (StgPtr*)(&bco->ptrs->payload[0]);
+ StgArrBytes* breakPoints = (StgArrBytes *) BCO_PTR(arg1_brk_array);
- breakPoints = (StgArrBytes *) BCO_PTR(brk_array);
// ACTIVATE the breakpoint by tick index
- ((StgInt*)breakPoints->payload)[tick_index] = 0;
+ ((StgInt*)breakPoints->payload)[arg4_info_index] = 0;
}
- else if ((bco_instrs[0] & 0xFF) == bci_BRK_ALTS) {
+ else if ((bci & 0xFF) == bci_BRK_ALTS) {
// ACTIVATE BRK_ALTS by setting its only argument to ON
- bco_instrs[1] = 1;
+ instrs[1] = 1;
}
// else: if there is no BRK instruction perhaps we should keep
// traversing; that said, the continuation should always have a BRK
@@ -1520,9 +1523,9 @@ run_BCO:
/* check for a breakpoint on the beginning of a let binding */
case bci_BRK_FUN:
{
- int arg1_brk_array, arg2_tick_mod, arg3_info_mod, arg4_tick_mod_id, arg5_info_mod_id, arg6_tick_index, arg7_info_index;
+ W_ arg1_brk_array, arg2_info_mod_name, arg3_info_mod_id, arg4_info_index;
#if defined(PROFILING)
- int arg8_cc;
+ W_ arg5_cc;
#endif
StgArrBytes *breakPoints;
int returning_from_break, stop_next_breakpoint;
@@ -1537,14 +1540,11 @@ run_BCO:
int size_words;
arg1_brk_array = BCO_GET_LARGE_ARG;
- arg2_tick_mod = BCO_GET_LARGE_ARG;
- arg3_info_mod = BCO_GET_LARGE_ARG;
- arg4_tick_mod_id = BCO_GET_LARGE_ARG;
- arg5_info_mod_id = BCO_GET_LARGE_ARG;
- arg6_tick_index = BCO_NEXT;
- arg7_info_index = BCO_NEXT;
+ arg2_info_mod_name = BCO_GET_LARGE_ARG;
+ arg3_info_mod_id = BCO_GET_LARGE_ARG;
+ arg4_info_index = BCO_NEXT;
#if defined(PROFILING)
- arg8_cc = BCO_GET_LARGE_ARG;
+ arg5_cc = BCO_GET_LARGE_ARG;
#else
BCO_GET_LARGE_ARG;
#endif
@@ -1564,7 +1564,7 @@ run_BCO:
#if defined(PROFILING)
cap->r.rCCCS = pushCostCentre(cap->r.rCCCS,
- (CostCentre*)BCO_LIT(arg8_cc));
+ (CostCentre*)BCO_LIT(arg5_cc));
#endif
// if we are returning from a break then skip this section
@@ -1575,11 +1575,11 @@ run_BCO:
// stop the current thread if either `stop_next_breakpoint` is
// true OR if the ignore count for this particular breakpoint is zero
- StgInt ignore_count = ((StgInt*)breakPoints->payload)[arg6_tick_index];
+ StgInt ignore_count = ((StgInt*)breakPoints->payload)[arg4_info_index];
if (stop_next_breakpoint == false && ignore_count > 0)
{
// decrement and write back ignore count
- ((StgInt*)breakPoints->payload)[arg6_tick_index] = --ignore_count;
+ ((StgInt*)breakPoints->payload)[arg4_info_index] = --ignore_count;
}
else if (stop_next_breakpoint == true || ignore_count == 0)
{
@@ -1613,10 +1613,7 @@ run_BCO:
// Arrange the stack to call the breakpoint IO action, and
// continue execution of this BCO when the IO action returns.
//
- // ioAction :: Addr# -- the breakpoint tick module
- // -> Addr# -- the breakpoint tick module unit id
- // -> Int# -- the breakpoint tick index
- // -> Addr# -- the breakpoint info module
+ // ioAction :: Addr# -- the breakpoint info module
// -> Addr# -- the breakpoint info module unit id
// -> Int# -- the breakpoint info index
// -> Bool -- exception?
@@ -1626,23 +1623,17 @@ run_BCO:
ioAction = (StgClosure *) deRefStablePtr (
rts_breakpoint_io_action);
- Sp_subW(19);
- SpW(18) = (W_)obj;
- SpW(17) = (W_)&stg_apply_interp_info;
- SpW(16) = (W_)new_aps;
- SpW(15) = (W_)False_closure; // True <=> an exception
- SpW(14) = (W_)&stg_ap_ppv_info;
- SpW(13) = (W_)arg7_info_index;
- SpW(12) = (W_)&stg_ap_n_info;
- SpW(11) = (W_)BCO_LIT(arg5_info_mod_id);
- SpW(10) = (W_)&stg_ap_n_info;
- SpW(9) = (W_)BCO_LIT(arg3_info_mod);
- SpW(8) = (W_)&stg_ap_n_info;
- SpW(7) = (W_)arg6_tick_index;
+ Sp_subW(13);
+ SpW(12) = (W_)obj;
+ SpW(11) = (W_)&stg_apply_interp_info;
+ SpW(10) = (W_)new_aps;
+ SpW(9) = (W_)False_closure; // True <=> an exception
+ SpW(8) = (W_)&stg_ap_ppv_info;
+ SpW(7) = (W_)arg4_info_index;
SpW(6) = (W_)&stg_ap_n_info;
- SpW(5) = (W_)BCO_LIT(arg4_tick_mod_id);
+ SpW(5) = (W_)BCO_LIT(arg3_info_mod_id);
SpW(4) = (W_)&stg_ap_n_info;
- SpW(3) = (W_)BCO_LIT(arg2_tick_mod);
+ SpW(3) = (W_)BCO_LIT(arg2_info_mod_name);
SpW(2) = (W_)&stg_ap_n_info;
SpW(1) = (W_)ioAction;
SpW(0) = (W_)&stg_enter_info;
=====================================
testsuite/tests/corelint/T21115b.stderr
=====================================
@@ -30,6 +30,6 @@ end Rec }
*** End of Offense ***
-
-<no location info>: error:
Compilation had errors
+
+
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/02a70b51da9255204b02d5fc088c74…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/02a70b51da9255204b02d5fc088c74…
You're receiving this email because of your account on gitlab.haskell.org.
1
0