- ghc-commits - Haskell.org

[Git][ghc/ghc][wip/fix-26670] Apply 1 suggestion(s) to 1 file(s)
by recursion-ninja (＠recursion-ninja) 19 Dec '25

19 Dec '25

recursion-ninja pushed to branch wip/fix-26670 at Glasgow Haskell Compiler / GHC Commits: 74ac93ee by recursion-ninja at 2025-12-18T19:01:51+00:00 Apply 1 suggestion(s) to 1 file(s) Co-authored-by: sheaf <sam.derbyshire(a)gmail.com> - - - - - 1 changed file: - compiler/GHC/Types/InlinePragma.hs Changes: ===================================== compiler/GHC/Types/InlinePragma.hs ===================================== @@ -106,9 +106,17 @@ import Data.Data import Language.Haskell.Syntax.Binds.InlinePragma import Language.Haskell.Syntax.Extension -data InlinePragmaGhcTag = InlinePragmaGhcTag - { inl_ghcrn_src :: {-# UNPACK#-} !SourceText - , inl_ghcrn_arity :: {-# UNPACK#-} !Arity +data XInlinePragmaGhc = XInlinePragmaGhc + { xinl_src :: SourceText + -- ^ See Note [Pragma source text] + , xinl_sat :: Maybe Arity + -- ^ @Just n@ <=> Inline only when applied to @n@ explicit + -- (non-type, non-dictionary) arguments. + -- + -- That is, 'xinl_sat' describes the number of *source-code* + -- arguments the thing must be applied to. We add on the + -- number of implicit, dictionary arguments when making + -- the Unfolding, and don't look at inl_sat further } deriving (Eq, Data) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/74ac93ee37f1c8e390ca84b1b296698… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/74ac93ee37f1c8e390ca84b1b296698… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 18 commits: X86 CodeGen: fix assign_eax_sse_regs
by Marge Bot (＠marge-bot) 19 Dec '25

19 Dec '25

Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: fca9cd7c by sheaf at 2025-12-18T13:18:18-05:00 X86 CodeGen: fix assign_eax_sse_regs We must set %al to the number of SSE2 registers that contain arguments (in case we are dealing with a varargs function). The logic for counting how many arguments reside in SSE2 registers was incorrect, as it used 'isFloatFormat', which incorrectly ignores vector registers. We now instead do case analysis on the register class: is_sse_reg r = case targetClassOfReg platform r of RcFloatOrVector -> True RcInteger -> False This change is necessary to prevent segfaults in T20030_test1j, because subsequent commits change the format calculations, resulting in vector formats more often. - - - - - 53150617 by sheaf at 2025-12-18T13:18:19-05:00 X86 regUsageOfInstr: fix format for IMUL When used with 8-bit operands, the IMUL instruction returns the result in the lower 16 bits of %rax (also known as %ax). This is different than for the other sizes, where an input at 16, 32 or 64 bits will result in 16, 32 or 64 bits of output in both %rax and %rdx. This doesn't affect the behaviour of the compiler, because we don't allow partial writes at sub-word sizes. The rationale is explained in Wrinkle [Don't allow scalar partial writes] in Note [Register formats in liveness analysis], in GHC.CmmToAsm.Reg.Liveness. - - - - - c7a56dd1 by sheaf at 2025-12-18T13:18:19-05:00 Liveness analysis: consider register formats This commit updates the register allocator to be a bit more careful in situations in which a single register is used at multiple different formats, e.g. when xmm1 is used both to store a Double# and a DoubleX2#. This is done by introducing the 'Regs' newtype around 'UniqSet RegWithFormat', for which the combining operations take the larger of the two formats instead of overriding the format. Operations on 'Regs' are defined in 'GHC.CmmToAsm.Reg.Regs'. There is a modest compile-time cost for the additional overhead for tracking register formats, which causes the metric increases of this commit. The subtle aspects of the implementation are outlined in Note [Register formats in liveness analysis] in GHC.CmmToAsm.Reg.Liveness. Fixes #26411 #26611 ------------------------- Metric Increase: T12707 T26425 T3294 ------------------------- - - - - - c2e83339 by sheaf at 2025-12-18T13:18:19-05:00 Register allocator: reload at same format as spill This commit ensures that if we spill a register onto the stack at a given format, we then always reload the register at this same format. This ensures we don't end up in a situation where we spill F64x2 but end up only reloading the lower F64. This first reload would make us believe the whole data is in a register, thus silently losing the upper 64 bits of the spilled register's contents. Fixes #26526 - - - - - 55ab583b by sheaf at 2025-12-18T13:18:19-05:00 Register allocation: writes redefine format As explained in Note [Allocated register formats] in GHC.CmmToAsm.Reg.Linear, we consider all writes to redefine the format of the register. This ensures that in a situation such as movsd .Ln6m(%rip),%v1 shufpd $0,%v1,%v1 we properly consider the broadcast operation to change the format of %v1 from F64 to F64x2. This completes the fix to #26411 (test in T26411b). - - - - - 951402ed by Vladislav Zavialov at 2025-12-18T13:19:05-05:00 Parser: improve mkModuleImpExp, remove checkImportSpec 1. The `mkModuleImpExp` helper now knows whether it is processing an import or export list item, and uses this information to produce a more accurate error message for `import M (T(..,x))` with PatternSynonyms disabled. The old message incorrectly referred to this case as an export form. 2. The `checkImportSpec` helper is removed in favor of more comprehensive error checking in `mkModuleImpExp`. 3. Additionaly, the invariants of `ImpExpList` and `ImpExpAllWith` have been made more explicit in the comments and assertions (calls to 'panic'). Test case: import-syntax-no-ext - - - - - 47d83d96 by Vladislav Zavialov at 2025-12-18T13:19:06-05:00 Subordinate namespace-specified wildcards (#25901) Add support for subordinate namespace-specified wildcards `X(type ..)` and `X(data ..)` to import and export lists. Examples: import M (Cls(type ..)) -- imports Cls and all its associated types import M (Cls(data ..)) -- imports Cls and all its methods module M (R(data ..), C(type ..)) where -- exports R and all its data constructors and record fields; -- exports C and all its associated types, but not its methods The scope of this change is limited to the case where the wildcard is the only subordinate import/export item, whereas the more complex forms `X(type .., f)` or `X(type .., data ..)` are unsupported and raise the newly introduced PsErrUnsupportedExplicitNamespace error. This restriction may be lifted later. Summary of the changes: 1. Refactor IEThingAll to store its extension field XIEThingAll as a record IEThingAllExt instead of a tuple. 2. Extend the AST by adding a NamespaceSpecifier field to IEThingAllExt, representing an optional namespace specifier `type` or `data` in front of a subordinate wildcard `X(..)`. 3. Extend the grammar in Parser.y with productions for `type ..` and `data ..` in subordinate import/export items. 4. Introduce `filterByNamespaceGREs` to filter [GlobalRdrElt] by a NamespaceSpecifier; use it in `filterImports` and `exports_from_avail` to account for the namespace specifier in IEThingAll. 5. Improve diagnostics by storing more information in DodgyImportsEmptyParent and DodgyExportsEmptyParent. Test cases: T25901_sub_e T25901_sub_f T25901_sub_g T25901_sub_a T25901_sub_b T25901_sub_c T25901_sub_d T25901_sub_w DodgyImports02 DodgyImports03 DodgyImports04 - - - - - eac418bb by Recursion Ninja at 2025-12-18T13:19:48-05:00 Removing the 'Data' instance for 'InstEnv'. The 'Data' instance is blocking work on Trees that Grow, and the 'Data' instance seem to have been added without a clear purpose. - - - - - e920e038 by Recursion Ninja at 2025-12-18T13:19:48-05:00 'Decouple Language.Haskell.Syntax.Decls' from 'GHC.Unit.Module.Warnings' - - - - - bd38b76c by Cheng Shao at 2025-12-18T13:20:31-05:00 testsuite: improve coverage of foundation test This patch refactors the `foundation` test a bit to improve coverage: - Instead of using a hard-coded seed, a random seed is now taken from the command line, and printed upon test failure. This improves test coverage over many future CI runs, and shall a failure occur, the seed is available in the CI log for local reproduction. - The iterations count is bumped to 1000 instead of 100, similar to the bump in `test-primops`. Runtime timeout is bumped 2x just to be safe. - Improve `newLCGGen` by using non-atomic loads/stores on a `MutableByteArray#` for storing mutable `Word64`, this test doesn't use parallelism in the first place - Fixed a few compiler warnings and removed redundant pragmas and imports Co-authored-by: Codex <codex(a)openai.com> - - - - - 3995187c by Sylvain Henry at 2025-12-18T13:21:45-05:00 Doc: document -pgmi "" (#26634) - - - - - 5729418c by Cheng Shao at 2025-12-18T13:22:29-05:00 rts: use __builtin_mul_overflow for hs_mulIntMayOflo This patch uses `__builtin_mul_overflow` to implement `hs_mulIntMayOflo`. This is a GNU C checked arithmetic builtin function supported by gcc/clang, is type-generic so works for both 32-bit/64-bit, and makes the code both more efficient and easier to read/maintain than the previous hand rolled logic. - - - - - 1ca4b49a by Cheng Shao at 2025-12-18T13:23:11-05:00 compiler/rts: fix ABI mismatch in barf() invocations This patch fixes a long-standing issue of ABI mismatch in `barf()` invocations, both in compiler-emitted code and in hand written Cmm code: - In RTS, we have `barf()` which reports a fatal internal error message and exits the program. - `barf()` is a variadic C function! When used as a callee of a foreign call with `ccall` calling convention instead of `capi`, there is an ABI mismatch between the caller and the callee! - Unfortunately, both the compiler and the Cmm sources contain many places where we call `barf()` via `ccall` convention!! Like, when you write `foreign "C" barf("foo object (%p) entered!", R1)`, it totally doesn't do what you think it'll do at all!! The second argument `R1` is not properly passed in `va_list`, and the behavior is completely undefined!! - Even more unfortunately, this issue has been sitting around long enough because the ABI mismatch is subtle enough on normie platforms like x64 and arm64. - But there are platforms like wasm32 that are stricter about ABI, and the broken `barf()` invocations already causes trouble for wasm backend: we had to use ugly hacks like `barf(errmsg, NULL)` to make `wasm-ld` happy, and even with this band-aid, compiler-generated `barf()` invocations are still broken, resulting in regressions in certain debug-related functionality, e.g. `-dtag-inference-checks` is broken on wasm32 (#22882). This patch properly fixes the issue: - We add non-variadic `barf` wrappers in the RTS that can be used as `ccall` callees - Both the compiler `emitBarf` logic and the hand-written Cmm are changed to call these wrappers - `emitBarf` now also properly annotates the foreign call as `CmmNeverReturns` to indicate it's a noreturn call to enable more efficient code generation `-dtag-inference-checks` now works on wasm. Closes #22882. Co-authored-by: Codex <codex(a)openai.com> - - - - - b3dd23b9 by Vilim Lendvaj at 2025-12-18T13:23:57-05:00 Remove outdated comment The Traversable instance for ZipList is no longer in GHC.Internal.Data.Traversable. In fact, it is right below this very comment. - - - - - 9a9c2f03 by Cheng Shao at 2025-12-18T13:24:39-05:00 compiler: remove unused OtherSection logic This patch removes the OtherSection logic in Cmm, given it's never actually used by any of our backends. - - - - - 54f74e4b by Wolfgang Jeltsch at 2025-12-18T13:57:28-05:00 Remove unused known-key and name variables for generics This removes the known-key and corresponding name variables for `K1`, `M1`, `R`, `D`, `C`, `S`, and `URec` from `GHC.Generics`, as they are apparently nowhere used in GHC’s source code. - - - - - e1e2adce by Wolfgang Jeltsch at 2025-12-18T13:57:30-05:00 Remove unused known keys and names for generics classes This removes the known-key and corresponding name variables for `Datatype`, `Constructor`, and `Selector` from `GHC.Generics`, as they are apparently nowhere used in GHC’s source code. - - - - - d02245f6 by Cheng Shao at 2025-12-18T13:57:32-05:00 wasm: fix handling of ByteArray#/MutableByteArray# arguments in JSFFI imports This patch fixes the handling of ByteArray#/MutableByteArray# arguments in JSFFI imports, see the amended note and manual for explanation. Also adds a test to witness the fix. Co-authored-by: Codex <codex(a)openai.com> - - - - - 125 changed files: - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Utils.hs - compiler/GHC/Cmm.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/LA64/Ppr.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/CmmToAsm/RV64/Ppr.hs - compiler/GHC/CmmToAsm/Reg/Graph.hs - compiler/GHC/CmmToAsm/Reg/Graph/Coalesce.hs - compiler/GHC/CmmToAsm/Reg/Graph/Spill.hs - compiler/GHC/CmmToAsm/Reg/Graph/SpillCost.hs - compiler/GHC/CmmToAsm/Reg/Linear.hs - compiler/GHC/CmmToAsm/Reg/Linear/Base.hs - compiler/GHC/CmmToAsm/Reg/Linear/JoinToTargets.hs - compiler/GHC/CmmToAsm/Reg/Liveness.hs - + compiler/GHC/CmmToAsm/Reg/Regs.hs - compiler/GHC/CmmToAsm/Reg/Target.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToAsm/X86/Instr.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs - compiler/GHC/CmmToC.hs - compiler/GHC/CmmToLlvm/Data.hs - compiler/GHC/Core/InstEnv.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/ImpExp.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/HsToCore/Foreign/Wasm.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Warnings.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Errors/Ppr.hs - compiler/GHC/Parser/Errors/Types.hs - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/StgToCmm/Bind.hs - compiler/GHC/StgToCmm/Utils.hs - compiler/GHC/Tc/Deriv.hs - compiler/GHC/Tc/Deriv/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Export.hs - compiler/GHC/Tc/Types/Origin.hs - compiler/GHC/Tc/Utils/Instantiate.hs - compiler/GHC/Types/DefaultEnv.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Reader.hs - compiler/GHC/Types/Unique/FM.hs - compiler/GHC/Types/Unique/Set.hs - compiler/GHC/Unit/Module/Warnings.hs - compiler/Language/Haskell/Syntax/Decls.hs - compiler/Language/Haskell/Syntax/Extension.hs - compiler/ghc.cabal.in - docs/users_guide/phases.rst - docs/users_guide/wasm.rst - libraries/ghc-internal/src/GHC/Internal/Functor/ZipList.hs - rts/Apply.cmm - rts/Compact.cmm - rts/ContinuationOps.cmm - rts/Exception.cmm - rts/Jumps.h - rts/PrimOps.cmm - rts/RtsMessages.c - rts/StgMiscClosures.cmm - rts/StgStartup.cmm - rts/include/Stg.h - rts/include/rts/Messages.h - rts/prim/mulIntMayOflo.c - testsuite/tests/diagnostic-codes/codes.stdout - testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr - testsuite/tests/jsffi/all.T - + testsuite/tests/jsffi/bytearrayarg.hs - + testsuite/tests/jsffi/bytearrayarg.mjs - + testsuite/tests/jsffi/bytearrayarg.stdout - testsuite/tests/numeric/should_run/all.T - testsuite/tests/numeric/should_run/foundation.hs - testsuite/tests/numeric/should_run/foundation.stdout - testsuite/tests/patsyn/should_fail/all.T - + testsuite/tests/patsyn/should_fail/import-syntax-no-ext.hs - + testsuite/tests/patsyn/should_fail/import-syntax-no-ext.stderr - testsuite/tests/perf/should_run/all.T - + testsuite/tests/rename/should_compile/T25901_sub_e.hs - + testsuite/tests/rename/should_compile/T25901_sub_f.hs - + testsuite/tests/rename/should_compile/T25901_sub_f.stderr - + testsuite/tests/rename/should_compile/T25901_sub_g.hs - + testsuite/tests/rename/should_compile/T25901_sub_g.stderr - + testsuite/tests/rename/should_compile/T25901_sub_g_helper.hs - testsuite/tests/rename/should_compile/all.T - testsuite/tests/rename/should_fail/T23570b.stderr - + testsuite/tests/rename/should_fail/T25901_sub_a.hs - + testsuite/tests/rename/should_fail/T25901_sub_a.stderr - + testsuite/tests/rename/should_fail/T25901_sub_b.hs - + testsuite/tests/rename/should_fail/T25901_sub_b.stderr - + testsuite/tests/rename/should_fail/T25901_sub_c.hs - + testsuite/tests/rename/should_fail/T25901_sub_c.stderr - + testsuite/tests/rename/should_fail/T25901_sub_c_helper.hs - + testsuite/tests/rename/should_fail/T25901_sub_d.hs - + testsuite/tests/rename/should_fail/T25901_sub_d.stderr - + testsuite/tests/rename/should_fail/T25901_sub_d_helper.hs - + testsuite/tests/rename/should_fail/T25901_sub_w.hs - + testsuite/tests/rename/should_fail/T25901_sub_w.stderr - testsuite/tests/rename/should_fail/all.T - + testsuite/tests/simd/should_run/T26411.hs - + testsuite/tests/simd/should_run/T26411.stdout - + testsuite/tests/simd/should_run/T26411b.hs - + testsuite/tests/simd/should_run/T26411b.stdout - testsuite/tests/simd/should_run/all.T - testsuite/tests/simplStg/should_compile/all.T - testsuite/tests/warnings/should_compile/DodgyExports03.stderr - testsuite/tests/warnings/should_compile/DodgyImports.stderr - + testsuite/tests/warnings/should_compile/DodgyImports02.hs - + testsuite/tests/warnings/should_compile/DodgyImports02.stderr - + testsuite/tests/warnings/should_compile/DodgyImports03.hs - + testsuite/tests/warnings/should_compile/DodgyImports03.stderr - + testsuite/tests/warnings/should_compile/DodgyImports03_helper.hs - + testsuite/tests/warnings/should_compile/DodgyImports04.hs - + testsuite/tests/warnings/should_compile/DodgyImports04.stderr - testsuite/tests/warnings/should_compile/DodgyImports_hiding.stderr - testsuite/tests/warnings/should_compile/all.T - utils/check-exact/ExactPrint.hs - utils/genapply/Main.hs - utils/haddock/haddock-api/src/Haddock/Interface/Create.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5c8309bcf3f2a3faa31522c0eb0b08… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5c8309bcf3f2a3faa31522c0eb0b08… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Pushed new branch wip/jeltsch/known-key-removals/type-representations
by Wolfgang Jeltsch (＠jeltsch) 19 Dec '25

19 Dec '25

Wolfgang Jeltsch pushed new branch wip/jeltsch/known-key-removals/type-representations at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/jeltsch/known-key-removals/ty… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/romes/25636] +5%
by Rodrigo Mesquita (＠alt-romes) 19 Dec '25

19 Dec '25

Rodrigo Mesquita pushed to branch wip/romes/25636 at Glasgow Haskell Compiler / GHC Commits: 5aaacfeb by Rodrigo Mesquita at 2025-12-18T18:42:33+00:00 +5% - - - - - 13 changed files: - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/StgToCmm/Prim.hs - compiler/GHC/StgToJS/Prim.hs - libraries/ghci/GHCi/CreateBCO.hs - libraries/ghci/GHCi/ResolvedBCO.hs - rts/PrimOps.cmm - rts/RtsSymbols.c - rts/include/stg/MiscClosures.h - utils/genprimopcode/Main.hs Changes: ===================================== compiler/GHC/Builtin/Names.hs ===================================== @@ -2099,6 +2099,9 @@ exceptionContextTyConKey = mkPreludeTyConUnique 420 unsafeUnpackJSStringUtf8ShShKey = mkPreludeMiscIdUnique 805 +staticConObjPrimTyConKey :: Unique +staticConObjPrimTyConKey = mkPreludeTyConUnique 501 + {- ************************************************************************ * * ===================================== compiler/GHC/Builtin/Types/Prim.hs ===================================== @@ -82,6 +82,7 @@ module GHC.Builtin.Types.Prim( stableNamePrimTyCon, mkStableNamePrimTy, compactPrimTyCon, compactPrimTy, bcoPrimTyCon, bcoPrimTy, + staticConObjPrimTyCon, staticConObjPrimTy, weakPrimTyCon, mkWeakPrimTy, threadIdPrimTyCon, threadIdPrimTy, stackSnapshotPrimTyCon, stackSnapshotPrimTy, @@ -309,7 +310,7 @@ charPrimTyConName, intPrimTyConName, int8PrimTyConName, int16PrimTyConName, int3 mutableArrayPrimTyConName, mutableByteArrayPrimTyConName, smallMutableArrayPrimTyConName, mutVarPrimTyConName, mVarPrimTyConName, tVarPrimTyConName, stablePtrPrimTyConName, - stableNamePrimTyConName, compactPrimTyConName, bcoPrimTyConName, + stableNamePrimTyConName, compactPrimTyConName, bcoPrimTyConName, staticConObjPrimTyConName, weakPrimTyConName, threadIdPrimTyConName, eqPrimTyConName, eqReprPrimTyConName, eqPhantPrimTyConName, stackSnapshotPrimTyConName, promptTagPrimTyConName :: Name @@ -347,6 +348,7 @@ stableNamePrimTyConName = mkPrimTc (fsLit "StableName#") stableNamePrimTyC compactPrimTyConName = mkPrimTc (fsLit "Compact#") compactPrimTyConKey compactPrimTyCon stackSnapshotPrimTyConName = mkPrimTc (fsLit "StackSnapshot#") stackSnapshotPrimTyConKey stackSnapshotPrimTyCon bcoPrimTyConName = mkPrimTc (fsLit "BCO") bcoPrimTyConKey bcoPrimTyCon +staticConObjPrimTyConName = mkPrimTc (fsLit "StaticConObj#") staticConObjPrimTyConKey staticConObjPrimTyCon weakPrimTyConName = mkPrimTc (fsLit "Weak#") weakPrimTyConKey weakPrimTyCon threadIdPrimTyConName = mkPrimTc (fsLit "ThreadId#") threadIdPrimTyConKey threadIdPrimTyCon promptTagPrimTyConName = mkPrimTc (fsLit "PromptTag#") promptTagPrimTyConKey promptTagPrimTyCon @@ -1399,6 +1401,12 @@ bcoPrimTy = mkTyConTy bcoPrimTyCon bcoPrimTyCon :: TyCon bcoPrimTyCon = pcPrimTyCon0 bcoPrimTyConName liftedRepTy +-- A static constructor object is never a thunk, unlike BCOs +staticConObjPrimTy :: Type +staticConObjPrimTy = mkTyConTy staticConObjPrimTyCon +staticConObjPrimTyCon :: TyCon +staticConObjPrimTyCon = pcPrimTyCon0 staticConObjPrimTyConName unliftedRepTy + {- ************************************************************************ * * ===================================== compiler/GHC/Builtin/primops.txt.pp ===================================== @@ -3909,6 +3909,9 @@ section "Bytecode operations" primtype BCO { Primitive bytecode type. } +primtype StaticConObj# + { Primitive static constructor allocated on the heap type. } + primop AddrToAnyOp "addrToAny#" GenPrimOp Addr# -> (# a_levpoly #) { Convert an 'Addr#' to a followable Any type. } @@ -3947,6 +3950,17 @@ primop NewBCOOp "newBCO#" GenPrimOp effect = ReadWriteEffect out_of_line = True +primop NewStaticConOp "newStaticCon#" GenPrimOp + Array# a -> Int# -> State# s -> (# State# s, StaticConObj# #) + { @'newStaticCon#' data size@ creates a new static constructor object. The + resulting object points to the given data laid out contiguously on a heap allocated location. + The first element of the @data@ array must be a pointer to the info table representing the + constructor, which will be followed by the rest of the data. The given + @size@ describes how many words should be allocated for the data. } + with + effect = ReadWriteEffect + out_of_line = True + primop UnpackClosureOp "unpackClosure#" GenPrimOp a -> (# Addr#, ByteArray#, Array# b #) { @'unpackClosure#' closure@ copies the closure and pointers in the ===================================== compiler/GHC/ByteCode/Linker.hs ===================================== @@ -50,16 +50,17 @@ import Data.Array.Unboxed import Foreign.Ptr import GHC.Exts -{- +{- | Linking interpretables into something we can run -} - linkBCO :: Interp -> PkgsLoaded -> LinkerEnv -> LinkedBreaks - -> NameEnv Int + -> NameEnv (Int, Bool) + -- ^ A mapping from names to int references to other BCOs or Static Constructors in this group. + -- The boolean identifies whether the referenced object is a BCO (when @True@) or a Static Constructor (when @False@) -> UnlinkedBCO -> IO ResolvedBCO linkBCO interp pkgs_loaded le lb bco_ix @@ -80,7 +81,7 @@ linkBCO interp pkgs_loaded le lb bco_ix (UnlinkedStaticCon conName conArgs) = do all_data <- mapM (either doBCOPtr doBCONPtr) (Right (BCONPtrItbl conName):elemsFlatBag conArgs) return ResolvedStaticCon - { resolvedStaticConIsLE = isLittleEndian + { resolvedBCOIsLE = isLittleEndian , resolvedStaticConData = addListToSS emptySS all_data } where @@ -170,13 +171,16 @@ resolvePtr -> PkgsLoaded -> LinkerEnv -> LinkedBreaks - -> NameEnv Int + -> NameEnv (Int, Bool) -> BCOPtr -> IO ResolvedBCOPtr resolvePtr interp pkgs_loaded le lb bco_ix ptr = case ptr of BCOPtrName nm - | Just ix <- lookupNameEnv bco_ix nm - -> return (ResolvedBCORef ix) -- ref to another BCO in this group + | Just (ix, b) <- lookupNameEnv bco_ix nm + -> if b then + return (ResolvedBCORef ix) -- ref to another BCO in this group + else + return (ResolvedStaticConRef ix) -- ref to another StaticCon in this group | Just (_, rhv) <- lookupNameEnv (closure_env le) nm -> return (ResolvedBCOPtr (unsafeForeignRefToRemoteRef rhv)) ===================================== compiler/GHC/Linker/Loader.hs ===================================== @@ -1025,11 +1025,13 @@ linkSomeBCOs interp pkgs_loaded le lb mods = foldr fun do_link mods [] do_link [] = return [] do_link mods = do let flat = [ bco | bcos <- mods, bco <- bcos ] - names = map unlinkedBCOName flat - bco_ix = mkNameEnv (zip names [0..]) + names = map (\case UnlinkedBCO{unlinkedBCOName} -> (unlinkedBCOName, True) + UnlinkedStaticCon{unlinkedStaticConName} -> (unlinkedStaticConName, False) + ) flat + bco_ix = mkNameEnv (zipWith (\(n,isBCO) ix -> (n,(ix, isBCO))) names [0..]) resolved <- sequence [ linkBCO interp pkgs_loaded le lb bco_ix bco | bco <- flat ] hvrefs <- createBCOs interp resolved - return (zip names hvrefs) + return (zipWith (\(n,_) hvr -> (n, hvr)) names hvrefs) -- | Useful to apply to the result of 'linkSomeBCOs' makeForeignNamedHValueRefs ===================================== compiler/GHC/StgToCmm/Prim.hs ===================================== @@ -1772,6 +1772,7 @@ emitPrimOp cfg primop = DataToTagLargeOp -> alwaysExternal MkApUpd0_Op -> alwaysExternal NewBCOOp -> alwaysExternal + NewStaticConOp -> alwaysExternal UnpackClosureOp -> alwaysExternal ListThreadsOp -> alwaysExternal ClosureSizeOp -> alwaysExternal ===================================== compiler/GHC/StgToJS/Prim.hs ===================================== @@ -1165,6 +1165,7 @@ genPrim prof bound ty op = case op of AnyToAddrOp -> unhandledPrimop op MkApUpd0_Op -> unhandledPrimop op NewBCOOp -> unhandledPrimop op + NewStaticConOp -> unhandledPrimop op UnpackClosureOp -> unhandledPrimop op ClosureSizeOp -> unhandledPrimop op GetApStackValOp -> unhandledPrimop op ===================================== libraries/ghci/GHCi/CreateBCO.hs ===================================== @@ -6,6 +6,8 @@ {-# LANGUAGE UnboxedTuples #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE CPP #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE KindSignatures #-} -- -- (c) The University of Glasgow 2002-2006 @@ -30,6 +32,7 @@ import GHC.Exts hiding ( BCO, mkApUpd0#, newBCO# ) import GHC.Internal.Base ( BCO, mkApUpd0#, newBCO# ) import GHC.IO import Control.Exception ( ErrorCall(..) ) +import Data.Kind createBCOs :: [ResolvedBCO] -> IO [HValueRef] createBCOs bcos = do @@ -40,36 +43,39 @@ createBCOs bcos = do mapM mkRemoteRef hvals createBCO :: Array Int HValue -> ResolvedBCO -> IO HValue -createBCO _ ResolvedBCO{..} | resolvedBCOIsLE /= isLittleEndian +createBCO _ obj | resolvedBCOIsLE obj /= isLittleEndian = throwIO (ErrorCall $ unlines [ "The endianness of the ResolvedBCO does not match" , "the systems endianness. Using ghc and iserv in a" , "mixed endianness setup is not supported!" ]) createBCO arr bco - = do linked_bco <- linkBCO' arr bco - -- Note [Updatable CAF BCOs] - -- ~~~~~~~~~~~~~~~~~~~~~~~~~ - -- Why do we need mkApUpd0 here? Otherwise top-level - -- interpreted CAFs don't get updated after evaluation. A - -- top-level BCO will evaluate itself and return its value - -- when entered, but it won't update itself. Wrapping the BCO - -- in an AP_UPD thunk will take care of the update for us. - -- - -- Furthermore: - -- (a) An AP thunk *must* point directly to a BCO - -- (b) A zero-arity BCO *must* be wrapped in an AP thunk - -- (c) An AP is always fully saturated, so we *can't* wrap - -- non-zero arity BCOs in an AP thunk. - -- - -- See #17424. - if (resolvedBCOArity bco > 0) - then return (HValue (unsafeCoerce linked_bco)) - else case mkApUpd0# linked_bco of { (# final_bco #) -> - return (HValue final_bco) } - - -linkBCO' :: Array Int HValue -> ResolvedBCO -> IO BCO + = do linked_thing <- linkBCO' arr bco + case linked_thing of + LeftL linked_bco -> do + -- Note [Updatable CAF BCOs] + -- ~~~~~~~~~~~~~~~~~~~~~~~~~ + -- Why do we need mkApUpd0 here? Otherwise top-level + -- interpreted CAFs don't get updated after evaluation. A + -- top-level BCO will evaluate itself and return its value + -- when entered, but it won't update itself. Wrapping the BCO + -- in an AP_UPD thunk will take care of the update for us. + -- + -- Furthermore: + -- (a) An AP thunk *must* point directly to a BCO + -- (b) A zero-arity BCO *must* be wrapped in an AP thunk + -- (c) An AP is always fully saturated, so we *can't* wrap + -- non-zero arity BCOs in an AP thunk. + -- + -- See #17424. + if (resolvedBCOArity bco > 0) + then return (HValue (unsafeCoerce linked_bco)) + else case mkApUpd0# linked_bco of { (# final_bco #) -> + return (HValue final_bco) } + RightU linked_static_con -> do + return (HValue (unsafeCoerce linked_static_con)) + +linkBCO' :: Array Int HValue -> ResolvedBCO -> IO (EitherLU BCO StaticConObj#) linkBCO' arr ResolvedBCO{..} = do let ptrs = ssElts resolvedBCOPtrs @@ -83,21 +89,59 @@ linkBCO' arr ResolvedBCO{..} = do bitmap_barr = barr (getBCOByteArray resolvedBCOBitmap) literals_barr = barr (getBCOByteArray resolvedBCOLits) - PtrsArr marr <- mkPtrsArray arr n_ptrs ptrs + PtrsArr marr <- mkPtrsArray arr n_ptrs (zip ptrs [0..]) IO $ \s -> case unsafeFreezeArray# marr s of { (# s, arr #) -> case newBCO insns_barr literals_barr arr arity# bitmap_barr of { IO io -> io s }} +linkBCO' arr ResolvedStaticCon{..} = do + + let data_size@(I# data_size#) + = sizeSS resolvedStaticConData + data_els = ssElts resolvedStaticConData + + -- First, write pointers at the ptrs locations + PtrsArr marr <- mkPtrsArray arr data_size $ + mapMaybe (\case + (Left _,_) -> Nothing + (Right p,_) -> Just p + ) (zip data_els [0..]) + -- Second, write literals at the remaining location + writeLiterals marr $ + mapMaybe (\case + (Left l,_) -> Just l + (Right _,_) -> Nothing + ) (zip data_els [0..]) + IO $ \s -> + case unsafeFreezeArray# marr' s of { (# s, arr #) -> + newStaticCon# arr data_size# s + } + where + writeLiterals :: MutableArray# RealWorld Word -> [(Word, Int)] -> IO () + writeLiterals arr = mapM_ (uncurry (writeLiteral arr)) + + writeLiteral :: MutableArray# RealWorld Word -> Word -> Int -> IO () + writeLiteral arr w i = IO $ \s -> + case writeArray# arr i w s of s' -> (# s', () #) + +-- | Either for lifted @a@ and unlifted @b@ +data EitherLU (a :: Type) (b :: UnliftedType) = LeftL a | RightU b -- we recursively link any sub-BCOs while making the ptrs array -mkPtrsArray :: Array Int HValue -> Word -> [ResolvedBCOPtr] -> IO PtrsArr +mkPtrsArray :: Array Int HValue -> Word -> [(ResolvedBCOPtr, Int{-index of array at which to write ResolvedBCOPtr-})] -> IO PtrsArr mkPtrsArray arr n_ptrs ptrs = do marr <- newPtrsArray (fromIntegral n_ptrs) let fill (ResolvedBCORef n) i = writePtrsArrayHValue i (arr ! n) marr -- must be lazy! + fill (ResolvedStaticConRef n) i = do + -- this MUST be /strict/! + -- the static con reference must be an evaluated pointer to the data con + -- info table, but (arr ! n) would construct a thunk instead if unforced. + let !hv = arr ! n + writePtrsArrayHValue i hv marr fill (ResolvedBCOPtr r) i = do hv <- localRef r writePtrsArrayHValue i hv marr @@ -109,7 +153,7 @@ mkPtrsArray arr n_ptrs ptrs = do fill (ResolvedBCOPtrBreakArray r) i = do BA mba <- localRef r writePtrsArrayMBA i mba marr - zipWithM_ fill ptrs [0..] + mapM_ fill ptrs return marr data PtrsArr = PtrsArr (MutableArray# RealWorld HValue) @@ -165,3 +209,5 @@ emptyArr = unsafeDupablePerformIO $ IO $ \s -> case unsafeFreezeByteArray# arr s of { (# s, farr #) -> (# s, EmptyArr farr #) }} + + ===================================== libraries/ghci/GHCi/ResolvedBCO.hs ===================================== @@ -50,7 +50,7 @@ data ResolvedBCO -- | A resolved static constructor -- See Note [Static constructors in Bytecode] | ResolvedStaticCon { - resolvedStaticConIsLE :: Bool, + resolvedBCOIsLE :: Bool, resolvedStaticConData :: SizedSeq (Either ResolvedBCOPtr Word) -- ^ All the data to be laid contiguously for this static datacon. -- The first entry is the info table pointer for the datacon it represents. @@ -97,7 +97,7 @@ instance Binary ResolvedBCO where put resolvedBCOPtrs put ResolvedStaticCon{..} = do putWord8 1 - put resolvedStaticConIsLE + put resolvedBCOIsLE put resolvedStaticConData get = do t <- getWord8 @@ -123,6 +123,8 @@ data ResolvedBCOPtr -- ^ a nested BCO | ResolvedBCOPtrBreakArray {-# UNPACK #-} !(RemoteRef BreakArray) -- ^ Resolves to the MutableArray# inside the BreakArray + | ResolvedStaticConRef {-# UNPACK #-} !Int + -- ^ reference to the Nth static constructor in the current set deriving (Generic, Show) instance Binary ResolvedBCOPtr ===================================== rts/PrimOps.cmm ===================================== @@ -2181,6 +2181,21 @@ for: return (bco); } +stg_newStaticConzh ( P_ data, W_ size ) +{ + W_ staticConObj, itbl, bytes; + + bytes = WDS(size); + + ALLOC_PRIM (bytes); + + staticConObj = Hp - bytes; + // No memory barrier necessary as this is a new allocation. + SET_HDR(staticConObj, stg_BCO_info, CCS_MAIN); + + TODOOOOOOO +} + stg_mkApUpd0zh ( P_ bco ) { W_ ap; ===================================== rts/RtsSymbols.c ===================================== @@ -634,6 +634,7 @@ extern char **environ; SymI_HasDataProto(stg_casSmallArrayzh) \ SymI_HasDataProto(stg_copyArray_barrier) \ SymI_HasDataProto(stg_newBCOzh) \ + SymI_HasDataProto(stg_newStaticConzh) \ SymI_HasDataProto(stg_newByteArrayzh) \ SymI_HasDataProto(stg_casIntArrayzh) \ SymI_HasDataProto(stg_casInt8Arrayzh) \ ===================================== rts/include/stg/MiscClosures.h ===================================== @@ -583,6 +583,7 @@ RTS_FUN_DECL(stg_deRefWeakzh); RTS_FUN_DECL(stg_runRWzh); RTS_FUN_DECL(stg_newBCOzh); +RTS_FUN_DECL(stg_newStaticConzh); RTS_FUN_DECL(stg_mkApUpd0zh); RTS_FUN_DECL(stg_retryzh); ===================================== utils/genprimopcode/Main.hs ===================================== @@ -944,6 +944,7 @@ ppType (TyApp (TyCon "RealWorld") []) = "realWorldTy" ppType (TyApp (TyCon "ThreadId#") []) = "threadIdPrimTy" ppType (TyApp (TyCon "ForeignObj#") []) = "foreignObjPrimTy" ppType (TyApp (TyCon "BCO") []) = "bcoPrimTy" +ppType (TyApp (TyCon "StaticConObj#") []) = "staticConObjPrimTy" ppType (TyApp (TyCon "Compact#") []) = "compactPrimTy" ppType (TyApp (TyCon "StackSnapshot#") []) = "stackSnapshotPrimTy" ppType (TyApp (TyCon "()") []) = "unitTy" -- unitTy is GHC.Builtin.Types's name for () View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5aaacfeb18855e50cafe15b6667ddf0… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5aaacfeb18855e50cafe15b6667ddf0… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Pushed new branch wip/cleanup-ci-duplicate-keys
by Cheng Shao (＠TerrorJack) 19 Dec '25

19 Dec '25

Cheng Shao pushed new branch wip/cleanup-ci-duplicate-keys at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/cleanup-ci-duplicate-keys You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] compiler: remove unused OtherSection logic
by Marge Bot (＠marge-bot) 19 Dec '25

19 Dec '25

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 9a9c2f03 by Cheng Shao at 2025-12-18T13:24:39-05:00 compiler: remove unused OtherSection logic This patch removes the OtherSection logic in Cmm, given it's never actually used by any of our backends. - - - - - 9 changed files: - compiler/GHC/Cmm.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/LA64/Ppr.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/CmmToAsm/RV64/Ppr.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs - compiler/GHC/CmmToLlvm/Data.hs Changes: ===================================== compiler/GHC/Cmm.hs ===================================== @@ -269,7 +269,6 @@ data SectionType | FiniArray -- .fini_array on ELF, .dtor on Windows | CString | IPE - | OtherSection String deriving (Show) data SectionProtection @@ -290,7 +289,6 @@ sectionProtection (Section t _) = case t of Data -> ReadWriteSection UninitialisedData -> ReadWriteSection IPE -> ReadWriteSection - (OtherSection _) -> ReadWriteSection {- Note [Relocatable Read-Only Data] @@ -550,4 +548,3 @@ pprSectionType s = doubleQuotes $ case s of FiniArray -> text "finiarray" CString -> text "cstring" IPE -> text "ipe" - OtherSection s' -> text s' ===================================== compiler/GHC/Cmm/Parser.y ===================================== @@ -978,7 +978,7 @@ section "data" = Data section "rodata" = ReadOnlyData section "relrodata" = RelocatableReadOnlyData section "bss" = UninitialisedData -section s = OtherSection s +section s = panic ("CmmParse: unknown section type: " ++ s) mkString :: String -> CmmStatic mkString s = CmmString (BS8.pack s) ===================================== compiler/GHC/CmmToAsm/AArch64/Ppr.hs ===================================== @@ -91,8 +91,6 @@ pprAlignForSection _platform _seg -- .balign 8 -- pprSectionAlign :: IsDoc doc => NCGConfig -> Section -> doc -pprSectionAlign _config (Section (OtherSection _) _) = - panic "AArch64.Ppr.pprSectionAlign: unknown section" pprSectionAlign config sec@(Section seg _) = line (pprSectionHeader config sec) $$ pprAlignForSection (ncgPlatform config) seg ===================================== compiler/GHC/CmmToAsm/LA64/Ppr.hs ===================================== @@ -108,8 +108,6 @@ pprAlignForSection _seg = pprAlign . mkAlignment $ 8 -- .balign 8 -- pprSectionAlign :: IsDoc doc => NCGConfig -> Section -> doc -pprSectionAlign _config (Section (OtherSection _) _) = - panic "LA64.Ppr.pprSectionAlign: unknown section" pprSectionAlign config sec@(Section seg _) = line (pprSectionHeader config sec) $$ pprAlignForSection seg ===================================== compiler/GHC/CmmToAsm/PPC/Ppr.hs ===================================== @@ -302,7 +302,6 @@ pprAlignForSection platform seg = line $ CString | ppc64 -> text ".align 3" | otherwise -> text ".align 2" - OtherSection _ -> panic "PprMach.pprSectionAlign: unknown section" pprDataItem :: IsDoc doc => Platform -> CmmLit -> doc pprDataItem platform lit ===================================== compiler/GHC/CmmToAsm/Ppr.hs ===================================== @@ -240,8 +240,6 @@ pprGNUSectionHeader config t suffix = | OSMinGW32 <- platformOS platform -> text ".rdata" | otherwise -> text ".ipe" - OtherSection _ -> - panic "PprBase.pprGNUSectionHeader: unknown section type" flags = case t of Text | OSMinGW32 <- platformOS platform, splitSections @@ -286,6 +284,5 @@ pprDarwinSectionHeader t = case t of FiniArray -> panic "pprDarwinSectionHeader: fini not supported" CString -> text ".section\t__TEXT,__cstring,cstring_literals" IPE -> text ".const" - OtherSection _ -> panic "pprDarwinSectionHeader: unknown section type" {-# SPECIALIZE pprDarwinSectionHeader :: SectionType -> SDoc #-} {-# SPECIALIZE pprDarwinSectionHeader :: SectionType -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable ===================================== compiler/GHC/CmmToAsm/RV64/Ppr.hs ===================================== @@ -99,8 +99,6 @@ pprAlignForSection _seg = pprAlign . mkAlignment $ 8 -- .section .text -- .balign 8 pprSectionAlign :: (IsDoc doc) => NCGConfig -> Section -> doc -pprSectionAlign _config (Section (OtherSection _) _) = - panic "RV64.Ppr.pprSectionAlign: unknown section" pprSectionAlign config sec@(Section seg _) = line (pprSectionHeader config sec) $$ pprAlignForSection seg ===================================== compiler/GHC/CmmToAsm/X86/Ppr.hs ===================================== @@ -526,8 +526,6 @@ pprAddr platform (AddrBaseIndex base index displacement) -- | Print section header and appropriate alignment for that section. pprSectionAlign :: IsDoc doc => NCGConfig -> Section -> doc -pprSectionAlign _config (Section (OtherSection _) _) = - panic "X86.Ppr.pprSectionAlign: unknown section" pprSectionAlign config sec@(Section seg _) = line (pprSectionHeader config sec) $$ pprAlignForSection (ncgPlatform config) seg ===================================== compiler/GHC/CmmToLlvm/Data.hs ===================================== @@ -148,7 +148,6 @@ llvmSectionType p t = case t of IPE -> fsLit ".ipe" InitArray -> panic "llvmSectionType: InitArray" FiniArray -> panic "llvmSectionType: FiniArray" - OtherSection _ -> panic "llvmSectionType: unknown section type" -- | Format a Cmm Section into a LLVM section name llvmSection :: Section -> LlvmM LMSection View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9a9c2f031abba5efdad19efc54e0e57… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9a9c2f031abba5efdad19efc54e0e57… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] Remove outdated comment
by Marge Bot (＠marge-bot) 19 Dec '25

19 Dec '25

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: b3dd23b9 by Vilim Lendvaj at 2025-12-18T13:23:57-05:00 Remove outdated comment The Traversable instance for ZipList is no longer in GHC.Internal.Data.Traversable. In fact, it is right below this very comment. - - - - - 1 changed file: - libraries/ghc-internal/src/GHC/Internal/Functor/ZipList.hs Changes: ===================================== libraries/ghc-internal/src/GHC/Internal/Functor/ZipList.hs ===================================== @@ -46,7 +46,6 @@ newtype ZipList a = ZipList { getZipList :: [a] } , Generic -- ^ @since base-4.7.0.0 , Generic1 -- ^ @since base-4.7.0.0 ) --- See GHC.Internal.Data.Traversable for Traversable instance due to import loops -- | @since base-4.9.0.0 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b3dd23b9d6c40160f9b15df8ae80825… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b3dd23b9d6c40160f9b15df8ae80825… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] compiler/rts: fix ABI mismatch in barf() invocations
by Marge Bot (＠marge-bot) 19 Dec '25

19 Dec '25

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 1ca4b49a by Cheng Shao at 2025-12-18T13:23:11-05:00 compiler/rts: fix ABI mismatch in barf() invocations This patch fixes a long-standing issue of ABI mismatch in `barf()` invocations, both in compiler-emitted code and in hand written Cmm code: - In RTS, we have `barf()` which reports a fatal internal error message and exits the program. - `barf()` is a variadic C function! When used as a callee of a foreign call with `ccall` calling convention instead of `capi`, there is an ABI mismatch between the caller and the callee! - Unfortunately, both the compiler and the Cmm sources contain many places where we call `barf()` via `ccall` convention!! Like, when you write `foreign "C" barf("foo object (%p) entered!", R1)`, it totally doesn't do what you think it'll do at all!! The second argument `R1` is not properly passed in `va_list`, and the behavior is completely undefined!! - Even more unfortunately, this issue has been sitting around long enough because the ABI mismatch is subtle enough on normie platforms like x64 and arm64. - But there are platforms like wasm32 that are stricter about ABI, and the broken `barf()` invocations already causes trouble for wasm backend: we had to use ugly hacks like `barf(errmsg, NULL)` to make `wasm-ld` happy, and even with this band-aid, compiler-generated `barf()` invocations are still broken, resulting in regressions in certain debug-related functionality, e.g. `-dtag-inference-checks` is broken on wasm32 (#22882). This patch properly fixes the issue: - We add non-variadic `barf` wrappers in the RTS that can be used as `ccall` callees - Both the compiler `emitBarf` logic and the hand-written Cmm are changed to call these wrappers - `emitBarf` now also properly annotates the foreign call as `CmmNeverReturns` to indicate it's a noreturn call to enable more efficient code generation `-dtag-inference-checks` now works on wasm. Closes #22882. Co-authored-by: Codex <codex(a)openai.com> - - - - - 14 changed files: - compiler/GHC/StgToCmm/Bind.hs - compiler/GHC/StgToCmm/Utils.hs - rts/Apply.cmm - rts/Compact.cmm - rts/ContinuationOps.cmm - rts/Exception.cmm - rts/Jumps.h - rts/PrimOps.cmm - rts/RtsMessages.c - rts/StgMiscClosures.cmm - rts/StgStartup.cmm - rts/include/rts/Messages.h - testsuite/tests/simplStg/should_compile/all.T - utils/genapply/Main.hs Changes: ===================================== compiler/GHC/StgToCmm/Bind.hs ===================================== @@ -866,7 +866,7 @@ link_caf node = do ; let profile = stgToCmmProfile cfg ; let platform = profilePlatform profile ; bh <- newTemp (bWord platform) - ; emitRtsCallGen [(bh,AddrHint)] newCAF_lbl + ; emitRtsCallGen [(bh,AddrHint)] newCAF_lbl CmmMayReturn [ (baseExpr platform, AddrHint), (CmmReg (CmmLocal node), AddrHint) ] False ===================================== compiler/GHC/StgToCmm/Utils.hs ===================================== @@ -186,23 +186,27 @@ tagToClosure platform tycon tag emitBarf :: String -> FCode () emitBarf msg = do strLbl <- newStringCLit msg - emitRtsCall rtsUnitId (fsLit "barf") [(CmmLit strLbl,AddrHint)] False + emitRtsCallGen [] (mkCmmCodeLabel rtsUnitId (fsLit "sbarf")) + CmmNeverReturns + [(CmmLit strLbl, AddrHint)] False emitRtsCall :: UnitId -> FastString -> [(CmmExpr,ForeignHint)] -> Bool -> FCode () -emitRtsCall pkg fun = emitRtsCallGen [] (mkCmmCodeLabel pkg fun) +emitRtsCall pkg fun = emitRtsCallGen [] (mkCmmCodeLabel pkg fun) CmmMayReturn emitRtsCallWithResult :: LocalReg -> ForeignHint -> UnitId -> FastString -> [(CmmExpr,ForeignHint)] -> Bool -> FCode () -emitRtsCallWithResult res hint pkg = emitRtsCallGen [(res,hint)] . mkCmmCodeLabel pkg +emitRtsCallWithResult res hint pkg = + \fun -> emitRtsCallGen [(res,hint)] (mkCmmCodeLabel pkg fun) CmmMayReturn -- Make a call to an RTS C procedure emitRtsCallGen :: [(LocalReg,ForeignHint)] -> CLabel + -> CmmReturnInfo -> [(CmmExpr,ForeignHint)] -> Bool -- True <=> CmmSafe call -> FCode () -emitRtsCallGen res lbl args safe +emitRtsCallGen res lbl ret_info args safe = do { platform <- getPlatform ; updfr_off <- getUpdFrameOff ; let (caller_save, caller_load) = callerSaveVolatileRegs platform @@ -214,7 +218,7 @@ emitRtsCallGen res lbl args safe if safe then emit =<< mkCmmCall fun_expr res' args' updfr_off else do - let conv = ForeignConvention CCallConv arg_hints res_hints CmmMayReturn + let conv = ForeignConvention CCallConv arg_hints res_hints ret_info emit $ mkUnsafeCall (ForeignTarget fun_expr conv) res' args' (args', arg_hints) = unzip args (res', res_hints) = unzip res ===================================== rts/Apply.cmm ===================================== @@ -250,7 +250,7 @@ again: -------------------------------------------------------------------------- */ INFO_TABLE(stg_PAP,/*special layout*/0,0,PAP,"PAP","PAP") -{ ccall barf("PAP object (%p) entered!", R1) never returns; } +{ ccall pbarf("PAP object (%p) entered!", R1 "ptr") never returns; } stg_PAP_apply /* no args => explicit stack */ { ===================================== rts/Compact.cmm ===================================== @@ -282,7 +282,7 @@ eval: goto constructor; }} - ccall barf("stg_compactWorkerzh", NULL); + ccall sbarf("stg_compactWorkerzh") never returns; } // ===================================== rts/ContinuationOps.cmm ===================================== @@ -36,7 +36,7 @@ import CLOSURE ghc_hs_iface; -------------------------------------------------------------------------- */ INFO_TABLE(stg_PROMPT_TAG,0,0,PRIM,"PROMPT_TAG","PROMPT_TAG") -{ foreign "C" barf("PROMPT_TAG object (%p) entered!", R1) never returns; } +{ ccall pbarf("PROMPT_TAG object (%p) entered!", R1 "ptr") never returns; } stg_newPromptTagzh() { ===================================== rts/Exception.cmm ===================================== @@ -666,11 +666,11 @@ stg_raiseOverflowzh () */ stg_paniczh (W_ str) { - ccall barf(str, NULL) never returns; + ccall sbarf(str "ptr") never returns; } // See Note [Compiler error functions] in GHC.Prim.Panic stg_absentErrorzh (W_ str) { - ccall barf("Oops! Entered absent arg %s", str) never returns; + ccall ssbarf("Oops! Entered absent arg %s", str "ptr") never returns; } ===================================== rts/Jumps.h ===================================== @@ -70,7 +70,7 @@ INFO_TABLE_RET (MK_FUN_NM(stg_stack_underflow_frame), UNDERFLOW_FRAME, jump %ENTRY_CODE(Sp(ret_off)) ALL_ARG_REGS; #else - ccall barf("stg_stack_underflow_frame: unsupported register", NULL) never returns; + ccall sbarf("stg_stack_underflow_frame: unsupported register") never returns; #endif } @@ -96,6 +96,6 @@ INFO_TABLE_RET (MK_FUN_NM(stg_restore_cccs), RET_SMALL, W_ info_ptr, W_ cccs) jump %ENTRY_CODE(Sp(0)) ALL_ARG_REGS; #else - ccall barf("stg_restore_cccs: unsupported register", NULL) never returns; + ccall sbarf("stg_restore_cccs: unsupported register") never returns; #endif } ===================================== rts/PrimOps.cmm ===================================== @@ -2332,7 +2332,7 @@ stg_asyncReadzh ( W_ fd, W_ is_sock, W_ len, W_ buf ) CInt reqID; #if defined(THREADED_RTS) - ccall barf("asyncRead# on threaded RTS") never returns; + ccall sbarf("asyncRead# on threaded RTS") never returns; #else /* could probably allocate this on the heap instead */ @@ -2358,7 +2358,7 @@ stg_asyncWritezh ( W_ fd, W_ is_sock, W_ len, W_ buf ) CInt reqID; #if defined(THREADED_RTS) - ccall barf("asyncWrite# on threaded RTS") never returns; + ccall sbarf("asyncWrite# on threaded RTS") never returns; #else ("ptr" ares) = ccall stgMallocBytes(SIZEOF_StgAsyncIOResult, @@ -2384,7 +2384,7 @@ stg_asyncDoProczh ( W_ proc, W_ param ) CInt reqID; #if defined(THREADED_RTS) - ccall barf("asyncDoProc# on threaded RTS") never returns; + ccall sbarf("asyncDoProc# on threaded RTS") never returns; #else /* could probably allocate this on the heap instead */ ===================================== rts/RtsMessages.c ===================================== @@ -58,6 +58,24 @@ vbarf(const char*s, va_list ap) stg_exit(EXIT_INTERNAL_ERROR); // just in case fatalInternalErrorFn() returns } +void +sbarf(const char*s) +{ + barf("%s", s); +} + +void +pbarf(const char*fmt, void *p) +{ + barf(fmt, p); +} + +void +ssbarf(const char *fmt, const char *s) +{ + barf(fmt, s); +} + void _assertFail(const char*filename, unsigned int linenum) { ===================================== rts/StgMiscClosures.cmm ===================================== @@ -473,7 +473,7 @@ INFO_TABLE_RET( stg_dead_thread, RET_SMALL, W_ info_ptr, PROF_HDR_FIELDS(W_,p1,p2) P_ result ) -{ foreign "C" barf("stg_dead_thread entered!", NULL) never returns; } +{ ccall sbarf("stg_dead_thread entered!") never returns; } /* ---------------------------------------------------------------------------- Entry code for a BCO @@ -631,11 +631,11 @@ INFO_TABLE(__stg_EAGER_BLACKHOLE,1,0,BLACKHOLE,"BLACKHOLE","BLACKHOLE") } INFO_TABLE(stg_BLOCKING_QUEUE_CLEAN,4,0,BLOCKING_QUEUE,"BLOCKING_QUEUE","BLOCKING_QUEUE") -{ foreign "C" barf("BLOCKING_QUEUE_CLEAN object (%p) entered!", R1) never returns; } +{ ccall pbarf("BLOCKING_QUEUE_CLEAN object (%p) entered!", R1 "ptr") never returns; } INFO_TABLE(stg_BLOCKING_QUEUE_DIRTY,4,0,BLOCKING_QUEUE,"BLOCKING_QUEUE","BLOCKING_QUEUE") -{ foreign "C" barf("BLOCKING_QUEUE_DIRTY object (%p) entered!", R1) never returns; } +{ ccall pbarf("BLOCKING_QUEUE_DIRTY object (%p) entered!", R1 "ptr") never returns; } /* ---------------------------------------------------------------------------- @@ -673,7 +673,7 @@ loop: ACQUIRE_FENCE_ON(node + OFFSET_StgHeader_info); jump %ENTRY_CODE(info) (node); #else - ccall barf("WHITEHOLE object (%p) entered!", R1) never returns; + ccall pbarf("WHITEHOLE object (%p) entered!", R1 "ptr") never returns; #endif } @@ -684,10 +684,10 @@ loop: ------------------------------------------------------------------------- */ INFO_TABLE(stg_TSO, 0,0,TSO, "TSO", "TSO") -{ foreign "C" barf("TSO object (%p) entered!", R1) never returns; } +{ ccall pbarf("TSO object (%p) entered!", R1 "ptr") never returns; } INFO_TABLE(stg_STACK, 0,0, STACK, "STACK", "STACK") -{ foreign "C" barf("STACK object (%p) entered!", R1) never returns; } +{ ccall pbarf("STACK object (%p) entered!", R1 "ptr") never returns; } /* ---------------------------------------------------------------------------- Weak pointers @@ -698,7 +698,7 @@ INFO_TABLE(stg_STACK, 0,0, STACK, "STACK", "STACK") ------------------------------------------------------------------------- */ INFO_TABLE(stg_WEAK,1,4,WEAK,"WEAK","WEAK") -{ foreign "C" barf("WEAK object (%p) entered!", R1) never returns; } +{ ccall pbarf("WEAK object (%p) entered!", R1 "ptr") never returns; } /* * It's important when turning an existing WEAK into a DEAD_WEAK @@ -707,7 +707,7 @@ INFO_TABLE(stg_WEAK,1,4,WEAK,"WEAK","WEAK") * DEAD_WEAK 5 non-pointer fields. */ INFO_TABLE_CONSTR(stg_DEAD_WEAK,0,5,0,CONSTR,"DEAD_WEAK","DEAD_WEAK") -{ foreign "C" barf("DEAD_WEAK object (%p) entered!", R1) never returns; } +{ ccall pbarf("DEAD_WEAK object (%p) entered!", R1 "ptr") never returns; } /* ---------------------------------------------------------------------------- C finalizer lists @@ -716,7 +716,7 @@ INFO_TABLE_CONSTR(stg_DEAD_WEAK,0,5,0,CONSTR,"DEAD_WEAK","DEAD_WEAK") ------------------------------------------------------------------------- */ INFO_TABLE_CONSTR(stg_C_FINALIZER_LIST,1,4,0,CONSTR,"C_FINALIZER_LIST","C_FINALIZER_LIST") -{ foreign "C" barf("C_FINALIZER_LIST object (%p) entered!", R1) never returns; } +{ ccall pbarf("C_FINALIZER_LIST object (%p) entered!", R1 "ptr") never returns; } /* ---------------------------------------------------------------------------- NO_FINALIZER @@ -726,7 +726,7 @@ INFO_TABLE_CONSTR(stg_C_FINALIZER_LIST,1,4,0,CONSTR,"C_FINALIZER_LIST","C_FINALI ------------------------------------------------------------------------- */ INFO_TABLE_CONSTR(stg_NO_FINALIZER,0,0,0,CONSTR_NOCAF,"NO_FINALIZER","NO_FINALIZER") -{ foreign "C" barf("NO_FINALIZER object (%p) entered!", R1) never returns; } +{ ccall pbarf("NO_FINALIZER object (%p) entered!", R1 "ptr") never returns; } CLOSURE(stg_NO_FINALIZER_closure,stg_NO_FINALIZER); @@ -735,7 +735,7 @@ CLOSURE(stg_NO_FINALIZER_closure,stg_NO_FINALIZER); ------------------------------------------------------------------------- */ INFO_TABLE(stg_STABLE_NAME,0,1,PRIM,"STABLE_NAME","STABLE_NAME") -{ foreign "C" barf("STABLE_NAME object (%p) entered!", R1) never returns; } +{ ccall pbarf("STABLE_NAME object (%p) entered!", R1 "ptr") never returns; } /* ---------------------------------------------------------------------------- MVars @@ -745,38 +745,38 @@ INFO_TABLE(stg_STABLE_NAME,0,1,PRIM,"STABLE_NAME","STABLE_NAME") ------------------------------------------------------------------------- */ INFO_TABLE(stg_MVAR_CLEAN,3,0,MVAR_CLEAN,"MVAR","MVAR") -{ foreign "C" barf("MVAR object (%p) entered!", R1) never returns; } +{ ccall pbarf("MVAR object (%p) entered!", R1 "ptr") never returns; } INFO_TABLE(stg_MVAR_DIRTY,3,0,MVAR_DIRTY,"MVAR","MVAR") -{ foreign "C" barf("MVAR object (%p) entered!", R1) never returns; } +{ ccall pbarf("MVAR object (%p) entered!", R1 "ptr") never returns; } /* ----------------------------------------------------------------------------- STM -------------------------------------------------------------------------- */ INFO_TABLE(stg_TVAR_CLEAN, 2, 1, TVAR, "TVAR", "TVAR") -{ foreign "C" barf("TVAR_CLEAN object (%p) entered!", R1) never returns; } +{ ccall pbarf("TVAR_CLEAN object (%p) entered!", R1 "ptr") never returns; } INFO_TABLE(stg_TVAR_DIRTY, 2, 1, TVAR, "TVAR", "TVAR") -{ foreign "C" barf("TVAR_DIRTY object (%p) entered!", R1) never returns; } +{ ccall pbarf("TVAR_DIRTY object (%p) entered!", R1 "ptr") never returns; } INFO_TABLE(stg_TVAR_WATCH_QUEUE, 3, 0, MUT_PRIM, "TVAR_WATCH_QUEUE", "TVAR_WATCH_QUEUE") -{ foreign "C" barf("TVAR_WATCH_QUEUE object (%p) entered!", R1) never returns; } +{ ccall pbarf("TVAR_WATCH_QUEUE object (%p) entered!", R1 "ptr") never returns; } INFO_TABLE(stg_TREC_CHUNK, 0, 0, TREC_CHUNK, "TREC_CHUNK", "TREC_CHUNK") -{ foreign "C" barf("TREC_CHUNK object (%p) entered!", R1) never returns; } +{ ccall pbarf("TREC_CHUNK object (%p) entered!", R1 "ptr") never returns; } INFO_TABLE(stg_TREC_HEADER, 2, 1, MUT_PRIM, "TREC_HEADER", "TREC_HEADER") -{ foreign "C" barf("TREC_HEADER object (%p) entered!", R1) never returns; } +{ ccall pbarf("TREC_HEADER object (%p) entered!", R1 "ptr") never returns; } INFO_TABLE_CONSTR(stg_END_STM_WATCH_QUEUE,0,0,0,CONSTR_NOCAF,"END_STM_WATCH_QUEUE","END_STM_WATCH_QUEUE") -{ foreign "C" barf("END_STM_WATCH_QUEUE object (%p) entered!", R1) never returns; } +{ ccall pbarf("END_STM_WATCH_QUEUE object (%p) entered!", R1 "ptr") never returns; } INFO_TABLE_CONSTR(stg_END_STM_CHUNK_LIST,0,0,0,CONSTR_NOCAF,"END_STM_CHUNK_LIST","END_STM_CHUNK_LIST") -{ foreign "C" barf("END_STM_CHUNK_LIST object (%p) entered!", R1) never returns; } +{ ccall pbarf("END_STM_CHUNK_LIST object (%p) entered!", R1 "ptr") never returns; } INFO_TABLE_CONSTR(stg_NO_TREC,0,0,0,CONSTR_NOCAF,"NO_TREC","NO_TREC") -{ foreign "C" barf("NO_TREC object (%p) entered!", R1) never returns; } +{ ccall pbarf("NO_TREC object (%p) entered!", R1 "ptr") never returns; } CLOSURE(stg_END_STM_WATCH_QUEUE_closure,stg_END_STM_WATCH_QUEUE); @@ -791,52 +791,52 @@ CLOSURE(stg_NO_TREC_closure,stg_NO_TREC); ------------------------------------------------------------------------- */ INFO_TABLE_CONSTR(stg_SRT_1, 1, 0, 0, CONSTR_1_0, "SRT_1", "SRT_1") -{ foreign "C" barf("SRT_1 object (%p) entered!", R1) never returns; } +{ ccall pbarf("SRT_1 object (%p) entered!", R1 "ptr") never returns; } INFO_TABLE_CONSTR(stg_SRT_2, 2, 0, 0, CONSTR_2_0, "SRT_2", "SRT_2") -{ foreign "C" barf("SRT_2 object (%p) entered!", R1) never returns; } +{ ccall pbarf("SRT_2 object (%p) entered!", R1 "ptr") never returns; } INFO_TABLE_CONSTR(stg_SRT_3, 3, 0, 0, CONSTR, "SRT_3", "SRT_3") -{ foreign "C" barf("SRT_3 object (%p) entered!", R1) never returns; } +{ ccall pbarf("SRT_3 object (%p) entered!", R1 "ptr") never returns; } INFO_TABLE_CONSTR(stg_SRT_4, 4, 0, 0, CONSTR, "SRT_4", "SRT_4") -{ foreign "C" barf("SRT_4 object (%p) entered!", R1) never returns; } +{ ccall pbarf("SRT_4 object (%p) entered!", R1 "ptr") never returns; } INFO_TABLE_CONSTR(stg_SRT_5, 5, 0, 0, CONSTR, "SRT_5", "SRT_5") -{ foreign "C" barf("SRT_5 object (%p) entered!", R1) never returns; } +{ ccall pbarf("SRT_5 object (%p) entered!", R1 "ptr") never returns; } INFO_TABLE_CONSTR(stg_SRT_6, 6, 0, 0, CONSTR, "SRT_6", "SRT_6") -{ foreign "C" barf("SRT_6 object (%p) entered!", R1) never returns; } +{ ccall pbarf("SRT_6 object (%p) entered!", R1 "ptr") never returns; } INFO_TABLE_CONSTR(stg_SRT_7, 7, 0, 0, CONSTR, "SRT_7", "SRT_7") -{ foreign "C" barf("SRT_7 object (%p) entered!", R1) never returns; } +{ ccall pbarf("SRT_7 object (%p) entered!", R1 "ptr") never returns; } INFO_TABLE_CONSTR(stg_SRT_8, 8, 0, 0, CONSTR, "SRT_8", "SRT_8") -{ foreign "C" barf("SRT_8 object (%p) entered!", R1) never returns; } +{ ccall pbarf("SRT_8 object (%p) entered!", R1 "ptr") never returns; } INFO_TABLE_CONSTR(stg_SRT_9, 9, 0, 0, CONSTR, "SRT_9", "SRT_9") -{ foreign "C" barf("SRT_9 object (%p) entered!", R1) never returns; } +{ ccall pbarf("SRT_9 object (%p) entered!", R1 "ptr") never returns; } INFO_TABLE_CONSTR(stg_SRT_10, 10, 0, 0, CONSTR, "SRT_10", "SRT_10") -{ foreign "C" barf("SRT_10 object (%p) entered!", R1) never returns; } +{ ccall pbarf("SRT_10 object (%p) entered!", R1 "ptr") never returns; } INFO_TABLE_CONSTR(stg_SRT_11, 11, 0, 0, CONSTR, "SRT_11", "SRT_11") -{ foreign "C" barf("SRT_11 object (%p) entered!", R1) never returns; } +{ ccall pbarf("SRT_11 object (%p) entered!", R1 "ptr") never returns; } INFO_TABLE_CONSTR(stg_SRT_12, 12, 0, 0, CONSTR, "SRT_12", "SRT_12") -{ foreign "C" barf("SRT_12 object (%p) entered!", R1) never returns; } +{ ccall pbarf("SRT_12 object (%p) entered!", R1 "ptr") never returns; } INFO_TABLE_CONSTR(stg_SRT_13, 13, 0, 0, CONSTR, "SRT_13", "SRT_13") -{ foreign "C" barf("SRT_13 object (%p) entered!", R1) never returns; } +{ ccall pbarf("SRT_13 object (%p) entered!", R1 "ptr") never returns; } INFO_TABLE_CONSTR(stg_SRT_14, 14, 0, 0, CONSTR, "SRT_14", "SRT_14") -{ foreign "C" barf("SRT_14 object (%p) entered!", R1) never returns; } +{ ccall pbarf("SRT_14 object (%p) entered!", R1 "ptr") never returns; } INFO_TABLE_CONSTR(stg_SRT_15, 15, 0, 0, CONSTR, "SRT_15", "SRT_15") -{ foreign "C" barf("SRT_15 object (%p) entered!", R1) never returns; } +{ ccall pbarf("SRT_15 object (%p) entered!", R1 "ptr") never returns; } INFO_TABLE_CONSTR(stg_SRT_16, 16, 0, 0, CONSTR, "SRT_16", "SRT_16") -{ foreign "C" barf("SRT_16 object (%p) entered!", R1) never returns; } +{ ccall pbarf("SRT_16 object (%p) entered!", R1 "ptr") never returns; } /* --------------------------------------------------------------------------- Messages ------------------------------------------------------------------------- */ @@ -844,20 +844,20 @@ INFO_TABLE_CONSTR(stg_SRT_16, 16, 0, 0, CONSTR, "SRT_16", "SRT_16") // PRIM rather than CONSTR, because PRIM objects cannot be duplicated by the GC. INFO_TABLE_CONSTR(stg_MSG_TRY_WAKEUP,2,0,0,PRIM,"MSG_TRY_WAKEUP","MSG_TRY_WAKEUP") -{ foreign "C" barf("MSG_TRY_WAKEUP object (%p) entered!", R1) never returns; } +{ ccall pbarf("MSG_TRY_WAKEUP object (%p) entered!", R1 "ptr") never returns; } INFO_TABLE_CONSTR(stg_MSG_THROWTO,4,0,0,PRIM,"MSG_THROWTO","MSG_THROWTO") -{ foreign "C" barf("MSG_THROWTO object (%p) entered!", R1) never returns; } +{ ccall pbarf("MSG_THROWTO object (%p) entered!", R1 "ptr") never returns; } INFO_TABLE_CONSTR(stg_MSG_BLACKHOLE,3,0,0,PRIM,"MSG_BLACKHOLE","MSG_BLACKHOLE") -{ foreign "C" barf("MSG_BLACKHOLE object (%p) entered!", R1) never returns; } +{ ccall pbarf("MSG_BLACKHOLE object (%p) entered!", R1 "ptr") never returns; } // used to overwrite a MSG_THROWTO when the message has been used/revoked INFO_TABLE_CONSTR(stg_MSG_NULL,1,0,0,PRIM,"MSG_NULL","MSG_NULL") -{ foreign "C" barf("MSG_NULL object (%p) entered!", R1) never returns; } +{ ccall pbarf("MSG_NULL object (%p) entered!", R1 "ptr") never returns; } INFO_TABLE_CONSTR(stg_MSG_CLONE_STACK,3,0,0,PRIM,"MSG_CLONE_STACK","MSG_CLONE_STACK") -{ foreign "C" barf("stg_MSG_CLONE_STACK object (%p) entered!", R1) never returns; } +{ ccall pbarf("stg_MSG_CLONE_STACK object (%p) entered!", R1 "ptr") never returns; } /* ---------------------------------------------------------------------------- END_TSO_QUEUE @@ -867,7 +867,7 @@ INFO_TABLE_CONSTR(stg_MSG_CLONE_STACK,3,0,0,PRIM,"MSG_CLONE_STACK","MSG_CLONE_ST ------------------------------------------------------------------------- */ INFO_TABLE_CONSTR(stg_END_TSO_QUEUE,0,0,0,CONSTR_NOCAF,"END_TSO_QUEUE","END_TSO_QUEUE") -{ foreign "C" barf("END_TSO_QUEUE object (%p) entered!", R1) never returns; } +{ ccall pbarf("END_TSO_QUEUE object (%p) entered!", R1 "ptr") never returns; } CLOSURE(stg_END_TSO_QUEUE_closure,stg_END_TSO_QUEUE); @@ -876,7 +876,7 @@ CLOSURE(stg_END_TSO_QUEUE_closure,stg_END_TSO_QUEUE); ------------------------------------------------------------------------- */ INFO_TABLE_CONSTR(stg_GCD_CAF,0,0,0,CONSTR_NOCAF,"GCD_CAF","GCD_CAF") -{ foreign "C" barf("Evaluated a CAF (%p) that was GC'd!", R1) never returns; } +{ ccall pbarf("Evaluated a CAF (%p) that was GC'd!", R1 "ptr") never returns; } /* ---------------------------------------------------------------------------- STM_AWOKEN @@ -886,7 +886,7 @@ INFO_TABLE_CONSTR(stg_GCD_CAF,0,0,0,CONSTR_NOCAF,"GCD_CAF","GCD_CAF") ------------------------------------------------------------------------- */ INFO_TABLE_CONSTR(stg_STM_AWOKEN,0,0,0,CONSTR_NOCAF,"STM_AWOKEN","STM_AWOKEN") -{ foreign "C" barf("STM_AWOKEN object (%p) entered!", R1) never returns; } +{ ccall pbarf("STM_AWOKEN object (%p) entered!", R1 "ptr") never returns; } CLOSURE(stg_STM_AWOKEN_closure,stg_STM_AWOKEN); @@ -906,40 +906,40 @@ CLOSURE(stg_STM_AWOKEN_closure,stg_STM_AWOKEN); ------------------------------------------------------------------------- */ INFO_TABLE(stg_ARR_WORDS, 0, 0, ARR_WORDS, "ARR_WORDS", "ARR_WORDS") -{ foreign "C" barf("ARR_WORDS object (%p) entered!", R1) never returns; } +{ ccall pbarf("ARR_WORDS object (%p) entered!", R1 "ptr") never returns; } INFO_TABLE(stg_MUT_ARR_PTRS_CLEAN, 0, 0, MUT_ARR_PTRS_CLEAN, "MUT_ARR_PTRS_CLEAN", "MUT_ARR_PTRS_CLEAN") -{ foreign "C" barf("MUT_ARR_PTRS_CLEAN object (%p) entered!", R1) never returns; } +{ ccall pbarf("MUT_ARR_PTRS_CLEAN object (%p) entered!", R1 "ptr") never returns; } INFO_TABLE(stg_MUT_ARR_PTRS_DIRTY, 0, 0, MUT_ARR_PTRS_DIRTY, "MUT_ARR_PTRS_DIRTY", "MUT_ARR_PTRS_DIRTY") -{ foreign "C" barf("MUT_ARR_PTRS_DIRTY object (%p) entered!", R1) never returns; } +{ ccall pbarf("MUT_ARR_PTRS_DIRTY object (%p) entered!", R1 "ptr") never returns; } INFO_TABLE(stg_MUT_ARR_PTRS_FROZEN_CLEAN, 0, 0, MUT_ARR_PTRS_FROZEN_CLEAN, "MUT_ARR_PTRS_FROZEN_CLEAN", "MUT_ARR_PTRS_FROZEN_CLEAN") -{ foreign "C" barf("MUT_ARR_PTRS_FROZEN_CLEAN object (%p) entered!", R1) never returns; } +{ ccall pbarf("MUT_ARR_PTRS_FROZEN_CLEAN object (%p) entered!", R1 "ptr") never returns; } INFO_TABLE(stg_MUT_ARR_PTRS_FROZEN_DIRTY, 0, 0, MUT_ARR_PTRS_FROZEN_DIRTY, "MUT_ARR_PTRS_FROZEN_DIRTY", "MUT_ARR_PTRS_FROZEN_DIRTY") -{ foreign "C" barf("MUT_ARR_PTRS_FROZEN_DIRTY object (%p) entered!", R1) never returns; } +{ ccall pbarf("MUT_ARR_PTRS_FROZEN_DIRTY object (%p) entered!", R1 "ptr") never returns; } INFO_TABLE(stg_SMALL_MUT_ARR_PTRS_CLEAN, 0, 0, SMALL_MUT_ARR_PTRS_CLEAN, "SMALL_MUT_ARR_PTRS_CLEAN", "SMALL_MUT_ARR_PTRS_CLEAN") -{ foreign "C" barf("SMALL_MUT_ARR_PTRS_CLEAN object (%p) entered!", R1) never returns; } +{ ccall pbarf("SMALL_MUT_ARR_PTRS_CLEAN object (%p) entered!", R1 "ptr") never returns; } INFO_TABLE(stg_SMALL_MUT_ARR_PTRS_DIRTY, 0, 0, SMALL_MUT_ARR_PTRS_DIRTY, "SMALL_MUT_ARR_PTRS_DIRTY", "SMALL_MUT_ARR_PTRS_DIRTY") -{ foreign "C" barf("SMALL_MUT_ARR_PTRS_DIRTY object (%p) entered!", R1) never returns; } +{ ccall pbarf("SMALL_MUT_ARR_PTRS_DIRTY object (%p) entered!", R1 "ptr") never returns; } INFO_TABLE(stg_SMALL_MUT_ARR_PTRS_FROZEN_CLEAN, 0, 0, SMALL_MUT_ARR_PTRS_FROZEN_CLEAN, "SMALL_MUT_ARR_PTRS_FROZEN_CLEAN", "SMALL_MUT_ARR_PTRS_FROZEN_CLEAN") -{ foreign "C" barf("SMALL_MUT_ARR_PTRS_FROZEN_CLEAN object (%p) entered!", R1) never returns; } +{ ccall pbarf("SMALL_MUT_ARR_PTRS_FROZEN_CLEAN object (%p) entered!", R1 "ptr") never returns; } INFO_TABLE(stg_SMALL_MUT_ARR_PTRS_FROZEN_DIRTY, 0, 0, SMALL_MUT_ARR_PTRS_FROZEN_DIRTY, "SMALL_MUT_ARR_PTRS_FROZEN_DIRTY", "SMALL_MUT_ARR_PTRS_FROZEN_DIRTY") -{ foreign "C" barf("SMALL_MUT_ARR_PTRS_FROZEN_DIRTY object (%p) entered!", R1) never returns; } +{ ccall pbarf("SMALL_MUT_ARR_PTRS_FROZEN_DIRTY object (%p) entered!", R1 "ptr") never returns; } /* ---------------------------------------------------------------------------- Mutable Variables ------------------------------------------------------------------------- */ INFO_TABLE(stg_MUT_VAR_CLEAN, 1, 0, MUT_VAR_CLEAN, "MUT_VAR_CLEAN", "MUT_VAR_CLEAN") -{ foreign "C" barf("MUT_VAR_CLEAN object (%p) entered!", R1) never returns; } +{ ccall pbarf("MUT_VAR_CLEAN object (%p) entered!", R1 "ptr") never returns; } INFO_TABLE(stg_MUT_VAR_DIRTY, 1, 0, MUT_VAR_DIRTY, "MUT_VAR_DIRTY", "MUT_VAR_DIRTY") -{ foreign "C" barf("MUT_VAR_DIRTY object (%p) entered!", R1) never returns; } +{ ccall pbarf("MUT_VAR_DIRTY object (%p) entered!", R1 "ptr") never returns; } /* ---------------------------------------------------------------------------- Dummy return closure @@ -961,7 +961,7 @@ CLOSURE(stg_dummy_ret_closure,stg_dummy_ret); ------------------------------------------------------------------------- */ INFO_TABLE_CONSTR(stg_MVAR_TSO_QUEUE,2,0,0,PRIM,"MVAR_TSO_QUEUE","MVAR_TSO_QUEUE") -{ foreign "C" barf("MVAR_TSO_QUEUE object (%p) entered!", R1) never returns; } +{ ccall pbarf("MVAR_TSO_QUEUE object (%p) entered!", R1 "ptr") never returns; } /* ---------------------------------------------------------------------------- COMPACT_NFDATA (a blob of data in NF with no outgoing pointers) @@ -974,11 +974,11 @@ INFO_TABLE_CONSTR(stg_MVAR_TSO_QUEUE,2,0,0,PRIM,"MVAR_TSO_QUEUE","MVAR_TSO_QUEUE INFO_TABLE( stg_COMPACT_NFDATA_CLEAN, 0, 9, COMPACT_NFDATA, "COMPACT_NFDATA", "COMPACT_NFDATA") () -{ foreign "C" barf("COMPACT_NFDATA_CLEAN object (%p) entered!", R1) never returns; } +{ ccall pbarf("COMPACT_NFDATA_CLEAN object (%p) entered!", R1 "ptr") never returns; } INFO_TABLE( stg_COMPACT_NFDATA_DIRTY, 0, 9, COMPACT_NFDATA, "COMPACT_NFDATA", "COMPACT_NFDATA") () -{ foreign "C" barf("COMPACT_NFDATA_DIRTY object (%p) entered!", R1) never returns; } +{ ccall pbarf("COMPACT_NFDATA_DIRTY object (%p) entered!", R1 "ptr") never returns; } /* ---------------------------------------------------------------------------- ClosureTable element null value @@ -988,7 +988,7 @@ INFO_TABLE( stg_COMPACT_NFDATA_DIRTY, 0, 9, COMPACT_NFDATA, "COMPACT_NFDATA", "C ------------------------------------------------------------------------- */ INFO_TABLE_CONSTR(stg_CLOSURE_TABLE_NULL,0,0,0,CONSTR_NOCAF,"CLOSURE_TABLE_NULL","CLOSURE_TABLE_NULL") -{ foreign "C" barf("CLOSURE_TABLE_NULL object (%p) entered!", R1) never returns; } +{ ccall pbarf("CLOSURE_TABLE_NULL object (%p) entered!", R1 "ptr") never returns; } CLOSURE(stg_CLOSURE_TABLE_NULL_closure,stg_CLOSURE_TABLE_NULL); @@ -1003,10 +1003,10 @@ INFO_TABLE_CONSTR(stg_TIMEOUT_QUEUE, stg_TIMEOUT_QUEUE_NUM_PTRS, stg_TIMEOUT_QUEUE_NUM_NONPTRS, 0,MUT_PRIM,"TIMEOUT_QUEUE","TIMEOUT_QUEUE") -{ foreign "C" barf("TIMEOUT_QUEUE object (%p) entered!", R1) never returns; } +{ ccall pbarf("TIMEOUT_QUEUE object (%p) entered!", R1 "ptr") never returns; } INFO_TABLE_CONSTR(stg_TIMEOUT_QUEUE_EMPTY,0,0,0,CONSTR_NOCAF,"TIMEOUT_QUEUE_EMPTY","TIMEOUT_QUEUE_EMPTY") -{ foreign "C" barf("TIMEOUT_QUEUE_EMPTY object (%p) entered!", R1) never returns; } +{ ccall pbarf("TIMEOUT_QUEUE_EMPTY object (%p) entered!", R1 "ptr") never returns; } CLOSURE(stg_TIMEOUT_QUEUE_EMPTY_closure,stg_TIMEOUT_QUEUE_EMPTY); @@ -1022,9 +1022,9 @@ INFO_TABLE_CONSTR(stg_ASYNCIOOP, stg_ASYNCIOOP_NUM_PTRS, stg_ASYNCIOOP_NUM_NONPTRS, 0,PRIM,"ASYNCIOOP","ASYNCIOOP") -{ foreign "C" barf("ASYNCIOOP object (%p) entered!", R1) never returns; } +{ ccall pbarf("ASYNCIOOP object (%p) entered!", R1 "ptr") never returns; } INFO_TABLE_CONSTR(stg_ASYNCIO_LIVE0,0,0,0,CONSTR_NOCAF,"ASYNCIO_LIVE0","ASYNCIO_LIVE0") -{ foreign "C" barf("ASYNCIO_LIVE0 object (%p) entered!", R1) never returns; } +{ ccall pbarf("ASYNCIO_LIVE0 object (%p) entered!", R1 "ptr") never returns; } CLOSURE(stg_ASYNCIO_LIVE0_closure,stg_ASYNCIO_LIVE0); ===================================== rts/StgStartup.cmm ===================================== @@ -178,5 +178,5 @@ INFO_TABLE_RET(stg_forceIO, RET_SMALL, P_ info_ptr) /* Called when compiled with -falignment-sanitisation on alignment failure */ stg_badAlignment_entry { - foreign "C" barf("stg_badAlignment_entry", NULL); + ccall sbarf("stg_badAlignment_entry") never returns; } ===================================== rts/include/rts/Messages.h ===================================== @@ -37,6 +37,18 @@ void barf(const char *s, ...) void vbarf(const char *s, va_list ap) STG_NORETURN; +/* Non-variadic wrapper around barf(), used by the code generator. */ +void sbarf(const char *s) + STG_NORETURN; + +/* Non-variadic wrapper around barf() for a format string and one pointer. */ +void pbarf(const char *fmt, void *p) + STG_NORETURN; + +/* Non-variadic wrapper around barf() for a format string and one string. */ +void ssbarf(const char *fmt, const char *s) + STG_NORETURN; + // declared in Rts.h: // extern void _assertFail(const char *filename, unsigned int linenum) // STG_NORETURN; ===================================== testsuite/tests/simplStg/should_compile/all.T ===================================== @@ -19,8 +19,6 @@ test('T22840', [extra_files( [ 'T22840A.hs' , 'T22840B.hs' ]), - # barf signature mismatch on wasm32 due to -dtag-inference-checks - when(arch('wasm32'), skip), when(not(have_dynamic()),skip)], multimod_compile, ['T22840', '-dynamic-too -dtag-inference-checks']) test('inferTags003', [ only_ways(['optasm']), grep_errmsg(r'(call stg\_ap\_0)', [1]) ===================================== utils/genapply/Main.hs ===================================== @@ -79,7 +79,7 @@ in a conditional. For example, stg_stk_save_v32 looks like: V32_[Sp+WDS(3)] = YMM1; ... #else - foreign "C" barf("stg_stk_save_v32: unsupported vector register", NULL) never returns; + ccall sbarf("stg_stk_save_v32: unsupported vector register") never returns; #endif } @@ -344,7 +344,7 @@ vecsCpp fun regs code = , text "#if" <+> cond ] ++ code ++ [ text "#else //" <+> cond - , text "foreign \"C\" barf(\"" <> fun <> text ": unsupported vector register\", NULL) never returns;" + , text "ccall sbarf(\"" <> fun <> text ": unsupported vector register\") never returns;" , text "#endif //" <+> cond ] @@ -1049,7 +1049,7 @@ genApply targetInfo args = text "default: {", nest 4 ( - text "foreign \"C\" barf(\"" <> fun_ret_label <> text "\", NULL) never returns;" + text "ccall sbarf(\"" <> fun_ret_label <> text "\") never returns;" ), text "}" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1ca4b49a561447222072a44320fa9b0… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1ca4b49a561447222072a44320fa9b0… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] rts: use __builtin_mul_overflow for hs_mulIntMayOflo
by Marge Bot (＠marge-bot) 19 Dec '25

19 Dec '25

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 5729418c by Cheng Shao at 2025-12-18T13:22:29-05:00 rts: use __builtin_mul_overflow for hs_mulIntMayOflo This patch uses `__builtin_mul_overflow` to implement `hs_mulIntMayOflo`. This is a GNU C checked arithmetic builtin function supported by gcc/clang, is type-generic so works for both 32-bit/64-bit, and makes the code both more efficient and easier to read/maintain than the previous hand rolled logic. - - - - - 3 changed files: - compiler/GHC/CmmToC.hs - rts/include/Stg.h - rts/prim/mulIntMayOflo.c Changes: ===================================== compiler/GHC/CmmToC.hs ===================================== @@ -426,7 +426,7 @@ pprMachOpApp :: Platform -> MachOp -> [CmmExpr] -> SDoc pprMachOpApp platform op args | isMulMayOfloOp op - = text "mulIntMayOflo" <> parens (commafy (map (pprExpr platform) args)) + = text "hs_mulIntMayOflo" <> parens (commafy (map (pprExpr platform) args)) where isMulMayOfloOp (MO_S_MulMayOflo _) = True isMulMayOfloOp _ = False ===================================== rts/include/Stg.h ===================================== @@ -519,79 +519,3 @@ INLINE_HEADER StgInt64 PK_Int64(W_ p_src[]) } #endif /* SIZEOF_HSWORD == 4 */ - -/* ----------------------------------------------------------------------------- - Integer multiply with overflow - -------------------------------------------------------------------------- */ - -/* Multiply with overflow checking. - * - * This is tricky - the usual sign rules for add/subtract don't apply. - * - * On 32-bit machines we use gcc's 'long long' types, finding - * overflow with some careful bit-twiddling. - * - * On 64-bit machines where gcc's 'long long' type is also 64-bits, - * we use a crude approximation, testing whether either operand is - * larger than 32-bits; if neither is, then we go ahead with the - * multiplication. - * - * Return non-zero if there is any possibility that the signed multiply - * of a and b might overflow. Return zero only if you are absolutely sure - * that it won't overflow. If in doubt, return non-zero. - */ - -#if SIZEOF_VOID_P == 4 - -#if defined(WORDS_BIGENDIAN) -#define RTS_CARRY_IDX__ 0 -#define RTS_REM_IDX__ 1 -#else -#define RTS_CARRY_IDX__ 1 -#define RTS_REM_IDX__ 0 -#endif - -typedef union { - StgInt64 l; - StgInt32 i[2]; -} long_long_u ; - -#define mulIntMayOflo(a,b) \ -({ \ - StgInt32 r, c; \ - long_long_u z; \ - z.l = (StgInt64)a * (StgInt64)b; \ - r = z.i[RTS_REM_IDX__]; \ - c = z.i[RTS_CARRY_IDX__]; \ - if (c == 0 || c == -1) { \ - c = ((StgWord)((a^b) ^ r)) \ - >> (BITS_IN (I_) - 1); \ - } \ - c; \ -}) - -/* Careful: the carry calculation above is extremely delicate. Make sure - * you test it thoroughly after changing it. - */ - -#else - -/* Approximate version when we don't have long arithmetic (on 64-bit archs) */ - -/* If we have n-bit words then we have n-1 bits after accounting for the - * sign bit, so we can fit the result of multiplying 2 (n-1)/2-bit numbers */ -#define HALF_POS_INT (((I_)1) << ((BITS_IN (I_) - 1) / 2)) -#define HALF_NEG_INT (-HALF_POS_INT) - -#define mulIntMayOflo(a,b) \ -({ \ - I_ c; \ - if ((I_)a <= HALF_NEG_INT || a >= HALF_POS_INT \ - || (I_)b <= HALF_NEG_INT || b >= HALF_POS_INT) {\ - c = 1; \ - } else { \ - c = 0; \ - } \ - c; \ -}) -#endif ===================================== rts/prim/mulIntMayOflo.c ===================================== @@ -1,3 +1,6 @@ #include "Rts.h" -W_ hs_mulIntMayOflo(W_ a, W_ b) { return mulIntMayOflo(a, b); } +W_ hs_mulIntMayOflo(W_ a, W_ b) { + I_ r; + return (W_)__builtin_mul_overflow((I_)a, (I_)b, &r); +} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5729418c5b017cff5e722ec42c91e73… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5729418c5b017cff5e722ec42c91e73… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] Doc: document -pgmi "" (#26634)
by Marge Bot (＠marge-bot) 19 Dec '25

19 Dec '25

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 3995187c by Sylvain Henry at 2025-12-18T13:21:45-05:00 Doc: document -pgmi "" (#26634) - - - - - 1 changed file: - docs/users_guide/phases.rst Changes: ===================================== docs/users_guide/phases.rst ===================================== @@ -155,6 +155,14 @@ given compilation phase: :ghc-flag:`-prof` is enabled, ``ghc-iserv-dyn`` if :ghc-flag:`-dynamic` is enabled, or ``ghc-iserv`` otherwise. + If <cmd> is the empty string then GHC will try to build an appropriate iserv + program for the target platform. It does this by looking for the installed + ``ghci`` unit and by building an executable program that uses + ``ghci:GHCi.Server.defaultServer`` as an entry point. Note that it doesn't + work when cross-compiling: the cross-compiled ``iserv`` program (if it can + be built) can't be run on the build platform. + + .. _forcing-options-through: Forcing options to a particular phase View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3995187c5d2d71984acd79d045aca7a… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3995187c5d2d71984acd79d045aca7a… You're receiving this email because of your account on gitlab.haskell.org.

1 0