May 2026 - ghc-commits

[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 6 commits: Hadrian: remove legacy rts .so symlinks
by Marge Bot (＠marge-bot) 20 May '26

20 May '26

Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 1a7de232 by Duncan Coutts at 2026-05-20T12:26:25-04:00 Hadrian: remove legacy rts .so symlinks For compatibility with the old makefile based build system, hadrian had rules to generate symlinks from unversioned to versioned names for the rts .so/.dynlib file, like libHSrts-ghcx.y.so -> libHSrts-1.0.3-ghcx.y.so We no longer need these symlinks since the makefile build system has been retired some time ago. The need for these symlinks is awkward on windows where we cannot (in practice) create symlinks. So rather than make them conditional (non-windows), just remove them entirely. - - - - - 286f1adf by fendor at 2026-05-20T12:27:09-04:00 Fix regression T27202: `:load` and `:add` work in GHCi To fix the regression there are conceptually two major things that we fix: * We don't remove the `importDirs` from `interactive-session` * When `:add`ing a module, we don't try to find them via PackageImports * The PackageImport is wrong as we can't know the package-name at this stage in ghc/UI.hs What does it mean to not remove the `importDirs` from `interactive-session`? It means that, given some initial `DynFlags`, we will use those `importDirs` in `interactive-session`. The initial `DynFlags`, however, depend on how you initialise the GHC session. For a simple session, initialised by ghc -isrc -this-unit-id main It is simple, just use the `DynFlags` given on the cli. Thus, `main` and `interactive-session` will have the same `DynFlags`, except for the `homeUnitId` and `interactive-session` depends on `main` by construction of the GHCi session. What about a multiple home unit session, though? ghc -unit @unit1 -unit @unit2 What are the `DynFlags` in this cli invocation? It shouldn't be either `@unti1` nor `@unit2`, as the order shouldn't matter or any other implicit condition. For consistency, we decide that the initial `DynFlags` are the top `DynFlags` on the cli, ignoring `-unit` flags. Thus, in this example, there are no `importsDirs` regardless of what we might find in `@unit1` and `@unit2`. But in this invocation: ghc -isrc -unit @unit1 -unit @unit2 The `interactive-session` will have the `importsDirs` `src`. Note, `-isrc` will be inherited in `@unit1` and `@unit2`, so you need to explicitly use `-i` to clear the `importsDirs`, in order to avoid accidentally adding `src` as an import directory to all other home units. This fix has been made possible by the improvements introduced in !15888, which avoids ambiguity when a home unit shares the `importsDirs` with the `interactive-session`, on top of being much faster for multiple home units. Adds regression tests for T27202 for `:load`ing and `:add`ing modules that are located in import directories. - - - - - 728662de by fendor at 2026-05-20T12:27:09-04:00 Use home unit package db stacks in GHCi prompt and session unit In order to import modules from home unit dependencies (e.g., `Data.Map`), the ghci prompt unit needs to populate its `UnitState`. This is tricky to handle correctly, which `PackageDBFlag`s should we use to populate the `UnitState`? We decide, the most intuitive solution for users is to depend on all `PackageDBFlag`s, so that any dependency can be imported in GHCi. This assumes consistency in the `PackageDBFlag`s, so no two home units specify `PackageDBFlag`s that are inconsistent with each other. We could simply concat all the `PackageDBFlag`s of the existing home units, but later `PackageDBFlag`s shadow earlier ones, leading to the last processed home units' `PackageDBFlag`s to shadow the earlier ones. This is hard to fix, we need to give users the capability to provide ghc options for the ghci prompt home unit. However, as this is considerably more work, we decided on an approximation that should work out most of the time. Package Db stacks in cabal and stack follow a certain structure: -no-user-package-db > -package-db $cabal-store > -package-db $local-db The first two arguments are always the same, namely the `-no-user-package-db` and `-package-db`. We compute the longest common prefix over all home units, and use that as the start of the package db stack. Then, over the rest of the `PackageDBFlag`s, we simply take the union and append them to our initial stack. We assume, that the rest of package dbs only defines very few, "local" units that are usually not shadowing each other. This allows us to get a relatively consistent package database stack for the ghci prompt home unit. Similar reasoning applies to the session unit in order to add modules to the session and have dependencies available in the module. We do something similar for `-package` flags, to make sure only the correct units are actually visible in the ghci session. This time, we simply take the union of all `PackageFlag`s, allowing us to import modules from the home unit dependencies. In the future, it would be beneficial to allow the user to provide the exact ghc options to control the visibilities. For now, this will have to do. - - - - - 638d27ea by Simon Peyton Jones at 2026-05-20T13:00:15-04:00 Do not use mkCast during typechecking This commit fixes #27219. The problem was that the typechecker was using `mkCast`, whose assertion checks legitimately fail when applied to types that contain unification variables. - - - - - 5b128f91 by Simon Peyton Jones at 2026-05-20T13:00:15-04:00 Major refactor of the Simplifier The main payload of this patch is to refactor the Simplifer to avoid repeated simplification when using Plan (AFTER) for rule rewrites. The need for this was shown up by #26989. See Note [Avoid repeated simplification] in GHC.Core.Opt.Simplify.Iteration. Related refactoring: * Refactor the two fields `sc_dup` and `sc_env` in `ApplyToVal` into one, `sc_env`. Reason: the envt is irrelevant in the "simplified" case, so the data type describes the possiblitiies much more accurately now. * Some refactoring in `knownCon` to split off `wrapDataConFloats`. * Refactor `lookupRule` and its auxiliary functions to return `RuleMatch`, a new data type. See Note [data RuleMatch] in GHC.Core. Ditto for BuiltinRule. This RuleMatch returns fragments of the target in rm_args and rm_floats, leaving `rm_rhs` to be the stuff from the RULE itself. Doing this has routine consequences in GHC.Core.Opt.ConstantFold. Many changes there but all routine. * When doing occurrence analysis on RULEs, make the occ-info on the rule binders relate just to the RHS, not the LHS. See (OUR1) in Note Note [OccInfo in unfoldings and rules] This means that Lint must not complain about the fact that the patterns in the RULE mentions binders that are marked dead. See Note [Dead occurrences] in GHC.Core.Lint. I changed the Core pretty-printer so that it didn't suppress dead binders, else I can't see those binders in RULEs. That led to quite a lot of testsuite wibbles. * Refactor FloatBinds, so that it is used both by `exprIsConApp_mabye` and by `lookupRule` * Move the definition of FloatBinds out of GHc.Core.Make, into GHC.Core. * Add FloatTick as an extra constructor. * Refactor `lookupRule` to use `FloatBinds` instead of `BindWrapper`. This refactor just shares more code. (Rename GHC.Core.Opt.FloatOut.FloatBinds to FloatLets, to avoid gratuitious name clash with GHC.Core.FloatBinds.) Corecion optimisation * In simpleOpt, when composing coercions, call new function `optTransCo`. This is much lighter weight than full blown coercion optimisation. * Make `GHC.Core.Opt.Arity.pushCoValArg` and `pushCoTyArg` return the coercionLKind of the coercion. This saves recomputing that coercionLKind at the key call sites in GHC.Core.Opt.Simplify.Iteration.pushCast. * Rename `addCoerce` in GHC.Core.Simplify.Iteration to become `pushCast`. * In the `ApplyToVal` case of `pushCast` we had a very unsavoury call to `simplArg`. I eliminated it by adding a field `sc_cast` to `ApplyToVal` that records any pending casts. Much nicer now. See Note [The sc_cast field of ApplyToVal]. * Don't optimise coercions if the type-substitution is empty. See Note [Optimising coercions] in GHC.Core.Opt.Simplify.Iteration. The fix for #26838 is dramatic. For the test in perf/compiler/T26839 we have Compiler allocs: Before: 7,363M After: 688M Compile time goes down generally. Here are compiler-alloc changes over 0.5%: CoOpt_Read(normal) 729,184,920 -0.7% CoOpt_Singletons(normal) 666,916,960 -4.6% GOOD LargeRecord(normal) 1,227,056,876 +1.1% T12227(normal) 256,827,604 -4.6% GOOD T12425(optasm) 76,879,410 -0.8% T12545(normal) 787,826,918 -10.8% GOOD T12707(normal) 775,186,464 -0.9% T13253(normal) 318,599,596 -0.8% T14766(normal) 685,857,320 -1.0% T15304(normal) 1,123,333,422 -2.2% T15630(normal) 123,142,330 -2.6% T15630a(normal) 123,092,100 -2.6% T15703(normal) 299,751,682 -2.9% GOOD T17516(normal) 964,072,280 +1.0% T18223(normal) 367,016,820 -6.2% GOOD T18730(optasm) 130,643,770 -3.3% GOOD T20261(normal) 535,608,584 -0.7% T21839c(normal) 340,340,436 -0.9% T24984(normal) 85,568,392 -1.9% T3064(normal) 174,631,992 -1.2% T3294(normal) 1,215,886,432 -0.7% T5030(normal) 141,449,704 -17.2% GOOD T5321Fun(normal) 258,484,744 -1.9% T8095(normal) 770,532,232 -2.7% T9630(normal) 858,423,408 -14.5% GOOD T9872c(normal) 1,591,709,448 +0.7% info_table_map_perf(normal) 19,700,614,458 -1.3% geo. mean -0.7% minimum -17.2% maximum +1.1% However, strangely there seems to be a 5.0% increase in CoOpt_Read in the x86_64-linux-fedora43-validate+debug_info+ubsan job, although there generally a /decrease/ in this test in other builds. The baseline value looks strange. Anyway I'll just accept it. Metric Decrease: CoOpt_Singletons T12227 T12545 T12707 T15703 T18223 T18730 T21839c T5030 T9630 Metric Increase: CoOpt_Read - - - - - 3df97ad6 by Mrjtjmn at 2026-05-20T13:00:21-04:00 users-guide: Fix weird notation in "Summary of stolen syntax" - - - - - 127 changed files: - + changelog.d/T27202 - + changelog.d/rts_symlinks.md - compiler/GHC/Core.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Make.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Core/Opt/FloatIn.hs - compiler/GHC/Core/Opt/FloatOut.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Ppr.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/SimpleOpt.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Data/List/SetOps.hs - compiler/GHC/Driver/Config/Core/Lint.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/HsToCore/Pmc/Solver.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Tc/Types/Evidence.hs - compiler/GHC/Types/Id/Make.hs - compiler/GHC/Unit/State.hs - docs/users_guide/exts/stolen_syntax.rst - docs/users_guide/exts/template_haskell.rst - ghc/GHCi/UI.hs - ghc/Main.hs - hadrian/src/Rules/Register.hs - hadrian/src/Rules/Rts.hs - testsuite/tests/codeGen/should_compile/T25177.stderr - testsuite/tests/deSugar/should_compile/T13208.stdout - testsuite/tests/driver/fat-iface/fat014.stdout - + testsuite/tests/ghci/prog-mhu006/Makefile - + testsuite/tests/ghci/prog-mhu006/a/A.hs - + testsuite/tests/ghci/prog-mhu006/all.T - + testsuite/tests/ghci/prog-mhu006/b/B.hs - + testsuite/tests/ghci/prog-mhu006/prog-mhu006a.script - + testsuite/tests/ghci/prog-mhu006/prog-mhu006a.stdout - + testsuite/tests/ghci/prog-mhu006/unitA - + testsuite/tests/ghci/prog-mhu006/unitB - testsuite/tests/ghci/prog003/prog003.T - testsuite/tests/ghci/prog018/prog018.stdout - testsuite/tests/ghci/prog020/Makefile - testsuite/tests/ghci/prog020/all.T - testsuite/tests/ghci/prog020/ghci.prog020.script → testsuite/tests/ghci/prog020/ghci.prog020a.script - testsuite/tests/ghci/prog020/ghci.prog020.stderr → testsuite/tests/ghci/prog020/ghci.prog020a.stderr - testsuite/tests/ghci/prog020/ghci.prog020.stdout → testsuite/tests/ghci/prog020/ghci.prog020a.stdout - + testsuite/tests/ghci/prog020/ghci.prog020b.script - + testsuite/tests/ghci/prog020/ghci.prog020b.stderr - + testsuite/tests/ghci/prog020/ghci.prog020b.stdout - + testsuite/tests/ghci/prog023/Makefile - + testsuite/tests/ghci/prog023/all.T - + testsuite/tests/ghci/prog023/prog023a.script - + testsuite/tests/ghci/prog023/prog023a.stdout - + testsuite/tests/ghci/prog023/prog023b.script - + testsuite/tests/ghci/prog023/prog023b.stdout - + testsuite/tests/ghci/prog023/src/A.hs - + testsuite/tests/ghci/prog024/Makefile - + testsuite/tests/ghci/prog024/all.T - + testsuite/tests/ghci/prog024/prog024a.script - + testsuite/tests/ghci/prog024/prog024a.stdout - + testsuite/tests/ghci/prog024/prog024b.script - + testsuite/tests/ghci/prog024/prog024b.stdout - + testsuite/tests/ghci/prog024/prog024c.script - + testsuite/tests/ghci/prog024/prog024c.stderr - + testsuite/tests/ghci/prog024/prog024c.stdout - + testsuite/tests/ghci/prog024/prog024d.script - + testsuite/tests/ghci/prog024/prog024d.stderr - + testsuite/tests/ghci/prog024/prog024d.stdout - + testsuite/tests/ghci/prog024/prog024e.script - + testsuite/tests/ghci/prog024/prog024e.stdout - + testsuite/tests/ghci/prog024/prog024f.script - + testsuite/tests/ghci/prog024/prog024f.stdout - + testsuite/tests/ghci/prog024/src/A.hs - + testsuite/tests/ghci/prog024/src/B.hs - + testsuite/tests/ghci/prog025/Makefile - + testsuite/tests/ghci/prog025/a/A.hs - + testsuite/tests/ghci/prog025/all.T - + testsuite/tests/ghci/prog025/prog025a.script - + testsuite/tests/ghci/prog025/prog025a.stdout - + testsuite/tests/ghci/prog025/prog025b.script - + testsuite/tests/ghci/prog025/prog025b.stdout - + testsuite/tests/ghci/prog025/testpkg/Test.hs - + testsuite/tests/ghci/prog025/testpkg/testpkg-0.1.0.0.pkg - + testsuite/tests/ghci/prog025/testpkg/testpkg-0.2.0.0.pkg - + testsuite/tests/ghci/prog025/unitA - testsuite/tests/ghci/scripts/T13997.stdout - testsuite/tests/ghci/scripts/T1914.stdout - testsuite/tests/ghci/scripts/T20217.stdout - testsuite/tests/ghci/scripts/T8042.stdout - testsuite/tests/ghci/scripts/T8042recomp.stdout - testsuite/tests/ghci/should_run/T10920.stderr - testsuite/tests/linters/notes.stdout - testsuite/tests/numeric/should_compile/T15547.stderr - testsuite/tests/numeric/should_compile/T20347.stderr - testsuite/tests/numeric/should_compile/T20374.stderr - testsuite/tests/numeric/should_compile/T20376.stderr - + testsuite/tests/perf/compiler/T26989.hs - + testsuite/tests/perf/compiler/T26989a.hs - testsuite/tests/perf/compiler/all.T - testsuite/tests/printer/T18052a.stderr - testsuite/tests/simplCore/should_compile/DsSpecPragmas.stderr - testsuite/tests/simplCore/should_compile/RewriteHigherOrderPatterns.stderr - testsuite/tests/simplCore/should_compile/T15205.stderr - testsuite/tests/simplCore/should_compile/T18668.stderr - testsuite/tests/simplCore/should_compile/T19246.stderr - testsuite/tests/simplCore/should_compile/T19599.stderr - testsuite/tests/simplCore/should_compile/T19599a.stderr - testsuite/tests/simplCore/should_compile/T21917.stderr - testsuite/tests/simplCore/should_compile/T23074.stderr - testsuite/tests/simplCore/should_compile/T24359a.stderr - testsuite/tests/simplCore/should_compile/T25160.stderr - testsuite/tests/simplCore/should_compile/T25718c.stderr-ws-32 - testsuite/tests/simplCore/should_compile/T25718c.stderr-ws-64 - testsuite/tests/simplCore/should_compile/T26051.stderr - testsuite/tests/simplCore/should_compile/T26116.stderr - testsuite/tests/simplCore/should_compile/T8331.stderr - testsuite/tests/simplCore/should_compile/T8848a.stderr - testsuite/tests/simplCore/should_compile/spec004.stderr - testsuite/tests/typecheck/should_compile/T13032.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ac034fa77b61047701492e391a71b9… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ac034fa77b61047701492e391a71b9… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Pushed new branch wip/fendor/revert-ghci003-test-accept
by Hannes Siebenhandl (＠fendor) 20 May '26

20 May '26

Hannes Siebenhandl pushed new branch wip/fendor/revert-ghci003-test-accept at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/fendor/revert-ghci003-test-ac… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] 2 commits: Fix regression T27202: `:load` and `:add` work in GHCi
by Marge Bot (＠marge-bot) 20 May '26

