[Git][ghc/ghc][wip/andreask/data-module-name] 21 commits: ghc-boot: remove unused SizedSeq instances and functions
by Andreas Klebinger (＠AndreasK) 03 Apr '26
by Andreas Klebinger (＠AndreasK) 03 Apr '26
03 Apr '26
Andreas Klebinger pushed to branch wip/andreask/data-module-name at Glasgow Haskell Compiler / GHC
Commits:
cf942119 by Cheng Shao at 2026-03-30T15:24:37-04:00
ghc-boot: remove unused SizedSeq instances and functions
This commit removes unused `SizedSeq` instances and functions, only
keeping the bits we need for hpc tick sequence for now.
- - - - -
22c5b7cc by Cheng Shao at 2026-03-30T15:24:38-04:00
ghci: remove unused GHCi.BinaryArray
This patch removes the unused `GHCi.BinaryArray` module from `ghci`.
Closes #27108.
- - - - -
77abb4ab by Cheng Shao at 2026-03-30T15:25:21-04:00
testsuite: mark T17912 as fragile on Windows
T17912 is still fragile on Windows, it sometimes unexpectedly pass in
CI. This especially strains our already scarce Windows CI runner
resources. Mark it as fragile on Windows for the time being.
- - - - -
d741a6cc by Andreas Klebinger at 2026-03-31T04:39:33-04:00
Bump minimum shake version for hadrian.
We also add the shake version we want to stack.yaml
Fixes #26884
- - - - -
5e556f9e by Vladislav Zavialov at 2026-03-31T04:40:16-04:00
Status check for the HsType~HsExpr refactoring (#25121)
Add a test case to track the status of a refactoring project within GHC
whose goal is to arrive at the following declaration:
type HsType = HsExpr
The rationale for this is to increase code reuse between the term- and
type-level code in the compiler front-end (AST, parser, renamer, type checker).
The status report is saved to testsuite/tests/ghc-api/T25121_status.stdout
and provides useful insights into what needs to happen to make progress on
the ticket.
- - - - -
acffb1b1 by fendor at 2026-03-31T04:41:02-04:00
Extract Binary instances to `GHC.ByteCode.Binary`
- - - - -
e2ea8e25 by fendor at 2026-03-31T04:41:02-04:00
Add `seqNonEmpty` for evaluating `NonEmpty a`
- - - - -
048b00b7 by fendor at 2026-03-31T04:41:02-04:00
Record `LinkableUsage` instead of `Linkable` in `LoaderState`
Retaining a ByteCode `Linkable` after it has been loaded retains its
`UnlinkedBCO`, keeping it alive for the remainder of the program.
This starts accumulating a lot of `UnlinkedBCO` and memory over time.
However, the `Linkable` is merely used to later record its usage in
`mkObjectUsage`, which is used for recompilation checking.
However, this is incorrect, as the interface file and bytecode objects
could be in different states, e.g. the interface changes, but the
bytecode library hasn't changed so we don't need to recompile and vice
versa.
By computing a `Fingerprint` for the `ModuleByteCode`, and recording it
in the `LinkableUsage`, we know precisely whether the `ByteCode` object
on disk is outdated.
Thus, parts of this commit just makes sure that we efficiently compute a
`Fingerprint` for `ModuleByteCode` and store it in the on-disk
representation of `ModuleByteCode`.
We change the `LoaderState` to retain `LinkableUsage`, which is smaller
representation of a `Linkable`. This allows us to free the unneeded
fields of `Linkable` after linking them.
We declare the following memory invariants that this commit implements:
* No `LinkablePart` should be retained from `LoaderState`.
* `Linkable`s should be unloaded after they have been loaded.
These invariants are unfortunately tricky to automatically uphold, so we
are simply documenting our assumptions for now.
We introduce the `linkable-space` test which makes sure that after
loading, no `DotGBC` or `UnlinkedBCO` is retained.
-------------------------
Metric Increase:
MultiLayerModulesTH_OneShot
-------------------------
We allocate a bit more, but the peak number of bytes doesn't change.
While a bit unfortunate, accepting the metric increase.
We add multiple new performance measurements where we were able to
observe the desired memory invariants. Further, we add regression tests
to validate that the recompilation checker behaves more correct than
before.
- - - - -
2d1c1997 by Simon Jakobi at 2026-03-31T04:41:46-04:00
Eliminate dictionary-passing in ListMap operations
Mark the ListMap helpers 'INLINABLE' so importing modules can specialise
the 'TrieMap (ListMap m)' methods and avoid recursive dictionary-passing.
See Note [Making ListMap operations specialisable].
Fixes #27097
- - - - -
ed2c6570 by Cheng Shao at 2026-03-31T04:42:33-04:00
testsuite: fix testdir cleanup logic on Windows
testdir cleanup is unreliable on Windows (#13162) and despite existing
hacks in the driver, new failure mode has occurred. This patch makes
it print the warning and carry on when failed to clean up a testdir,
instead of reporting a spurious framework failure. See added comment
for detailed explanation.
- - - - -
d9388e29 by Simon Jakobi at 2026-03-31T13:14:59-04:00
Add regression test for #18177
Closes #18177.
Assisted-by: Codex
- - - - -
6a10045c by mangoiv at 2026-03-31T13:15:43-04:00
ci: allow metric decrease for two tests on i386
There has been a nightly failure on i386 due to a compiler runtime
improvement on i386 debian 12. We allow that.
Metric Decrease (test_env='i386-linux-deb12'):
T12707 T8095
- - - - -
7fbb4fcb by Rodrigo Mesquita at 2026-04-01T12:16:33+00:00
Bump default language edition to GHC2024
As per the accepted ghc-proposal#632
Fixes #26039
- - - - -
5ae43275 by Peng Fan at 2026-04-01T19:01:06-04:00
NCG/LA64: add cmpxchg and xchg primops
And append some new instructions for LA664 uarch.
Apply fix to cmpxchg-prim by Andreas Klebinger.
Suggestions in https://gitlab.haskell.org/ghc/ghc/-/merge_requests/15515
- - - - -
8f95534a by Duncan Coutts at 2026-04-01T19:01:52-04:00
Remove signal-based ticker implementations
Fixes issue #27073
All supported platforms should work with the pthreads + nanosleep based
ticker implementation. This avoids all the problems with using signals.
In practice, all supported platforms were probably using the non-signal
tickers already, which is probably why we do not get lots of reports
about deadlocks and other weirdness: we were definately using functions
that are not async signal safe in the tick handler (such as fflush to
flussh the eventlog).
Only Solaris was explicitly using the timer_create ticker impl, and even
Solaris could probably use the pthreads one (if anyone cared: Solaris is
no longer a Teir 3 supported platform).
Plausibly the only supported platform that this will change will be AIX,
which should now use the pthreads impl.
- - - - -
51b32b0d by Duncan Coutts at 2026-04-01T19:01:52-04:00
Tidy up some timer/ticker comments elsewhere
- - - - -
7562bcd7 by Duncan Coutts at 2026-04-01T19:01:52-04:00
Remove now-unused install_vtalrm_handler
Support function used by both of the signal-based ticker
implementations.
- - - - -
6da127c7 by Duncan Coutts at 2026-04-01T19:01:52-04:00
No longer probe for timer_create in rts/configure
It was only used by the TimerCreate.c ticker impl.
- - - - -
3fd490fa by Duncan Coutts at 2026-04-01T19:01:53-04:00
Note that rtsTimerSignal is deprecated.
- - - - -
63099b0f by Simon Jakobi at 2026-04-01T19:02:39-04:00
Add perf test for #13960
Closes #13960.
- - - - -
ecad72e0 by Andreas Klebinger at 2026-04-03T10:48:01+02:00
Give the Data instance for ModuleName a non-bottom toConstr implementation.
I've also taken the liberty to add Note [Data.Data instances for GHC AST Types]
describing some of the uses of Data.Data I could find.
Fixes #27129
- - - - -
196 changed files:
- .gitlab/ci.sh
- + compiler/GHC/ByteCode/Binary.hs
- + compiler/GHC/ByteCode/Recomp/Binary.hs
- compiler/GHC/ByteCode/Serialize.hs
- compiler/GHC/CmmToAsm/LA64/CodeGen.hs
- compiler/GHC/CmmToAsm/LA64/Instr.hs
- compiler/GHC/CmmToAsm/LA64/Ppr.hs
- compiler/GHC/Data/TrieMap.hs
- compiler/GHC/Driver/Flags.hs
- compiler/GHC/Driver/Hooks.hs
- compiler/GHC/Driver/Main.hs
- compiler/GHC/Driver/Pipeline.hs
- compiler/GHC/Driver/Plugins.hs
- compiler/GHC/Hs/Instances.hs
- compiler/GHC/HsToCore/Usage.hs
- compiler/GHC/Iface/Recomp.hs
- compiler/GHC/Iface/Recomp/Types.hs
- compiler/GHC/Linker/ByteCode.hs
- compiler/GHC/Linker/Deps.hs
- compiler/GHC/Linker/Loader.hs
- compiler/GHC/Linker/Types.hs
- compiler/GHC/Runtime/Loader.hs
- compiler/GHC/Tc/Types.hs
- compiler/GHC/Tc/Utils/Monad.hs
- compiler/GHC/Unit/Home/ModInfo.hs
- compiler/GHC/Unit/Module/Deps.hs
- compiler/GHC/Unit/Module/Status.hs
- compiler/GHC/Utils/Misc.hs
- compiler/Language/Haskell/Syntax/Module/Name.hs
- compiler/ghc.cabal.in
- docs/users_guide/exts/control.rst
- ghc/GHCi/Leak.hs
- hadrian/hadrian.cabal
- hadrian/stack.yaml
- libraries/base/tests/IO/all.T
- libraries/ghc-boot/GHC/Data/SizedSeq.hs
- − libraries/ghci/GHCi/BinaryArray.hs
- libraries/ghci/ghci.cabal.in
- − m4/fp_check_timer_create.m4
- rts/Timer.c
- rts/configure.ac
- rts/include/rts/Timer.h
- rts/include/stg/SMP.h
- rts/posix/Signals.c
- rts/posix/Signals.h
- rts/posix/Ticker.c
- − rts/posix/ticker/Setitimer.c
- − rts/posix/ticker/TimerCreate.c
- testsuite/driver/testlib.py
- testsuite/tests/ado/ado004.hs
- testsuite/tests/annotations/should_fail/annfail02.hs
- testsuite/tests/annotations/should_fail/annfail02.stderr
- testsuite/tests/array/should_run/arr020.hs
- + testsuite/tests/bytecode/TLinkable/BCOTemplate.hs
- + testsuite/tests/bytecode/TLinkable/LinkableUsage01.stderr
- + testsuite/tests/bytecode/TLinkable/LinkableUsage02.stderr
- + testsuite/tests/bytecode/TLinkable/Makefile
- + testsuite/tests/bytecode/TLinkable/all.T
- + testsuite/tests/bytecode/TLinkable/genLinkables.sh
- + testsuite/tests/bytecode/TLinkable/linkable-space.hs
- + testsuite/tests/bytecode/TLinkable/linkable-space.stdout
- testsuite/tests/core-to-stg/T19700.hs
- testsuite/tests/count-deps/CountDepsAst.stdout
- testsuite/tests/count-deps/CountDepsParser.stdout
- testsuite/tests/deSugar/should_fail/DsStrictFail.hs
- testsuite/tests/deriving/should_compile/T15798b.hs
- testsuite/tests/deriving/should_compile/T15798c.hs
- testsuite/tests/deriving/should_compile/T15798c.stderr
- testsuite/tests/deriving/should_compile/T24955a.hs
- testsuite/tests/deriving/should_compile/T24955a.stderr
- testsuite/tests/deriving/should_compile/T24955b.hs
- testsuite/tests/deriving/should_compile/T24955c.hs
- testsuite/tests/deriving/should_fail/T10598_fail4.hs
- testsuite/tests/deriving/should_fail/T10598_fail4.stderr
- testsuite/tests/deriving/should_fail/T10598_fail5.hs
- testsuite/tests/deriving/should_fail/T10598_fail5.stderr
- testsuite/tests/dmdanal/sigs/T22241.hs
- + testsuite/tests/driver/T18177.hs
- testsuite/tests/driver/all.T
- testsuite/tests/driver/multipleHomeUnits/multipleHomeUnits_recomp_th.stdout
- + testsuite/tests/driver/recomp022/A1.hs
- + testsuite/tests/driver/recomp022/A2.hs
- + testsuite/tests/driver/recomp022/A3.hs
- + testsuite/tests/driver/recomp022/B.hs
- + testsuite/tests/driver/recomp022/C.hs
- + testsuite/tests/driver/recomp022/Makefile
- + testsuite/tests/driver/recomp022/all.T
- + testsuite/tests/driver/recomp022/recomp022a.stdout
- + testsuite/tests/driver/recomp022/recomp022b.stdout
- testsuite/tests/gadt/T20485.hs
- + testsuite/tests/ghc-api/T25121_status.hs
- + testsuite/tests/ghc-api/T25121_status.stdout
- testsuite/tests/ghc-api/all.T
- testsuite/tests/ghci.debugger/scripts/all.T
- testsuite/tests/ghci.debugger/scripts/break012.hs
- testsuite/tests/ghci.debugger/scripts/break012.stdout
- testsuite/tests/ghci/prog-mhu002/all.T
- testsuite/tests/ghci/scripts/Makefile
- testsuite/tests/ghci/should_run/BinaryArray.hs
- testsuite/tests/ghci/should_run/all.T
- testsuite/tests/indexed-types/should_compile/T15322.hs
- testsuite/tests/indexed-types/should_compile/T15322.stderr
- testsuite/tests/linear/should_fail/T18888.hs
- testsuite/tests/module/T20007.hs
- testsuite/tests/module/T20007.stderr
- testsuite/tests/module/mod90.hs
- testsuite/tests/module/mod90.stderr
- testsuite/tests/overloadedrecflds/should_fail/NoFieldSelectorsFail.hs
- testsuite/tests/overloadedrecflds/should_fail/T18999_NoDisambiguateRecordFields.hs
- testsuite/tests/overloadedrecflds/should_fail/all.T
- testsuite/tests/parser/should_fail/ParserNoLambdaCase.hs
- testsuite/tests/parser/should_fail/ParserNoLambdaCase.stderr
- testsuite/tests/parser/should_fail/T16270h.hs
- testsuite/tests/parser/should_fail/T16270h.stderr
- testsuite/tests/parser/should_fail/readFail001.hs
- testsuite/tests/parser/should_fail/readFail001.stderr
- testsuite/tests/partial-sigs/should_compile/SomethingShowable.hs
- + testsuite/tests/perf/compiler/T13960.hs
- testsuite/tests/perf/compiler/all.T
- testsuite/tests/plugins/late-plugin/LatePlugin.hs
- testsuite/tests/polykinds/T7151.hs
- testsuite/tests/polykinds/T7151.stderr
- testsuite/tests/polykinds/T7433.hs
- testsuite/tests/polykinds/T7433.stderr
- testsuite/tests/programs/andy_cherry/test.T
- testsuite/tests/rename/should_fail/T10668.hs
- testsuite/tests/rename/should_fail/T10668.stderr
- testsuite/tests/rename/should_fail/T12681.hs
- testsuite/tests/rename/should_fail/T12681.stderr
- testsuite/tests/rename/should_fail/T13568.hs
- testsuite/tests/rename/should_fail/T13568.stderr
- testsuite/tests/rename/should_fail/T13644.hs
- testsuite/tests/rename/should_fail/T13644.stderr
- testsuite/tests/rename/should_fail/T13847.hs
- testsuite/tests/rename/should_fail/T13847.stderr
- testsuite/tests/rename/should_fail/T14032c.hs
- testsuite/tests/rename/should_fail/T19843l.hs
- testsuite/tests/rename/should_fail/T19843l.stderr
- testsuite/tests/rename/should_fail/T25901_imp_hq_fail_5.stderr
- testsuite/tests/rename/should_fail/T25901_imp_sq_fail_2.stderr
- testsuite/tests/rename/should_fail/T5385.hs
- testsuite/tests/rename/should_fail/T5385.stderr
- testsuite/tests/roles/should_fail/Roles5.hs
- testsuite/tests/roles/should_fail/Roles5.stderr
- testsuite/tests/showIface/DocsInHiFile.hs
- testsuite/tests/showIface/DocsInHiFile1.stdout
- testsuite/tests/showIface/DocsInHiFileTH.hs
- testsuite/tests/showIface/DocsInHiFileTH.stdout
- testsuite/tests/showIface/DocsInHiFileTHExternal.hs
- testsuite/tests/showIface/HaddockIssue849.hs
- testsuite/tests/showIface/HaddockIssue849.stdout
- testsuite/tests/showIface/HaddockOpts.hs
- testsuite/tests/showIface/HaddockOpts.stdout
- testsuite/tests/showIface/HaddockSpanIssueT24378.hs
- testsuite/tests/showIface/HaddockSpanIssueT24378.stdout
- testsuite/tests/showIface/MagicHashInHaddocks.hs
- testsuite/tests/showIface/MagicHashInHaddocks.stdout
- testsuite/tests/showIface/Makefile
- testsuite/tests/showIface/NoExportList.hs
- testsuite/tests/showIface/NoExportList.stdout
- testsuite/tests/showIface/PragmaDocs.stdout
- testsuite/tests/showIface/ReExports.stdout
- testsuite/tests/simplCore/T9646/test.T
- testsuite/tests/simplCore/should_compile/T21960.hs
- testsuite/tests/simplCore/should_compile/T26709.stderr
- testsuite/tests/th/TH_Promoted1Tuple.hs
- testsuite/tests/th/TH_Roles1.hs
- testsuite/tests/typecheck/should_compile/MutRec.hs
- testsuite/tests/typecheck/should_compile/T10770a.hs
- testsuite/tests/typecheck/should_compile/T11339.hs
- testsuite/tests/typecheck/should_compile/T11397.hs
- testsuite/tests/typecheck/should_compile/T13526.hs
- testsuite/tests/typecheck/should_compile/T18467.hs
- testsuite/tests/typecheck/should_compile/T18467.stderr
- testsuite/tests/typecheck/should_compile/tc081.hs
- testsuite/tests/typecheck/should_compile/tc141.hs
- testsuite/tests/typecheck/should_fail/T23427.hs
- testsuite/tests/typecheck/should_fail/T6078.hs
- testsuite/tests/typecheck/should_fail/T7453.hs
- testsuite/tests/typecheck/should_fail/T7453.stderr
- testsuite/tests/typecheck/should_fail/T8570.hs
- testsuite/tests/typecheck/should_fail/T8570.stderr
- testsuite/tests/typecheck/should_fail/tcfail083.hs
- testsuite/tests/typecheck/should_fail/tcfail083.stderr
- testsuite/tests/typecheck/should_fail/tcfail084.hs
- testsuite/tests/typecheck/should_fail/tcfail084.stderr
- testsuite/tests/typecheck/should_fail/tcfail094.hs
- testsuite/tests/typecheck/should_fail/tcfail094.stderr
- testsuite/tests/typecheck/should_run/T1735.hs
- testsuite/tests/typecheck/should_run/T1735_Help/Basics.hs
- testsuite/tests/typecheck/should_run/T3731.hs
- testsuite/tests/vdq-rta/should_fail/T24159_type_syntax_th_fail.script
- testsuite/tests/warnings/should_fail/CaretDiagnostics1.hs
- testsuite/tests/warnings/should_fail/CaretDiagnostics1.stderr
- testsuite/tests/warnings/should_fail/T24396c.hs
- testsuite/tests/warnings/should_fail/T24396c.stderr
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7c883bfac436f901c0002f1c2d76a4…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7c883bfac436f901c0002f1c2d76a4…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/sort-usages] determinism: Sort Usages by fingerprint to ensure consistent ordering
by Hannes Siebenhandl (＠fendor) 03 Apr '26
by Hannes Siebenhandl (＠fendor) 03 Apr '26
03 Apr '26
Hannes Siebenhandl pushed to branch wip/sort-usages at Glasgow Haskell Compiler / GHC
Commits:
ebaed6ca by Ian-Woo Kim at 2026-04-03T10:26:47+02:00
determinism: Sort Usages by fingerprint to ensure consistent ordering
In some situations it has been observed that the ordering of usages can
be non-determinstic in parallel builds. Therefore to be on the safe side
we perform a sort on the usages field before writing them to the
interface.
Fixes #26877
- - - - -
3 changed files:
- compiler/GHC/HsToCore/Usage.hs
- compiler/GHC/Unit/Module/Deps.hs
- testsuite/tests/driver/recomp016/recomp016.stdout
Changes:
=====================================
compiler/GHC/HsToCore/Usage.hs
=====================================
@@ -32,7 +32,7 @@ import GHC.Unit.Module.Deps
import GHC.Data.Maybe
import GHC.Data.FastString
-import Data.List (sortBy)
+import Data.List (sortBy, sortOn)
import Data.Map (Map)
import qualified Data.Map as Map
import qualified Data.Set as Set
@@ -69,6 +69,8 @@ data UsageConfig = UsageConfig
{ uc_safe_implicit_imps_req :: !Bool -- ^ Are all implicit imports required to be safe for this Safe Haskell mode?
}
+-- | Build the list of 'Usage's that drives recompilation checking.
+-- The resulting list is deterministically sorted (see 'usageFingerprint').
mkUsageInfo :: UsageConfig -> Plugins -> FinderCache -> UnitEnv
-> Module -> ImportedMods -> [ImportUserSpec] -> NameSet
-> [FilePath] -> [FilePath] -> [(Module, Fingerprint)] -> [LinkableUsage] -> PkgsLoaded
@@ -99,7 +101,10 @@ mkUsageInfo uc plugins fc unit_env
}
| (mod, hash) <- merged ]
++ object_usages
- usages `seqList` return usages
+
+ -- Sort all the Usages to ensure a deterministic ordering.
+ let sorted_usages = sortOn usageFingerprint usages
+ sorted_usages `seqList` return sorted_usages
-- seq the list of Usages returned: occasionally these
-- don't get evaluated for a while and we can end up hanging on to
-- the entire collection of Ifaces.
=====================================
compiler/GHC/Unit/Module/Deps.hs
=====================================
@@ -17,6 +17,7 @@ module GHC.Unit.Module.Deps
, noDependencies
, pprDeps
, Usage (..)
+ , usageFingerprint
, HomeModImport (..)
, HomeModImportedAvails (..)
, ImportAvails (..)
@@ -497,6 +498,17 @@ instance Binary Usage where
i -> error ("Binary.get(Usage): " ++ show i)
+-- | Extract the distinguishing fingerprint carried by a particular 'Usage'
+-- constructor. Every constructor stores a hash capturing the bit of state
+-- that drives recompilation decisions, so we can sort on it directly.
+usageFingerprint :: Usage -> Fingerprint
+usageFingerprint UsagePackageModule{ usg_mod_hash = fp } = fp
+usageFingerprint UsageHomeModule{ usg_mod_hash = fp } = fp
+usageFingerprint UsageFile{ usg_file_hash = fp } = fp
+usageFingerprint UsageDirectory{ usg_dir_hash = fp } = fp
+usageFingerprint UsageHomeModuleBytecode{ usg_bytecode_hash = fp } = fp
+usageFingerprint UsageMergedRequirement{ usg_mod_hash = fp } = fp
+
-- | Records the imports that we depend on from a home module,
-- for recompilation checking.
--
=====================================
testsuite/tests/driver/recomp016/recomp016.stdout
=====================================
@@ -9,4 +9,4 @@ second run
[2 of 5] Compiling B ( B.hs, B.o ) [Source file changed]
[3 of 5] Compiling C ( C.hs, C.o ) [B changed]
[4 of 5] Compiling D ( D.hs, D.o ) [C changed]
-[5 of 5] Compiling E ( E.hs, E.o ) [B changed]
+[5 of 5] Compiling E ( E.hs, E.o ) [D changed]
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ebaed6cac8b642cb21c6e726c12989a…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ebaed6cac8b642cb21c6e726c12989a…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/fendor/hpc-bc-support] Expose startupHpc as an rts symbol
by Hannes Siebenhandl (＠fendor) 03 Apr '26
by Hannes Siebenhandl (＠fendor) 03 Apr '26
03 Apr '26
Hannes Siebenhandl pushed to branch wip/fendor/hpc-bc-support at Glasgow Haskell Compiler / GHC
Commits:
0ea85353 by fendor at 2026-04-03T10:08:12+02:00
Expose startupHpc as an rts symbol
- - - - -
2 changed files:
- libraries/ghci/GHCi/Coverage.hs
- rts/RtsSymbols.c
Changes:
=====================================
libraries/ghci/GHCi/Coverage.hs
=====================================
@@ -41,8 +41,8 @@ hpcAddModule modlName ticks hash tickboxes = do
-- calling 'hpc_startup' multiple times is safe, it will only be initialised once.
hpc_startup
-foreign import ccall "hs_hpc_module"
+foreign import ccall unsafe "hs_hpc_module"
hpc_register_module :: CString -> Word32 -> Word32 -> Ptr Word64 -> IO ()
-foreign import ccall "startupHpc"
+foreign import ccall usnafe "startupHpc"
hpc_startup :: IO ()
=====================================
rts/RtsSymbols.c
=====================================
@@ -600,6 +600,7 @@ extern char **environ;
SymI_HasProto(hs_free_fun_ptr) \
SymI_HasProto(hs_hpc_rootModule) \
SymI_HasProto(hs_hpc_module) \
+ SymI_HasProto(startupHpc) \
SymI_HasProto(hs_thread_done) \
SymI_HasProto(hs_try_putmvar) \
SymI_HasProto(hs_try_putmvar_with_value) \
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0ea85353f57b3613644a680e1607391…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0ea85353f57b3613644a680e1607391…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/fendor/hpc-bc-support] Add more tests for ghci and -fhpc
by Hannes Siebenhandl (＠fendor) 03 Apr '26
by Hannes Siebenhandl (＠fendor) 03 Apr '26
03 Apr '26
Hannes Siebenhandl pushed to branch wip/fendor/hpc-bc-support at Glasgow Haskell Compiler / GHC
Commits:
dca9e699 by fendor at 2026-04-03T10:01:43+02:00
Add more tests for ghci and -fhpc
- - - - -
24 changed files:
- testsuite/tests/hpc/Makefile
- testsuite/tests/hpc/T17073.stdout → testsuite/tests/hpc/T17073a.stdout
- + testsuite/tests/hpc/T17073b.stdout
- testsuite/tests/hpc/T20568.stdout → testsuite/tests/hpc/T20568a.stdout
- + testsuite/tests/hpc/T20568b.stdout
- testsuite/tests/hpc/all.T
- testsuite/tests/hpc/fork/Makefile
- + testsuite/tests/hpc/function/hpcrun.sh
- testsuite/tests/hpc/function/test.T
- + testsuite/tests/hpc/function/tough1.script
- + testsuite/tests/hpc/function/tough1.stderr
- + testsuite/tests/hpc/function/tough1.stdout
- testsuite/tests/hpc/function2/test.T
- + testsuite/tests/hpc/function2/tough3.script
- testsuite/tests/hpc/ghc_ghci/Makefile
- testsuite/tests/hpc/hpcrun.pl
- testsuite/tests/hpc/simple/Makefile
- + testsuite/tests/hpc/simple/hpc002.hs
- + testsuite/tests/hpc/simple/hpc002.stdout
- + testsuite/tests/hpc/simple/hpc003.hs
- + testsuite/tests/hpc/simple/hpc003.script
- + testsuite/tests/hpc/simple/hpc003.stderr
- + testsuite/tests/hpc/simple/hpc003.stdout
- testsuite/tests/hpc/simple/test.T
Changes:
=====================================
testsuite/tests/hpc/Makefile
=====================================
@@ -1,4 +1,4 @@
-TOP=../..
+TOP=/home/hugin/Documents/haskell/ghc-hpc-bc/testsuite
include $(TOP)/mk/boilerplate.mk
include $(TOP)/mk/test.mk
@@ -8,13 +8,22 @@ T11798:
"$(TEST_HC)" $(TEST_HC_ARGS) T11798 -fhpc
test -e .hpc/T11798.mix
-T17073:
+T17073a:
LANG=ASCII "$(TEST_HC)" $(TEST_HC_ARGS) T17073.hs -fhpc -v0
./T17073
"$(HPC)" report T17073
"$(HPC)" version
LANG=ASCII "$(HPC)" markup T17073
-T20568:
+T17073b:
+ "$(TEST_HC)" $(TEST_HC_OPTS_INTERACTIVE) $(TEST_HC_ARGS) T17073.hs -fhpc -v0 -e ":main"
+ "$(HPC)" report ghc
+ "$(HPC)" version
+ LANG=ASCII "$(HPC)" markup ghc
+
+T20568a:
"$(TEST_HC)" $(TEST_HC_ARGS) T20568.hs -fhpc -v0
./T20568
+
+T20568b:
+ "$(TEST_HC)" $(TEST_HC_OPTS_INTERACTIVE) $(TEST_HC_ARGS) T20568.hs -fhpc -v0 -e ":main"
=====================================
testsuite/tests/hpc/T17073.stdout → testsuite/tests/hpc/T17073a.stdout
=====================================
@@ -12,4 +12,4 @@ Writing: Main.hs.html
Writing: hpc_index.html
Writing: hpc_index_fun.html
Writing: hpc_index_alt.html
-Writing: hpc_index_exp.html
\ No newline at end of file
+Writing: hpc_index_exp.html
=====================================
testsuite/tests/hpc/T17073b.stdout
=====================================
@@ -0,0 +1,15 @@
+Добрый день
+100% expressions used (2/2)
+100% boolean coverage (0/0)
+ 100% guards (0/0)
+ 100% 'if' conditions (0/0)
+ 100% qualifiers (0/0)
+100% alternatives used (0/0)
+100% local declarations used (0/0)
+100% top-level declarations used (1/1)
+hpc tools, version 0.69
+Writing: Main.hs.html
+Writing: hpc_index.html
+Writing: hpc_index_fun.html
+Writing: hpc_index_alt.html
+Writing: hpc_index_exp.html
=====================================
testsuite/tests/hpc/T20568.stdout → testsuite/tests/hpc/T20568a.stdout
=====================================
=====================================
testsuite/tests/hpc/T20568b.stdout
=====================================
@@ -0,0 +1 @@
+IfThenElse (AstBool True) (AstInt 1) (AstInt 2)
=====================================
testsuite/tests/hpc/all.T
=====================================
@@ -23,7 +23,10 @@ test('T2991', [cmd_wrapper(T2991)],
# Run with 'ghc --main'. Do not list other modules explicitly.
multimod_compile_and_run, ['T2991', ''])
-test('T17073', when(opsys('mingw32'), expect_broken(17607)),
- makefile_test, ['T17073 HPC={hpc}'])
+test('T17073a', [when(opsys('mingw32'), expect_broken(17607)), extra_files(['T17073.hs'])],
+ makefile_test, ['T17073a HPC={hpc}'])
+test('T17073b', [when(opsys('mingw32'), expect_broken(17607)), extra_files(['T17073.hs'])],
+ makefile_test, ['T17073b HPC={hpc}'])
-test('T20568', normal, makefile_test, [])
+test('T20568a', [extra_files(['T20568.hs'])], makefile_test, [])
+test('T20568b', [extra_files(['T20568.hs'])], makefile_test, [])
=====================================
testsuite/tests/hpc/fork/Makefile
=====================================
@@ -1,4 +1,3 @@
TOP=../../..
include $(TOP)/mk/boilerplate.mk
include $(TOP)/mk/test.mk
-
=====================================
testsuite/tests/hpc/function/hpcrun.sh
=====================================
@@ -0,0 +1,48 @@
+#!/usr/bin/env bash
+
+while [[ $1 == --* ]]; do
+ arg=$1; shift
+ case $arg in
+ --) break ;;
+ --hpc=*) HPC=${arg#--hpc=} ;;
+ --clear) CLEAR=1 ;;
+ --exeext=*) exeext=${arg#--exeext=} ;;
+ *) echo "Bad arg: $arg" >&2; exit 1 ;;
+ esac
+done
+
+[[ -z $HPC ]] && { echo "no option --hpc=* provided" >&2; exit 1; }
+
+# Skip KEY=VALUE assignments to find the real executable
+exe=""
+for arg in "$@"; do
+ [[ $arg =~ ^[A-Za-z_][A-Za-z0-9_]*= ]] && continue
+ exe=$arg
+ break
+done
+
+binary=$(basename "$exe")$exeext
+
+[[ -n $CLEAR ]] && rm -f "$binary.tix"
+
+# Reconstruct with quoted arguments
+cmd=""
+for arg in "$@"; do
+ cmd+=" $(printf '%q' "$arg")"
+done
+bash -c "$cmd"
+echo
+
+$HPC report "$binary.tix"
+echo
+
+$HPC report "$binary.tix" --per-module
+echo
+
+$HPC markup "$binary.tix" | while IFS= read -r line; do
+ echo "$line"
+ if [[ $line =~ Writing:\ ([^[:space:]]+\.html) ]]; then
+ cat "${BASH_REMATCH[1]}"
+ fi
+done
+echo
=====================================
testsuite/tests/hpc/function/test.T
=====================================
@@ -1,6 +1,6 @@
-setTestOpts([omit_ghci, when(fast(), skip), js_skip])
+setTestOpts([when(fast(), skip), js_skip])
-hpc_prefix = "perl hpcrun.pl --clear --exeext={exeext} --hpc={hpc}"
+hpc_prefix = "./hpcrun.sh --clear --exeext={exeext} --hpc={hpc} --"
test('tough',
[extra_files(['../hpcrun.pl']),
@@ -8,3 +8,11 @@ test('tough',
ignore_extension,
when(arch('wasm32'), fragile(23243))],
compile_and_run, ['-fhpc'])
+
+test('tough1',
+ [extra_files(['hpcrun.sh', 'tough.hs']),
+ cmd_prefix(hpc_prefix),
+ ignore_extension,
+ extra_hc_opts('-fhpc tough.hs'),
+ when(arch('wasm32'), fragile(23243))],
+ ghci_script, ['tough1.script'])
=====================================
testsuite/tests/hpc/function/tough1.script
=====================================
@@ -0,0 +1,2 @@
+main
+:quit
=====================================
testsuite/tests/hpc/function/tough1.stderr
=====================================
@@ -0,0 +1,4 @@
+tough.hs:22:5: warning: [GHC-53633] [-Woverlapping-patterns (in -Wdefault)]
+ Pattern match is redundant
+ In a case alternative: _ -> ...
+
=====================================
testsuite/tests/hpc/function/tough1.stdout
=====================================
@@ -0,0 +1,127 @@
+"Hello"
+"Hello"
+badCase
+badCase
+"Bark"
+"Hello"
+(1,2,3)
+
+ 73% expressions used (73/100)
+ 14% boolean coverage (1/7)
+ 0% guards (0/4), 3 always True, 1 always False
+ 33% 'if' conditions (1/3), 1 always True, 1 always False
+ 100% qualifiers (0/0)
+ 58% alternatives used (7/12)
+100% local declarations used (0/0)
+ 83% top-level declarations used (5/6)
+
+-----<module Main>-----
+ 73% expressions used (73/100)
+ 14% boolean coverage (1/7)
+ 0% guards (0/4), 3 always True, 1 always False
+ 33% 'if' conditions (1/3), 1 always True, 1 always False
+ 100% qualifiers (0/0)
+ 58% alternatives used (7/12)
+100% local declarations used (0/0)
+ 83% top-level declarations used (5/6)
+
+Writing: Main.hs.html
+<html>
+<head>
+<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
+<style type="text/css">
+span.lineno { color: white; background: #aaaaaa; border-right: solid white 12px }
+span.nottickedoff { background: yellow}
+span.istickedoff { background: white }
+span.tickonlyfalse { margin: -1px; border: 1px solid #f20913; background: #f20913 }
+span.tickonlytrue { margin: -1px; border: 1px solid #60de51; background: #60de51 }
+span.funcount { font-size: small; color: orange; z-index: 2; position: absolute; right: 20 }
+span.decl { font-weight: bold }
+span.spaces { background: white }
+</style>
+</head>
+<body>
+<pre>
+<span class="decl"><span class="nottickedoff">never executed</span> <span class="tickonlytrue">always true</span> <span class="tickonlyfalse">always false</span></span>
+</pre>
+<pre>
+<span class="lineno"> 1 </span>import Control.Exception as E
+<span class="lineno"> 2 </span>
+<span class="lineno"> 3 </span>-- This test shows what hpc can really do.
+<span class="lineno"> 4 </span>
+<span class="lineno"> 5 </span><span class="decl"><span class="istickedoff">main = do</span>
+<span class="lineno"> 6 </span><span class="spaces"> </span><span class="istickedoff">print ("Hello")</span>
+<span class="lineno"> 7 </span><span class="spaces"> </span><span class="istickedoff">foo "Hello"</span>
+<span class="lineno"> 8 </span><span class="spaces"> </span><span class="istickedoff">E.catch (print (badCase 22 <span class="nottickedoff">44</span>))</span>
+<span class="lineno"> 9 </span><span class="spaces"> </span><span class="istickedoff">(\ e -> print (e :: E.ErrorCall))</span>
+<span class="lineno"> 10 </span><span class="spaces"> </span><span class="istickedoff">E.catch (print (badCase 22 <span class="nottickedoff">(error "Foo")</span>))</span>
+<span class="lineno"> 11 </span><span class="spaces"> </span><span class="istickedoff">(\ e -> print (e :: E.ErrorCall))</span>
+<span class="lineno"> 12 </span><span class="spaces"> </span><span class="istickedoff">E.catch (print "Bark")</span>
+<span class="lineno"> 13 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">(\ e -> print (e :: E.ErrorCall))</span></span>
+<span class="lineno"> 14 </span><span class="spaces"> </span><span class="istickedoff">(_,_) <- return $ (<span class="nottickedoff">"Hello"</span>,<span class="nottickedoff">"World"</span>)</span>
+<span class="lineno"> 15 </span><span class="spaces"> </span><span class="istickedoff">return <span class="nottickedoff">()</span></span>
+<span class="lineno"> 16 </span><span class="spaces"> </span><span class="istickedoff">() <- return ()</span>
+<span class="lineno"> 17 </span><span class="spaces"> </span><span class="istickedoff">t <- case <span class="nottickedoff">()</span> of</span>
+<span class="lineno"> 18 </span><span class="spaces"> </span><span class="istickedoff">_ | <span class="tickonlytrue">otherwoz</span> -> return <span class="nottickedoff">"Hello"</span></span>
+<span class="lineno"> 19 </span><span class="spaces"> </span><span class="istickedoff">_ -> <span class="nottickedoff">error "Bad Thing Happened"</span></span>
+<span class="lineno"> 20 </span><span class="spaces"> </span><span class="istickedoff">t <- case <span class="nottickedoff">()</span> of</span>
+<span class="lineno"> 21 </span><span class="spaces"> </span><span class="istickedoff">_ | <span class="tickonlytrue">otherwise</span> -> return <span class="nottickedoff">"Hello"</span></span>
+<span class="lineno"> 22 </span><span class="spaces"> </span><span class="istickedoff">_ -> <span class="nottickedoff">error "Bad Thing Happened"</span></span>
+<span class="lineno"> 23 </span><span class="spaces"> </span><span class="istickedoff">t <- case <span class="nottickedoff">()</span> of</span>
+<span class="lineno"> 24 </span><span class="spaces"> </span><span class="istickedoff">_ | <span class="tickonlytrue">otherwise</span> </span>
+<span class="lineno"> 25 </span><span class="spaces"> </span><span class="istickedoff">, <span class="tickonlyfalse">False</span> -> <span class="nottickedoff">error "Bad Thing Happened"</span></span>
+<span class="lineno"> 26 </span><span class="spaces"> </span><span class="istickedoff">_ -> return "Hello"</span>
+<span class="lineno"> 27 </span><span class="spaces"> </span><span class="istickedoff">print t</span>
+<span class="lineno"> 28 </span><span class="spaces"> </span><span class="istickedoff">print foo2</span></span>
+<span class="lineno"> 29 </span>
+<span class="lineno"> 30 </span><span class="decl"><span class="istickedoff">foo x = do</span>
+<span class="lineno"> 31 </span><span class="spaces"> </span><span class="istickedoff">print x</span>
+<span class="lineno"> 32 </span><span class="spaces"> </span><span class="istickedoff">return <span class="nottickedoff">()</span></span></span>
+<span class="lineno"> 33 </span>
+<span class="lineno"> 34 </span><span class="decl"><span class="nottickedoff">unused_ a = a</span></span>
+<span class="lineno"> 35 </span>
+<span class="lineno"> 36 </span>badCase :: Int -> Int -> Int
+<span class="lineno"> 37 </span><span class="decl"><span class="istickedoff">badCase a b = </span>
+<span class="lineno"> 38 </span><span class="spaces"> </span><span class="istickedoff">if a > 100 </span>
+<span class="lineno"> 39 </span><span class="spaces"> </span><span class="istickedoff">then error "badCase" </span>
+<span class="lineno"> 40 </span><span class="spaces"> </span><span class="istickedoff">else if <span class="tickonlyfalse">a > 1000</span> </span>
+<span class="lineno"> 41 </span><span class="spaces"> </span><span class="istickedoff">then <span class="nottickedoff">1</span> </span>
+<span class="lineno"> 42 </span><span class="spaces"> </span><span class="istickedoff">else badCase (a + 1) <span class="nottickedoff">(b - 1)</span></span></span>
+<span class="lineno"> 43 </span>
+<span class="lineno"> 44 </span>
+<span class="lineno"> 45 </span><span class="decl"><span class="istickedoff">foo2 = (1,2, if <span class="tickonlytrue">True</span> then 3 else <span class="nottickedoff">4</span>)</span></span>
+<span class="lineno"> 46 </span>
+<span class="lineno"> 47 </span><span class="decl"><span class="istickedoff">otherwoz = True</span></span>
+
+</pre>
+</body>
+</html>
+Writing: hpc_index.html
+<html><head><meta http-equiv="Content-Type" content="text/html; charset=UTF-8"><style type="text/css">table.bar { background-color: #f25913; }
+td.bar { background-color: #60de51; }
+td.invbar { background-color: #f25913; }
+table.dashboard { border-collapse: collapse ; border: solid 1px black }
+.dashboard td { border: solid 1px black }
+.dashboard th { border: solid 1px black }
+</style></head><body><table class="dashboard" width="100%" border="1"><tr><th rowspan="2"><a href="hpc_index.html">module</a></th><th colspan="3"><a href="hpc_index_fun.html">Top Level Definitions</a></th><th colspan="3"><a href="hpc_index_alt.html">Alternatives</a></th><th colspan="3"><a href="hpc_index_exp.html">Expressions</a></th></tr><tr><th>%</th><th colspan="2">covered / total</th><th>%</th><th colspan="2">covered / total</th><th>%</th><th colspan="2">covered / total</th></tr><tr><td> <code>module <a href="Main.hs.html">Main</a></code></td><td align="right">83%</td><td>5/6</td><td width="100"><table cellpadding="0" cellspacing="0" width="100%" class="bar"><tr><td><table cellpadding="0" cellspacing="0" width="83%"><tr><td height="12" class="bar"></td></tr></table></td></tr></table></td><td align="right">58%</td><td>7/12</td><td width="100"><table cellpadding="0" cellspacing="0" width="100%" class="bar"><tr><td><table cellpadding="0" cellspacing="0" width="58%"><tr><td height="12" class="bar"></td></tr></table></td></tr></table></td><td align="right">73%</td><td>73/100</td><td width="100"><table cellpadding="0" cellspacing="0" width="100%" class="bar"><tr><td><table cellpadding="0" cellspacing="0" width="73%"><tr><td height="12" class="bar"></td></tr></table></td></tr></table></td></tr><tr></tr><tr style="background: #e0e0e0"><th align="left"> Program Coverage Total</th><td align="right">83%</td><td>5/6</td><td width="100"><table cellpadding="0" cellspacing="0" width="100%" class="bar"><tr><td><table cellpadding="0" cellspacing="0" width="83%"><tr><td height="12" class="bar"></td></tr></table></td></tr></table></td><td align="right">58%</td><td>7/12</td><td width="100"><table cellpadding="0" cellspacing="0" width="100%" class="bar"><tr><td><table cellpadding="0" cellspacing="0" width="58%"><tr><td height="12" class="bar"></td></tr></table></td></tr></table></td><td align="right">73%</td><td>73/100</td><td width="100"><table cellpadding="0" cellspacing="0" width="100%" class="bar"><tr><td><table cellpadding="0" cellspacing="0" width="73%"><tr><td height="12" class="bar"></td></tr></table></td></tr></table></td></tr></table></body></html>Writing: hpc_index_fun.html
+<html><head><meta http-equiv="Content-Type" content="text/html; charset=UTF-8"><style type="text/css">table.bar { background-color: #f25913; }
+td.bar { background-color: #60de51; }
+td.invbar { background-color: #f25913; }
+table.dashboard { border-collapse: collapse ; border: solid 1px black }
+.dashboard td { border: solid 1px black }
+.dashboard th { border: solid 1px black }
+</style></head><body><table class="dashboard" width="100%" border="1"><tr><th rowspan="2"><a href="hpc_index.html">module</a></th><th colspan="3"><a href="hpc_index_fun.html">Top Level Definitions</a></th><th colspan="3"><a href="hpc_index_alt.html">Alternatives</a></th><th colspan="3"><a href="hpc_index_exp.html">Expressions</a></th></tr><tr><th>%</th><th colspan="2">covered / total</th><th>%</th><th colspan="2">covered / total</th><th>%</th><th colspan="2">covered / total</th></tr><tr><td> <code>module <a href="Main.hs.html">Main</a></code></td><td align="right">83%</td><td>5/6</td><td width="100"><table cellpadding="0" cellspacing="0" width="100%" class="bar"><tr><td><table cellpadding="0" cellspacing="0" width="83%"><tr><td height="12" class="bar"></td></tr></table></td></tr></table></td><td align="right">58%</td><td>7/12</td><td width="100"><table cellpadding="0" cellspacing="0" width="100%" class="bar"><tr><td><table cellpadding="0" cellspacing="0" width="58%"><tr><td height="12" class="bar"></td></tr></table></td></tr></table></td><td align="right">73%</td><td>73/100</td><td width="100"><table cellpadding="0" cellspacing="0" width="100%" class="bar"><tr><td><table cellpadding="0" cellspacing="0" width="73%"><tr><td height="12" class="bar"></td></tr></table></td></tr></table></td></tr><tr></tr><tr style="background: #e0e0e0"><th align="left"> Program Coverage Total</th><td align="right">83%</td><td>5/6</td><td width="100"><table cellpadding="0" cellspacing="0" width="100%" class="bar"><tr><td><table cellpadding="0" cellspacing="0" width="83%"><tr><td height="12" class="bar"></td></tr></table></td></tr></table></td><td align="right">58%</td><td>7/12</td><td width="100"><table cellpadding="0" cellspacing="0" width="100%" class="bar"><tr><td><table cellpadding="0" cellspacing="0" width="58%"><tr><td height="12" class="bar"></td></tr></table></td></tr></table></td><td align="right">73%</td><td>73/100</td><td width="100"><table cellpadding="0" cellspacing="0" width="100%" class="bar"><tr><td><table cellpadding="0" cellspacing="0" width="73%"><tr><td height="12" class="bar"></td></tr></table></td></tr></table></td></tr></table></body></html>Writing: hpc_index_alt.html
+<html><head><meta http-equiv="Content-Type" content="text/html; charset=UTF-8"><style type="text/css">table.bar { background-color: #f25913; }
+td.bar { background-color: #60de51; }
+td.invbar { background-color: #f25913; }
+table.dashboard { border-collapse: collapse ; border: solid 1px black }
+.dashboard td { border: solid 1px black }
+.dashboard th { border: solid 1px black }
+</style></head><body><table class="dashboard" width="100%" border="1"><tr><th rowspan="2"><a href="hpc_index.html">module</a></th><th colspan="3"><a href="hpc_index_fun.html">Top Level Definitions</a></th><th colspan="3"><a href="hpc_index_alt.html">Alternatives</a></th><th colspan="3"><a href="hpc_index_exp.html">Expressions</a></th></tr><tr><th>%</th><th colspan="2">covered / total</th><th>%</th><th colspan="2">covered / total</th><th>%</th><th colspan="2">covered / total</th></tr><tr><td> <code>module <a href="Main.hs.html">Main</a></code></td><td align="right">83%</td><td>5/6</td><td width="100"><table cellpadding="0" cellspacing="0" width="100%" class="bar"><tr><td><table cellpadding="0" cellspacing="0" width="83%"><tr><td height="12" class="bar"></td></tr></table></td></tr></table></td><td align="right">58%</td><td>7/12</td><td width="100"><table cellpadding="0" cellspacing="0" width="100%" class="bar"><tr><td><table cellpadding="0" cellspacing="0" width="58%"><tr><td height="12" class="bar"></td></tr></table></td></tr></table></td><td align="right">73%</td><td>73/100</td><td width="100"><table cellpadding="0" cellspacing="0" width="100%" class="bar"><tr><td><table cellpadding="0" cellspacing="0" width="73%"><tr><td height="12" class="bar"></td></tr></table></td></tr></table></td></tr><tr></tr><tr style="background: #e0e0e0"><th align="left"> Program Coverage Total</th><td align="right">83%</td><td>5/6</td><td width="100"><table cellpadding="0" cellspacing="0" width="100%" class="bar"><tr><td><table cellpadding="0" cellspacing="0" width="83%"><tr><td height="12" class="bar"></td></tr></table></td></tr></table></td><td align="right">58%</td><td>7/12</td><td width="100"><table cellpadding="0" cellspacing="0" width="100%" class="bar"><tr><td><table cellpadding="0" cellspacing="0" width="58%"><tr><td height="12" class="bar"></td></tr></table></td></tr></table></td><td align="right">73%</td><td>73/100</td><td width="100"><table cellpadding="0" cellspacing="0" width="100%" class="bar"><tr><td><table cellpadding="0" cellspacing="0" width="73%"><tr><td height="12" class="bar"></td></tr></table></td></tr></table></td></tr></table></body></html>Writing: hpc_index_exp.html
+<html><head><meta http-equiv="Content-Type" content="text/html; charset=UTF-8"><style type="text/css">table.bar { background-color: #f25913; }
+td.bar { background-color: #60de51; }
+td.invbar { background-color: #f25913; }
+table.dashboard { border-collapse: collapse ; border: solid 1px black }
+.dashboard td { border: solid 1px black }
+.dashboard th { border: solid 1px black }
+</style></head><body><table class="dashboard" width="100%" border="1"><tr><th rowspan="2"><a href="hpc_index.html">module</a></th><th colspan="3"><a href="hpc_index_fun.html">Top Level Definitions</a></th><th colspan="3"><a href="hpc_index_alt.html">Alternatives</a></th><th colspan="3"><a href="hpc_index_exp.html">Expressions</a></th></tr><tr><th>%</th><th colspan="2">covered / total</th><th>%</th><th colspan="2">covered / total</th><th>%</th><th colspan="2">covered / total</th></tr><tr><td> <code>module <a href="Main.hs.html">Main</a></code></td><td align="right">83%</td><td>5/6</td><td width="100"><table cellpadding="0" cellspacing="0" width="100%" class="bar"><tr><td><table cellpadding="0" cellspacing="0" width="83%"><tr><td height="12" class="bar"></td></tr></table></td></tr></table></td><td align="right">58%</td><td>7/12</td><td width="100"><table cellpadding="0" cellspacing="0" width="100%" class="bar"><tr><td><table cellpadding="0" cellspacing="0" width="58%"><tr><td height="12" class="bar"></td></tr></table></td></tr></table></td><td align="right">73%</td><td>73/100</td><td width="100"><table cellpadding="0" cellspacing="0" width="100%" class="bar"><tr><td><table cellpadding="0" cellspacing="0" width="73%"><tr><td height="12" class="bar"></td></tr></table></td></tr></table></td></tr><tr></tr><tr style="background: #e0e0e0"><th align="left"> Program Coverage Total</th><td align="right">83%</td><td>5/6</td><td width="100"><table cellpadding="0" cellspacing="0" width="100%" class="bar"><tr><td><table cellpadding="0" cellspacing="0" width="83%"><tr><td height="12" class="bar"></td></tr></table></td></tr></table></td><td align="right">58%</td><td>7/12</td><td width="100"><table cellpadding="0" cellspacing="0" width="100%" class="bar"><tr><td><table cellpadding="0" cellspacing="0" width="58%"><tr><td height="12" class="bar"></td></tr></table></td></tr></table></td><td align="right">73%</td><td>73/100</td><td width="100"><table cellpadding="0" cellspacing="0" width="100%" class="bar"><tr><td><table cellpadding="0" cellspacing="0" width="73%"><tr><td height="12" class="bar"></td></tr></table></td></tr></table></td></tr></table></body></html>
=====================================
testsuite/tests/hpc/function2/test.T
=====================================
@@ -14,3 +14,14 @@ test('tough2',
omit_ways(ghci_ways + prof_ways), # profile goes in the wrong place
when(arch('wasm32'), fragile(23243)) ],
multimod_compile_and_run, ['subdir/tough2.lhs', '-fhpc'])
+
+# Same as tough2, but for ghci
+test('tough3',
+ [extra_files(['../hpcrun.pl', 'subdir/']),
+ literate,
+ cmd_prefix(hpc_prefix),
+ ignore_extension,
+ extra_hc_opts('-fhpc subdir/tough2.lhs'),
+ omit_ways(ghci_ways + prof_ways), # profile goes in the wrong place
+ when(arch('wasm32'), fragile(23243)) ],
+ ghci_script, ['tough3.script'])
=====================================
testsuite/tests/hpc/function2/tough3.script
=====================================
@@ -0,0 +1,2 @@
+:main
+:quit
=====================================
testsuite/tests/hpc/ghc_ghci/Makefile
=====================================
@@ -9,7 +9,7 @@ hpc_ghc_ghci:
hpc_ghc_ghci_bytecode:
rm -f ./*.tix
- printf "main\n:quit\n" | '$(TEST_HC)' $(TEST_HC_OPTS_INTERACTIVE) -fhpc -fbyte-code-and-object-code -fprefer-byte-code BytecodeMain.hs
+ '$(TEST_HC)' $(TEST_HC_OPTS_INTERACTIVE) -fhpc -fbyte-code-and-object-code -fprefer-byte-code BytecodeMain.hs -e "main" -e ":quit"
@[ -f .hpc/Main.mix ] || (echo "ERROR: Expected .hpc/Main.mix file not found"; exit 1)
@set -- ./*.tix; [ -f "$$1" ] || (echo "ERROR: Expected .tix file not found"; exit 1); '$(HPC)' report "$$1" Main > hpc-report.txt
@grep -F "100% expressions used" hpc-report.txt >/dev/null || (echo "ERROR: Expected full expression coverage in hpc report"; cat hpc-report.txt; exit 1)
=====================================
testsuite/tests/hpc/hpcrun.pl
=====================================
@@ -4,11 +4,12 @@
while($ARGV[0] =~ /^--/) {
$arg = shift @ARGV;
+ last if ($arg eq '--');
if ($arg =~ /--hpc=(.*)/) {
$HPC = $1;
- }
+ }
elsif ($arg =~ /--clear/) {
- $CLEAR = 1;
+ $CLEAR = 1;
}
elsif ($arg =~ /--exeext=(.*)/) {
$exeext = $1;
@@ -19,8 +20,10 @@ while($ARGV[0] =~ /^--/) {
}
die "no option --hpc=* provided\n" if (!defined($HPC));
-
-$binary = $ARGV[0] . $exeext;
+
+# Skip over any KEY=VALUE env assignments to find the real executable
+my $exe = (grep { !/^\w+=/ } @ARGV)[0];
+$binary = $exe . $exeext;
# get the basename: needed for the test function/subdir/tough2
$binary =~ s/^.*\/([^\/]*)$/$1/;
@@ -38,7 +41,7 @@ while(<MARKUP>) {
my $line = $_;
print $line;
if (/Writing: (\S+.html)/) {
- system("cat $1");
+ system("cat $1");
}
}
print "\n\n";
=====================================
testsuite/tests/hpc/simple/Makefile
=====================================
@@ -2,3 +2,12 @@ TOP=../../..
include $(TOP)/mk/boilerplate.mk
include $(TOP)/mk/test.mk
+hpc002:
+ "$(TEST_HC)" $(TEST_HC_OPTS_INTERACTIVE) $(TEST_HC_ARGS) hpc002.hs -fhpc -v0 -e ":main"
+ "$(HPC)" report ghc
+ "$(HPC)" report ghc --per-module
+ LANG=ASCII "$(HPC)" markup ghc
+
+hpc003:
+ "$(TEST_HC)" $(TEST_HC_OPTS_INTERACTIVE) $(TEST_HC_ARGS) -fhpc -v0 < hpc003.script
+ "$(HPC)" report ghc || echo "Can't summarise file that is ':load'ed"
=====================================
testsuite/tests/hpc/simple/hpc002.hs
=====================================
@@ -0,0 +1 @@
+main = print (const "Hello" "World")
=====================================
testsuite/tests/hpc/simple/hpc002.stdout
=====================================
@@ -0,0 +1,23 @@
+"Hello"
+ 75% expressions used (3/4)
+100% boolean coverage (0/0)
+ 100% guards (0/0)
+ 100% 'if' conditions (0/0)
+ 100% qualifiers (0/0)
+100% alternatives used (0/0)
+100% local declarations used (0/0)
+100% top-level declarations used (1/1)
+-----<module Main>-----
+ 75% expressions used (3/4)
+100% boolean coverage (0/0)
+ 100% guards (0/0)
+ 100% 'if' conditions (0/0)
+ 100% qualifiers (0/0)
+100% alternatives used (0/0)
+100% local declarations used (0/0)
+100% top-level declarations used (1/1)
+Writing: Main.hs.html
+Writing: hpc_index.html
+Writing: hpc_index_fun.html
+Writing: hpc_index_alt.html
+Writing: hpc_index_exp.html
=====================================
testsuite/tests/hpc/simple/hpc003.hs
=====================================
@@ -0,0 +1 @@
+main = print (const "Hello" "World")
=====================================
testsuite/tests/hpc/simple/hpc003.script
=====================================
@@ -0,0 +1,2 @@
+:load hpc003.hs
+:main
=====================================
testsuite/tests/hpc/simple/hpc003.stderr
=====================================
@@ -0,0 +1,7 @@
+hpc: Uncaught exception ghc-internal:GHC.Internal.Exception.ErrorCall:
+
+can not find interactivezmsession_Main in ./.hpc
+
+HasCallStack backtrace:
+ error, called at libraries/hpc/Trace/Hpc/Mix.hs:110:15 in hpc-0.7.0.2-inplace:Trace.Hpc.Mix
+
=====================================
testsuite/tests/hpc/simple/hpc003.stdout
=====================================
@@ -0,0 +1,2 @@
+"Hello"
+Can't summarise file that is ':load'ed
=====================================
testsuite/tests/hpc/simple/test.T
=====================================
@@ -7,3 +7,16 @@ test('hpc001', [extra_files(['../hpcrun.pl']), cmd_prefix(hpc_prefix),
ignore_extension
],
compile_and_run, ['-fhpc'])
+
+test('hpc002',
+ [ when(arch('wasm32'), fragile(23243))
+ , ignore_extension
+ ],
+ makefile_test, [])
+
+test('hpc003',
+ [ when(arch('wasm32'), fragile(23243))
+ , ignore_extension
+ , extra_files(['hpc003.script'])
+ ],
+ makefile_test, [])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/dca9e69945e98dbd1452067100dadb8…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/dca9e69945e98dbd1452067100dadb8…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 12 commits: driver: recognise .dyn_o as a valid object file to link if passed on the command line.
by Marge Bot (＠marge-bot) 03 Apr '26
by Marge Bot (＠marge-bot) 03 Apr '26
03 Apr '26
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
9a1fe58d by Zubin Duggal at 2026-04-03T02:18:11-04:00
driver: recognise .dyn_o as a valid object file to link if passed on the command line.
This allows plugins compiled with this suffix to run.
Fixes #24486
- - - - -
563b2788 by Simon Jakobi at 2026-04-03T02:18:12-04:00
Add regression test for #16145
Closes #16145.
- - - - -
18c2e38d by Matthew Pickering at 2026-04-03T02:18:14-04:00
bytecode: Add magic header/version to bytecode files
In order to avoid confusing errors when using stale interface files (ie
from an older compiler version), we add a simple header/version check
like the one for interface files.
Fixes #27068
- - - - -
9211ccf1 by fendor at 2026-04-03T02:18:14-04:00
Add constants for bytecode in-memory buffer size
Introduce a common constant for the default size of the .gbc and
.bytecodelib binary buffer.
The buffer is by default set to 1 MB.
- - - - -
a5f335f6 by Duncan Coutts at 2026-04-03T02:18:14-04:00
Add a rts posix FdWakup utility module
This will be used to implement wakeupIOManager for in-RTS I/O managers.
It provides a notification/wakeup mechanism using FDs, suitable for
situations when a thread is blocked on a set of fds anyway. It uses the
classic self-pipe trick, or equivalently eventfd on supported platforms.
This will initially be used to implement prompt interrupt or shutdown of
the posix ticker thread.
- - - - -
094f22ba by Duncan Coutts at 2026-04-03T02:18:15-04:00
Add prompt shutdown to the pthread ticker implementation.
The Linux timerfd ticker monitors a pipe which is used by exitTicker to
ensure a prompt wakeup and shutdown. The pthread ticker lacked this and
so would only exit at the next ticker wakeup (10ms by default).
This patch adds the same mechanism to the pthread ticker.
This changes the pthread ticker from waiting by using nanosleep() to
waiting using either ppoll() or select(), so that it can wait on both
a time and a file descriptor. On Linux at least, a test program to
compare the timing jitter of these APIs shows that using nanpsleep,
ppoll or select makes no statistical difference to the maximum or
average jitter.
This is a step towards unifying the posix ticker implementations, so
that we can have just one portable one (albeit with some limited cpp).
It is also a step towards using the ticker as part of a more general
implementation of wakeUpRts, since this will require a method to wake
the rts from a signal handler context (ctl-c handler).
- - - - -
d2c780a3 by Duncan Coutts at 2026-04-03T02:18:15-04:00
Update ticker header commentary
It was antique and didn't apply even to the previous implementation, and
certainly not to the updated one.
- - - - -
69b6033c by Duncan Coutts at 2026-04-03T02:18:15-04:00
Remove the timerfd-based ticker implementation
There does not appear to be any remaining advantage on Linux to using
the timerfd ticker implementation over the portable one (using ppoll on
Linux for precise timing).
The eventfd implementation was originally added at a time when Linux was
still using a signal based implementation. So it made sense at the time.
See (closed) issue #10840.
- - - - -
5c32c5fb by Duncan Coutts at 2026-04-03T02:18:15-04:00
Consolidate to a single posix ticker implementation
Previously we had four implementations, two using signals and two using
threads. Having just one should make behaviour more consistent between
platforms, and should make maintenance easier.
- - - - -
c222aa0b by mangoiv at 2026-04-03T02:18:16-04:00
testsuite: filter stderr for static001 on darwin
This reactivates the test on x86_64 darwin as this should have been done
long ago and ignores warnings emitted by ranlib on newer version of the
darwin toolchain since they are benign. (no symbols for stub libraries)
Fixes #27116
- - - - -
9cdb57b6 by mangoiv at 2026-04-03T02:18:17-04:00
issue template: fix add bug label
- - - - -
ebb20c2c by Sylvain Henry at 2026-04-03T02:18:41-04:00
Add more canned GC functions for common register patterns (#27142)
Based on analysis of heap-check sites across the GHC compiler and Cabal,
the following patterns were not covered by existing canned GC functions
but occurred frequently enough to warrant specialisation:
stg_gc_ppppp -- 5 GC pointers
stg_gc_ip -- unboxed word + GC pointer
stg_gc_pi -- GC pointer + unboxed word
stg_gc_ii -- two unboxed words
stg_gc_bpp -- byte (I8) + two GC pointers
Adding these reduces the fraction of heap-check sites falling back to
the generic GC path from ~1.4% to ~0.4% when compiling GHC itself.
Co-Authored-By: Claude Sonnet 4.6 <noreply(a)anthropic.com>
- - - - -
30 changed files:
- .gitlab/issue_templates/default.md
- compiler/GHC/ByteCode/Serialize.hs
- compiler/GHC/Driver/Phases.hs
- compiler/GHC/StgToCmm/Heap.hs
- rts/HeapStackCheck.cmm
- rts/RtsSymbols.c
- rts/include/stg/MiscClosures.h
- + rts/posix/FdWakeup.c
- + rts/posix/FdWakeup.h
- rts/posix/Ticker.c
- − rts/posix/ticker/Pthread.c
- − rts/posix/ticker/TimerFd.c
- rts/rts.cabal
- testsuite/driver/testlib.py
- testsuite/tests/driver/all.T
- testsuite/tests/driver/bytecode-object/Makefile
- testsuite/tests/driver/bytecode-object/all.T
- testsuite/tests/plugins/Makefile
- + testsuite/tests/plugins/T24486-plugin/Makefile
- + testsuite/tests/plugins/T24486-plugin/Setup.hs
- + testsuite/tests/plugins/T24486-plugin/T24486-plugin.cabal
- + testsuite/tests/plugins/T24486-plugin/T24486_Plugin.hs
- + testsuite/tests/plugins/T24486.hs
- + testsuite/tests/plugins/T24486_Helper.hs
- testsuite/tests/plugins/all.T
- testsuite/tests/runghc/Makefile
- + testsuite/tests/runghc/T16145.hs
- + testsuite/tests/runghc/T16145.stdout
- + testsuite/tests/runghc/T16145_aux.hs
- testsuite/tests/runghc/all.T
Changes:
=====================================
.gitlab/issue_templates/default.md
=====================================
@@ -20,5 +20,5 @@ Optional:
* System Architecture:
-/label ~bug
+/label ~"T::bug"
/label ~"needs triage"
=====================================
compiler/GHC/ByteCode/Serialize.hs
=====================================
@@ -25,22 +25,26 @@ where
import GHC.Prelude
import GHC.ByteCode.Binary
-import GHC.ByteCode.Types
import GHC.ByteCode.Recomp.Binary (computeFingerprint)
-import GHC.Driver.Env
+import GHC.ByteCode.Types
import GHC.Driver.DynFlags
+import GHC.Driver.Env
import GHC.Iface.Binary
import GHC.Iface.Recomp.Binary (putNameLiterally)
import GHC.Linker.Types
+import GHC.Settings.Constants (hiVersion)
import GHC.Unit.Types
import GHC.Utils.Binary
-import GHC.Utils.TmpFs
-import GHC.Utils.Logger
import GHC.Utils.Fingerprint (Fingerprint)
+import GHC.Utils.Logger
+import GHC.Utils.Panic
+import GHC.Utils.TmpFs
import Data.ByteString (ByteString)
-import qualified Data.ByteString as BS
+import Data.ByteString qualified as BS
+import Data.Char (ord)
import Data.Traversable
+import Data.Word
import System.Directory
import System.FilePath
@@ -79,21 +83,35 @@ The ticket where bytecode objects were dicussed is #26298
See Note [-fwrite-byte-code is not the default]
See Note [Recompilation avoidance with bytecode objects]
+See Note [Persistent bytecode file headers]
+Note [Persistent bytecode file headers]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Persistent bytecode files (`.gbc`) and bytecode libraries (`.bytecodelib`)
+are version-specific binary formats. Without a small file-level header, stale
+or corrupt files are only discovered once we start deserialising the payload,
+which can lead to confusing failures.
+
+To make these failures explicit, we write a file-kind-specific magic word and
+the current `hiVersion` ahead of the binary payload. Readers validate this
+header before setting up the normal `Name`/`FastString` deserialisation
+machinery. This follows the same approach as normal interface files.
-}
writeBytecodeLib :: BytecodeLib -> FilePath -> IO ()
writeBytecodeLib lib path = do
odbco <- encodeBytecodeLib lib
createDirectoryIfMissing True (takeDirectory path)
- bh' <- openBinMem (1024 * 1024)
+ bh' <- openBinMem initBinMemSize
bh <- addBinNameWriter bh'
+ writePersistentBytecodeHeader BytecodeLibraryFile bh
putWithUserData QuietBinIFace NormalCompression bh odbco
writeBinMem bh path
readBytecodeLib :: HscEnv -> FilePath -> IO OnDiskBytecodeLib
readBytecodeLib hsc_env path = do
bh' <- readBinMem path
+ readPersistentBytecodeHeader BytecodeLibraryFile path bh'
bh <- addBinNameReader (hsc_NC hsc_env) bh'
res <- getWithUserData (hsc_NC hsc_env) bh
pure res
@@ -185,6 +203,7 @@ readBinByteCode hsc_env f = do
readOnDiskModuleByteCode :: HscEnv -> FilePath -> IO OnDiskModuleByteCode
readOnDiskModuleByteCode hsc_env f = do
bh' <- readBinMem f
+ readPersistentBytecodeHeader ModuleByteCodeFile f bh'
bh <- addBinNameReader (hsc_NC hsc_env) bh'
getWithUserData (hsc_NC hsc_env) bh
@@ -192,9 +211,10 @@ readOnDiskModuleByteCode hsc_env f = do
writeBinByteCode :: FilePath -> ModuleByteCode -> IO ()
writeBinByteCode f cbc = do
createDirectoryIfMissing True (takeDirectory f)
- bh' <- openBinMem (1024 * 1024)
+ bh' <- openBinMem initBinMemSize
bh <- addBinNameWriter bh'
odbco <- encodeOnDiskModuleByteCode cbc
+ writePersistentBytecodeHeader ModuleByteCodeFile bh
putWithUserData QuietBinIFace NormalCompression bh odbco
writeBinMem bh f
@@ -213,3 +233,64 @@ fingerprintModuleByteCodeContents :: Module -> CompiledByteCode -> [FilePath] ->
fingerprintModuleByteCodeContents modl cbc foreign_files = do
foreign_contents <- readObjectFiles foreign_files
pure $ computeFingerprint putNameLiterally (modl, cbc, foreign_contents)
+
+-- ----------------------------------------------------------------------------
+-- ByteCode module and library magic header.
+-- ----------------------------------------------------------------------------
+
+data PersistentBytecodeFile
+ = ModuleByteCodeFile
+ | BytecodeLibraryFile
+
+-- See Note [Persistent bytecode file headers]
+writePersistentBytecodeHeader :: PersistentBytecodeFile -> WriteBinHandle -> IO ()
+writePersistentBytecodeHeader file_kind bh = do
+ put_ bh (persistentBytecodeMagic file_kind)
+ put_ bh (show hiVersion)
+
+readPersistentBytecodeHeader :: PersistentBytecodeFile -> FilePath -> ReadBinHandle -> IO ()
+readPersistentBytecodeHeader file_kind path bh = do
+ let mismatch what expected actual =
+ throwGhcExceptionIO $ ProgramError $
+ persistentBytecodeFileDescription file_kind ++ " header mismatch in " ++ path ++
+ ": " ++ what ++ " (expected " ++ expected ++ ", got " ++ actual ++ ")"
+
+ magic <- get bh
+ let expected_magic = persistentBytecodeMagic file_kind
+ if unFixedLength magic == unFixedLength expected_magic
+ then pure ()
+ else mismatch "magic" (show $ unFixedLength expected_magic) (show $ unFixedLength magic)
+
+ version <- get bh
+ let expected_version = show hiVersion
+ if version == expected_version
+ then pure ()
+ else mismatch "version" expected_version version
+
+persistentBytecodeFileDescription :: PersistentBytecodeFile -> String
+persistentBytecodeFileDescription ModuleByteCodeFile = "bytecode file"
+persistentBytecodeFileDescription BytecodeLibraryFile = "bytecode library"
+
+persistentBytecodeMagic :: PersistentBytecodeFile -> FixedLengthEncoding Word32
+persistentBytecodeMagic file_kind =
+ case file_kind of
+ ModuleByteCodeFile -> asciiWord32 "gbc0"
+ BytecodeLibraryFile -> asciiWord32 "bcl0"
+
+-- | Encode a 4-letter word into a single Word32.
+asciiWord32 :: String -> FixedLengthEncoding Word32
+asciiWord32 [a, b, c, d] =
+ FixedLengthEncoding $
+ (fromIntegral (ord a) `shiftL` 24) .|.
+ (fromIntegral (ord b) `shiftL` 16) .|.
+ (fromIntegral (ord c) `shiftL` 8) .|.
+ fromIntegral (ord d)
+asciiWord32 _ = error "asciiWord32: expected exactly four ASCII characters"
+
+-- ----------------------------------------------------------------------------
+-- Constants and utils
+-- ----------------------------------------------------------------------------
+
+-- | Initial ram buffer to allocate for writing .gbc and .bytecodelib files.
+initBinMemSize :: Int
+initBinMemSize = 1024 * 1024 -- 1 MB
=====================================
compiler/GHC/Driver/Phases.hs
=====================================
@@ -262,7 +262,7 @@ objish_suffixes :: Platform -> [String]
-- the GHC-compiled code will run
objish_suffixes platform = case platformOS platform of
OSMinGW32 -> [ "o", "O", "obj", "OBJ" ]
- _ -> [ "o" ]
+ _ -> [ "o", "dyn_o"]
dynlib_suffixes :: Platform -> [String]
dynlib_suffixes platform = case platformOS platform of
=====================================
compiler/GHC/StgToCmm/Heap.hs
=====================================
@@ -1,3 +1,4 @@
+{-# LANGUAGE OverloadedStrings #-}
-----------------------------------------------------------------------------
--
-- Stg to C--: heap management functions
@@ -44,7 +45,7 @@ import GHC.Types.Id ( Id )
import GHC.Unit
import GHC.Platform
import GHC.Platform.Profile
-import GHC.Data.FastString( mkFastString, fsLit )
+import GHC.Data.FastString( FastString )
import GHC.Utils.Panic( sorry )
import Control.Monad (when)
@@ -125,7 +126,7 @@ allocHeapClosure rep info_ptr use_cc payload = do
-- ie 1 *before* the info-ptr word of new object.
base <- getHpRelOffset info_offset
- emitComment $ mkFastString "allocHeapClosure"
+ emitComment "allocHeapClosure"
emitSetDynHdr base info_ptr use_cc
-- Fill in the fields
@@ -460,35 +461,41 @@ genericGC checkYield code
call <- mkCall generic_gc (GC, GC) [] [] updfr_sz []
heapCheck False checkYield (call <*> mkBranch lretry) code
+-- | Predefined ("canned") GC functions
+--
+-- Functions have been added to cover 99% of the GC calls made in GHC and Cabal.
+-- See #27142.
cannedGCEntryPoint :: Platform -> [LocalReg] -> Maybe CmmExpr
-cannedGCEntryPoint platform regs
- = case map localRegType regs of
- [] -> Just (mkGcLabel "stg_gc_noregs")
- [ty]
- | isGcPtrType ty -> Just (mkGcLabel "stg_gc_unpt_r1")
- | isFloatType ty -> case width of
- W32 -> Just (mkGcLabel "stg_gc_f1")
- W64 -> Just (mkGcLabel "stg_gc_d1")
- _ -> Nothing
-
- | width == wordWidth platform -> Just (mkGcLabel "stg_gc_unbx_r1")
- | width == W64 -> Just (mkGcLabel "stg_gc_l1")
- | otherwise -> Nothing
- where
- width = typeWidth ty
- [ty1,ty2]
- | isGcPtrType ty1
- && isGcPtrType ty2 -> Just (mkGcLabel "stg_gc_pp")
- [ty1,ty2,ty3]
- | isGcPtrType ty1
- && isGcPtrType ty2
- && isGcPtrType ty3 -> Just (mkGcLabel "stg_gc_ppp")
- [ty1,ty2,ty3,ty4]
- | isGcPtrType ty1
- && isGcPtrType ty2
- && isGcPtrType ty3
- && isGcPtrType ty4 -> Just (mkGcLabel "stg_gc_pppp")
- _otherwise -> Nothing
+cannedGCEntryPoint platform regs =
+ case map localRegType regs of
+ [] -> ret "stg_gc_noregs"
+ [ty]
+ | is_gc ty -> ret "stg_gc_unpt_r1"
+ | is_f32 ty -> ret "stg_gc_f1"
+ | is_f64 ty -> ret "stg_gc_d1"
+ | is_wn ty -> ret "stg_gc_unbx_r1"
+ | is_w64 ty -> ret "stg_gc_l1"
+ [ty1,ty2]
+ | is_gc ty1 && is_gc ty2 -> ret "stg_gc_pp"
+ | is_gc ty1 && is_wn ty2 -> ret "stg_gc_pi"
+ | is_wn ty1 && is_gc ty2 -> ret "stg_gc_ip"
+ | is_wn ty1 && is_wn ty2 -> ret "stg_gc_ii"
+ [ty1,ty2,ty3]
+ | is_gc ty1 && is_gc ty2 && is_gc ty3 -> ret "stg_gc_ppp"
+ | is_w8 ty1 && is_gc ty2 && is_gc ty3 -> ret "stg_gc_bpp"
+ [ty1,ty2,ty3,ty4]
+ | is_gc ty1 && is_gc ty2 && is_gc ty3 && is_gc ty4 -> ret "stg_gc_pppp"
+ [ty1,ty2,ty3,ty4,ty5]
+ | is_gc ty1 && is_gc ty2 && is_gc ty3 && is_gc ty4 && is_gc ty5 -> ret "stg_gc_ppppp"
+ _ -> Nothing
+ where
+ ret fs = Just (mkGcLabel fs)
+ is_gc ty = isGcPtrType ty
+ is_wn ty = isBitsType ty && typeWidth ty == wordWidth platform
+ is_w8 ty = isBitsType ty && typeWidth ty == W8
+ is_w64 ty = isBitsType ty && typeWidth ty == W64
+ is_f32 ty = isFloatType ty && typeWidth ty == W32
+ is_f64 ty = isFloatType ty && typeWidth ty == W64
-- Note [stg_gc arguments]
-- ~~~~~~~~~~~~~~~~~~~~~~~
@@ -514,8 +521,8 @@ generic_gc :: CmmExpr
generic_gc = mkGcLabel "stg_gc_noregs"
-- | Create a CLabel for calling a garbage collector entry point
-mkGcLabel :: String -> CmmExpr
-mkGcLabel s = CmmLit (CmmLabel (mkCmmCodeLabel rtsUnitId (fsLit s)))
+mkGcLabel :: FastString -> CmmExpr
+mkGcLabel s = CmmLit (CmmLabel (mkCmmCodeLabel rtsUnitId s))
-------------------------------
heapCheck :: Bool -> Bool -> CmmAGraph -> FCode a -> FCode a
=====================================
rts/HeapStackCheck.cmm
=====================================
@@ -373,8 +373,6 @@ stg_gc_l1 return (L_ l)
jump stg_gc_noregs (stg_ret_l_info, l) ();
}
-/*-- Unboxed tuples with multiple pointers -------------------------------- */
-
stg_gc_pp return (P_ arg1, P_ arg2)
{
call stg_gc_noregs();
@@ -393,6 +391,36 @@ stg_gc_pppp return (P_ arg1, P_ arg2, P_ arg3, P_ arg4)
return (arg1,arg2,arg3,arg4);
}
+stg_gc_ppppp return (P_ arg1, P_ arg2, P_ arg3, P_ arg4, P_ arg5)
+{
+ call stg_gc_noregs();
+ return (arg1,arg2,arg3,arg4,arg5);
+}
+
+stg_gc_ip return (W_ arg1, P_ arg2)
+{
+ call stg_gc_noregs();
+ return (arg1,arg2);
+}
+
+stg_gc_pi return (P_ arg1, W_ arg2)
+{
+ call stg_gc_noregs();
+ return (arg1,arg2);
+}
+
+stg_gc_ii return (W_ arg1, W_ arg2)
+{
+ call stg_gc_noregs();
+ return (arg1,arg2);
+}
+
+stg_gc_bpp return (I8 arg1, P_ arg2, P_ arg3)
+{
+ call stg_gc_noregs();
+ return (arg1,arg2,arg3);
+}
+
/* -----------------------------------------------------------------------------
Generic function entry heap check code.
=====================================
rts/RtsSymbols.c
=====================================
@@ -499,6 +499,11 @@ extern char **environ;
SymI_HasDataProto(stg_gc_pp) \
SymI_HasDataProto(stg_gc_ppp) \
SymI_HasDataProto(stg_gc_pppp) \
+ SymI_HasDataProto(stg_gc_ppppp) \
+ SymI_HasDataProto(stg_gc_ip) \
+ SymI_HasDataProto(stg_gc_pi) \
+ SymI_HasDataProto(stg_gc_ii) \
+ SymI_HasDataProto(stg_gc_bpp) \
SymI_HasDataProto(__stg_gc_fun) \
SymI_HasDataProto(stg_gc_fun_info) \
SymI_HasDataProto(stg_yield_noregs) \
=====================================
rts/include/stg/MiscClosures.h
=====================================
@@ -361,6 +361,11 @@ RTS_FUN_DECL(stg_gc_l1);
RTS_FUN_DECL(stg_gc_pp);
RTS_FUN_DECL(stg_gc_ppp);
RTS_FUN_DECL(stg_gc_pppp);
+RTS_FUN_DECL(stg_gc_ppppp);
+RTS_FUN_DECL(stg_gc_ip);
+RTS_FUN_DECL(stg_gc_pi);
+RTS_FUN_DECL(stg_gc_ii);
+RTS_FUN_DECL(stg_gc_bpp);
RTS_RET(stg_gc_fun);
RTS_FUN_DECL(__stg_gc_fun);
=====================================
rts/posix/FdWakeup.c
=====================================
@@ -0,0 +1,141 @@
+/* -----------------------------------------------------------------------------
+ *
+ * (c) The GHC Team 2025
+ *
+ * Utilities for a simple fd-based cross-thread wakeup mechanism.
+ *
+ * This is used to provide a mechanism to wake a thread when it is blocked
+ * waiting on fds and timeouts. The mechanism works by including the read end
+ * fd into the set of fds the thread waits on, and when a wake up is needed,
+ * the write end fd is used.
+ *
+ * This is implemented using either eventfd() or pipe().
+ *
+ * Linux 2.6.22+ and FreeBSD 13+ support eventfd. It is a single fd with a
+ * 64bit counter. It uses fewer resources than a pipe (less memory and one
+ * rather than two fds), and is a tad faster (on the order of 5-10%). Using
+ * write() adds to the counter, while read() reads and resets it. Thus
+ * multiple writes are combined automatically into a single corresponding
+ * read.
+ *
+ * Otherwise we use a classic unix pipe.
+ *
+ * In both implementations, multiple sendFdWakeup notifcations (without
+ * interleaved collectFdWakeup) are combined to a single notification. This
+ * is automatic given the semantics of eventfd, while for pipe we implement
+ * it explicitly by draining the pipe in collectFdWakeup.
+ *
+ * -------------------------------------------------------------------------*/
+
+#include "rts/PosixSource.h"
+#include "Rts.h"
+
+#include "FdWakeup.h"
+
+#include <fcntl.h>
+#include <unistd.h>
+
+#ifdef HAVE_SYS_EVENTFD_H
+#include <sys/eventfd.h>
+#endif
+
+#if !defined(HAVE_EVENTFD) \
+ || (defined(HAVE_EVENTFD) && !(defined(EFD_CLOEXEC) && defined(EFD_NONBLOCK)))
+static void fcntl_CLOEXEC_NONBLOCK(int fd)
+{
+ int res1 = fcntl(fd, F_SETFD, FD_CLOEXEC);
+ int res2 = fcntl(fd, F_SETFL, O_NONBLOCK);
+ if (RTS_UNLIKELY(res1 < 0 || res2 < 0)) {
+ sysErrorBelch("newFdWakeup fcntl()");
+ stg_exit(EXIT_FAILURE);
+ }
+}
+#endif
+
+void newFdWakeup(int *wakeup_fd_r, int *wakeup_fd_w)
+{
+#if defined(HAVE_EVENTFD)
+ int wakeup_fd;
+#if defined(EFD_CLOEXEC) && defined(EFD_NONBLOCK)
+ wakeup_fd = eventfd(0, EFD_CLOEXEC | EFD_NONBLOCK);
+#else
+ wakeup_fd = eventfd(0, 0);
+ if (wakeup_fd >= 0) fcntl_CLOEXEC_NONBLOCK(wakeup_fd);
+#endif
+ if (RTS_UNLIKELY(wakeup_fd < 0)) {
+ sysErrorBelch("newFdWakeup eventfd()");
+ stg_exit(EXIT_FAILURE);
+ }
+ /* eventfd uses the same fd for each end */
+ *wakeup_fd_r = wakeup_fd;
+ *wakeup_fd_w = wakeup_fd;
+#else
+ int pipefd[2];
+ int res;
+ res = pipe(pipefd);
+ if (RTS_UNLIKELY(res < 0)) {
+ sysErrorBelch("newFdWakeup pipe");
+ stg_exit(EXIT_FAILURE);
+ }
+ fcntl_CLOEXEC_NONBLOCK(pipefd[0]);
+ fcntl_CLOEXEC_NONBLOCK(pipefd[1]);
+ *wakeup_fd_r = pipefd[0]; /* read end */
+ *wakeup_fd_w = pipefd[1]; /* write end */
+#endif
+}
+
+void closeFdWakeup(int wakeup_fd_r, int wakeup_fd_w)
+{
+#if defined(HAVE_EVENTFD)
+ ASSERT(wakeup_fd_r == wakeup_fd_w);
+ close(wakeup_fd_r);
+#else
+ ASSERT(wakeup_fd_r != wakeup_fd_w);
+ close(wakeup_fd_r);
+ close(wakeup_fd_w);
+#endif
+}
+
+/* This is safe to use from a signal handler. Using write() to a pipe
+ * or eventfd is fine. */
+void sendFdWakeup(int wakeup_fd_w)
+{
+ int res;
+#if defined(HAVE_EVENTFD)
+ uint64_t val = 1;
+ res = write(wakeup_fd_w, &val, 8);
+#else
+ unsigned char buf = 1;
+ res = write(wakeup_fd_w, &buf, 1);
+#endif
+ if (RTS_UNLIKELY(res < 0)) {
+ /* Unlikely the pipe buffer will fill, but it would not be an error. */
+ if (errno == EAGAIN) return;
+ sysErrorBelch("sendFdWakeup write");
+ stg_exit(EXIT_FAILURE);
+ }
+}
+
+void collectFdWakeup(int wakeup_fd_r)
+{
+ int res;
+#if defined(HAVE_EVENTFD)
+ uint64_t buf;
+ /* eventfd combines events into one counter, so a single read is enough */
+ res = read(wakeup_fd_r, &buf, 8);
+#else
+ /* Drain the pipe buffer. Multiple wakeup notifications could
+ * have been sent before we have a chance to collect them.
+ */
+ uint64_t buf;
+ do {
+ res = read(wakeup_fd_r, &buf, 8);
+ } while (res == 8);
+#endif
+ if (RTS_UNLIKELY(res < 0)) {
+ /* After the first pipe read, it could block */
+ if (errno == EAGAIN) return;
+ sysErrorBelch("collectFdWakeup read");
+ stg_exit(EXIT_FAILURE);
+ }
+}
=====================================
rts/posix/FdWakeup.h
=====================================
@@ -0,0 +1,40 @@
+/* -----------------------------------------------------------------------------
+ *
+ * (c) The GHC Team 2025
+ *
+ * Utilities for a simple fd-based cross-thread wakeup mechanism.
+ *
+ * It provides a mechanism for a thread that block on fds to add a simple
+ * wakeup/notification feature.
+ *
+ * Start with newFdWakeup, and pass the fd_r to the thread that needs the
+ * wakeup feature. The thread that needs to be woken should include the fd_r
+ * into the set of fds that the thread waits on (e.g. using poll or similar).
+ * If this fd becomes ready for read, the thread must call collectFdWakeup,
+ * and when a wake up is needed, the write end fd is used. In any other thread
+ * (or in a signal handler), call sendFdWakeup(fd_w) to (asynchronously) cause
+ * the wakeup.
+ *
+ * There is no message payload. Multiple wakeups may be combined (if they're
+ * sent multiple times before the notified thread can wake and call
+ * collectFdWakeup).
+ *
+ * The implementation uses pipe() or eventfd() on supported OSs.
+ *
+ * Prototypes for functions in FdWakeup.c
+ *
+ * -------------------------------------------------------------------------*/
+
+#pragma once
+
+#include "BeginPrivate.h"
+
+void newFdWakeup(int *fd_r, int *fd_w);
+void closeFdWakeup(int fd_r, int fd_w);
+
+/* This is safe to use from a signal handler */
+void sendFdWakeup(int fd_w);
+void collectFdWakeup(int fd_r);
+
+#include "EndPrivate.h"
+
=====================================
rts/posix/Ticker.c
=====================================
@@ -1,19 +1,53 @@
/* -----------------------------------------------------------------------------
*
- * (c) The GHC Team, 1995-2007
+ * (c) The GHC Team, 1995-2026
*
- * Posix implementation(s) of the interval timer for profiling and pre-emptive
- * scheduling.
+ * The posix implementation of the interval timer, used for pre-emptive
+ * scheduling of Haskell threads, and for sample based profiling.
+ *
+ * This file defines the "ticker": the platform-specific service to install and
+ * run the timer. See rts/Timer.c for the platform-dependent view of interval
+ * timing.
*
* ---------------------------------------------------------------------------*/
-/* The interval timer is used for profiling and for context switching.
- * This file defines the platform-specific services to install and run the
- * timers, and we call this the ticker. See rts/Timer.c for the
- * platform-dependent view of interval timing.
+/* This implementation uses a posix thread which repeatedly blocks on a timeout
+ * using either the ppoll() or select() API. This lets it also block on a file
+ * descriptor for early wakeup.
+ *
+ * The design uses a simple relative time delay with no catchup. That is, time
+ * spent by the ticker thread itself (e.g. flushing eventlog buffers) is not
+ * accounted for, and the next tick is delayed by that much (modulo wakeup
+ * jitter). This is probably the right thing to do: generally in realtime
+ * systems one does not want to try to catch up when behind, since that tends
+ * towards oversubscribing resources. Graceful degredation is usually
+ * preferable.
+ *
+ * Experimental results (on Linux 6.18 on x86-64) to measure the typical
+ * difference between the requested wakeup time and actual wakeup time for
+ * different delay intervals:
+ *
+ * interval typical actual wakeup time after due time
+ * 10000us 340 -- 400us (this is the default interval)
+ * 1000us 55 -- 100us
+ * 100us 55us
+ * 10us 55us
+ *
+ * While there's quite a bit of variance to these numbers, the results do not
+ * vary significantly between using select, ppoll or nanosleep.
+ *
+ * On Linux at least, for longer delays the kernel allows itself lower wakeup
+ * accuracy (which allows it to save power by coalescing multiple wakeups).
+ * Similarly, the reason for 55us on the low end is that the default thread
+ * timer slack on Linux is 50us, and context switch time accounts for the
+ * remainder.
+ *
+ * In conclusion, on Linux at least, the accuracy is fine, both for the
+ * default interval (10ms, 10000us) and for shorter intervals used during
+ * profiling.
*
* Historically we had ticker implementations using signals. This was always a
- * rather shakey thing to do but we had few alternatives.
+ * rather shakey thing to do but we originally had few alternatives.
* - One problem with using signals is that there are severe limits on what
* code can be called from signal handlers. In particular it's not possible
* to take locks in a signal handler contex. This was enough for contex
@@ -23,17 +57,245 @@
* calls (#10840) or can be overwritten by user code.
*/
-/* Select a ticker implementation to use:
- *
- * On modern Linux, FreeBSD and NetBSD we can use timerfd_create and a thread
- * that waits on it using poll. Linux has had timerfd since version 2.6.25.
- * NetBSD has had timerfd since version 10, and FreeBSD since version 15.
- *
- * For older version of linux/bsd without timerfd, and for all other posix
- * platforms, we use the implementation using posix pthreads and nanosleep().
+#include "rts/PosixSource.h"
+#include "Rts.h"
+
+#include "Ticker.h"
+#include "RtsUtils.h"
+#include "Proftimer.h"
+#include "Schedule.h"
+#include "posix/Clock.h"
+#include "posix/FdWakeup.h"
+
+#if defined(HAVE_DECL_PPOLL) && HAVE_DECL_PPOLL == 1
+/* We prefer the ppoll() function if available since it allows sanely waiting
+ * on a single fd with precise timeouts (nanosecond precision). It is not in
+ * the posix standard however and some platforms (notably glibc and freebsd)
+ * need special CPP defines to make it available:
+ */
+#define _GNU_SOURCE 1
+#define __BSD_VISIBLE 1
+#include <signal.h>
+#include <poll.h>
+#else
+/* Otherwise we use the classic select(), which does have microsecond
+ * precision, but requires we build three whole 1024 bit (128 byte) fd sets
+ * just to wait on one fd.
*/
-#if defined(HAVE_SYS_TIMERFD_H)
-#include "ticker/TimerFd.c"
+#include <sys/select.h>
+#endif
+
+#include <time.h>
+#if HAVE_SYS_TIME_H
+# include <sys/time.h>
+#endif
+
+#if defined(HAVE_SIGNAL_H)
+# include <signal.h>
+#endif
+
+#include <string.h>
+
+#include <pthread.h>
+#if defined(HAVE_PTHREAD_NP_H)
+#include <pthread_np.h>
+#endif
+#include <unistd.h>
+#include <fcntl.h>
+
+static Time itimer_interval = DEFAULT_TICK_INTERVAL;
+
+// Should we be firing ticks?
+// Writers to this must hold the mutex below.
+static bool stopped = false;
+
+// should the ticker thread exit?
+// This can be set without holding the mutex.
+static bool exited = true;
+
+// Signaled when we want to (re)start the timer
+static Condition start_cond;
+static Mutex mutex;
+static OSThreadId thread;
+
+// fds for interrupting the ticker
+static int interruptfd_r = -1, interruptfd_w = -1;
+
+static void *itimer_thread_func(void *_handle_tick)
+{
+ TickProc handle_tick = _handle_tick;
+
+#if defined(HAVE_DECL_PPOLL) && HAVE_DECL_PPOLL == 1
+ struct pollfd pollfds[1];
+
+ pollfds[0].fd = interruptfd_r;
+ pollfds[0].events = POLLIN;
+
+ struct timespec ts = { .tv_sec = TimeToSeconds(itimer_interval)
+ , .tv_nsec = TimeToNS(itimer_interval) % 1000000000
+ };
#else
-#include "ticker/Pthread.c"
+ fd_set selectfds;
+ FD_ZERO(&selectfds);
+ FD_SET(interruptfd_r, &selectfds);
+
+ struct timeval tv = { .tv_sec = TimeToSeconds(itimer_interval)
+ /* convert remainder time in nanoseconds
+ to microseconds, rounding up: */
+ , .tv_usec = ((TimeToNS(itimer_interval) % 1000000000)
+ + 999) / 1000
+ };
+#endif
+
+ // Relaxed is sufficient: If we don't see that exited was set in one iteration we will
+ // see it next time.
+ while (!RELAXED_LOAD_ALWAYS(&exited)) {
+
+#if defined(HAVE_DECL_PPOLL) && HAVE_DECL_PPOLL == 1
+ int nfds = 1;
+ int nready = ppoll(pollfds, nfds, &ts, NULL);
+#else
+ struct timeval tv_tmp = tv; // copy since select may change this value.
+ int nfds = interruptfd_r+1;
+ int nready = select(nfds, &selectfds, NULL, NULL, &tv_tmp);
+#endif
+ // In either case (ppoll or select), the result nready is the number
+ // of fds that are ready.
+ if (RTS_LIKELY(nready == 0)) {
+ // Timer expired, not interrupted, continue.
+ } else if (nready > 0) {
+ // We only monitor one fd (the interruptfd_r), so we know
+ // it is that fd that is ready without any further checks.
+ collectFdWakeup(interruptfd_r);
+ // No further action needed, continue on to handling the final tick
+ // and then stop.
+
+ // Note that we rely on sendFdWakeup and select/poll to provide the
+ // happens-before relation. So if 'exited' was set before calling
+ // sendFdWakeup, then we should be able to reliably read it after.
+ // And thus reading 'exited' in the while loop guard is ok.
+ } else {
+ // While the RTS attempts to mask signals, some foreign libraries
+ // that rely on signal delivery may unmask them. Consequently we
+ // may see EINTR. See #24610.
+ if (errno != EINTR) {
+ sysErrorBelch("Ticker: poll failed: %s", strerror(errno));
+ }
+ }
+
+ // first try a cheap test
+ if (RELAXED_LOAD_ALWAYS(&stopped)) {
+ OS_ACQUIRE_LOCK(&mutex);
+ // should we really stop?
+ if (stopped) {
+ waitCondition(&start_cond, &mutex);
+ }
+ OS_RELEASE_LOCK(&mutex);
+ } else {
+ handle_tick(0);
+ }
+ }
+
+ return NULL;
+}
+
+void
+initTicker (Time interval, TickProc handle_tick)
+{
+ itimer_interval = interval;
+ stopped = true;
+ exited = false;
+#if defined(HAVE_SIGNAL_H)
+ sigset_t mask, omask;
+ int sigret;
+#endif
+ int ret;
+
+ initCondition(&start_cond);
+ initMutex(&mutex);
+
+ /* Open the interrupt fd synchronously.
+ *
+ * We used to do it in itimer_thread_func (i.e. in the timer thread) but it
+ * meant that some user code could run before it and get confused by the
+ * allocation of the timerfd.
+ *
+ * See hClose002 which unsafely closes a file descriptor twice expecting an
+ * exception the second time: it sometimes failed when the second call to
+ * "close" closed our own timerfd which inadvertently reused the same file
+ * descriptor closed by the first call! (see #20618)
+ */
+
+ if (interruptfd_r != -1) {
+ // don't leak the old file descriptors after a fork (#25280)
+ closeFdWakeup(interruptfd_r, interruptfd_w);
+ }
+ newFdWakeup(&interruptfd_r, &interruptfd_w);
+
+ /*
+ * Create the thread with all blockable signals blocked, leaving signal
+ * handling to the main and/or other threads. This is especially useful in
+ * the non-threaded runtime, where applications might expect sigprocmask(2)
+ * to effectively block signals.
+ */
+#if defined(HAVE_SIGNAL_H)
+ sigfillset(&mask);
+ sigret = pthread_sigmask(SIG_SETMASK, &mask, &omask);
+#endif
+ ret = createAttachedOSThread(&thread, "ghc_ticker", itimer_thread_func, (void*)handle_tick);
+#if defined(HAVE_SIGNAL_H)
+ if (sigret == 0)
+ pthread_sigmask(SIG_SETMASK, &omask, NULL);
#endif
+
+ if (ret != 0) {
+ barf("Ticker: Failed to spawn thread: %s", strerror(errno));
+ }
+}
+
+void
+startTicker(void)
+{
+ OS_ACQUIRE_LOCK(&mutex);
+ RELAXED_STORE(&stopped, false);
+ signalCondition(&start_cond);
+ OS_RELEASE_LOCK(&mutex);
+}
+
+/* There may be at most one additional tick fired after a call to this */
+void
+stopTicker(void)
+{
+ OS_ACQUIRE_LOCK(&mutex);
+ RELAXED_STORE(&stopped, true);
+ OS_RELEASE_LOCK(&mutex);
+}
+
+/* There may be at most one additional tick fired after a call to this */
+void
+exitTicker (bool wait)
+{
+ ASSERT(!SEQ_CST_LOAD(&exited));
+ SEQ_CST_STORE(&exited, true);
+ // ensure that ticker wakes up if stopped
+ startTicker();
+ sendFdWakeup(interruptfd_w);
+
+ // wait for ticker to terminate if necessary
+ if (wait) {
+ if (pthread_join(thread, NULL)) {
+ sysErrorBelch("Ticker: Failed to join: %s", strerror(errno));
+ }
+ closeFdWakeup(interruptfd_r, interruptfd_w);
+ closeMutex(&mutex);
+ closeCondition(&start_cond);
+ } else {
+ pthread_detach(thread);
+ }
+}
+
+int
+rtsTimerSignal(void)
+{
+ return SIGALRM;
+}
=====================================
rts/posix/ticker/Pthread.c deleted
=====================================
@@ -1,195 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team, 1995-2007
- *
- * Interval timer for profiling and pre-emptive scheduling.
- *
- * ---------------------------------------------------------------------------*/
-
-/*
- * We use a realtime timer by default. I found this much more
- * reliable than a CPU timer:
- *
- * Experiments with different frequencies: using
- * CLOCK_REALTIME/CLOCK_MONOTONIC on Linux 2.6.32,
- * 1000us has <1% impact on runtime
- * 100us has ~2% impact on runtime
- * 10us has ~40% impact on runtime
- *
- * using CLOCK_PROCESS_CPUTIME_ID on Linux 2.6.32,
- * I cannot get it to tick faster than 10ms (10000us)
- * which isn't great for profiling.
- *
- * In the threaded RTS, we can't tick in CPU time because the thread
- * which has the virtual timer might be idle, so the tick would never
- * fire. Therefore we used to tick in realtime in the threaded RTS and
- * in CPU time otherwise, but now we always tick in realtime, for
- * several reasons:
- *
- * - resolution (see above)
- * - consistency (-threaded is the same as normal)
- * - more consistency: Windows only has a realtime timer
- *
- * Note we want to use CLOCK_MONOTONIC rather than CLOCK_REALTIME,
- * because the latter may jump around (NTP adjustments, leap seconds
- * etc.).
- */
-
-#include "rts/PosixSource.h"
-#include "Rts.h"
-
-#include "Ticker.h"
-#include "RtsUtils.h"
-#include "Proftimer.h"
-#include "Schedule.h"
-#include "posix/Clock.h"
-#include <poll.h>
-
-#include <time.h>
-#if HAVE_SYS_TIME_H
-# include <sys/time.h>
-#endif
-
-#if defined(HAVE_SIGNAL_H)
-# include <signal.h>
-#endif
-
-#include <string.h>
-
-#include <pthread.h>
-#if defined(HAVE_PTHREAD_NP_H)
-#include <pthread_np.h>
-#endif
-#include <unistd.h>
-#include <fcntl.h>
-
-/*
- * TFD_CLOEXEC has been added in Linux 2.6.26.
- * If it is not available, we use fcntl(F_SETFD).
- */
-#if !defined(TFD_CLOEXEC)
-#define TFD_CLOEXEC 0
-#endif
-
-static Time itimer_interval = DEFAULT_TICK_INTERVAL;
-
-// Should we be firing ticks?
-// Writers to this must hold the mutex below.
-static bool stopped = false;
-
-// should the ticker thread exit?
-// This can be set without holding the mutex.
-static bool exited = true;
-
-// Signaled when we want to (re)start the timer
-static Condition start_cond;
-static Mutex mutex;
-static OSThreadId thread;
-
-static void *itimer_thread_func(void *_handle_tick)
-{
- TickProc handle_tick = _handle_tick;
-
- // Relaxed is sufficient: If we don't see that exited was set in one iteration we will
- // see it next time.
- while (!RELAXED_LOAD_ALWAYS(&exited)) {
- if (rtsSleep(itimer_interval) != 0) {
- sysErrorBelch("Ticker: sleep failed: %s", strerror(errno));
- }
-
- // first try a cheap test
- if (RELAXED_LOAD_ALWAYS(&stopped)) {
- OS_ACQUIRE_LOCK(&mutex);
- // should we really stop?
- if (stopped) {
- waitCondition(&start_cond, &mutex);
- }
- OS_RELEASE_LOCK(&mutex);
- } else {
- handle_tick(0);
- }
- }
-
- return NULL;
-}
-
-void
-initTicker (Time interval, TickProc handle_tick)
-{
- itimer_interval = interval;
- stopped = true;
- exited = false;
-#if defined(HAVE_SIGNAL_H)
- sigset_t mask, omask;
- int sigret;
-#endif
- int ret;
-
- initCondition(&start_cond);
- initMutex(&mutex);
-
- /*
- * Create the thread with all blockable signals blocked, leaving signal
- * handling to the main and/or other threads. This is especially useful in
- * the non-threaded runtime, where applications might expect sigprocmask(2)
- * to effectively block signals.
- */
-#if defined(HAVE_SIGNAL_H)
- sigfillset(&mask);
- sigret = pthread_sigmask(SIG_SETMASK, &mask, &omask);
-#endif
- ret = createAttachedOSThread(&thread, "ghc_ticker", itimer_thread_func, (void*)handle_tick);
-#if defined(HAVE_SIGNAL_H)
- if (sigret == 0)
- pthread_sigmask(SIG_SETMASK, &omask, NULL);
-#endif
-
- if (ret != 0) {
- barf("Ticker: Failed to spawn thread: %s", strerror(errno));
- }
-}
-
-void
-startTicker(void)
-{
- OS_ACQUIRE_LOCK(&mutex);
- RELAXED_STORE(&stopped, false);
- signalCondition(&start_cond);
- OS_RELEASE_LOCK(&mutex);
-}
-
-/* There may be at most one additional tick fired after a call to this */
-void
-stopTicker(void)
-{
- OS_ACQUIRE_LOCK(&mutex);
- RELAXED_STORE(&stopped, true);
- OS_RELEASE_LOCK(&mutex);
-}
-
-/* There may be at most one additional tick fired after a call to this */
-void
-exitTicker (bool wait)
-{
- ASSERT(!SEQ_CST_LOAD(&exited));
- SEQ_CST_STORE(&exited, true);
- // ensure that ticker wakes up if stopped
- startTicker();
-
- // wait for ticker to terminate if necessary
- if (wait) {
- if (pthread_join(thread, NULL)) {
- sysErrorBelch("Ticker: Failed to join: %s", strerror(errno));
- }
- closeMutex(&mutex);
- closeCondition(&start_cond);
- } else {
- pthread_detach(thread);
- }
-}
-
-int
-rtsTimerSignal(void)
-{
- return SIGALRM;
-}
=====================================
rts/posix/ticker/TimerFd.c deleted
=====================================
@@ -1,291 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team, 1995-2023
- *
- * Interval timer for profiling and pre-emptive scheduling.
- *
- * ---------------------------------------------------------------------------*/
-
-/*
- * We use a realtime timer by default. I found this much more
- * reliable than a CPU timer:
- *
- * Experiments with different frequencies: using
- * CLOCK_REALTIME/CLOCK_MONOTONIC on Linux 2.6.32,
- * 1000us has <1% impact on runtime
- * 100us has ~2% impact on runtime
- * 10us has ~40% impact on runtime
- *
- * using CLOCK_PROCESS_CPUTIME_ID on Linux 2.6.32,
- * I cannot get it to tick faster than 10ms (10000us)
- * which isn't great for profiling.
- *
- * In the threaded RTS, we can't tick in CPU time because the thread
- * which has the virtual timer might be idle, so the tick would never
- * fire. Therefore we used to tick in realtime in the threaded RTS and
- * in CPU time otherwise, but now we always tick in realtime, for
- * several reasons:
- *
- * - resolution (see above)
- * - consistency (-threaded is the same as normal)
- * - more consistency: Windows only has a realtime timer
- *
- * Note we want to use CLOCK_MONOTONIC rather than CLOCK_REALTIME,
- * because the latter may jump around (NTP adjustments, leap seconds
- * etc.).
- */
-
-#include "rts/PosixSource.h"
-#include "Rts.h"
-
-#include "Ticker.h"
-#include "RtsUtils.h"
-#include "Proftimer.h"
-#include "Schedule.h"
-#include "posix/Clock.h"
-#include <poll.h>
-
-#include <time.h>
-#if HAVE_SYS_TIME_H
-# include <sys/time.h>
-#endif
-
-#if defined(HAVE_SIGNAL_H)
-# include <signal.h>
-#endif
-
-#include <string.h>
-
-#include <pthread.h>
-#if defined(HAVE_PTHREAD_NP_H)
-#include <pthread_np.h>
-#endif
-#include <unistd.h>
-#include <fcntl.h>
-
-#include <sys/timerfd.h>
-
-
-/*
- * TFD_CLOEXEC has been added in Linux 2.6.26.
- * If it is not available, we use fcntl(F_SETFD).
- */
-#if !defined(TFD_CLOEXEC)
-#define TFD_CLOEXEC 0
-#endif
-
-static Time itimer_interval = DEFAULT_TICK_INTERVAL;
-
-// Should we be firing ticks?
-// Writers to this must hold the mutex below.
-static bool stopped = false;
-
-// should the ticker thread exit?
-// This can be set without holding the mutex.
-static bool exited = true;
-
-// Signaled when we want to (re)start the timer
-static Condition start_cond;
-static Mutex mutex;
-static OSThreadId thread;
-
-// file descriptor for the timer (Linux only)
-static int timerfd = -1;
-
-// pipe for signaling exit
-static int pipefds[2];
-
-static void *itimer_thread_func(void *_handle_tick)
-{
- TickProc handle_tick = _handle_tick;
- uint64_t nticks;
- ssize_t r = 0;
- struct pollfd pollfds[2];
-
- pollfds[0].fd = pipefds[0];
- pollfds[0].events = POLLIN;
- pollfds[1].fd = timerfd;
- pollfds[1].events = POLLIN;
-
- // Relaxed is sufficient: If we don't see that exited was set in one iteration we will
- // see it next time.
- while (!RELAXED_LOAD_ALWAYS(&exited)) {
- if (poll(pollfds, 2, -1) == -1) {
- // While the RTS attempts to mask signals, some foreign libraries
- // may rely on signal delivery may unmask them. Consequently we may
- // see EINTR. See #24610.
- if (errno != EINTR) {
- sysErrorBelch("Ticker: poll failed: %s", strerror(errno));
- }
- }
-
- // We check the pipe first, even though the timerfd may also have triggered.
- if (pollfds[0].revents & POLLIN) {
- // the pipe is ready for reading, the only possible reason is that we're exiting
- exited = true; // set this again to make sure even RELAXED_LOAD will read the proper value
- // no further action needed, skip ahead to handling the final tick and then stopping
- }
- else if (pollfds[1].revents & POLLIN) { // the timerfd is ready for reading
- r = read(timerfd, &nticks, sizeof(nticks)); // this should never block now
-
- if ((r == 0) && (errno == 0)) {
- /* r == 0 is expected only for non-blocking fd (in which case
- * errno should be EAGAIN) but we use a blocking fd.
- *
- * Due to a kernel bug (cf https://lkml.org/lkml/2019/8/16/335)
- * on some platforms we could see r == 0 and errno == 0.
- */
- IF_DEBUG(scheduler, debugBelch("read(timerfd) returned 0 with errno=0. This is a known kernel bug. We just ignore it."));
- }
- else if (r != sizeof(nticks) && errno != EINTR) {
- barf("Ticker: read(timerfd) failed with %s and returned %zd", strerror(errno), r);
- }
- }
-
- // first try a cheap test
- if (RELAXED_LOAD_ALWAYS(&stopped)) {
- OS_ACQUIRE_LOCK(&mutex);
- // should we really stop?
- if (stopped) {
- waitCondition(&start_cond, &mutex);
- }
- OS_RELEASE_LOCK(&mutex);
- } else {
- handle_tick(0);
- }
- }
-
- close(timerfd);
- return NULL;
-}
-
-void
-initTicker (Time interval, TickProc handle_tick)
-{
- itimer_interval = interval;
- stopped = true;
- exited = false;
-#if defined(HAVE_SIGNAL_H)
- sigset_t mask, omask;
- int sigret;
-#endif
- int ret;
-
- initCondition(&start_cond);
- initMutex(&mutex);
-
- /* Open the file descriptor for the timer synchronously.
- *
- * We used to do it in itimer_thread_func (i.e. in the timer thread) but it
- * meant that some user code could run before it and get confused by the
- * allocation of the timerfd.
- *
- * See hClose002 which unsafely closes a file descriptor twice expecting an
- * exception the second time: it sometimes failed when the second call to
- * "close" closed our own timerfd which inadvertently reused the same file
- * descriptor closed by the first call! (see #20618)
- */
- struct itimerspec it;
- it.it_value.tv_sec = TimeToSeconds(itimer_interval);
- it.it_value.tv_nsec = TimeToNS(itimer_interval) % 1000000000;
- it.it_interval = it.it_value;
-
- if (timerfd != -1) {
- // don't leak the old file descriptors after a fork (#25280)
- close(timerfd);
- close(pipefds[0]);
- close(pipefds[1]);
- timerfd = -1;
- }
-
- timerfd = timerfd_create(CLOCK_MONOTONIC, TFD_CLOEXEC);
- if (timerfd == -1) {
- barf("timerfd_create: %s", strerror(errno));
- }
- if (!TFD_CLOEXEC) {
- fcntl(timerfd, F_SETFD, FD_CLOEXEC);
- }
- if (timerfd_settime(timerfd, 0, &it, NULL)) {
- barf("timerfd_settime: %s", strerror(errno));
- }
-
- if (pipe(pipefds) < 0) {
- barf("pipe: %s", strerror(errno));
- }
-
- /*
- * Create the thread with all blockable signals blocked, leaving signal
- * handling to the main and/or other threads. This is especially useful in
- * the non-threaded runtime, where applications might expect sigprocmask(2)
- * to effectively block signals.
- */
-#if defined(HAVE_SIGNAL_H)
- sigfillset(&mask);
- sigret = pthread_sigmask(SIG_SETMASK, &mask, &omask);
-#endif
- ret = createAttachedOSThread(&thread, "ghc_ticker", itimer_thread_func, (void*)handle_tick);
-#if defined(HAVE_SIGNAL_H)
- if (sigret == 0)
- pthread_sigmask(SIG_SETMASK, &omask, NULL);
-#endif
-
- if (ret != 0) {
- barf("Ticker: Failed to spawn thread: %s", strerror(errno));
- }
-}
-
-void
-startTicker(void)
-{
- OS_ACQUIRE_LOCK(&mutex);
- RELAXED_STORE(&stopped, false);
- signalCondition(&start_cond);
- OS_RELEASE_LOCK(&mutex);
-}
-
-/* There may be at most one additional tick fired after a call to this */
-void
-stopTicker(void)
-{
- OS_ACQUIRE_LOCK(&mutex);
- RELAXED_STORE(&stopped, true);
- OS_RELEASE_LOCK(&mutex);
-}
-
-/* There may be at most one additional tick fired after a call to this */
-void
-exitTicker (bool wait)
-{
- ASSERT(!SEQ_CST_LOAD(&exited));
- SEQ_CST_STORE(&exited, true);
- // ensure that ticker wakes up if stopped
- startTicker();
-
- // wait for ticker to terminate if necessary
- if (wait) {
- // write anything to the pipe to trigger poll() in the ticker thread
- if (write(pipefds[1], "stop", 5) < 0) {
- sysErrorBelch("Ticker: Failed to write to pipe: %s", strerror(errno));
- }
-
- if (pthread_join(thread, NULL)) {
- sysErrorBelch("Ticker: Failed to join: %s", strerror(errno));
- }
-
- // These need to happen AFTER the ticker thread has finished to prevent a race condition
- // where the ticker thread closes the read end of the pipe before we're done writing to it.
- close(pipefds[0]);
- close(pipefds[1]);
-
- closeMutex(&mutex);
- closeCondition(&start_cond);
- } else {
- pthread_detach(thread);
- }
-}
-
-int
-rtsTimerSignal(void)
-{
- return SIGALRM;
-}
=====================================
rts/rts.cabal
=====================================
@@ -582,11 +582,9 @@ library
posix/Ticker.c
posix/OSMem.c
posix/OSThreads.c
+ posix/FdWakeup.c
posix/Poll.c
posix/Select.c
posix/Signals.c
posix/Timeout.c
posix/TTY.c
- -- ticker/*.c
- -- We don't want to compile posix/ticker/*.c, these will be #included
- -- from Ticker.c
=====================================
testsuite/driver/testlib.py
=====================================
@@ -3043,6 +3043,12 @@ def normalise_errmsg(s: str) -> str:
# Old emcc warns when we export HEAP8 but new one requires it (see #26290)
s = s.replace('warning: invalid item in EXPORTED_RUNTIME_METHODS: HEAP8\nwarning: invalid item in EXPORTED_RUNTIME_METHODS: HEAPU8\nemcc: warning: warnings in JS library compilation [-Wjs-compiler]\n','')
+ # on newer versions of MacOS X, the shipped ranlib warns about object files with no symbols,
+ # however, these are completely benign stubs.
+ # See https://gitlab.haskell.org/ghc/ghc/-/issues/27116
+ if opsys('darwin'):
+ s = modify_lines(s, lambda l: re.sub(r'.*ranlib:.*has no symbols', '', l))
+
return s
# normalise a .prof file, so that we can reasonably compare it against
=====================================
testsuite/tests/driver/all.T
=====================================
@@ -120,9 +120,7 @@ if config.os == 'darwin':
else:
only_darwin = skip
-test('static001', [extra_files(['Static001.hs']),
- only_darwin,
- when(arch('x86_64'), expect_broken(8127))],
+test('static001', [extra_files(['Static001.hs']), only_darwin],
makefile_test, ['static001'])
test('dynHelloWorld',
=====================================
testsuite/tests/driver/bytecode-object/Makefile
=====================================
@@ -159,3 +159,9 @@ bytecode_object25:
"$(TEST_HC)" $(TEST_HC_OPTS) -c BytecodeForeign.hs -fbyte-code -fwrite-byte-code -fwrite-interface $(ghciWayFlags)
"$(TEST_HC)" $(TEST_HC_OPTS_INTERACTIVE) -v1 -fno-hide-source-paths -fbyte-code -fwrite-byte-code -fwrite-interface BytecodeForeign.hs -e "testForeign"
+# Test that corrupt bytecode file headers are rejected clearly.
+bytecode_object26:
+ "$(TEST_HC)" $(TEST_HC_OPTS) -c BytecodeTest.hs -fbyte-code -fwrite-byte-code
+ @printf 'bad!' | dd of=BytecodeTest.gbc bs=1 count=4 conv=notrunc 2>/dev/null
+ ! "$(TEST_HC)" $(TEST_HC_OPTS) -c -bytecodelib -o linked.bytecode BytecodeTest.gbc 2> bytecode_object26.stderr
+ @grep -F "bytecode file header mismatch" bytecode_object26.stderr >/dev/null
=====================================
testsuite/tests/driver/bytecode-object/all.T
=====================================
@@ -26,3 +26,4 @@ test('bytecode_object22', bytecode_opts, makefile_test, ['bytecode_object22'])
test('bytecode_object23', bytecode_opts, makefile_test, ['bytecode_object23'])
test('bytecode_object24', bytecode_opts + [copy_files], makefile_test, ['bytecode_object24'])
test('bytecode_object25', [bytecode_opts, req_interp, extra_files(['BytecodeForeign.hs', 'BytecodeForeign.c'])], makefile_test, ['bytecode_object25'])
+test('bytecode_object26', [bytecode_opts], makefile_test, ['bytecode_object26'])
=====================================
testsuite/tests/plugins/Makefile
=====================================
@@ -238,3 +238,10 @@ test-late-plugin:
.PHONY: T21730
T21730:
"$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) -v0 T21730.hs -package-db T21730-plugin/pkg.T21730-plugin/local.package.conf
+
+# Test that .dyn_o files are accepted as valid object files on the command line
+# without producing "ignoring unrecognised input" warnings (#24486)
+.PHONY: T24486
+T24486:
+ "$(TEST_HC)" $(TEST_HC_OPTS) -v0 -c T24486_Helper.hs -osuf dyn_o
+ "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) -v0 T24486.hs T24486_Helper.dyn_o -package-db T24486-plugin/pkg.T24486-plugin/local.package.conf -fplugin T24486_Plugin -plugin-package T24486-plugin
=====================================
testsuite/tests/plugins/T24486-plugin/Makefile
=====================================
@@ -0,0 +1,18 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
+
+clean.%:
+ rm -rf pkg.$*
+
+HERE := $(abspath .)
+$(eval $(call canonicalise,HERE))
+
+package.%:
+ $(MAKE) -s --no-print-directory clean.$*
+ mkdir pkg.$*
+ "$(TEST_HC)" -outputdir pkg.$* --make -v0 -o pkg.$*/setup Setup.hs
+ "$(GHC_PKG)" init pkg.$*/local.package.conf
+ pkg.$*/setup configure --distdir pkg.$*/dist -v0 $(CABAL_PLUGIN_BUILD) --prefix="$(HERE)/pkg.$*/install" --with-compiler="$(TEST_HC)" --with-hc-pkg="$(GHC_PKG)" --package-db=pkg.$*/local.package.conf $(if $(findstring YES,$(HAVE_PROFILING)), --enable-library-profiling)
+ pkg.$*/setup build --distdir pkg.$*/dist -v0
+ pkg.$*/setup install --distdir pkg.$*/dist -v0
=====================================
testsuite/tests/plugins/T24486-plugin/Setup.hs
=====================================
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
=====================================
testsuite/tests/plugins/T24486-plugin/T24486-plugin.cabal
=====================================
@@ -0,0 +1,9 @@
+Name: T24486-plugin
+Version: 0.1
+Synopsis: For testing
+Cabal-Version: >= 1.2
+Build-Type: Simple
+
+Library
+ Build-Depends: base, ghc
+ Exposed-Modules: T24486_Plugin
=====================================
testsuite/tests/plugins/T24486-plugin/T24486_Plugin.hs
=====================================
@@ -0,0 +1,6 @@
+module T24486_Plugin (plugin) where
+
+import GHC.Plugins
+
+plugin :: Plugin
+plugin = defaultPlugin
=====================================
testsuite/tests/plugins/T24486.hs
=====================================
@@ -0,0 +1,4 @@
+module Main where
+
+main :: IO ()
+main = return ()
=====================================
testsuite/tests/plugins/T24486_Helper.hs
=====================================
@@ -0,0 +1,4 @@
+module T24486_Helper where
+
+helper :: Int
+helper = 42
=====================================
testsuite/tests/plugins/all.T
=====================================
@@ -395,3 +395,10 @@ test('T21730',
pre_cmd('$MAKE -s --no-print-directory -C T21730-plugin package.T21730-plugin TOP={top}')
],
makefile_test, [])
+
+test('T24486',
+ [extra_files(['T24486-plugin/', 'T24486_Helper.hs']),
+ when(opsys('mingw32'), skip),
+ pre_cmd('$MAKE -s --no-print-directory -C T24486-plugin package.T24486-plugin TOP={top}')
+ ],
+ makefile_test, [])
=====================================
testsuite/tests/runghc/Makefile
=====================================
@@ -23,6 +23,11 @@ T11247:
-'$(RUNGHC)' foo.
-'$(RUNGHC)' foo.bar
+# runghc should honour -osuf for dependencies too (#16145).
+T16145:
+ '$(RUNGHC)' -- -fobject-code -osuf=hs.o T16145
+ printf '%s\n' *.hi *.o *.hs | LC_ALL=C sort
+
T17171a:
'$(RUNGHC)' --ghc-arg=-Wall T17171a.hs
T17171b:
=====================================
testsuite/tests/runghc/T16145.hs
=====================================
@@ -0,0 +1,5 @@
+module T16145 where
+
+import T16145_aux
+
+main = g
=====================================
testsuite/tests/runghc/T16145.stdout
=====================================
@@ -0,0 +1,6 @@
+T16145.hi
+T16145.hs
+T16145.hs.o
+T16145_aux.hi
+T16145_aux.hs
+T16145_aux.hs.o
=====================================
testsuite/tests/runghc/T16145_aux.hs
=====================================
@@ -0,0 +1,4 @@
+module T16145_aux where
+
+g :: IO ()
+g = return ()
=====================================
testsuite/tests/runghc/all.T
=====================================
@@ -4,6 +4,8 @@ test('T8601', req_interp, makefile_test, [])
test('T11247', [req_interp, expect_broken(11247)], makefile_test, [])
+test('T16145', req_interp, makefile_test, [])
+
test('T6132', [],
compile, [''])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b5c7a63a086def4174deb6385f5594…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b5c7a63a086def4174deb6385f5594…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/ani/precise-fun-loc] compute a more accuate application chain head location
by Apoorv Ingle (＠ani) 03 Apr '26
by Apoorv Ingle (＠ani) 03 Apr '26
03 Apr '26
Apoorv Ingle pushed to branch wip/ani/precise-fun-loc at Glasgow Haskell Compiler / GHC
Commits:
c9af140d by Apoorv Ingle at 2026-04-02T21:19:03-05:00
compute a more accuate application chain head location
- - - - -
3 changed files:
- compiler/GHC/Tc/Gen/App.hs
- compiler/GHC/Tc/Gen/Head.hs
- testsuite/tests/partial-sigs/should_compile/SplicesUsed.stderr
Changes:
=====================================
compiler/GHC/Tc/Gen/App.hs
=====================================
@@ -243,7 +243,7 @@ tcApp accepts 4 arguments:
3. the argument list (types and terms)
4. The expected result type
-PRECONDITION : the head (2.) and the list of arguments (3.) will
+PRECONDITION : the head (2.) and the list of arguments (3.)
are the de-constructred version of the expression (1.)
POSTCONDITION: The return expression is the typechecked version of (1.)
@@ -365,7 +365,7 @@ tcApp :: HsExpr GhcRn -- ^ The whole application (For error messages)
-- See Note [tcApp: typechecking applications]
-- See Note [splitHsApps] in GHC.Tc.Head
tcApp rn_expr rn_fun rn_args exp_res_ty
- = do { fun_lspan <- getFunSrcSpan rn_args
+ = do { fun_lspan <- getFunSrcSpan rn_fun rn_args
; traceTc "tcApp {" $
vcat [ text "rn_fun:" <+> ppr rn_fun
, text "fun_lspan:" <+> ppr fun_lspan
@@ -1958,14 +1958,14 @@ quickLookArg1 pos app_lspan rn_head larg@(L _ arg) sc_arg_ty@(Scaled _ orig_arg_
-- generated by calls in arg
do { traceTc "qla1" (ppr arg)
- ; (rn_fun_arg, rn_args) <- splitHsApps arg
+ ; (rn_arg_head, rn_arg_args) <- splitHsApps arg
; traceTc "qla2" (ppr arg)
- ; fun_lspan_arg <- getFunSrcSpan rn_args
+ ; fun_lspan_arg <- getFunSrcSpan rn_arg_head rn_arg_args
-- Step 1: get the type of the head of the argument
- ; (fun_ue, mb_fun_ty) <- tcCollectingUsage $ tcInferAppHead_maybe rn_fun_arg
+ ; (fun_ue, mb_fun_ty) <- tcCollectingUsage $ tcInferAppHead_maybe rn_arg_head
-- tcCollectingUsage: the use of an Id at the head generates usage-info
-- See the call to `tcEmitBindingUsage` in `check_local_id`. So we must
-- capture and save it in the `EValArgQL`. See (QLA6) in
@@ -1974,8 +1974,8 @@ quickLookArg1 pos app_lspan rn_head larg@(L _ arg) sc_arg_ty@(Scaled _ orig_arg_
; traceTc "quickLookArg {" $
vcat [ text "arg:" <+> ppr arg
, text "orig_arg_rho:" <+> ppr orig_arg_rho
- , text "head:" <+> ppr rn_fun_arg <+> dcolon <+> ppr mb_fun_ty
- , text "args:" <+> ppr rn_args ]
+ , text "head:" <+> ppr rn_arg_head <+> dcolon <+> ppr mb_fun_ty
+ , text "args:" <+> ppr rn_arg_args ]
; case mb_fun_ty of {
Nothing -> skipQuickLook app_lspan larg sc_arg_ty ; -- fun is too complicated
@@ -1983,11 +1983,11 @@ quickLookArg1 pos app_lspan rn_head larg@(L _ arg) sc_arg_ty@(Scaled _ orig_arg_
-- step 2: use |-inst to instantiate the head applied to the arguments
do { let arg_tc_head = (tc_fun_arg_head, fun_lspan_arg)
- ; do_ql <- wantQuickLook rn_fun_arg
+ ; do_ql <- wantQuickLook rn_arg_head
; ((inst_args, app_res_rho), wanted)
<- captureConstraints $
- tcInstFun do_ql True (rn_fun_arg, fun_lspan_arg) tc_fun_arg_head fun_sigma_arg_head rn_args
+ tcInstFun do_ql True (rn_arg_head, fun_lspan_arg) tc_fun_arg_head fun_sigma_arg_head rn_arg_args
-- We must capture type-class and equality constraints here, but
-- not usage information. See (QLA6) in Note [Quick Look at
-- value arguments]
@@ -2017,13 +2017,13 @@ quickLookArg1 pos app_lspan rn_head larg@(L _ arg) sc_arg_ty@(Scaled _ orig_arg_
; when arg_influences_enclosing_call $
qlUnify app_res_rho orig_arg_rho
- ; traceTc "quickLookArg done }" (ppr rn_fun_arg)
+ ; traceTc "quickLookArg done }" (ppr rn_arg_head)
; return (EValArgQL { eaql_loc_span = app_lspan
, eaql_arg_ty = sc_arg_ty
, eaql_larg = larg
, eaql_tc_fun = arg_tc_head
- , eaql_rn_fun = rn_fun_arg
+ , eaql_rn_fun = rn_arg_head
, eaql_fun_ue = fun_ue
, eaql_args = inst_args
, eaql_wanted = wanted
=====================================
compiler/GHC/Tc/Gen/Head.hs
=====================================
@@ -223,14 +223,15 @@ addArgWrap wrap args
--------------------
-getFunSrcSpan :: [HsExprArg 'TcpRn] -> TcM SrcSpan
-getFunSrcSpan [] = getSrcSpanM
-getFunSrcSpan (ETypeArg { ea_loc_span = l } : _) = return (locA l)
-getFunSrcSpan (EValArg { ea_loc_span = l } : _) = return (locA l)
-getFunSrcSpan (EPrag l _ : _) = return (locA l)
-getFunSrcSpan (EWrap (EPar l) : _) = return (locA l)
-getFunSrcSpan (EWrap (EExpand l _) : _) = return (locA l)
-getFunSrcSpan (EWrap (EHsWrap {}) : args) = getFunSrcSpan args
+getFunSrcSpan :: HsExpr GhcRn -> [HsExprArg 'TcpRn] -> TcM SrcSpan
+getFunSrcSpan (ExprWithTySig _ (L l _) _) _ = return (locA l)
+getFunSrcSpan _ [] = getSrcSpanM
+getFunSrcSpan _ (ETypeArg { ea_loc_span = l } : _) = return (locA l)
+getFunSrcSpan _ (EValArg { ea_loc_span = l } : _) = return (locA l)
+getFunSrcSpan _ (EPrag l _ : _) = return (locA l)
+getFunSrcSpan _ (EWrap (EPar l) : _) = return (locA l)
+getFunSrcSpan _ (EWrap (EExpand l _) : _) = return (locA l)
+getFunSrcSpan f (EWrap (EHsWrap {}) : args) = getFunSrcSpan f args
--------------------
isHsValArg :: HsExprArg id -> Bool
@@ -294,10 +295,10 @@ instance Outputable EWrap where
splitHsApps :: HsExpr GhcRn -> TcM (HsExpr GhcRn, [HsExprArg 'TcpRn])
splitHsApps e = go e []
where
- go (HsPar _ (L l fun)) args = go fun (EWrap (EPar l) : args)
- go (HsPragE _ p (L l fun)) args = go fun (EPrag l p : args)
- go (HsAppType _ (L l fun) ty) args = go fun (mkETypeArg l ty : args)
- go (HsApp _ (L l fun) arg) args = go fun (mkEValArg l arg : args)
+ go (HsPar _ (L l fun)) args = go fun (EWrap (EPar l) : args)
+ go (HsPragE _ p (L l fun)) args = go fun (EPrag l p : args)
+ go (HsAppType _ (L l fun) ty) args = go fun (mkETypeArg l ty : args)
+ go (HsApp _ (L l fun) arg) args = go fun (mkEValArg l arg : args)
go fun args = do { mb_hse <- tcExpand fun
; case mb_hse of
Just (HSE { hse_ctxt = orig, hse_exp = L l fun' })
=====================================
testsuite/tests/partial-sigs/should_compile/SplicesUsed.stderr
=====================================
@@ -20,7 +20,8 @@ SplicesUsed.hs:8:26: warning: [GHC-88464] [-Wpartial-type-signatures (in -Wdefau
• Found type wildcard ‘_’ standing for ‘Bool’
• In the first argument of ‘Maybe’, namely ‘_’
In an expression type signature: Maybe _
- In the expression: Just True :: Maybe _
+ In the first argument of ‘id :: _a -> _a’, namely
+ ‘(Just True :: Maybe _)’
• Relevant bindings include
maybeBool :: Maybe Bool (bound at SplicesUsed.hs:8:1)
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c9af140d496ca06466d1d14678fe909…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c9af140d496ca06466d1d14678fe909…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 12 commits: driver: recognise .dyn_o as a valid object file to link if passed on the command line.
by Marge Bot (＠marge-bot) 03 Apr '26
by Marge Bot (＠marge-bot) 03 Apr '26
03 Apr '26
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
a116ca75 by Zubin Duggal at 2026-04-02T21:29:21-04:00
driver: recognise .dyn_o as a valid object file to link if passed on the command line.
This allows plugins compiled with this suffix to run.
Fixes #24486
- - - - -
5ca0ec57 by Simon Jakobi at 2026-04-02T21:29:24-04:00
Add regression test for #16145
Closes #16145.
- - - - -
de30ea3b by Matthew Pickering at 2026-04-02T21:29:24-04:00
bytecode: Add magic header/version to bytecode files
In order to avoid confusing errors when using stale interface files (ie
from an older compiler version), we add a simple header/version check
like the one for interface files.
Fixes #27068
- - - - -
f6cd6f2d by fendor at 2026-04-02T21:29:25-04:00
Add constants for bytecode in-memory buffer size
Introduce a common constant for the default size of the .gbc and
.bytecodelib binary buffer.
The buffer is by default set to 1 MB.
- - - - -
1a2b7f11 by Duncan Coutts at 2026-04-02T21:29:26-04:00
Add a rts posix FdWakup utility module
This will be used to implement wakeupIOManager for in-RTS I/O managers.
It provides a notification/wakeup mechanism using FDs, suitable for
situations when a thread is blocked on a set of fds anyway. It uses the
classic self-pipe trick, or equivalently eventfd on supported platforms.
This will initially be used to implement prompt interrupt or shutdown of
the posix ticker thread.
- - - - -
66f81c55 by Duncan Coutts at 2026-04-02T21:29:26-04:00
Add prompt shutdown to the pthread ticker implementation.
The Linux timerfd ticker monitors a pipe which is used by exitTicker to
ensure a prompt wakeup and shutdown. The pthread ticker lacked this and
so would only exit at the next ticker wakeup (10ms by default).
This patch adds the same mechanism to the pthread ticker.
This changes the pthread ticker from waiting by using nanosleep() to
waiting using either ppoll() or select(), so that it can wait on both
a time and a file descriptor. On Linux at least, a test program to
compare the timing jitter of these APIs shows that using nanpsleep,
ppoll or select makes no statistical difference to the maximum or
average jitter.
This is a step towards unifying the posix ticker implementations, so
that we can have just one portable one (albeit with some limited cpp).
It is also a step towards using the ticker as part of a more general
implementation of wakeUpRts, since this will require a method to wake
the rts from a signal handler context (ctl-c handler).
- - - - -
13b86936 by Duncan Coutts at 2026-04-02T21:29:26-04:00
Update ticker header commentary
It was antique and didn't apply even to the previous implementation, and
certainly not to the updated one.
- - - - -
1f0d1bad by Duncan Coutts at 2026-04-02T21:29:26-04:00
Remove the timerfd-based ticker implementation
There does not appear to be any remaining advantage on Linux to using
the timerfd ticker implementation over the portable one (using ppoll on
Linux for precise timing).
The eventfd implementation was originally added at a time when Linux was
still using a signal based implementation. So it made sense at the time.
See (closed) issue #10840.
- - - - -
21e4fd73 by Duncan Coutts at 2026-04-02T21:29:26-04:00
Consolidate to a single posix ticker implementation
Previously we had four implementations, two using signals and two using
threads. Having just one should make behaviour more consistent between
platforms, and should make maintenance easier.
- - - - -
119c0dfc by mangoiv at 2026-04-02T21:29:27-04:00
testsuite: filter stderr for static001 on darwin
This reactivates the test on x86_64 darwin as this should have been done
long ago and ignores warnings emitted by ranlib on newer version of the
darwin toolchain since they are benign. (no symbols for stub libraries)
Fixes #27116
- - - - -
3d644081 by mangoiv at 2026-04-02T21:29:28-04:00
issue template: fix add bug label
- - - - -
b5c7a63a by Sylvain Henry at 2026-04-02T21:29:37-04:00
Add more canned GC functions for common register patterns (#27142)
Based on analysis of heap-check sites across the GHC compiler and Cabal,
the following patterns were not covered by existing canned GC functions
but occurred frequently enough to warrant specialisation:
stg_gc_ppppp -- 5 GC pointers
stg_gc_ip -- unboxed word + GC pointer
stg_gc_pi -- GC pointer + unboxed word
stg_gc_ii -- two unboxed words
stg_gc_bpp -- byte (I8) + two GC pointers
Adding these reduces the fraction of heap-check sites falling back to
the generic GC path from ~1.4% to ~0.4% when compiling GHC itself.
Co-Authored-By: Claude Sonnet 4.6 <noreply(a)anthropic.com>
- - - - -
30 changed files:
- .gitlab/issue_templates/default.md
- compiler/GHC/ByteCode/Serialize.hs
- compiler/GHC/Driver/Phases.hs
- compiler/GHC/StgToCmm/Heap.hs
- rts/HeapStackCheck.cmm
- rts/RtsSymbols.c
- rts/include/stg/MiscClosures.h
- + rts/posix/FdWakeup.c
- + rts/posix/FdWakeup.h
- rts/posix/Ticker.c
- − rts/posix/ticker/Pthread.c
- − rts/posix/ticker/TimerFd.c
- rts/rts.cabal
- testsuite/driver/testlib.py
- testsuite/tests/driver/all.T
- testsuite/tests/driver/bytecode-object/Makefile
- testsuite/tests/driver/bytecode-object/all.T
- testsuite/tests/plugins/Makefile
- + testsuite/tests/plugins/T24486-plugin/Makefile
- + testsuite/tests/plugins/T24486-plugin/Setup.hs
- + testsuite/tests/plugins/T24486-plugin/T24486-plugin.cabal
- + testsuite/tests/plugins/T24486-plugin/T24486_Plugin.hs
- + testsuite/tests/plugins/T24486.hs
- + testsuite/tests/plugins/T24486_Helper.hs
- testsuite/tests/plugins/all.T
- testsuite/tests/runghc/Makefile
- + testsuite/tests/runghc/T16145.hs
- + testsuite/tests/runghc/T16145.stdout
- + testsuite/tests/runghc/T16145_aux.hs
- testsuite/tests/runghc/all.T
Changes:
=====================================
.gitlab/issue_templates/default.md
=====================================
@@ -20,5 +20,5 @@ Optional:
* System Architecture:
-/label ~bug
+/label ~"T::bug"
/label ~"needs triage"
=====================================
compiler/GHC/ByteCode/Serialize.hs
=====================================
@@ -25,22 +25,26 @@ where
import GHC.Prelude
import GHC.ByteCode.Binary
-import GHC.ByteCode.Types
import GHC.ByteCode.Recomp.Binary (computeFingerprint)
-import GHC.Driver.Env
+import GHC.ByteCode.Types
import GHC.Driver.DynFlags
+import GHC.Driver.Env
import GHC.Iface.Binary
import GHC.Iface.Recomp.Binary (putNameLiterally)
import GHC.Linker.Types
+import GHC.Settings.Constants (hiVersion)
import GHC.Unit.Types
import GHC.Utils.Binary
-import GHC.Utils.TmpFs
-import GHC.Utils.Logger
import GHC.Utils.Fingerprint (Fingerprint)
+import GHC.Utils.Logger
+import GHC.Utils.Panic
+import GHC.Utils.TmpFs
import Data.ByteString (ByteString)
-import qualified Data.ByteString as BS
+import Data.ByteString qualified as BS
+import Data.Char (ord)
import Data.Traversable
+import Data.Word
import System.Directory
import System.FilePath
@@ -79,21 +83,35 @@ The ticket where bytecode objects were dicussed is #26298
See Note [-fwrite-byte-code is not the default]
See Note [Recompilation avoidance with bytecode objects]
+See Note [Persistent bytecode file headers]
+Note [Persistent bytecode file headers]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Persistent bytecode files (`.gbc`) and bytecode libraries (`.bytecodelib`)
+are version-specific binary formats. Without a small file-level header, stale
+or corrupt files are only discovered once we start deserialising the payload,
+which can lead to confusing failures.
+
+To make these failures explicit, we write a file-kind-specific magic word and
+the current `hiVersion` ahead of the binary payload. Readers validate this
+header before setting up the normal `Name`/`FastString` deserialisation
+machinery. This follows the same approach as normal interface files.
-}
writeBytecodeLib :: BytecodeLib -> FilePath -> IO ()
writeBytecodeLib lib path = do
odbco <- encodeBytecodeLib lib
createDirectoryIfMissing True (takeDirectory path)
- bh' <- openBinMem (1024 * 1024)
+ bh' <- openBinMem initBinMemSize
bh <- addBinNameWriter bh'
+ writePersistentBytecodeHeader BytecodeLibraryFile bh
putWithUserData QuietBinIFace NormalCompression bh odbco
writeBinMem bh path
readBytecodeLib :: HscEnv -> FilePath -> IO OnDiskBytecodeLib
readBytecodeLib hsc_env path = do
bh' <- readBinMem path
+ readPersistentBytecodeHeader BytecodeLibraryFile path bh'
bh <- addBinNameReader (hsc_NC hsc_env) bh'
res <- getWithUserData (hsc_NC hsc_env) bh
pure res
@@ -185,6 +203,7 @@ readBinByteCode hsc_env f = do
readOnDiskModuleByteCode :: HscEnv -> FilePath -> IO OnDiskModuleByteCode
readOnDiskModuleByteCode hsc_env f = do
bh' <- readBinMem f
+ readPersistentBytecodeHeader ModuleByteCodeFile f bh'
bh <- addBinNameReader (hsc_NC hsc_env) bh'
getWithUserData (hsc_NC hsc_env) bh
@@ -192,9 +211,10 @@ readOnDiskModuleByteCode hsc_env f = do
writeBinByteCode :: FilePath -> ModuleByteCode -> IO ()
writeBinByteCode f cbc = do
createDirectoryIfMissing True (takeDirectory f)
- bh' <- openBinMem (1024 * 1024)
+ bh' <- openBinMem initBinMemSize
bh <- addBinNameWriter bh'
odbco <- encodeOnDiskModuleByteCode cbc
+ writePersistentBytecodeHeader ModuleByteCodeFile bh
putWithUserData QuietBinIFace NormalCompression bh odbco
writeBinMem bh f
@@ -213,3 +233,64 @@ fingerprintModuleByteCodeContents :: Module -> CompiledByteCode -> [FilePath] ->
fingerprintModuleByteCodeContents modl cbc foreign_files = do
foreign_contents <- readObjectFiles foreign_files
pure $ computeFingerprint putNameLiterally (modl, cbc, foreign_contents)
+
+-- ----------------------------------------------------------------------------
+-- ByteCode module and library magic header.
+-- ----------------------------------------------------------------------------
+
+data PersistentBytecodeFile
+ = ModuleByteCodeFile
+ | BytecodeLibraryFile
+
+-- See Note [Persistent bytecode file headers]
+writePersistentBytecodeHeader :: PersistentBytecodeFile -> WriteBinHandle -> IO ()
+writePersistentBytecodeHeader file_kind bh = do
+ put_ bh (persistentBytecodeMagic file_kind)
+ put_ bh (show hiVersion)
+
+readPersistentBytecodeHeader :: PersistentBytecodeFile -> FilePath -> ReadBinHandle -> IO ()
+readPersistentBytecodeHeader file_kind path bh = do
+ let mismatch what expected actual =
+ throwGhcExceptionIO $ ProgramError $
+ persistentBytecodeFileDescription file_kind ++ " header mismatch in " ++ path ++
+ ": " ++ what ++ " (expected " ++ expected ++ ", got " ++ actual ++ ")"
+
+ magic <- get bh
+ let expected_magic = persistentBytecodeMagic file_kind
+ if unFixedLength magic == unFixedLength expected_magic
+ then pure ()
+ else mismatch "magic" (show $ unFixedLength expected_magic) (show $ unFixedLength magic)
+
+ version <- get bh
+ let expected_version = show hiVersion
+ if version == expected_version
+ then pure ()
+ else mismatch "version" expected_version version
+
+persistentBytecodeFileDescription :: PersistentBytecodeFile -> String
+persistentBytecodeFileDescription ModuleByteCodeFile = "bytecode file"
+persistentBytecodeFileDescription BytecodeLibraryFile = "bytecode library"
+
+persistentBytecodeMagic :: PersistentBytecodeFile -> FixedLengthEncoding Word32
+persistentBytecodeMagic file_kind =
+ case file_kind of
+ ModuleByteCodeFile -> asciiWord32 "gbc0"
+ BytecodeLibraryFile -> asciiWord32 "bcl0"
+
+-- | Encode a 4-letter word into a single Word32.
+asciiWord32 :: String -> FixedLengthEncoding Word32
+asciiWord32 [a, b, c, d] =
+ FixedLengthEncoding $
+ (fromIntegral (ord a) `shiftL` 24) .|.
+ (fromIntegral (ord b) `shiftL` 16) .|.
+ (fromIntegral (ord c) `shiftL` 8) .|.
+ fromIntegral (ord d)
+asciiWord32 _ = error "asciiWord32: expected exactly four ASCII characters"
+
+-- ----------------------------------------------------------------------------
+-- Constants and utils
+-- ----------------------------------------------------------------------------
+
+-- | Initial ram buffer to allocate for writing .gbc and .bytecodelib files.
+initBinMemSize :: Int
+initBinMemSize = 1024 * 1024 -- 1 MB
=====================================
compiler/GHC/Driver/Phases.hs
=====================================
@@ -262,7 +262,7 @@ objish_suffixes :: Platform -> [String]
-- the GHC-compiled code will run
objish_suffixes platform = case platformOS platform of
OSMinGW32 -> [ "o", "O", "obj", "OBJ" ]
- _ -> [ "o" ]
+ _ -> [ "o", "dyn_o"]
dynlib_suffixes :: Platform -> [String]
dynlib_suffixes platform = case platformOS platform of
=====================================
compiler/GHC/StgToCmm/Heap.hs
=====================================
@@ -1,3 +1,4 @@
+{-# LANGUAGE OverloadedStrings #-}
-----------------------------------------------------------------------------
--
-- Stg to C--: heap management functions
@@ -44,7 +45,7 @@ import GHC.Types.Id ( Id )
import GHC.Unit
import GHC.Platform
import GHC.Platform.Profile
-import GHC.Data.FastString( mkFastString, fsLit )
+import GHC.Data.FastString( FastString )
import GHC.Utils.Panic( sorry )
import Control.Monad (when)
@@ -125,7 +126,7 @@ allocHeapClosure rep info_ptr use_cc payload = do
-- ie 1 *before* the info-ptr word of new object.
base <- getHpRelOffset info_offset
- emitComment $ mkFastString "allocHeapClosure"
+ emitComment "allocHeapClosure"
emitSetDynHdr base info_ptr use_cc
-- Fill in the fields
@@ -460,35 +461,41 @@ genericGC checkYield code
call <- mkCall generic_gc (GC, GC) [] [] updfr_sz []
heapCheck False checkYield (call <*> mkBranch lretry) code
+-- | Predefined ("canned") GC functions
+--
+-- Functions have been added to cover 99% of the GC calls made in GHC and Cabal.
+-- See #27142.
cannedGCEntryPoint :: Platform -> [LocalReg] -> Maybe CmmExpr
-cannedGCEntryPoint platform regs
- = case map localRegType regs of
- [] -> Just (mkGcLabel "stg_gc_noregs")
- [ty]
- | isGcPtrType ty -> Just (mkGcLabel "stg_gc_unpt_r1")
- | isFloatType ty -> case width of
- W32 -> Just (mkGcLabel "stg_gc_f1")
- W64 -> Just (mkGcLabel "stg_gc_d1")
- _ -> Nothing
-
- | width == wordWidth platform -> Just (mkGcLabel "stg_gc_unbx_r1")
- | width == W64 -> Just (mkGcLabel "stg_gc_l1")
- | otherwise -> Nothing
- where
- width = typeWidth ty
- [ty1,ty2]
- | isGcPtrType ty1
- && isGcPtrType ty2 -> Just (mkGcLabel "stg_gc_pp")
- [ty1,ty2,ty3]
- | isGcPtrType ty1
- && isGcPtrType ty2
- && isGcPtrType ty3 -> Just (mkGcLabel "stg_gc_ppp")
- [ty1,ty2,ty3,ty4]
- | isGcPtrType ty1
- && isGcPtrType ty2
- && isGcPtrType ty3
- && isGcPtrType ty4 -> Just (mkGcLabel "stg_gc_pppp")
- _otherwise -> Nothing
+cannedGCEntryPoint platform regs =
+ case map localRegType regs of
+ [] -> ret "stg_gc_noregs"
+ [ty]
+ | is_gc ty -> ret "stg_gc_unpt_r1"
+ | is_f32 ty -> ret "stg_gc_f1"
+ | is_f64 ty -> ret "stg_gc_d1"
+ | is_wn ty -> ret "stg_gc_unbx_r1"
+ | is_w64 ty -> ret "stg_gc_l1"
+ [ty1,ty2]
+ | is_gc ty1 && is_gc ty2 -> ret "stg_gc_pp"
+ | is_gc ty1 && is_wn ty2 -> ret "stg_gc_pi"
+ | is_wn ty1 && is_gc ty2 -> ret "stg_gc_ip"
+ | is_wn ty1 && is_wn ty2 -> ret "stg_gc_ii"
+ [ty1,ty2,ty3]
+ | is_gc ty1 && is_gc ty2 && is_gc ty3 -> ret "stg_gc_ppp"
+ | is_w8 ty1 && is_gc ty2 && is_gc ty3 -> ret "stg_gc_bpp"
+ [ty1,ty2,ty3,ty4]
+ | is_gc ty1 && is_gc ty2 && is_gc ty3 && is_gc ty4 -> ret "stg_gc_pppp"
+ [ty1,ty2,ty3,ty4,ty5]
+ | is_gc ty1 && is_gc ty2 && is_gc ty3 && is_gc ty4 && is_gc ty5 -> ret "stg_gc_ppppp"
+ _ -> Nothing
+ where
+ ret fs = Just (mkGcLabel fs)
+ is_gc ty = isGcPtrType ty
+ is_wn ty = isBitsType ty && typeWidth ty == wordWidth platform
+ is_w8 ty = isBitsType ty && typeWidth ty == W8
+ is_w64 ty = isBitsType ty && typeWidth ty == W64
+ is_f32 ty = isFloatType ty && typeWidth ty == W32
+ is_f64 ty = isFloatType ty && typeWidth ty == W64
-- Note [stg_gc arguments]
-- ~~~~~~~~~~~~~~~~~~~~~~~
@@ -514,8 +521,8 @@ generic_gc :: CmmExpr
generic_gc = mkGcLabel "stg_gc_noregs"
-- | Create a CLabel for calling a garbage collector entry point
-mkGcLabel :: String -> CmmExpr
-mkGcLabel s = CmmLit (CmmLabel (mkCmmCodeLabel rtsUnitId (fsLit s)))
+mkGcLabel :: FastString -> CmmExpr
+mkGcLabel s = CmmLit (CmmLabel (mkCmmCodeLabel rtsUnitId s))
-------------------------------
heapCheck :: Bool -> Bool -> CmmAGraph -> FCode a -> FCode a
=====================================
rts/HeapStackCheck.cmm
=====================================
@@ -373,8 +373,6 @@ stg_gc_l1 return (L_ l)
jump stg_gc_noregs (stg_ret_l_info, l) ();
}
-/*-- Unboxed tuples with multiple pointers -------------------------------- */
-
stg_gc_pp return (P_ arg1, P_ arg2)
{
call stg_gc_noregs();
@@ -393,6 +391,36 @@ stg_gc_pppp return (P_ arg1, P_ arg2, P_ arg3, P_ arg4)
return (arg1,arg2,arg3,arg4);
}
+stg_gc_ppppp return (P_ arg1, P_ arg2, P_ arg3, P_ arg4, P_ arg5)
+{
+ call stg_gc_noregs();
+ return (arg1,arg2,arg3,arg4,arg5);
+}
+
+stg_gc_ip return (W_ arg1, P_ arg2)
+{
+ call stg_gc_noregs();
+ return (arg1,arg2);
+}
+
+stg_gc_pi return (P_ arg1, W_ arg2)
+{
+ call stg_gc_noregs();
+ return (arg1,arg2);
+}
+
+stg_gc_ii return (W_ arg1, W_ arg2)
+{
+ call stg_gc_noregs();
+ return (arg1,arg2);
+}
+
+stg_gc_bpp return (I8 arg1, P_ arg2, P_ arg3)
+{
+ call stg_gc_noregs();
+ return (arg1,arg2,arg3);
+}
+
/* -----------------------------------------------------------------------------
Generic function entry heap check code.
=====================================
rts/RtsSymbols.c
=====================================
@@ -499,6 +499,11 @@ extern char **environ;
SymI_HasDataProto(stg_gc_pp) \
SymI_HasDataProto(stg_gc_ppp) \
SymI_HasDataProto(stg_gc_pppp) \
+ SymI_HasDataProto(stg_gc_ppppp) \
+ SymI_HasDataProto(stg_gc_ip) \
+ SymI_HasDataProto(stg_gc_pi) \
+ SymI_HasDataProto(stg_gc_ii) \
+ SymI_HasDataProto(stg_gc_bpp) \
SymI_HasDataProto(__stg_gc_fun) \
SymI_HasDataProto(stg_gc_fun_info) \
SymI_HasDataProto(stg_yield_noregs) \
=====================================
rts/include/stg/MiscClosures.h
=====================================
@@ -361,6 +361,11 @@ RTS_FUN_DECL(stg_gc_l1);
RTS_FUN_DECL(stg_gc_pp);
RTS_FUN_DECL(stg_gc_ppp);
RTS_FUN_DECL(stg_gc_pppp);
+RTS_FUN_DECL(stg_gc_ppppp);
+RTS_FUN_DECL(stg_gc_ip);
+RTS_FUN_DECL(stg_gc_pi);
+RTS_FUN_DECL(stg_gc_ii);
+RTS_FUN_DECL(stg_gc_bpp);
RTS_RET(stg_gc_fun);
RTS_FUN_DECL(__stg_gc_fun);
=====================================
rts/posix/FdWakeup.c
=====================================
@@ -0,0 +1,141 @@
+/* -----------------------------------------------------------------------------
+ *
+ * (c) The GHC Team 2025
+ *
+ * Utilities for a simple fd-based cross-thread wakeup mechanism.
+ *
+ * This is used to provide a mechanism to wake a thread when it is blocked
+ * waiting on fds and timeouts. The mechanism works by including the read end
+ * fd into the set of fds the thread waits on, and when a wake up is needed,
+ * the write end fd is used.
+ *
+ * This is implemented using either eventfd() or pipe().
+ *
+ * Linux 2.6.22+ and FreeBSD 13+ support eventfd. It is a single fd with a
+ * 64bit counter. It uses fewer resources than a pipe (less memory and one
+ * rather than two fds), and is a tad faster (on the order of 5-10%). Using
+ * write() adds to the counter, while read() reads and resets it. Thus
+ * multiple writes are combined automatically into a single corresponding
+ * read.
+ *
+ * Otherwise we use a classic unix pipe.
+ *
+ * In both implementations, multiple sendFdWakeup notifcations (without
+ * interleaved collectFdWakeup) are combined to a single notification. This
+ * is automatic given the semantics of eventfd, while for pipe we implement
+ * it explicitly by draining the pipe in collectFdWakeup.
+ *
+ * -------------------------------------------------------------------------*/
+
+#include "rts/PosixSource.h"
+#include "Rts.h"
+
+#include "FdWakeup.h"
+
+#include <fcntl.h>
+#include <unistd.h>
+
+#ifdef HAVE_SYS_EVENTFD_H
+#include <sys/eventfd.h>
+#endif
+
+#if !defined(HAVE_EVENTFD) \
+ || (defined(HAVE_EVENTFD) && !(defined(EFD_CLOEXEC) && defined(EFD_NONBLOCK)))
+static void fcntl_CLOEXEC_NONBLOCK(int fd)
+{
+ int res1 = fcntl(fd, F_SETFD, FD_CLOEXEC);
+ int res2 = fcntl(fd, F_SETFL, O_NONBLOCK);
+ if (RTS_UNLIKELY(res1 < 0 || res2 < 0)) {
+ sysErrorBelch("newFdWakeup fcntl()");
+ stg_exit(EXIT_FAILURE);
+ }
+}
+#endif
+
+void newFdWakeup(int *wakeup_fd_r, int *wakeup_fd_w)
+{
+#if defined(HAVE_EVENTFD)
+ int wakeup_fd;
+#if defined(EFD_CLOEXEC) && defined(EFD_NONBLOCK)
+ wakeup_fd = eventfd(0, EFD_CLOEXEC | EFD_NONBLOCK);
+#else
+ wakeup_fd = eventfd(0, 0);
+ if (wakeup_fd >= 0) fcntl_CLOEXEC_NONBLOCK(wakeup_fd);
+#endif
+ if (RTS_UNLIKELY(wakeup_fd < 0)) {
+ sysErrorBelch("newFdWakeup eventfd()");
+ stg_exit(EXIT_FAILURE);
+ }
+ /* eventfd uses the same fd for each end */
+ *wakeup_fd_r = wakeup_fd;
+ *wakeup_fd_w = wakeup_fd;
+#else
+ int pipefd[2];
+ int res;
+ res = pipe(pipefd);
+ if (RTS_UNLIKELY(res < 0)) {
+ sysErrorBelch("newFdWakeup pipe");
+ stg_exit(EXIT_FAILURE);
+ }
+ fcntl_CLOEXEC_NONBLOCK(pipefd[0]);
+ fcntl_CLOEXEC_NONBLOCK(pipefd[1]);
+ *wakeup_fd_r = pipefd[0]; /* read end */
+ *wakeup_fd_w = pipefd[1]; /* write end */
+#endif
+}
+
+void closeFdWakeup(int wakeup_fd_r, int wakeup_fd_w)
+{
+#if defined(HAVE_EVENTFD)
+ ASSERT(wakeup_fd_r == wakeup_fd_w);
+ close(wakeup_fd_r);
+#else
+ ASSERT(wakeup_fd_r != wakeup_fd_w);
+ close(wakeup_fd_r);
+ close(wakeup_fd_w);
+#endif
+}
+
+/* This is safe to use from a signal handler. Using write() to a pipe
+ * or eventfd is fine. */
+void sendFdWakeup(int wakeup_fd_w)
+{
+ int res;
+#if defined(HAVE_EVENTFD)
+ uint64_t val = 1;
+ res = write(wakeup_fd_w, &val, 8);
+#else
+ unsigned char buf = 1;
+ res = write(wakeup_fd_w, &buf, 1);
+#endif
+ if (RTS_UNLIKELY(res < 0)) {
+ /* Unlikely the pipe buffer will fill, but it would not be an error. */
+ if (errno == EAGAIN) return;
+ sysErrorBelch("sendFdWakeup write");
+ stg_exit(EXIT_FAILURE);
+ }
+}
+
+void collectFdWakeup(int wakeup_fd_r)
+{
+ int res;
+#if defined(HAVE_EVENTFD)
+ uint64_t buf;
+ /* eventfd combines events into one counter, so a single read is enough */
+ res = read(wakeup_fd_r, &buf, 8);
+#else
+ /* Drain the pipe buffer. Multiple wakeup notifications could
+ * have been sent before we have a chance to collect them.
+ */
+ uint64_t buf;
+ do {
+ res = read(wakeup_fd_r, &buf, 8);
+ } while (res == 8);
+#endif
+ if (RTS_UNLIKELY(res < 0)) {
+ /* After the first pipe read, it could block */
+ if (errno == EAGAIN) return;
+ sysErrorBelch("collectFdWakeup read");
+ stg_exit(EXIT_FAILURE);
+ }
+}
=====================================
rts/posix/FdWakeup.h
=====================================
@@ -0,0 +1,40 @@
+/* -----------------------------------------------------------------------------
+ *
+ * (c) The GHC Team 2025
+ *
+ * Utilities for a simple fd-based cross-thread wakeup mechanism.
+ *
+ * It provides a mechanism for a thread that block on fds to add a simple
+ * wakeup/notification feature.
+ *
+ * Start with newFdWakeup, and pass the fd_r to the thread that needs the
+ * wakeup feature. The thread that needs to be woken should include the fd_r
+ * into the set of fds that the thread waits on (e.g. using poll or similar).
+ * If this fd becomes ready for read, the thread must call collectFdWakeup,
+ * and when a wake up is needed, the write end fd is used. In any other thread
+ * (or in a signal handler), call sendFdWakeup(fd_w) to (asynchronously) cause
+ * the wakeup.
+ *
+ * There is no message payload. Multiple wakeups may be combined (if they're
+ * sent multiple times before the notified thread can wake and call
+ * collectFdWakeup).
+ *
+ * The implementation uses pipe() or eventfd() on supported OSs.
+ *
+ * Prototypes for functions in FdWakeup.c
+ *
+ * -------------------------------------------------------------------------*/
+
+#pragma once
+
+#include "BeginPrivate.h"
+
+void newFdWakeup(int *fd_r, int *fd_w);
+void closeFdWakeup(int fd_r, int fd_w);
+
+/* This is safe to use from a signal handler */
+void sendFdWakeup(int fd_w);
+void collectFdWakeup(int fd_r);
+
+#include "EndPrivate.h"
+
=====================================
rts/posix/Ticker.c
=====================================
@@ -1,19 +1,53 @@
/* -----------------------------------------------------------------------------
*
- * (c) The GHC Team, 1995-2007
+ * (c) The GHC Team, 1995-2026
*
- * Posix implementation(s) of the interval timer for profiling and pre-emptive
- * scheduling.
+ * The posix implementation of the interval timer, used for pre-emptive
+ * scheduling of Haskell threads, and for sample based profiling.
+ *
+ * This file defines the "ticker": the platform-specific service to install and
+ * run the timer. See rts/Timer.c for the platform-dependent view of interval
+ * timing.
*
* ---------------------------------------------------------------------------*/
-/* The interval timer is used for profiling and for context switching.
- * This file defines the platform-specific services to install and run the
- * timers, and we call this the ticker. See rts/Timer.c for the
- * platform-dependent view of interval timing.
+/* This implementation uses a posix thread which repeatedly blocks on a timeout
+ * using either the ppoll() or select() API. This lets it also block on a file
+ * descriptor for early wakeup.
+ *
+ * The design uses a simple relative time delay with no catchup. That is, time
+ * spent by the ticker thread itself (e.g. flushing eventlog buffers) is not
+ * accounted for, and the next tick is delayed by that much (modulo wakeup
+ * jitter). This is probably the right thing to do: generally in realtime
+ * systems one does not want to try to catch up when behind, since that tends
+ * towards oversubscribing resources. Graceful degredation is usually
+ * preferable.
+ *
+ * Experimental results (on Linux 6.18 on x86-64) to measure the typical
+ * difference between the requested wakeup time and actual wakeup time for
+ * different delay intervals:
+ *
+ * interval typical actual wakeup time after due time
+ * 10000us 340 -- 400us (this is the default interval)
+ * 1000us 55 -- 100us
+ * 100us 55us
+ * 10us 55us
+ *
+ * While there's quite a bit of variance to these numbers, the results do not
+ * vary significantly between using select, ppoll or nanosleep.
+ *
+ * On Linux at least, for longer delays the kernel allows itself lower wakeup
+ * accuracy (which allows it to save power by coalescing multiple wakeups).
+ * Similarly, the reason for 55us on the low end is that the default thread
+ * timer slack on Linux is 50us, and context switch time accounts for the
+ * remainder.
+ *
+ * In conclusion, on Linux at least, the accuracy is fine, both for the
+ * default interval (10ms, 10000us) and for shorter intervals used during
+ * profiling.
*
* Historically we had ticker implementations using signals. This was always a
- * rather shakey thing to do but we had few alternatives.
+ * rather shakey thing to do but we originally had few alternatives.
* - One problem with using signals is that there are severe limits on what
* code can be called from signal handlers. In particular it's not possible
* to take locks in a signal handler contex. This was enough for contex
@@ -23,17 +57,245 @@
* calls (#10840) or can be overwritten by user code.
*/
-/* Select a ticker implementation to use:
- *
- * On modern Linux, FreeBSD and NetBSD we can use timerfd_create and a thread
- * that waits on it using poll. Linux has had timerfd since version 2.6.25.
- * NetBSD has had timerfd since version 10, and FreeBSD since version 15.
- *
- * For older version of linux/bsd without timerfd, and for all other posix
- * platforms, we use the implementation using posix pthreads and nanosleep().
+#include "rts/PosixSource.h"
+#include "Rts.h"
+
+#include "Ticker.h"
+#include "RtsUtils.h"
+#include "Proftimer.h"
+#include "Schedule.h"
+#include "posix/Clock.h"
+#include "posix/FdWakeup.h"
+
+#if defined(HAVE_DECL_PPOLL) && HAVE_DECL_PPOLL == 1
+/* We prefer the ppoll() function if available since it allows sanely waiting
+ * on a single fd with precise timeouts (nanosecond precision). It is not in
+ * the posix standard however and some platforms (notably glibc and freebsd)
+ * need special CPP defines to make it available:
+ */
+#define _GNU_SOURCE 1
+#define __BSD_VISIBLE 1
+#include <signal.h>
+#include <poll.h>
+#else
+/* Otherwise we use the classic select(), which does have microsecond
+ * precision, but requires we build three whole 1024 bit (128 byte) fd sets
+ * just to wait on one fd.
*/
-#if defined(HAVE_SYS_TIMERFD_H)
-#include "ticker/TimerFd.c"
+#include <sys/select.h>
+#endif
+
+#include <time.h>
+#if HAVE_SYS_TIME_H
+# include <sys/time.h>
+#endif
+
+#if defined(HAVE_SIGNAL_H)
+# include <signal.h>
+#endif
+
+#include <string.h>
+
+#include <pthread.h>
+#if defined(HAVE_PTHREAD_NP_H)
+#include <pthread_np.h>
+#endif
+#include <unistd.h>
+#include <fcntl.h>
+
+static Time itimer_interval = DEFAULT_TICK_INTERVAL;
+
+// Should we be firing ticks?
+// Writers to this must hold the mutex below.
+static bool stopped = false;
+
+// should the ticker thread exit?
+// This can be set without holding the mutex.
+static bool exited = true;
+
+// Signaled when we want to (re)start the timer
+static Condition start_cond;
+static Mutex mutex;
+static OSThreadId thread;
+
+// fds for interrupting the ticker
+static int interruptfd_r = -1, interruptfd_w = -1;
+
+static void *itimer_thread_func(void *_handle_tick)
+{
+ TickProc handle_tick = _handle_tick;
+
+#if defined(HAVE_DECL_PPOLL) && HAVE_DECL_PPOLL == 1
+ struct pollfd pollfds[1];
+
+ pollfds[0].fd = interruptfd_r;
+ pollfds[0].events = POLLIN;
+
+ struct timespec ts = { .tv_sec = TimeToSeconds(itimer_interval)
+ , .tv_nsec = TimeToNS(itimer_interval) % 1000000000
+ };
#else
-#include "ticker/Pthread.c"
+ fd_set selectfds;
+ FD_ZERO(&selectfds);
+ FD_SET(interruptfd_r, &selectfds);
+
+ struct timeval tv = { .tv_sec = TimeToSeconds(itimer_interval)
+ /* convert remainder time in nanoseconds
+ to microseconds, rounding up: */
+ , .tv_usec = ((TimeToNS(itimer_interval) % 1000000000)
+ + 999) / 1000
+ };
+#endif
+
+ // Relaxed is sufficient: If we don't see that exited was set in one iteration we will
+ // see it next time.
+ while (!RELAXED_LOAD_ALWAYS(&exited)) {
+
+#if defined(HAVE_DECL_PPOLL) && HAVE_DECL_PPOLL == 1
+ int nfds = 1;
+ int nready = ppoll(pollfds, nfds, &ts, NULL);
+#else
+ struct timeval tv_tmp = tv; // copy since select may change this value.
+ int nfds = interruptfd_r+1;
+ int nready = select(nfds, &selectfds, NULL, NULL, &tv_tmp);
+#endif
+ // In either case (ppoll or select), the result nready is the number
+ // of fds that are ready.
+ if (RTS_LIKELY(nready == 0)) {
+ // Timer expired, not interrupted, continue.
+ } else if (nready > 0) {
+ // We only monitor one fd (the interruptfd_r), so we know
+ // it is that fd that is ready without any further checks.
+ collectFdWakeup(interruptfd_r);
+ // No further action needed, continue on to handling the final tick
+ // and then stop.
+
+ // Note that we rely on sendFdWakeup and select/poll to provide the
+ // happens-before relation. So if 'exited' was set before calling
+ // sendFdWakeup, then we should be able to reliably read it after.
+ // And thus reading 'exited' in the while loop guard is ok.
+ } else {
+ // While the RTS attempts to mask signals, some foreign libraries
+ // that rely on signal delivery may unmask them. Consequently we
+ // may see EINTR. See #24610.
+ if (errno != EINTR) {
+ sysErrorBelch("Ticker: poll failed: %s", strerror(errno));
+ }
+ }
+
+ // first try a cheap test
+ if (RELAXED_LOAD_ALWAYS(&stopped)) {
+ OS_ACQUIRE_LOCK(&mutex);
+ // should we really stop?
+ if (stopped) {
+ waitCondition(&start_cond, &mutex);
+ }
+ OS_RELEASE_LOCK(&mutex);
+ } else {
+ handle_tick(0);
+ }
+ }
+
+ return NULL;
+}
+
+void
+initTicker (Time interval, TickProc handle_tick)
+{
+ itimer_interval = interval;
+ stopped = true;
+ exited = false;
+#if defined(HAVE_SIGNAL_H)
+ sigset_t mask, omask;
+ int sigret;
+#endif
+ int ret;
+
+ initCondition(&start_cond);
+ initMutex(&mutex);
+
+ /* Open the interrupt fd synchronously.
+ *
+ * We used to do it in itimer_thread_func (i.e. in the timer thread) but it
+ * meant that some user code could run before it and get confused by the
+ * allocation of the timerfd.
+ *
+ * See hClose002 which unsafely closes a file descriptor twice expecting an
+ * exception the second time: it sometimes failed when the second call to
+ * "close" closed our own timerfd which inadvertently reused the same file
+ * descriptor closed by the first call! (see #20618)
+ */
+
+ if (interruptfd_r != -1) {
+ // don't leak the old file descriptors after a fork (#25280)
+ closeFdWakeup(interruptfd_r, interruptfd_w);
+ }
+ newFdWakeup(&interruptfd_r, &interruptfd_w);
+
+ /*
+ * Create the thread with all blockable signals blocked, leaving signal
+ * handling to the main and/or other threads. This is especially useful in
+ * the non-threaded runtime, where applications might expect sigprocmask(2)
+ * to effectively block signals.
+ */
+#if defined(HAVE_SIGNAL_H)
+ sigfillset(&mask);
+ sigret = pthread_sigmask(SIG_SETMASK, &mask, &omask);
+#endif
+ ret = createAttachedOSThread(&thread, "ghc_ticker", itimer_thread_func, (void*)handle_tick);
+#if defined(HAVE_SIGNAL_H)
+ if (sigret == 0)
+ pthread_sigmask(SIG_SETMASK, &omask, NULL);
#endif
+
+ if (ret != 0) {
+ barf("Ticker: Failed to spawn thread: %s", strerror(errno));
+ }
+}
+
+void
+startTicker(void)
+{
+ OS_ACQUIRE_LOCK(&mutex);
+ RELAXED_STORE(&stopped, false);
+ signalCondition(&start_cond);
+ OS_RELEASE_LOCK(&mutex);
+}
+
+/* There may be at most one additional tick fired after a call to this */
+void
+stopTicker(void)
+{
+ OS_ACQUIRE_LOCK(&mutex);
+ RELAXED_STORE(&stopped, true);
+ OS_RELEASE_LOCK(&mutex);
+}
+
+/* There may be at most one additional tick fired after a call to this */
+void
+exitTicker (bool wait)
+{
+ ASSERT(!SEQ_CST_LOAD(&exited));
+ SEQ_CST_STORE(&exited, true);
+ // ensure that ticker wakes up if stopped
+ startTicker();
+ sendFdWakeup(interruptfd_w);
+
+ // wait for ticker to terminate if necessary
+ if (wait) {
+ if (pthread_join(thread, NULL)) {
+ sysErrorBelch("Ticker: Failed to join: %s", strerror(errno));
+ }
+ closeFdWakeup(interruptfd_r, interruptfd_w);
+ closeMutex(&mutex);
+ closeCondition(&start_cond);
+ } else {
+ pthread_detach(thread);
+ }
+}
+
+int
+rtsTimerSignal(void)
+{
+ return SIGALRM;
+}
=====================================
rts/posix/ticker/Pthread.c deleted
=====================================
@@ -1,195 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team, 1995-2007
- *
- * Interval timer for profiling and pre-emptive scheduling.
- *
- * ---------------------------------------------------------------------------*/
-
-/*
- * We use a realtime timer by default. I found this much more
- * reliable than a CPU timer:
- *
- * Experiments with different frequencies: using
- * CLOCK_REALTIME/CLOCK_MONOTONIC on Linux 2.6.32,
- * 1000us has <1% impact on runtime
- * 100us has ~2% impact on runtime
- * 10us has ~40% impact on runtime
- *
- * using CLOCK_PROCESS_CPUTIME_ID on Linux 2.6.32,
- * I cannot get it to tick faster than 10ms (10000us)
- * which isn't great for profiling.
- *
- * In the threaded RTS, we can't tick in CPU time because the thread
- * which has the virtual timer might be idle, so the tick would never
- * fire. Therefore we used to tick in realtime in the threaded RTS and
- * in CPU time otherwise, but now we always tick in realtime, for
- * several reasons:
- *
- * - resolution (see above)
- * - consistency (-threaded is the same as normal)
- * - more consistency: Windows only has a realtime timer
- *
- * Note we want to use CLOCK_MONOTONIC rather than CLOCK_REALTIME,
- * because the latter may jump around (NTP adjustments, leap seconds
- * etc.).
- */
-
-#include "rts/PosixSource.h"
-#include "Rts.h"
-
-#include "Ticker.h"
-#include "RtsUtils.h"
-#include "Proftimer.h"
-#include "Schedule.h"
-#include "posix/Clock.h"
-#include <poll.h>
-
-#include <time.h>
-#if HAVE_SYS_TIME_H
-# include <sys/time.h>
-#endif
-
-#if defined(HAVE_SIGNAL_H)
-# include <signal.h>
-#endif
-
-#include <string.h>
-
-#include <pthread.h>
-#if defined(HAVE_PTHREAD_NP_H)
-#include <pthread_np.h>
-#endif
-#include <unistd.h>
-#include <fcntl.h>
-
-/*
- * TFD_CLOEXEC has been added in Linux 2.6.26.
- * If it is not available, we use fcntl(F_SETFD).
- */
-#if !defined(TFD_CLOEXEC)
-#define TFD_CLOEXEC 0
-#endif
-
-static Time itimer_interval = DEFAULT_TICK_INTERVAL;
-
-// Should we be firing ticks?
-// Writers to this must hold the mutex below.
-static bool stopped = false;
-
-// should the ticker thread exit?
-// This can be set without holding the mutex.
-static bool exited = true;
-
-// Signaled when we want to (re)start the timer
-static Condition start_cond;
-static Mutex mutex;
-static OSThreadId thread;
-
-static void *itimer_thread_func(void *_handle_tick)
-{
- TickProc handle_tick = _handle_tick;
-
- // Relaxed is sufficient: If we don't see that exited was set in one iteration we will
- // see it next time.
- while (!RELAXED_LOAD_ALWAYS(&exited)) {
- if (rtsSleep(itimer_interval) != 0) {
- sysErrorBelch("Ticker: sleep failed: %s", strerror(errno));
- }
-
- // first try a cheap test
- if (RELAXED_LOAD_ALWAYS(&stopped)) {
- OS_ACQUIRE_LOCK(&mutex);
- // should we really stop?
- if (stopped) {
- waitCondition(&start_cond, &mutex);
- }
- OS_RELEASE_LOCK(&mutex);
- } else {
- handle_tick(0);
- }
- }
-
- return NULL;
-}
-
-void
-initTicker (Time interval, TickProc handle_tick)
-{
- itimer_interval = interval;
- stopped = true;
- exited = false;
-#if defined(HAVE_SIGNAL_H)
- sigset_t mask, omask;
- int sigret;
-#endif
- int ret;
-
- initCondition(&start_cond);
- initMutex(&mutex);
-
- /*
- * Create the thread with all blockable signals blocked, leaving signal
- * handling to the main and/or other threads. This is especially useful in
- * the non-threaded runtime, where applications might expect sigprocmask(2)
- * to effectively block signals.
- */
-#if defined(HAVE_SIGNAL_H)
- sigfillset(&mask);
- sigret = pthread_sigmask(SIG_SETMASK, &mask, &omask);
-#endif
- ret = createAttachedOSThread(&thread, "ghc_ticker", itimer_thread_func, (void*)handle_tick);
-#if defined(HAVE_SIGNAL_H)
- if (sigret == 0)
- pthread_sigmask(SIG_SETMASK, &omask, NULL);
-#endif
-
- if (ret != 0) {
- barf("Ticker: Failed to spawn thread: %s", strerror(errno));
- }
-}
-
-void
-startTicker(void)
-{
- OS_ACQUIRE_LOCK(&mutex);
- RELAXED_STORE(&stopped, false);
- signalCondition(&start_cond);
- OS_RELEASE_LOCK(&mutex);
-}
-
-/* There may be at most one additional tick fired after a call to this */
-void
-stopTicker(void)
-{
- OS_ACQUIRE_LOCK(&mutex);
- RELAXED_STORE(&stopped, true);
- OS_RELEASE_LOCK(&mutex);
-}
-
-/* There may be at most one additional tick fired after a call to this */
-void
-exitTicker (bool wait)
-{
- ASSERT(!SEQ_CST_LOAD(&exited));
- SEQ_CST_STORE(&exited, true);
- // ensure that ticker wakes up if stopped
- startTicker();
-
- // wait for ticker to terminate if necessary
- if (wait) {
- if (pthread_join(thread, NULL)) {
- sysErrorBelch("Ticker: Failed to join: %s", strerror(errno));
- }
- closeMutex(&mutex);
- closeCondition(&start_cond);
- } else {
- pthread_detach(thread);
- }
-}
-
-int
-rtsTimerSignal(void)
-{
- return SIGALRM;
-}
=====================================
rts/posix/ticker/TimerFd.c deleted
=====================================
@@ -1,291 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team, 1995-2023
- *
- * Interval timer for profiling and pre-emptive scheduling.
- *
- * ---------------------------------------------------------------------------*/
-
-/*
- * We use a realtime timer by default. I found this much more
- * reliable than a CPU timer:
- *
- * Experiments with different frequencies: using
- * CLOCK_REALTIME/CLOCK_MONOTONIC on Linux 2.6.32,
- * 1000us has <1% impact on runtime
- * 100us has ~2% impact on runtime
- * 10us has ~40% impact on runtime
- *
- * using CLOCK_PROCESS_CPUTIME_ID on Linux 2.6.32,
- * I cannot get it to tick faster than 10ms (10000us)
- * which isn't great for profiling.
- *
- * In the threaded RTS, we can't tick in CPU time because the thread
- * which has the virtual timer might be idle, so the tick would never
- * fire. Therefore we used to tick in realtime in the threaded RTS and
- * in CPU time otherwise, but now we always tick in realtime, for
- * several reasons:
- *
- * - resolution (see above)
- * - consistency (-threaded is the same as normal)
- * - more consistency: Windows only has a realtime timer
- *
- * Note we want to use CLOCK_MONOTONIC rather than CLOCK_REALTIME,
- * because the latter may jump around (NTP adjustments, leap seconds
- * etc.).
- */
-
-#include "rts/PosixSource.h"
-#include "Rts.h"
-
-#include "Ticker.h"
-#include "RtsUtils.h"
-#include "Proftimer.h"
-#include "Schedule.h"
-#include "posix/Clock.h"
-#include <poll.h>
-
-#include <time.h>
-#if HAVE_SYS_TIME_H
-# include <sys/time.h>
-#endif
-
-#if defined(HAVE_SIGNAL_H)
-# include <signal.h>
-#endif
-
-#include <string.h>
-
-#include <pthread.h>
-#if defined(HAVE_PTHREAD_NP_H)
-#include <pthread_np.h>
-#endif
-#include <unistd.h>
-#include <fcntl.h>
-
-#include <sys/timerfd.h>
-
-
-/*
- * TFD_CLOEXEC has been added in Linux 2.6.26.
- * If it is not available, we use fcntl(F_SETFD).
- */
-#if !defined(TFD_CLOEXEC)
-#define TFD_CLOEXEC 0
-#endif
-
-static Time itimer_interval = DEFAULT_TICK_INTERVAL;
-
-// Should we be firing ticks?
-// Writers to this must hold the mutex below.
-static bool stopped = false;
-
-// should the ticker thread exit?
-// This can be set without holding the mutex.
-static bool exited = true;
-
-// Signaled when we want to (re)start the timer
-static Condition start_cond;
-static Mutex mutex;
-static OSThreadId thread;
-
-// file descriptor for the timer (Linux only)
-static int timerfd = -1;
-
-// pipe for signaling exit
-static int pipefds[2];
-
-static void *itimer_thread_func(void *_handle_tick)
-{
- TickProc handle_tick = _handle_tick;
- uint64_t nticks;
- ssize_t r = 0;
- struct pollfd pollfds[2];
-
- pollfds[0].fd = pipefds[0];
- pollfds[0].events = POLLIN;
- pollfds[1].fd = timerfd;
- pollfds[1].events = POLLIN;
-
- // Relaxed is sufficient: If we don't see that exited was set in one iteration we will
- // see it next time.
- while (!RELAXED_LOAD_ALWAYS(&exited)) {
- if (poll(pollfds, 2, -1) == -1) {
- // While the RTS attempts to mask signals, some foreign libraries
- // may rely on signal delivery may unmask them. Consequently we may
- // see EINTR. See #24610.
- if (errno != EINTR) {
- sysErrorBelch("Ticker: poll failed: %s", strerror(errno));
- }
- }
-
- // We check the pipe first, even though the timerfd may also have triggered.
- if (pollfds[0].revents & POLLIN) {
- // the pipe is ready for reading, the only possible reason is that we're exiting
- exited = true; // set this again to make sure even RELAXED_LOAD will read the proper value
- // no further action needed, skip ahead to handling the final tick and then stopping
- }
- else if (pollfds[1].revents & POLLIN) { // the timerfd is ready for reading
- r = read(timerfd, &nticks, sizeof(nticks)); // this should never block now
-
- if ((r == 0) && (errno == 0)) {
- /* r == 0 is expected only for non-blocking fd (in which case
- * errno should be EAGAIN) but we use a blocking fd.
- *
- * Due to a kernel bug (cf https://lkml.org/lkml/2019/8/16/335)
- * on some platforms we could see r == 0 and errno == 0.
- */
- IF_DEBUG(scheduler, debugBelch("read(timerfd) returned 0 with errno=0. This is a known kernel bug. We just ignore it."));
- }
- else if (r != sizeof(nticks) && errno != EINTR) {
- barf("Ticker: read(timerfd) failed with %s and returned %zd", strerror(errno), r);
- }
- }
-
- // first try a cheap test
- if (RELAXED_LOAD_ALWAYS(&stopped)) {
- OS_ACQUIRE_LOCK(&mutex);
- // should we really stop?
- if (stopped) {
- waitCondition(&start_cond, &mutex);
- }
- OS_RELEASE_LOCK(&mutex);
- } else {
- handle_tick(0);
- }
- }
-
- close(timerfd);
- return NULL;
-}
-
-void
-initTicker (Time interval, TickProc handle_tick)
-{
- itimer_interval = interval;
- stopped = true;
- exited = false;
-#if defined(HAVE_SIGNAL_H)
- sigset_t mask, omask;
- int sigret;
-#endif
- int ret;
-
- initCondition(&start_cond);
- initMutex(&mutex);
-
- /* Open the file descriptor for the timer synchronously.
- *
- * We used to do it in itimer_thread_func (i.e. in the timer thread) but it
- * meant that some user code could run before it and get confused by the
- * allocation of the timerfd.
- *
- * See hClose002 which unsafely closes a file descriptor twice expecting an
- * exception the second time: it sometimes failed when the second call to
- * "close" closed our own timerfd which inadvertently reused the same file
- * descriptor closed by the first call! (see #20618)
- */
- struct itimerspec it;
- it.it_value.tv_sec = TimeToSeconds(itimer_interval);
- it.it_value.tv_nsec = TimeToNS(itimer_interval) % 1000000000;
- it.it_interval = it.it_value;
-
- if (timerfd != -1) {
- // don't leak the old file descriptors after a fork (#25280)
- close(timerfd);
- close(pipefds[0]);
- close(pipefds[1]);
- timerfd = -1;
- }
-
- timerfd = timerfd_create(CLOCK_MONOTONIC, TFD_CLOEXEC);
- if (timerfd == -1) {
- barf("timerfd_create: %s", strerror(errno));
- }
- if (!TFD_CLOEXEC) {
- fcntl(timerfd, F_SETFD, FD_CLOEXEC);
- }
- if (timerfd_settime(timerfd, 0, &it, NULL)) {
- barf("timerfd_settime: %s", strerror(errno));
- }
-
- if (pipe(pipefds) < 0) {
- barf("pipe: %s", strerror(errno));
- }
-
- /*
- * Create the thread with all blockable signals blocked, leaving signal
- * handling to the main and/or other threads. This is especially useful in
- * the non-threaded runtime, where applications might expect sigprocmask(2)
- * to effectively block signals.
- */
-#if defined(HAVE_SIGNAL_H)
- sigfillset(&mask);
- sigret = pthread_sigmask(SIG_SETMASK, &mask, &omask);
-#endif
- ret = createAttachedOSThread(&thread, "ghc_ticker", itimer_thread_func, (void*)handle_tick);
-#if defined(HAVE_SIGNAL_H)
- if (sigret == 0)
- pthread_sigmask(SIG_SETMASK, &omask, NULL);
-#endif
-
- if (ret != 0) {
- barf("Ticker: Failed to spawn thread: %s", strerror(errno));
- }
-}
-
-void
-startTicker(void)
-{
- OS_ACQUIRE_LOCK(&mutex);
- RELAXED_STORE(&stopped, false);
- signalCondition(&start_cond);
- OS_RELEASE_LOCK(&mutex);
-}
-
-/* There may be at most one additional tick fired after a call to this */
-void
-stopTicker(void)
-{
- OS_ACQUIRE_LOCK(&mutex);
- RELAXED_STORE(&stopped, true);
- OS_RELEASE_LOCK(&mutex);
-}
-
-/* There may be at most one additional tick fired after a call to this */
-void
-exitTicker (bool wait)
-{
- ASSERT(!SEQ_CST_LOAD(&exited));
- SEQ_CST_STORE(&exited, true);
- // ensure that ticker wakes up if stopped
- startTicker();
-
- // wait for ticker to terminate if necessary
- if (wait) {
- // write anything to the pipe to trigger poll() in the ticker thread
- if (write(pipefds[1], "stop", 5) < 0) {
- sysErrorBelch("Ticker: Failed to write to pipe: %s", strerror(errno));
- }
-
- if (pthread_join(thread, NULL)) {
- sysErrorBelch("Ticker: Failed to join: %s", strerror(errno));
- }
-
- // These need to happen AFTER the ticker thread has finished to prevent a race condition
- // where the ticker thread closes the read end of the pipe before we're done writing to it.
- close(pipefds[0]);
- close(pipefds[1]);
-
- closeMutex(&mutex);
- closeCondition(&start_cond);
- } else {
- pthread_detach(thread);
- }
-}
-
-int
-rtsTimerSignal(void)
-{
- return SIGALRM;
-}
=====================================
rts/rts.cabal
=====================================
@@ -582,11 +582,9 @@ library
posix/Ticker.c
posix/OSMem.c
posix/OSThreads.c
+ posix/FdWakeup.c
posix/Poll.c
posix/Select.c
posix/Signals.c
posix/Timeout.c
posix/TTY.c
- -- ticker/*.c
- -- We don't want to compile posix/ticker/*.c, these will be #included
- -- from Ticker.c
=====================================
testsuite/driver/testlib.py
=====================================
@@ -3043,6 +3043,12 @@ def normalise_errmsg(s: str) -> str:
# Old emcc warns when we export HEAP8 but new one requires it (see #26290)
s = s.replace('warning: invalid item in EXPORTED_RUNTIME_METHODS: HEAP8\nwarning: invalid item in EXPORTED_RUNTIME_METHODS: HEAPU8\nemcc: warning: warnings in JS library compilation [-Wjs-compiler]\n','')
+ # on newer versions of MacOS X, the shipped ranlib warns about object files with no symbols,
+ # however, these are completely benign stubs.
+ # See https://gitlab.haskell.org/ghc/ghc/-/issues/27116
+ if opsys('darwin'):
+ s = modify_lines(s, lambda l: re.sub(r'.*ranlib:.*has no symbols', '', l))
+
return s
# normalise a .prof file, so that we can reasonably compare it against
=====================================
testsuite/tests/driver/all.T
=====================================
@@ -120,9 +120,7 @@ if config.os == 'darwin':
else:
only_darwin = skip
-test('static001', [extra_files(['Static001.hs']),
- only_darwin,
- when(arch('x86_64'), expect_broken(8127))],
+test('static001', [extra_files(['Static001.hs']), only_darwin],
makefile_test, ['static001'])
test('dynHelloWorld',
=====================================
testsuite/tests/driver/bytecode-object/Makefile
=====================================
@@ -159,3 +159,9 @@ bytecode_object25:
"$(TEST_HC)" $(TEST_HC_OPTS) -c BytecodeForeign.hs -fbyte-code -fwrite-byte-code -fwrite-interface $(ghciWayFlags)
"$(TEST_HC)" $(TEST_HC_OPTS_INTERACTIVE) -v1 -fno-hide-source-paths -fbyte-code -fwrite-byte-code -fwrite-interface BytecodeForeign.hs -e "testForeign"
+# Test that corrupt bytecode file headers are rejected clearly.
+bytecode_object26:
+ "$(TEST_HC)" $(TEST_HC_OPTS) -c BytecodeTest.hs -fbyte-code -fwrite-byte-code
+ @printf 'bad!' | dd of=BytecodeTest.gbc bs=1 count=4 conv=notrunc 2>/dev/null
+ ! "$(TEST_HC)" $(TEST_HC_OPTS) -c -bytecodelib -o linked.bytecode BytecodeTest.gbc 2> bytecode_object26.stderr
+ @grep -F "bytecode file header mismatch" bytecode_object26.stderr >/dev/null
=====================================
testsuite/tests/driver/bytecode-object/all.T
=====================================
@@ -26,3 +26,4 @@ test('bytecode_object22', bytecode_opts, makefile_test, ['bytecode_object22'])
test('bytecode_object23', bytecode_opts, makefile_test, ['bytecode_object23'])
test('bytecode_object24', bytecode_opts + [copy_files], makefile_test, ['bytecode_object24'])
test('bytecode_object25', [bytecode_opts, req_interp, extra_files(['BytecodeForeign.hs', 'BytecodeForeign.c'])], makefile_test, ['bytecode_object25'])
+test('bytecode_object26', [bytecode_opts], makefile_test, ['bytecode_object26'])
=====================================
testsuite/tests/plugins/Makefile
=====================================
@@ -238,3 +238,10 @@ test-late-plugin:
.PHONY: T21730
T21730:
"$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) -v0 T21730.hs -package-db T21730-plugin/pkg.T21730-plugin/local.package.conf
+
+# Test that .dyn_o files are accepted as valid object files on the command line
+# without producing "ignoring unrecognised input" warnings (#24486)
+.PHONY: T24486
+T24486:
+ "$(TEST_HC)" $(TEST_HC_OPTS) -v0 -c T24486_Helper.hs -osuf dyn_o
+ "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) -v0 T24486.hs T24486_Helper.dyn_o -package-db T24486-plugin/pkg.T24486-plugin/local.package.conf -fplugin T24486_Plugin -plugin-package T24486-plugin
=====================================
testsuite/tests/plugins/T24486-plugin/Makefile
=====================================
@@ -0,0 +1,18 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
+
+clean.%:
+ rm -rf pkg.$*
+
+HERE := $(abspath .)
+$(eval $(call canonicalise,HERE))
+
+package.%:
+ $(MAKE) -s --no-print-directory clean.$*
+ mkdir pkg.$*
+ "$(TEST_HC)" -outputdir pkg.$* --make -v0 -o pkg.$*/setup Setup.hs
+ "$(GHC_PKG)" init pkg.$*/local.package.conf
+ pkg.$*/setup configure --distdir pkg.$*/dist -v0 $(CABAL_PLUGIN_BUILD) --prefix="$(HERE)/pkg.$*/install" --with-compiler="$(TEST_HC)" --with-hc-pkg="$(GHC_PKG)" --package-db=pkg.$*/local.package.conf $(if $(findstring YES,$(HAVE_PROFILING)), --enable-library-profiling)
+ pkg.$*/setup build --distdir pkg.$*/dist -v0
+ pkg.$*/setup install --distdir pkg.$*/dist -v0
=====================================
testsuite/tests/plugins/T24486-plugin/Setup.hs
=====================================
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
=====================================
testsuite/tests/plugins/T24486-plugin/T24486-plugin.cabal
=====================================
@@ -0,0 +1,9 @@
+Name: T24486-plugin
+Version: 0.1
+Synopsis: For testing
+Cabal-Version: >= 1.2
+Build-Type: Simple
+
+Library
+ Build-Depends: base, ghc
+ Exposed-Modules: T24486_Plugin
=====================================
testsuite/tests/plugins/T24486-plugin/T24486_Plugin.hs
=====================================
@@ -0,0 +1,6 @@
+module T24486_Plugin (plugin) where
+
+import GHC.Plugins
+
+plugin :: Plugin
+plugin = defaultPlugin
=====================================
testsuite/tests/plugins/T24486.hs
=====================================
@@ -0,0 +1,4 @@
+module Main where
+
+main :: IO ()
+main = return ()
=====================================
testsuite/tests/plugins/T24486_Helper.hs
=====================================
@@ -0,0 +1,4 @@
+module T24486_Helper where
+
+helper :: Int
+helper = 42
=====================================
testsuite/tests/plugins/all.T
=====================================
@@ -395,3 +395,10 @@ test('T21730',
pre_cmd('$MAKE -s --no-print-directory -C T21730-plugin package.T21730-plugin TOP={top}')
],
makefile_test, [])
+
+test('T24486',
+ [extra_files(['T24486-plugin/', 'T24486_Helper.hs']),
+ when(opsys('mingw32'), skip),
+ pre_cmd('$MAKE -s --no-print-directory -C T24486-plugin package.T24486-plugin TOP={top}')
+ ],
+ makefile_test, [])
=====================================
testsuite/tests/runghc/Makefile
=====================================
@@ -23,6 +23,11 @@ T11247:
-'$(RUNGHC)' foo.
-'$(RUNGHC)' foo.bar
+# runghc should honour -osuf for dependencies too (#16145).
+T16145:
+ '$(RUNGHC)' -- -fobject-code -osuf=hs.o T16145
+ printf '%s\n' *.hi *.o *.hs | LC_ALL=C sort
+
T17171a:
'$(RUNGHC)' --ghc-arg=-Wall T17171a.hs
T17171b:
=====================================
testsuite/tests/runghc/T16145.hs
=====================================
@@ -0,0 +1,5 @@
+module T16145 where
+
+import T16145_aux
+
+main = g
=====================================
testsuite/tests/runghc/T16145.stdout
=====================================
@@ -0,0 +1,6 @@
+T16145.hi
+T16145.hs
+T16145.hs.o
+T16145_aux.hi
+T16145_aux.hs
+T16145_aux.hs.o
=====================================
testsuite/tests/runghc/T16145_aux.hs
=====================================
@@ -0,0 +1,4 @@
+module T16145_aux where
+
+g :: IO ()
+g = return ()
=====================================
testsuite/tests/runghc/all.T
=====================================
@@ -4,6 +4,8 @@ test('T8601', req_interp, makefile_test, [])
test('T11247', [req_interp, expect_broken(11247)], makefile_test, [])
+test('T16145', req_interp, makefile_test, [])
+
test('T6132', [],
compile, [''])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5c57fa5f1a3fbba72a653dc8ecf2c3…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5c57fa5f1a3fbba72a653dc8ecf2c3…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/spj-reinstallable-base] Onward [skip ci]
by Simon Peyton Jones (＠simonpj) 02 Apr '26
by Simon Peyton Jones (＠simonpj) 02 Apr '26
02 Apr '26
Simon Peyton Jones pushed to branch wip/spj-reinstallable-base at Glasgow Haskell Compiler / GHC
Commits:
5a6fbce9 by Simon Peyton Jones at 2026-04-03T00:52:08+01:00
Onward [skip ci]
- - - - -
11 changed files:
- compiler/GHC/Builtin/Names.hs
- compiler/GHC/HsToCore/ListComp.hs
- compiler/GHC/HsToCore/Monad.hs
- compiler/GHC/HsToCore/Quote.hs
- compiler/GHC/Parser/PostProcess.hs
- compiler/GHC/Rename/Env.hs
- compiler/GHC/Tc/Deriv/Generate.hs
- compiler/GHC/Tc/Gen/Splice.hs
- compiler/GHC/ThToHs.hs
- compiler/GHC/Types/Name/Reader.hs
- compiler/GHC/Types/Unique.hs
Changes:
=====================================
compiler/GHC/Builtin/Names.hs
=====================================
@@ -206,7 +206,6 @@ knownKeyOccName std_uniq
basicKnownKeyTable :: [(OccName, KnownKeyNameKey)]
basicKnownKeyTable
= [ (mkTcOcc "Rational", rationalTyConKey)
- , (mkTcOcc "Ord", ordClassKey)
, (mkTcOcc "Show", showClassKey)
, (mkTcOcc "Foldable", foldableClassKey)
, (mkTcOcc "Traversable", traversableClassKey)
@@ -218,9 +217,18 @@ basicKnownKeyTable
, (mkTcOcc "Ix", ixClassKey)
, (mkTcOcc "Alternative", alternativeClassKey)
- -- Class Eq
+ -- Class Eq and Ord
, (mkTcOcc "Eq", eqClassKey)
+ , (mkTcOcc "Ord", ordClassKey)
, (mkVarOcc "==", eqClassOpKey)
+ , (mkVarOcc ">=", geClassOpKey)
+ , (mkVarOcc "<=", leClassOpKey)
+ , (mkVarOcc "<", ltClassOpKey)
+ , (mkVarOcc ">", gtClassOpKey)
+ , (mkVarOcc "compare", compareClassOpKey)
+ , (mkDataOcc "LT", ordLTDataConKey)
+ , (mkDataOcc "EQ", ordEQDataConKey)
+ , (mkDataOcc "GT", ordGTDataConKey)
-- Numeric operations
, (mkTcOcc "Num", numClassKey)
@@ -236,6 +244,7 @@ basicKnownKeyTable
-- Class Functor
, (mkTcOcc "Functor", functorClassKey)
, (mkVarOcc "fmap", fmapClassOpKey)
+ , (mkVarOcc "map", mapIdKey)
-- Class Monad, MonadFix, MonadZip
, (mkTcOcc "Monad", monadClassKey)
@@ -263,7 +272,7 @@ basicKnownKeyTable
, (mkTcOcc "IsString", isStringClassKey)
, (mkVarOcc "fromString", fromStringClassOpKey)
- -- Stuff for pre-typechecker expansion
+ -- Records
, (mkTcOcc "HasField", hasFieldClassKey)
, (mkVarOcc "fromLabel", fromLabelClassOpKey)
, (mkVarOcc "getField", getFieldClassOpKey)
@@ -420,9 +429,6 @@ basicKnownKeyNames
-- Dynamic
toDynName,
- -- Numeric stuff
- geName,
-
-- Conversion functions
ratioTyConName, ratioDataConName,
toIntegerName, toRationalName,
@@ -458,7 +464,7 @@ basicKnownKeyNames
nonEmptyTyConName,
-- List operations
- mapName, foldrName, buildName, augmentName,
+ foldrName, buildName, augmentName,
-- FFI primitive types that are not wired-in.
stablePtrTyConName, ptrTyConName, funPtrTyConName, constPtrConName,
@@ -727,6 +733,8 @@ mkMainModule_ m = mkModule mainUnit m
* *
************************************************************************
-}
+kk_RDR :: KnownKeyNameKey -> RdrName
+kk_RDR key = knownKeyRdrName key (knownKeyOccName key)
main_RDR_Unqual :: RdrName
main_RDR_Unqual = mkUnqual varName (fsLit "main")
@@ -735,17 +743,18 @@ main_RDR_Unqual = mkUnqual varName (fsLit "main")
ge_RDR, le_RDR, lt_RDR, gt_RDR, compare_RDR,
ltTag_RDR, eqTag_RDR, gtTag_RDR :: RdrName
-ge_RDR = nameRdrName geName
-le_RDR = varQual_RDR gHC_CLASSES (fsLit "<=")
-lt_RDR = varQual_RDR gHC_CLASSES (fsLit "<")
-gt_RDR = varQual_RDR gHC_CLASSES (fsLit ">")
-compare_RDR = varQual_RDR gHC_CLASSES (fsLit "compare")
-ltTag_RDR = nameRdrName ordLTDataConName
-eqTag_RDR = nameRdrName ordEQDataConName
-gtTag_RDR = nameRdrName ordGTDataConName
+eq_RDR = kk_RDR eqClassOpKey
+ge_RDR = kk_RDR geClassOpKey
+le_RDR = kk_RDR leClassOpKey
+lt_RDR = kk_RDR ltClassOpKey
+gt_RDR = kk_RDR gtClassOpKey
+compare_RDR = kk_RDR compareClassOpKey
+ltTag_RDR = kk_RDR ordLTDataConKey
+eqTag_RDR = kk_RDR ordEQDataConKey
+gtTag_RDR = kk_RDR ordGTDataConKey
map_RDR :: RdrName
-map_RDR = nameRdrName mapName
+map_RDR = kk_RDR mapIdKey
foldr_RDR, build_RDR, returnM_RDR, bindM_RDR, failM_RDR
:: RdrName
@@ -906,7 +915,7 @@ uWordHash_RDR = fieldQual_RDR gHC_INTERNAL_GENERICS (fsLit "UWord") (fsLit "
fmap_RDR, replace_RDR, pure_RDR, ap_RDR, liftA2_RDR, foldable_foldr_RDR,
foldMap_RDR, null_RDR, all_RDR, traverse_RDR, mempty_RDR,
mappend_RDR :: RdrName
-fmap_RDR = nameRdrName fmapName
+fmap_RDR = kk_RDR fmapClassOpKey
replace_RDR = varQual_RDR gHC_INTERNAL_BASE (fsLit "<$")
pure_RDR = nameRdrName pureAName
ap_RDR = nameRdrName apAName
@@ -951,7 +960,7 @@ runRWName = varQual gHC_MAGIC (fsLit "runRW#") runRWKey
orderingTyConName, ordLTDataConName, ordEQDataConName, ordGTDataConName :: Name
orderingTyConName = tcQual gHC_TYPES (fsLit "Ordering") orderingTyConKey
-ordLTDataConName = dcQual gHC_TYPES (fsLit "LT") ordLTDataConKey
+ordLTDataConName = dcQual gHC_TYPES (fsLit "LT")
ordEQDataConName = dcQual gHC_TYPES (fsLit "EQ") ordEQDataConKey
ordGTDataConName = dcQual gHC_TYPES (fsLit "GT") ordGTDataConKey
@@ -1029,12 +1038,6 @@ unpackCStringName, unpackCStringUtf8Name :: Name
unpackCStringName = varQual gHC_CSTRING (fsLit "unpackCString#") unpackCStringIdKey
unpackCStringUtf8Name = varQual gHC_CSTRING (fsLit "unpackCStringUtf8#") unpackCStringUtf8IdKey
--- Base classes (Eq, Ord, Functor)
-fmapName, geName, functorClassName :: Name
-geName = varQual gHC_CLASSES (fsLit ">=") geClassOpKey
-functorClassName = clsQual gHC_INTERNAL_BASE (fsLit "Functor") functorClassKey
-fmapName = varQual gHC_INTERNAL_BASE (fsLit "fmap") fmapClassOpKey
-
-- Class Monad
thenMName, bindMName, returnMName :: Name
thenMName = varQual gHC_INTERNAL_BASE (fsLit ">>") thenMClassOpKey
@@ -1076,14 +1079,13 @@ considerAccessibleName = varQual gHC_MAGIC (fsLit "considerAccessible") consider
-- Random GHC.Internal.Base functions
fromStringName, otherwiseIdName, foldrName, buildName, augmentName,
- mapName, assertName,
+ assertName,
dollarName :: Name
dollarName = varQual gHC_INTERNAL_BASE (fsLit "$") dollarIdKey
otherwiseIdName = varQual gHC_INTERNAL_BASE (fsLit "otherwise") otherwiseIdKey
foldrName = varQual gHC_INTERNAL_BASE (fsLit "foldr") foldrIdKey
buildName = varQual gHC_INTERNAL_BASE (fsLit "build") buildIdKey
augmentName = varQual gHC_INTERNAL_BASE (fsLit "augment") augmentIdKey
-mapName = varQual gHC_INTERNAL_BASE (fsLit "map") mapIdKey
assertName = varQual gHC_INTERNAL_BASE (fsLit "assert") assertIdKey
fromStringName = varQual gHC_INTERNAL_DATA_STRING (fsLit "fromString") fromStringClassOpKey
@@ -2063,7 +2065,7 @@ rootMainKey, runMainKey :: KnownKeyNameKey
rootMainKey = mkPreludeMiscIdUnique 101
runMainKey = mkPreludeMiscIdUnique 102
-thenIOIdKey, lazyIdKey, assertErrorIdKey, oneShotKey, runRWKey, seqHashKey :: KnownKeyNameKey
+thenIOIdKey, lazyIdKey, assertErrorIdKey, oneShotKey, runRWKey :: KnownKeyNameKey
thenIOIdKey = mkPreludeMiscIdUnique 103
lazyIdKey = mkPreludeMiscIdUnique 104
assertErrorIdKey = mkPreludeMiscIdUnique 105
@@ -2096,52 +2098,53 @@ rationalToFloatIdKey, rationalToDoubleIdKey :: KnownKeyNameKey
rationalToFloatIdKey = mkPreludeMiscIdUnique 132
rationalToDoubleIdKey = mkPreludeMiscIdUnique 133
-seqHashKey = mkPreludeMiscIdUnique 134
-
-coerceKey :: KnownKeyNameKey
-coerceKey = mkPreludeMiscIdUnique 157
-{-
-Certain class operations from Prelude classes. They get their own
-uniques so we can look them up easily when we want to conjure them up
-during type checking.
--}
+seqHashKey, coerceKey :: KnownKeyNameKey
+seqHashKey = mkPreludeMiscIdUnique 134
+coerceKey = mkPreludeMiscIdUnique 135
-- Just a placeholder for unbound variables produced by the renamer:
unboundKey :: KnownKeyNameKey
-unboundKey = mkPreludeMiscIdUnique 158
+unboundKey = mkPreludeMiscIdUnique 136
fromIntegerClassOpKey, minusClassOpKey, fromRationalClassOpKey,
enumFromClassOpKey, enumFromThenClassOpKey, enumFromToClassOpKey,
enumFromThenToClassOpKey, eqClassOpKey, geClassOpKey, negateClassOpKey,
bindMClassOpKey, thenMClassOpKey, returnMClassOpKey, fmapClassOpKey
:: KnownKeyNameKey
-fromIntegerClassOpKey = mkPreludeMiscIdUnique 160
-minusClassOpKey = mkPreludeMiscIdUnique 161
-fromRationalClassOpKey = mkPreludeMiscIdUnique 162
-enumFromClassOpKey = mkPreludeMiscIdUnique 163
-enumFromThenClassOpKey = mkPreludeMiscIdUnique 164
-enumFromToClassOpKey = mkPreludeMiscIdUnique 165
-enumFromThenToClassOpKey = mkPreludeMiscIdUnique 166
-eqClassOpKey = mkPreludeMiscIdUnique 167
-geClassOpKey = mkPreludeMiscIdUnique 168
-negateClassOpKey = mkPreludeMiscIdUnique 169
-bindMClassOpKey = mkPreludeMiscIdUnique 171 -- (>>=) 02L
-thenMClassOpKey = mkPreludeMiscIdUnique 172 -- (>>)
-fmapClassOpKey = mkPreludeMiscIdUnique 173
-returnMClassOpKey = mkPreludeMiscIdUnique 174
+fromIntegerClassOpKey = mkPreludeMiscIdUnique 140
+minusClassOpKey = mkPreludeMiscIdUnique 141
+fromRationalClassOpKey = mkPreludeMiscIdUnique 142
+enumFromClassOpKey = mkPreludeMiscIdUnique 143
+enumFromThenClassOpKey = mkPreludeMiscIdUnique 144
+enumFromToClassOpKey = mkPreludeMiscIdUnique 145
+enumFromThenToClassOpKey = mkPreludeMiscIdUnique 146
+
+eqClassOpKey = mkPreludeMiscIdUnique 147
+geClassOpKey = mkPreludeMiscIdUnique 148
+leClassOpKey = mkPreludeMiscIdUnique 149
+ltClassOpKey = mkPreludeMiscIdUnique 150
+gtClassOpKey = mkPreludeMiscIdUnique 151
+compareClassOpKey = mkPreludeMiscIdUnique 152
+
+
+negateClassOpKey = mkPreludeMiscIdUnique 153
+bindMClassOpKey = mkPreludeMiscIdUnique 154
+thenMClassOpKey = mkPreludeMiscIdUnique 155 -- (>>)
+fmapClassOpKey = mkPreludeMiscIdUnique 156
+returnMClassOpKey = mkPreludeMiscIdUnique 157
-- Recursive do notation
mfixIdKey :: KnownKeyNameKey
-mfixIdKey = mkPreludeMiscIdUnique 175
+mfixIdKey = mkPreludeMiscIdUnique 158
-- MonadFail operations
failMClassOpKey :: KnownKeyNameKey
-failMClassOpKey = mkPreludeMiscIdUnique 176
+failMClassOpKey = mkPreludeMiscIdUnique 159
-- fromLabel
fromLabelClassOpKey :: KnownKeyNameKey
-fromLabelClassOpKey = mkPreludeMiscIdUnique 177
+fromLabelClassOpKey = mkPreludeMiscIdUnique 160
-- Arrow notation
arrAIdKey, composeAIdKey, firstAIdKey, appAIdKey, choiceAIdKey,
@@ -2180,6 +2183,7 @@ ghciStepIoMClassOpKey = mkPreludeMiscIdUnique 197
isListClassKey, fromListClassOpKey, fromListNClassOpKey, toListClassOpKey :: KnownKeyNameKey
isListClassKey = mkPreludeMiscIdUnique 198
fromListClassOpKey = mkPreludeMiscIdUnique 199
+
fromListNClassOpKey = mkPreludeMiscIdUnique 500
toListClassOpKey = mkPreludeMiscIdUnique 501
=====================================
compiler/GHC/HsToCore/ListComp.hs
=====================================
@@ -118,7 +118,7 @@ dsTransStmt (TransStmt { trS_form = form, trS_stmts = stmts, trS_bndrs = binderM
-- Create an unzip function for the appropriate arity and element types and find "map"
unzip_stuff' <- mkUnzipBind form from_bndrs_tys
- map_id <- dsLookupGlobalId mapName
+ map_id <- dsLookupKnownKeyId mapIdKey
-- Generate the expressions to build the grouped list
let -- First we apply the grouping function to the inner list
=====================================
compiler/GHC/HsToCore/Monad.hs
=====================================
@@ -27,7 +27,7 @@ module GHC.HsToCore.Monad (
dsLookupGlobal, dsLookupGlobalId, dsLookupTyCon,
dsLookupDataCon, dsLookupConLike,
- dsLookupKnownKey, dsLookupKnownKeyTyCon, dsLookupKnownKeyId,
+ dsLookupKnownKeyTyCon, dsLookupKnownKeyId,
DsMetaEnv, DsMetaVal(..), dsGetMetaEnv, dsLookupMetaEnv, dsExtendMetaEnv,
@@ -563,13 +563,26 @@ mkNamePprCtxDs = ds_name_ppr_ctx <$> getGblEnv
instance MonadThings (IOEnv (Env DsGblEnv DsLclEnv)) where
lookupThing = dsLookupGlobal
-dsLookupKnownKey :: KnownKeyNameKey -> DsM TyThing
-dsLookupKnownKey uniq
+dsGetKnownKeySource :: DsM KnownKeyNameSource
+dsGetKnownKeySource
= do { rebindable_path <- goptM Opt_RebindableKnownKeyNames
- ; mb_rdr_env <- if rebindable_path
- then do { rdr_env <- dsGetGlobalRdrEnv
- ; return (KKNS_InScope rdr_env) }
- else return KKNS_FromModule
+ ; if rebindable_path
+ then do { rdr_env <- dsGetGlobalRdrEnv
+ ; return (KKNS_InScope rdr_env) }
+ else return KKNS_FromModule }
+
+dsLookupKnownKeyName :: KnownKeyNameKey -> DsM Name
+dsLookupKnownKeyName uniq
+ = do { rebindable_path <- dsGetKnownKeySource
+ ; dsToIfL $
+ do { mb_res <- lookupKnownKeyName mb_rdr_env uniq
+ ; case mb_res of
+ Succeeded name -> return name
+ Failed msg -> failIfM (pprDiagnostic msg) } }
+
+dsLookupKnownKeyThing :: KnownKeyNameKey -> DsM TyThing
+dsLookupKnownKeyThing uniq
+ = do { rebindable_path <- dsGetKnownKeySource
; dsToIfL $
do { mb_res <- lookupKnownKeyThing mb_rdr_env uniq
; case mb_res of
@@ -578,11 +591,11 @@ dsLookupKnownKey uniq
dsLookupKnownKeyTyCon :: KnownKeyNameKey -> DsM TyCon
dsLookupKnownKeyTyCon uniq
- = tyThingTyCon <$> dsLookupKnownKey uniq
+ = tyThingTyCon <$> dsLookupKnownKeyThing uniq
dsLookupKnownKeyId :: KnownKeyNameKey -> DsM Id
dsLookupKnownKeyId uniq
- = tyThingId <$> dsLookupKnownKey uniq
+ = tyThingId <$> dsLookupKnownKeyThing uniq
dsLookupGlobal :: Name -> DsM TyThing
-- Very like GHC.Tc.Utils.Env.tcLookupGlobal
=====================================
compiler/GHC/HsToCore/Quote.hs
=====================================
@@ -2315,9 +2315,14 @@ lookupOccDsM n
globalVar :: Name -> DsM (Core TH.Name)
globalVar n =
case nameModule_maybe n of
- Just m -> globalVarExternal m (getOccName n)
+ Just m -> globalVarExternal m (getOccName n)
Nothing -> globalVarLocal (getUnique n) (getOccName n)
+globalKnownKey :: KnonwKeyNameKey -> DsM (Core TH.Name)
+globalKnownKey key
+ = do { name <- dsLookupKnownKeyName key
+ ; globalVar name }
+
globalVarLocal :: Unique -> OccName -> DsM (Core TH.Name)
globalVarLocal unique name
= do { MkC occ <- occNameLit name
@@ -3150,7 +3155,8 @@ repRdrName rdr_name = do
occ <- occNameLit occ
repNameQ mod occ
Orig m n -> lift $ globalVarExternal m n
- Exact n -> lift $ globalVar n
+ Exact (ExactName n) -> lift $ globalVar n
+ Exact (ExactKey key _) -> lift $ globalKnownKey key
repNameS :: Core String -> MetaM (Core TH.Name)
repNameS (MkC name) = rep2_nw mkNameSName [name]
=====================================
compiler/GHC/Parser/PostProcess.hs
=====================================
@@ -864,7 +864,9 @@ setRdrNameSpace :: RdrName -> NameSpace -> RdrName
setRdrNameSpace (Unqual occ) ns = Unqual (setOccNameSpace ns occ)
setRdrNameSpace (Qual m occ) ns = Qual m (setOccNameSpace ns occ)
setRdrNameSpace (Orig m occ) ns = Orig m (setOccNameSpace ns occ)
-setRdrNameSpace (Exact n) ns
+setRdrNameSpace (Exact (ExactKey k o)) ns -- Highly suspicious
+ = Exact (ExactKey k (setOccNameSpace ns o))
+setRdrNameSpace (Exact (ExactName n)) ns
| Just thing <- wiredInNameTyThing_maybe n
= setWiredInNameSpace thing ns
-- Preserve Exact Names for wired-in things,
@@ -875,7 +877,7 @@ setRdrNameSpace (Exact n) ns
| otherwise -- This can happen when quoting and then
-- splicing a fixity declaration for a type
- = Exact (mkSystemNameAt (nameUnique n) occ (nameSrcSpan n))
+ = nameRdrName (mkSystemNameAt (nameUnique n) occ (nameSrcSpan n))
where
occ = setOccNameSpace ns (nameOccName n)
@@ -884,13 +886,13 @@ setWiredInNameSpace (ATyCon tc) ns
| isDataConNameSpace ns
= ty_con_data_con tc
| isTcClsNameSpace ns
- = Exact (getName tc) -- No-op
+ = nameRdrName (getName tc) -- No-op
setWiredInNameSpace (AConLike (RealDataCon dc)) ns
| isTcClsNameSpace ns
= data_con_ty_con dc
| isDataConNameSpace ns
- = Exact (getName dc) -- No-op
+ = nameRdrName (getName dc) -- No-op
setWiredInNameSpace thing ns
= pprPanic "setWiredinNameSpace" (pprNameSpace ns <+> ppr thing)
@@ -899,10 +901,10 @@ ty_con_data_con :: TyCon -> RdrName
ty_con_data_con tc
| isTupleTyCon tc
, Just dc <- tyConSingleDataCon_maybe tc
- = Exact (getName dc)
+ = nameRdrName (getName dc)
| tc `hasKey` listTyConKey
- = Exact nilDataConName
+ = nameRdrName nilDataConName
| otherwise -- See Note [setRdrNameSpace for wired-in names]
= Unqual (setOccNameSpace srcDataName (getOccName tc))
@@ -911,10 +913,10 @@ data_con_ty_con :: DataCon -> RdrName
data_con_ty_con dc
| let tc = dataConTyCon dc
, isTupleTyCon tc
- = Exact (getName tc)
+ = nameRdrName (getName tc)
| dc `hasKey` nilDataConKey
- = Exact listTyConName
+ = nameRdrName listTyConName
| otherwise -- See Note [setRdrNameSpace for wired-in names]
= Unqual (setOccNameSpace tcClsName (getOccName dc))
=====================================
compiler/GHC/Rename/Env.hs
=====================================
@@ -485,8 +485,13 @@ data ExactOrOrigResult
-- Does the actual looking up an Exact or Orig name, see 'ExactOrOrigResult'
lookupExactOrOrig_base :: RdrName -> RnM ExactOrOrigResult
lookupExactOrOrig_base rdr_name
- | Just n <- isExact_maybe rdr_name -- This happens in derived code
+ | Just n <- rdrNameExactName_maybe rdr_name -- This happens in derived code
= cvtEither <$> lookupExactOcc_either n
+
+ | Just key <- exactKeyRdr_maybe rdr_name
+ = do { name <- rnLookupKnownKeyName key
+ ; cvtEither <$> lookupExactOcc_either name }
+
| Just (rdr_mod, rdr_occ) <- isOrig_maybe rdr_name
= do { nm <- lookupOrig rdr_mod rdr_occ
@@ -499,6 +504,7 @@ lookupExactOrOrig_base rdr_name
; return $ case mb_gre of
Left err -> ExactOrOrigError err
Right gre -> FoundExactOrOrig gre }
+
| otherwise = return NotExactOrOrig
where
cvtEither (Left e) = ExactOrOrigError e
=====================================
compiler/GHC/Tc/Deriv/Generate.hs
=====================================
@@ -1656,17 +1656,17 @@ gen_Lift_binds loc (DerivInstTys{ dit_rep_tc = tycon
as_needed = take con_arity as_RDRs
lift_Expr = mk_bracket finish
con_brack :: LHsExpr GhcPs
- con_brack = nlHsApps (Exact conEName)
+ con_brack = nlHsApps (nameRdrName conEName)
[noLocA $ HsUntypedBracket noExtField
- $ VarBr noSrcSpanA True (noLocA (Exact (dataConName data_con)))]
+ $ VarBr noSrcSpanA True (noLocA (nameRdrName (dataConName data_con)))]
- finish = foldl' (\b1 b2 -> nlHsApps (Exact appEName) [b1, b2]) con_brack (map lift_var as_needed)
+ finish = foldl' (\b1 b2 -> nlHsApps (nameRdrName appEName) [b1, b2]) con_brack (map lift_var as_needed)
lift_var :: RdrName -> LHsExpr (GhcPass 'Parsed)
lift_var x = nlHsPar (mk_lift_expr x)
mk_lift_expr :: RdrName -> LHsExpr (GhcPass 'Parsed)
- mk_lift_expr x = nlHsApps (Exact liftName) [nlHsVar x]
+ mk_lift_expr x = nlHsApps (nameRdrName liftName) [nlHsVar x]
{-
************************************************************************
@@ -2612,7 +2612,7 @@ new_dc_deriv_rdr_name loc dc occ_fun
newAuxBinderRdrName :: SrcSpan -> Name -> (OccName -> OccName) -> TcM RdrName
newAuxBinderRdrName loc parent occ_fun = do
uniq <- newUnique
- pure $ Exact $ mkSystemNameAt uniq (occ_fun (nameOccName parent)) loc
+ pure $ nameRdrName $ mkSystemNameAt uniq (occ_fun (nameOccName parent)) loc
-- | @getPossibleDataCons tycon tycon_args@ returns the constructors of @tycon@
-- whose return types match when checked against @tycon_args@.
=====================================
compiler/GHC/Tc/Gen/Splice.hs
=====================================
@@ -1552,12 +1552,12 @@ instance TH.Quasi TcM where
= addErr $ TcRnTHError $ AddTopDeclsError $ InvalidTopDecl d
bindName :: RdrName -> TcM ()
- bindName (Exact n)
+ bindName rdr_name
+ | Just n <- rdrNameExactName_maybe rdr_nname
= do { th_topnames_var <- fmap tcg_th_topnames getGblEnv
- ; updTcRef th_topnames_var (\ns -> extendNameSet ns n)
- }
-
- bindName name = addErr $ TcRnTHError $ THNameError $ NonExactName name
+ ; updTcRef th_topnames_var (\ns -> extendNameSet ns n) }
+ | otherwise
+ = addErr $ TcRnTHError $ THNameError $ NonExactName rdr_name
qAddForeignFilePath lang fp = do
var <- fmap tcg_th_foreign_files getGblEnv
=====================================
compiler/GHC/ThToHs.hs
=====================================
@@ -1889,7 +1889,7 @@ cvtTypeKind typeOrKind ty
hsTypeToArrow :: LHsType GhcPs -> HsMultAnn GhcPs
hsTypeToArrow w = case unLoc w of
- HsTyVar _ _ (L _ (isExact_maybe -> Just n))
+ HsTyVar _ _ (L _ (rdrNameExactName_maybe -> Just n))
| n == oneDataConName -> HsLinearAnn noAnn
| n == manyDataConName -> HsUnannotated (EpArrow noAnn)
_ -> HsExplicitMult (noAnn, EpArrow noAnn) w
@@ -2319,7 +2319,7 @@ thOrigOrExactRdrName occ th_ns pkg mod = knownOrigToExactRdrName (thOrigRdrName
knownOrigToExactRdrName :: RdrName -> RdrName
knownOrigToExactRdrName (Orig mod occ)
| Just name <- isKnownOrigName_maybe mod occ
- = Exact name
+ = nameRdrName name
knownOrigToExactRdrName rdr = rdr
-- Return an exact RdrName if we're dealing with built-in syntax.
=====================================
compiler/GHC/Types/Name/Reader.hs
=====================================
@@ -26,18 +26,20 @@
module GHC.Types.Name.Reader (
-- * The main type
RdrName(..), -- Constructors exported only to GHC.Iface.Binary
+ ExactRdrName(..),
-- ** Construction
mkRdrUnqual, mkRdrQual,
mkUnqual, mkVarUnqual, mkQual, mkOrig,
- nameRdrName, getRdrName,
+ nameRdrName, knownKeyRdrName, getRdrName,
-- ** Destruction
rdrNameOcc, rdrNameSpace,
demoteRdrName, demoteRdrNameTcCls, demoteRdrNameTv,
promoteRdrName,
isRdrDataCon, isRdrTyVar, isRdrTc, isQual, isQual_maybe, isUnqual,
- isOrig, isOrig_maybe, isExact, isExact_maybe, isSrcRdrName,
+ isOrig, isOrig_maybe, isExact,
+ rdrNameExactName_maybe, rdrNameKnownKey_maybe, isSrcRdrName,
-- ** Preserving user-written qualification
WithUserRdr(..), noUserRdr, unLocWithUserRdr, userRdrName,
@@ -196,7 +198,7 @@ data RdrName
-- we want to say \"Use Prelude.map dammit\". One of these
-- can be created with 'mkOrig'
- | Exact ExactSpec
+ | Exact ExactRdrName
-- ^ Exact name
--
-- We know exactly the 'Name'. This is used:
@@ -209,9 +211,14 @@ data RdrName
-- Such a 'RdrName' can be created by using 'getRdrName' on a 'Name'
deriving Data
-data ExactSpec
- = ExactName Name -- Use this when you know the exact Name
- | ExactKey KnownKeyNameKey -- Use this for known-key names
+data ExactRdrName
+ = ExactName -- Use this when you know the exact Name
+ Name
+
+ | ExactKey -- Use this for known-key names
+ KnownKeyNameKey
+ OccName -- This OccName corresponds to the key
+
deriving Data
{-
@@ -229,7 +236,8 @@ rdrNameOcc :: RdrName -> OccName
rdrNameOcc (Qual _ occ) = occ
rdrNameOcc (Unqual occ) = occ
rdrNameOcc (Orig _ occ) = occ
-rdrNameOcc (Exact name) = nameOccName name
+rdrNameOcc (Exact (ExactName name)) = nameOccName name
+rdrNameOcc (Exact (ExactKey _ occ)) = occ
rdrNameSpace :: RdrName -> NameSpace
rdrNameSpace = occNameSpace . rdrNameOcc
@@ -291,16 +299,19 @@ mkQual sp (m, n) = Qual (mkModuleNameFS m) (mkOccNameFS sp n)
getRdrName :: NamedThing thing => thing -> RdrName
getRdrName name = nameRdrName (getName name)
+knownKeyRdrName :: KnownKeyNameKey -> OccName -> RdrName
+knownKeyRdrName key occ = Exact (ExactKey key occ)
+
nameRdrName :: Name -> RdrName
nameRdrName name = Exact (ExactName name)
-- Keep the Name even for Internal names, so that the
-- unique is still there for debug printing, particularly
-- of Types (which are converted to IfaceTypes before printing)
-nukeExact :: Name -> RdrName
-nukeExact n
- | isExternalName n = Orig (nameModule n) (nameOccName n)
- | otherwise = Unqual (nameOccName n)
+-- nukeExact :: Name -> RdrName
+-- nukeExact n
+-- | isExternalName n = Orig (nameModule n) (nameOccName n)
+-- | otherwise = Unqual (nameOccName n)
isRdrDataCon :: RdrName -> Bool
isRdrTyVar :: RdrName -> Bool
@@ -339,9 +350,13 @@ isExact :: RdrName -> Bool
isExact (Exact _) = True
isExact _ = False
-isExact_maybe :: RdrName -> Maybe Name
-isExact_maybe (Exact n) = Just n
-isExact_maybe _ = Nothing
+rdrNameExactName_maybe :: RdrName -> Maybe Name
+rdrNameExactName_maybe (Exact (ExactName n)) = Just n
+rdrNameExactName_maybe _ = Nothing
+
+rdrNameKnownKey_maybe :: RdrName -> Maybe KnownKeyNameKey
+rdrNameKnownKey_maybe (Exact (ExactKey k _)) = Just k
+rdrNameKnownKey_maybe _ = Nothing
{-
************************************************************************
@@ -352,7 +367,8 @@ isExact_maybe _ = Nothing
-}
instance Outputable RdrName where
- ppr (Exact name) = ppr name
+ ppr (Exact (ExactName name)) = ppr name
+ ppr (Exact (ExactKey key occ)) = ppr occ <> braces (pprKnownKey key)
ppr (Unqual occ) = ppr occ
ppr (Qual mod occ) = ppr mod <> dot <> ppr occ
ppr (Orig mod occ) = getPprStyle (\sty -> pprModulePrefix sty mod Nothing occ <> ppr occ)
@@ -364,16 +380,28 @@ instance OutputableBndr RdrName where
pprInfixOcc rdr = pprInfixVar (isSymOcc (rdrNameOcc rdr)) (ppr rdr)
pprPrefixOcc rdr
- | Just name <- isExact_maybe rdr = pprPrefixName name
+ | Just name <- rdrNameExactName_maybe rdr = pprPrefixName name
-- pprPrefixName has some special cases, so
-- we delegate to them rather than reproduce them
| otherwise = pprPrefixVar (isSymOcc (rdrNameOcc rdr)) (ppr rdr)
+instance Eq ExactRdrName where
+ (ExactName n1) == (ExactName n2) = n1==n2
+ (ExactKey k1 _) == (ExactKey k2 _) = k1==k2
+ _ == _ = False
+
+instance Ord ExactRdrName where
+ (ExactName n1) `compare` (ExactName n2) = n1 `compare` n2
+ (ExactName {}) `compare` (ExactKey {}) = LT
+ (ExactKey {}) `compare` (ExactName {}) = GT
+ (ExactKey k1 _) `compare` (ExactKey k2 _) = k1 `nonDetCmpUnique` k2
+
instance Eq RdrName where
(Exact n1) == (Exact n2) = n1==n2
+
-- Convert exact to orig
- (Exact n1) == r2@(Orig _ _) = nukeExact n1 == r2
- r1@(Orig _ _) == (Exact n2) = r1 == nukeExact n2
+-- (Exact n1) == r2@(Orig _ _) = nukeExact n1 == r2
+-- r1@(Orig _ _) == (Exact n2) = r1 == nukeExact n2
(Orig m1 o1) == (Orig m2 o2) = m1==m2 && o1==o2
(Qual m1 o1) == (Qual m2 o2) = m1==m2 && o1==o2
@@ -471,7 +499,7 @@ lookupLocalRdrEnv (LRE { lre_env = env, lre_in_scope = ns }) rdr
= lookupOccEnv env occ
-- See Note [Local bindings with Exact Names]
- | Exact name <- rdr
+ | Just name <- rdrNameExactName_maybe rdr
, name `elemNameSet` ns
= Just name
@@ -492,8 +520,9 @@ lookupLocalRdrOcc (LRE { lre_env = env }) occ = lookupOccEnv env occ
elemLocalRdrEnv :: RdrName -> LocalRdrEnv -> Bool
elemLocalRdrEnv rdr_name (LRE { lre_env = env, lre_in_scope = ns })
= case rdr_name of
- Unqual occ -> occ `elemOccEnv` env
- Exact name -> name `elemNameSet` ns -- See Note [Local bindings with Exact Names]
+ Unqual occ -> occ `elemOccEnv` env
+ Exact (ExactName name) -> name `elemNameSet` ns -- See Note [Local bindings with Exact Names]
+ Exact (ExactKey{}) -> False
Qual {} -> False
Orig {} -> False
=====================================
compiler/GHC/Types/Unique.hs
=====================================
@@ -67,6 +67,7 @@ import GHC.Exts (indexCharOffAddr#, Char(..), Int(..))
import GHC.Word ( Word64 )
import Data.Char ( chr, ord, isPrint )
+import Data.Data ( Data )
import Language.Haskell.Syntax.Module.Name
@@ -128,6 +129,7 @@ Prefer `env_ut :: Char` and
--
-- These are sometimes also referred to as \"keys\" in comments in GHC.
newtype Unique = MkUnique Word64
+ deriving Data -- Needed only because KnownKeyNameKey is in RdrName
data UniqueTag
= AlphaTyVarTag
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5a6fbce9a799ad24d05b864f43ddc5b…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5a6fbce9a799ad24d05b864f43ddc5b…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
02 Apr '26
Apoorv Ingle pushed new branch wip/ani/precise-fun-loc at Glasgow Haskell Compiler / GHC
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/ani/precise-fun-loc
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 12 commits: Streamline expansions using HsExpansion (#25001)
by Marge Bot (＠marge-bot) 02 Apr '26
by Marge Bot (＠marge-bot) 02 Apr '26
02 Apr '26
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
58009c14 by Apoorv Ingle at 2026-04-02T09:51:24+01:00
Streamline expansions using HsExpansion (#25001)
Notes added [Error Context Stack] [Typechecking by expansion: overview]
Notes updated Note [Expanding HsDo with XXExprGhcRn] [tcApp: typechecking applications]
-------------------------
Metric Decrease:
T9020
-------------------------
There are 2 key changes:
1. `HsExpand` datatype mediates between expansions
2. Replace `ErrCtxtM` to a simpler `HsCtxt` that does not depend on a `TidyEnv`
This has some consequences detailed below:
1. `HsExpand` datatype mediates between expansions
* Simplifies the implementations of `tcExpr` to work on `XExpr`
* Removes `VACtxt` (and its associated `VAExpansion` and `VACall`) datatype, it is subsumed by simply a `SrcSpan`.
* Removes the function `addHeadCtxt` as it is now mearly setting a location
* The function `tcValArgs` does its own argument number management
* move `splitHsTypes` out of `tcApp`
* Removes special case of tcBody from `tcLambdaMatches`
* Removes special case of `dsExpr` for `ExpandedThingTc`
* Renames `tcMonoExpr` -> `tcMonoLExpr`, `tcMonoExprNC` -> `tcMonoLExpr`
* Renames `EValArg`, `EValArgQL` fields: `ea_ctxt` -> `ea_loc_span` and `eaql_ctx` -> `eaql_loc_span`
* Remove `PopErrCtxt` from `XXExprGhcRn`
* `fun_orig` in tcInstFun depends on the SrcSpan of the head of the application chain (similar to addArgCtxt)
- it references the application chain head if it is user located, or
uses the error context stack as a fallback if it's a generated
location
* Make a new variant `GeneratedSrcSpan` in `SrcSpan` for HIEAst Nodes
- Expressions wrapped around `GeneratedSrcSpan` are ignored and never added to the error context stack
- In Explicit list expansion `fromListN` is wrapped with a `GeneratedSrcSpan` with `GeneratedSrcSpanDetails` field to store the original srcspan
2. Replace `ErrCtxtM` to a simpler `HsCtxt` that does not depend on a `TidyEnv`
* Merge `HsThingRn` to `HsCtxt`
* Landmark Error messages are now just computed on the fly
* Make HsExpandedRn and HsExpandedTc payload a located HsExpr GhcRn
* `HsCtxt` are tidied and zonked at the end right before printing
Co-authored-by: simonpj <simon.peytonjones(a)gmail.com>
- - - - -
9d964ec9 by Zubin Duggal at 2026-04-02T16:15:51-04:00
driver: recognise .dyn_o as a valid object file to link if passed on the command line.
This allows plugins compiled with this suffix to run.
Fixes #24486
- - - - -
117f299b by Simon Jakobi at 2026-04-02T16:15:54-04:00
Add regression test for #16145
Closes #16145.
- - - - -
87807fc2 by Matthew Pickering at 2026-04-02T16:15:55-04:00
bytecode: Add magic header/version to bytecode files
In order to avoid confusing errors when using stale interface files (ie
from an older compiler version), we add a simple header/version check
like the one for interface files.
Fixes #27068
- - - - -
2d653e6a by fendor at 2026-04-02T16:15:55-04:00
Add constants for bytecode in-memory buffer size
Introduce a common constant for the default size of the .gbc and
.bytecodelib binary buffer.
The buffer is by default set to 1 MB.
- - - - -
e28fd7fc by Duncan Coutts at 2026-04-02T16:15:56-04:00
Add a rts posix FdWakup utility module
This will be used to implement wakeupIOManager for in-RTS I/O managers.
It provides a notification/wakeup mechanism using FDs, suitable for
situations when a thread is blocked on a set of fds anyway. It uses the
classic self-pipe trick, or equivalently eventfd on supported platforms.
This will initially be used to implement prompt interrupt or shutdown of
the posix ticker thread.
- - - - -
85199690 by Duncan Coutts at 2026-04-02T16:15:56-04:00
Add prompt shutdown to the pthread ticker implementation.
The Linux timerfd ticker monitors a pipe which is used by exitTicker to
ensure a prompt wakeup and shutdown. The pthread ticker lacked this and
so would only exit at the next ticker wakeup (10ms by default).
This patch adds the same mechanism to the pthread ticker.
This changes the pthread ticker from waiting by using nanosleep() to
waiting using either ppoll() or select(), so that it can wait on both
a time and a file descriptor. On Linux at least, a test program to
compare the timing jitter of these APIs shows that using nanpsleep,
ppoll or select makes no statistical difference to the maximum or
average jitter.
This is a step towards unifying the posix ticker implementations, so
that we can have just one portable one (albeit with some limited cpp).
It is also a step towards using the ticker as part of a more general
implementation of wakeUpRts, since this will require a method to wake
the rts from a signal handler context (ctl-c handler).
- - - - -
bd6e5d21 by Duncan Coutts at 2026-04-02T16:15:56-04:00
Update ticker header commentary
It was antique and didn't apply even to the previous implementation, and
certainly not to the updated one.
- - - - -
4286c294 by Duncan Coutts at 2026-04-02T16:15:56-04:00
Remove the timerfd-based ticker implementation
There does not appear to be any remaining advantage on Linux to using
the timerfd ticker implementation over the portable one (using ppoll on
Linux for precise timing).
The eventfd implementation was originally added at a time when Linux was
still using a signal based implementation. So it made sense at the time.
See (closed) issue #10840.
- - - - -
6bf4326a by Duncan Coutts at 2026-04-02T16:15:56-04:00
Consolidate to a single posix ticker implementation
Previously we had four implementations, two using signals and two using
threads. Having just one should make behaviour more consistent between
platforms, and should make maintenance easier.
- - - - -
93344577 by mangoiv at 2026-04-02T16:15:57-04:00
issue template: fix add bug label
- - - - -
5c57fa5f by Sylvain Henry at 2026-04-02T16:16:28-04:00
Add more canned GC functions for common register patterns (#27142)
Based on analysis of heap-check sites across the GHC compiler and Cabal,
the following patterns were not covered by existing canned GC functions
but occurred frequently enough to warrant specialisation:
stg_gc_ppppp -- 5 GC pointers
stg_gc_ip -- unboxed word + GC pointer
stg_gc_pi -- GC pointer + unboxed word
stg_gc_ii -- two unboxed words
stg_gc_bpp -- byte (I8) + two GC pointers
Adding these reduces the fraction of heap-check sites falling back to
the generic GC path from ~1.4% to ~0.4% when compiling GHC itself.
Co-Authored-By: Claude Sonnet 4.6 <noreply(a)anthropic.com>
- - - - -
142 changed files:
- .gitlab/issue_templates/default.md
- compiler/GHC.hs
- compiler/GHC/ByteCode/Serialize.hs
- compiler/GHC/Driver/Phases.hs
- compiler/GHC/Hs/DocString.hs
- compiler/GHC/Hs/Expr.hs
- compiler/GHC/Hs/Expr.hs-boot
- compiler/GHC/Hs/Instances.hs
- compiler/GHC/Hs/Syn/Type.hs
- compiler/GHC/HsToCore/Expr.hs
- compiler/GHC/HsToCore/Match.hs
- compiler/GHC/HsToCore/Monad.hs
- compiler/GHC/HsToCore/Pmc.hs
- compiler/GHC/HsToCore/Quote.hs
- compiler/GHC/HsToCore/Ticks.hs
- compiler/GHC/Iface/Ext/Ast.hs
- compiler/GHC/Iface/Ext/Utils.hs
- compiler/GHC/Parser/HaddockLex.x
- compiler/GHC/Rename/Expr.hs
- compiler/GHC/Rename/Names.hs
- compiler/GHC/Rename/Utils.hs
- compiler/GHC/Runtime/Debugger/Breakpoints.hs
- compiler/GHC/StgToCmm/Heap.hs
- compiler/GHC/Tc/Deriv.hs
- compiler/GHC/Tc/Deriv/Infer.hs
- compiler/GHC/Tc/Deriv/Utils.hs
- compiler/GHC/Tc/Errors.hs
- compiler/GHC/Tc/Errors/Ppr.hs
- compiler/GHC/Tc/Errors/Types.hs
- compiler/GHC/Tc/Gen/App.hs
- compiler/GHC/Tc/Gen/Bind.hs
- compiler/GHC/Tc/Gen/Do.hs
- + compiler/GHC/Tc/Gen/Expand.hs
- compiler/GHC/Tc/Gen/Export.hs
- compiler/GHC/Tc/Gen/Expr.hs
- compiler/GHC/Tc/Gen/Expr.hs-boot
- compiler/GHC/Tc/Gen/Head.hs
- compiler/GHC/Tc/Gen/HsType.hs
- compiler/GHC/Tc/Gen/Match.hs
- compiler/GHC/Tc/Gen/Match.hs-boot
- compiler/GHC/Tc/Gen/Pat.hs
- compiler/GHC/Tc/Gen/Sig.hs
- compiler/GHC/Tc/Gen/Splice.hs
- compiler/GHC/Tc/Instance/Class.hs
- compiler/GHC/Tc/Module.hs
- compiler/GHC/Tc/Solver/Solve.hs
- compiler/GHC/Tc/TyCl.hs
- compiler/GHC/Tc/TyCl/Class.hs
- compiler/GHC/Tc/TyCl/Instance.hs
- compiler/GHC/Tc/TyCl/PatSyn.hs
- compiler/GHC/Tc/Types.hs
- compiler/GHC/Tc/Types/BasicTypes.hs
- compiler/GHC/Tc/Types/Constraint.hs
- compiler/GHC/Tc/Types/CtLoc.hs
- compiler/GHC/Tc/Types/ErrCtxt.hs
- compiler/GHC/Tc/Types/LclEnv.hs
- compiler/GHC/Tc/Types/Origin.hs
- compiler/GHC/Tc/Types/Origin.hs-boot
- compiler/GHC/Tc/Utils/Instantiate.hs
- compiler/GHC/Tc/Utils/Monad.hs
- compiler/GHC/Tc/Utils/TcMType.hs
- compiler/GHC/Tc/Utils/TcType.hs-boot
- compiler/GHC/Tc/Utils/Unify.hs
- compiler/GHC/Tc/Validity.hs
- compiler/GHC/Tc/Zonk/TcType.hs
- compiler/GHC/Tc/Zonk/Type.hs
- compiler/GHC/Types/Error.hs
- + compiler/GHC/Types/Error.hs-boot
- compiler/GHC/Types/Hint/Ppr.hs
- compiler/GHC/Types/Name/Reader.hs
- compiler/GHC/Types/SrcLoc.hs
- + compiler/GHC/Unit/State.hs-boot
- compiler/GHC/Utils/Binary.hs
- compiler/GHC/Utils/Logger.hs
- compiler/ghc.cabal.in
- ghc/GHCi/UI.hs
- ghc/GHCi/UI/Info.hs
- rts/HeapStackCheck.cmm
- rts/RtsSymbols.c
- rts/include/stg/MiscClosures.h
- + rts/posix/FdWakeup.c
- + rts/posix/FdWakeup.h
- rts/posix/Ticker.c
- − rts/posix/ticker/Pthread.c
- − rts/posix/ticker/TimerFd.c
- rts/rts.cabal
- testsuite/tests/count-deps/CountDepsAst.stdout
- testsuite/tests/count-deps/CountDepsParser.stdout
- testsuite/tests/driver/bytecode-object/Makefile
- testsuite/tests/driver/bytecode-object/all.T
- testsuite/tests/ghci/prog-mhu001/prog-mhu001c.stdout
- testsuite/tests/indexed-types/should_fail/T2693.stderr
- testsuite/tests/indexed-types/should_fail/T5439.stderr
- testsuite/tests/monadfail/MonadFailErrors.stderr
- testsuite/tests/overloadedrecflds/should_fail/T26480b.stderr
- testsuite/tests/parser/should_fail/RecordDotSyntaxFail10.stderr
- testsuite/tests/parser/should_fail/RecordDotSyntaxFail11.stderr
- testsuite/tests/parser/should_fail/RecordDotSyntaxFail9.stderr
- testsuite/tests/partial-sigs/should_compile/SplicesUsed.stderr
- testsuite/tests/plugins/Makefile
- + testsuite/tests/plugins/T24486-plugin/Makefile
- + testsuite/tests/plugins/T24486-plugin/Setup.hs
- + testsuite/tests/plugins/T24486-plugin/T24486-plugin.cabal
- + testsuite/tests/plugins/T24486-plugin/T24486_Plugin.hs
- + testsuite/tests/plugins/T24486.hs
- + testsuite/tests/plugins/T24486_Helper.hs
- testsuite/tests/plugins/all.T
- testsuite/tests/plugins/test-defaulting-plugin.stderr
- testsuite/tests/printer/T17697.stderr
- testsuite/tests/profiling/should_run/callstack001.stdout
- testsuite/tests/rebindable/rebindable6.stderr
- testsuite/tests/rep-poly/RepPolyRecordUpdate.stderr
- testsuite/tests/runghc/Makefile
- + testsuite/tests/runghc/T16145.hs
- + testsuite/tests/runghc/T16145.stdout
- + testsuite/tests/runghc/T16145_aux.hs
- testsuite/tests/runghc/all.T
- + testsuite/tests/typecheck/should_compile/ExpansionQLIm.hs
- testsuite/tests/typecheck/should_compile/T14590.stderr
- testsuite/tests/typecheck/should_compile/all.T
- testsuite/tests/typecheck/should_compile/valid_hole_fits.stderr
- testsuite/tests/typecheck/should_fail/DoExpansion1.stderr
- testsuite/tests/typecheck/should_fail/DoExpansion2.stderr
- testsuite/tests/typecheck/should_fail/T10971d.stderr
- testsuite/tests/typecheck/should_fail/T13311.stderr
- testsuite/tests/typecheck/should_fail/T3323.stderr
- testsuite/tests/typecheck/should_fail/T3613.stderr
- testsuite/tests/typecheck/should_fail/T6069.stderr
- testsuite/tests/typecheck/should_fail/T7851.stderr
- testsuite/tests/typecheck/should_fail/T7857.stderr
- testsuite/tests/typecheck/should_fail/T8603.stderr
- testsuite/tests/typecheck/should_fail/T9612.stderr
- testsuite/tests/typecheck/should_fail/tcfail102.stderr
- testsuite/tests/typecheck/should_fail/tcfail128.stderr
- testsuite/tests/typecheck/should_fail/tcfail140.stderr
- testsuite/tests/typecheck/should_fail/tcfail181.stderr
- utils/check-exact/ExactPrint.hs
- utils/check-exact/Parsers.hs
- utils/check-exact/Transform.hs
- utils/check-exact/Utils.hs
- utils/haddock/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
- utils/haddock/haddock-api/src/Haddock/Backends/Xhtml/Utils.hs
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/82c991ca1ea5fa9c70a3f7986af9ab…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/82c991ca1ea5fa9c70a3f7986af9ab…
You're receiving this email because of your account on gitlab.haskell.org.
1
0