Zubin pushed new branch wip/no-try-lookup at Glasgow Haskell Compiler / GHC
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/no-try-lookup
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/26135] 2 commits: compiler: Export a version of `newNameCache` that is not prone to footguns.
by Zubin (＠wz1000) 29 Jul '25
by Zubin (＠wz1000) 29 Jul '25
29 Jul '25
Zubin pushed to branch wip/26135 at Glasgow Haskell Compiler / GHC
Commits:
27fca852 by Zubin Duggal at 2025-07-29T08:37:44+05:30
compiler: Export a version of `newNameCache` that is not prone to footguns.
`newNameCache` must be initialized with both a non-"reserved" unique tag, as well
as a list of known key names. Failing to do so results in hard to debug unique conflicts.
It is difficult for API users to tell which unique tags are safe to use. So instead of leaving
this up to the user to decide, we now export a version of `newNameCache` which uses a guaranteed
non-reserved unique tag. In fact, this is now the way the unique tag is initialized for all invocations
of the compiler.
The original version of `newNameCache` is now exported as `newNameCache'` for advanced users.
We also deprecate `initNameCache` as it is also prone to footguns and is completely subsumed in
functionality by `newNameCache` and `newNameCache'`.
Fixes #26135 and #26055
- - - - -
cd320876 by Zubin Duggal at 2025-07-29T08:39:54+05:30
wip: testing what happens if we don't initialize NameCache with known key names
- - - - -
3 changed files:
- compiler/GHC/Driver/Main.hs
- compiler/GHC/Types/Name/Cache.hs
- testsuite/tests/hiefile/should_run/TestUtils.hs
Changes:
=====================================
compiler/GHC/Driver/Main.hs
=====================================
@@ -245,7 +245,7 @@ import GHC.Types.IPE
import GHC.Types.SourceFile
import GHC.Types.SrcLoc
import GHC.Types.Name
-import GHC.Types.Name.Cache ( newNameCache, knownKeysOrigNameCache )
+import GHC.Types.Name.Cache ( newNameCache )
import GHC.Types.Name.Reader
import GHC.Types.Name.Ppr
import GHC.Types.TyThing
@@ -322,7 +322,7 @@ newHscEnv top_dir dflags = do
newHscEnvWithHUG :: FilePath -> DynFlags -> UnitId -> HomeUnitGraph -> IO HscEnv
newHscEnvWithHUG top_dir top_dynflags cur_unit home_unit_graph = do
- nc_var <- newNameCache 'r' knownKeysOrigNameCache
+ nc_var <- newNameCache
fc_var <- initFinderCache
logger <- initLogger
tmpfs <- initTmpFs
=====================================
compiler/GHC/Types/Name/Cache.hs
=====================================
@@ -4,6 +4,8 @@
module GHC.Types.Name.Cache
( NameCache (..)
, newNameCache
+ , newNameCacheWith
+ , newEmptyNameCache
, initNameCache
, takeUniqFromNameCache
, updateNameCache'
@@ -140,11 +142,31 @@ extendOrigNameCache nc mod occ name
where
combine _ occ_env = extendOccEnv occ_env occ name
-newNameCache :: Char -> OrigNameCache -> IO NameCache
-newNameCache c nc = NameCache c <$> newMVar nc
+-- | Initialize a new name cache
+newNameCache :: IO NameCache
+newNameCache = newNameCacheWith 'r'
-initNameCache :: Char -> [Name] -> IO NameCache
-initNameCache c names = newNameCache c (initOrigNames names)
+-- | This is a version of `newNameCache` that lets you supply your
+-- own unique tag and set of known key names. This can go wrong if the tag
+-- supplied is one reserved by GHC for internal purposes. See #26055 for
+-- an example.
+--
+-- Use `newNameCache` when possible.
+newNameCacheWith :: Char -> IO NameCache
+newNameCacheWith c nc = NameCache c <$> newMVar (initOrigNames [])
+
+-- | This takes a tag for uniques to be generated and the list of knownKeyNames
+-- These must be initialized properly to ensure that names generated from this
+-- NameCache do not conflict with known key names.
+--
+-- Use `newNameCache` or `newNameCacheWith` instead
+{-# DEPRECATED initNameCache "Use newNameCache or newNameCacheWith instead" #-}
+initNameCache :: Char -> IO NameCache
+initNameCache c names = newNameCacheWith c
+
+-- | An empty namecache initialized to the default namecache
+newEmptyNameCache :: IO NameCache
+newEmptyNameCache = newNameCacheWith 'r'
initOrigNames :: [Name] -> OrigNameCache
initOrigNames names = foldl' extendOrigNameCache' emptyModuleEnv names
=====================================
testsuite/tests/hiefile/should_run/TestUtils.hs
=====================================
@@ -25,9 +25,6 @@ import GHC.Iface.Ext.Utils
import GHC.Driver.Session
import GHC.SysTools
-makeNc :: IO NameCache
-makeNc = initNameCache 'z' []
-
dynFlagsForPrinting :: String -> IO DynFlags
dynFlagsForPrinting libdir = do
systemSettings <- initSysTools libdir
@@ -37,7 +34,7 @@ readTestHie :: FilePath -> IO (DynFlags, HieFile)
readTestHie fp = do
libdir:_ <- getArgs
df <- dynFlagsForPrinting libdir
- nc <- makeNc
+ nc <- newNameCache
hfr <- readHieFile nc fp
pure (df, hie_file_result hfr)
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c4980497742094ebebcffdd2c1b7a6…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c4980497742094ebebcffdd2c1b7a6…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][ghc-9.10] 63 commits: NCG: AArch64 - Add -finter-module-far-jumps.
by Zubin (＠wz1000) 29 Jul '25
by Zubin (＠wz1000) 29 Jul '25
29 Jul '25
Zubin pushed to branch ghc-9.10 at Glasgow Haskell Compiler / GHC
Commits:
59629e84 by Andreas Klebinger at 2025-07-22T17:54:57+05:30
NCG: AArch64 - Add -finter-module-far-jumps.
When enabled the arm backend will assume jumps to targets outside of the
current module are further than 128MB away.
This will allow for code to work if:
* The current module results in less than 128MB of code.
* The whole program is loaded within a 4GB memory region.
We have seen a few reports of broken linkers (#24648) where this flag might allow
a program to compile/run successfully at a very small performance cost.
-------------------------
Metric Increase:
T783
-------------------------
(cherry picked from commit f32d6c2b468c67fed619f2fa1fb97eb012afbb6e)
- - - - -
4e67ec95 by Andreas Klebinger at 2025-07-22T17:54:58+05:30
SpecConstr: Introduce a separate argument limit for forced specs.
We used to put no limit at all on specializations forced via the SPEC
argument. This isn't always reasonable so we introduce a very high limit
that applies to forced specializations, a flag to control it, and we now
emit a warning if we fail a specialization because we exceed the
warning.
Fixes #25197
(cherry picked from commit da20cac16d0982c982f9d6779dc8174e5184fe15)
- - - - -
f633ae3f by Jens Petersen at 2025-07-22T17:54:58+05:30
hp2ps Utilities.c: include stdlib.h instead of extern malloc and realloc
(cherry picked from commit 7596675e470699f6184e13c08b268972028bc868)
- - - - -
33a04bf7 by Simon Peyton Jones at 2025-07-22T17:54:58+05:30
We can't UNPACK multi-constructor GADTs
This MR fixes #25672
See Note [Unpacking GADTs and existentials] in GHC.Types.Id.Make
(cherry picked from commit b6d5b09103dea97351774c5ab34082165504b997)
- - - - -
19d035d2 by Cheng Shao at 2025-07-22T17:54:58+05:30
testsuite: fix InternalCounters test with +debug_ghc
The `InternalCounters` test case fails when ghc is built with
`+debug_ghc`. This patch skips it in that case and allows the
testsuite to pass for the `+debug_ghc` flavour transformer.
(cherry picked from commit 59b9307b239f0e1058ccc90ca2fadb86552c0308)
- - - - -
cd9568dd by sheaf at 2025-07-22T17:54:58+05:30
Propagate long distance info to guarded let binds
This commit ensures that we propagate the enclosing long distance
information to let bindings inside guards, in order to get accurate
pattern-match checking warnings, in particular incomplete record
selector warnings.
Example:
data D = K0 | K1 { fld :: Int }
f :: D -> Int
f d@(K1 {})
| let i = fld d
= i
f _ = 3
We now correctly recognise that the field selector 'fld' cannot fail,
due to the outer pattern match which guarantees that the value 'd' has
the field 'fld'.
Fixes #25749
(cherry picked from commit 0f2241e9758e8b74fedfe52269a8fb1ff17858cb)
- - - - -
dff0870b by Fangyi Zhou at 2025-07-22T17:54:58+05:30
wasm: use primitive opcodes for fabs and sqrt
- Add new `WasmInstr` constructor `WasmSqrt` for sqrt, corresponding to
primitivie operations in wasm.
- When lowering CallishMachOp, use `WasmAbs` and `WasmSqrt` for F32 and
F64 fabs and sqrt.
(cherry picked from commit 64b0d4d061902c0f7443355fa4877ff6aad946d5)
- - - - -
9d129da6 by sheaf at 2025-07-22T17:54:58+05:30
Don't report used duplicate record fields as unused
This commit fixes the bug reported in #24035 in which the import of a
duplicate record field could be erroneously reported as unused.
The issue is that an import of the form "import M (fld)" can import
several different 'Name's, and we should only report an error if ALL
of those 'Name's are unused, not if ANY are.
Note [Reporting unused imported duplicate record fields]
in GHC.Rename.Names explains the solution to this problem.
Fixes #24035
(cherry picked from commit 0cb1db9270e11469f11a2ccf323219e032c2a312)
- - - - -
23789c28 by sheaf at 2025-07-23T18:37:50+05:30
LLVM: fix typo in padLiveArgs
This commit fixes a serious bug in the padLiveArgs function, which
was incorrectly computing too many padding registers. This caused
segfaults, e.g. in the UnboxedTuples test.
Fixes #25770
Fixes #25773
(cherry picked from commit 044a6e08c2aee23ef18c60a036e01d3b77168830)
- - - - -
cf5d5a31 by sheaf at 2025-07-23T18:37:50+05:30
GHC settings: always unescape escaped spaces
In #25204, it was noted that GHC didn't properly deal with having
spaces in its executable path, as it would compute an invalid path
for the C compiler.
The original fix in 31bf85ee49fe2ca0b17eaee0774e395f017a9373 used a
trick: escape spaces before splitting up flags into a list. This fixed
the behaviour with extra flags (e.g. -I), but forgot to also unescape
for non-flags, e.g. for an executable path (such as the C compiler).
This commit rectifies this oversight by consistently unescaping the
spaces that were introduced in order to split up argument lists.
Fixes #25204
(cherry picked from commit aa1e3b8b5c9a92592b6a49783083da37dfc69375)
- - - - -
0b4316fd by Ben Gamari at 2025-07-23T18:37:50+05:30
llvmGen: Fix built-in variable predicate
Previously the predicate to identify LLVM builtin global variables was
checking for `$llvm` rather than `@llvm` as it should.
(cherry picked from commit 6e67fa083a50684e1cfae546e07cab4d4250e871)
- - - - -
4cc84ccf by Ben Gamari at 2025-07-23T18:37:50+05:30
llvmGen: Fix linkage of built-in arrays
LLVM now insists that built-in arrays use Appending linkage, not
Internal.
Fixes #25769.
(cherry picked from commit a9d0a22c0777de18446f7f1e31ec0f575d53b290)
- - - - -
61267ae6 by Zubin Duggal at 2025-07-23T18:37:50+05:30
get-win32-tarballs.py: List tarball files to be downloaded if we cannot find them
Fixes #25929
(cherry picked from commit aba2a4a5913a347f7e11623ac3e6f528cf8d8c39)
- - - - -
e28490c1 by Matthew Pickering at 2025-07-23T18:37:50+05:30
perf: Replace uses of genericLength with strictGenericLength
genericLength is a recursive function and marked NOINLINE. It is not
going to specialise. In profiles, it can be seen that 3% of total compilation
time when computing bytecode is spend calling this non-specialised
function.
In addition, we can simplify `addListToSS` to avoid traversing the input
list twice and also allocating an intermediate list (after the call to
reverse).
Overall these changes reduce the time spend in 'assembleBCOs' from 5.61s
to 3.88s. Allocations drop from 8GB to 5.3G.
Fixes #25706
- - - - -
873c0cdc by Matthew Craven at 2025-07-23T18:37:50+05:30
Fix bytecode generation for `tagToEnum# <LITERAL>`
Fixes #25975.
(cherry picked from commit a00eeaec8f0b98ec2b8c4630f359fdeb3a6ce04e)
- - - - -
b5dc8100 by sheaf at 2025-07-23T18:37:50+05:30
Use mkTrAppChecked in ds_ev_typeable
This change avoids violating the invariant of mkTrApp according to which
the argument should not be a fully saturated function type.
This ensures we don't return false negatives for type equality
involving function types.
Fixes #25998
(cherry picked from commit 9c6d2b1bf54310b6d9755aa2ba67fbe38feeac51)
- - - - -
33343357 by Ben Gamari at 2025-07-23T18:37:50+05:30
rts/linker: Don't fail due to RTLD_NOW
In !12264 we started using the NativeObj machinery introduced some time
ago for loading of shared objects. One of the side-effects of this
change is shared objects are now loaded eagerly (i.e. with `RTLD_NOW`).
This is needed by NativeObj to ensure full visibility of the mappings of
the loaded object, which is in turn needed for safe shared object
unloading.
Unfortunately, this change subtly regressed, causing compilation
failures in some programs. Specifically, shared objects which refer to
undefined symbols (e.g. which may be usually provided by either the
executable image or libraries loaded via `dlopen`) will fail to load
with eager binding. This is problematic as GHC loads all package
dependencies while, e.g., evaluating TemplateHaskell splices. This
results in compilation failures in programs depending upon (but not
using at compile-time) packages with undefined symbol references.
To mitigate this NativeObj now first attempts to load an object via
eager binding, reverting to lazy binding (and disabling unloading) on
failure.
See Note [Don't fail due to RTLD_NOW].
Fixes #25943.
(cherry picked from commit ce6cf240f4b39371777d484b4de30d746b7abd62)
- - - - -
4f3649e5 by Ben Gamari at 2025-07-23T18:37:50+05:30
base: Note strictness changes made in 4.16.0.0
Addresses #25886.
(cherry picked from commit 7722232c6f8f0b57db03d0439d77896d38191bf9)
- - - - -
6e5b2a4d by kwxm at 2025-07-23T18:37:51+05:30
Fix bugs in `integerRecipMod` and `integerPowMod`
This fixes #26017.
* `integerRecipMod x 1` now returns `(# 1 | #)` for all x; previously it
incorrectly returned `(# | () #)`, indicating failure.
* `integerPowMod 0 e m` now returns `(# | () #)` for e<0 and m>1, indicating
failure; previously it incorrectly returned `(# 0 | #)`.
(cherry picked from commit 8ded23300367c6e032b3c5a635fd506b8915374b)
- - - - -
8de483d9 by Ben Gamari at 2025-07-23T18:37:51+05:30
rts/linker: Factor out ProddableBlocks machinery
- - - - -
f1f75958 by Ben Gamari at 2025-07-23T18:37:51+05:30
rts/linker: Improve efficiency of proddable blocks structure
Previously the linker's "proddable blocks" check relied on a simple
linked list of spans. This resulted in extremely poor complexity while
linking objects with lots of small sections (e.g. objects built with
split sections).
Rework the mechanism to instead use a simple interval set implemented
via binary search.
Fixes #26009.
- - - - -
de2afe15 by Ben Gamari at 2025-07-23T18:37:51+05:30
testsuite: Add simple functional test for ProddableBlockSet
- - - - -
09e85c28 by Ben Gamari at 2025-07-23T18:37:51+05:30
rts/linker/PEi386: Drop check for LOAD_LIBRARY_SEARCH_*_DIRS
The `LOAD_LIBRARY_SEARCH_USER_DIRS` and
`LOAD_LIBRARY_SEARCH_DEFAULT_DIRS` were introduced in Windows Vista and
have been available every since. As we no longer support Windows XP we
can drop this check.
Addresses #26009.
- - - - -
992975e9 by Ben Gamari at 2025-07-23T18:37:51+05:30
rts/linker/PEi386: Clean up code style
- - - - -
68b36fb7 by Ben Gamari at 2025-07-23T18:37:51+05:30
rts/Hash: Factor out hashBuffer
This is a useful helper which can be used for non-strings as well.
- - - - -
95c4edff by Ben Gamari at 2025-07-23T18:37:51+05:30
rts/linker/PEi386: Fix incorrect use of break in nested for
Previously the happy path of PEi386 used `break` in a double-`for` loop
resulting in redundant calls to `LoadLibraryEx`.
Fixes #26052.
- - - - -
ef423f0c by Ben Gamari at 2025-07-23T18:37:51+05:30
rts: Correctly mark const arguments
- - - - -
b9f49013 by Ben Gamari at 2025-07-23T18:37:51+05:30
rts/linker/PEi386: Don't repeatedly load DLLs
Previously every DLL-imported symbol would result in a call to
`LoadLibraryEx`. This ended up constituting over 40% of the runtime of
`ghc --interactive -e 42` on Windows. Avoid this by maintaining a
hash-set of loaded DLL names, skipping the call if we have already
loaded the requested DLL.
Addresses #26009.
- - - - -
e308564f by Ben Gamari at 2025-07-23T18:37:51+05:30
rts/linker: Expand comment describing ProddableBlockSet
- - - - -
92083d23 by Cheng Shao at 2025-07-23T18:37:51+05:30
rts: fix rts_clearMemory logic when sanity checks are enabled
This commit fixes an RTS assertion failure when invoking
rts_clearMemory with +RTS -DS. -DS implies -DZ which asserts that free
blocks contain 0xaa as the designated garbage value. Also adds the
sanity way to rts_clearMemory test to prevent future regression.
Closes #26011.
ChatGPT Codex automatically diagnosed the issue and proposed the
initial patch in a single shot, given a GHC checkout and the following
prompt:
---
Someone is reporting the following error when attempting to use `rts_clearMemory` with the RTS option `-DS`:
```
test.wasm: internal error: ASSERTION FAILED: file rts/sm/Storage.c, line 1216
(GHC version 9.12.2.20250327 for wasm32_unknown_wasi)
Please report this as a GHC bug: https://www.haskell.org/ghc/reportabug
```
What's the culprit? How do I look into this issue?
---
I manually reviewed & revised the patch, tested and submitted it.
(cherry picked from commit 86406f48659a5ab61ce1fd2a2d427faba2dcdb09)
- - - - -
82646560 by Hécate Kleidukos at 2025-07-23T18:37:51+05:30
Expose all of Backtraces' internals for ghc-internal
Closes #26049
(cherry picked from commit 16014bf84afa0d009b6254b103033bceca42233a)
- - - - -
ebd36e61 by ARATA Mizuki at 2025-07-23T18:37:51+05:30
AArch64 NCG: Fix sub-word arithmetic right shift
As noted in Note [Signed arithmetic on AArch64], we should zero-extend sub-word values.
Fixes #26061
(cherry picked from commit 265d0024abc95be941f8e4769f24af128eedaa10)
- - - - -
1d7e7535 by Ben Gamari at 2025-07-23T20:57:32+05:30
base: Expose Backtraces constructor and fields
This was specified in the proposal (CLC #199) yet somehow didn't make it
into the implementation.
Fixes #26049.
(cherry picked from commit 17db44c5b32fff82ea988fa4f1a233d1a27bdf57)
- - - - -
05545de7 by Cheng Shao at 2025-07-24T07:39:03+05:30
testsuite: add T26120 marked as broken
(cherry picked from commit 44b8cee2d5c114b238898ce4ee7b44ecaa0bf491)
- - - - -
7fb42ed3 by Cheng Shao at 2025-07-24T07:39:03+05:30
compiler: fix GHC.SysTools.Ar archive member size writing logic
This patch fixes a long-standing bug in `GHC.SysTools.Ar` that emits
the wrong archive member size in each archive header. It should encode
the exact length of the member payload, excluding any padding byte,
otherwise malformed archive that extracts a broken object with an
extra trailing byte could be created.
Apart from the in-tree `T26120` test, I've also created an out-of-tree
testsuite at https://github.com/TerrorJack/ghc-ar-quickcheck that
contains QuickCheck roundtrip tests for `GHC.SysTools.Ar`. With this
fix, simple roundtrip tests and `writeGNUAr`/GNU `ar` roundtrip test
passes. There might be more bugs lurking in here, but this patch is
still a critical bugfix already.
Fixes #26120 #22586.
Co-authored-by: Codex <codex(a)openai.com>
(cherry picked from commit 894a04f3a82dd39ecef71619e2032c4dfead556e)
- - - - -
41db0a0b by Vladislav Zavialov at 2025-07-24T07:39:03+05:30
Error message with EmptyCase and RequiredTypeArguments (#25004)
Fix a panic triggered by a combination of \case{} and forall t ->
ghci> let f :: forall (xs :: Type) -> (); f = \case {}
panic! (the 'impossible' happened)
GHC version 9.10.1:
Util: only
The new error message looks like this:
ghci> let f :: forall (xs :: Type) -> (); f = \case {}
<interactive>:5:41: error: [GHC-48010]
• Empty list of alternatives in \case expression
checked against a forall-type: forall xs -> ...
This is achieved as follows:
* A new data type, BadEmptyCaseReason, is now used to describe
why an empty case has been rejected. Used in TcRnEmptyCase.
* HsMatchContextRn is passed to tcMatches, so that the type checker
can attach the syntactic context to the error message.
* tcMatches now rejects type arguments if the list of alternatives is
empty. This is what fixes the bug.
(cherry picked from commit cce869ea2439bb16c284ce7ed71a173d54a8c9ad)
- - - - -
7f9c7f22 by Vladislav Zavialov at 2025-07-24T07:39:03+05:30
Fix EmptyCase panic in tcMatches (#25960)
Due to faulty reasoning in Note [Pattern types for EmptyCase],
tcMatches was too keen to panic.
* Old (incorrect) assumption: pat_tys is a singleton list.
This does not hold when \case{} is checked against a function type
preceded by invisible forall. See the new T25960 test case.
* New (hopefully correct) assumption: vis_pat_tys is a singleton list.
This should follow from:
checkArgCounts :: MatchGroup GhcRn ... -> TcM VisArity
checkArgCounts (MG { mg_alts = L _ [] })
= return 1
...
(cherry picked from commit b34890c7d4803041caff060391eec298e2b0a098)
- - - - -
418bb568 by Vladislav Zavialov at 2025-07-24T07:39:03+05:30
Take subordinate 'type' specifiers into account
This patch fixes multiple bugs (#22581, #25983, #25984, #25991)
in name resolution of subordinate import lists.
Bug #22581
----------
In subordinate import lists, the use of the `type` namespace specifier
used to be ignored. For example, this import statement was incorrectly
accepted:
import Prelude (Bool(type True))
Now it results in an error message:
<interactive>:2:17: error: [GHC-51433]
In the import of ‘Prelude’:
a data type called ‘Bool’ is exported,
but its subordinate item ‘True’ is not in the type namespace.
Bug #25983
----------
In subordinate import lists within a `hiding` clause, non-existent
items led to a poor warning message with -Wdodgy-imports. Consider:
import Prelude hiding (Bool(X))
The warning message for this import statement used to misreport the
cause of the problem:
<interactive>:3:24: warning: [GHC-56449] [-Wdodgy-imports]
In the import of ‘Prelude’:
an item called ‘Bool’ is exported, but it is a type.
Now the warning message is correct:
<interactive>:2:24: warning: [GHC-10237] [-Wdodgy-imports]
In the import of ‘Prelude’:
a data type called ‘Bool’ is exported, but it does not export
any constructors or record fields called ‘X’.
Bug #25984
----------
In subordinate import lists within a `hiding` clause, non-existent
items resulted in the entire import declaration being discarded.
For example, this program was incorrectly accepted:
import Prelude hiding (Bool(True,X))
t = True
Now it results in an error message:
<interactive>:2:5: error: [GHC-88464]
Data constructor not in scope: True
Bug #25991
----------
In subordinate import lists, it was not possible to refer to a class
method if there was an associated type of the same name:
module M_helper where
class C a b where
type a # b
(#) :: a -> b -> ()
module M where
import M_helper (C((#)))
This import declaration failed with:
M.hs:2:28: error: [GHC-10237]
In the import of ‘M_helper’:
an item called ‘C’ is exported, but it does not export any children
(constructors, class methods or field names) called ‘#’.
Now it is accepted.
Summary
-------
The changes required to fix these bugs are almost entirely confined to
GHC.Rename.Names. Other than that, there is a new error constructor
BadImportNonTypeSubordinates with error code [GHC-51433].
Test cases:
T22581a T22581b T22581c T22581d
T25983a T25983b T25983c T25983d T25983e T25983f T25983g
T25984a T25984b
T25991a T25991b1 T25991b2
(cherry picked from commit 282df90570fa9c777c914ae543fea291f7158482)
- - - - -
89d6c4ff by Zubin Duggal at 2025-07-24T07:39:03+05:30
fetch_gitlab: Ensure we copy users_guide.pdf and Haddock.pdf to the release docs directory
Fixes #24093
(cherry picked from commit 48cf32dbd2cf52e1db7ee68bc79a5511ff52a2a6)
- - - - -
cf1f18c3 by Ben Gamari at 2025-07-24T07:39:03+05:30
configure: Drop probing of ld.gold
As noted in #25716, `gold` has been dropped from binutils-2.44.
Fixes #25716.
Metric Increase:
size_hello_artifact_gzip
size_hello_unicode_gzip
ghc_prim_so
(cherry picked from commit c635f164cb62bcb3f34166adc24e5a9437415311)
- - - - -
a4123c53 by Ben Gamari at 2025-07-24T07:39:03+05:30
testsuite/recomp015: Ignore stderr
This is necessary since ld.bfd complains
that we don't have a .note.GNU-stack section,
potentially resulting in an executable stack.
(cherry picked from commit 637bb53825b9414f7c7dbed4cc3e5cc1ed4d2329)
- - - - -
e6b14504 by Andreas Klebinger at 2025-07-24T07:39:03+05:30
Add since tag and more docs for do-clever-arg-eta-expansion
Fixes #26113
(cherry picked from commit 699deef58bf89ef2f111b35f72d303a3624d219d)
- - - - -
0a8dcfb9 by Zubin Duggal at 2025-07-24T07:39:03+05:30
release: copy index.html from correct directory
(cherry picked from commit cbfd0829cd61928976c9eb17ba4af18272466063)
(cherry picked from commit ea3f7fd5f702d41077fff0a749b9c443d54e4844)
- - - - -
1f698c03 by Tamar Christina at 2025-07-24T07:39:03+05:30
rts: Handle API set symbol versioning conflicts
(cherry picked from commit 63373b95331f07c16e3eef511379fe3bed484839)
- - - - -
e5e2f396 by Tamar Christina at 2025-07-24T07:39:03+05:30
rts: Implement WEAK EXTERNAL undef redirection by target symbol name
(cherry picked from commit e3bfc62416dd738bfd1a4464f0a622c9d0b7c393)
- - - - -
9eefe6ba by Zubin Duggal at 2025-07-24T23:53:12+05:30
bump deepseq to 1.5.2.0
- - - - -
add840dc by Zubin Duggal at 2025-07-24T23:53:12+05:30
bump os-string to 2.0.7
- - - - -
b00be995 by Zubin Duggal at 2025-07-24T23:53:13+05:30
bump process to 1.6.26.1
- - - - -
f3d00969 by Zubin Duggal at 2025-07-24T23:53:13+05:30
bump unix to 2.8.7.0
- - - - -
b3899d42 by Jens Petersen at 2025-07-24T23:53:13+05:30
9.10 hadrian can build with Cabal-3.12.1
fixes #25605
(cherry picked from commit 07f17b6ed1bb0ba7134ee8dfd992036e97552c94)
- - - - -
3b1ef0ae by sheaf at 2025-07-24T23:53:13+05:30
Don't cache solved [W] HasCallStack constraints
This commit ensures we do not add solved Wanted constraints that mention
HasCallStack or HasExceptionContext constraints to the set of solved
Wanted dictionary constraints: caching them is invalid, because re-using
such cached dictionaries means using an old call-stack instead of
constructing a new one, as was reported in #25529.
Fixes #25529.
(cherry picked from commit 256ac29c8df4f17a1d50ea243408d506ebf395d6)
- - - - -
7492d007 by Zubin Duggal at 2025-07-24T23:53:13+05:30
In commit "Don't cache solved [W] HasCallStack constraints" (256ac29c8df4f17a1d50ea243408d506ebf395d6),
we attempt to use `tryM` to avoid errors when looking up certain known-key names like CallStack while
compiling ghc-prim and ghc-internal.
Unfortunately, `tryM` doesn't catch module lookup errors. This manifests as a failure to build ghc-prim
in `--make` mode on the GHC 9.10 branch.
Instead, we explicitly avoid doing lookups when we are compiling ghc-prim or ghc-internal instead of
relying on catching the exception.
- - - - -
ce5f1782 by Zubin Duggal at 2025-07-24T23:53:13+05:30
Consider `PromotedDataCon` in `tyConStupidTheta`
Haddock checks data declarations for the stupid theta so as not to
pretty-print them as empty contexts. Type data declarations end up as
`PromotedDataCon`s by the time Haddock performs this check, causing a
panic. This commit extends `tyConStupidTheta` so that it returns an
empty list for `PromotedDataCon`s. This decision was guided by the fact
that type data declarations never have data type contexts (see (R1) in
Note [Type data declarations]).
Fixes #25739.
(cherry picked from commit 8d33d048dbe159a045a4c304fa92318365a3dfe2)
- - - - -
a54ae3d5 by Ryan Hendrickson at 2025-07-24T23:53:13+05:30
haddock: Preserve indentation in multiline examples
Intended for use with :{ :}, but doesn't look for those characters. Any
consecutive lines with birdtracks will only have initial whitespace
stripped up to the column of the first line.
(cherry picked from commit 2c73250494fd9f48ebda6d6fe72f0cd03182aff1)
- - - - -
ccd546a9 by Ryan Hendrickson at 2025-07-24T23:53:13+05:30
haddock: Parse math even after ordinary characters
Fixes a bug where math sections were not recognized if preceded by a
character that isn't special (like space or a markup character).
(cherry picked from commit b790d647c1ccdcc9aa8f166c3e0e42d0a5c29625)
- - - - -
6c735ac2 by Ryan Hendrickson at 2025-07-24T23:53:13+05:30
haddock: Fix links to type operators
(cherry picked from commit a0adc30d892f14f543f39d5c45faccacbc28afb4)
- - - - -
68ce2fde by Ryan Hendrickson at 2025-07-24T23:53:13+05:30
haddock: Document instances from other packages
When attaching instances to `Interface`s, it isn't enough just to look
for instances in the list of `Interface`s being processed. We also need
to look in the modules on which they depend, including those outside of
this package.
Fixes #25147.
Fixes #26079.
(cherry picked from commit a26243fde4680271712a3d774e17f6cd6da4a652)
- - - - -
d23694b3 by Zubin Duggal at 2025-07-24T23:53:13+05:30
haddock: Don't warn about missing link destinations for derived names.
Fixes #26114
(cherry picked from commit 5dabc718a04bfc4d277c5ff7f815ee3d6b9670cb)
- - - - -
539a44bc by Zubin Duggal at 2025-07-24T23:53:13+05:30
Bump haddock version to 2.31.3
- - - - -
90a90dc9 by doyougnu at 2025-07-25T05:28:40+05:30
RTS linker: add support for hidden symbols (#25191)
Add linker support for hidden symbols. We basically treat them as weak
symbols.
Patch upstreamed from haskell.nix
Co-authored-by: Sylvain Henry <sylvain(a)haskus.fr>
Co-authored-by: Moritz Angermann <moritz.angermann(a)gmail.com>
(cherry picked from commit 9ca155065b39968d784846902ec1e0bcbe60ee40)
- - - - -
4c43fe31 by Tamar Christina at 2025-07-25T05:28:40+05:30
rts: Mark API set symbols as HIDDEN and correct symbol type
(cherry picked from commit 48e9aa3ebf5acb950a94addc6e47bfebeabead70)
- - - - -
3007a9f4 by Zubin Duggal at 2025-07-25T16:01:44+05:30
Prepare 9.10.3 prerelease
- - - - -
cc5b5550 by Zubin Duggal at 2025-07-29T01:46:41+05:30
Set -Wno-unused-imports for os-string
Metric Increase:
T13035
T9198
Metric Decrease:
MultiLayerModulesTH_OneShot
- - - - -
207 changed files:
- .gitlab/generate-ci/gen_ci.hs
- .gitlab/jobs.yaml
- .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py
- compiler/GHC/Builtin/Names.hs
- compiler/GHC/ByteCode/Asm.hs
- compiler/GHC/CmmToAsm/AArch64/CodeGen.hs
- compiler/GHC/CmmToAsm/Config.hs
- compiler/GHC/CmmToAsm/Wasm/Asm.hs
- compiler/GHC/CmmToAsm/Wasm/FromCmm.hs
- compiler/GHC/CmmToAsm/Wasm/Types.hs
- compiler/GHC/CmmToLlvm/Base.hs
- compiler/GHC/CmmToLlvm/Data.hs
- compiler/GHC/Core/Opt/SpecConstr.hs
- compiler/GHC/Core/Predicate.hs
- compiler/GHC/Core/TyCon.hs
- compiler/GHC/Driver/Config/CmmToAsm.hs
- compiler/GHC/Driver/DynFlags.hs
- compiler/GHC/Driver/Flags.hs
- compiler/GHC/Driver/Pipeline/Execute.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/Hs/ImpExp.hs
- compiler/GHC/HsToCore/Binds.hs
- compiler/GHC/HsToCore/GuardedRHSs.hs
- compiler/GHC/Prelude/Basic.hs
- compiler/GHC/Rename/Bind.hs
- compiler/GHC/Rename/Names.hs
- compiler/GHC/Settings/IO.hs
- compiler/GHC/StgToByteCode.hs
- compiler/GHC/SysTools/Ar.hs
- compiler/GHC/SysTools/Process.hs
- compiler/GHC/Tc/Errors/Ppr.hs
- compiler/GHC/Tc/Errors/Types.hs
- compiler/GHC/Tc/Gen/Arrow.hs
- compiler/GHC/Tc/Gen/Expr.hs
- compiler/GHC/Tc/Gen/Match.hs
- compiler/GHC/Tc/Solver/Dict.hs
- compiler/GHC/Tc/Solver/Monad.hs
- compiler/GHC/Tc/Solver/Types.hs
- compiler/GHC/Tc/TyCl.hs
- compiler/GHC/Types/Error/Codes.hs
- compiler/GHC/Types/Id/Make.hs
- compiler/GHC/Utils/Outputable.hs
- configure.ac
- + docs/users_guide/9.10.3-notes.rst
- docs/users_guide/exts/explicit_namespaces.rst
- docs/users_guide/using-optimisation.rst
- hadrian/hadrian.cabal
- hadrian/src/Context.hs
- hadrian/src/Hadrian/Haskell/Cabal/Parse.hs
- hadrian/src/Hadrian/Haskell/Cabal/Type.hs
- hadrian/src/Rules/BinaryDist.hs
- hadrian/src/Rules/CabalReinstall.hs
- hadrian/src/Rules/Register.hs
- hadrian/src/Rules/Rts.hs
- hadrian/src/Settings/Builders/Ghc.hs
- hadrian/src/Settings/Warnings.hs
- libraries/base/base.cabal.in
- libraries/base/changelog.md
- libraries/base/src/Control/Exception/Backtrace.hs
- libraries/deepseq
- libraries/ghc-bignum/src/GHC/Num/Integer.hs
- libraries/ghc-boot/GHC/Data/SizedSeq.hs
- libraries/ghc-internal/src/GHC/Internal/Exception/Backtrace.hs
- libraries/os-string
- libraries/process
- libraries/unix
- m4/find_ld.m4
- m4/fp_setup_windows_toolchain.m4
- rts/Hash.c
- rts/Hash.h
- rts/Linker.c
- rts/LinkerInternals.h
- rts/PathUtils.c
- rts/PathUtils.h
- rts/linker/Elf.c
- rts/linker/ElfTypes.h
- rts/linker/LoadNativeObjPosix.c
- rts/linker/MachO.c
- rts/linker/PEi386.c
- rts/linker/PEi386.h
- + rts/linker/ProddableBlocks.c
- + rts/linker/ProddableBlocks.h
- rts/rts.cabal
- rts/sm/Storage.h
- testsuite/driver/testlib.py
- testsuite/tests/backpack/cabal/bkpcabal08/bkpcabal08.stdout
- + testsuite/tests/bytecode/T25975.hs
- + testsuite/tests/bytecode/T25975.stdout
- testsuite/tests/bytecode/all.T
- + testsuite/tests/codeGen/should_run/T26061.hs
- + testsuite/tests/codeGen/should_run/T26061.stdout
- testsuite/tests/codeGen/should_run/all.T
- testsuite/tests/deriving/should_compile/T17324.stderr
- testsuite/tests/driver/T20604/T20604.stdout
- testsuite/tests/driver/recomp015/all.T
- testsuite/tests/ffi/should_run/all.T
- + testsuite/tests/ghc-api/T26120.hs
- + testsuite/tests/ghc-api/T26120.stdout
- testsuite/tests/ghc-api/all.T
- testsuite/tests/ghc-api/settings-escape/T11938.hs → testsuite/tests/ghc-api/settings-escape/T24265.hs
- testsuite/tests/ghc-api/settings-escape/T11938.stderr → testsuite/tests/ghc-api/settings-escape/T24265.stderr
- + testsuite/tests/ghc-api/settings-escape/T25204.hs
- + testsuite/tests/ghc-api/settings-escape/T25204.stdout
- + testsuite/tests/ghc-api/settings-escape/T25204_C.c
- testsuite/tests/ghc-api/settings-escape/all.T
- + testsuite/tests/ghc-api/settings-escape/ghc-install-folder/ghc version.h
- testsuite/tests/ghc-api/settings-escape/ghc-install-folder/lib/.gitkeep → testsuite/tests/ghc-api/settings-escape/ghc-install-folder/lib with spaces/.gitkeep
- testsuite/tests/ghci/scripts/ghci064.stdout
- 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/integer/T26017.hs
- + testsuite/tests/lib/integer/T26017.stdout
- testsuite/tests/lib/integer/all.T
- testsuite/tests/lib/integer/integerRecipMod.hs
- testsuite/tests/lib/integer/integerRecipMod.stdout
- + testsuite/tests/llvm/should_run/T25770.hs
- + testsuite/tests/llvm/should_run/T25770.stdout
- + testsuite/tests/llvm/should_run/all.T
- testsuite/tests/module/T11970A.stderr
- testsuite/tests/module/T21826.stderr
- testsuite/tests/module/mod176.stderr
- testsuite/tests/module/mod81.stderr
- testsuite/tests/module/mod91.stderr
- testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail06.stderr
- testsuite/tests/plugins/plugins10.stdout
- testsuite/tests/plugins/static-plugins.stdout
- + testsuite/tests/pmcheck/should_compile/T25749.hs
- testsuite/tests/pmcheck/should_compile/all.T
- testsuite/tests/rename/should_compile/T14881.stderr
- + testsuite/tests/rename/should_compile/T22581c.hs
- + testsuite/tests/rename/should_compile/T22581c_helper.hs
- + testsuite/tests/rename/should_compile/T22581d.script
- + testsuite/tests/rename/should_compile/T22581d.stdout
- + testsuite/tests/rename/should_compile/T24035.hs
- + testsuite/tests/rename/should_compile/T24035_aux.hs
- + testsuite/tests/rename/should_compile/T24035b.hs
- + testsuite/tests/rename/should_compile/T24035b.stderr
- + testsuite/tests/rename/should_compile/T25983a.hs
- + testsuite/tests/rename/should_compile/T25983a.stderr
- + testsuite/tests/rename/should_compile/T25983b.hs
- + testsuite/tests/rename/should_compile/T25983b.stderr
- + testsuite/tests/rename/should_compile/T25983c.hs
- + testsuite/tests/rename/should_compile/T25983c.stderr
- + testsuite/tests/rename/should_compile/T25983d.hs
- + testsuite/tests/rename/should_compile/T25983d.stderr
- + testsuite/tests/rename/should_compile/T25983e.hs
- + testsuite/tests/rename/should_compile/T25983e.stderr
- + testsuite/tests/rename/should_compile/T25983f.hs
- + testsuite/tests/rename/should_compile/T25983f.stderr
- + testsuite/tests/rename/should_compile/T25983g.hs
- + testsuite/tests/rename/should_compile/T25983g.stderr
- + testsuite/tests/rename/should_compile/T25984a.hs
- + testsuite/tests/rename/should_compile/T25984a.stderr
- + testsuite/tests/rename/should_compile/T25984a_helper.hs
- + testsuite/tests/rename/should_compile/T25991a.hs
- + testsuite/tests/rename/should_compile/T25991a_helper.hs
- testsuite/tests/rename/should_compile/all.T
- + testsuite/tests/rename/should_fail/T22581a.hs
- + testsuite/tests/rename/should_fail/T22581a.stderr
- + testsuite/tests/rename/should_fail/T22581a_helper.hs
- + testsuite/tests/rename/should_fail/T22581b.hs
- + testsuite/tests/rename/should_fail/T22581b.stderr
- + testsuite/tests/rename/should_fail/T22581b_helper.hs
- + testsuite/tests/rename/should_fail/T25984b.hs
- + testsuite/tests/rename/should_fail/T25984b.stderr
- + testsuite/tests/rename/should_fail/T25991b1.hs
- + testsuite/tests/rename/should_fail/T25991b1.stderr
- + testsuite/tests/rename/should_fail/T25991b2.hs
- + testsuite/tests/rename/should_fail/T25991b2.stderr
- + testsuite/tests/rename/should_fail/T25991b_helper.hs
- testsuite/tests/rename/should_fail/T9006.stderr
- testsuite/tests/rename/should_fail/all.T
- testsuite/tests/rts/T13082/Makefile
- testsuite/tests/rts/T13082/T13082_fail.stderr → testsuite/tests/rts/T13082/T13082_fail.stdout
- + testsuite/tests/rts/TestProddableBlockSet.c
- testsuite/tests/rts/all.T
- testsuite/tests/rts/linker/Makefile
- + testsuite/tests/rts/linker/T25191.hs
- + testsuite/tests/rts/linker/T25191.stdout
- + testsuite/tests/rts/linker/T25191_foo1.c
- + testsuite/tests/rts/linker/T25191_foo2.c
- testsuite/tests/rts/linker/all.T
- + testsuite/tests/simplCore/should_compile/T21391.stderr
- + testsuite/tests/simplCore/should_compile/T25197.hs
- + testsuite/tests/simplCore/should_compile/T25197.stderr
- + testsuite/tests/simplCore/should_compile/T25197_TH.hs
- testsuite/tests/simplCore/should_compile/all.T
- + testsuite/tests/simplCore/should_fail/T25672.hs
- + testsuite/tests/simplCore/should_fail/T25672.stderr
- testsuite/tests/simplCore/should_fail/all.T
- + testsuite/tests/typecheck/should_compile/T25960.hs
- testsuite/tests/typecheck/should_compile/all.T
- + testsuite/tests/typecheck/should_fail/T25004.hs
- + testsuite/tests/typecheck/should_fail/T25004.stderr
- + testsuite/tests/typecheck/should_fail/T25004k.hs
- + testsuite/tests/typecheck/should_fail/T25004k.stderr
- testsuite/tests/typecheck/should_fail/all.T
- + testsuite/tests/typecheck/should_run/T25529.hs
- + testsuite/tests/typecheck/should_run/T25529.stdout
- + testsuite/tests/typecheck/should_run/T25998.hs
- + testsuite/tests/typecheck/should_run/T25998.stdout
- testsuite/tests/typecheck/should_run/all.T
- utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs
- utils/haddock
- utils/hp2ps/Utilities.c
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e761967a628f1a031dfdfec87d8f04…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e761967a628f1a031dfdfec87d8f04…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/romes/step-out-11] 2 commits: debugger: Allow BRK_FUNs to head case continuation BCOs
by Rodrigo Mesquita (＠alt-romes) 28 Jul '25
by Rodrigo Mesquita (＠alt-romes) 28 Jul '25
28 Jul '25
Rodrigo Mesquita pushed to branch wip/romes/step-out-11 at Glasgow Haskell Compiler / GHC
Commits:
bccb2147 by Rodrigo Mesquita at 2025-07-28T17:59:50+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).
- - - - -
6a546b33 by Rodrigo Mesquita at 2025-07-28T18:16:25+01:00
Add InternalBreakLocs for code-generation time Brk locations
T26042d2 is a simple example displaying how this approach is not good
enough e.g. for do blocks because the cases continuations currently end
up not surrounded by a tick.
TODO: Figure out how to add BRK_FUNs to all case continuations where it
is relevant that we can step out to
TODO: Test step-out from a continuation which receives an unboxed tuple as an argument
TODO: A few comments
- - - - -
18 changed files:
- compiler/GHC/ByteCode/Breakpoints.hs
- compiler/GHC/Linker/Loader.hs
- compiler/GHC/Runtime/Debugger/Breakpoints.hs
- compiler/GHC/Runtime/Eval.hs
- compiler/GHC/StgToByteCode.hs
- ghc/GHCi/UI.hs
- libraries/ghci/GHCi/Run.hs
- rts/Interpreter.c
- 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
Changes:
=====================================
compiler/GHC/ByteCode/Breakpoints.hs
=====================================
@@ -1,4 +1,5 @@
{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE DerivingStrategies #-}
-- | Breakpoint information constructed during ByteCode generation.
--
@@ -15,6 +16,7 @@ module GHC.ByteCode.Breakpoints
-- ** Internal breakpoint identifier
, InternalBreakpointId(..), BreakInfoIndex
+ , InternalBreakLoc(..)
-- * Operations
@@ -23,7 +25,7 @@ module GHC.ByteCode.Breakpoints
-- ** Source-level information operations
, getBreakLoc, getBreakVars, getBreakDecls, getBreakCCS
- , getBreakSourceId
+ , getBreakSourceId, getBreakSourceMod
-- * Utils
, seqInternalModBreaks
@@ -165,7 +167,7 @@ data CgBreakInfo
{ cgb_tyvars :: ![IfaceTvBndr] -- ^ Type variables in scope at the breakpoint
, cgb_vars :: ![Maybe (IfaceIdBndr, Word)]
, cgb_resty :: !IfaceType
- , cgb_tick_id :: !BreakpointId
+ , cgb_tick_id :: !(Either InternalBreakLoc 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
@@ -173,9 +175,19 @@ data CgBreakInfo
--
-- The modules of breakpoint occurrence and breakpoint definition are not
-- necessarily the same: See Note [Breakpoint identifiers].
+ --
+ -- If there is no original tick identifier (that is, the breakpoint was
+ -- created during code generation), instead refer directly to the SrcSpan
+ -- we want to use for it. See Note [Internal Breakpoint Locations]
}
-- See Note [Syncing breakpoint info] in GHC.Runtime.Eval
+-- | Breakpoints created during code generation don't have a source-level tick
+-- location. Instead, we come up with one ourselves.
+-- See Note [Internal Breakpoint Locations]
+newtype InternalBreakLoc = InternalBreakLoc SrcSpan
+ deriving newtype (Eq, Show, NFData, Outputable)
+
-- | Get an internal breakpoint info by 'InternalBreakpointId'
getInternalBreak :: InternalBreakpointId -> InternalModBreaks -> CgBreakInfo
getInternalBreak (InternalBreakpointId mod ix) imbs =
@@ -196,27 +208,36 @@ assert_modules_match ibi_mod imbs_mod =
-- | 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 -> InternalModBreaks -> Either InternalBreakLoc 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 module for this breakpoint (where the breakpoint is defined)
+getBreakSourceMod :: InternalBreakpointId -> InternalModBreaks -> Module
+getBreakSourceMod (InternalBreakpointId ibi_mod ibi_ix) imbs =
+ assert_modules_match ibi_mod (imodBreaks_module imbs) $
+ let cgb = imodBreaks_breakInfo imbs IM.! ibi_ix
+ in case cgb_tick_id cgb of
+ Left InternalBreakLoc{} -> imodBreaks_module imbs
+ Right BreakpointId{bi_tick_mod} -> bi_tick_mod
+
-- | Get the source span for this breakpoint
getBreakLoc :: (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO SrcSpan
-getBreakLoc = getBreakXXX modBreaks_locs
+getBreakLoc = getBreakXXX modBreaks_locs (\(InternalBreakLoc x) -> x)
-- | Get the vars for this breakpoint
getBreakVars :: (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO [OccName]
-getBreakVars = getBreakXXX modBreaks_vars
+getBreakVars = getBreakXXX modBreaks_vars (const [])
-- | Get the decls for this breakpoint
getBreakDecls :: (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO [String]
-getBreakDecls = getBreakXXX modBreaks_decls
+getBreakDecls = getBreakXXX modBreaks_decls (const [])
-- | Get the decls for this breakpoint
-getBreakCCS :: (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO (String, String)
-getBreakCCS = getBreakXXX modBreaks_ccs
+getBreakCCS :: (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO (Maybe (String, String))
+getBreakCCS = getBreakXXX (fmap Just . modBreaks_ccs) (const Nothing)
-- | Internal utility to access a ModBreaks field at a particular breakpoint index
--
@@ -228,14 +249,17 @@ getBreakCCS = getBreakXXX modBreaks_ccs
-- 'ModBreaks'. When the tick module is different, we need to look up the
-- 'ModBreaks' in the HUG for that other module.
--
+-- When there is no tick module (the breakpoint was generated at codegen), use
+-- the function on internal mod breaks.
+--
-- 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 =
+getBreakXXX :: (ModBreaks -> Array BreakTickIndex a) -> (InternalBreakLoc -> a) -> (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO a
+getBreakXXX view viewInternal 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}
+ Right BreakpointId{bi_tick_mod, bi_tick_index}
| bi_tick_mod == ibi_mod
-> do
let these_mbs = imodBreaks_modBreaks imbs
@@ -244,6 +268,8 @@ getBreakXXX view lookupModule (InternalBreakpointId ibi_mod ibi_ix) imbs =
-> do
other_mbs <- lookupModule bi_tick_mod
return $ view other_mbs ! bi_tick_index
+ Left l ->
+ return $ viewInternal l
--------------------------------------------------------------------------------
-- Instances
=====================================
compiler/GHC/Linker/Loader.hs
=====================================
@@ -58,6 +58,7 @@ import GHCi.RemoteTypes
import GHC.Iface.Load
import GHCi.Message (ConInfoTable(..), LoadedDLL)
+import GHC.ByteCode.Breakpoints
import GHC.ByteCode.Linker
import GHC.ByteCode.Asm
import GHC.ByteCode.Types
@@ -1711,8 +1712,10 @@ allocateCCS interp ce mbss
let count = 1 + (maybe 0 fst $ IM.lookupMax imodBreaks_breakInfo)
let ccs = IM.map
(\info ->
- fromMaybe (toRemotePtr nullPtr)
- (M.lookup (cgb_tick_id info) ccss)
+ case cgb_tick_id info of
+ Right bi -> fromMaybe (toRemotePtr nullPtr)
+ (M.lookup bi ccss)
+ Left InternalBreakLoc{} -> toRemotePtr nullPtr
)
imodBreaks_breakInfo
assertPpr (count == length ccs)
=====================================
compiler/GHC/Runtime/Debugger/Breakpoints.hs
=====================================
@@ -253,8 +253,11 @@ mkBreakpointOccurrences = 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])
+ case cgb_tick_id cgi of
+ Right (BreakpointId tick_mod tick_ix)
+ -> extendModuleEnvWith (IntMap.unionWith (S.<>)) bmp tick_mod (IntMap.singleton tick_ix [ibi])
+ Left _
+ -> bmp
) bmp0 (imodBreaks_breakInfo ibrks)
--------------------------------------------------------------------------------
@@ -287,7 +290,7 @@ getCurrentBreakModule = do
Nothing -> pure Nothing
Just ibi -> do
brks <- readIModBreaks hug ibi
- return $ Just $ bi_tick_mod $ getBreakSourceId ibi brks
+ return $ Just $ getBreakSourceMod ibi brks
ix ->
Just <$> getHistoryModule hug (resumeHistory r !! (ix-1))
=====================================
compiler/GHC/Runtime/Eval.hs
=====================================
@@ -151,7 +151,7 @@ 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
+ return $ getBreakSourceMod ibi brks
getHistorySpan :: HUG.HomeUnitGraph -> History -> IO SrcSpan
getHistorySpan hug hist = do
=====================================
compiler/GHC/StgToByteCode.hs
=====================================
@@ -63,7 +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.Runtime.Interpreter ( interpreterProfiled, readIModModBreaks )
import GHC.Data.Bitmap
import GHC.Data.FlatBag as FlatBag
import GHC.Data.OrdList
@@ -99,6 +99,7 @@ import GHC.CoreToIface
import Control.Monad.IO.Class
import Control.Monad.Trans.Reader (ReaderT(..))
import Control.Monad.Trans.State (StateT(..))
+import Data.Array ((!))
-- -----------------------------------------------------------------------------
-- Generating byte code for a complete module
@@ -393,26 +394,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 tick_id fvs) rhs) = do
- code <- schemeE d 0 p rhs
- 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 -> 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
+schemeER_wrk d p (StgTick bp@(Breakpoint tick_ty tick_id fvs) rhs) = do
+ platform <- profilePlatform <$> getProfile
+
+ -- When we find a tick surrounding a case expression we introduce a new BRK_FUN
+ -- instruction at the start of the case *continuation*, in addition to the
+ -- usual BRK_FUN surrounding the StgCase)
+ -- TODO: FIX COMMENT
+ code <- withBreakTick bp $
+ schemeE d 0 p rhs
+
+ 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 (Right tick_id)
+
+ mibi <- newBreakInfo breakInfo
- let info_mod = modBreaks_module current_mod_breaks
- infox <- newBreakInfo breakInfo
+ return $ case mibi of
+ Nothing -> code
+ Just ibi -> BRK_FUN ibi `consOL` code
- let breakInstr = BRK_FUN (InternalBreakpointId info_mod infox)
- return $ breakInstr `consOL` code
schemeER_wrk d p rhs = schemeE d 0 p rhs
getVarOffSets :: Platform -> StackDepth -> BCEnv -> [Id] -> [Maybe (Id, WordOff)]
@@ -1140,43 +1143,34 @@ doCase d s p scrut bndr alts
-- When an alt is entered, it assumes the returned value is
-- on top of the itbl; see Note [Return convention for non-tuple values]
-- for details.
- ret_frame_size_b :: StackDepth
- ret_frame_size_b | ubx_tuple_frame =
- (if profiling then 5 else 4) * wordSize platform
- | otherwise = 2 * wordSize platform
+ ret_frame_size_w :: WordOff
+ ret_frame_size_w | ubx_tuple_frame =
+ if profiling then 5 else 4
+ | otherwise = 2
-- The stack space used to save/restore the CCCS when profiling
save_ccs_size_b | profiling &&
not ubx_tuple_frame = 2 * wordSize platform
| otherwise = 0
- -- The size of the return frame info table pointer if one exists
- unlifted_itbl_size_b :: StackDepth
- unlifted_itbl_size_b | ubx_tuple_frame = wordSize platform
- | otherwise = 0
-
(bndr_size, call_info, args_offsets)
| ubx_tuple_frame =
let bndr_reps = typePrimRep (idType bndr)
(call_info, args_offsets) =
layoutNativeCall profile NativeTupleReturn 0 id bndr_reps
- in ( wordsToBytes platform (nativeCallSize call_info)
+ in ( nativeCallSize call_info
, call_info
, args_offsets
)
- | otherwise = ( wordsToBytes platform (idSizeW platform bndr)
+ | otherwise = ( idSizeW platform bndr
, voidTupleReturnInfo
, []
)
- -- depth of stack after the return value has been pushed
+ -- Depth of stack after the return value has been pushed
+ -- This is the stack depth at the continuation.
d_bndr =
- d + ret_frame_size_b + bndr_size
-
- -- depth of stack after the extra info table for an unlifted return
- -- has been pushed, if any. This is the stack depth at the
- -- continuation.
- d_alts = d + ret_frame_size_b + bndr_size + unlifted_itbl_size_b
+ d + wordsToBytes platform bndr_size
-- Env in which to compile the alts, not including
-- any vars bound by the alts themselves
@@ -1188,13 +1182,13 @@ doCase d s p scrut bndr alts
-- given an alt, return a discr and code for it.
codeAlt :: CgStgAlt -> BcM (Discr, BCInstrList)
codeAlt GenStgAlt{alt_con=DEFAULT,alt_bndrs=_,alt_rhs=rhs}
- = do rhs_code <- schemeE d_alts s p_alts rhs
+ = do rhs_code <- schemeE d_bndr s p_alts rhs
return (NoDiscr, rhs_code)
codeAlt alt@GenStgAlt{alt_con=_, alt_bndrs=bndrs, alt_rhs=rhs}
-- primitive or nullary constructor alt: no need to UNPACK
| null real_bndrs = do
- rhs_code <- schemeE d_alts s p_alts rhs
+ rhs_code <- schemeE d_bndr s p_alts rhs
return (my_discr alt, rhs_code)
| isUnboxedTupleType bndr_ty || isUnboxedSumType bndr_ty =
let bndr_ty = idPrimRepU . fromNonVoid
@@ -1206,7 +1200,7 @@ doCase d s p scrut bndr alts
bndr_ty
(assertNonVoidIds bndrs)
- stack_bot = d_alts
+ stack_bot = d_bndr
p' = Map.insertList
[ (arg, tuple_start -
@@ -1224,7 +1218,7 @@ doCase d s p scrut bndr alts
(addIdReps (assertNonVoidIds real_bndrs))
size = WordOff tot_wds
- stack_bot = d_alts + wordsToBytes platform size
+ stack_bot = d_bndr + wordsToBytes platform size
-- convert offsets from Sp into offsets into the virtual stack
p' = Map.insertList
@@ -1324,22 +1318,53 @@ doCase d s p scrut bndr alts
alt_stuff <- mapM codeAlt alts
alt_final0 <- mkMultiBranch maybe_ncons alt_stuff
- let alt_final1
- | ubx_tuple_frame = SLIDE 0 2 `consOL` alt_final0
- | otherwise = alt_final0
- alt_final
- | gopt Opt_InsertBreakpoints (hsc_dflags hsc_env)
- -- See Note [Debugger: BRK_ALTS]
- = BRK_ALTS False `consOL` alt_final1
- | otherwise = alt_final1
+ let
+
+ -- drop the stg_ctoi_*_info header...
+ alt_final1 = SLIDE bndr_size ret_frame_size_w `consOL` alt_final0
+
+ -- after dropping the stg_ret_*_info header
+ alt_final2
+ | ubx_tuple_frame = SLIDE 0 3 `consOL` alt_final1
+ | otherwise = SLIDE 0 1 `consOL` alt_final1
+
+ -- When entering a case continuation BCO, the stack is always headed
+ -- by the stg_ret frame and the stg_ctoi frame that returned to it.
+ -- See Note [Stack layout when entering run_BCO]
+ --
+ -- Right after the breakpoint instruction, a case continuation BCO
+ -- drops the stg_ret and stg_ctoi frame headers (see alt_final1,
+ -- alt_final2), leaving the stack with the scrutinee followed by the
+ -- free variables (with depth==d_bndr)
+ alt_final <- getLastBreakTick >>= \case
+ Just (Breakpoint tick_ty tick_id fvs)
+ | gopt Opt_InsertBreakpoints (hsc_dflags hsc_env)
+ -- Construct an internal breakpoint to put at the start of this case
+ -- continuation BCO.
+ -- See Note [TODO]
+ -> do
+ internal_tick_loc <- makeCaseInternalBreakLoc tick_id
+
+ -- same fvs available in the case expression are available in the case continuation
+ 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 (Left internal_tick_loc)
+
+ mibi <- newBreakInfo breakInfo
+ return $ case mibi of
+ Nothing -> alt_final2
+ Just ibi -> BRK_FUN ibi `consOL` alt_final2
+ _ -> pure alt_final2
add_bco_name <- shouldAddBcoName
let
alt_bco_name = getName bndr
alt_bco = mkProtoBCO platform add_bco_name alt_bco_name alt_final (Left alts)
0{-no arity-} bitmap_size bitmap True{-is alts-}
- scrut_code <- schemeE (d + ret_frame_size_b + save_ccs_size_b)
- (d + ret_frame_size_b + save_ccs_size_b)
+ scrut_code <- schemeE (d + wordsToBytes platform ret_frame_size_w + save_ccs_size_b)
+ (d + wordsToBytes platform ret_frame_size_w + save_ccs_size_b)
p scrut
if ubx_tuple_frame
then do let tuple_bco = tupleBCO platform call_info args_offsets
@@ -1351,6 +1376,24 @@ doCase d s p scrut bndr alts
_ -> panic "schemeE(StgCase).push_alts"
in return (PUSH_ALTS alt_bco scrut_rep `consOL` scrut_code)
+makeCaseInternalBreakLoc :: BreakpointId -> BcM InternalBreakLoc
+makeCaseInternalBreakLoc bid = do
+ hug <- hsc_HUG <$> getHscEnv
+ curr_mod <- getCurrentModule
+ mb_mod_brks <- getCurrentModBreaks
+
+ -- TODO: Subtract the scrutinee loc from the case loc to get continuation loc
+ InternalBreakLoc <$> case bid of
+ BreakpointId{bi_tick_mod, bi_tick_index}
+ | bi_tick_mod == curr_mod
+ , Just these_mbs <- mb_mod_brks
+ -> do
+ return $ modBreaks_locs these_mbs ! bi_tick_index
+ | otherwise
+ -> do
+ other_mbs <- liftIO $ readIModModBreaks hug bi_tick_mod
+ return $ modBreaks_locs other_mbs ! bi_tick_index
+
{-
Note [Debugger: BRK_ALTS]
~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -2619,6 +2662,7 @@ data BcM_Env
{ bcm_hsc_env :: !HscEnv
, bcm_module :: !Module -- current module (for breakpoints)
, modBreaks :: !(Maybe ModBreaks)
+ , last_bp_tick :: !(Maybe StgTickish)
}
data BcM_State
@@ -2637,7 +2681,7 @@ newtype BcM r = BcM (BcM_Env -> BcM_State -> IO (r, BcM_State))
runBc :: HscEnv -> Module -> Maybe ModBreaks -> BcM r -> IO (r, BcM_State)
runBc hsc_env this_mod mbs (BcM m)
- = m (BcM_Env hsc_env this_mod mbs) (BcM_State 0 0 IntMap.empty)
+ = m (BcM_Env hsc_env this_mod mbs Nothing) (BcM_State 0 0 IntMap.empty)
instance HasDynFlags BcM where
getDynFlags = hsc_dflags <$> getHscEnv
@@ -2667,14 +2711,19 @@ getLabelsBc n = BcM $ \_ st ->
let ctr = nextlabel st
in return (coerce [ctr .. ctr+n-1], st{nextlabel = ctr+n})
-newBreakInfo :: CgBreakInfo -> BcM Int
-newBreakInfo info = BcM $ \_ st ->
- let ix = breakInfoIdx st
- st' = st
- { breakInfo = IntMap.insert ix info (breakInfo st)
- , breakInfoIdx = ix + 1
- }
- in return (ix, st')
+newBreakInfo :: CgBreakInfo -> BcM (Maybe InternalBreakpointId)
+newBreakInfo info = BcM $ \env st -> do
+ -- if we're not generating ModBreaks for this module for some reason, we
+ -- can't store breakpoint occurrence information.
+ case modBreaks env of
+ Nothing -> pure (Nothing, st)
+ Just modBreaks -> do
+ let ix = breakInfoIdx st
+ st' = st
+ { breakInfo = IntMap.insert ix info (breakInfo st)
+ , breakInfoIdx = ix + 1
+ }
+ return (Just $ InternalBreakpointId (modBreaks_module modBreaks) ix, st')
getCurrentModule :: BcM Module
getCurrentModule = BcM $ \env st -> return (bcm_module env, st)
@@ -2682,12 +2731,20 @@ getCurrentModule = BcM $ \env st -> return (bcm_module env, st)
getCurrentModBreaks :: BcM (Maybe ModBreaks)
getCurrentModBreaks = BcM $ \env st -> return (modBreaks env, st)
+withBreakTick :: StgTickish -> BcM a -> BcM a
+withBreakTick bp (BcM act) = BcM $ \env st ->
+ act env{last_bp_tick=Just bp} st
+
+getLastBreakTick :: BcM (Maybe StgTickish)
+getLastBreakTick = BcM $ \env st ->
+ pure (last_bp_tick env, st)
+
tickFS :: FastString
tickFS = fsLit "ticked"
-- Dehydrating CgBreakInfo
-dehydrateCgBreakInfo :: [TyVar] -> [Maybe (Id, Word)] -> Type -> BreakpointId -> CgBreakInfo
+dehydrateCgBreakInfo :: [TyVar] -> [Maybe (Id, Word)] -> Type -> Either InternalBreakLoc BreakpointId -> CgBreakInfo
dehydrateCgBreakInfo ty_vars idOffSets tick_ty bid =
CgBreakInfo
{ cgb_tyvars = map toIfaceTvBndr ty_vars
=====================================
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, InternalBreakpointId(..), getBreakSourceId)
+import GHC.ByteCode.Breakpoints (imodBreaks_modBreaks, InternalBreakpointId(..), getBreakSourceId, getBreakSourceMod)
import GHC.Runtime.Interpreter
import GHCi.RemoteTypes
import GHCi.BreakArray( breakOn, breakOff )
@@ -1621,7 +1621,7 @@ toBreakIdAndLocation (Just inf) = do
brks <- liftIO $ readIModBreaks hug inf
let bi = getBreakSourceId inf brks
return $ listToMaybe [ id_loc | id_loc@(_,loc) <- IntMap.assocs (breaks st),
- breakId loc == bi ]
+ Right (breakId loc) == bi ]
printStoppedAtBreakInfo :: GHC.GhcMonad m => Resume -> [Name] -> m ()
printStoppedAtBreakInfo res names = do
@@ -3825,7 +3825,7 @@ pprStopped res = do
hug <- hsc_HUG <$> GHC.getSession
brks <- liftIO $ readIModBreaks hug ibi
return $ Just $ moduleName $
- bi_tick_mod $ getBreakSourceId ibi brks
+ getBreakSourceMod ibi brks
return $
text "Stopped in"
<+> ((case mb_mod_name of
=====================================
libraries/ghci/GHCi/Run.hs
=====================================
@@ -362,6 +362,14 @@ withBreakAction opts breakMVar statusMVar mtid act
info_mod_uid <- BS.packCString (Ptr info_mod_uid#)
pure (Just (EvalBreakpoint info_mod info_mod_uid (I# infox#)))
putMVar statusMVar $ EvalBreak apStack_r breakpoint resume_r ccs
+
+ -- Block until this thread is resumed (by the thread which took the
+ -- `ResumeContext` from the `statusMVar`).
+ --
+ -- The `onBreak` function must have been called from `rts/Interpreter.c`
+ -- when interpreting a `BRK_FUN`. After taking from the MVar, the function
+ -- returns to the continuation on the stack which is where the interpreter
+ -- was stopped.
takeMVar breakMVar
resetBreakAction stablePtr = do
=====================================
rts/Interpreter.c
=====================================
@@ -284,6 +284,30 @@ allocate_NONUPD (Capability *cap, int n_words)
return allocate(cap, stg_max(sizeofW(StgHeader)+MIN_PAYLOAD_SIZE, n_words));
}
+STATIC_INLINE int
+is_ctoi_nontuple_frame(const StgPtr frame_head) {
+ return (
+ (W_)frame_head == (W_)&stg_ctoi_R1p_info ||
+ (W_)frame_head == (W_)&stg_ctoi_R1n_info ||
+ (W_)frame_head == (W_)&stg_ctoi_F1_info ||
+ (W_)frame_head == (W_)&stg_ctoi_D1_info ||
+ (W_)frame_head == (W_)&stg_ctoi_L1_info ||
+ (W_)frame_head == (W_)&stg_ctoi_V_info
+ );
+}
+
+STATIC_INLINE int
+is_ret_bco_frame(const StgPtr frame_head) {
+ return ( (W_)frame_head == (W_)&stg_ret_t_info
+ || (W_)frame_head == (W_)&stg_ret_v_info
+ || (W_)frame_head == (W_)&stg_ret_p_info
+ || (W_)frame_head == (W_)&stg_ret_n_info
+ || (W_)frame_head == (W_)&stg_ret_f_info
+ || (W_)frame_head == (W_)&stg_ret_d_info
+ || (W_)frame_head == (W_)&stg_ret_l_info
+ );
+}
+
int rts_stop_on_exception = 0;
/* ---------------------------------------------------------------------------
@@ -692,8 +716,13 @@ interpretBCO (Capability* cap)
StgPtr restoreStackPointer = Sp;
/* The first BCO on the stack is the one we are already stopped at.
- * Skip it. */
- Sp = SafeSpWP(stack_frame_sizeW((StgClosure *)Sp));
+ * Skip it. In the case of returning to a case cont. BCO, there are two
+ * frames to skip before we reach the first continuation frame.
+ * */
+ int to_skip = is_ret_bco_frame((StgPtr)SpW(0)) ? 2 : 1;
+ for (int i = 0; i < to_skip; i++) {
+ Sp = SafeSpWP(stack_frame_sizeW((StgClosure *)Sp));
+ }
/* Traverse upwards until continuation BCO, or the end */
while ((type = get_itbl((StgClosure*)Sp)->type) != RET_BCO
@@ -844,7 +873,6 @@ eval_obj:
debugBelch("\n\n");
);
-// IF_DEBUG(sanity,checkStackChunk(Sp, cap->r.rCurrentTSO->stack+cap->r.rCurrentTSO->stack_size));
IF_DEBUG(sanity,checkStackFrame(Sp));
switch ( get_itbl(obj)->type ) {
@@ -1086,11 +1114,33 @@ do_return_pointer:
// Returning to an interpreted continuation: put the object on
// the stack, and start executing the BCO.
INTERP_TICK(it_retto_BCO);
- Sp_subW(1);
- SpW(0) = (W_)tagged_obj;
- obj = (StgClosure*)ReadSpW(2);
+ obj = (StgClosure*)ReadSpW(1);
ASSERT(get_itbl(obj)->type == BCO);
- goto run_BCO_return_pointer;
+
+ // Heap check
+ if (doYouWantToGC(cap)) {
+ Sp_subW(2);
+ SpW(1) = (W_)tagged_obj;
+ SpW(0) = (W_)&stg_ret_p_info;
+ RETURN_TO_SCHEDULER(ThreadInterpret, HeapOverflow);
+ }
+ else {
+
+ // Stack checks aren't necessary at return points, the stack use
+ // is aggregated into the enclosing function entry point.
+
+ // Make sure stack is headed by a ctoi R1p frame when returning a pointer
+ ASSERT(ReadSpW(0) == (W_)&stg_ctoi_R1p_info);
+
+ // Add the return frame on top of the args
+ Sp_subW(2);
+ SpW(1) = (W_)tagged_obj;
+ SpW(0) = (W_)&stg_ret_p_info;
+ }
+
+ /* Keep the ret frame and the ctoi frame for run_BCO.
+ * See Note [Stack layout when entering run_BCO] */
+ goto run_BCO;
default:
do_return_unrecognised:
@@ -1159,8 +1209,9 @@ do_return_nonpointer:
// get the offset of the header of the next stack frame
offset = stack_frame_sizeW((StgClosure *)Sp);
+ StgClosure* next_frame = (StgClosure*)(SafeSpWP(offset));
- switch (get_itbl((StgClosure*)(SafeSpWP(offset)))->type) {
+ switch (get_itbl(next_frame)->type) {
case RET_BCO:
// Returning to an interpreted continuation: pop the return frame
@@ -1168,8 +1219,58 @@ do_return_nonpointer:
// executing the BCO.
INTERP_TICK(it_retto_BCO);
obj = (StgClosure*)ReadSpW(offset+1);
+
ASSERT(get_itbl(obj)->type == BCO);
- goto run_BCO_return_nonpointer;
+
+ // Heap check
+ if (doYouWantToGC(cap)) {
+ RETURN_TO_SCHEDULER(ThreadInterpret, HeapOverflow);
+ }
+ else {
+ // Stack checks aren't necessary at return points, the stack use
+ // is aggregated into the enclosing function entry point.
+
+#if defined(PROFILING)
+ /*
+ Restore the current cost centre stack if a tuple is being returned.
+
+ When a "simple" unlifted value is returned, the cccs is restored with
+ an stg_restore_cccs frame on the stack, for example:
+
+ ...
+ stg_ctoi_D1
+ <CCCS>
+ stg_restore_cccs
+
+ But stg_restore_cccs cannot deal with tuples, which may have more
+ things on the stack. Therefore we store the CCCS inside the
+ stg_ctoi_t frame.
+
+ If we have a tuple being returned, the stack looks like this:
+
+ ...
+ <CCCS> <- to restore, Sp offset <next frame + 4 words>
+ tuple_BCO
+ tuple_info
+ cont_BCO
+ stg_ctoi_t <- next frame
+ tuple_data_1
+ ...
+ tuple_data_n
+ tuple_info
+ tuple_BCO
+ stg_ret_t <- Sp
+ */
+
+ if(SpW(0) == (W_)&stg_ret_t_info) {
+ cap->r.rCCCS = (CostCentreStack*)ReadSpW(offset + 4);
+ }
+#endif
+
+ /* Keep the ret frame and the ctoi frame for run_BCO.
+ * See Note [Stack layout when entering run_BCO] */
+ goto run_BCO;
+ }
default:
{
@@ -1332,111 +1433,90 @@ do_apply:
RETURN_TO_SCHEDULER_NO_PAUSE(ThreadRunGHC, ThreadYielding);
}
- // ------------------------------------------------------------------------
- // Ok, we now have a bco (obj), and its arguments are all on the
- // stack. We can start executing the byte codes.
- //
- // The stack is in one of two states. First, if this BCO is a
- // function:
- //
- // | .... |
- // +---------------+
- // | arg2 |
- // +---------------+
- // | arg1 |
- // +---------------+
- //
- // Second, if this BCO is a continuation:
- //
- // | .... |
- // +---------------+
- // | fv2 |
- // +---------------+
- // | fv1 |
- // +---------------+
- // | BCO |
- // +---------------+
- // | stg_ctoi_ret_ |
- // +---------------+
- // | retval |
- // +---------------+
- //
- // where retval is the value being returned to this continuation.
- // In the event of a stack check, heap check, or context switch,
- // we need to leave the stack in a sane state so the garbage
- // collector can find all the pointers.
- //
- // (1) BCO is a function: the BCO's bitmap describes the
- // pointerhood of the arguments.
- //
- // (2) BCO is a continuation: BCO's bitmap describes the
- // pointerhood of the free variables.
- //
- // Sadly we have three different kinds of stack/heap/cswitch check
- // to do:
-
-
-run_BCO_return_pointer:
- // Heap check
- if (doYouWantToGC(cap)) {
- Sp_subW(1); SpW(0) = (W_)&stg_ret_p_info;
- RETURN_TO_SCHEDULER(ThreadInterpret, HeapOverflow);
- }
- // Stack checks aren't necessary at return points, the stack use
- // is aggregated into the enclosing function entry point.
-
- goto run_BCO;
-
-run_BCO_return_nonpointer:
- // Heap check
- if (doYouWantToGC(cap)) {
- RETURN_TO_SCHEDULER(ThreadInterpret, HeapOverflow);
- }
- // Stack checks aren't necessary at return points, the stack use
- // is aggregated into the enclosing function entry point.
-
-#if defined(PROFILING)
- /*
- Restore the current cost centre stack if a tuple is being returned.
-
- When a "simple" unlifted value is returned, the cccs is restored with
- an stg_restore_cccs frame on the stack, for example:
-
- ...
- stg_ctoi_D1
- <CCCS>
- stg_restore_cccs
-
- But stg_restore_cccs cannot deal with tuples, which may have more
- things on the stack. Therefore we store the CCCS inside the
- stg_ctoi_t frame.
-
- If we have a tuple being returned, the stack looks like this:
-
- ...
- <CCCS> <- to restore, Sp offset <next frame + 4 words>
- tuple_BCO
- tuple_info
- cont_BCO
- stg_ctoi_t <- next frame
- tuple_data_1
- ...
- tuple_data_n
- tuple_info
- tuple_BCO
- stg_ret_t <- Sp
- */
-
- if(SpW(0) == (W_)&stg_ret_t_info) {
- cap->r.rCCCS = (CostCentreStack*)ReadSpW(stack_frame_sizeW((StgClosure *)Sp) + 4);
- }
-#endif
-
- if (SpW(0) != (W_)&stg_ret_t_info) {
- Sp_addW(1);
- }
- goto run_BCO;
+/*
+Note [Stack layout when entering run_BCO]
+-----------------------------------------
+We have a bco (obj), and its arguments are all on the stack. We can start
+executing the byte codes.
+
+The stack is in one of two states. First, if this BCO is a
+function (in run_BCO_fun or run_BCO)
+
+ | .... |
+ +---------------+
+ | arg2 |
+ +---------------+
+ | arg1 |
+ +---------------+
+
+Second, if this BCO is a case cont., as per Note [Case continuation BCOs] (only
+in run_BCO):
+
+ | .... |
+ +---------------+
+ | fv2 |
+ +---------------+
+ | fv1 |
+ +---------------+
+ | BCO |
+ +---------------+
+ | stg_ctoi_ret_ |
+ +---------------+
+ | retval |
+ +---------------+
+ | stg_ret_..... |
+ +---------------+
+
+where retval is the value being returned to this continuation.
+In the event of a stack check, heap check, context switch,
+or breakpoint, we need to leave the stack in a sane state so
+the garbage collector can find all the pointers.
+
+ (1) BCO is a function: the BCO's bitmap describes the
+ pointerhood of the arguments.
+
+ (2) BCO is a continuation: BCO's bitmap describes the
+ pointerhood of the free variables.
+
+To reconstruct a valid stack state for yielding (such that when we return to
+the interpreter we end up in the same place from where we yielded), we need to
+differentiate the two cases again:
+
+ (1) For function BCOs, the arguments are directly on top of the stack, so it
+ suffices to add a `stg_apply_interp_info` frame header using the BCO that is
+ being applied to these arguments (i.e. the `obj` being run)
+
+ (2) For continuation BCOs, the stack is already consistent -- that's why we
+ keep the ret and ctoi frame on top of the stack when we start executing it.
+
+ We couldn't reconstruct a valid stack that resumes the case continuation
+ execution just from the return and free vars values alone because we wouldn't
+ know what kind of result it was (are we returning a pointer, non pointer int,
+ a tuple? etc.); especially considering some frames have different sizes,
+ notably unboxed tuple return frames (see Note [unboxed tuple bytecodes and tuple_BCO]).
+
+ For consistency, the first instructions in a case continuation BCO, right
+ after a possible BRK_FUN heading it, are two SLIDEs to remove the stg_ret_
+ and stg_ctoi_ frame headers, leaving only the return value followed by the
+ free vars. Theses slides use statically known offsets computed in StgToByteCode.hs.
+ Following the continuation BCO diagram above, SLIDING would result in:
+
+ | .... |
+ +---------------+
+ | fv2 |
+ +---------------+
+ | fv1 |
+ +---------------+
+ | retval |
+ +---------------+
+*/
+// Ok, we now have a bco (obj), and its arguments are all on the stack as
+// described by Note [Stack layout when entering run_BCO].
+// We can start executing the byte codes.
+//
+// Sadly we have three different kinds of stack/heap/cswitch check
+// to do:
run_BCO_fun:
IF_DEBUG(sanity,
Sp_subW(2);
@@ -1466,6 +1546,7 @@ run_BCO_fun:
// Now, actually interpret the BCO... (no returning to the
// scheduler again until the stack is in an orderly state).
+ // See also Note [Stack layout when entering run_BCO]
run_BCO:
INTERP_TICK(it_BCO_entries);
{
@@ -1519,7 +1600,7 @@ run_BCO:
switch (bci & 0xFF) {
- /* check for a breakpoint on the beginning of a let binding */
+ /* check for a breakpoint on the beginning of a BCO */
case bci_BRK_FUN:
{
W_ arg1_brk_array, arg2_info_mod_name, arg3_info_mod_id, arg4_info_index;
@@ -1572,6 +1653,13 @@ run_BCO:
{
breakPoints = (StgArrBytes *) BCO_PTR(arg1_brk_array);
+ StgPtr stack_head = (StgPtr)SpW(0);
+
+ // When the BRK_FUN is at the start of a case continuation BCO,
+ // the stack is headed by the frame returning the value at the start.
+ // See Note [Stack layout when entering run_BCO]
+ int is_case_cont_BCO = is_ret_bco_frame(stack_head);
+
// 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)[arg4_info_index];
@@ -1580,36 +1668,96 @@ run_BCO:
// decrement and write back ignore count
((StgInt*)breakPoints->payload)[arg4_info_index] = --ignore_count;
}
- else if (stop_next_breakpoint == true || ignore_count == 0)
+ else if (
+ /* Doing step-in (but don't stop at case continuation BCOs,
+ * those are only useful when stepping out) */
+ (stop_next_breakpoint == true && !is_case_cont_BCO)
+ /* Or breakpoint is explicitly enabled */
+ || ignore_count == 0)
{
// make sure we don't automatically stop at the
// next breakpoint
rts_stop_next_breakpoint = 0;
cap->r.rCurrentTSO->flags &= ~TSO_STOP_NEXT_BREAKPOINT;
- // allocate memory for a new AP_STACK, enough to
- // store the top stack frame plus an
- // stg_apply_interp_info pointer and a pointer to
- // the BCO
- size_words = BCO_BITMAP_SIZE(obj) + 2;
- new_aps = (StgAP_STACK *) allocate(cap, AP_STACK_sizeW(size_words));
- new_aps->size = size_words;
- new_aps->fun = &stg_dummy_ret_closure;
-
- // fill in the payload of the AP_STACK
- new_aps->payload[0] = (StgClosure *)&stg_apply_interp_info;
- new_aps->payload[1] = (StgClosure *)obj;
-
- // copy the contents of the top stack frame into the AP_STACK
- for (i = 2; i < size_words; i++)
- {
- new_aps->payload[i] = (StgClosure *)ReadSpW(i-2);
+ /* To yield execution we need to come up with a consistent AP_STACK
+ * to store in the :history data structure.
+ */
+ if (is_case_cont_BCO) {
+
+ // If the BCO is a case cont. then the stack is headed by the
+ // stg_ret and a stg_ctoi frames which caused this same BCO
+ // to be run. This stack is already well-formed, so it
+ // needs only to be copied to the AP_STACK.
+ // See Note [Stack layout when entering run_BCO]
+
+ // stg_ret_*
+ int size_returned_frame =
+ ((W_)stack_head == (W_)&stg_ret_t_info)
+ ? 2 /* ret_t + tuple_BCO */
+ + /* Sp(2) is call_info which records the offset to the next frame
+ * See also Note [unboxed tuple bytecodes and tuple_BCO] */
+ ((ReadSpW(2) & 0xFF))
+ : 2; /* ret_* + return value */
+
+ StgPtr cont_frame_head
+ = (StgPtr)(SpW(size_returned_frame));
+ ASSERT(obj == UNTAG_CLOSURE((StgClosure*)ReadSpW(size_returned_frame+1)));
+
+ // stg_ctoi_*
+ int size_cont_frame_head =
+ is_ctoi_nontuple_frame(cont_frame_head)
+ ? 2 // info+bco
+#if defined(PROFILING)
+ : 5; // or info+bco+tuple_info+tuple_BCO+CCS
+#else
+ : 4; // or info+bco+tuple_info+tuple_BCO
+#endif
+
+ // Continuation stack is already well formed,
+ // so just copy it whole to the AP_STACK
+ size_words = size_returned_frame
+ + size_cont_frame_head
+ + BCO_BITMAP_SIZE(obj) /* payload of cont_frame */;
+ new_aps = (StgAP_STACK *) allocate(cap, AP_STACK_sizeW(size_words));
+ new_aps->size = size_words;
+ new_aps->fun = &stg_dummy_ret_closure;
+
+ // (1) Fill in the payload of the AP_STACK:
+ for (i = 0; i < size_words; i++) {
+ new_aps->payload[i] = (StgClosure *)ReadSpW(i);
+ }
+ }
+ else {
+
+ // The BCO is a function, therefore the arguments are
+ // directly on top of the stack.
+ // To construct a valid stack chunk simply add an
+ // stg_apply_interp and the current BCO to the stack.
+ // See also Note [Stack layout when entering run_BCO]
+
+ // (1) Allocate memory for a new AP_STACK, enough to store
+ // the top stack frame plus an stg_apply_interp_info pointer
+ // and a pointer to the BCO
+ size_words = BCO_BITMAP_SIZE(obj) + 2;
+ new_aps = (StgAP_STACK *) allocate(cap, AP_STACK_sizeW(size_words));
+ new_aps->size = size_words;
+ new_aps->fun = &stg_dummy_ret_closure;
+
+ // (1.1) the continuation frame
+ new_aps->payload[0] = (StgClosure *)&stg_apply_interp_info;
+ new_aps->payload[1] = (StgClosure *)obj;
+
+ // (1.2.1) copy the args/free vars of the top stack frame into the AP_STACK
+ for (i = 2; i < size_words; i++) {
+ new_aps->payload[i] = (StgClosure *)ReadSpW(i-2);
+ }
}
// No write barrier is needed here as this is a new allocation
SET_HDR(new_aps,&stg_AP_STACK_info,cap->r.rCCCS);
- // Arrange the stack to call the breakpoint IO action, and
+ // (2) Arrange the stack to call the breakpoint IO action, and
// continue execution of this BCO when the IO action returns.
//
// ioAction :: Addr# -- the breakpoint info module
@@ -1622,12 +1770,27 @@ run_BCO:
ioAction = (StgClosure *) deRefStablePtr (
rts_breakpoint_io_action);
- Sp_subW(13);
- SpW(12) = (W_)obj;
- SpW(11) = (W_)&stg_apply_interp_info;
+ // (2.1) Construct the continuation to which we'll return in
+ // this thread after the `rts_breakpoint_io_action` returns.
+ //
+ // For case cont. BCOs, the continuation to re-run this BCO
+ // is already first on the stack. For function BCOs we need
+ // to add an `stg_apply_interp` apply to the current BCO.
+ // See Note [Stack layout when entering run_BCO]
+ if (!is_case_cont_BCO) {
+ Sp_subW(2); // stg_apply_interp_info + StgBCO*
+
+ // (2.1.2) Write the continuation frame (above the stg_ret
+ // frame if one exists)
+ SpW(1) = (W_)obj;
+ SpW(0) = (W_)&stg_apply_interp_info;
+ }
+
+ // (2.2) The `rts_breakpoint_io_action` call
+ Sp_subW(11);
SpW(10) = (W_)new_aps;
- SpW(9) = (W_)False_closure; // True <=> an exception
- SpW(8) = (W_)&stg_ap_ppv_info;
+ 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(arg3_info_mod_id);
=====================================
testsuite/tests/ghci.debugger/scripts/T26042b.stdout
=====================================
@@ -8,35 +8,32 @@ _result ::
10 foo True i = return i
^^^^^^^^
11 foo False _ = do
-Stopped in Main.bar, T26042b.hs:21:3-10
+Stopped in Main., T26042b.hs:20:3-17
_result ::
GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld
-> (# GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld,
Int #) = _
-y :: Int = _
+19 let t = z * 2
20 y <- foo True t
+ ^^^^^^^^^^^^^^^
21 return y
- ^^^^^^^^
-22
-Stopped in Main.foo, T26042b.hs:15:3-10
+Stopped in Main., T26042b.hs:14:3-18
_result ::
GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld
-> (# GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld,
Int #) = _
-n :: Int = _
+13 y = 4
14 n <- bar (x + y)
+ ^^^^^^^^^^^^^^^^
15 return n
- ^^^^^^^^
-16
-Stopped in Main.main, T26042b.hs:6:3-9
+Stopped in Main., T26042b.hs:5:3-26
_result ::
GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld
-> (# GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld,
() #) = _
-a :: Int = _
+4 main = do
5 a <- foo False undefined
+ ^^^^^^^^^^^^^^^^^^^^^^^^
6 print a
- ^^^^^^^
-7 print a
14
14
=====================================
testsuite/tests/ghci.debugger/scripts/T26042c.script
=====================================
@@ -14,15 +14,7 @@ main
-- we go straight to `main`.
:stepout
:list
--- stepping out from here will stop in the thunk (TODO: WHY?)
-:stepout
-:list
-
--- bring us back to main from the thunk (why were we stopped there?...)
-:stepout
-:list
-
--- and finally out
+-- stepping out from here will exit main
:stepout
-- this test is also run with optimisation to make sure the IO bindings inline and we can stop at them
=====================================
testsuite/tests/ghci.debugger/scripts/T26042c.stdout
=====================================
@@ -8,17 +8,14 @@ _result ::
10 foo True i = return i
^^^^^^^^
11 foo False _ = do
-Stopped in Main.main, T26042c.hs:6:3-9
+Stopped in Main., T26042c.hs:5:3-26
_result ::
GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld
-> (# GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld,
() #) = _
-a :: Int = _
+4 main = do
5 a <- foo False undefined
+ ^^^^^^^^^^^^^^^^^^^^^^^^
6 print a
- ^^^^^^^
-7 print a
14
14
-not stopped at a breakpoint
-not stopped at a breakpoint
=====================================
testsuite/tests/ghci.debugger/scripts/T26042d2.hs
=====================================
@@ -0,0 +1,13 @@
+
+module Main where
+
+main = do
+ putStrLn "hello1"
+ f
+ putStrLn "hello3"
+ putStrLn "hello4"
+
+f = do
+ putStrLn "hello2.1"
+ putStrLn "hello2.2"
+{-# NOINLINE f #-}
=====================================
testsuite/tests/ghci.debugger/scripts/T26042d2.script
=====================================
@@ -0,0 +1,12 @@
+:load T26042d2.hs
+
+:break 11
+main
+:list
+:stepout
+:list
+:stepout
+
+-- should exit! we compile this test case with -O1 to make sure the monad >> are inlined
+-- and thus the test relies on the filtering behavior based on SrcSpans for stepout
+
=====================================
testsuite/tests/ghci.debugger/scripts/T26042d2.stdout
=====================================
@@ -0,0 +1,24 @@
+Breakpoint 0 activated at T26042d2.hs:11:3-21
+hello1
+Stopped in Main.f, T26042d2.hs:11:3-21
+_result ::
+ GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld
+ -> (# GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld,
+ () #) = _
+10 f = do
+11 putStrLn "hello2.1"
+ ^^^^^^^^^^^^^^^^^^^
+12 putStrLn "hello2.2"
+hello2.1
+hello2.2
+Stopped in Main., T26042d2.hs:6:3
+_result ::
+ GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld
+ -> (# GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld,
+ () #) = _
+5 putStrLn "hello1"
+6 f
+ ^
+7 putStrLn "hello3"
+hello3
+hello4
=====================================
testsuite/tests/ghci.debugger/scripts/T26042e.stdout
=====================================
@@ -7,14 +7,12 @@ y :: [a1] -> Int = _
11 let !z = y x
^^^^^^^^^^^^
12 let !t = y ['b']
-Stopped in T7.main, T26042e.hs:19:3-11
+Stopped in T7., T26042e.hs:18:3-17
_result :: IO () = _
-x :: Int = _
-y :: Int = _
+17 main = do
18 let !(x, y) = a
+ ^^^^^^^^^^^^^^^
19 print '1'
- ^^^^^^^^^
-20 print '2'
'1'
'2'
'3'
=====================================
testsuite/tests/ghci.debugger/scripts/T26042f2.stdout
=====================================
@@ -8,18 +8,16 @@ x :: Int = 450
21 pure (x + 3)
^^
22 {-# OPAQUE t #-}
-Stopped in T8.g, T26042f.hs:15:3-17
+Stopped in T8., T26042f.hs:14:3-14
_result :: Identity Int = _
-a :: Int = 453
+13 g x = do
14 a <- t (x*2)
+ ^^^^^^^^^^^^
15 n <- pure (a+a)
- ^^^^^^^^^^^^^^^
-16 return (n+n)
-Stopped in T8.f, T26042f.hs:9:3-17
+Stopped in T8., T26042f.hs:8:3-14
_result :: Identity Int = _
-b :: Int = 1812
+7 f x = do
8 b <- g (x*x)
+ ^^^^^^^^^^^^
9 y <- pure (b+b)
- ^^^^^^^^^^^^^^^
-10 return (y+y)
7248
=====================================
testsuite/tests/ghci.debugger/scripts/T26042g.stdout
=====================================
@@ -6,10 +6,13 @@ x :: Int = 14
11 succ x = (-) (x - 2) (x + 1)
^^^^^^^^^^^^^^^^^^^
12
-Stopped in T9.top, T26042g.hs:8:10-21
+Stopped in T9., T26042g.hs:(6,3)-(8,21)
_result :: Int = _
+5 top = do
+ vv
+6 case succ 14 of
7 5 -> 5
8 _ -> 6 + other 55
- ^^^^^^^^^^^^
+ ^^
9
171
=====================================
testsuite/tests/ghci.debugger/scripts/all.T
=====================================
@@ -147,8 +147,9 @@ test('T25932', extra_files(['T25932.hs']), ghci_script, ['T25932.script'])
# Step out tests
test('T26042b', [extra_hc_opts('-O -fno-unoptimized-core-for-interpreter'), extra_files(['T26042b.hs'])], ghci_script, ['T26042b.script'])
-test('T26042c', [expect_broken(26042),extra_hc_opts('-O -fno-unoptimized-core-for-interpreter'), extra_files(['T26042c.hs'])], ghci_script, ['T26042c.script'])
+test('T26042c', [extra_hc_opts('-O -fno-unoptimized-core-for-interpreter'), extra_files(['T26042c.hs'])], ghci_script, ['T26042c.script'])
test('T26042d', [extra_hc_opts('-O -fno-unoptimized-core-for-interpreter'), extra_files(['T26042d.hs'])], ghci_script, ['T26042d.script'])
+test('T26042d2', [extra_hc_opts('-O -fno-unoptimized-core-for-interpreter'), extra_files(['T26042d2.hs'])], ghci_script, ['T26042d2.script'])
test('T26042e', extra_files(['T26042e.hs']), ghci_script, ['T26042e.script'])
test('T26042f1', extra_files(['T26042f.hs', 'T26042f.script']), ghci_script, ['T26042f.script']) # >> is not inlined, so stepout has nowhere to stop
test('T26042f2', [extra_hc_opts('-O -fno-unoptimized-core-for-interpreter'), extra_files(['T26042f.hs', 'T26042f.script'])], ghci_script, ['T26042f.script'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5047e9326f616c48d6e10f5766a2b8…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5047e9326f616c48d6e10f5766a2b8…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/sol/hie-wierd-in-as-external] Use isKnownOrigName_maybe to reconstruct wired-in names
by Simon Hengel (＠sol) 28 Jul '25
by Simon Hengel (＠sol) 28 Jul '25
28 Jul '25
Simon Hengel pushed to branch wip/sol/hie-wierd-in-as-external at Glasgow Haskell Compiler / GHC
Commits:
330d46a1 by Simon Hengel at 2025-07-28T23:23:47+07:00
Use isKnownOrigName_maybe to reconstruct wired-in names
- - - - -
1 changed file:
- compiler/GHC/Iface/Ext/Binary.hs
Changes:
=====================================
compiler/GHC/Iface/Ext/Binary.hs
=====================================
@@ -285,6 +285,8 @@ fromHieName :: NameCache -> HieName -> IO Name
fromHieName nc hie_name = do
case hie_name of
+ ExternalName mod occ _ | Just name <- isKnownOrigName_maybe mod occ -> return name
+
ExternalName mod occ span -> updateNameCache nc mod occ $ \cache -> do
case lookupOrigNameCache cache mod occ of
Just name -> pure (cache, name)
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/330d46a1e9414c37cc0460c4de123c4…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/330d46a1e9414c37cc0460c4de123c4…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/romes/step-out-11] 2 commits: debugger: Allow BRK_FUNs to head case continuation BCOs
by Rodrigo Mesquita (＠alt-romes) 28 Jul '25
by Rodrigo Mesquita (＠alt-romes) 28 Jul '25
28 Jul '25
Rodrigo Mesquita pushed to branch wip/romes/step-out-11 at Glasgow Haskell Compiler / GHC
Commits:
6a4011a3 by Rodrigo Mesquita at 2025-07-28T16:21:32+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).
- - - - -
5047e932 by Rodrigo Mesquita at 2025-07-28T16:21:32+01:00
Add InternalBreakLocs for code-generation time Brk locations
T26042d2 is a simple example displaying how this approach is not good
enough e.g. for do blocks because the cases continuations currently end
up not surrounded by a tick.
TODO: Figure out how to add BRK_FUNs to all case continuations where it
is relevant that we can step out to
TODO: Test step-out from a continuation which receives an unboxed tuple as an argument
- - - - -
13 changed files:
- compiler/GHC/ByteCode/Breakpoints.hs
- compiler/GHC/Linker/Loader.hs
- compiler/GHC/Runtime/Debugger/Breakpoints.hs
- compiler/GHC/Runtime/Eval.hs
- compiler/GHC/StgToByteCode.hs
- ghc/GHCi/UI.hs
- libraries/ghci/GHCi/Run.hs
- rts/Interpreter.c
- + 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/T26042g.stdout
- testsuite/tests/ghci.debugger/scripts/all.T
Changes:
=====================================
compiler/GHC/ByteCode/Breakpoints.hs
=====================================
@@ -1,4 +1,5 @@
{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE DerivingStrategies #-}
-- | Breakpoint information constructed during ByteCode generation.
--
@@ -15,6 +16,7 @@ module GHC.ByteCode.Breakpoints
-- ** Internal breakpoint identifier
, InternalBreakpointId(..), BreakInfoIndex
+ , InternalBreakLoc(..)
-- * Operations
@@ -23,7 +25,7 @@ module GHC.ByteCode.Breakpoints
-- ** Source-level information operations
, getBreakLoc, getBreakVars, getBreakDecls, getBreakCCS
- , getBreakSourceId
+ , getBreakSourceId, getBreakSourceMod
-- * Utils
, seqInternalModBreaks
@@ -165,7 +167,7 @@ data CgBreakInfo
{ cgb_tyvars :: ![IfaceTvBndr] -- ^ Type variables in scope at the breakpoint
, cgb_vars :: ![Maybe (IfaceIdBndr, Word)]
, cgb_resty :: !IfaceType
- , cgb_tick_id :: !BreakpointId
+ , cgb_tick_id :: !(Either InternalBreakLoc 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
@@ -173,9 +175,19 @@ data CgBreakInfo
--
-- The modules of breakpoint occurrence and breakpoint definition are not
-- necessarily the same: See Note [Breakpoint identifiers].
+ --
+ -- If there is no original tick identifier (that is, the breakpoint was
+ -- created during code generation), instead refer directly to the SrcSpan
+ -- we want to use for it. See Note [Internal Breakpoint Locations]
}
-- See Note [Syncing breakpoint info] in GHC.Runtime.Eval
+-- | Breakpoints created during code generation don't have a source-level tick
+-- location. Instead, we come up with one ourselves.
+-- See Note [Internal Breakpoint Locations]
+newtype InternalBreakLoc = InternalBreakLoc SrcSpan
+ deriving newtype (Eq, Show, NFData, Outputable)
+
-- | Get an internal breakpoint info by 'InternalBreakpointId'
getInternalBreak :: InternalBreakpointId -> InternalModBreaks -> CgBreakInfo
getInternalBreak (InternalBreakpointId mod ix) imbs =
@@ -196,27 +208,36 @@ assert_modules_match ibi_mod imbs_mod =
-- | 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 -> InternalModBreaks -> Either InternalBreakLoc 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 module for this breakpoint (where the breakpoint is defined)
+getBreakSourceMod :: InternalBreakpointId -> InternalModBreaks -> Module
+getBreakSourceMod (InternalBreakpointId ibi_mod ibi_ix) imbs =
+ assert_modules_match ibi_mod (imodBreaks_module imbs) $
+ let cgb = imodBreaks_breakInfo imbs IM.! ibi_ix
+ in case cgb_tick_id cgb of
+ Left InternalBreakLoc{} -> imodBreaks_module imbs
+ Right BreakpointId{bi_tick_mod} -> bi_tick_mod
+
-- | Get the source span for this breakpoint
getBreakLoc :: (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO SrcSpan
-getBreakLoc = getBreakXXX modBreaks_locs
+getBreakLoc = getBreakXXX modBreaks_locs (\(InternalBreakLoc x) -> x)
-- | Get the vars for this breakpoint
getBreakVars :: (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO [OccName]
-getBreakVars = getBreakXXX modBreaks_vars
+getBreakVars = getBreakXXX modBreaks_vars (const [])
-- | Get the decls for this breakpoint
getBreakDecls :: (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO [String]
-getBreakDecls = getBreakXXX modBreaks_decls
+getBreakDecls = getBreakXXX modBreaks_decls (const [])
-- | Get the decls for this breakpoint
-getBreakCCS :: (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO (String, String)
-getBreakCCS = getBreakXXX modBreaks_ccs
+getBreakCCS :: (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO (Maybe (String, String))
+getBreakCCS = getBreakXXX (fmap Just . modBreaks_ccs) (const Nothing)
-- | Internal utility to access a ModBreaks field at a particular breakpoint index
--
@@ -228,14 +249,17 @@ getBreakCCS = getBreakXXX modBreaks_ccs
-- 'ModBreaks'. When the tick module is different, we need to look up the
-- 'ModBreaks' in the HUG for that other module.
--
+-- When there is no tick module (the breakpoint was generated at codegen), use
+-- the function on internal mod breaks.
+--
-- 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 =
+getBreakXXX :: (ModBreaks -> Array BreakTickIndex a) -> (InternalBreakLoc -> a) -> (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO a
+getBreakXXX view viewInternal 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}
+ Right BreakpointId{bi_tick_mod, bi_tick_index}
| bi_tick_mod == ibi_mod
-> do
let these_mbs = imodBreaks_modBreaks imbs
@@ -244,6 +268,8 @@ getBreakXXX view lookupModule (InternalBreakpointId ibi_mod ibi_ix) imbs =
-> do
other_mbs <- lookupModule bi_tick_mod
return $ view other_mbs ! bi_tick_index
+ Left l ->
+ return $ viewInternal l
--------------------------------------------------------------------------------
-- Instances
=====================================
compiler/GHC/Linker/Loader.hs
=====================================
@@ -58,6 +58,7 @@ import GHCi.RemoteTypes
import GHC.Iface.Load
import GHCi.Message (ConInfoTable(..), LoadedDLL)
+import GHC.ByteCode.Breakpoints
import GHC.ByteCode.Linker
import GHC.ByteCode.Asm
import GHC.ByteCode.Types
@@ -1711,8 +1712,10 @@ allocateCCS interp ce mbss
let count = 1 + (maybe 0 fst $ IM.lookupMax imodBreaks_breakInfo)
let ccs = IM.map
(\info ->
- fromMaybe (toRemotePtr nullPtr)
- (M.lookup (cgb_tick_id info) ccss)
+ case cgb_tick_id info of
+ Right bi -> fromMaybe (toRemotePtr nullPtr)
+ (M.lookup bi ccss)
+ Left InternalBreakLoc{} -> toRemotePtr nullPtr
)
imodBreaks_breakInfo
assertPpr (count == length ccs)
=====================================
compiler/GHC/Runtime/Debugger/Breakpoints.hs
=====================================
@@ -253,8 +253,11 @@ mkBreakpointOccurrences = 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])
+ case cgb_tick_id cgi of
+ Right (BreakpointId tick_mod tick_ix)
+ -> extendModuleEnvWith (IntMap.unionWith (S.<>)) bmp tick_mod (IntMap.singleton tick_ix [ibi])
+ Left _
+ -> bmp
) bmp0 (imodBreaks_breakInfo ibrks)
--------------------------------------------------------------------------------
@@ -287,7 +290,7 @@ getCurrentBreakModule = do
Nothing -> pure Nothing
Just ibi -> do
brks <- readIModBreaks hug ibi
- return $ Just $ bi_tick_mod $ getBreakSourceId ibi brks
+ return $ Just $ getBreakSourceMod ibi brks
ix ->
Just <$> getHistoryModule hug (resumeHistory r !! (ix-1))
=====================================
compiler/GHC/Runtime/Eval.hs
=====================================
@@ -151,7 +151,7 @@ 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
+ return $ getBreakSourceMod ibi brks
getHistorySpan :: HUG.HomeUnitGraph -> History -> IO SrcSpan
getHistorySpan hug hist = do
=====================================
compiler/GHC/StgToByteCode.hs
=====================================
@@ -63,7 +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.Runtime.Interpreter ( interpreterProfiled, readIModModBreaks )
import GHC.Data.Bitmap
import GHC.Data.FlatBag as FlatBag
import GHC.Data.OrdList
@@ -99,6 +99,7 @@ import GHC.CoreToIface
import Control.Monad.IO.Class
import Control.Monad.Trans.Reader (ReaderT(..))
import Control.Monad.Trans.State (StateT(..))
+import Data.Array ((!))
-- -----------------------------------------------------------------------------
-- Generating byte code for a complete module
@@ -393,26 +394,30 @@ 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 tick_id fvs) rhs) = do
- code <- schemeE d 0 p rhs
- 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 -> 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
+schemeER_wrk d p (StgTick bp@(Breakpoint tick_ty tick_id fvs) rhs) = do
+ platform <- profilePlatform <$> getProfile
+
+ code <- case rhs of
+ -- When we find a tick surrounding a case expression we introduce a new BRK_FUN
+ -- instruction at the start of the case *continuation*, in addition to the
+ -- usual BRK_FUN surrounding the StgCase)
+ -- See Note [TODO]
+ StgCase scrut bndr _ alts
+ -> doCase d 0 p (Just bp) scrut bndr alts
+ _ -> schemeE d 0 p rhs
+
+ 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 (Right tick_id)
+
+ mibi <- newBreakInfo breakInfo
+
+ return $ case mibi of
+ Nothing -> code
+ Just ibi -> BRK_FUN ibi `consOL` code
- let breakInstr = BRK_FUN (InternalBreakpointId info_mod infox)
- return $ breakInstr `consOL` code
schemeER_wrk d p rhs = schemeE d 0 p rhs
getVarOffSets :: Platform -> StackDepth -> BCEnv -> [Id] -> [Maybe (Id, WordOff)]
@@ -614,7 +619,7 @@ schemeE d s p (StgTick _ rhs) = schemeE d s p rhs
schemeE d s p (StgCase scrut _ _ []) = schemeE d s p scrut
schemeE d s p (StgCase scrut bndr _ alts)
- = doCase d s p scrut bndr alts
+ = doCase d s p Nothing scrut bndr alts
{-
@@ -1106,11 +1111,15 @@ doCase
:: StackDepth
-> Sequel
-> BCEnv
+ -> Maybe StgTickish
+ -- ^ The breakpoint surrounding the full case expression, if any (only
+ -- source-level cases get breakpoint ticks, and those are the only we care
+ -- about). See Note [TODO]
-> CgStgExpr
-> Id
-> [CgStgAlt]
-> BcM BCInstrList
-doCase d s p scrut bndr alts
+doCase d s p m_bid scrut bndr alts
= do
profile <- getProfile
hsc_env <- getHscEnv
@@ -1140,43 +1149,34 @@ doCase d s p scrut bndr alts
-- When an alt is entered, it assumes the returned value is
-- on top of the itbl; see Note [Return convention for non-tuple values]
-- for details.
- ret_frame_size_b :: StackDepth
- ret_frame_size_b | ubx_tuple_frame =
- (if profiling then 5 else 4) * wordSize platform
- | otherwise = 2 * wordSize platform
+ ret_frame_size_w :: WordOff
+ ret_frame_size_w | ubx_tuple_frame =
+ if profiling then 5 else 4
+ | otherwise = 2
-- The stack space used to save/restore the CCCS when profiling
save_ccs_size_b | profiling &&
not ubx_tuple_frame = 2 * wordSize platform
| otherwise = 0
- -- The size of the return frame info table pointer if one exists
- unlifted_itbl_size_b :: StackDepth
- unlifted_itbl_size_b | ubx_tuple_frame = wordSize platform
- | otherwise = 0
-
(bndr_size, call_info, args_offsets)
| ubx_tuple_frame =
let bndr_reps = typePrimRep (idType bndr)
(call_info, args_offsets) =
layoutNativeCall profile NativeTupleReturn 0 id bndr_reps
- in ( wordsToBytes platform (nativeCallSize call_info)
+ in ( nativeCallSize call_info
, call_info
, args_offsets
)
- | otherwise = ( wordsToBytes platform (idSizeW platform bndr)
+ | otherwise = ( idSizeW platform bndr
, voidTupleReturnInfo
, []
)
- -- depth of stack after the return value has been pushed
+ -- Depth of stack after the return value has been pushed
+ -- This is the stack depth at the continuation.
d_bndr =
- d + ret_frame_size_b + bndr_size
-
- -- depth of stack after the extra info table for an unlifted return
- -- has been pushed, if any. This is the stack depth at the
- -- continuation.
- d_alts = d + ret_frame_size_b + bndr_size + unlifted_itbl_size_b
+ d + wordsToBytes platform bndr_size
-- Env in which to compile the alts, not including
-- any vars bound by the alts themselves
@@ -1188,13 +1188,13 @@ doCase d s p scrut bndr alts
-- given an alt, return a discr and code for it.
codeAlt :: CgStgAlt -> BcM (Discr, BCInstrList)
codeAlt GenStgAlt{alt_con=DEFAULT,alt_bndrs=_,alt_rhs=rhs}
- = do rhs_code <- schemeE d_alts s p_alts rhs
+ = do rhs_code <- schemeE d_bndr s p_alts rhs
return (NoDiscr, rhs_code)
codeAlt alt@GenStgAlt{alt_con=_, alt_bndrs=bndrs, alt_rhs=rhs}
-- primitive or nullary constructor alt: no need to UNPACK
| null real_bndrs = do
- rhs_code <- schemeE d_alts s p_alts rhs
+ rhs_code <- schemeE d_bndr s p_alts rhs
return (my_discr alt, rhs_code)
| isUnboxedTupleType bndr_ty || isUnboxedSumType bndr_ty =
let bndr_ty = idPrimRepU . fromNonVoid
@@ -1206,7 +1206,7 @@ doCase d s p scrut bndr alts
bndr_ty
(assertNonVoidIds bndrs)
- stack_bot = d_alts
+ stack_bot = d_bndr
p' = Map.insertList
[ (arg, tuple_start -
@@ -1224,7 +1224,7 @@ doCase d s p scrut bndr alts
(addIdReps (assertNonVoidIds real_bndrs))
size = WordOff tot_wds
- stack_bot = d_alts + wordsToBytes platform size
+ stack_bot = d_bndr + wordsToBytes platform size
-- convert offsets from Sp into offsets into the virtual stack
p' = Map.insertList
@@ -1324,22 +1324,53 @@ doCase d s p scrut bndr alts
alt_stuff <- mapM codeAlt alts
alt_final0 <- mkMultiBranch maybe_ncons alt_stuff
- let alt_final1
- | ubx_tuple_frame = SLIDE 0 2 `consOL` alt_final0
- | otherwise = alt_final0
- alt_final
- | gopt Opt_InsertBreakpoints (hsc_dflags hsc_env)
- -- See Note [Debugger: BRK_ALTS]
- = BRK_ALTS False `consOL` alt_final1
- | otherwise = alt_final1
+ let
+
+ -- drop the stg_ctoi_*_info header...
+ alt_final1 = SLIDE bndr_size ret_frame_size_w `consOL` alt_final0
+
+ -- after dropping the stg_ret_*_info header
+ alt_final2
+ | ubx_tuple_frame = SLIDE 0 3 `consOL` alt_final1
+ | otherwise = SLIDE 0 1 `consOL` alt_final1
+
+ -- When entering a case continuation BCO, the stack is always headed
+ -- by the stg_ret frame and the stg_ctoi frame that returned to it.
+ -- See Note [Stack layout when entering run_BCO]
+ --
+ -- Right after the breakpoint instruction, a case continuation BCO
+ -- drops the stg_ret and stg_ctoi frame headers (see alt_final1,
+ -- alt_final2), leaving the stack with the scrutinee followed by the
+ -- free variables (with depth==d_bndr)
+ alt_final <- case m_bid of
+ Just (Breakpoint tick_ty tick_id fvs)
+ | gopt Opt_InsertBreakpoints (hsc_dflags hsc_env)
+ -- Construct an internal breakpoint to put at the start of this case
+ -- continuation BCO.
+ -- See Note [TODO]
+ -> do
+ internal_tick_loc <- makeCaseInternalBreakLoc tick_id
+
+ -- same fvs available in the case expression are available in the case continuation
+ 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 (Left internal_tick_loc)
+
+ mibi <- newBreakInfo breakInfo
+ return $ case mibi of
+ Nothing -> alt_final2
+ Just ibi -> BRK_FUN ibi `consOL` alt_final2
+ _ -> pure alt_final2
add_bco_name <- shouldAddBcoName
let
alt_bco_name = getName bndr
alt_bco = mkProtoBCO platform add_bco_name alt_bco_name alt_final (Left alts)
0{-no arity-} bitmap_size bitmap True{-is alts-}
- scrut_code <- schemeE (d + ret_frame_size_b + save_ccs_size_b)
- (d + ret_frame_size_b + save_ccs_size_b)
+ scrut_code <- schemeE (d + wordsToBytes platform ret_frame_size_w + save_ccs_size_b)
+ (d + wordsToBytes platform ret_frame_size_w + save_ccs_size_b)
p scrut
if ubx_tuple_frame
then do let tuple_bco = tupleBCO platform call_info args_offsets
@@ -1351,6 +1382,24 @@ doCase d s p scrut bndr alts
_ -> panic "schemeE(StgCase).push_alts"
in return (PUSH_ALTS alt_bco scrut_rep `consOL` scrut_code)
+makeCaseInternalBreakLoc :: BreakpointId -> BcM InternalBreakLoc
+makeCaseInternalBreakLoc bid = do
+ hug <- hsc_HUG <$> getHscEnv
+ curr_mod <- getCurrentModule
+ mb_mod_brks <- getCurrentModBreaks
+
+ -- TODO: Subtract the scrutinee loc from the case loc to get continuation loc
+ InternalBreakLoc <$> case bid of
+ BreakpointId{bi_tick_mod, bi_tick_index}
+ | bi_tick_mod == curr_mod
+ , Just these_mbs <- mb_mod_brks
+ -> do
+ return $ modBreaks_locs these_mbs ! bi_tick_index
+ | otherwise
+ -> do
+ other_mbs <- liftIO $ readIModModBreaks hug bi_tick_mod
+ return $ modBreaks_locs other_mbs ! bi_tick_index
+
{-
Note [Debugger: BRK_ALTS]
~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -2667,14 +2716,19 @@ getLabelsBc n = BcM $ \_ st ->
let ctr = nextlabel st
in return (coerce [ctr .. ctr+n-1], st{nextlabel = ctr+n})
-newBreakInfo :: CgBreakInfo -> BcM Int
-newBreakInfo info = BcM $ \_ st ->
- let ix = breakInfoIdx st
- st' = st
- { breakInfo = IntMap.insert ix info (breakInfo st)
- , breakInfoIdx = ix + 1
- }
- in return (ix, st')
+newBreakInfo :: CgBreakInfo -> BcM (Maybe InternalBreakpointId)
+newBreakInfo info = BcM $ \env st -> do
+ -- if we're not generating ModBreaks for this module for some reason, we
+ -- can't store breakpoint occurrence information.
+ case modBreaks env of
+ Nothing -> pure (Nothing, st)
+ Just modBreaks -> do
+ let ix = breakInfoIdx st
+ st' = st
+ { breakInfo = IntMap.insert ix info (breakInfo st)
+ , breakInfoIdx = ix + 1
+ }
+ return (Just $ InternalBreakpointId (modBreaks_module modBreaks) ix, st')
getCurrentModule :: BcM Module
getCurrentModule = BcM $ \env st -> return (bcm_module env, st)
@@ -2687,7 +2741,7 @@ tickFS = fsLit "ticked"
-- Dehydrating CgBreakInfo
-dehydrateCgBreakInfo :: [TyVar] -> [Maybe (Id, Word)] -> Type -> BreakpointId -> CgBreakInfo
+dehydrateCgBreakInfo :: [TyVar] -> [Maybe (Id, Word)] -> Type -> Either InternalBreakLoc BreakpointId -> CgBreakInfo
dehydrateCgBreakInfo ty_vars idOffSets tick_ty bid =
CgBreakInfo
{ cgb_tyvars = map toIfaceTvBndr ty_vars
=====================================
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, InternalBreakpointId(..), getBreakSourceId)
+import GHC.ByteCode.Breakpoints (imodBreaks_modBreaks, InternalBreakpointId(..), getBreakSourceId, getBreakSourceMod)
import GHC.Runtime.Interpreter
import GHCi.RemoteTypes
import GHCi.BreakArray( breakOn, breakOff )
@@ -1621,7 +1621,7 @@ toBreakIdAndLocation (Just inf) = do
brks <- liftIO $ readIModBreaks hug inf
let bi = getBreakSourceId inf brks
return $ listToMaybe [ id_loc | id_loc@(_,loc) <- IntMap.assocs (breaks st),
- breakId loc == bi ]
+ Right (breakId loc) == bi ]
printStoppedAtBreakInfo :: GHC.GhcMonad m => Resume -> [Name] -> m ()
printStoppedAtBreakInfo res names = do
@@ -3825,7 +3825,7 @@ pprStopped res = do
hug <- hsc_HUG <$> GHC.getSession
brks <- liftIO $ readIModBreaks hug ibi
return $ Just $ moduleName $
- bi_tick_mod $ getBreakSourceId ibi brks
+ getBreakSourceMod ibi brks
return $
text "Stopped in"
<+> ((case mb_mod_name of
=====================================
libraries/ghci/GHCi/Run.hs
=====================================
@@ -362,6 +362,14 @@ withBreakAction opts breakMVar statusMVar mtid act
info_mod_uid <- BS.packCString (Ptr info_mod_uid#)
pure (Just (EvalBreakpoint info_mod info_mod_uid (I# infox#)))
putMVar statusMVar $ EvalBreak apStack_r breakpoint resume_r ccs
+
+ -- Block until this thread is resumed (by the thread which took the
+ -- `ResumeContext` from the `statusMVar`).
+ --
+ -- The `onBreak` function must have been called from `rts/Interpreter.c`
+ -- when interpreting a `BRK_FUN`. After taking from the MVar, the function
+ -- returns to the continuation on the stack which is where the interpreter
+ -- was stopped.
takeMVar breakMVar
resetBreakAction stablePtr = do
=====================================
rts/Interpreter.c
=====================================
@@ -284,6 +284,18 @@ allocate_NONUPD (Capability *cap, int n_words)
return allocate(cap, stg_max(sizeofW(StgHeader)+MIN_PAYLOAD_SIZE, n_words));
}
+STATIC_INLINE int
+is_ctoi_nontuple_frame(const StgPtr frame_head) {
+ return (
+ (W_)frame_head == (W_)&stg_ctoi_R1p_info ||
+ (W_)frame_head == (W_)&stg_ctoi_R1n_info ||
+ (W_)frame_head == (W_)&stg_ctoi_F1_info ||
+ (W_)frame_head == (W_)&stg_ctoi_D1_info ||
+ (W_)frame_head == (W_)&stg_ctoi_L1_info ||
+ (W_)frame_head == (W_)&stg_ctoi_V_info
+ );
+}
+
int rts_stop_on_exception = 0;
/* ---------------------------------------------------------------------------
@@ -844,7 +856,6 @@ eval_obj:
debugBelch("\n\n");
);
-// IF_DEBUG(sanity,checkStackChunk(Sp, cap->r.rCurrentTSO->stack+cap->r.rCurrentTSO->stack_size));
IF_DEBUG(sanity,checkStackFrame(Sp));
switch ( get_itbl(obj)->type ) {
@@ -1086,11 +1097,33 @@ do_return_pointer:
// Returning to an interpreted continuation: put the object on
// the stack, and start executing the BCO.
INTERP_TICK(it_retto_BCO);
- Sp_subW(1);
- SpW(0) = (W_)tagged_obj;
- obj = (StgClosure*)ReadSpW(2);
+ obj = (StgClosure*)ReadSpW(1);
ASSERT(get_itbl(obj)->type == BCO);
- goto run_BCO_return_pointer;
+
+ // Heap check
+ if (doYouWantToGC(cap)) {
+ Sp_subW(2);
+ SpW(1) = (W_)tagged_obj;
+ SpW(0) = (W_)&stg_ret_p_info;
+ RETURN_TO_SCHEDULER(ThreadInterpret, HeapOverflow);
+ }
+ else {
+
+ // Stack checks aren't necessary at return points, the stack use
+ // is aggregated into the enclosing function entry point.
+
+ // Make sure stack is headed by a ctoi R1p frame when returning a pointer
+ ASSERT(ReadSpW(0) == (W_)&stg_ctoi_R1p_info);
+
+ // Add the return frame on top of the args
+ Sp_subW(2);
+ SpW(1) = (W_)tagged_obj;
+ SpW(0) = (W_)&stg_ret_p_info;
+ }
+
+ /* Keep the ret frame and the ctoi frame for run_BCO.
+ * See Note [Stack layout when entering run_BCO] */
+ goto run_BCO;
default:
do_return_unrecognised:
@@ -1159,8 +1192,9 @@ do_return_nonpointer:
// get the offset of the header of the next stack frame
offset = stack_frame_sizeW((StgClosure *)Sp);
+ StgClosure* next_frame = (StgClosure*)(SafeSpWP(offset));
- switch (get_itbl((StgClosure*)(SafeSpWP(offset)))->type) {
+ switch (get_itbl(next_frame)->type) {
case RET_BCO:
// Returning to an interpreted continuation: pop the return frame
@@ -1168,8 +1202,58 @@ do_return_nonpointer:
// executing the BCO.
INTERP_TICK(it_retto_BCO);
obj = (StgClosure*)ReadSpW(offset+1);
+
ASSERT(get_itbl(obj)->type == BCO);
- goto run_BCO_return_nonpointer;
+
+ // Heap check
+ if (doYouWantToGC(cap)) {
+ RETURN_TO_SCHEDULER(ThreadInterpret, HeapOverflow);
+ }
+ else {
+ // Stack checks aren't necessary at return points, the stack use
+ // is aggregated into the enclosing function entry point.
+
+#if defined(PROFILING)
+ /*
+ Restore the current cost centre stack if a tuple is being returned.
+
+ When a "simple" unlifted value is returned, the cccs is restored with
+ an stg_restore_cccs frame on the stack, for example:
+
+ ...
+ stg_ctoi_D1
+ <CCCS>
+ stg_restore_cccs
+
+ But stg_restore_cccs cannot deal with tuples, which may have more
+ things on the stack. Therefore we store the CCCS inside the
+ stg_ctoi_t frame.
+
+ If we have a tuple being returned, the stack looks like this:
+
+ ...
+ <CCCS> <- to restore, Sp offset <next frame + 4 words>
+ tuple_BCO
+ tuple_info
+ cont_BCO
+ stg_ctoi_t <- next frame
+ tuple_data_1
+ ...
+ tuple_data_n
+ tuple_info
+ tuple_BCO
+ stg_ret_t <- Sp
+ */
+
+ if(SpW(0) == (W_)&stg_ret_t_info) {
+ cap->r.rCCCS = (CostCentreStack*)ReadSpW(offset + 4);
+ }
+#endif
+
+ /* Keep the ret frame and the ctoi frame for run_BCO.
+ * See Note [Stack layout when entering run_BCO] */
+ goto run_BCO;
+ }
default:
{
@@ -1332,111 +1416,90 @@ do_apply:
RETURN_TO_SCHEDULER_NO_PAUSE(ThreadRunGHC, ThreadYielding);
}
- // ------------------------------------------------------------------------
- // Ok, we now have a bco (obj), and its arguments are all on the
- // stack. We can start executing the byte codes.
- //
- // The stack is in one of two states. First, if this BCO is a
- // function:
- //
- // | .... |
- // +---------------+
- // | arg2 |
- // +---------------+
- // | arg1 |
- // +---------------+
- //
- // Second, if this BCO is a continuation:
- //
- // | .... |
- // +---------------+
- // | fv2 |
- // +---------------+
- // | fv1 |
- // +---------------+
- // | BCO |
- // +---------------+
- // | stg_ctoi_ret_ |
- // +---------------+
- // | retval |
- // +---------------+
- //
- // where retval is the value being returned to this continuation.
- // In the event of a stack check, heap check, or context switch,
- // we need to leave the stack in a sane state so the garbage
- // collector can find all the pointers.
- //
- // (1) BCO is a function: the BCO's bitmap describes the
- // pointerhood of the arguments.
- //
- // (2) BCO is a continuation: BCO's bitmap describes the
- // pointerhood of the free variables.
- //
- // Sadly we have three different kinds of stack/heap/cswitch check
- // to do:
-
-
-run_BCO_return_pointer:
- // Heap check
- if (doYouWantToGC(cap)) {
- Sp_subW(1); SpW(0) = (W_)&stg_ret_p_info;
- RETURN_TO_SCHEDULER(ThreadInterpret, HeapOverflow);
- }
- // Stack checks aren't necessary at return points, the stack use
- // is aggregated into the enclosing function entry point.
-
- goto run_BCO;
-
-run_BCO_return_nonpointer:
- // Heap check
- if (doYouWantToGC(cap)) {
- RETURN_TO_SCHEDULER(ThreadInterpret, HeapOverflow);
- }
- // Stack checks aren't necessary at return points, the stack use
- // is aggregated into the enclosing function entry point.
-
-#if defined(PROFILING)
- /*
- Restore the current cost centre stack if a tuple is being returned.
-
- When a "simple" unlifted value is returned, the cccs is restored with
- an stg_restore_cccs frame on the stack, for example:
-
- ...
- stg_ctoi_D1
- <CCCS>
- stg_restore_cccs
-
- But stg_restore_cccs cannot deal with tuples, which may have more
- things on the stack. Therefore we store the CCCS inside the
- stg_ctoi_t frame.
-
- If we have a tuple being returned, the stack looks like this:
-
- ...
- <CCCS> <- to restore, Sp offset <next frame + 4 words>
- tuple_BCO
- tuple_info
- cont_BCO
- stg_ctoi_t <- next frame
- tuple_data_1
- ...
- tuple_data_n
- tuple_info
- tuple_BCO
- stg_ret_t <- Sp
- */
-
- if(SpW(0) == (W_)&stg_ret_t_info) {
- cap->r.rCCCS = (CostCentreStack*)ReadSpW(stack_frame_sizeW((StgClosure *)Sp) + 4);
- }
-#endif
-
- if (SpW(0) != (W_)&stg_ret_t_info) {
- Sp_addW(1);
- }
- goto run_BCO;
+/*
+Note [Stack layout when entering run_BCO]
+-----------------------------------------
+We have a bco (obj), and its arguments are all on the stack. We can start
+executing the byte codes.
+
+The stack is in one of two states. First, if this BCO is a
+function (in run_BCO_fun or run_BCO)
+
+ | .... |
+ +---------------+
+ | arg2 |
+ +---------------+
+ | arg1 |
+ +---------------+
+
+Second, if this BCO is a case cont., as per Note [Case continuation BCOs] (only
+in run_BCO):
+
+ | .... |
+ +---------------+
+ | fv2 |
+ +---------------+
+ | fv1 |
+ +---------------+
+ | BCO |
+ +---------------+
+ | stg_ctoi_ret_ |
+ +---------------+
+ | retval |
+ +---------------+
+ | stg_ret_..... |
+ +---------------+
+
+where retval is the value being returned to this continuation.
+In the event of a stack check, heap check, context switch,
+or breakpoint, we need to leave the stack in a sane state so
+the garbage collector can find all the pointers.
+
+ (1) BCO is a function: the BCO's bitmap describes the
+ pointerhood of the arguments.
+
+ (2) BCO is a continuation: BCO's bitmap describes the
+ pointerhood of the free variables.
+
+To reconstruct a valid stack state for yielding (such that when we return to
+the interpreter we end up in the same place from where we yielded), we need to
+differentiate the two cases again:
+
+ (1) For function BCOs, the arguments are directly on top of the stack, so it
+ suffices to add a `stg_apply_interp_info` frame header using the BCO that is
+ being applied to these arguments (i.e. the `obj` being run)
+
+ (2) For continuation BCOs, the stack is already consistent -- that's why we
+ keep the ret and ctoi frame on top of the stack when we start executing it.
+
+ We couldn't reconstruct a valid stack that resumes the case continuation
+ execution just from the return and free vars values alone because we wouldn't
+ know what kind of result it was (are we returning a pointer, non pointer int,
+ a tuple? etc.); especially considering some frames have different sizes,
+ notably unboxed tuple return frames (see Note [unboxed tuple bytecodes and tuple_BCO]).
+
+ For consistency, the first instructions in a case continuation BCO, right
+ after a possible BRK_FUN heading it, are two SLIDEs to remove the stg_ret_
+ and stg_ctoi_ frame headers, leaving only the return value followed by the
+ free vars. Theses slides use statically known offsets computed in StgToByteCode.hs.
+ Following the continuation BCO diagram above, SLIDING would result in:
+
+ | .... |
+ +---------------+
+ | fv2 |
+ +---------------+
+ | fv1 |
+ +---------------+
+ | retval |
+ +---------------+
+*/
+// Ok, we now have a bco (obj), and its arguments are all on the stack as
+// described by Note [Stack layout when entering run_BCO].
+// We can start executing the byte codes.
+//
+// Sadly we have three different kinds of stack/heap/cswitch check
+// to do:
run_BCO_fun:
IF_DEBUG(sanity,
Sp_subW(2);
@@ -1466,6 +1529,7 @@ run_BCO_fun:
// Now, actually interpret the BCO... (no returning to the
// scheduler again until the stack is in an orderly state).
+ // See also Note [Stack layout when entering run_BCO]
run_BCO:
INTERP_TICK(it_BCO_entries);
{
@@ -1519,7 +1583,7 @@ run_BCO:
switch (bci & 0xFF) {
- /* check for a breakpoint on the beginning of a let binding */
+ /* check for a breakpoint on the beginning of a BCO */
case bci_BRK_FUN:
{
W_ arg1_brk_array, arg2_info_mod_name, arg3_info_mod_id, arg4_info_index;
@@ -1572,6 +1636,20 @@ run_BCO:
{
breakPoints = (StgArrBytes *) BCO_PTR(arg1_brk_array);
+ W_ stack_head = ReadSpW(0);
+
+ // When the BRK_FUN is at the start of a case continuation BCO,
+ // the stack contains the frame returning the value at the start.
+ // See Note [Stack layout when entering run_BCO]
+ int is_case_cont_BCO =
+ stack_head == (W_)&stg_ret_t_info
+ || stack_head == (W_)&stg_ret_v_info
+ || stack_head == (W_)&stg_ret_p_info
+ || stack_head == (W_)&stg_ret_n_info
+ || stack_head == (W_)&stg_ret_f_info
+ || stack_head == (W_)&stg_ret_d_info
+ || stack_head == (W_)&stg_ret_l_info;
+
// 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)[arg4_info_index];
@@ -1580,36 +1658,96 @@ run_BCO:
// decrement and write back ignore count
((StgInt*)breakPoints->payload)[arg4_info_index] = --ignore_count;
}
- else if (stop_next_breakpoint == true || ignore_count == 0)
+ else if (
+ /* Doing step-in (but don't stop at case continuation BCOs,
+ * those are only useful when stepping out) */
+ (stop_next_breakpoint == true && !is_case_cont_BCO)
+ /* Or breakpoint is explicitly enabled */
+ || ignore_count == 0)
{
// make sure we don't automatically stop at the
// next breakpoint
rts_stop_next_breakpoint = 0;
cap->r.rCurrentTSO->flags &= ~TSO_STOP_NEXT_BREAKPOINT;
- // allocate memory for a new AP_STACK, enough to
- // store the top stack frame plus an
- // stg_apply_interp_info pointer and a pointer to
- // the BCO
- size_words = BCO_BITMAP_SIZE(obj) + 2;
- new_aps = (StgAP_STACK *) allocate(cap, AP_STACK_sizeW(size_words));
- new_aps->size = size_words;
- new_aps->fun = &stg_dummy_ret_closure;
-
- // fill in the payload of the AP_STACK
- new_aps->payload[0] = (StgClosure *)&stg_apply_interp_info;
- new_aps->payload[1] = (StgClosure *)obj;
-
- // copy the contents of the top stack frame into the AP_STACK
- for (i = 2; i < size_words; i++)
- {
- new_aps->payload[i] = (StgClosure *)ReadSpW(i-2);
+ /* To yield execution we need to come up with a consistent AP_STACK
+ * to store in the :history data structure.
+ */
+ if (is_case_cont_BCO) {
+
+ // If the BCO is a case cont. then the stack is headed by the
+ // stg_ret and a stg_ctoi frames which caused this same BCO
+ // to be run. This stack is already well-formed, so it
+ // needs only to be copied to the AP_STACK.
+ // See Note [Stack layout when entering run_BCO]
+
+ // stg_ret_*
+ int size_returned_frame =
+ (stack_head == (W_)&stg_ret_t_info)
+ ? 2 /* ret_t + tuple_BCO */
+ + /* Sp(2) is call_info which records the offset to the next frame
+ * See also Note [unboxed tuple bytecodes and tuple_BCO] */
+ ((ReadSpW(2) & 0xFF))
+ : 2; /* ret_* + return value */
+
+ StgPtr cont_frame_head
+ = (StgPtr)(SpW(size_returned_frame));
+ ASSERT(obj == UNTAG_CLOSURE((StgClosure*)ReadSpW(size_returned_frame+1)));
+
+ // stg_ctoi_*
+ int size_cont_frame_head =
+ is_ctoi_nontuple_frame(cont_frame_head)
+ ? 2 // info+bco
+#if defined(PROFILING)
+ : 5; // or info+bco+tuple_info+tuple_BCO+CCS
+#else
+ : 4; // or info+bco+tuple_info+tuple_BCO
+#endif
+
+ // Continuation stack is already well formed,
+ // so just copy it whole to the AP_STACK
+ size_words = size_returned_frame
+ + size_cont_frame_head
+ + BCO_BITMAP_SIZE(obj) /* payload of cont_frame */;
+ new_aps = (StgAP_STACK *) allocate(cap, AP_STACK_sizeW(size_words));
+ new_aps->size = size_words;
+ new_aps->fun = &stg_dummy_ret_closure;
+
+ // (1) Fill in the payload of the AP_STACK:
+ for (i = 0; i < size_words; i++) {
+ new_aps->payload[i] = (StgClosure *)ReadSpW(i);
+ }
+ }
+ else {
+
+ // The BCO is a function, therefore the arguments are
+ // directly on top of the stack.
+ // To construct a valid stack chunk simply add an
+ // stg_apply_interp and the current BCO to the stack.
+ // See also Note [Stack layout when entering run_BCO]
+
+ // (1) Allocate memory for a new AP_STACK, enough to store
+ // the top stack frame plus an stg_apply_interp_info pointer
+ // and a pointer to the BCO
+ size_words = BCO_BITMAP_SIZE(obj) + 2;
+ new_aps = (StgAP_STACK *) allocate(cap, AP_STACK_sizeW(size_words));
+ new_aps->size = size_words;
+ new_aps->fun = &stg_dummy_ret_closure;
+
+ // (1.1) the continuation frame
+ new_aps->payload[0] = (StgClosure *)&stg_apply_interp_info;
+ new_aps->payload[1] = (StgClosure *)obj;
+
+ // (1.2.1) copy the args/free vars of the top stack frame into the AP_STACK
+ for (i = 2; i < size_words; i++) {
+ new_aps->payload[i] = (StgClosure *)ReadSpW(i-2);
+ }
}
// No write barrier is needed here as this is a new allocation
SET_HDR(new_aps,&stg_AP_STACK_info,cap->r.rCCCS);
- // Arrange the stack to call the breakpoint IO action, and
+ // (2) Arrange the stack to call the breakpoint IO action, and
// continue execution of this BCO when the IO action returns.
//
// ioAction :: Addr# -- the breakpoint info module
@@ -1622,12 +1760,27 @@ run_BCO:
ioAction = (StgClosure *) deRefStablePtr (
rts_breakpoint_io_action);
- Sp_subW(13);
- SpW(12) = (W_)obj;
- SpW(11) = (W_)&stg_apply_interp_info;
+ // (2.1) Construct the continuation to which we'll return in
+ // this thread after the `rts_breakpoint_io_action` returns.
+ //
+ // For case cont. BCOs, the continuation to re-run this BCO
+ // is already first on the stack. For function BCOs we need
+ // to add an `stg_apply_interp` apply to the current BCO.
+ // See Note [Stack layout when entering run_BCO]
+ if (!is_case_cont_BCO) {
+ Sp_subW(2); // stg_apply_interp_info + StgBCO*
+
+ // (2.1.2) Write the continuation frame (above the stg_ret
+ // frame if one exists)
+ SpW(1) = (W_)obj;
+ SpW(0) = (W_)&stg_apply_interp_info;
+ }
+
+ // (2.2) The `rts_breakpoint_io_action` call
+ Sp_subW(11);
SpW(10) = (W_)new_aps;
- SpW(9) = (W_)False_closure; // True <=> an exception
- SpW(8) = (W_)&stg_ap_ppv_info;
+ 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(arg3_info_mod_id);
=====================================
testsuite/tests/ghci.debugger/scripts/T26042d2.hs
=====================================
@@ -0,0 +1,13 @@
+
+module Main where
+
+main = do
+ putStrLn "hello1"
+ f
+ putStrLn "hello3"
+ putStrLn "hello4"
+
+f = do
+ putStrLn "hello2.1"
+ putStrLn "hello2.2"
+{-# NOINLINE f #-}
=====================================
testsuite/tests/ghci.debugger/scripts/T26042d2.script
=====================================
@@ -0,0 +1,12 @@
+:load T26042d2.hs
+
+:break 11
+main
+:list
+:stepout
+:list
+:stepout
+
+-- should exit! we compile this test case with -O1 to make sure the monad >> are inlined
+-- and thus the test relies on the filtering behavior based on SrcSpans for stepout
+
=====================================
testsuite/tests/ghci.debugger/scripts/T26042d2.stdout
=====================================
@@ -0,0 +1,16 @@
+Breakpoint 0 activated at T26042d2.hs:11:3-21
+hello1
+Stopped in Main.f, T26042d2.hs:11:3-21
+_result ::
+ GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld
+ -> (# GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld,
+ () #) = _
+10 f = do
+11 putStrLn "hello2.1"
+ ^^^^^^^^^^^^^^^^^^^
+12 putStrLn "hello2.2"
+hello2.1
+hello2.2
+<--- should break here too
+hello3
+hello4
=====================================
testsuite/tests/ghci.debugger/scripts/T26042g.stdout
=====================================
@@ -6,10 +6,13 @@ x :: Int = 14
11 succ x = (-) (x - 2) (x + 1)
^^^^^^^^^^^^^^^^^^^
12
-Stopped in T9.top, T26042g.hs:8:10-21
+Stopped in T9., T26042g.hs:(6,3)-(8,21)
_result :: Int = _
+5 top = do
+ vv
+6 case succ 14 of
7 5 -> 5
8 _ -> 6 + other 55
- ^^^^^^^^^^^^
+ ^^
9
171
=====================================
testsuite/tests/ghci.debugger/scripts/all.T
=====================================
@@ -147,8 +147,9 @@ test('T25932', extra_files(['T25932.hs']), ghci_script, ['T25932.script'])
# Step out tests
test('T26042b', [extra_hc_opts('-O -fno-unoptimized-core-for-interpreter'), extra_files(['T26042b.hs'])], ghci_script, ['T26042b.script'])
-test('T26042c', [expect_broken(26042),extra_hc_opts('-O -fno-unoptimized-core-for-interpreter'), extra_files(['T26042c.hs'])], ghci_script, ['T26042c.script'])
+test('T26042c', [extra_hc_opts('-O -fno-unoptimized-core-for-interpreter'), extra_files(['T26042c.hs'])], ghci_script, ['T26042c.script'])
test('T26042d', [extra_hc_opts('-O -fno-unoptimized-core-for-interpreter'), extra_files(['T26042d.hs'])], ghci_script, ['T26042d.script'])
+test('T26042d2', [extra_hc_opts('-O -fno-unoptimized-core-for-interpreter'), extra_files(['T26042d2.hs'])], ghci_script, ['T26042d2.script'])
test('T26042e', extra_files(['T26042e.hs']), ghci_script, ['T26042e.script'])
test('T26042f1', extra_files(['T26042f.hs', 'T26042f.script']), ghci_script, ['T26042f.script']) # >> is not inlined, so stepout has nowhere to stop
test('T26042f2', [extra_hc_opts('-O -fno-unoptimized-core-for-interpreter'), extra_files(['T26042f.hs', 'T26042f.script'])], ghci_script, ['T26042f.script'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/712acd47702ac847697c4e9acd7eba…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/712acd47702ac847697c4e9acd7eba…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/romes/step-out-11] 2 commits: debugger: Allow BRK_FUNs to head case continuation BCOs
by Rodrigo Mesquita (＠alt-romes) 28 Jul '25
by Rodrigo Mesquita (＠alt-romes) 28 Jul '25
28 Jul '25
Rodrigo Mesquita pushed to branch wip/romes/step-out-11 at Glasgow Haskell Compiler / GHC
Commits:
882d7397 by Rodrigo Mesquita at 2025-07-28T14:55:23+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).
- - - - -
712acd47 by Rodrigo Mesquita at 2025-07-28T15:09:09+01:00
Add InternalBreakLocs for code-generation time Brk locations
T26042d2 is a simple example displaying how this approach is not good
enough e.g. for do blocks because the cases continuations currently end
up not surrounded by a tick.
TODO: Figure out how to add BRK_FUNs to all case continuations where it
is relevant that we can step out to
TODO: Test step-out from a continuation which receives an unboxed tuple as an argument
- - - - -
13 changed files:
- compiler/GHC/ByteCode/Breakpoints.hs
- compiler/GHC/Linker/Loader.hs
- compiler/GHC/Runtime/Debugger/Breakpoints.hs
- compiler/GHC/Runtime/Eval.hs
- compiler/GHC/StgToByteCode.hs
- ghc/GHCi/UI.hs
- libraries/ghci/GHCi/Run.hs
- rts/Interpreter.c
- + 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/T26042g.stdout
- testsuite/tests/ghci.debugger/scripts/all.T
Changes:
=====================================
compiler/GHC/ByteCode/Breakpoints.hs
=====================================
@@ -1,4 +1,5 @@
{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE DerivingStrategies #-}
-- | Breakpoint information constructed during ByteCode generation.
--
@@ -15,6 +16,7 @@ module GHC.ByteCode.Breakpoints
-- ** Internal breakpoint identifier
, InternalBreakpointId(..), BreakInfoIndex
+ , InternalBreakLoc(..)
-- * Operations
@@ -23,7 +25,7 @@ module GHC.ByteCode.Breakpoints
-- ** Source-level information operations
, getBreakLoc, getBreakVars, getBreakDecls, getBreakCCS
- , getBreakSourceId
+ , getBreakSourceId, getBreakSourceMod
-- * Utils
, seqInternalModBreaks
@@ -165,7 +167,7 @@ data CgBreakInfo
{ cgb_tyvars :: ![IfaceTvBndr] -- ^ Type variables in scope at the breakpoint
, cgb_vars :: ![Maybe (IfaceIdBndr, Word)]
, cgb_resty :: !IfaceType
- , cgb_tick_id :: !BreakpointId
+ , cgb_tick_id :: !(Either InternalBreakLoc 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
@@ -173,9 +175,19 @@ data CgBreakInfo
--
-- The modules of breakpoint occurrence and breakpoint definition are not
-- necessarily the same: See Note [Breakpoint identifiers].
+ --
+ -- If there is no original tick identifier (that is, the breakpoint was
+ -- created during code generation), instead refer directly to the SrcSpan
+ -- we want to use for it. See Note [Internal Breakpoint Locations]
}
-- See Note [Syncing breakpoint info] in GHC.Runtime.Eval
+-- | Breakpoints created during code generation don't have a source-level tick
+-- location. Instead, we come up with one ourselves.
+-- See Note [Internal Breakpoint Locations]
+newtype InternalBreakLoc = InternalBreakLoc SrcSpan
+ deriving newtype (Eq, Show, NFData, Outputable)
+
-- | Get an internal breakpoint info by 'InternalBreakpointId'
getInternalBreak :: InternalBreakpointId -> InternalModBreaks -> CgBreakInfo
getInternalBreak (InternalBreakpointId mod ix) imbs =
@@ -196,27 +208,36 @@ assert_modules_match ibi_mod imbs_mod =
-- | 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 -> InternalModBreaks -> Either InternalBreakLoc 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 module for this breakpoint (where the breakpoint is defined)
+getBreakSourceMod :: InternalBreakpointId -> InternalModBreaks -> Module
+getBreakSourceMod (InternalBreakpointId ibi_mod ibi_ix) imbs =
+ assert_modules_match ibi_mod (imodBreaks_module imbs) $
+ let cgb = imodBreaks_breakInfo imbs IM.! ibi_ix
+ in case cgb_tick_id cgb of
+ Left InternalBreakLoc{} -> imodBreaks_module imbs
+ Right BreakpointId{bi_tick_mod} -> bi_tick_mod
+
-- | Get the source span for this breakpoint
getBreakLoc :: (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO SrcSpan
-getBreakLoc = getBreakXXX modBreaks_locs
+getBreakLoc = getBreakXXX modBreaks_locs (\(InternalBreakLoc x) -> x)
-- | Get the vars for this breakpoint
getBreakVars :: (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO [OccName]
-getBreakVars = getBreakXXX modBreaks_vars
+getBreakVars = getBreakXXX modBreaks_vars (const [])
-- | Get the decls for this breakpoint
getBreakDecls :: (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO [String]
-getBreakDecls = getBreakXXX modBreaks_decls
+getBreakDecls = getBreakXXX modBreaks_decls (const [])
-- | Get the decls for this breakpoint
-getBreakCCS :: (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO (String, String)
-getBreakCCS = getBreakXXX modBreaks_ccs
+getBreakCCS :: (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO (Maybe (String, String))
+getBreakCCS = getBreakXXX (fmap Just . modBreaks_ccs) (const Nothing)
-- | Internal utility to access a ModBreaks field at a particular breakpoint index
--
@@ -228,14 +249,17 @@ getBreakCCS = getBreakXXX modBreaks_ccs
-- 'ModBreaks'. When the tick module is different, we need to look up the
-- 'ModBreaks' in the HUG for that other module.
--
+-- When there is no tick module (the breakpoint was generated at codegen), use
+-- the function on internal mod breaks.
+--
-- 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 =
+getBreakXXX :: (ModBreaks -> Array BreakTickIndex a) -> (InternalBreakLoc -> a) -> (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO a
+getBreakXXX view viewInternal 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}
+ Right BreakpointId{bi_tick_mod, bi_tick_index}
| bi_tick_mod == ibi_mod
-> do
let these_mbs = imodBreaks_modBreaks imbs
@@ -244,6 +268,8 @@ getBreakXXX view lookupModule (InternalBreakpointId ibi_mod ibi_ix) imbs =
-> do
other_mbs <- lookupModule bi_tick_mod
return $ view other_mbs ! bi_tick_index
+ Left l ->
+ return $ viewInternal l
--------------------------------------------------------------------------------
-- Instances
=====================================
compiler/GHC/Linker/Loader.hs
=====================================
@@ -58,6 +58,7 @@ import GHCi.RemoteTypes
import GHC.Iface.Load
import GHCi.Message (ConInfoTable(..), LoadedDLL)
+import GHC.ByteCode.Breakpoints
import GHC.ByteCode.Linker
import GHC.ByteCode.Asm
import GHC.ByteCode.Types
@@ -1711,8 +1712,10 @@ allocateCCS interp ce mbss
let count = 1 + (maybe 0 fst $ IM.lookupMax imodBreaks_breakInfo)
let ccs = IM.map
(\info ->
- fromMaybe (toRemotePtr nullPtr)
- (M.lookup (cgb_tick_id info) ccss)
+ case cgb_tick_id info of
+ Right bi -> fromMaybe (toRemotePtr nullPtr)
+ (M.lookup bi ccss)
+ Left InternalBreakLoc{} -> toRemotePtr nullPtr
)
imodBreaks_breakInfo
assertPpr (count == length ccs)
=====================================
compiler/GHC/Runtime/Debugger/Breakpoints.hs
=====================================
@@ -253,8 +253,11 @@ mkBreakpointOccurrences = 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])
+ case cgb_tick_id cgi of
+ Right (BreakpointId tick_mod tick_ix)
+ -> extendModuleEnvWith (IntMap.unionWith (S.<>)) bmp tick_mod (IntMap.singleton tick_ix [ibi])
+ Left _
+ -> bmp
) bmp0 (imodBreaks_breakInfo ibrks)
--------------------------------------------------------------------------------
@@ -287,7 +290,7 @@ getCurrentBreakModule = do
Nothing -> pure Nothing
Just ibi -> do
brks <- readIModBreaks hug ibi
- return $ Just $ bi_tick_mod $ getBreakSourceId ibi brks
+ return $ Just $ getBreakSourceMod ibi brks
ix ->
Just <$> getHistoryModule hug (resumeHistory r !! (ix-1))
=====================================
compiler/GHC/Runtime/Eval.hs
=====================================
@@ -151,7 +151,7 @@ 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
+ return $ getBreakSourceMod ibi brks
getHistorySpan :: HUG.HomeUnitGraph -> History -> IO SrcSpan
getHistorySpan hug hist = do
=====================================
compiler/GHC/StgToByteCode.hs
=====================================
@@ -63,7 +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.Runtime.Interpreter ( interpreterProfiled, readIModModBreaks )
import GHC.Data.Bitmap
import GHC.Data.FlatBag as FlatBag
import GHC.Data.OrdList
@@ -99,6 +99,7 @@ import GHC.CoreToIface
import Control.Monad.IO.Class
import Control.Monad.Trans.Reader (ReaderT(..))
import Control.Monad.Trans.State (StateT(..))
+import Data.Array ((!))
-- -----------------------------------------------------------------------------
-- Generating byte code for a complete module
@@ -393,26 +394,30 @@ 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 tick_id fvs) rhs) = do
- code <- schemeE d 0 p rhs
- 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 -> 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
+schemeER_wrk d p (StgTick bp@(Breakpoint tick_ty tick_id fvs) rhs) = do
+ platform <- profilePlatform <$> getProfile
+
+ code <- case rhs of
+ -- When we find a tick surrounding a case expression we introduce a new BRK_FUN
+ -- instruction at the start of the case *continuation*, in addition to the
+ -- usual BRK_FUN surrounding the StgCase)
+ -- See Note [TODO]
+ StgCase scrut bndr _ alts
+ -> doCase d 0 p (Just bp) scrut bndr alts
+ _ -> schemeE d 0 p rhs
+
+ 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 (Right tick_id)
+
+ mibi <- newBreakInfo breakInfo
+
+ return $ case mibi of
+ Nothing -> code
+ Just ibi -> BRK_FUN ibi `consOL` code
- let breakInstr = BRK_FUN (InternalBreakpointId info_mod infox)
- return $ breakInstr `consOL` code
schemeER_wrk d p rhs = schemeE d 0 p rhs
getVarOffSets :: Platform -> StackDepth -> BCEnv -> [Id] -> [Maybe (Id, WordOff)]
@@ -614,7 +619,7 @@ schemeE d s p (StgTick _ rhs) = schemeE d s p rhs
schemeE d s p (StgCase scrut _ _ []) = schemeE d s p scrut
schemeE d s p (StgCase scrut bndr _ alts)
- = doCase d s p scrut bndr alts
+ = doCase d s p Nothing scrut bndr alts
{-
@@ -1106,11 +1111,15 @@ doCase
:: StackDepth
-> Sequel
-> BCEnv
+ -> Maybe StgTickish
+ -- ^ The breakpoint surrounding the full case expression, if any (only
+ -- source-level cases get breakpoint ticks, and those are the only we care
+ -- about). See Note [TODO]
-> CgStgExpr
-> Id
-> [CgStgAlt]
-> BcM BCInstrList
-doCase d s p scrut bndr alts
+doCase d s p m_bid scrut bndr alts
= do
profile <- getProfile
hsc_env <- getHscEnv
@@ -1140,43 +1149,34 @@ doCase d s p scrut bndr alts
-- When an alt is entered, it assumes the returned value is
-- on top of the itbl; see Note [Return convention for non-tuple values]
-- for details.
- ret_frame_size_b :: StackDepth
- ret_frame_size_b | ubx_tuple_frame =
- (if profiling then 5 else 4) * wordSize platform
- | otherwise = 2 * wordSize platform
+ ret_frame_size_w :: WordOff
+ ret_frame_size_w | ubx_tuple_frame =
+ if profiling then 5 else 4
+ | otherwise = 2
-- The stack space used to save/restore the CCCS when profiling
save_ccs_size_b | profiling &&
not ubx_tuple_frame = 2 * wordSize platform
| otherwise = 0
- -- The size of the return frame info table pointer if one exists
- unlifted_itbl_size_b :: StackDepth
- unlifted_itbl_size_b | ubx_tuple_frame = wordSize platform
- | otherwise = 0
-
(bndr_size, call_info, args_offsets)
| ubx_tuple_frame =
let bndr_reps = typePrimRep (idType bndr)
(call_info, args_offsets) =
layoutNativeCall profile NativeTupleReturn 0 id bndr_reps
- in ( wordsToBytes platform (nativeCallSize call_info)
+ in ( nativeCallSize call_info
, call_info
, args_offsets
)
- | otherwise = ( wordsToBytes platform (idSizeW platform bndr)
+ | otherwise = ( idSizeW platform bndr
, voidTupleReturnInfo
, []
)
- -- depth of stack after the return value has been pushed
+ -- Depth of stack after the return value has been pushed
+ -- This is the stack depth at the continuation.
d_bndr =
- d + ret_frame_size_b + bndr_size
-
- -- depth of stack after the extra info table for an unlifted return
- -- has been pushed, if any. This is the stack depth at the
- -- continuation.
- d_alts = d + ret_frame_size_b + bndr_size + unlifted_itbl_size_b
+ d + wordsToBytes platform bndr_size
-- Env in which to compile the alts, not including
-- any vars bound by the alts themselves
@@ -1188,13 +1188,13 @@ doCase d s p scrut bndr alts
-- given an alt, return a discr and code for it.
codeAlt :: CgStgAlt -> BcM (Discr, BCInstrList)
codeAlt GenStgAlt{alt_con=DEFAULT,alt_bndrs=_,alt_rhs=rhs}
- = do rhs_code <- schemeE d_alts s p_alts rhs
+ = do rhs_code <- schemeE d_bndr s p_alts rhs
return (NoDiscr, rhs_code)
codeAlt alt@GenStgAlt{alt_con=_, alt_bndrs=bndrs, alt_rhs=rhs}
-- primitive or nullary constructor alt: no need to UNPACK
| null real_bndrs = do
- rhs_code <- schemeE d_alts s p_alts rhs
+ rhs_code <- schemeE d_bndr s p_alts rhs
return (my_discr alt, rhs_code)
| isUnboxedTupleType bndr_ty || isUnboxedSumType bndr_ty =
let bndr_ty = idPrimRepU . fromNonVoid
@@ -1206,7 +1206,7 @@ doCase d s p scrut bndr alts
bndr_ty
(assertNonVoidIds bndrs)
- stack_bot = d_alts
+ stack_bot = d_bndr
p' = Map.insertList
[ (arg, tuple_start -
@@ -1224,7 +1224,7 @@ doCase d s p scrut bndr alts
(addIdReps (assertNonVoidIds real_bndrs))
size = WordOff tot_wds
- stack_bot = d_alts + wordsToBytes platform size
+ stack_bot = d_bndr + wordsToBytes platform size
-- convert offsets from Sp into offsets into the virtual stack
p' = Map.insertList
@@ -1324,22 +1324,53 @@ doCase d s p scrut bndr alts
alt_stuff <- mapM codeAlt alts
alt_final0 <- mkMultiBranch maybe_ncons alt_stuff
- let alt_final1
- | ubx_tuple_frame = SLIDE 0 2 `consOL` alt_final0
- | otherwise = alt_final0
- alt_final
- | gopt Opt_InsertBreakpoints (hsc_dflags hsc_env)
- -- See Note [Debugger: BRK_ALTS]
- = BRK_ALTS False `consOL` alt_final1
- | otherwise = alt_final1
+ let
+
+ -- drop the stg_ctoi_*_info header...
+ alt_final1 = SLIDE bndr_size ret_frame_size_w `consOL` alt_final0
+
+ -- after dropping the stg_ret_*_info header
+ alt_final2
+ | ubx_tuple_frame = SLIDE 0 3 `consOL` alt_final1
+ | otherwise = SLIDE 0 1 `consOL` alt_final1
+
+ -- When entering a case continuation BCO, the stack is always headed
+ -- by the stg_ret frame and the stg_ctoi frame that returned to it.
+ -- See Note [Stack layout when entering run_BCO]
+ --
+ -- Right after the breakpoint instruction, a case continuation BCO
+ -- drops the stg_ret and stg_ctoi frame headers (see alt_final1,
+ -- alt_final2), leaving the stack with the scrutinee followed by the
+ -- free variables (with depth==d_bndr)
+ alt_final <- case m_bid of
+ Just (Breakpoint tick_ty tick_id fvs)
+ | gopt Opt_InsertBreakpoints (hsc_dflags hsc_env)
+ -- Construct an internal breakpoint to put at the start of this case
+ -- continuation BCO.
+ -- See Note [TODO]
+ -> do
+ internal_tick_loc <- makeCaseInternalBreakLoc tick_id
+
+ -- same fvs available in the case expression are available in the case continuation
+ 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 (Left internal_tick_loc)
+
+ mibi <- newBreakInfo breakInfo
+ return $ case mibi of
+ Nothing -> alt_final2
+ Just ibi -> BRK_FUN ibi `consOL` alt_final2
+ _ -> pure alt_final2
add_bco_name <- shouldAddBcoName
let
alt_bco_name = getName bndr
alt_bco = mkProtoBCO platform add_bco_name alt_bco_name alt_final (Left alts)
0{-no arity-} bitmap_size bitmap True{-is alts-}
- scrut_code <- schemeE (d + ret_frame_size_b + save_ccs_size_b)
- (d + ret_frame_size_b + save_ccs_size_b)
+ scrut_code <- schemeE (d + wordsToBytes platform ret_frame_size_w + save_ccs_size_b)
+ (d + wordsToBytes platform ret_frame_size_w + save_ccs_size_b)
p scrut
if ubx_tuple_frame
then do let tuple_bco = tupleBCO platform call_info args_offsets
@@ -1351,6 +1382,24 @@ doCase d s p scrut bndr alts
_ -> panic "schemeE(StgCase).push_alts"
in return (PUSH_ALTS alt_bco scrut_rep `consOL` scrut_code)
+makeCaseInternalBreakLoc :: BreakpointId -> BcM InternalBreakLoc
+makeCaseInternalBreakLoc bid = do
+ hug <- hsc_HUG <$> getHscEnv
+ curr_mod <- getCurrentModule
+ mb_mod_brks <- getCurrentModBreaks
+
+ -- TODO: Subtract the scrutinee loc from the case loc to get continuation loc
+ InternalBreakLoc <$> case bid of
+ BreakpointId{bi_tick_mod, bi_tick_index}
+ | bi_tick_mod == curr_mod
+ , Just these_mbs <- mb_mod_brks
+ -> do
+ return $ modBreaks_locs these_mbs ! bi_tick_index
+ | otherwise
+ -> do
+ other_mbs <- liftIO $ readIModModBreaks hug bi_tick_mod
+ return $ modBreaks_locs other_mbs ! bi_tick_index
+
{-
Note [Debugger: BRK_ALTS]
~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -2667,14 +2716,19 @@ getLabelsBc n = BcM $ \_ st ->
let ctr = nextlabel st
in return (coerce [ctr .. ctr+n-1], st{nextlabel = ctr+n})
-newBreakInfo :: CgBreakInfo -> BcM Int
-newBreakInfo info = BcM $ \_ st ->
- let ix = breakInfoIdx st
- st' = st
- { breakInfo = IntMap.insert ix info (breakInfo st)
- , breakInfoIdx = ix + 1
- }
- in return (ix, st')
+newBreakInfo :: CgBreakInfo -> BcM (Maybe InternalBreakpointId)
+newBreakInfo info = BcM $ \env st -> do
+ -- if we're not generating ModBreaks for this module for some reason, we
+ -- can't store breakpoint occurrence information.
+ case modBreaks env of
+ Nothing -> pure (Nothing, st)
+ Just modBreaks -> do
+ let ix = breakInfoIdx st
+ st' = st
+ { breakInfo = IntMap.insert ix info (breakInfo st)
+ , breakInfoIdx = ix + 1
+ }
+ return (Just $ InternalBreakpointId (modBreaks_module modBreaks) ix, st')
getCurrentModule :: BcM Module
getCurrentModule = BcM $ \env st -> return (bcm_module env, st)
@@ -2687,7 +2741,7 @@ tickFS = fsLit "ticked"
-- Dehydrating CgBreakInfo
-dehydrateCgBreakInfo :: [TyVar] -> [Maybe (Id, Word)] -> Type -> BreakpointId -> CgBreakInfo
+dehydrateCgBreakInfo :: [TyVar] -> [Maybe (Id, Word)] -> Type -> Either InternalBreakLoc BreakpointId -> CgBreakInfo
dehydrateCgBreakInfo ty_vars idOffSets tick_ty bid =
CgBreakInfo
{ cgb_tyvars = map toIfaceTvBndr ty_vars
=====================================
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, InternalBreakpointId(..), getBreakSourceId)
+import GHC.ByteCode.Breakpoints (imodBreaks_modBreaks, InternalBreakpointId(..), getBreakSourceId, getBreakSourceMod)
import GHC.Runtime.Interpreter
import GHCi.RemoteTypes
import GHCi.BreakArray( breakOn, breakOff )
@@ -1621,7 +1621,7 @@ toBreakIdAndLocation (Just inf) = do
brks <- liftIO $ readIModBreaks hug inf
let bi = getBreakSourceId inf brks
return $ listToMaybe [ id_loc | id_loc@(_,loc) <- IntMap.assocs (breaks st),
- breakId loc == bi ]
+ Right (breakId loc) == bi ]
printStoppedAtBreakInfo :: GHC.GhcMonad m => Resume -> [Name] -> m ()
printStoppedAtBreakInfo res names = do
@@ -3825,7 +3825,7 @@ pprStopped res = do
hug <- hsc_HUG <$> GHC.getSession
brks <- liftIO $ readIModBreaks hug ibi
return $ Just $ moduleName $
- bi_tick_mod $ getBreakSourceId ibi brks
+ getBreakSourceMod ibi brks
return $
text "Stopped in"
<+> ((case mb_mod_name of
=====================================
libraries/ghci/GHCi/Run.hs
=====================================
@@ -362,6 +362,14 @@ withBreakAction opts breakMVar statusMVar mtid act
info_mod_uid <- BS.packCString (Ptr info_mod_uid#)
pure (Just (EvalBreakpoint info_mod info_mod_uid (I# infox#)))
putMVar statusMVar $ EvalBreak apStack_r breakpoint resume_r ccs
+
+ -- Block until this thread is resumed (by the thread which took the
+ -- `ResumeContext` from the `statusMVar`).
+ --
+ -- The `onBreak` function must have been called from `rts/Interpreter.c`
+ -- when interpreting a `BRK_FUN`. After taking from the MVar, the function
+ -- returns to the continuation on the stack which is where the interpreter
+ -- was stopped.
takeMVar breakMVar
resetBreakAction stablePtr = do
=====================================
rts/Interpreter.c
=====================================
@@ -284,6 +284,18 @@ allocate_NONUPD (Capability *cap, int n_words)
return allocate(cap, stg_max(sizeofW(StgHeader)+MIN_PAYLOAD_SIZE, n_words));
}
+STATIC_INLINE int
+is_ctoi_nontuple_frame(const StgPtr frame_head) {
+ return (
+ (W_)frame_head == (W_)&stg_ctoi_R1p_info ||
+ (W_)frame_head == (W_)&stg_ctoi_R1n_info ||
+ (W_)frame_head == (W_)&stg_ctoi_F1_info ||
+ (W_)frame_head == (W_)&stg_ctoi_D1_info ||
+ (W_)frame_head == (W_)&stg_ctoi_L1_info ||
+ (W_)frame_head == (W_)&stg_ctoi_V_info
+ );
+}
+
int rts_stop_on_exception = 0;
/* ---------------------------------------------------------------------------
@@ -844,7 +856,6 @@ eval_obj:
debugBelch("\n\n");
);
-// IF_DEBUG(sanity,checkStackChunk(Sp, cap->r.rCurrentTSO->stack+cap->r.rCurrentTSO->stack_size));
IF_DEBUG(sanity,checkStackFrame(Sp));
switch ( get_itbl(obj)->type ) {
@@ -1086,11 +1097,33 @@ do_return_pointer:
// Returning to an interpreted continuation: put the object on
// the stack, and start executing the BCO.
INTERP_TICK(it_retto_BCO);
- Sp_subW(1);
- SpW(0) = (W_)tagged_obj;
- obj = (StgClosure*)ReadSpW(2);
+ obj = (StgClosure*)ReadSpW(1);
ASSERT(get_itbl(obj)->type == BCO);
- goto run_BCO_return_pointer;
+
+ // Heap check
+ if (doYouWantToGC(cap)) {
+ Sp_subW(2);
+ SpW(1) = (W_)tagged_obj;
+ SpW(0) = (W_)&stg_ret_p_info;
+ RETURN_TO_SCHEDULER(ThreadInterpret, HeapOverflow);
+ }
+ else {
+
+ // Stack checks aren't necessary at return points, the stack use
+ // is aggregated into the enclosing function entry point.
+
+ // Make sure stack is headed by a ctoi R1p frame when returning a pointer
+ ASSERT(ReadSpW(0) == (W_)&stg_ctoi_R1p_info);
+
+ // Add the return frame on top of the args
+ Sp_subW(2);
+ SpW(1) = (W_)tagged_obj;
+ SpW(0) = (W_)&stg_ret_p_info;
+ }
+
+ /* Keep the ret frame and the ctoi frame for run_BCO.
+ * See Note [Stack layout when entering run_BCO] */
+ goto run_BCO;
default:
do_return_unrecognised:
@@ -1159,8 +1192,9 @@ do_return_nonpointer:
// get the offset of the header of the next stack frame
offset = stack_frame_sizeW((StgClosure *)Sp);
+ StgClosure* next_frame = (StgClosure*)(SafeSpWP(offset));
- switch (get_itbl((StgClosure*)(SafeSpWP(offset)))->type) {
+ switch (get_itbl(next_frame)->type) {
case RET_BCO:
// Returning to an interpreted continuation: pop the return frame
@@ -1168,8 +1202,58 @@ do_return_nonpointer:
// executing the BCO.
INTERP_TICK(it_retto_BCO);
obj = (StgClosure*)ReadSpW(offset+1);
+
ASSERT(get_itbl(obj)->type == BCO);
- goto run_BCO_return_nonpointer;
+
+ // Heap check
+ if (doYouWantToGC(cap)) {
+ RETURN_TO_SCHEDULER(ThreadInterpret, HeapOverflow);
+ }
+ else {
+ // Stack checks aren't necessary at return points, the stack use
+ // is aggregated into the enclosing function entry point.
+
+#if defined(PROFILING)
+ /*
+ Restore the current cost centre stack if a tuple is being returned.
+
+ When a "simple" unlifted value is returned, the cccs is restored with
+ an stg_restore_cccs frame on the stack, for example:
+
+ ...
+ stg_ctoi_D1
+ <CCCS>
+ stg_restore_cccs
+
+ But stg_restore_cccs cannot deal with tuples, which may have more
+ things on the stack. Therefore we store the CCCS inside the
+ stg_ctoi_t frame.
+
+ If we have a tuple being returned, the stack looks like this:
+
+ ...
+ <CCCS> <- to restore, Sp offset <next frame + 4 words>
+ tuple_BCO
+ tuple_info
+ cont_BCO
+ stg_ctoi_t <- next frame
+ tuple_data_1
+ ...
+ tuple_data_n
+ tuple_info
+ tuple_BCO
+ stg_ret_t <- Sp
+ */
+
+ if(SpW(0) == (W_)&stg_ret_t_info) {
+ cap->r.rCCCS = (CostCentreStack*)ReadSpW(offset + 4);
+ }
+#endif
+
+ /* Keep the ret frame and the ctoi frame for run_BCO.
+ * See Note [Stack layout when entering run_BCO] */
+ goto run_BCO;
+ }
default:
{
@@ -1332,111 +1416,90 @@ do_apply:
RETURN_TO_SCHEDULER_NO_PAUSE(ThreadRunGHC, ThreadYielding);
}
- // ------------------------------------------------------------------------
- // Ok, we now have a bco (obj), and its arguments are all on the
- // stack. We can start executing the byte codes.
- //
- // The stack is in one of two states. First, if this BCO is a
- // function:
- //
- // | .... |
- // +---------------+
- // | arg2 |
- // +---------------+
- // | arg1 |
- // +---------------+
- //
- // Second, if this BCO is a continuation:
- //
- // | .... |
- // +---------------+
- // | fv2 |
- // +---------------+
- // | fv1 |
- // +---------------+
- // | BCO |
- // +---------------+
- // | stg_ctoi_ret_ |
- // +---------------+
- // | retval |
- // +---------------+
- //
- // where retval is the value being returned to this continuation.
- // In the event of a stack check, heap check, or context switch,
- // we need to leave the stack in a sane state so the garbage
- // collector can find all the pointers.
- //
- // (1) BCO is a function: the BCO's bitmap describes the
- // pointerhood of the arguments.
- //
- // (2) BCO is a continuation: BCO's bitmap describes the
- // pointerhood of the free variables.
- //
- // Sadly we have three different kinds of stack/heap/cswitch check
- // to do:
-
-
-run_BCO_return_pointer:
- // Heap check
- if (doYouWantToGC(cap)) {
- Sp_subW(1); SpW(0) = (W_)&stg_ret_p_info;
- RETURN_TO_SCHEDULER(ThreadInterpret, HeapOverflow);
- }
- // Stack checks aren't necessary at return points, the stack use
- // is aggregated into the enclosing function entry point.
-
- goto run_BCO;
-
-run_BCO_return_nonpointer:
- // Heap check
- if (doYouWantToGC(cap)) {
- RETURN_TO_SCHEDULER(ThreadInterpret, HeapOverflow);
- }
- // Stack checks aren't necessary at return points, the stack use
- // is aggregated into the enclosing function entry point.
-
-#if defined(PROFILING)
- /*
- Restore the current cost centre stack if a tuple is being returned.
-
- When a "simple" unlifted value is returned, the cccs is restored with
- an stg_restore_cccs frame on the stack, for example:
-
- ...
- stg_ctoi_D1
- <CCCS>
- stg_restore_cccs
-
- But stg_restore_cccs cannot deal with tuples, which may have more
- things on the stack. Therefore we store the CCCS inside the
- stg_ctoi_t frame.
-
- If we have a tuple being returned, the stack looks like this:
-
- ...
- <CCCS> <- to restore, Sp offset <next frame + 4 words>
- tuple_BCO
- tuple_info
- cont_BCO
- stg_ctoi_t <- next frame
- tuple_data_1
- ...
- tuple_data_n
- tuple_info
- tuple_BCO
- stg_ret_t <- Sp
- */
-
- if(SpW(0) == (W_)&stg_ret_t_info) {
- cap->r.rCCCS = (CostCentreStack*)ReadSpW(stack_frame_sizeW((StgClosure *)Sp) + 4);
- }
-#endif
-
- if (SpW(0) != (W_)&stg_ret_t_info) {
- Sp_addW(1);
- }
- goto run_BCO;
+/*
+Note [Stack layout when entering run_BCO]
+------------------------------------------------------------------------
+We have a bco (obj), and its arguments are all on the stack. We can start
+executing the byte codes.
+
+The stack is in one of two states. First, if this BCO is a
+function (in run_BCO_fun or run_BCO)
+
+ | .... |
+ +---------------+
+ | arg2 |
+ +---------------+
+ | arg1 |
+ +---------------+
+
+Second, if this BCO is a case cont., as per Note [Case continuation BCOs] (only
+in run_BCO):
+
+ | .... |
+ +---------------+
+ | fv2 |
+ +---------------+
+ | fv1 |
+ +---------------+
+ | BCO |
+ +---------------+
+ | stg_ctoi_ret_ |
+ +---------------+
+ | retval |
+ +---------------+
+ | stg_ret_..... |
+ +---------------+
+
+where retval is the value being returned to this continuation.
+In the event of a stack check, heap check, context switch,
+or breakpoint, we need to leave the stack in a sane state so
+the garbage collector can find all the pointers.
+
+ (1) BCO is a function: the BCO's bitmap describes the
+ pointerhood of the arguments.
+
+ (2) BCO is a continuation: BCO's bitmap describes the
+ pointerhood of the free variables.
+
+To reconstruct a valid stack state for yielding (such that when we return to
+the interpreter we end up in the same place from where we yielded), we need to
+differentiate the two cases again:
+
+ (1) For function BCOs, the arguments are directly on top of the stack, so it
+ suffices to add a `stg_apply_interp_info` frame header using the BCO that is
+ being applied to these arguments (i.e. the `obj` being run)
+
+ (2) For continuation BCOs, the stack is already consistent -- that's why we
+ keep the ret and ctoi frame on top of the stack when we start executing it.
+
+ We couldn't reconstruct a valid stack that resumes the case continuation
+ execution just from the return and free vars values alone because we wouldn't
+ know what kind of result it was (are we returning a pointer, non pointer int,
+ a tuple? etc.); especially considering some frames have different sizes,
+ notably unboxed tuple return frames (see Note [unboxed tuple bytecodes and tuple_BCO]).
+
+ For consistency, the first instructions in a case continuation BCO, right
+ after a possible BRK_FUN heading it, are two SLIDEs to remove the stg_ret_
+ and stg_ctoi_ frame headers, leaving only the return value followed by the
+ free vars. Theses slides use statically known offsets computed in StgToByteCode.hs.
+ Following the continuation BCO diagram above, SLIDING would result in:
+
+ | .... |
+ +---------------+
+ | fv2 |
+ +---------------+
+ | fv1 |
+ +---------------+
+ | retval |
+ +---------------+
+*/
+// Ok, we now have a bco (obj), and its arguments are all on the stack as
+// described by Note [Stack layout when entering run_BCO].
+// We can start executing the byte codes.
+//
+// Sadly we have three different kinds of stack/heap/cswitch check
+// to do:
run_BCO_fun:
IF_DEBUG(sanity,
Sp_subW(2);
@@ -1466,6 +1529,7 @@ run_BCO_fun:
// Now, actually interpret the BCO... (no returning to the
// scheduler again until the stack is in an orderly state).
+ // See also Note [Stack layout when entering run_BCO]
run_BCO:
INTERP_TICK(it_BCO_entries);
{
@@ -1519,7 +1583,7 @@ run_BCO:
switch (bci & 0xFF) {
- /* check for a breakpoint on the beginning of a let binding */
+ /* check for a breakpoint on the beginning of a BCO */
case bci_BRK_FUN:
{
W_ arg1_brk_array, arg2_info_mod_name, arg3_info_mod_id, arg4_info_index;
@@ -1572,6 +1636,20 @@ run_BCO:
{
breakPoints = (StgArrBytes *) BCO_PTR(arg1_brk_array);
+ W_ stack_head = ReadSpW(0);
+
+ // When the BRK_FUN is at the start of a case continuation BCO,
+ // the stack contains the frame returning the value at the start.
+ // See Note [Stack layout when entering run_BCO]
+ int is_case_cont_BCO =
+ stack_head == (W_)&stg_ret_t_info
+ || stack_head == (W_)&stg_ret_v_info
+ || stack_head == (W_)&stg_ret_p_info
+ || stack_head == (W_)&stg_ret_n_info
+ || stack_head == (W_)&stg_ret_f_info
+ || stack_head == (W_)&stg_ret_d_info
+ || stack_head == (W_)&stg_ret_l_info;
+
// 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)[arg4_info_index];
@@ -1580,36 +1658,96 @@ run_BCO:
// decrement and write back ignore count
((StgInt*)breakPoints->payload)[arg4_info_index] = --ignore_count;
}
- else if (stop_next_breakpoint == true || ignore_count == 0)
+ else if (
+ /* Doing step-in (but don't stop at case continuation BCOs,
+ * those are only useful when stepping out) */
+ (stop_next_breakpoint == true && !is_case_cont_BCO)
+ /* Or breakpoint is explicitly enabled */
+ || ignore_count == 0)
{
// make sure we don't automatically stop at the
// next breakpoint
rts_stop_next_breakpoint = 0;
cap->r.rCurrentTSO->flags &= ~TSO_STOP_NEXT_BREAKPOINT;
- // allocate memory for a new AP_STACK, enough to
- // store the top stack frame plus an
- // stg_apply_interp_info pointer and a pointer to
- // the BCO
- size_words = BCO_BITMAP_SIZE(obj) + 2;
- new_aps = (StgAP_STACK *) allocate(cap, AP_STACK_sizeW(size_words));
- new_aps->size = size_words;
- new_aps->fun = &stg_dummy_ret_closure;
-
- // fill in the payload of the AP_STACK
- new_aps->payload[0] = (StgClosure *)&stg_apply_interp_info;
- new_aps->payload[1] = (StgClosure *)obj;
-
- // copy the contents of the top stack frame into the AP_STACK
- for (i = 2; i < size_words; i++)
- {
- new_aps->payload[i] = (StgClosure *)ReadSpW(i-2);
+ /* To yield execution we need to come up with a consistent AP_STACK
+ * to store in the :history data structure.
+ */
+ if (is_case_cont_BCO) {
+
+ // If the BCO is a case cont. then the stack is headed by the
+ // stg_ret and a stg_ctoi frames which caused this same BCO
+ // to be run. This stack is already well-formed, so it
+ // needs only to be copied to the AP_STACK.
+ // See Note [Stack layout when entering run_BCO]
+
+ // stg_ret_*
+ int size_returned_frame =
+ (stack_head == (W_)&stg_ret_t_info)
+ ? 2 /* ret_t + tuple_BCO */
+ + /* Sp(2) is call_info which records the offset to the next frame
+ * See also Note [unboxed tuple bytecodes and tuple_BCO] */
+ ((ReadSpW(2) & 0xFF))
+ : 2; /* ret_* + return value */
+
+ StgPtr cont_frame_head
+ = (StgPtr)(SpW(size_returned_frame));
+ ASSERT(obj == UNTAG_CLOSURE((StgClosure*)ReadSpW(size_returned_frame+1)));
+
+ // stg_ctoi_*
+ int size_cont_frame_head =
+ is_ctoi_nontuple_frame(cont_frame_head)
+ ? 2 // info+bco
+#if defined(PROFILING)
+ : 5; // or info+bco+tuple_info+tuple_BCO+CCS
+#else
+ : 4; // or info+bco+tuple_info+tuple_BCO
+#endif
+
+ // Continuation stack is already well formed,
+ // so just copy it whole to the AP_STACK
+ size_words = size_returned_frame
+ + size_cont_frame_head
+ + BCO_BITMAP_SIZE(obj) /* payload of cont_frame */;
+ new_aps = (StgAP_STACK *) allocate(cap, AP_STACK_sizeW(size_words));
+ new_aps->size = size_words;
+ new_aps->fun = &stg_dummy_ret_closure;
+
+ // (1) Fill in the payload of the AP_STACK:
+ for (i = 0; i < size_words; i++) {
+ new_aps->payload[i] = (StgClosure *)ReadSpW(i);
+ }
+ }
+ else {
+
+ // The BCO is a function, therefore the arguments are
+ // directly on top of the stack.
+ // To construct a valid stack chunk simply add an
+ // stg_apply_interp and the current BCO to the stack.
+ // See also Note [Stack layout when entering run_BCO]
+
+ // (1) Allocate memory for a new AP_STACK, enough to store
+ // the top stack frame plus an stg_apply_interp_info pointer
+ // and a pointer to the BCO
+ size_words = BCO_BITMAP_SIZE(obj) + 2;
+ new_aps = (StgAP_STACK *) allocate(cap, AP_STACK_sizeW(size_words));
+ new_aps->size = size_words;
+ new_aps->fun = &stg_dummy_ret_closure;
+
+ // (1.1) the continuation frame
+ new_aps->payload[0] = (StgClosure *)&stg_apply_interp_info;
+ new_aps->payload[1] = (StgClosure *)obj;
+
+ // (1.2.1) copy the args/free vars of the top stack frame into the AP_STACK
+ for (i = 2; i < size_words; i++) {
+ new_aps->payload[i] = (StgClosure *)ReadSpW(i-2);
+ }
}
// No write barrier is needed here as this is a new allocation
SET_HDR(new_aps,&stg_AP_STACK_info,cap->r.rCCCS);
- // Arrange the stack to call the breakpoint IO action, and
+ // (2) Arrange the stack to call the breakpoint IO action, and
// continue execution of this BCO when the IO action returns.
//
// ioAction :: Addr# -- the breakpoint info module
@@ -1622,12 +1760,27 @@ run_BCO:
ioAction = (StgClosure *) deRefStablePtr (
rts_breakpoint_io_action);
- Sp_subW(13);
- SpW(12) = (W_)obj;
- SpW(11) = (W_)&stg_apply_interp_info;
+ // (2.1) Construct the continuation to which we'll return in
+ // this thread after the `rts_breakpoint_io_action` returns.
+ //
+ // For case cont. BCOs, the continuation to re-run this BCO
+ // is already first on the stack. For function BCOs we need
+ // to add an `stg_apply_interp` apply to the current BCO.
+ // See Note [Stack layout when entering run_BCO]
+ if (!is_case_cont_BCO) {
+ Sp_subW(2); // stg_apply_interp_info + StgBCO*
+
+ // (2.1.2) Write the continuation frame (above the stg_ret
+ // frame if one exists)
+ SpW(1) = (W_)obj;
+ SpW(0) = (W_)&stg_apply_interp_info;
+ }
+
+ // (2.2) The `rts_breakpoint_io_action` call
+ Sp_subW(11);
SpW(10) = (W_)new_aps;
- SpW(9) = (W_)False_closure; // True <=> an exception
- SpW(8) = (W_)&stg_ap_ppv_info;
+ 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(arg3_info_mod_id);
=====================================
testsuite/tests/ghci.debugger/scripts/T26042d2.hs
=====================================
@@ -0,0 +1,13 @@
+
+module Main where
+
+main = do
+ putStrLn "hello1"
+ f
+ putStrLn "hello3"
+ putStrLn "hello4"
+
+f = do
+ putStrLn "hello2.1"
+ putStrLn "hello2.2"
+{-# NOINLINE f #-}
=====================================
testsuite/tests/ghci.debugger/scripts/T26042d2.script
=====================================
@@ -0,0 +1,12 @@
+:load T26042d2.hs
+
+:break 11
+main
+:list
+:stepout
+:list
+:stepout
+
+-- should exit! we compile this test case with -O1 to make sure the monad >> are inlined
+-- and thus the test relies on the filtering behavior based on SrcSpans for stepout
+
=====================================
testsuite/tests/ghci.debugger/scripts/T26042d2.stdout
=====================================
@@ -0,0 +1,16 @@
+Breakpoint 0 activated at T26042d2.hs:11:3-21
+hello1
+Stopped in Main.f, T26042d2.hs:11:3-21
+_result ::
+ GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld
+ -> (# GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld,
+ () #) = _
+10 f = do
+11 putStrLn "hello2.1"
+ ^^^^^^^^^^^^^^^^^^^
+12 putStrLn "hello2.2"
+hello2.1
+hello2.2
+<--- should break here too
+hello3
+hello4
=====================================
testsuite/tests/ghci.debugger/scripts/T26042g.stdout
=====================================
@@ -6,10 +6,13 @@ x :: Int = 14
11 succ x = (-) (x - 2) (x + 1)
^^^^^^^^^^^^^^^^^^^
12
-Stopped in T9.top, T26042g.hs:8:10-21
+Stopped in T9., T26042g.hs:(6,3)-(8,21)
_result :: Int = _
+5 top = do
+ vv
+6 case succ 14 of
7 5 -> 5
8 _ -> 6 + other 55
- ^^^^^^^^^^^^
+ ^^
9
171
=====================================
testsuite/tests/ghci.debugger/scripts/all.T
=====================================
@@ -147,8 +147,9 @@ test('T25932', extra_files(['T25932.hs']), ghci_script, ['T25932.script'])
# Step out tests
test('T26042b', [extra_hc_opts('-O -fno-unoptimized-core-for-interpreter'), extra_files(['T26042b.hs'])], ghci_script, ['T26042b.script'])
-test('T26042c', [expect_broken(26042),extra_hc_opts('-O -fno-unoptimized-core-for-interpreter'), extra_files(['T26042c.hs'])], ghci_script, ['T26042c.script'])
+test('T26042c', [extra_hc_opts('-O -fno-unoptimized-core-for-interpreter'), extra_files(['T26042c.hs'])], ghci_script, ['T26042c.script'])
test('T26042d', [extra_hc_opts('-O -fno-unoptimized-core-for-interpreter'), extra_files(['T26042d.hs'])], ghci_script, ['T26042d.script'])
+test('T26042d2', [extra_hc_opts('-O -fno-unoptimized-core-for-interpreter'), extra_files(['T26042d2.hs'])], ghci_script, ['T26042d2.script'])
test('T26042e', extra_files(['T26042e.hs']), ghci_script, ['T26042e.script'])
test('T26042f1', extra_files(['T26042f.hs', 'T26042f.script']), ghci_script, ['T26042f.script']) # >> is not inlined, so stepout has nowhere to stop
test('T26042f2', [extra_hc_opts('-O -fno-unoptimized-core-for-interpreter'), extra_files(['T26042f.hs', 'T26042f.script'])], ghci_script, ['T26042f.script'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b4387c89b6042a9ce2f52483c6a984…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b4387c89b6042a9ce2f52483c6a984…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/sol/remove-ddump-json] 2 commits: Rename MCDiagnostic to UnsafeMCDiagnostic
by Simon Hengel (＠sol) 28 Jul '25
by Simon Hengel (＠sol) 28 Jul '25
28 Jul '25
Simon Hengel pushed to branch wip/sol/remove-ddump-json at Glasgow Haskell Compiler / GHC
Commits:
08b2d89a by Simon Hengel at 2025-07-28T14:58:41+07:00
Rename MCDiagnostic to UnsafeMCDiagnostic
- - - - -
acb24033 by Simon Hengel at 2025-07-28T14:59:11+07:00
Remove -ddump-json (fixes #24113)
- - - - -
22 changed files:
- compiler/GHC/Core/Lint.hs
- compiler/GHC/Driver/Errors.hs
- compiler/GHC/Driver/Flags.hs
- compiler/GHC/Driver/Main.hs
- compiler/GHC/Driver/Pipeline.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/HsToCore/Monad.hs
- compiler/GHC/Stg/Lint.hs
- compiler/GHC/Tc/Errors.hs
- compiler/GHC/Tc/Utils/Monad.hs
- compiler/GHC/Types/Error.hs
- compiler/GHC/Types/SourceError.hs
- compiler/GHC/Utils/Error.hs
- compiler/GHC/Utils/Logger.hs
- docs/users_guide/debugging.rst
- ghc/GHCi/UI.hs
- testsuite/tests/driver/T16167.stderr
- − testsuite/tests/driver/T16167.stdout
- testsuite/tests/driver/all.T
- testsuite/tests/driver/json2.stderr
- − testsuite/tests/driver/json_dump.hs
- − testsuite/tests/driver/json_dump.stderr
Changes:
=====================================
compiler/GHC/Core/Lint.hs
=====================================
@@ -3418,7 +3418,7 @@ addMsg show_context env msgs msg
[] -> noSrcSpan
(s:_) -> s
!diag_opts = le_diagOpts env
- mk_msg msg = mkLocMessage (mkMCDiagnostic diag_opts WarningWithoutFlag Nothing) msg_span
+ mk_msg msg = mkLocMessage (unsafeMCDiagnostic diag_opts WarningWithoutFlag Nothing) msg_span
(msg $$ context)
addLoc :: LintLocInfo -> LintM a -> LintM a
=====================================
compiler/GHC/Driver/Errors.hs
=====================================
@@ -67,7 +67,7 @@ printMessage logger msg_opts opts message
doc = updSDocContext (\_ -> ctx) (messageWithHints diagnostic)
messageClass :: MessageClass
- messageClass = MCDiagnostic severity (errMsgReason message) (diagnosticCode diagnostic)
+ messageClass = UnsafeMCDiagnostic severity (errMsgReason message) (diagnosticCode diagnostic)
style :: PprStyle
style = mkErrStyle (errMsgContext message)
=====================================
compiler/GHC/Driver/Flags.hs
=====================================
@@ -526,7 +526,6 @@ data DumpFlag
| Opt_D_dump_view_pattern_commoning
| Opt_D_verbose_core2core
| Opt_D_dump_debug
- | Opt_D_dump_json
| Opt_D_ppr_debug
| Opt_D_no_debug_output
| Opt_D_dump_faststrings
=====================================
compiler/GHC/Driver/Main.hs
=====================================
@@ -1829,7 +1829,7 @@ markUnsafeInfer tcg_env whyUnsafe = do
, nest 4 $ (vcat $ badFlags df) $+$
-- MP: Using defaultDiagnosticOpts here is not right but it's also not right to handle these
-- unsafety error messages in an unstructured manner.
- (vcat $ pprMsgEnvelopeBagWithLoc (defaultDiagnosticOpts @e) (getMessages whyUnsafe)) $+$
+ (vcat $ unsafePprMsgEnvelopeBagWithLoc (defaultDiagnosticOpts @e) (getMessages whyUnsafe)) $+$
(vcat $ badInsts $ tcg_insts tcg_env)
]
badFlags df = concatMap (badFlag df) unsafeFlagsForInfer
=====================================
compiler/GHC/Driver/Pipeline.hs
=====================================
@@ -163,7 +163,7 @@ preprocess hsc_env input_fn mb_input_buf mb_phase =
to_driver_messages msgs = case traverse to_driver_message msgs of
Nothing -> pprPanic "non-driver message in preprocess"
-- MP: Default config is fine here as it's just in a panic.
- (vcat $ pprMsgEnvelopeBagWithLoc (defaultDiagnosticOpts @GhcMessage) (getMessages msgs))
+ (vcat $ unsafePprMsgEnvelopeBagWithLoc (defaultDiagnosticOpts @GhcMessage) (getMessages msgs))
Just msgs' -> msgs'
to_driver_message = \case
=====================================
compiler/GHC/Driver/Session.hs
=====================================
@@ -1657,9 +1657,6 @@ dynamic_flags_deps = [
(NoArg (setGeneralFlag Opt_NoTypeableBinds))
, make_ord_flag defGhcFlag "ddump-debug"
(setDumpFlag Opt_D_dump_debug)
- , make_dep_flag defGhcFlag "ddump-json"
- (setDumpFlag Opt_D_dump_json)
- "Use `-fdiagnostics-as-json` instead"
, make_ord_flag defGhcFlag "dppr-debug"
(setDumpFlag Opt_D_ppr_debug)
, make_ord_flag defGhcFlag "ddebug-output"
=====================================
compiler/GHC/HsToCore/Monad.hs
=====================================
@@ -376,7 +376,7 @@ initTcDsForSolver thing_inside
thing_inside
; case mb_ret of
Just ret -> pure ret
- Nothing -> pprPanic "initTcDsForSolver" (vcat $ pprMsgEnvelopeBagWithLocDefault (getErrorMessages msgs)) }
+ Nothing -> pprPanic "initTcDsForSolver" (vcat $ unsafePprMsgEnvelopeBagWithLocDefault (getErrorMessages msgs)) }
mkDsEnvs :: UnitEnv -> Module -> GlobalRdrEnv -> TypeEnv -> FamInstEnv
-> PromotionTickContext
=====================================
compiler/GHC/Stg/Lint.hs
=====================================
@@ -540,7 +540,7 @@ addErr diag_opts errs_so_far msg locs
= errs_so_far `snocBag` mk_msg locs
where
mk_msg (loc:_) = let (l,hdr) = dumpLoc loc
- in mkLocMessage (Err.mkMCDiagnostic diag_opts WarningWithoutFlag Nothing)
+ in mkLocMessage (Err.unsafeMCDiagnostic diag_opts WarningWithoutFlag Nothing)
l (hdr $$ msg)
mk_msg [] = msg
=====================================
compiler/GHC/Tc/Errors.hs
=====================================
@@ -65,7 +65,7 @@ import GHC.Core.InstEnv
import GHC.Core.TyCon
import GHC.Core.DataCon
-import GHC.Utils.Error (diagReasonSeverity, pprLocMsgEnvelope )
+import GHC.Utils.Error (diagReasonSeverity, unsafePprLocMsgEnvelope )
import GHC.Utils.Misc
import GHC.Utils.Outputable as O
import GHC.Utils.Panic
@@ -1294,7 +1294,7 @@ mkErrorTerm ct_loc ty ctxt msg supp hints
hints
-- This will be reported at runtime, so we always want "error:" in the report, never "warning:"
; dflags <- getDynFlags
- ; let err_msg = pprLocMsgEnvelope (initTcMessageOpts dflags) msg
+ ; let err_msg = unsafePprLocMsgEnvelope (initTcMessageOpts dflags) msg
err_str = showSDoc dflags $
err_msg $$ text "(deferred type error)"
=====================================
compiler/GHC/Tc/Utils/Monad.hs
=====================================
@@ -1146,7 +1146,7 @@ reportDiagnostics = mapM_ reportDiagnostic
reportDiagnostic :: MsgEnvelope TcRnMessage -> TcRn ()
reportDiagnostic msg
- = do { traceTc "Adding diagnostic:" (pprLocMsgEnvelopeDefault msg) ;
+ = do { traceTc "Adding diagnostic:" (unsafePprLocMsgEnvelopeDefault msg) ;
errs_var <- getErrsVar ;
msgs <- readTcRef errs_var ;
writeTcRef errs_var (msg `addMessage` msgs) }
=====================================
compiler/GHC/Types/Error.hs
=====================================
@@ -26,7 +26,7 @@ module GHC.Types.Error
-- * Classifying Messages
- , MessageClass (..)
+ , MessageClass (MCDiagnostic, ..)
, Severity (..)
, Diagnostic (..)
, UnknownDiagnostic (..)
@@ -491,11 +491,11 @@ data MessageClass
-- ^ Log messages intended for end users.
-- No file\/line\/column stuff.
- | MCDiagnostic Severity ResolvedDiagnosticReason (Maybe DiagnosticCode)
+ | UnsafeMCDiagnostic Severity ResolvedDiagnosticReason (Maybe DiagnosticCode)
-- ^ Diagnostics from the compiler. This constructor is very powerful as
-- it allows the construction of a 'MessageClass' with a completely
-- arbitrary permutation of 'Severity' and 'DiagnosticReason'. As such,
- -- users are encouraged to use the 'mkMCDiagnostic' smart constructor
+ -- users are encouraged to use the 'unsafeMCDiagnostic' smart constructor
-- instead. Use this constructor directly only if you need to construct
-- and manipulate diagnostic messages directly, for example inside
-- 'GHC.Utils.Error'. In all the other circumstances, /especially/ when
@@ -506,6 +506,10 @@ data MessageClass
-- error-message type, then use Nothing. In the long run, this really
-- should always have a 'DiagnosticCode'. See Note [Diagnostic codes].
+{-# COMPLETE MCOutput, MCFatal, MCInteractive, MCDump, MCInfo, MCDiagnostic #-}
+pattern MCDiagnostic :: Severity -> ResolvedDiagnosticReason -> Maybe DiagnosticCode -> MessageClass
+pattern MCDiagnostic severity reason code <- UnsafeMCDiagnostic severity reason code
+
{-
Note [Suppressing Messages]
~~~~~~~~~~~~~~~~~~~~~~~~~~~
=====================================
compiler/GHC/Types/SourceError.hs
=====================================
@@ -14,7 +14,7 @@ import GHC.Types.Error
import GHC.Utils.Monad
import GHC.Utils.Panic
import GHC.Utils.Exception
-import GHC.Utils.Error (pprMsgEnvelopeBagWithLocDefault)
+import GHC.Utils.Error (unsafePprMsgEnvelopeBagWithLocDefault)
import GHC.Utils.Outputable
import GHC.Driver.Errors.Ppr () -- instance Diagnostic GhcMessage
@@ -59,7 +59,7 @@ instance Show SourceError where
show (SourceError msgs) =
renderWithContext defaultSDocContext
. vcat
- . pprMsgEnvelopeBagWithLocDefault
+ . unsafePprMsgEnvelopeBagWithLocDefault
. getMessages
$ msgs
=====================================
compiler/GHC/Utils/Error.hs
=====================================
@@ -22,9 +22,8 @@ module GHC.Utils.Error (
errorsFound, isEmptyMessages,
-- ** Formatting
- pprMessageBag, pprMsgEnvelopeBagWithLoc, pprMsgEnvelopeBagWithLocDefault,
- pprMessages,
- pprLocMsgEnvelope, pprLocMsgEnvelopeDefault,
+ pprMessageBag, unsafePprMsgEnvelopeBagWithLoc, unsafePprMsgEnvelopeBagWithLocDefault,
+ unsafePprLocMsgEnvelope, unsafePprLocMsgEnvelopeDefault,
formatBulleted,
-- ** Construction
@@ -32,7 +31,7 @@ module GHC.Utils.Error (
emptyMessages, mkDecorated, mkLocMessage,
mkMsgEnvelope, mkPlainMsgEnvelope, mkPlainErrorMsgEnvelope,
mkErrorMsgEnvelope,
- mkMCDiagnostic, diagReasonSeverity,
+ unsafeMCDiagnostic, diagReasonSeverity,
mkPlainError,
mkPlainDiagnostic,
@@ -162,8 +161,8 @@ diag_reason_severity opts reason = fmap ResolvedDiagnosticReason $ case reason o
-- | Make a 'MessageClass' for a given 'DiagnosticReason', consulting the
-- 'DiagOpts'.
-mkMCDiagnostic :: DiagOpts -> DiagnosticReason -> Maybe DiagnosticCode -> MessageClass
-mkMCDiagnostic opts reason code = MCDiagnostic sev reason' code
+unsafeMCDiagnostic :: DiagOpts -> DiagnosticReason -> Maybe DiagnosticCode -> MessageClass
+unsafeMCDiagnostic opts reason code = UnsafeMCDiagnostic sev reason' code
where
(sev, reason') = diag_reason_severity opts reason
@@ -267,29 +266,26 @@ formatBulleted (unDecorated -> docs)
msgs ctx = filter (not . Outputable.isEmpty ctx) docs
starred = (bullet<+>)
-pprMessages :: Diagnostic e => DiagnosticOpts e -> Messages e -> SDoc
-pprMessages e = vcat . pprMsgEnvelopeBagWithLoc e . getMessages
-
-pprMsgEnvelopeBagWithLoc :: Diagnostic e => DiagnosticOpts e -> Bag (MsgEnvelope e) -> [SDoc]
-pprMsgEnvelopeBagWithLoc e bag = [ pprLocMsgEnvelope e item | item <- sortMsgBag Nothing bag ]
+unsafePprMsgEnvelopeBagWithLoc :: Diagnostic e => DiagnosticOpts e -> Bag (MsgEnvelope e) -> [SDoc]
+unsafePprMsgEnvelopeBagWithLoc e bag = [ unsafePprLocMsgEnvelope e item | item <- sortMsgBag Nothing bag ]
-- | Print the messages with the suitable default configuration, usually not what you want but sometimes you don't really
-- care about what the configuration is (for example, if the message is in a panic).
-pprMsgEnvelopeBagWithLocDefault :: forall e . Diagnostic e => Bag (MsgEnvelope e) -> [SDoc]
-pprMsgEnvelopeBagWithLocDefault bag = [ pprLocMsgEnvelopeDefault item | item <- sortMsgBag Nothing bag ]
+unsafePprMsgEnvelopeBagWithLocDefault :: forall e . Diagnostic e => Bag (MsgEnvelope e) -> [SDoc]
+unsafePprMsgEnvelopeBagWithLocDefault bag = [ unsafePprLocMsgEnvelopeDefault item | item <- sortMsgBag Nothing bag ]
-pprLocMsgEnvelopeDefault :: forall e . Diagnostic e => MsgEnvelope e -> SDoc
-pprLocMsgEnvelopeDefault = pprLocMsgEnvelope (defaultDiagnosticOpts @e)
+unsafePprLocMsgEnvelopeDefault :: forall e . Diagnostic e => MsgEnvelope e -> SDoc
+unsafePprLocMsgEnvelopeDefault = unsafePprLocMsgEnvelope (defaultDiagnosticOpts @e)
-pprLocMsgEnvelope :: Diagnostic e => DiagnosticOpts e -> MsgEnvelope e -> SDoc
-pprLocMsgEnvelope opts (MsgEnvelope { errMsgSpan = s
+unsafePprLocMsgEnvelope :: Diagnostic e => DiagnosticOpts e -> MsgEnvelope e -> SDoc
+unsafePprLocMsgEnvelope opts (MsgEnvelope { errMsgSpan = s
, errMsgDiagnostic = e
, errMsgSeverity = sev
, errMsgContext = name_ppr_ctx
, errMsgReason = reason })
= withErrStyle name_ppr_ctx $
mkLocMessage
- (MCDiagnostic sev reason (diagnosticCode e))
+ (UnsafeMCDiagnostic sev reason (diagnosticCode e))
s
(formatBulleted $ diagnosticMessage opts e)
=====================================
compiler/GHC/Utils/Logger.hs
=====================================
@@ -94,7 +94,6 @@ import GHC.Utils.Panic
import GHC.Data.EnumSet (EnumSet)
import qualified GHC.Data.EnumSet as EnumSet
-import GHC.Data.FastString
import System.Directory
import System.FilePath ( takeDirectory, (</>) )
@@ -359,7 +358,6 @@ makeThreadSafe logger = do
$ pushTraceHook trc
$ logger
--- See Note [JSON Error Messages]
defaultLogJsonAction :: LogJsonAction
defaultLogJsonAction logflags msg_class jsdoc =
case msg_class of
@@ -376,32 +374,6 @@ defaultLogJsonAction logflags msg_class jsdoc =
putStrSDoc = defaultLogActionHPutStrDoc logflags False stdout
msg = renderJSON jsdoc
--- See Note [JSON Error Messages]
--- this is to be removed
-jsonLogActionWithHandle :: Handle {-^ Standard out -} -> LogAction
-jsonLogActionWithHandle _ _ (MCDiagnostic SevIgnore _ _) _ _ = return () -- suppress the message
-jsonLogActionWithHandle out logflags msg_class srcSpan msg
- =
- defaultLogActionHPutStrDoc logflags True out
- (withPprStyle PprCode (doc $$ text ""))
- where
- str = renderWithContext (log_default_user_context logflags) msg
- doc = renderJSON $
- JSObject [ ( "span", spanToDumpJSON srcSpan )
- , ( "doc" , JSString str )
- , ( "messageClass", json msg_class )
- ]
- spanToDumpJSON :: SrcSpan -> JsonDoc
- spanToDumpJSON s = case s of
- (RealSrcSpan rss _) -> JSObject [ ("file", json file)
- , ("startLine", json $ srcSpanStartLine rss)
- , ("startCol", json $ srcSpanStartCol rss)
- , ("endLine", json $ srcSpanEndLine rss)
- , ("endCol", json $ srcSpanEndCol rss)
- ]
- where file = unpackFS $ srcSpanFile rss
- UnhelpfulSpan _ -> JSNull
-
-- | The default 'LogAction' prints to 'stdout' and 'stderr'.
--
-- To replicate the default log action behaviour with different @out@ and @err@
@@ -413,8 +385,7 @@ defaultLogAction = defaultLogActionWithHandles stdout stderr
-- Allows clients to replicate the log message formatting of GHC with custom handles.
defaultLogActionWithHandles :: Handle {-^ Handle for standard output -} -> Handle {-^ Handle for standard errors -} -> LogAction
defaultLogActionWithHandles out err logflags msg_class srcSpan msg
- | log_dopt Opt_D_dump_json logflags = jsonLogActionWithHandle out logflags msg_class srcSpan msg
- | otherwise = case msg_class of
+ = case msg_class of
MCOutput -> printOut msg
MCDump -> printOut (msg $$ blankLine)
MCInteractive -> putStrSDoc msg
@@ -491,28 +462,6 @@ defaultLogActionHPutStrDoc logflags asciiSpace h d
-- calls to this log-action can output all on the same line
= printSDoc (log_default_user_context logflags) (Pretty.PageMode asciiSpace) h d
---
--- Note [JSON Error Messages]
--- ~~~~~~~~~~~~~~~~~~~~~~~~~~
---
--- When the user requests the compiler output to be dumped as json
--- we used to collect them all in an IORef and then print them at the end.
--- This doesn't work very well with GHCi. (See #14078) So instead we now
--- use the simpler method of just outputting a JSON document inplace to
--- stdout.
---
--- Before the compiler calls log_action, it has already turned the `ErrMsg`
--- into a formatted message. This means that we lose some possible
--- information to provide to the user but refactoring log_action is quite
--- invasive as it is called in many places. So, for now I left it alone
--- and we can refine its behaviour as users request different output.
---
--- The recent work here replaces the purpose of flag -ddump-json with
--- -fdiagnostics-as-json. For temporary backwards compatibility while
--- -ddump-json is being deprecated, `jsonLogAction` has been added in, but
--- it should be removed along with -ddump-json. Similarly, the guard in
--- `defaultLogAction` should be removed. This cleanup is tracked in #24113.
-
-- | Default action for 'dumpAction' hook
defaultDumpAction :: DumpCache -> LogAction -> DumpAction
defaultDumpAction dumps log_action logflags sty flag title _fmt doc =
=====================================
docs/users_guide/debugging.rst
=====================================
@@ -55,13 +55,6 @@ Dumping out compiler intermediate structures
``Main.p.dump-simpl`` and ``Main.dump-simpl`` instead of overwriting the
output of one way with the output of another.
-.. ghc-flag:: -ddump-json
- :shortdesc: *(deprecated)* Use :ghc-flag:`-fdiagnostics-as-json` instead
- :type: dynamic
-
- This flag was previously used to generated JSON formatted GHC diagnostics,
- but has been deprecated. Instead, use :ghc-flag:`-fdiagnostics-as-json`.
-
.. ghc-flag:: -dshow-passes
:shortdesc: Print out each pass name as it happens
:type: dynamic
=====================================
ghc/GHCi/UI.hs
=====================================
@@ -498,8 +498,6 @@ interactiveUI config srcs maybe_exprs = do
installInteractiveHomeUnits
- -- Update the LogAction. Ensure we don't override the user's log action lest
- -- we break -ddump-json (#14078)
lastErrLocationsRef <- liftIO $ newIORef []
pushLogHookM (ghciLogAction lastErrLocationsRef)
=====================================
testsuite/tests/driver/T16167.stderr
=====================================
@@ -1 +1,2 @@
+{"version":"1.1","ghcVersion":"ghc-9.13.20250627","span":{"file":"T16167.hs","start":{"line":1,"column":8},"end":{"line":1,"column":9}},"severity":"Error","code":58481,"message":["parse error on input \u2018f\u2019"],"hints":[]}
*** Exception: ExitFailure 1
=====================================
testsuite/tests/driver/T16167.stdout deleted
=====================================
@@ -1,2 +0,0 @@
-{"span":null,"doc":"-ddump-json is deprecated: Use `-fdiagnostics-as-json` instead","messageClass":"MCDiagnostic SevWarning WarningWithFlags Opt_WarnDeprecatedFlags :| [] Just GHC-53692"}
-{"span":{"file":"T16167.hs","startLine":1,"startCol":8,"endLine":1,"endCol":9},"doc":"parse error on input \u2018f\u2019","messageClass":"MCDiagnostic SevError ErrorWithoutFlag Just GHC-58481"}
=====================================
testsuite/tests/driver/all.T
=====================================
@@ -274,12 +274,11 @@ test('T12752pass', normal, compile, ['-DSHOULD_PASS=1 -Wcpp-undef'])
test('T12955', normal, makefile_test, [])
test('T12971', [when(opsys('mingw32'), fragile(17945)), ignore_stdout], makefile_test, [])
-test('json_dump', normal, compile_fail, ['-ddump-json'])
test('json', normalise_version('ghc'), compile_fail, ['-fdiagnostics-as-json'])
test('json_warn', normalise_version('ghc'), compile, ['-fdiagnostics-as-json -Wunused-matches -Wx-partial'])
-test('json2', normalise_version('ghc-internal', 'base','ghc-prim'), compile, ['-ddump-types -ddump-json -Wno-unsupported-llvm-version'])
+test('json2', normalise_version('ghc-internal', 'base','ghc-prim'), compile, ['-ddump-types -fdiagnostics-as-json -Wno-unsupported-llvm-version'])
test('T16167', [normalise_version('ghc'),req_interp,exit_code(1)], run_command,
- ['{compiler} -x hs -e ":set prog T16167.hs" -ddump-json T16167.hs'])
+ ['{compiler} -x hs -e ":set prog T16167.hs" -fdiagnostics-as-json T16167.hs'])
test('T13604', [], makefile_test, [])
test('T13604a',
[ js_broken(22261) # require HPC support
=====================================
testsuite/tests/driver/json2.stderr
=====================================
@@ -1,2 +1,4 @@
-{"span":null,"doc":"-ddump-json is deprecated: Use `-fdiagnostics-as-json` instead","messageClass":"MCDiagnostic SevWarning WarningWithFlags Opt_WarnDeprecatedFlags :| [] Just GHC-53692"}
-{"span":null,"doc":"TYPE SIGNATURES\n foo :: forall a. a -> a\nDependent modules: []\nDependent packages: [(normal, base-4.21.0.0)]","messageClass":"MCOutput"}
+TYPE SIGNATURES
+ foo :: forall a. a -> a
+Dependent modules: []
+Dependent packages: [(normal, base-4.21.0.0)]
=====================================
testsuite/tests/driver/json_dump.hs deleted
=====================================
@@ -1,6 +0,0 @@
-module Foo where
-
-import Data.List
-
-id1 :: a -> a
-id1 = 5
=====================================
testsuite/tests/driver/json_dump.stderr deleted
=====================================
@@ -1,2 +0,0 @@
-{"span":null,"doc":"-ddump-json is deprecated: Use `-fdiagnostics-as-json` instead","messageClass":"MCDiagnostic SevWarning WarningWithFlags Opt_WarnDeprecatedFlags :| [] Just GHC-53692"}
-{"span":{"file":"json_dump.hs","startLine":6,"startCol":7,"endLine":6,"endCol":8},"doc":"\u2022 No instance for \u2018Num (a -> a)\u2019 arising from the literal \u20185\u2019\n (maybe you haven't applied a function to enough arguments?)\n\u2022 In the expression: 5\n In an equation for \u2018id1\u2019: id1 = 5","messageClass":"MCDiagnostic SevError ErrorWithoutFlag Just GHC-39999"}
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/74b8e7d5c6cf239488113a20b9a4c1…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/74b8e7d5c6cf239488113a20b9a4c1…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc] Pushed new branch wip/sol/hie-store-occ-name-for-wierd-in-names
by Simon Hengel (＠sol) 28 Jul '25
by Simon Hengel (＠sol) 28 Jul '25
28 Jul '25
Simon Hengel pushed new branch wip/sol/hie-store-occ-name-for-wierd-in-names at Glasgow Haskell Compiler / GHC
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/sol/hie-store-occ-name-for-wi…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
28 Jul '25
Simon Hengel pushed new branch wip/sol/hie-wierd-in-as-external at Glasgow Haskell Compiler / GHC
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/sol/hie-wierd-in-as-external
You're receiving this email because of your account on gitlab.haskell.org.
1
0