20 May '26

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 286f1adf by fendor at 2026-05-20T12:27:09-04:00 Fix regression T27202: `:load` and `:add` work in GHCi To fix the regression there are conceptually two major things that we fix: * We don't remove the `importDirs` from `interactive-session` * When `:add`ing a module, we don't try to find them via PackageImports * The PackageImport is wrong as we can't know the package-name at this stage in ghc/UI.hs What does it mean to not remove the `importDirs` from `interactive-session`? It means that, given some initial `DynFlags`, we will use those `importDirs` in `interactive-session`. The initial `DynFlags`, however, depend on how you initialise the GHC session. For a simple session, initialised by ghc -isrc -this-unit-id main It is simple, just use the `DynFlags` given on the cli. Thus, `main` and `interactive-session` will have the same `DynFlags`, except for the `homeUnitId` and `interactive-session` depends on `main` by construction of the GHCi session. What about a multiple home unit session, though? ghc -unit @unit1 -unit @unit2 What are the `DynFlags` in this cli invocation? It shouldn't be either `@unti1` nor `@unit2`, as the order shouldn't matter or any other implicit condition. For consistency, we decide that the initial `DynFlags` are the top `DynFlags` on the cli, ignoring `-unit` flags. Thus, in this example, there are no `importsDirs` regardless of what we might find in `@unit1` and `@unit2`. But in this invocation: ghc -isrc -unit @unit1 -unit @unit2 The `interactive-session` will have the `importsDirs` `src`. Note, `-isrc` will be inherited in `@unit1` and `@unit2`, so you need to explicitly use `-i` to clear the `importsDirs`, in order to avoid accidentally adding `src` as an import directory to all other home units. This fix has been made possible by the improvements introduced in !15888, which avoids ambiguity when a home unit shares the `importsDirs` with the `interactive-session`, on top of being much faster for multiple home units. Adds regression tests for T27202 for `:load`ing and `:add`ing modules that are located in import directories. - - - - - 728662de by fendor at 2026-05-20T12:27:09-04:00 Use home unit package db stacks in GHCi prompt and session unit In order to import modules from home unit dependencies (e.g., `Data.Map`), the ghci prompt unit needs to populate its `UnitState`. This is tricky to handle correctly, which `PackageDBFlag`s should we use to populate the `UnitState`? We decide, the most intuitive solution for users is to depend on all `PackageDBFlag`s, so that any dependency can be imported in GHCi. This assumes consistency in the `PackageDBFlag`s, so no two home units specify `PackageDBFlag`s that are inconsistent with each other. We could simply concat all the `PackageDBFlag`s of the existing home units, but later `PackageDBFlag`s shadow earlier ones, leading to the last processed home units' `PackageDBFlag`s to shadow the earlier ones. This is hard to fix, we need to give users the capability to provide ghc options for the ghci prompt home unit. However, as this is considerably more work, we decided on an approximation that should work out most of the time. Package Db stacks in cabal and stack follow a certain structure: -no-user-package-db > -package-db $cabal-store > -package-db $local-db The first two arguments are always the same, namely the `-no-user-package-db` and `-package-db`. We compute the longest common prefix over all home units, and use that as the start of the package db stack. Then, over the rest of the `PackageDBFlag`s, we simply take the union and append them to our initial stack. We assume, that the rest of package dbs only defines very few, "local" units that are usually not shadowing each other. This allows us to get a relatively consistent package database stack for the ghci prompt home unit. Similar reasoning applies to the session unit in order to add modules to the session and have dependencies available in the module. We do something similar for `-package` flags, to make sure only the correct units are actually visible in the ghci session. This time, we simply take the union of all `PackageFlag`s, allowing us to import modules from the home unit dependencies. In the future, it would be beneficial to allow the user to provide the exact ghc options to control the visibilities. For now, this will have to do. - - - - - 66 changed files: - + changelog.d/T27202 - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Unit/State.hs - ghc/GHCi/UI.hs - ghc/Main.hs - testsuite/tests/driver/fat-iface/fat014.stdout - + testsuite/tests/ghci/prog-mhu006/Makefile - + testsuite/tests/ghci/prog-mhu006/a/A.hs - + testsuite/tests/ghci/prog-mhu006/all.T - + testsuite/tests/ghci/prog-mhu006/b/B.hs - + testsuite/tests/ghci/prog-mhu006/prog-mhu006a.script - + testsuite/tests/ghci/prog-mhu006/prog-mhu006a.stdout - + testsuite/tests/ghci/prog-mhu006/unitA - + testsuite/tests/ghci/prog-mhu006/unitB - testsuite/tests/ghci/prog003/prog003.T - testsuite/tests/ghci/prog018/prog018.stdout - testsuite/tests/ghci/prog020/Makefile - testsuite/tests/ghci/prog020/all.T - testsuite/tests/ghci/prog020/ghci.prog020.script → testsuite/tests/ghci/prog020/ghci.prog020a.script - testsuite/tests/ghci/prog020/ghci.prog020.stderr → testsuite/tests/ghci/prog020/ghci.prog020a.stderr - testsuite/tests/ghci/prog020/ghci.prog020.stdout → testsuite/tests/ghci/prog020/ghci.prog020a.stdout - + testsuite/tests/ghci/prog020/ghci.prog020b.script - + testsuite/tests/ghci/prog020/ghci.prog020b.stderr - + testsuite/tests/ghci/prog020/ghci.prog020b.stdout - + testsuite/tests/ghci/prog023/Makefile - + testsuite/tests/ghci/prog023/all.T - + testsuite/tests/ghci/prog023/prog023a.script - + testsuite/tests/ghci/prog023/prog023a.stdout - + testsuite/tests/ghci/prog023/prog023b.script - + testsuite/tests/ghci/prog023/prog023b.stdout - + testsuite/tests/ghci/prog023/src/A.hs - + testsuite/tests/ghci/prog024/Makefile - + testsuite/tests/ghci/prog024/all.T - + testsuite/tests/ghci/prog024/prog024a.script - + testsuite/tests/ghci/prog024/prog024a.stdout - + testsuite/tests/ghci/prog024/prog024b.script - + testsuite/tests/ghci/prog024/prog024b.stdout - + testsuite/tests/ghci/prog024/prog024c.script - + testsuite/tests/ghci/prog024/prog024c.stderr - + testsuite/tests/ghci/prog024/prog024c.stdout - + testsuite/tests/ghci/prog024/prog024d.script - + testsuite/tests/ghci/prog024/prog024d.stderr - + testsuite/tests/ghci/prog024/prog024d.stdout - + testsuite/tests/ghci/prog024/prog024e.script - + testsuite/tests/ghci/prog024/prog024e.stdout - + testsuite/tests/ghci/prog024/prog024f.script - + testsuite/tests/ghci/prog024/prog024f.stdout - + testsuite/tests/ghci/prog024/src/A.hs - + testsuite/tests/ghci/prog024/src/B.hs - + testsuite/tests/ghci/prog025/Makefile - + testsuite/tests/ghci/prog025/a/A.hs - + testsuite/tests/ghci/prog025/all.T - + testsuite/tests/ghci/prog025/prog025a.script - + testsuite/tests/ghci/prog025/prog025a.stdout - + testsuite/tests/ghci/prog025/prog025b.script - + testsuite/tests/ghci/prog025/prog025b.stdout - + testsuite/tests/ghci/prog025/testpkg/Test.hs - + testsuite/tests/ghci/prog025/testpkg/testpkg-0.1.0.0.pkg - + testsuite/tests/ghci/prog025/testpkg/testpkg-0.2.0.0.pkg - + testsuite/tests/ghci/prog025/unitA - testsuite/tests/ghci/scripts/T13997.stdout - testsuite/tests/ghci/scripts/T1914.stdout - testsuite/tests/ghci/scripts/T20217.stdout - testsuite/tests/ghci/scripts/T8042.stdout - testsuite/tests/ghci/scripts/T8042recomp.stdout - testsuite/tests/ghci/should_run/T10920.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1a7de2325e0bcc21488061f30c57e6… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1a7de2325e0bcc21488061f30c57e6… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] Hadrian: remove legacy rts .so symlinks
by Marge Bot (＠marge-bot) 20 May '26

20 May '26

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 1a7de232 by Duncan Coutts at 2026-05-20T12:26:25-04:00 Hadrian: remove legacy rts .so symlinks For compatibility with the old makefile based build system, hadrian had rules to generate symlinks from unversioned to versioned names for the rts .so/.dynlib file, like libHSrts-ghcx.y.so -> libHSrts-1.0.3-ghcx.y.so We no longer need these symlinks since the makefile build system has been retired some time ago. The need for these symlinks is awkward on windows where we cannot (in practice) create symlinks. So rather than make them conditional (non-windows), just remove them entirely. - - - - - 3 changed files: - + changelog.d/rts_symlinks.md - hadrian/src/Rules/Register.hs - hadrian/src/Rules/Rts.hs Changes: ===================================== changelog.d/rts_symlinks.md ===================================== @@ -0,0 +1,11 @@ +section: packaging +issues: #27162 +mrs: !15913 +synopsis: + GHC binary distributions no longer ship with unversioned symlinks of the RTS libraries (.so/.dylib) +description: + Whith dynamic linking, an RTS with explicit version number is already linked by default e.g. + `libHSrts-1.0.3-ghc9.14.1.so`. GHC's binary distributions previously included symlinks without + an explicit RTS versions number e.g. `libHSrts-ghc9.14.1.so -> libHSrts-1.0.3-ghc9.14.1.so`. + As they are not used, such unversioned symlinks are no longer included in binary distributions. + Custom tooling that makes use of the removed symlinks, should now use the versioned file name instead. ===================================== hadrian/src/Rules/Register.hs ===================================== @@ -12,7 +12,6 @@ import Hadrian.BuildPath import Hadrian.Expression import Hadrian.Haskell.Cabal import Packages -import Rules.Rts import Settings import Target import Utilities @@ -88,14 +87,9 @@ parseToBuildSubdirectory root = do -- * Registering registerPackages :: [Context] -> Action () -registerPackages ctxs = do +registerPackages ctxs = need =<< mapM pkgRegisteredLibraryFile ctxs - -- Dynamic RTS library files need symlinks (Rules.Rts.rtsRules). - forM_ ctxs $ \ ctx -> when (package ctx == rts) $ do - ways <- interpretInContext ctx (getLibraryWays <> getRtsWays) - needRtsSymLinks (stage ctx) ways - -- | Register a package and initialise the corresponding package database if -- need be. Note that we only register packages in 'Stage0' and 'Stage1'. registerPackageRules :: [(Resource, Int)] -> Stage -> Inplace -> Rules () ===================================== hadrian/src/Rules/Rts.hs ===================================== @@ -1,10 +1,5 @@ -{-# LANGUAGE MultiWayIf #-} +module Rules.Rts (rtsRules) where -module Rules.Rts (rtsRules, needRtsSymLinks) where - -import qualified Data.Set as Set - -import Packages (rts) import Hadrian.Utilities import Settings.Builders.Common @@ -12,18 +7,7 @@ import Settings.Builders.Common -- library files (see Rules.Library.libraryRules). rtsRules :: Rules () rtsRules = priority 3 $ do - -- Dynamic RTS library files need symlinks without the dummy version number. - -- This is for backwards compatibility (the old make build system omitted the - -- dummy version number). root <- buildRootRules - [ root -/- "**/libHSrts_*-ghc*.so", - root -/- "**/libHSrts_*-ghc*.dylib", - root -/- "**/libHSrts-ghc*.so", - root -/- "**/libHSrts-ghc*.dylib"] - |%> \ rtsLibFilePath' -> createFileLink - (addRtsDummyVersion $ takeFileName rtsLibFilePath') - rtsLibFilePath' - -- Solve the recursive dependency between the rts and ghc-internal -- on Windows by creating an import lib for the ghc-internal dll, -- to be linked into the rts dll. @@ -37,35 +21,3 @@ buildGhcInternalImportLib target = do output = target -- the .dll.a import lib need [input] runBuilder Dlltool ["-d", input, "-l", output] [input] [output] - --- Need symlinks generated by rtsRules. -needRtsSymLinks :: Stage -> Set.Set Way -> Action () -needRtsSymLinks stage rtsWays - = forM_ (Set.filter (wayUnit Dynamic) rtsWays) $ \ way -> do - let ctx = Context stage rts way Final - distDir <- distDynDir ctx - rtsLibFile <- takeFileName <$> pkgLibraryFile ctx - need [removeRtsDummyVersion (distDir </> rtsLibFile)] - -prefix, versionlessPrefix :: String -versionlessPrefix = "libHSrts" -prefix = versionlessPrefix ++ "-1.0.3" - --- removeRtsDummyVersion "a/libHSrts-1.0-ghc1.2.3.4.so" --- == "a/libHSrts-ghc1.2.3.4.so" -removeRtsDummyVersion :: FilePath -> FilePath -removeRtsDummyVersion = replaceLibFilePrefix prefix versionlessPrefix - --- addRtsDummyVersion "a/libHSrts-ghc1.2.3.4.so" --- == "a/libHSrts-1.0-ghc1.2.3.4.so" -addRtsDummyVersion :: FilePath -> FilePath -addRtsDummyVersion = replaceLibFilePrefix versionlessPrefix prefix - -replaceLibFilePrefix :: String -> String -> FilePath -> FilePath -replaceLibFilePrefix oldPrefix newPrefix oldFilePath = let - oldFileName = takeFileName oldFilePath - newFileName = maybe - (error $ "Expected RTS library file to start with " ++ oldPrefix) - (newPrefix ++) - (stripPrefix oldPrefix oldFileName) - in replaceFileName oldFilePath newFileName View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1a7de2325e0bcc21488061f30c57e6b… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1a7de2325e0bcc21488061f30c57e6b… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/davide/ghc-internal-def] Hadrian: create a ghc-internal .def file per ghc-internal dll
by David Eichmann (＠DavidEichmann) 20 May '26

20 May '26

David Eichmann pushed to branch wip/davide/ghc-internal-def at Glasgow Haskell Compiler / GHC Commits: e5dcd268 by David Eichmann at 2026-05-20T16:08:07+01:00 Hadrian: create a ghc-internal .def file per ghc-internal dll The .def file generated from rts/win32/libHSghc-internal.def.in contains the name of the ghc-internal dll, but that differs based on if the dll is inplace/final and what way it is. Previously, this was not accounted for and inconsistent dlls names where used. That led to failure when loading dlls are runtime in experiments with windows dynamic linking. - - - - - 5 changed files: - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Library.hs - hadrian/src/Rules/Rts.hs - rts/.gitignore - rts/win32/libHSghc-internal.def.in Changes: ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -377,7 +377,6 @@ templateRules = do , interpolateSetting "ProjectPatchLevel1" ProjectPatchLevel1 , interpolateSetting "ProjectPatchLevel2" ProjectPatchLevel2 ] - templateRule "rts/win32/libHSghc-internal.def" projectVersion templateRule "docs/index.html" $ packageUnitIds Stage1 templateRule "docs/users_guide/ghc_config.py" $ mconcat [ projectVersion ===================================== hadrian/src/Rules/Library.hs ===================================== @@ -203,10 +203,21 @@ extraObjects context | package context == rts = do target <- interpretInContext context getStagedTarget - builddir <- buildPath context - return [ builddir -/- "libHSghc-internal.dll.a" - | archOS_OS (tgtArchOs target) == OSMinGW32 - , Dynamic `wayUnit` way context ] + if not (archOS_OS (tgtArchOs target) == OSMinGW32 + && Dynamic `wayUnit` way context) + then return [] + else do + -- Find the ghc-internal library file name + let way' = if Profiling `wayUnit` way context then profilingDynamic else dynamic + ghcInternalDllName <- takeFileName <$> pkgLibraryFile (Context { + stage = stage context, + way = way', + iplace = iplace context, + package = ghcInternal + }) + + builddir <- buildPath context + return [ builddir -/- ghcInternalDllName <> ".a"] | otherwise = return [] ===================================== hadrian/src/Rules/Rts.hs ===================================== @@ -29,11 +29,19 @@ rtsRules = priority 3 $ do -- to be linked into the rts dll. forM_ [Stage1, Stage2, Stage3 ] $ \ stage -> do let buildPath = root -/- buildDir (rtsContext stage) - buildPath -/- "libHSghc-internal.dll.a" %> buildGhcInternalImportLib + buildPath -/- "libHSghc-internal-*.def" %> buildGhcInternalImportDef + buildPath -/- "libHSghc-internal-*.dll.a" %> buildGhcInternalImportLib + +buildGhcInternalImportDef :: FilePath -> Action () +buildGhcInternalImportDef target = do + templateIn <- readFile' "rts/win32/libHSghc-internal.def.in" + let dllName = (dropExtension (takeFileName target)) <.> "dll" + templateOut = replace "@GhcInternalDll@" dllName templateIn + writeFile' target templateOut buildGhcInternalImportLib :: FilePath -> Action () buildGhcInternalImportLib target = do - let input = "rts/win32/libHSghc-internal.def" + let input = (dropExtension (dropExtension target)) <.> "def" -- the .def file output = target -- the .dll.a import lib need [input] runBuilder Dlltool ["-d", input, "-l", output] [input] [output] ===================================== rts/.gitignore ===================================== @@ -20,4 +20,3 @@ /ghcautoconf.h.autoconf.in /ghcautoconf.h.autoconf /include/ghcautoconf.h -/win32/libHSghc-internal.def ===================================== rts/win32/libHSghc-internal.def.in ===================================== @@ -1,4 +1,4 @@ -LIBRARY libHSghc-internal-@ProjectVersionForLib@.0-ghc@ProjectVersion@.dll +LIBRARY @GhcInternalDll@ EXPORTS init_ghc_hs_iface View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e5dcd268ddf0449496b789d1e8d5f35… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e5dcd268ddf0449496b789d1e8d5f35… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/davide/ghc-internal-def] Hadrian: create a ghc-internal .def file per ghc-internal dll
by David Eichmann (＠DavidEichmann) 20 May '26

20 May '26

David Eichmann pushed to branch wip/davide/ghc-internal-def at Glasgow Haskell Compiler / GHC Commits: bbee1693 by David Eichmann at 2026-05-20T15:48:40+01:00 Hadrian: create a ghc-internal .def file per ghc-internal dll The .def file generated from rts/win32/libHSghc-internal.def.in contains the name of the ghc-internal dll, but that differs based on if the dll is inplace/final and what way it is. Previously, this was not accounted for and inconsistent dlls names where used. That led to failure when loading dlls are runtime in experiments with windows dynamic linking. - - - - - 5 changed files: - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Library.hs - hadrian/src/Rules/Rts.hs - rts/.gitignore - rts/win32/libHSghc-internal.def.in Changes: ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -377,7 +377,6 @@ templateRules = do , interpolateSetting "ProjectPatchLevel1" ProjectPatchLevel1 , interpolateSetting "ProjectPatchLevel2" ProjectPatchLevel2 ] - templateRule "rts/win32/libHSghc-internal.def" projectVersion templateRule "docs/index.html" $ packageUnitIds Stage1 templateRule "docs/users_guide/ghc_config.py" $ mconcat [ projectVersion ===================================== hadrian/src/Rules/Library.hs ===================================== @@ -203,10 +203,21 @@ extraObjects context | package context == rts = do target <- interpretInContext context getStagedTarget - builddir <- buildPath context - return [ builddir -/- "libHSghc-internal.dll.a" - | archOS_OS (tgtArchOs target) == OSMinGW32 - , Dynamic `wayUnit` way context ] + if not (archOS_OS (tgtArchOs target) == OSMinGW32 + && Dynamic `wayUnit` way context) + then return [] + else do + -- Find the ghc-internal library file name + let way' = if Profiling `wayUnit` way context then profilingDynamic else dynamic + ghcInternalDllName <- pkgLibraryFile (Context { + stage = stage context, + way = way', + iplace = iplace context, + package = ghcInternal + }) + + builddir <- buildPath context + return [ builddir -/- ghcInternalDllName <> ".a"] | otherwise = return [] ===================================== hadrian/src/Rules/Rts.hs ===================================== @@ -29,11 +29,19 @@ rtsRules = priority 3 $ do -- to be linked into the rts dll. forM_ [Stage1, Stage2, Stage3 ] $ \ stage -> do let buildPath = root -/- buildDir (rtsContext stage) - buildPath -/- "libHSghc-internal.dll.a" %> buildGhcInternalImportLib + buildPath -/- "libHSghc-internal-*.def" %> buildGhcInternalImportDef + buildPath -/- "libHSghc-internal-*.dll.a" %> buildGhcInternalImportLib + +buildGhcInternalImportDef :: FilePath -> Action () +buildGhcInternalImportDef target = do + templateIn <- readFile' "rts/win32/libHSghc-internal.def.in" + let dllName = (dropExtension (takeFileName target)) <.> "dll" + templateOut = replace "@GhcInternalDll@" dllName templateIn + writeFile' target templateOut buildGhcInternalImportLib :: FilePath -> Action () buildGhcInternalImportLib target = do - let input = "rts/win32/libHSghc-internal.def" + let input = (dropExtension (dropExtension target)) <.> "def" -- the .def file output = target -- the .dll.a import lib need [input] runBuilder Dlltool ["-d", input, "-l", output] [input] [output] ===================================== rts/.gitignore ===================================== @@ -20,4 +20,3 @@ /ghcautoconf.h.autoconf.in /ghcautoconf.h.autoconf /include/ghcautoconf.h -/win32/libHSghc-internal.def ===================================== rts/win32/libHSghc-internal.def.in ===================================== @@ -1,4 +1,4 @@ -LIBRARY libHSghc-internal-@ProjectVersionForLib@.0-ghc@ProjectVersion@.dll +LIBRARY @GhcInternalDll@ EXPORTS init_ghc_hs_iface View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bbee16932f3a66a3b02d754b24d7067… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bbee16932f3a66a3b02d754b24d7067… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/mangoiv/ghc-9.12-bp] driver: recognise .dyn_o as a valid object file to link if passed on the command line.
by Magnus (＠MangoIV) 20 May '26

20 May '26

Magnus pushed to branch wip/mangoiv/ghc-9.12-bp at Glasgow Haskell Compiler / GHC Commits: 213aa422 by Zubin Duggal at 2026-05-20T15:42:11+02: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 (cherry picked from commit bc4b44870d096d43e8cbc530da1fd613d9e4514f) - - - - - 9 changed files: - compiler/GHC/Driver/Phases.hs - 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 Changes: ===================================== compiler/GHC/Driver/Phases.hs ===================================== @@ -256,7 +256,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 ===================================== testsuite/tests/plugins/Makefile ===================================== @@ -234,3 +234,14 @@ test-late-plugin: ContainsLateBinding=$$(echo $$SHOW_IFACE | grep -o 222222) ; \ echo "$$ContainsLateBinding" ; \ [ "$$ContainsEarlyBinding" = "111111" ] && [ "$$ContainLateBinding" = "" ] + +.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 ===================================== @@ -376,3 +376,10 @@ test('test-late-plugin', [extra_files(['late-plugin/LatePlugin.hs']), ignore_stdout], 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, []) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/213aa422f3c3046f606d88f5b532f8a… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/213aa422f3c3046f606d88f5b532f8a… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/mangoiv/ghc-9.12-bp] 2 commits: configure: Accept happy-2.2
by Magnus (＠MangoIV) 20 May '26

20 May '26

Magnus pushed to branch wip/mangoiv/ghc-9.12-bp at Glasgow Haskell Compiler / GHC Commits: 9ba34598 by Brian J. Cardiff at 2026-05-20T15:17:39+02:00 configure: Accept happy-2.2 In Jan 2026 happy-2.2 was released. The most sensible change is https://github.com/haskell/happy/issues/335 which didn't trigger in a fresh build (cherry picked from commit 4f2840f2bb729ef1a6660f9f5c46906b7b838147) - - - - - 4a9baf14 by sheaf at 2026-05-20T15:28:16+02:00 Careful with ticked join points in mergeCaseAlts This commit backports the fix to GHC.Core.Utils.mergeCaseAlts that was carried out in f726fcc4fb0b59f8ad2e2fa80f1b03efdaf73c30. That is, this commit addresses the regression that was introduced by e026bdf275e287005f2c2e534d3ba034ebf11c01, which allowed mergeCaseAlts to move ticks in between a join point and one of its jumps, which results in disaster (see #26929 but also #26642, #26693). See (MC6) in Note [Merge Nested Cases] for a detailed explanation. (cherry picked from commit 08bc245be70d95801bc1138804ed1de9474fbdc0) (cherry picked from commit 974586eb5b6a924e8ce3ea8c4b2180ea9c0f3801) - - - - - 4 changed files: - compiler/GHC/Core/Utils.hs - m4/fptools_happy.m4 - + testsuite/tests/simplCore/should_compile/T26642.hs - testsuite/tests/simplCore/should_compile/all.T Changes: ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -709,11 +709,16 @@ mergeCaseAlts outer_bndr (Alt DEFAULT _ deflt_rhs : outer_alts) | otherwise = Nothing - -- We don't want ticks to get in the way; just push them inwards. - -- (This happens when you add SourceTicks e.g. GHC.Num.Integer.integerLt#) + -- Push ticks **inwards** (when possible). + -- See (MC5) in Note [Merge Nested Cases]. go (Tick t body) - = do { (joins, alts) <- go body - ; return (joins, [Alt con bs (Tick t rhs) | Alt con bs rhs <- alts]) } + = do { (joins, alts) <- go body -- (MC4): any join points inside are floated out of the tick. + + -- Abort if this would put a non-soft-scope tick in between + -- a join point binding and its jumps. See (MC6). + ; guard $ null joins || t `tickishScopesLike` SoftScope + ; return (joins, [Alt con bs (mkTick t rhs) | Alt con bs rhs <- alts]) + } go _ = Nothing @@ -924,9 +929,70 @@ Wrinkles So `mergeCaseAlts` floats out any join points. It doesn't float out non-join-points unless the /outer/ case has just one alternative; doing - so would risk more allocation + so would risk more allocation. + + Note also that `mergeCaseAlts` floats join points out of ticks, for which + we need to be extra careful; see (MC6). + +(MC5) We want to move ticks out of the way if possible, to prevent them from + inhibiting optimisation. For example, say we have: + + case expensive of r { + C1 -> rhs1; -- happy path + _ -> scctick<doEdgeCase> (case r of { C2 -> rhs2; C3 -> rhs3 }) + } + + In this situation, we push the "doEdgeCase" tick **inwards** and proceed + to merge cases, like so: + + case expensive of + C1 -> rhs1 + C2 -> scctick<doEdgeCase> rhs2 + C3 -> scctick<doEdgeCase> rhs3 + + This preserves the tick semantics, because this transformation: + + 1. preserves counts, + 2. does not move cost in or out of the tick scope. + + (1) is clear: we will tick 'doEdgeCase' exactly in the C2/C3 alternatives, + and we won't otherwise. + For (2), recall that case is strict in Core. We already evaluated 'expensive', + so re-scrutinising 'r' is free. + + This means that, perhaps surprisingly, this transformation is valid for + **all** ticks, including non-floatable ones. + + In contrast, we would not want to move the tick outwards, because this: + + - will lead to additional counting of 'doEdgeCase' in the 'C1' (happy path) case, + - risks attributing the cost of evaluating 'expensive' to 'doEdgeCase'. + +(MC6) There is a dangerous interaction between (MC4) and (MC5), which can lead + to invalid Core (as reported in #26642, #26929). Suppose we have: + + case f x of r -> + scctick<foo> + join j y = rhs in + case r of { C1 -> j 1; C2 -> bar } + + If we naively carried out (MC4) and (MC5) together, this would result in: + + join j y = rhs in + case f x of + C1 -> scctick<foo> (j 1) + C2 -> scctick<foo> bar + + This has moved the tick in between the join point binding 'j' and the + join point jump, which is invalid. The simplifier cannot deal with such + Core, resulting in #26642. + + The solution: abort whenever we would position a non-soft-scope tick + inside a join point in this manner. + An alternative would be to float the tick outwards, but as we saw in (MC5) + this risks a grave misattribution of profiling costs, so we don't do that. -(MC5) See Note [Cascading case merge] +(MC7) See Note [Cascading case merge] See also Note [Example of case-merging and caseRules] in GHC.Core.Opt.Simplify.Utils ===================================== m4/fptools_happy.m4 ===================================== @@ -24,13 +24,18 @@ changequote([, ])dnl ]) if test ! -f compiler/GHC/Parser.hs || test ! -f compiler/GHC/Cmm/Parser.hs then - failure_msg="Happy version == 1.20.* || >= 2.0.2 && < 2.2 is required to compile GHC" + if test x"$fptools_cv_happy_version" != x; then + fptools_cv_happy_version_display="version $fptools_cv_happy_version"; + else + fptools_cv_happy_version_display="none"; + fi; + failure_msg="Happy version == 1.20.* || >= 2.0.2 && < 2.3 is required to compile GHC. (Found: $fptools_cv_happy_version_display)" FP_COMPARE_VERSIONS([$fptools_cv_happy_version],[-lt],[1.20.0], [AC_MSG_ERROR([$failure_msg])])[] FP_COMPARE_VERSIONS([$fptools_cv_happy_version],[-ge],[1.21.0], FP_COMPARE_VERSIONS([$fptools_cv_happy_version], [-le], [2.0.1], [AC_MSG_ERROR([$failure_msg])])[])[] - FP_COMPARE_VERSIONS([$fptools_cv_happy_version],[-ge],[2.2.0], + FP_COMPARE_VERSIONS([$fptools_cv_happy_version],[-ge],[2.3.0], [AC_MSG_ERROR([$failure_msg])])[] fi ===================================== testsuite/tests/simplCore/should_compile/T26642.hs ===================================== @@ -0,0 +1,46 @@ +module T26642 ( saveClobberedTemps ) where + +import Prelude ( IO, Bool(..), Int, (>>=), (==), return ) +import Data.Word ( Word64 ) + +------------------------------------------------------------------------------- + +data Word64Map a + = Bin (Word64Map a) (Word64Map a) + | Tip a + | Nil + +{-# NOINLINE myFoldr #-} +myFoldr :: (a -> b -> b) -> b -> Word64Map a -> b +myFoldr f = go + where + {-# NOINLINE go #-} + go z' Nil = z' + go z' (Tip x) = f x z' + go z' (Bin l r) = go (go z' r) l + +{-# NOINLINE nonDetFold #-} +nonDetFold :: (b -> elt -> IO b) -> b -> Word64Map elt -> IO b +nonDetFold f z0 xs = myFoldr c return xs z0 + where + {-# NOINLINE c #-} + c x k z = f z x >>= k + +{-# NOINLINE myFalse #-} +myFalse :: Bool +myFalse = False + +type RealReg = Int +data Loc = InReg RealReg | InMem + +saveClobberedTemps :: forall instr. [RealReg] -> IO [instr] +saveClobberedTemps clobbered = nonDetFold maybe_spill [] Nil + where + {-# NOINLINE maybe_spill #-} + maybe_spill :: [instr] -> Loc -> IO [instr] + maybe_spill instrs !loc = + case loc of + InReg reg + | myFalse + -> return [] + _ -> return instrs ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -470,6 +470,8 @@ test('T22272', normal, multimod_compile, ['T22272', '-O -fexpose-all-unfoldings # go should become a join point test('T22428', [grep_errmsg(r'jump go') ], compile, ['-O -ddump-simpl -dsuppress-uniques -dno-typeable-binds -dsuppress-unfoldings']) +test('T26642', [unless(have_profiling(), skip)], compile, ['-O -prof -fprof-auto-calls']) + test('T22459', normal, compile, ['']) test('T22623', normal, multimod_compile, ['T22623', '-O -v0']) test('T22662', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3319b7da62b0665b4425dbac3c060e… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3319b7da62b0665b4425dbac3c060e… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/davide/ghc-internal-def] Hadrian: create a ghc-internal .def file per ghc-internal dll
by David Eichmann (＠DavidEichmann) 20 May '26

20 May '26

David Eichmann pushed to branch wip/davide/ghc-internal-def at Glasgow Haskell Compiler / GHC Commits: a072d02f by David Eichmann at 2026-05-20T14:20:52+01:00 Hadrian: create a ghc-internal .def file per ghc-internal dll The .def file generated from rts/win32/libHSghc-internal.def.in contains the name of the ghc-internal dll, but that differs based on if the dll is inplace/final and what way it is. Previously, this was not accounted for and inconsistent dlls names where used. That led to failure when loading dlls are runtime in experiments with windows dynamic linking. - - - - - 5 changed files: - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Library.hs - hadrian/src/Rules/Rts.hs - rts/.gitignore - rts/win32/libHSghc-internal.def.in Changes: ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -377,7 +377,6 @@ templateRules = do , interpolateSetting "ProjectPatchLevel1" ProjectPatchLevel1 , interpolateSetting "ProjectPatchLevel2" ProjectPatchLevel2 ] - templateRule "rts/win32/libHSghc-internal.def" projectVersion templateRule "docs/index.html" $ packageUnitIds Stage1 templateRule "docs/users_guide/ghc_config.py" $ mconcat [ projectVersion ===================================== hadrian/src/Rules/Library.hs ===================================== @@ -203,10 +203,21 @@ extraObjects context | package context == rts = do target <- interpretInContext context getStagedTarget - builddir <- buildPath context - return [ builddir -/- "libHSghc-internal.dll.a" - | archOS_OS (tgtArchOs target) == OSMinGW32 - , Dynamic `wayUnit` way context ] + if not (archOS_OS (tgtArchOs target) == OSMinGW32 + && Dynamic `wayUnit` way context) + then return [] + else do + -- Find the ghc-internal library file name + let way' = if Profiling `wayUnit` way context then profiling else vanilla + ghcInternalDllName <- takeFileName <$> pkgLibraryFile (Context { + stage = stage context, + way = way', + iplace = iplace context, + package = ghcInternal + }) + + builddir <- buildPath context + return [ builddir -/- ghcInternalDllName <> ".a"] | otherwise = return [] ===================================== hadrian/src/Rules/Rts.hs ===================================== @@ -29,11 +29,19 @@ rtsRules = priority 3 $ do -- to be linked into the rts dll. forM_ [Stage1, Stage2, Stage3 ] $ \ stage -> do let buildPath = root -/- buildDir (rtsContext stage) - buildPath -/- "libHSghc-internal.dll.a" %> buildGhcInternalImportLib + buildPath -/- "libHSghc-internal-*.def" %> buildGhcInternalImportDef + buildPath -/- "libHSghc-internal-*.dll.a" %> buildGhcInternalImportLib + +buildGhcInternalImportDef :: FilePath -> Action () +buildGhcInternalImportDef target = do + templateIn <- readFile' "rts/win32/libHSghc-internal.def.in" + let dllName = (dropExtension (takeFileName target)) <.> "dll" + templateOut = replace "@GhcInternalDll@" dllName templateIn + writeFile' target templateOut buildGhcInternalImportLib :: FilePath -> Action () buildGhcInternalImportLib target = do - let input = "rts/win32/libHSghc-internal.def" + let input = (dropExtension (dropExtension target)) <.> "def" -- the .def file output = target -- the .dll.a import lib need [input] runBuilder Dlltool ["-d", input, "-l", output] [input] [output] ===================================== rts/.gitignore ===================================== @@ -20,4 +20,3 @@ /ghcautoconf.h.autoconf.in /ghcautoconf.h.autoconf /include/ghcautoconf.h -/win32/libHSghc-internal.def ===================================== rts/win32/libHSghc-internal.def.in ===================================== @@ -1,4 +1,4 @@ -LIBRARY libHSghc-internal-@ProjectVersionForLib@.0-ghc@ProjectVersion@.dll +LIBRARY @GhcInternalDll@ EXPORTS init_ghc_hs_iface View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a072d02fd97cac69f0bc6a50477d4cf… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a072d02fd97cac69f0bc6a50477d4cf… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/mangoiv/ghc-9.12-bp] 4 commits: rts: cast Sp_plusW to StgPtr to appease gcc
by Magnus (＠MangoIV) 20 May '26

20 May '26

Magnus pushed to branch wip/mangoiv/ghc-9.12-bp at Glasgow Haskell Compiler / GHC Commits: d99bb8e1 by mangoiv at 2026-05-20T14:52:56+02:00 rts: cast Sp_plusW to StgPtr to appease gcc - - - - - 8fde70d7 by mangoiv at 2026-05-20T14:52:56+02:00 rts: disable out of bounds array warning for sometimes inlined rts function - - - - - b4ef6088 by Duncan Coutts at 2026-05-20T14:56:06+02:00 Handle heap allocation failure in I/O primops The current I/O managers do not use allocateMightFail, but future ones will. To support this properly we need to be able to return to the primop with a failure. We simply use a bool return value. Currently however, we will just throw an exception rather than calling the GC because that's what all the other primops do too. For the general issue of primops invoking GC and retrying, see https://gitlab.haskell.org/ghc/ghc/-/issues/24105 (cherry picked from commit 62ae97de67f8cc59fc702e26a9e29eda1f84d461) - - - - - 3319b7da by Luite Stegeman at 2026-05-20T14:56:59+02:00 Windows: remove StgAsyncIOResult and fix crash/leaks In stg_block_async{_void}, a stack slot was reserved for an StgAsyncIOResult. This slot would be filled by the IO manager upon completion of the async call. However, if the blocked thread was interrupted by an async exception, we would end up in an invalid state: - If the blocked computation was never re-entered, the StgAsyncIOResult would never be freed. - If the blocked computation was re-entered, the thread would find an unitialized stack slot for the StgAsyncIOResult, leading to a crash reading its fields, or freeing the pointer. We fix this by removing the StgAsyncIOResult altogether and writing the result directly to the stack. Fixes #26341 (cherry picked from commit fcf092dda534cc38637d1f7920aa0dae58fe5273) - - - - - 20 changed files: - rts/HeapStackCheck.cmm - rts/IOManager.c - rts/IOManager.h - rts/Interpreter.c - rts/PrimOps.cmm - rts/RtsSymbols.c - rts/Threads.c - rts/include/rts/storage/ClosureMacros.h - rts/include/rts/storage/TSO.h - rts/include/stg/MiscClosures.h - rts/win32/AsyncMIO.c - rts/win32/AsyncMIO.h - + testsuite/tests/concurrent/should_run/T26341.hs - + testsuite/tests/concurrent/should_run/T26341.stdout - + testsuite/tests/concurrent/should_run/T26341a.hs - + testsuite/tests/concurrent/should_run/T26341a.stdout - + testsuite/tests/concurrent/should_run/T26341b.hs - + testsuite/tests/concurrent/should_run/T26341b.stdout - testsuite/tests/concurrent/should_run/all.T - utils/deriveConstants/Main.hs Changes: ===================================== rts/HeapStackCheck.cmm ===================================== @@ -706,38 +706,24 @@ stg_block_throwto (P_ tso, P_ exception) } #if defined(mingw32_HOST_OS) -INFO_TABLE_RET ( stg_block_async, RET_SMALL, W_ info_ptr, W_ ares ) +INFO_TABLE_RET ( stg_block_async, RET_SMALL, W_ info_ptr, W_ len, W_ errCode ) return () { - W_ len, errC; - - len = TO_W_(StgAsyncIOResult_len(ares)); - errC = TO_W_(StgAsyncIOResult_errCode(ares)); - ccall free(ares "ptr"); - return (len, errC); + return (len, errCode); } stg_block_async { - Sp_adj(-2); - Sp(0) = stg_block_async_info; - BLOCK_GENERIC; -} + W_ eintr; + (eintr) = ccall rts_EINTR(); -/* Used by threadDelay implementation; it would be desirable to get rid of - * this free()'ing void return continuation. - */ -INFO_TABLE_RET ( stg_block_async_void, RET_SMALL, W_ info_ptr, W_ ares ) - return () -{ - ccall free(ares "ptr"); - return (); -} - -stg_block_async_void -{ - Sp_adj(-2); - Sp(0) = stg_block_async_void_info; + // Fill the stack frame with values that indicate that the operation + // has been interrupted. The IO manager will overwrite these with the + // actual results if the async operation completes. + Sp_adj(-3); + Sp(0) = stg_block_async_info; + Sp(1) = -1; // len: -1 indicates error + Sp(2) = eintr; // errCode: interrupted BLOCK_GENERIC; } ===================================== rts/IOManager.c ===================================== @@ -561,10 +561,8 @@ void scavengeTSOIOManager(StgTSO *tso) */ /* case IO_MANAGER_WIN32_LEGACY: - * BlockedOn{Read,Write,DoProc} uses block_info.async_result - * The StgAsyncIOResult async_result is allocated on the C heap. - * It'd probably be better if it used the GC heap. If it did we'd - * scavenge it here. + * BlockedOn{Read,Write,DoProc} uses block_info.async_reqID + * which is a plain integer, so nothing to scavenge. */ default: @@ -707,7 +705,7 @@ void awaitCompletedTimeoutsOrIO(Capability *cap) } -void syncIOWaitReady(Capability *cap, +bool syncIOWaitReady(Capability *cap, StgTSO *tso, IOReadOrWrite rw, HsInt fd) @@ -724,7 +722,7 @@ void syncIOWaitReady(Capability *cap, tso->block_info.fd = fd; RELEASE_STORE(&tso->why_blocked, why_blocked); appendToIOBlockedQueue(cap, tso); - break; + return true; } #endif default: @@ -747,7 +745,7 @@ void syncIOCancel(Capability *cap, StgTSO *tso) case IO_MANAGER_WIN32_LEGACY: removeThreadFromDeQueue(cap, &cap->iomgr->blocked_queue_hd, &cap->iomgr->blocked_queue_tl, tso); - abandonWorkRequest(tso->block_info.async_result->reqID); + abandonWorkRequest(tso->block_info.async_reqID); break; #endif default: @@ -761,7 +759,7 @@ static void insertIntoSleepingQueue(Capability *cap, StgTSO *tso, LowResTime tar #endif -void syncDelay(Capability *cap, StgTSO *tso, HsInt us_delay) +bool syncDelay(Capability *cap, StgTSO *tso, HsInt us_delay) { debugTrace(DEBUG_iomanager, "thread %ld waiting for %lld us", tso->id, us_delay); ASSERT(tso->why_blocked == NotBlocked); @@ -773,7 +771,7 @@ void syncDelay(Capability *cap, StgTSO *tso, HsInt us_delay) tso->block_info.target = target; RELEASE_STORE(&tso->why_blocked, BlockedOnDelay); insertIntoSleepingQueue(cap, tso, target); - break; + return true; } #endif #if defined(IOMGR_ENABLED_WIN32_LEGACY) @@ -782,12 +780,7 @@ void syncDelay(Capability *cap, StgTSO *tso, HsInt us_delay) * would make the primops more consistent. */ { - StgAsyncIOResult *ares = stgMallocBytes(sizeof(StgAsyncIOResult), - "syncDelay"); - ares->reqID = addDelayRequest(us_delay); - ares->len = 0; - ares->errCode = 0; - tso->block_info.async_result = ares; + tso->block_info.async_reqID = addDelayRequest(us_delay); /* Having all async-blocked threads reside on the blocked_queue * simplifies matters, so set the status to OnDoProc and put the @@ -795,7 +788,7 @@ void syncDelay(Capability *cap, StgTSO *tso, HsInt us_delay) */ RELEASE_STORE(&tso->why_blocked, BlockedOnDoProc); appendToIOBlockedQueue(cap, tso); - break; + return true; } #endif default: ===================================== rts/IOManager.h ===================================== @@ -282,13 +282,20 @@ typedef enum { IORead, IOWrite } IOReadOrWrite; /* Synchronous operations: I/O and delays. As synchronous operations they * necessarily operate on threads. The thread is suspended until the operation * completes. + * + * These are called from CMM primops. The ones returing int can perform heap + * allocation, which might fail. They return 0 on success, or n > 0 on heap + * allocation failure, needing n words. The CMM primops should invoke the + * GC to free up at least n words and then retry the operation. */ -void syncIOWaitReady(Capability *cap, StgTSO *tso, IOReadOrWrite rw, HsInt fd); +/* Result is true on success, or false on allocation failure. */ +bool syncIOWaitReady(Capability *cap, StgTSO *tso, IOReadOrWrite rw, HsInt fd); void syncIOCancel(Capability *cap, StgTSO *tso); -void syncDelay(Capability *cap, StgTSO *tso, HsInt us_delay); +/* Result is true on success, or false on allocation failure. */ +bool syncDelay(Capability *cap, StgTSO *tso, HsInt us_delay); void syncDelayCancel(Capability *cap, StgTSO *tso); ===================================== rts/Interpreter.c ===================================== @@ -468,7 +468,7 @@ slow_spw(void *Sp, StgStack *cur_stack, StgWord offset_words){ } // 2b. Access the element if there is no underflow frame, it must be right // at the top of the stack. - else if(Sp_plusW(offset_words) < (StgPtr)(cur_stack->stack + cur_stack->stack_size)) { + else if((StgPtr)Sp_plusW(offset_words) < (StgPtr)(cur_stack->stack + cur_stack->stack_size)) { // Still inside the stack chunk return Sp_plusW(offset_words); } else { @@ -1832,7 +1832,7 @@ run_BCO: threadStackUnderflow(cap, cap->r.rCurrentTSO); LOAD_STACK_POINTERS; by -= sp_to_uf; - } else if (Sp_plusW(by) < (StgPtr)(stk->stack + stk->stack_size)) { + } else if ((StgPtr)Sp_plusW(by) < (StgPtr)(stk->stack + stk->stack_size)) { // we're within the first stack chunk, this chunk has // no underflow frame break; ===================================== rts/PrimOps.cmm ===================================== @@ -2561,54 +2561,55 @@ stg_whereFromzh (P_ clos, W_ buf) stg_waitReadzh ( W_ fd ) { - ccall syncIOWaitReady(MyCapability() "ptr", CurrentTSO "ptr", - /* IORead */ 0::I32, fd); - jump stg_block_noregs(); + CBool ok; /* Ok, or heap alloc failure. */ + + (ok) = ccall syncIOWaitReady(MyCapability() "ptr", CurrentTSO "ptr", + /* IORead */ 0::I32, fd); + if (ok != 0::CBool) (likely: True) { + jump stg_block_noregs(); + } else { + jump stg_raisezh(ghczminternal_GHCziInternalziIOziException_heapOverflow_closure); + } } stg_waitWritezh ( W_ fd ) { - ccall syncIOWaitReady(MyCapability() "ptr", CurrentTSO "ptr", - /* IOWrite */ 1::I32, fd); - jump stg_block_noregs(); + CBool ok; /* Ok, or heap alloc failure. */ + + (ok) = ccall syncIOWaitReady(MyCapability() "ptr", CurrentTSO "ptr", + /* IOWrite */ 1::I32, fd); + if (ok != 0::CBool) (likely: True) { + jump stg_block_noregs(); + } else { + jump stg_raisezh(ghczminternal_GHCziInternalziIOziException_heapOverflow_closure); + } } stg_delayzh ( W_ us_delay ) { - ccall syncDelay(MyCapability() "ptr", CurrentTSO "ptr", us_delay); + CBool ok; /* Ok, or heap alloc failure. */ - /* Annoyingly, we cannot be consistent with how we wait and resume the - * blocked thread. The reason is that the win32 legacy I/O manager - * allocates a StgAsyncIOResult struct on the C heap which has to be - * freed when the thread resumes. It's a bit awkward to arrange to - * allocate it on the GC heap instead, so that's how it is for now. Sigh. - */ -#if defined(mingw32_HOST_OS) - jump stg_block_async_void(); -#else - jump stg_block_noregs(); -#endif + (ok) = ccall syncDelay(MyCapability() "ptr", CurrentTSO "ptr", us_delay); + + if (ok != 0::CBool) (likely: True) { + jump stg_block_noregs(); + } else { + jump stg_raisezh(ghczminternal_GHCziInternalziIOziException_heapOverflow_closure); + } } #if defined(mingw32_HOST_OS) stg_asyncReadzh ( W_ fd, W_ is_sock, W_ len, W_ buf ) { - W_ ares; CInt reqID; #if defined(THREADED_RTS) ccall barf("asyncRead# on threaded RTS") never returns; #else - /* could probably allocate this on the heap instead */ - ("ptr" ares) = ccall stgMallocBytes(SIZEOF_StgAsyncIOResult, - "stg_asyncReadzh"); (reqID) = ccall addIORequest(fd, 0/*FALSE*/,is_sock,len,buf "ptr"); - StgAsyncIOResult_reqID(ares) = reqID; - StgAsyncIOResult_len(ares) = 0; - StgAsyncIOResult_errCode(ares) = 0; - StgTSO_block_info(CurrentTSO) = ares; + StgTSO_block_info(CurrentTSO) = reqID; ASSERT(StgTSO_why_blocked(CurrentTSO) == NotBlocked::I32); %release StgTSO_why_blocked(CurrentTSO) = BlockedOnRead::I32; @@ -2620,21 +2621,14 @@ stg_asyncReadzh ( W_ fd, W_ is_sock, W_ len, W_ buf ) stg_asyncWritezh ( W_ fd, W_ is_sock, W_ len, W_ buf ) { - W_ ares; CInt reqID; #if defined(THREADED_RTS) ccall barf("asyncWrite# on threaded RTS") never returns; #else - ("ptr" ares) = ccall stgMallocBytes(SIZEOF_StgAsyncIOResult, - "stg_asyncWritezh"); (reqID) = ccall addIORequest(fd, 1/*TRUE*/,is_sock,len,buf "ptr"); - - StgAsyncIOResult_reqID(ares) = reqID; - StgAsyncIOResult_len(ares) = 0; - StgAsyncIOResult_errCode(ares) = 0; - StgTSO_block_info(CurrentTSO) = ares; + StgTSO_block_info(CurrentTSO) = reqID; ASSERT(StgTSO_why_blocked(CurrentTSO) == NotBlocked::I32); %release StgTSO_why_blocked(CurrentTSO) = BlockedOnWrite::I32; @@ -2646,21 +2640,14 @@ stg_asyncWritezh ( W_ fd, W_ is_sock, W_ len, W_ buf ) stg_asyncDoProczh ( W_ proc, W_ param ) { - W_ ares; CInt reqID; #if defined(THREADED_RTS) ccall barf("asyncDoProc# on threaded RTS") never returns; #else - /* could probably allocate this on the heap instead */ - ("ptr" ares) = ccall stgMallocBytes(SIZEOF_StgAsyncIOResult, - "stg_asyncDoProczh"); (reqID) = ccall addDoProcRequest(proc "ptr",param "ptr"); - StgAsyncIOResult_reqID(ares) = reqID; - StgAsyncIOResult_len(ares) = 0; - StgAsyncIOResult_errCode(ares) = 0; - StgTSO_block_info(CurrentTSO) = ares; + StgTSO_block_info(CurrentTSO) = reqID; ASSERT(StgTSO_why_blocked(CurrentTSO) == NotBlocked::I32); %release StgTSO_why_blocked(CurrentTSO) = BlockedOnDoProc::I32; ===================================== rts/RtsSymbols.c ===================================== @@ -30,6 +30,7 @@ #include <shfolder.h> /* SHGetFolderPathW */ #include "IOManager.h" #include "win32/AsyncWinIO.h" +#include "win32/AsyncMIO.h" #endif #if defined(openbsd_HOST_OS) @@ -168,6 +169,7 @@ extern char **environ; SymI_HasProto(__stdio_common_vswprintf_s) \ SymI_HasProto(__stdio_common_vswprintf) \ SymI_HasProto(_errno) \ + SymI_HasProto(rts_EINTR) \ /* see Note [Symbols for MinGW's printf] */ \ SymI_HasProto(_lock_file) \ SymI_HasProto(_unlock_file) \ ===================================== rts/Threads.c ===================================== @@ -928,7 +928,7 @@ printThreadBlockage(StgTSO *tso) switch (ACQUIRE_LOAD(&tso->why_blocked)) { #if defined(mingw32_HOST_OS) case BlockedOnDoProc: - debugBelch("is blocked on proc (request: %u)", tso->block_info.async_result->reqID); + debugBelch("is blocked on proc (request: %" FMT_Word ")", tso->block_info.async_reqID); break; #endif #if !defined(THREADED_RTS) ===================================== rts/include/rts/storage/ClosureMacros.h ===================================== @@ -322,8 +322,10 @@ EXTERN_INLINE bool LOOKS_LIKE_PTR (const void* p) EXTERN_INLINE bool LOOKS_LIKE_INFO_PTR_NOT_NULL (StgWord p); EXTERN_INLINE bool LOOKS_LIKE_INFO_PTR_NOT_NULL (StgWord p) { +NO_WARN(-Warray-bounds, StgInfoTable *info = INFO_PTR_TO_STRUCT((StgInfoTable *)p); return info->type != INVALID_OBJECT && info->type < N_CLOSURE_TYPES; +) } EXTERN_INLINE bool LOOKS_LIKE_INFO_PTR (StgWord p); ===================================== rts/include/rts/storage/TSO.h ===================================== @@ -37,15 +37,6 @@ typedef StgWord64 StgThreadID; */ typedef unsigned int StgThreadReturnCode; -#if defined(mingw32_HOST_OS) -/* results from an async I/O request + its request ID. */ -typedef struct { - unsigned int reqID; - int len; - int errCode; -} StgAsyncIOResult; -#endif - /* Reason for thread being blocked. See comment above struct StgTso_. */ typedef union { StgClosure *closure; @@ -55,7 +46,7 @@ typedef union { struct MessageWakeup_ *wakeup; StgInt fd; /* StgInt instead of int, so that it's the same size as the ptrs */ #if defined(mingw32_HOST_OS) - StgAsyncIOResult *async_result; + StgWord async_reqID; #endif #if !defined(THREADED_RTS) StgWord target; ===================================== rts/include/stg/MiscClosures.h ===================================== @@ -430,8 +430,6 @@ RTS_RET(stg_block_putmvar); #if defined(mingw32_HOST_OS) RTS_FUN_DECL(stg_block_async); RTS_RET(stg_block_async); -RTS_FUN_DECL(stg_block_async_void); -RTS_RET(stg_block_async_void); #endif RTS_FUN_DECL(stg_block_stmwait); RTS_FUN_DECL(stg_block_throwto); ===================================== rts/win32/AsyncMIO.c ===================================== @@ -8,16 +8,19 @@ * For the WINIO manager see base in the GHC.Event modules. */ -#if !defined(THREADED_RTS) #include "Rts.h" +#include <errno.h> +#include "win32/AsyncMIO.h" + +#if !defined(THREADED_RTS) + #include "RtsUtils.h" #include <windows.h> #include <stdio.h> #include "Schedule.h" #include "Capability.h" #include "IOManagerInternals.h" -#include "win32/AsyncMIO.h" #include "win32/MIOManager.h" /* @@ -299,14 +302,9 @@ start: case BlockedOnRead: case BlockedOnWrite: case BlockedOnDoProc: - if (tso->block_info.async_result->reqID == rID) { - // Found the thread blocked waiting on request; - // stodgily fill - // in its result block. - tso->block_info.async_result->len = - completedTable[i].len; - tso->block_info.async_result->errCode = - completedTable[i].errCode; + if (tso->block_info.async_reqID == rID) { + HsInt len = completedTable[i].len; + HsInt errCode = completedTable[i].errCode; // Drop the matched TSO from blocked_queue if (prev) { @@ -322,11 +320,14 @@ start: // Terminates the run queue + this inner for-loop. tso->_link = END_TSO_QUEUE; tso->why_blocked = NotBlocked; - // save the StgAsyncIOResult in the - // stg_block_async_info stack frame, because - // the block_info field will be overwritten by - // pushOnRunQueue(). - tso->stackobj->sp[1] = (W_)tso->block_info.async_result; + // For stg_block_async frames (read/write/doProc), + // write len and errCode directly to the stack. + // For stg_block_noregs frames (delay), nothing + // to write. + if (tso->stackobj->sp[0] == (W_)&stg_block_async_info) { + tso->stackobj->sp[1] = (W_)len; + tso->stackobj->sp[2] = (W_)errCode; + } pushOnRunQueue(&MainCapability, tso); break; } @@ -389,3 +390,8 @@ resetAbandonRequestWait( void ) } #endif /* !defined(THREADED_RTS) */ + +HsInt rts_EINTR(void) +{ + return EINTR; +} ===================================== rts/win32/AsyncMIO.h ===================================== @@ -27,3 +27,4 @@ extern int awaitRequests(bool wait); extern void abandonRequestWait(void); extern void resetAbandonRequestWait(void); +extern HsInt rts_EINTR(void); ===================================== testsuite/tests/concurrent/should_run/T26341.hs ===================================== @@ -0,0 +1,20 @@ +{-# OPTIONS_GHC -O -fno-full-laziness #-} + +import Control.Concurrent (threadDelay, myThreadId, forkIO, killThread) +import System.IO.Unsafe (unsafePerformIO) +import Control.Exception +import GHC.Exts + +compute :: Int +compute = noinline unsafePerformIO $ do + mainThreadID <- myThreadId + _ <- forkIO $ do + threadDelay 500000 + killThread mainThreadID + threadDelay 1000000 + return 0 + +main = do + catch (print compute) (\(e :: AsyncException) -> print $ "1:" ++ show e) + catch (print compute) (\(e :: AsyncException) -> print $ "2:" ++ show e) + print "done" ===================================== testsuite/tests/concurrent/should_run/T26341.stdout ===================================== @@ -0,0 +1,3 @@ +"1:thread killed" +0 +"done" ===================================== testsuite/tests/concurrent/should_run/T26341a.hs ===================================== @@ -0,0 +1,75 @@ +-- Test that re-evaluating an AP_STACK from an interrupted async I/O call +-- does not crash. On Windows non-threaded RTS, re-entry returns EINTR +-- which readRawBufferPtr converts to IOException Interrupted. On the +-- threaded RTS (any platform), the blocking read is re-attempted and +-- succeeds because we write a byte to the pipe between evaluations. +-- +-- Before the fix for #26341, re-evaluation on Windows would crash or read +-- uninitialized memory from a freed StgAsyncIOResult. +{-# OPTIONS_GHC -O -fno-full-laziness #-} + +import Control.Concurrent (threadDelay, myThreadId, forkIO, killThread, rtsSupportsBoundThreads) +import Control.Exception +import Data.IORef +import Foreign +import Foreign.C +import GHC.Exts +import GHC.IO.Exception (IOErrorType(..), IOException(..)) +import GHC.IO.FD (FD(..), readRawBufferPtr, writeRawBufferPtr) +import System.Info (os) +import System.IO.Unsafe (unsafePerformIO) +import System.Process (createPipeFd) + +-- Store the write fd so main can feed data into the pipe between +-- evaluations. On Unix this unblocks the re-entered read; on Windows +-- stg_block_async returns EINTR regardless. +{-# NOINLINE writeFdRef #-} +writeFdRef :: IORef CInt +writeFdRef = unsafePerformIO $ newIORef (-1) + +-- | A thunk whose unsafePerformIO blocks on a pipe read. A forked +-- thread kills the main thread after 200ms, which creates an AP_STACK. +{-# NOINLINE blockedRead #-} +blockedRead :: () +blockedRead = noinline unsafePerformIO $ do + (readFd, writeFd) <- createPipeFd + writeIORef writeFdRef writeFd + buf <- mallocBytes 1 + mainTid <- myThreadId + _ <- forkIO $ do + threadDelay 200000 -- 200ms + killThread mainTid + -- readRawBufferPtr dispatches to asyncReadRawBufferPtr on Windows + -- non-threaded RTS; on Unix it uses threadWaitRead + read(). + _ <- readRawBufferPtr "blockedRead" (FD readFd 0) buf 0 1 + return () + +main :: IO () +main = do + -- First evaluation: the thunk blocks on the pipe read, gets killed. + catch (evaluate blockedRead) + (\(e :: AsyncException) -> putStrLn $ "caught: " ++ show e) + + -- Write a byte so the re-entered read can complete on Unix. + wfd <- readIORef writeFdRef + buf <- mallocBytes 1 + poke buf 0 + _ <- writeRawBufferPtr "unblock" (FD wfd 0) buf 0 1 + + -- Second evaluation: AP_STACK re-enters. + -- Non-threaded Windows: asyncRead returns (-1, EINTR) → IOException + -- Threaded / Unix: read succeeds → returns normally + let expectEINTR = os == "mingw32" && not rtsSupportsBoundThreads + result <- try (evaluate blockedRead) + case result of + Left e + | Just ioe <- fromException e + , ioe_type (ioe :: IOException) == Interrupted + -> putStrLn "re-evaluated ok" + | otherwise + -> putStrLn $ "unexpected: " ++ show e + Right () + | expectEINTR -> putStrLn "unexpected: expected EINTR" + | otherwise -> putStrLn "re-evaluated ok" + + putStrLn "done" ===================================== testsuite/tests/concurrent/should_run/T26341a.stdout ===================================== @@ -0,0 +1,3 @@ +caught: thread killed +re-evaluated ok +done ===================================== testsuite/tests/concurrent/should_run/T26341b.hs ===================================== @@ -0,0 +1,101 @@ +-- Stress test for #26341: repeatedly interrupt async-blocked threads and +-- re-enter their AP_STACKs. Before the fix, re-entering a thunk whose +-- unsafePerformIO was blocked on an async I/O call (Windows non-threaded +-- RTS) would read uninitialized memory or free a dangling pointer, +-- because stg_block_async reserved a stack slot for a heap-allocated +-- StgAsyncIOResult that became invalid after an async exception. +-- +-- This test spawns many concurrent workers, each of which: +-- 1. Creates a pipe. +-- 2. Builds a thunk that blocks on a pipe read via unsafePerformIO. +-- 3. Evaluates the thunk and kills it with an async exception. +-- 4. Re-evaluates the thunk (AP_STACK re-entry). +-- 5. Repeats many times. +-- +-- On threaded RTS / Unix the re-entered read succeeds (we write a byte +-- first). On Windows non-threaded RTS the re-entered async call returns +-- EINTR. Both paths exercise the fixed stack-frame layout. +{-# OPTIONS_GHC -O -fno-full-laziness #-} + +import Control.Concurrent +import Control.Exception +import Foreign +import Foreign.C +import GHC.Exts +import GHC.IO.Exception (IOErrorType(..), IOException(..)) +import GHC.IO.FD (FD(..), readRawBufferPtr, writeRawBufferPtr) +import System.IO (hFlush, stdout) +import System.IO.Unsafe (unsafePerformIO) +import System.Posix.Internals (c_close) +import System.Process (createPipeFd) + +iterations :: Int +iterations = 200 + +workers :: Int +workers = 4 + +-- Each worker independently performs `iterations` rounds of: +-- block on pipe read → interrupt → re-evaluate the AP_STACK. +worker :: Int -> MVar () -> IO () +worker wid done = do + buf <- mallocBytes 1 + let go 0 = return () + go n = do + (readFd, writeFd) <- createPipeFd + + -- Build a fresh thunk each iteration so we get a new AP_STACK. + let {-# NOINLINE blockedThunk #-} + blockedThunk :: () + blockedThunk = noinline unsafePerformIO $ do + tid <- myThreadId + _ <- forkIO $ do + threadDelay 1000 -- 1ms: tight window + killThread tid + _ <- readRawBufferPtr "stress" (FD readFd 0) buf 0 1 + return () + + -- First evaluation: block and get killed. + catch (evaluate blockedThunk) + (\(_ :: SomeException) -> return ()) + + -- Write a byte so the re-entered read can complete on + -- threaded RTS / Unix. + poke buf 0 + _ <- writeRawBufferPtr "unblock" (FD writeFd 0) buf 0 1 + + -- Second evaluation: AP_STACK re-entry. + result <- try (evaluate blockedThunk) + case result of + Left e + | Just ioe <- fromException e + , ioe_type (ioe :: IOException) == Interrupted + -> return () -- expected on Windows non-threaded + | otherwise + -> throwIO (userError $ + "worker " ++ show wid ++ " iteration " ++ show n ++ + ": unexpected exception: " ++ show e) + Right () -> return () -- expected on threaded / Unix + + -- Close the pipe fds. + _ <- c_close readFd + _ <- c_close writeFd + + go (n - 1) + + go iterations + putMVar done () + +main :: IO () +main = do + dones <- mapM (\wid -> do + done <- newEmptyMVar + _ <- forkIO (worker wid done) + return done + ) [1..workers] + + -- Wait for all workers to finish. + mapM_ takeMVar dones + + putStrLn "stress test passed" + hFlush stdout ===================================== testsuite/tests/concurrent/should_run/T26341b.stdout ===================================== @@ -0,0 +1 @@ +stress test passed ===================================== testsuite/tests/concurrent/should_run/all.T ===================================== @@ -298,3 +298,19 @@ test('hs_try_putmvar003', # Check forkIO exception determinism under optimization test('T13330', normal, compile_and_run, ['-O']) + +test('T26341', normal, compile_and_run, ['']) + +# Test EINTR for async I/O interrupted by an exception (#26341) +test('T26341a' + # test uses pipe operations which are not supported by the JS/wasm backends + , when(arch('wasm32') or arch('javascript'), skip) + , compile_and_run, ['-package process']) + +# Stress test: many threads repeatedly interrupt and re-enter async-blocked +# thunks (#26341). Before the fix, this would crash due to dangling +# StgAsyncIOResult pointers on the stack. +test('T26341b' + # test uses pipe operations which are not supported by the JS/wasm backends + , when(arch('wasm32') or arch('javascript'), skip) + , compile_and_run, ['-package process']) ===================================== utils/deriveConstants/Main.hs ===================================== @@ -646,12 +646,7 @@ wanteds os = concat -- Note that this conditional part only affects the C headers. -- That's important, as it means we get the same PlatformConstants -- type on all platforms. - ,if os == Just Windows - then concat [structSize C "StgAsyncIOResult" - ,structField C "StgAsyncIOResult" "reqID" - ,structField C "StgAsyncIOResult" "len" - ,structField C "StgAsyncIOResult" "errCode"] - else [] + ,[] -- struct HsIface ,structField C "HsIface" "processRemoteCompletion_closure" @@ -814,9 +809,6 @@ getWanted verbose os tmpdir gccProgram gccFlags nmProgram mobjdumpProgram "", "#define PROFILING", "#define THREADED_RTS", - -- We need to define this if we want StgAsyncIOResult - -- struct to be present after CPP - -- -- FIXME: rts/PosixSource.h should include ghcplatform.h -- which should set this. There is a mismatch host/target -- again... View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d93c45110022be45f70600b25b184d… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d93c45110022be45f70600b25b184d… You're receiving this email because of your account on gitlab.haskell.org.

1 0