- ghc-commits - Haskell.org

[Git][ghc/ghc][wip/dcoutts/io-manager-io-primop-exceptions] FIXUP Change the encoding of results from the I/O manager to I/O primops
by Duncan Coutts (＠dcoutts) 28 Aug '26

28 Aug '26

Duncan Coutts pushed to branch wip/dcoutts/io-manager-io-primop-exceptions at Glasgow Haskell Compiler / GHC Commits: 3d73b7a6 by Duncan Coutts at 2026-08-28T17:56:38+01:00 FIXUP Change the encoding of results from the I/O manager to I/O primops - - - - - 1 changed file: - rts/PrimOps.cmm Changes: ===================================== rts/PrimOps.cmm ===================================== @@ -2314,22 +2314,22 @@ stg_waitReadyFd ( W_ fd, CInt rw ) (result) = ccall syncIOWaitReady(Capability_iomgr(MyCapability()) "ptr", CurrentTSO "ptr", rw, fd); - /* See Note [Encoding of I/O manager operation results to primops] */ + /* See Note [Encoding of result of I/O manager operations] */ /* case IOSubmitResultAsyncContinue */ - if (result == 0) (likely: True) { + if (result == 0::CInt) (likely: True) { /* See Note [Thread blocking for new I/O primops] */ jump stg_block_io_unit(); } /* case IOSubmitResultSyncSuccess*/ - if (result == 1) { + if (result == 1::CInt) { /* Success, don't even go via scheduler. */ return (); } /* negative numbers are -errno error codes */ - if (result < 0) { + if (result < 0::CInt) { /* See Note [Calling convention for raisePrimIOException] */ W_ dummyR1; W_ errno; dummyR1 = 0; @@ -2339,7 +2339,7 @@ stg_waitReadyFd ( W_ fd, CInt rw ) } /* case IOSubmitResultHeapOverflow */ - if (result == 2) { + if (result == 2::CInt) { jump stg_raisezh(HsIface_heapOverflow_closure(W_[ghc_hs_iface])); } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3d73b7a66c8d02181a8231be945d61c… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3d73b7a66c8d02181a8231be945d61c… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc][wip/andreask/cfg-fix] Another CFG Fix
by Andreas Klebinger (＠AndreasK) 28 Aug '26

28 Aug '26

Andreas Klebinger pushed to branch wip/andreask/cfg-fix at Glasgow Haskell Compiler / GHC Commits: 601c8e8d by Andreas Klebinger at 2026-08-28T14:06:51+00:00 Another CFG Fix - - - - - 1 changed file: - compiler/GHC/CmmToAsm/X86/CodeGen.hs Changes: ===================================== compiler/GHC/CmmToAsm/X86/CodeGen.hs ===================================== @@ -514,7 +514,7 @@ assignMem_I64Code addrTree valueTree = do -- Little-endian store mov_lo = MOV II32 (OpReg rlo) (OpAddr addr) mov_hi = MOV II32 (OpReg rhi) (OpAddr (fromJust (addrOffset addr 4))) - return (vcode `appOL` addr_code `snocOL` mov_lo `snocOL` mov_hi) + return (addr_code `appOL` vcode `snocOL` mov_lo `snocOL` mov_hi) assignReg_I64Code :: CmmReg -> CmmExpr -> NatM InstrBlock View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/601c8e8d21526db86e3fe44dbd09ce9… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/601c8e8d21526db86e3fe44dbd09ce9… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc][wip/jeltsch/improve-closure-property-check.global-unit-info-map] 19 commits: Add Data.RealFloat and Infinity/NegInfinity/NaN pattern synonyms (#26961)
by Wolfgang Jeltsch (＠jeltsch) 28 Aug '26

28 Aug '26

Wolfgang Jeltsch pushed to branch wip/jeltsch/improve-closure-property-check.global-unit-info-map at Glasgow Haskell Compiler / GHC Commits: b5d29ab8 by Brandon Chinn at 2026-08-25T18:42:08-04:00 Add Data.RealFloat and Infinity/NegInfinity/NaN pattern synonyms (#26961) - - - - - e60eb3bc by Andreas Klebinger at 2026-08-25T18:42:59-04:00 rts linker: Fix pointer arithmetic issue in flushInstructionCacheRISCV64 We accidentally operated over `uint64_t*` when we should use `uint8_t`. Fixes #27569 - - - - - e9bbe8f9 by Andreas Klebinger at 2026-08-26T15:09:23-04:00 cmm dumps: Add machop width info with -dppr-debug for infix ops. - - - - - 86e3a9d8 by Andreas Klebinger at 2026-08-26T15:09:24-04:00 CmmLint: Check for unsupported MachOp widths machOpArgReps now maps MachOp + Width to a list of supported argument widths or Nothing if the given operation is not supported at the given width. This allows us to check for nonsensical combinations like FloatToInt at Word16. Similarly we now check that every address is actually wordwidth. - - - - - 13781cca by Andreas Klebinger at 2026-08-26T15:09:24-04:00 arm64 ncg: The big subword truncation fix. A set of slightly related fixes to arm subword handling: Bitmask immediates: Don't produce overflowing assembly literals. There is still another bug here that causes us to miss some valid literals but we will fix that later. Improve subword truncation handling: We now use a small set of helpers to truncate `Register` values rather than truncating immediate `Reg` values which greatly simplifies the code structure. This fixes a great many bugs to do with sign/zero extending subwords or the lack thereof. We now establish the invariant that subword values are zero-extended at every site at which they come into "scope" of the ncg, and rely on the invariant throughout rather than pessimistically inserting redundant extensions in a hodgepodge manner at the use sites of these values. This fixes at least the bugs described in issues #27533, #27430 #27537, #27538, #27539, and #27550. But likely more bugs yet not found. Subword ffi results: Apply truncations when calling functions returning subword values. genCondJump: Don't sign extend signed values in the input register as it might map to a local variable, corrupting the value stored within. Fix subword store/load instructions.: We used to read those at 32bit width even for smaller values possibly resulting in invalid memory access. Now we construct the suffix for subword variants based on the instruction format for these. - - - - - d8fa5d7c by Andreas Klebinger at 2026-08-26T15:09:24-04:00 arm64 ncg: Fix MO_V_Broadcast for non-literals. We now use OpReg instead of OpScalarAsVec as required since we broadcast a gp register. Also adds a test. Fixes #27565. - - - - - 94822c95 by Andreas Klebinger at 2026-08-26T15:09:24-04:00 Add some test cases covering bugs in the arm ncg. * Test for #27430 (subword ffi results) * #27537 - subword conversions * #27538 - subwords used in conditional * #27533 - single byte read - - - - - dd1ba88a by Andreas Klebinger at 2026-08-26T15:09:24-04:00 cmmLint: Lint against MO_FS_Truncate subword use. - - - - - fd22f71e by Zubin Duggal at 2026-08-26T15:10:20-04:00 ghc-internal: annotateSTM should use catchSTM# rather than catch# A catch# frame inside a transaction breaks retry and async exception delivery. Fixes #27657 - - - - - bb324171 by Rodrigo Mesquita at 2026-08-26T15:10:59-04:00 rts: refactor to reduce THREADED_RTS in MSG_UPD_TSO_FLAGS - No behavior change in this commit (well, a small optimization here makes us do less work if the target TSO owned by the curr. capability) - Move all THREADED_RTS CPP needed into `updThreadFlag` - Merge MSG_SET_TSO_FLAGS and MSG_UNSET_TSO_FLAGS into MSG_UPD_TSO_FLAGS plus a `set` bool field in the MessageUpdTSOFlag struct Towards #27729 - - - - - ed99b7b7 by Rodrigo Mesquita at 2026-08-26T15:10:59-04:00 rts: Fix race condition in MSG_UPD_TSO_FLAGS execution The code for processing the MSG_UPD_TSO_FLAGS message was not taking into consideration that the TSO's owner might have moved in between that capability receiving the message (since it was its previous owner) and starting to process its inbox (a point at which it was no longer the owner) Added Note [TSO owner may change in between Msg being sent and received] to explain this race and the pattern used to fix this, where we just forward the message to the new owner. Fixes #27729 - - - - - cd653714 by Alan Zimmerman at 2026-08-26T15:11:49-04:00 EPA: Uses Parsers.parseModule for exactprint tests Parsers.parseModule is the advertised way to parse for use for exact printing in the ghc-exactprint library. This commit updates the GHC exact print testing to use it. This requires moving the comment balancing that was occurring only in the test path into the advertising parser path, so it moves from Transforms.hs to Utils.hs. Also update the comment adding to honour trailing annotations - - - - - d1d01fa5 by Wolfgang Jeltsch at 2026-08-27T13:17:59+03:00 Add `rethrowSTM` and improve STM-related documentation Adding `rethrowSTM` resolves #26758. The implementation of `rethrowSTM` is completely analogous to the one of `rethrowIO`. The following is established for the documentation of `throwSTM` and `catchSTM`: * Both operations are directly described as analogs of their `IO` counterparts. * There is no reference to `throw` in the documentation of `throwSTM`, because, although such a reference is great in the documentation of `throwIO`, it is somewhat out of place in the documentation of `throwSTM`. * Instead of repeating part of `throwIO`’s documentation, the documentation of `throwSTM` just recommends using `throwSTM` instead of `throw` and references the corresponding arguments in the documentation of `throwIO`. - - - - - 06fde293 by fendor at 2026-08-28T06:06:44-04:00 GHCi: Fix order of `PackageDBFlag`s for interactive home unit `PackageDBFlag`s are stored in reverse order of cli specification. When sorting the `PackageDBFlag`s by longest common prefix, we need thus to reverse the package db stacks before calculating the prefix. We make sure to reverse the package db stack for the interactive home unit to uphold that later specified package dbs overwrite earlier ones. Resolved and adds regression test for #27640 - - - - - 024c4d04 by fendor at 2026-08-28T06:07:23-04:00 Reuse the UnitIndexCache after initialising multiple home units - - - - - 55326fa0 by Alan Zimmerman at 2026-08-28T06:08:03-04:00 EPA: Some Haddock processing tweaks These changes to the Haddock postprocessing should not change behaviour, but just bring it more closely in line with the original, changed at 44309cd377f And add some haddock exactprint tests to show they work. - - - - - b00c277f by Wolfgang Jeltsch at 2026-08-28T16:47:56+03:00 Improve the `mhu-closure` makefile - - - - - 79253586 by Wolfgang Jeltsch at 2026-08-28T16:47:56+03:00 Re-implement the home unit closure check Resolves #27051. - - - - - 61de7ee7 by Wolfgang Jeltsch at 2026-08-28T16:47:56+03:00 Adapt `mhu-closure` to the inclusion of implicitly used units - - - - - 83 changed files: - changelog.d/T27202 - + changelog.d/T27657 - + changelog.d/arm_ncg_fixes_T27430 - + changelog.d/rethrow-stm - changelog.d/unit-index - compiler/GHC/Cmm/Expr.hs - compiler/GHC/Cmm/Lint.hs - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/Driver/Downsweep.hs - compiler/GHC/Driver/Errors/Ppr.hs - compiler/GHC/Driver/Errors/Types.hs - compiler/GHC/Driver/Session/Units.hs - compiler/GHC/Parser/PostProcess/Haddock.hs - compiler/GHC/Unit/Env.hs - compiler/GHC/Unit/External/Index.hs - ghc/GHCi/UI.hs - libraries/base/base.cabal.in - libraries/base/changelog.md - + libraries/base/src/Data/RealFloat.hs - libraries/base/src/GHC/Conc.hs - libraries/ghc-internal/src/GHC/Internal/STM.hs - rts/CloneStack.c - rts/Interpreter.c - rts/Messages.c - rts/StgMiscClosures.cmm - rts/Threads.c - rts/Threads.h - rts/include/rts/storage/Closures.h - rts/include/stg/MiscClosures.h - rts/linker/elf_reloc_riscv64.c - testsuite/tests/cmm/should_compile/Makefile - + testsuite/tests/cmm/should_compile/T27368-ppr-debug.stderr - − testsuite/tests/cmm/should_compile/T27368-ppr-debug.stdout - testsuite/tests/cmm/should_compile/all.T - + testsuite/tests/codeGen/should_run/T27430.hs - + testsuite/tests/codeGen/should_run/T27430.stdout - + testsuite/tests/codeGen/should_run/T27430_c.c - + testsuite/tests/codeGen/should_run/T27533.hs - + testsuite/tests/codeGen/should_run/T27533.stdout - + testsuite/tests/codeGen/should_run/T27533_cmm.cmm - + testsuite/tests/codeGen/should_run/T27537.hs - + testsuite/tests/codeGen/should_run/T27537.stdout - + testsuite/tests/codeGen/should_run/T27538.hs - + testsuite/tests/codeGen/should_run/T27538.stdout - testsuite/tests/codeGen/should_run/all.T - + testsuite/tests/concurrent/should_run/T27657a.hs - + testsuite/tests/concurrent/should_run/T27657a.stdout - + testsuite/tests/concurrent/should_run/T27657b.hs - + testsuite/tests/concurrent/should_run/T27657b.stdout - testsuite/tests/concurrent/should_run/all.T - testsuite/tests/driver/multipleHomeUnits/mhu-closure/Makefile - testsuite/tests/driver/multipleHomeUnits/mhu-closure/mhu-closure.stderr - testsuite/tests/driver/multipleHomeUnits/mhu-closure/mhu-closure.stdout - + testsuite/tests/ghci/prog-mhu007/Makefile - + testsuite/tests/ghci/prog-mhu007/a/A.hs - + testsuite/tests/ghci/prog-mhu007/all.T - + testsuite/tests/ghci/prog-mhu007/b/B.hs - + testsuite/tests/ghci/prog-mhu007/prog-mhu007.script - + testsuite/tests/ghci/prog-mhu007/prog-mhu007.stdout - + testsuite/tests/ghci/prog-mhu007/testpkg-bar/Bar.hs - + testsuite/tests/ghci/prog-mhu007/testpkg-bar/testpkg-bar.pkg - + testsuite/tests/ghci/prog-mhu007/testpkg-foo/Foo.hs - + testsuite/tests/ghci/prog-mhu007/testpkg-foo/testpkg-foo.pkg - + testsuite/tests/ghci/prog-mhu007/unitA - + testsuite/tests/ghci/prog-mhu007/unitB - testsuite/tests/interface-stability/base-exports.stdout - testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs - testsuite/tests/interface-stability/base-exports.stdout-mingw32 - + testsuite/tests/printer/Haddock1.hs - testsuite/tests/printer/Makefile - testsuite/tests/printer/all.T - + testsuite/tests/simd/should_run/T27565.hs - + testsuite/tests/simd/should_run/T27565.stdout - testsuite/tests/simd/should_run/all.T - utils/check-exact/ExactPrint.hs - utils/check-exact/Main.hs - utils/check-exact/Parsers.hs - utils/check-exact/Transform.hs - utils/check-exact/Utils.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4b2c3aedb50c4aed90cae420341727… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4b2c3aedb50c4aed90cae420341727… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc][wip/jeltsch/improve-closure-property-check] 19 commits: Add Data.RealFloat and Infinity/NegInfinity/NaN pattern synonyms (#26961)
by Wolfgang Jeltsch (＠jeltsch) 28 Aug '26

28 Aug '26

Wolfgang Jeltsch pushed to branch wip/jeltsch/improve-closure-property-check at Glasgow Haskell Compiler / GHC Commits: b5d29ab8 by Brandon Chinn at 2026-08-25T18:42:08-04:00 Add Data.RealFloat and Infinity/NegInfinity/NaN pattern synonyms (#26961) - - - - - e60eb3bc by Andreas Klebinger at 2026-08-25T18:42:59-04:00 rts linker: Fix pointer arithmetic issue in flushInstructionCacheRISCV64 We accidentally operated over `uint64_t*` when we should use `uint8_t`. Fixes #27569 - - - - - e9bbe8f9 by Andreas Klebinger at 2026-08-26T15:09:23-04:00 cmm dumps: Add machop width info with -dppr-debug for infix ops. - - - - - 86e3a9d8 by Andreas Klebinger at 2026-08-26T15:09:24-04:00 CmmLint: Check for unsupported MachOp widths machOpArgReps now maps MachOp + Width to a list of supported argument widths or Nothing if the given operation is not supported at the given width. This allows us to check for nonsensical combinations like FloatToInt at Word16. Similarly we now check that every address is actually wordwidth. - - - - - 13781cca by Andreas Klebinger at 2026-08-26T15:09:24-04:00 arm64 ncg: The big subword truncation fix. A set of slightly related fixes to arm subword handling: Bitmask immediates: Don't produce overflowing assembly literals. There is still another bug here that causes us to miss some valid literals but we will fix that later. Improve subword truncation handling: We now use a small set of helpers to truncate `Register` values rather than truncating immediate `Reg` values which greatly simplifies the code structure. This fixes a great many bugs to do with sign/zero extending subwords or the lack thereof. We now establish the invariant that subword values are zero-extended at every site at which they come into "scope" of the ncg, and rely on the invariant throughout rather than pessimistically inserting redundant extensions in a hodgepodge manner at the use sites of these values. This fixes at least the bugs described in issues #27533, #27430 #27537, #27538, #27539, and #27550. But likely more bugs yet not found. Subword ffi results: Apply truncations when calling functions returning subword values. genCondJump: Don't sign extend signed values in the input register as it might map to a local variable, corrupting the value stored within. Fix subword store/load instructions.: We used to read those at 32bit width even for smaller values possibly resulting in invalid memory access. Now we construct the suffix for subword variants based on the instruction format for these. - - - - - d8fa5d7c by Andreas Klebinger at 2026-08-26T15:09:24-04:00 arm64 ncg: Fix MO_V_Broadcast for non-literals. We now use OpReg instead of OpScalarAsVec as required since we broadcast a gp register. Also adds a test. Fixes #27565. - - - - - 94822c95 by Andreas Klebinger at 2026-08-26T15:09:24-04:00 Add some test cases covering bugs in the arm ncg. * Test for #27430 (subword ffi results) * #27537 - subword conversions * #27538 - subwords used in conditional * #27533 - single byte read - - - - - dd1ba88a by Andreas Klebinger at 2026-08-26T15:09:24-04:00 cmmLint: Lint against MO_FS_Truncate subword use. - - - - - fd22f71e by Zubin Duggal at 2026-08-26T15:10:20-04:00 ghc-internal: annotateSTM should use catchSTM# rather than catch# A catch# frame inside a transaction breaks retry and async exception delivery. Fixes #27657 - - - - - bb324171 by Rodrigo Mesquita at 2026-08-26T15:10:59-04:00 rts: refactor to reduce THREADED_RTS in MSG_UPD_TSO_FLAGS - No behavior change in this commit (well, a small optimization here makes us do less work if the target TSO owned by the curr. capability) - Move all THREADED_RTS CPP needed into `updThreadFlag` - Merge MSG_SET_TSO_FLAGS and MSG_UNSET_TSO_FLAGS into MSG_UPD_TSO_FLAGS plus a `set` bool field in the MessageUpdTSOFlag struct Towards #27729 - - - - - ed99b7b7 by Rodrigo Mesquita at 2026-08-26T15:10:59-04:00 rts: Fix race condition in MSG_UPD_TSO_FLAGS execution The code for processing the MSG_UPD_TSO_FLAGS message was not taking into consideration that the TSO's owner might have moved in between that capability receiving the message (since it was its previous owner) and starting to process its inbox (a point at which it was no longer the owner) Added Note [TSO owner may change in between Msg being sent and received] to explain this race and the pattern used to fix this, where we just forward the message to the new owner. Fixes #27729 - - - - - cd653714 by Alan Zimmerman at 2026-08-26T15:11:49-04:00 EPA: Uses Parsers.parseModule for exactprint tests Parsers.parseModule is the advertised way to parse for use for exact printing in the ghc-exactprint library. This commit updates the GHC exact print testing to use it. This requires moving the comment balancing that was occurring only in the test path into the advertising parser path, so it moves from Transforms.hs to Utils.hs. Also update the comment adding to honour trailing annotations - - - - - d1d01fa5 by Wolfgang Jeltsch at 2026-08-27T13:17:59+03:00 Add `rethrowSTM` and improve STM-related documentation Adding `rethrowSTM` resolves #26758. The implementation of `rethrowSTM` is completely analogous to the one of `rethrowIO`. The following is established for the documentation of `throwSTM` and `catchSTM`: * Both operations are directly described as analogs of their `IO` counterparts. * There is no reference to `throw` in the documentation of `throwSTM`, because, although such a reference is great in the documentation of `throwIO`, it is somewhat out of place in the documentation of `throwSTM`. * Instead of repeating part of `throwIO`’s documentation, the documentation of `throwSTM` just recommends using `throwSTM` instead of `throw` and references the corresponding arguments in the documentation of `throwIO`. - - - - - 06fde293 by fendor at 2026-08-28T06:06:44-04:00 GHCi: Fix order of `PackageDBFlag`s for interactive home unit `PackageDBFlag`s are stored in reverse order of cli specification. When sorting the `PackageDBFlag`s by longest common prefix, we need thus to reverse the package db stacks before calculating the prefix. We make sure to reverse the package db stack for the interactive home unit to uphold that later specified package dbs overwrite earlier ones. Resolved and adds regression test for #27640 - - - - - 024c4d04 by fendor at 2026-08-28T06:07:23-04:00 Reuse the UnitIndexCache after initialising multiple home units - - - - - 55326fa0 by Alan Zimmerman at 2026-08-28T06:08:03-04:00 EPA: Some Haddock processing tweaks These changes to the Haddock postprocessing should not change behaviour, but just bring it more closely in line with the original, changed at 44309cd377f And add some haddock exactprint tests to show they work. - - - - - 793a552c by Wolfgang Jeltsch at 2026-08-28T16:48:21+03:00 Improve the `mhu-closure` makefile - - - - - 9e1849fa by Wolfgang Jeltsch at 2026-08-28T16:48:21+03:00 Re-implement the home unit closure check Resolves #27051. - - - - - 44e03adb by Wolfgang Jeltsch at 2026-08-28T16:48:21+03:00 Adapt `mhu-closure` to the inclusion of implicitly used units - - - - - 83 changed files: - changelog.d/T27202 - + changelog.d/T27657 - + changelog.d/arm_ncg_fixes_T27430 - + changelog.d/rethrow-stm - changelog.d/unit-index - compiler/GHC/Cmm/Expr.hs - compiler/GHC/Cmm/Lint.hs - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/Driver/Downsweep.hs - compiler/GHC/Driver/Errors/Ppr.hs - compiler/GHC/Driver/Errors/Types.hs - compiler/GHC/Driver/Session/Units.hs - compiler/GHC/Parser/PostProcess/Haddock.hs - compiler/GHC/Unit/Env.hs - compiler/GHC/Unit/External/Index.hs - ghc/GHCi/UI.hs - libraries/base/base.cabal.in - libraries/base/changelog.md - + libraries/base/src/Data/RealFloat.hs - libraries/base/src/GHC/Conc.hs - libraries/ghc-internal/src/GHC/Internal/STM.hs - rts/CloneStack.c - rts/Interpreter.c - rts/Messages.c - rts/StgMiscClosures.cmm - rts/Threads.c - rts/Threads.h - rts/include/rts/storage/Closures.h - rts/include/stg/MiscClosures.h - rts/linker/elf_reloc_riscv64.c - testsuite/tests/cmm/should_compile/Makefile - + testsuite/tests/cmm/should_compile/T27368-ppr-debug.stderr - − testsuite/tests/cmm/should_compile/T27368-ppr-debug.stdout - testsuite/tests/cmm/should_compile/all.T - + testsuite/tests/codeGen/should_run/T27430.hs - + testsuite/tests/codeGen/should_run/T27430.stdout - + testsuite/tests/codeGen/should_run/T27430_c.c - + testsuite/tests/codeGen/should_run/T27533.hs - + testsuite/tests/codeGen/should_run/T27533.stdout - + testsuite/tests/codeGen/should_run/T27533_cmm.cmm - + testsuite/tests/codeGen/should_run/T27537.hs - + testsuite/tests/codeGen/should_run/T27537.stdout - + testsuite/tests/codeGen/should_run/T27538.hs - + testsuite/tests/codeGen/should_run/T27538.stdout - testsuite/tests/codeGen/should_run/all.T - + testsuite/tests/concurrent/should_run/T27657a.hs - + testsuite/tests/concurrent/should_run/T27657a.stdout - + testsuite/tests/concurrent/should_run/T27657b.hs - + testsuite/tests/concurrent/should_run/T27657b.stdout - testsuite/tests/concurrent/should_run/all.T - testsuite/tests/driver/multipleHomeUnits/mhu-closure/Makefile - testsuite/tests/driver/multipleHomeUnits/mhu-closure/mhu-closure.stderr - testsuite/tests/driver/multipleHomeUnits/mhu-closure/mhu-closure.stdout - + testsuite/tests/ghci/prog-mhu007/Makefile - + testsuite/tests/ghci/prog-mhu007/a/A.hs - + testsuite/tests/ghci/prog-mhu007/all.T - + testsuite/tests/ghci/prog-mhu007/b/B.hs - + testsuite/tests/ghci/prog-mhu007/prog-mhu007.script - + testsuite/tests/ghci/prog-mhu007/prog-mhu007.stdout - + testsuite/tests/ghci/prog-mhu007/testpkg-bar/Bar.hs - + testsuite/tests/ghci/prog-mhu007/testpkg-bar/testpkg-bar.pkg - + testsuite/tests/ghci/prog-mhu007/testpkg-foo/Foo.hs - + testsuite/tests/ghci/prog-mhu007/testpkg-foo/testpkg-foo.pkg - + testsuite/tests/ghci/prog-mhu007/unitA - + testsuite/tests/ghci/prog-mhu007/unitB - testsuite/tests/interface-stability/base-exports.stdout - testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs - testsuite/tests/interface-stability/base-exports.stdout-mingw32 - + testsuite/tests/printer/Haddock1.hs - testsuite/tests/printer/Makefile - testsuite/tests/printer/all.T - + testsuite/tests/simd/should_run/T27565.hs - + testsuite/tests/simd/should_run/T27565.stdout - testsuite/tests/simd/should_run/all.T - utils/check-exact/ExactPrint.hs - utils/check-exact/Main.hs - utils/check-exact/Parsers.hs - utils/check-exact/Transform.hs - utils/check-exact/Utils.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ad88ceb0d01859de0ad4fcf5e5cd1e… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ad88ceb0d01859de0ad4fcf5e5cd1e… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc] Pushed new branch wip/dcoutts/io-manager-io-primop-exceptions
by Duncan Coutts (＠dcoutts) 28 Aug '26

28 Aug '26

Duncan Coutts pushed new branch wip/dcoutts/io-manager-io-primop-exceptions at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/dcoutts/io-manager-io-primop-… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc] Deleted branch wip/jeltsch/stm-exception-improvements
by Wolfgang Jeltsch (＠jeltsch) 28 Aug '26

28 Aug '26

Wolfgang Jeltsch deleted branch wip/jeltsch/stm-exception-improvements at Glasgow Haskell Compiler / GHC -- You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc][wip/andreask/cfg-fix] 2 commits: Replace maybe with BlockCont type
by Andreas Klebinger (＠AndreasK) 28 Aug '26

28 Aug '26

Andreas Klebinger pushed to branch wip/andreask/cfg-fix at Glasgow Haskell Compiler / GHC Commits: 457ba7e1 by Andreas Klebinger at 2026-08-21T13:11:45+00:00 Replace maybe with BlockCont type - - - - - a0e60edd by Andreas Klebinger at 2026-08-21T17:40:46+00:00 wip: NatM approach - - - - - 3 changed files: - compiler/GHC/CmmToAsm/BlockLayout.hs - compiler/GHC/CmmToAsm/Monad.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs Changes: ===================================== compiler/GHC/CmmToAsm/BlockLayout.hs ===================================== @@ -66,6 +66,11 @@ import GHC.Types.Unique.DSM (UniqDSM) * Feed this CFG into the block layout code (`sequenceTop`) in this module. Which will then produce a code layout based on the input weights. + It's worth mentioning that instead of maintaining a CFG in the backend we + could re-create one from the assembly. But a naive version of this would lose + some essential information, like weither or not a branch is known to be + likely/unlikely. But we could get a similar effect by encoding the relevant + information directly in the instruction stream as meta instructions or similar. Note [Chain based CFG serialization] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/CmmToAsm/Monad.hs ===================================== @@ -19,7 +19,14 @@ module GHC.CmmToAsm.Monad ( addImportNat, addNodeBetweenNat, addImmediateSuccessorNat, - updateCfgNat, + getCurrentBlock, + setCurrentBlock, + currentBlock, + continueInNewBlock, + addDiamondFlow, + addCondBlock, + addColdSelfLoop, + increaseEdgeWeight, getUniqueNat, setDeltaNat, getConfig, @@ -66,11 +73,12 @@ import GHC.Types.Unique ( Unique ) import GHC.Unit.Module import GHC.Utils.Outputable (SDoc, HDoc, ppr) -import GHC.Utils.Panic (pprPanic) +import GHC.Utils.Panic (panic, pprPanic) import GHC.Utils.Monad.State.Strict (State (..), runState, state) import GHC.Utils.Misc import GHC.CmmToAsm.CFG import GHC.CmmToAsm.CFG.Weight +import GHC.Data.Unboxed (MaybeUB (..)) -- | A Native Code Generator implementation is parametrised over -- * The type of static data (typically related to 'CmmStatics') @@ -184,10 +192,13 @@ data NatM_State natm_config :: NCGConfig, natm_fileid :: DwarfFiles, natm_debug_map :: LabelMap DebugBlock, - natm_cfg :: CFG + natm_cfg :: CFG, -- ^ Having a CFG with additional information is essential for some -- operations. However we can't reconstruct all information once we -- generated instructions. So instead we update the CFG as we go. + natm_cur_block :: !(MaybeUB BlockId) + -- ^ Keep track of the current block during code generation for + -- CFG updates. Only used by backends using the CFG for code layout. } type DwarfFiles = UniqFM FastString (FastString, Int) @@ -217,6 +228,7 @@ mkNatM_State us delta config , natm_fileid = dwf , natm_debug_map = dbg , natm_cfg = cfg + , natm_cur_block = NothingUB } initNat :: NatM_State -> NatM a -> (a, NatM_State) @@ -255,6 +267,167 @@ updateCfgNat f = NatM $ \ st -> let !cfg' = f (natm_cfg st) in ((), st { natm_cfg = cfg'}) +setCurrentBlock :: BlockId -> NatM () +setCurrentBlock bid = NatM $ \ st -> ((), st { natm_cur_block = JustUB bid }) + +getCurrentBlock :: NatM (Maybe BlockId) +getCurrentBlock = NatM $ \ st -> + let !cbid = case natm_cur_block st of + JustUB bid -> Just bid + NothingUB -> Nothing + in + ( cbid, st ) + +{- Note [Updating the CFG during CodeGen] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +At the CMM level life is simple: +Blocks consist of a sequence of statements. +Control flow exists only between blocks. + +We are not so lucky for CodeGen. There we may introduce +intra-block control flow. For example we might turn a +simple ´MO_Ctz width arg` into branching code like this: + + arg_block + ╱ ╲ + left right + ╲ ╱ + cont + +We update the CFG to account for this. (See also Note [CFG based code layout]). +To do so we generally: +* Keep track of the current block in the NatM state. +* Compute code for all dependencies (arg in this case) +* Then generate the instructions for the MachOp at hand. + + If that involves branching control flow we call update the CFG + by calling one of continueInNewBlock, addCondBlock or addDiamondFlow, + which will adjust the CFG + and update the current block. +* We then return our generated instructions, and the parent expression + can use the update CFG/currentBlock to generate it's own code. +-} + +-- | The block instructions are currently being generated for. +-- +-- Panics if the current block isn't being tracked, which is a code generator +-- bug: any backend using the CFG based operations below must set the current +-- block for each basic block it starts to generate code for. +currentBlock :: HasDebugCallStack => NatM BlockId +currentBlock = NatM $ \ st -> + case natm_cur_block st of + JustUB bid -> (bid, st) + NothingUB -> panic "currentBlock: current block not tracked" + +-- | Continue/extend the current block under a new label. +-- +-- > Before: cur -> S After: cur -> cont -> S +-- +-- All cur->S edges get rewritten to cont->S. +-- @cont@ becomes the current block. +-- Returns @cur@ (the old current block). +-- +-- Use for example for self loops. See also Note [Updating the CFG during CodeGen] +continueInNewBlock :: HasDebugCallStack => BlockId -> NatM BlockId +continueInNewBlock cont = do + cur <- currentBlock + addImmediateSuccessorNat cur cont + setCurrentBlock cont + return cur + +-- | Register diamond shaped control flow. +-- +-- > Before: After: +-- > +-- > cur cur +-- > │ ╱ ╲ +-- > │ likely unlikely +-- > │ ╲ ╱ +-- > │ cont +-- > ▼ │ +-- > S ▼ +-- > S +-- +-- * All cur->S edges get rewritten to cont->S. +-- * @cont becomes the current block. +-- +-- See also Note [Updating the CFG during CodeGen] +addDiamondFlow :: HasDebugCallStack + => BlockId -- ^ the arm we expect to be taken + -> BlockId -- ^ the arm we expect not to be taken + -> BlockId -- ^ the block both arms converge on + -> NatM () +addDiamondFlow likely unlikely cont = do + weights <- getCfgWeights + cur <- continueInNewBlock cont + -- Both arms end in an unconditional jump to cont. Control never passes + -- from cur to cont directly, so we drop the edge continueInNewBlock added. + updateCfgNat ( addWeightEdge cur likely (fromIntegral $ likelyCondWeight weights) + . addWeightEdge cur unlikely (fromIntegral $ unlikelyCondWeight weights) + . addWeightEdge likely cont (fromIntegral $ uncondWeight weights) + . addWeightEdge unlikely cont (fromIntegral $ uncondWeight weights) + . delEdge cur cont ) + +-- | Register a conditional block that converges again on the same path. +-- +-- > Before: After: +-- > +-- > cur cur ────╮ +-- > │ │ │ +-- > │ │ cond_block +-- > │ │ │ +-- > │ cont ◀─╯ +-- > ▼ │ +-- > S ▼ +-- > S +-- +-- Takes a bool @is_likely@ that indicates if the new block is the likely code +-- path or not. +-- +-- @cont@ takes over the successors of the current block and becomes the +-- current block. +-- +-- See also Note [Updating the CFG during CodeGen] +addCondBlock :: HasDebugCallStack + => BlockId -- ^ the new code block + -> Bool -- ^ Is the newly given block the likely code path? + -> BlockId -- ^ the block control flow converges on + -> NatM () +addCondBlock cond_block is_likely cont = do + weights <- getCfgWeights + cur <- continueInNewBlock cont + let likely = fromIntegral (likelyCondWeight weights) + unlikely = fromIntegral (unlikelyCondWeight weights) + (w_cond, w_skip) | is_likely = (likely, unlikely) + | otherwise = (unlikely, likely) + -- This overwrites the cur -> cont edge added by continueInNewBlock, which + -- is no longer an unconditional jump now that cond_block can be taken. + updateCfgNat ( addWeightEdge cur cond_block w_cond + . addWeightEdge cur cont w_skip + . addWeightEdge cond_block cont (fromIntegral $ uncondWeight weights) ) + +-- | Register a self loop on the given block, e.g. the retry loop of a +-- cmpxchg based sequence. +-- +-- > bid ──╮ +-- > ▲ │ +-- > ╰────╯ +-- +-- The edge gets a weight of zero, which keeps it irrelevant for layout: +-- 'optimizeCFG' deliberately does not apply its back edge bonus to zero weight +-- edges, so @bid@ is not treated as the head of a hot loop. +-- +-- See also Note [Updating the CFG during CodeGen] +-- See also Note [Introducing cfg edges inside basic blocks] for some wrinkles around +-- self loops in particular. +addColdSelfLoop :: BlockId -> NatM () +addColdSelfLoop bid = updateCfgNat (addWeightEdge bid bid 0) + +-- | Allows us to bias layout towards a specific edge. +increaseEdgeWeight :: HasDebugCallStack => BlockId -> EdgeWeight -> NatM () +increaseEdgeWeight target bonus = do + cur <- currentBlock + updateCfgNat (\cfg -> adjustEdgeWeight cfg (+ bonus) cur target) + -- | Record that we added a block between `from` and `old`. addNodeBetweenNat :: BlockId -> BlockId -> BlockId -> NatM () addNodeBetweenNat from between to ===================================== compiler/GHC/CmmToAsm/X86/CodeGen.hs ===================================== @@ -47,8 +47,10 @@ import GHC.CmmToAsm.Monad , getDeltaNat, getBlockIdNat, getPicBaseNat , Reg64(..), RegCode64(..), getNewReg64, localReg64 , getPicBaseMaybeNat, getDebugBlock, getFileId - , addImmediateSuccessorNat, updateCfgNat, getConfig, getPlatform - , getCfgWeights + , getConfig, getPlatform + , setCurrentBlock, getCurrentBlock, currentBlock + , continueInNewBlock, addDiamondFlow, addCondBlock + , addColdSelfLoop, increaseEdgeWeight ) import GHC.CmmToAsm.CFG import GHC.CmmToAsm.Format @@ -216,6 +218,7 @@ basicBlockCodeGen block = do let (_, nodes, tail) = blockSplit block id = entryLabel block stmts = blockToList nodes + setCurrentBlock id -- Generate location directive dbg <- getDebugBlock (entryLabel block) loc_instrs <- case dblSourceTick =<< dbg of @@ -224,8 +227,8 @@ basicBlockCodeGen block = do let line = srcSpanStartLine span; col = srcSpanStartCol span return $ unitOL $ LOCATION fileId line col (unpackFS name) _ -> return nilOL - (mid_instrs,mid_bid) <- stmtsToInstrs id stmts - (!tail_instrs,_) <- stmtToInstrs mid_bid tail + mid_instrs <- stmtsToInstrs stmts + !tail_instrs <- stmtToInstrs tail let instrs = loc_instrs `appOL` mid_instrs `appOL` tail_instrs platform <- getPlatform return $! verifyBasicBlock platform (fromOL instrs) @@ -301,55 +304,41 @@ This resulted in two new basic blocks being inserted: jmp _c3B1 ... -Based on the Cmm we called stmtToInstrs we translated both atomic operations under -the assumption they would be placed into their Cmm basic block `c3Bf`. -However for the retry loop we introduce new labels, so this is not the case -for the second statement. -This resulted in a desync between the explicit control flow graph -we construct as a separate data type and the actual control flow graph in the code. +This is a relatively common occurance for a number of MachOps. And is, in fact, +not limited to statements but can also happen for Cmm expressions in general. +To ensure we always the basic block info around with which we can update the CFG +whenever we split up the control flow graph we keep track of that information +in the NatM state via setCurrentBlock. -Instead we now return the new basic block if a statement causes a change -in the current block and use the block for all following statements. - -For this reason genForeignCall is also split into two parts. One for calls which -*won't* change the basic blocks in which successive instructions will be -placed (since they only evaluate CmmExpr, which can only contain MachOps, which -cannot introduce basic blocks in their lowerings). A different one for calls -which *are* known to change the basic block. +This works because ultimately the control flow of those expressions and statements *does* +converge. So every expression, and every statement that wasn't a conditional branch at +the CMM level must converge in a single block. And whenver we are done generating the code +for one of those we can record the block in which it did so using setCurrentBlock. +While we could go all out and take this one step further and hoist the CFG updates fully +into NatM with combinators like `withDiamond (\left right cont -> ...)` for now we use +explicit CFG updates. -} --- See Note [Keeping track of the current block] for why --- we pass the BlockId. -stmtsToInstrs :: BlockId -- ^ Basic block these statement will start to be placed in. - -> [CmmNode O O] -- ^ Cmm Statement - -> NatM (InstrBlock, BlockId) -- ^ Resulting instruction -stmtsToInstrs bid stmts = - go bid stmts nilOL +stmtsToInstrs :: [CmmNode O O] -- ^ Cmm Statements + -> NatM InstrBlock -- ^ Resulting instructions +stmtsToInstrs stmts = + go stmts nilOL where - go bid [] instrs = return (instrs,bid) - go bid (s:stmts) instrs = do - (instrs',bid') <- stmtToInstrs bid s - -- If the statement introduced a new block, we use that one - let !newBid = fromMaybe bid bid' - go newBid stmts (instrs `appOL` instrs') - --- | `bid` refers to the current block and is used to update the CFG --- if new blocks are inserted in the control flow. --- See Note [Keeping track of the current block] for more details. -stmtToInstrs :: BlockId -- ^ Basic block this statement will start to be placed in. - -> CmmNode e x - -> NatM (InstrBlock, Maybe BlockId) - -- ^ Instructions, and bid of new block if successive - -- statements are placed in a different basic block. -stmtToInstrs bid stmt = do + go [] instrs = return instrs + go (s:stmts) instrs = do + instrs' <- stmtToInstrs s + go stmts (instrs `appOL` instrs') + +stmtToInstrs :: CmmNode e x + -> NatM InstrBlock +stmtToInstrs stmt = do is32Bit <- is32BitPlatform platform <- getPlatform case stmt of - CmmUnsafeForeignCall target result_regs args - -> genForeignCall target result_regs args bid + CmmUnsafeForeignCall target result_regs args + -> genForeignCall target result_regs args - _ -> (,Nothing) <$> case stmt of CmmComment s -> return (unitOL (COMMENT s)) CmmTick {} -> return nilOL @@ -381,8 +370,8 @@ stmtToInstrs bid stmt = do --We try to arrange blocks such that the likely branch is the fallthrough --in GHC.Cmm.ContFlowOpt. So we can assume the condition is likely false here. - CmmCondBranch arg true false _ -> genCondBranch bid true false arg - CmmSwitch arg ids -> genSwitch arg ids bid + CmmCondBranch arg true false _ -> genCondBranch true false arg + CmmSwitch arg ids -> genSwitch arg ids CmmCall { cml_target = arg , cml_args_regs = gregs } -> genJump arg (jumpRegs platform gregs) _ -> @@ -734,6 +723,8 @@ iselExpr64 (CmmMachOp (MO_Shl _) [e1,e2]) = do Reg64 rhi rlo <- getNewReg64 lbl1 <- newBlockId lbl2 <- newBlockId + -- See Note [Updating the CFG during CodeGen] + addCondBlock lbl1 False lbl2 let code = code1 `appOL` code2 ecx `appOL` @@ -764,6 +755,8 @@ iselExpr64 (CmmMachOp (MO_S_Shr _) [e1,e2]) = do Reg64 rhi rlo <- getNewReg64 lbl1 <- newBlockId lbl2 <- newBlockId + -- See Note [Updating the CFG during CodeGen] + addCondBlock lbl1 False lbl2 let code = code1 `appOL` code2 `appOL` @@ -791,6 +784,8 @@ iselExpr64 (CmmMachOp (MO_U_Shr _) [e1,e2]) = do Reg64 rhi rlo <- getNewReg64 lbl1 <- newBlockId lbl2 <- newBlockId + -- See Note [Updating the CFG during CodeGen] + addCondBlock lbl1 False lbl2 let code = code1 `appOL` code2 `appOL` @@ -4151,21 +4146,20 @@ codes are set according to the supplied comparison operation. -} genCondBranch - :: BlockId -- the source of the jump - -> BlockId -- the true branch target + :: BlockId -- the true branch target -> BlockId -- the false branch target -> CmmExpr -- the condition on which to branch -> NatM InstrBlock -- Instructions -genCondBranch bid id false expr = do +genCondBranch id false expr = do is32Bit <- is32BitPlatform - genCondBranch' is32Bit bid id false expr + genCondBranch' is32Bit id false expr -- | We return the instructions generated. -genCondBranch' :: Bool -> BlockId -> BlockId -> BlockId -> CmmExpr +genCondBranch' :: Bool -> BlockId -> BlockId -> CmmExpr -> NatM InstrBlock -genCondBranch' _ bid id false bool = do +genCondBranch' _ id false bool = do CondCode is_float cond cond_code <- getCondCode bool if not is_float then @@ -4200,7 +4194,11 @@ genCondBranch' _ bid id false bool = do JXX cond id, JXX ALWAYS false ] - updateCfgNat (\cfg -> adjustEdgeWeight cfg (+3) bid false) + + -- We can fall through the false branch. Which makes it + -- beneficial to bias code layout towards placing the + -- false target after the jump. + increaseEdgeWeight false 3 return (cond_code `appOL` code) {- Note [Introducing cfg edges inside basic blocks] @@ -4315,147 +4313,129 @@ genCondBranch' _ bid id false bool = do -- -- (If applicable) Do not fill the delay slots here; you will confuse the -- register allocator. --- --- See Note [Keeping track of the current block] for information why we need --- to take/return a block id. genForeignCall :: ForeignTarget -- ^ function to call -> [CmmFormal] -- ^ where to put the result -> [CmmActual] -- ^ arguments (of mixed type) - -> BlockId -- ^ The block we are in - -> NatM (InstrBlock, Maybe BlockId) + -> NatM InstrBlock -genForeignCall target dst args bid = do +genForeignCall target dst args = do case target of - PrimTarget prim -> genPrim bid prim dst args - ForeignTarget addr conv -> (,Nothing) <$> genCCall bid addr conv dst args + PrimTarget prim -> genPrim prim dst args + ForeignTarget addr conv -> genCCall addr conv dst args genPrim - :: BlockId -- ^ The block we are in - -> CallishMachOp -- ^ MachOp - -> [CmmFormal] -- ^ where to put the result - -> [CmmActual] -- ^ arguments (of mixed type) - -> NatM (InstrBlock, Maybe BlockId) - --- First we deal with cases which might introduce new blocks in the stream. -genPrim bid (MO_AtomicRMW width amop) [dst] [addr, n] - = genAtomicRMW bid width amop dst addr n -genPrim bid (MO_Ctz width) [dst] [src] - = genCtz bid width dst src -genPrim bid (MO_UF_Conv width) [dst] [src] - = genWordToFloat bid width dst src - --- Then we deal with cases which not introducing new blocks in the stream. -genPrim bid prim dst args - = (,Nothing) <$> genSimplePrim bid prim dst args - -genSimplePrim - :: BlockId -- ^ the block we are in - -> CallishMachOp -- ^ MachOp + :: CallishMachOp -- ^ MachOp -> [CmmFormal] -- ^ where to put the result -> [CmmActual] -- ^ arguments (of mixed type) -> NatM InstrBlock -genSimplePrim bid (MO_Memcpy align) [] [dst,src,n] = genMemCpy bid align dst src n -genSimplePrim bid (MO_Memmove align) [] [dst,src,n] = genMemMove bid align dst src n -genSimplePrim bid (MO_Memcmp align) [res] [dst,src,n] = genMemCmp bid align res dst src n -genSimplePrim bid (MO_Memset align) [] [dst,c,n] = genMemSet bid align dst c n -genSimplePrim _ MO_AcquireFence [] [] = return nilOL -- barriers compile to no code on x86/x86-64; -genSimplePrim _ MO_ReleaseFence [] [] = return nilOL -- we keep it this long in order to prevent earlier optimisations. -genSimplePrim _ MO_SeqCstFence [] [] = return $ unitOL MFENCE -genSimplePrim _ MO_Touch [] [_] = return nilOL -genSimplePrim _ (MO_Prefetch_Data n) [] [src] = genPrefetchData n src -genSimplePrim _ (MO_BSwap width) [dst] [src] = genByteSwap width dst src -genSimplePrim bid (MO_BRev width) [dst] [src] = genBitRev bid width dst src -genSimplePrim bid (MO_PopCnt width) [dst] [src] = genPopCnt bid width dst src -genSimplePrim bid (MO_Pdep width) [dst] [src,mask] = genPdep bid width dst src mask -genSimplePrim bid (MO_Pext width) [dst] [src,mask] = genPext bid width dst src mask -genSimplePrim bid (MO_Clz width) [dst] [src] = genClz bid width dst src -genSimplePrim _ (MO_AtomicRead w mo) [dst] [addr] = genAtomicRead w mo dst addr -genSimplePrim _ (MO_AtomicWrite w mo) [] [addr,val] = genAtomicWrite w mo addr val -genSimplePrim bid (MO_Cmpxchg width) [dst] [addr,old,new] = genCmpXchg bid width dst addr old new -genSimplePrim _ (MO_Xchg width) [dst] [addr, value] = genXchg width dst addr value -genSimplePrim _ (MO_AddWordC w) [r,c] [x,y] = genAddSubRetCarry w ADD_CC (const Nothing) CARRY r c x y -genSimplePrim _ (MO_SubWordC w) [r,c] [x,y] = genAddSubRetCarry w SUB_CC (const Nothing) CARRY r c x y -genSimplePrim _ (MO_AddIntC w) [r,c] [x,y] = genAddSubRetCarry w ADD_CC (Just . ADD_CC) OFLO r c x y -genSimplePrim _ (MO_SubIntC w) [r,c] [x,y] = genAddSubRetCarry w SUB_CC (const Nothing) OFLO r c x y -genSimplePrim _ (MO_Add2 w) [h,l] [x,y] = genAddWithCarry w h l x y -genSimplePrim _ (MO_U_Mul2 w) [h,l] [x,y] = genUnsignedLargeMul w h l x y -genSimplePrim _ (MO_S_Mul2 w) [c,h,l] [x,y] = genSignedLargeMul w c h l x y -genSimplePrim _ (MO_S_QuotRem w) [q,r] [x,y] = genQuotRem w True q r Nothing x y -genSimplePrim _ (MO_U_QuotRem w) [q,r] [x,y] = genQuotRem w False q r Nothing x y -genSimplePrim _ (MO_U_QuotRem2 w) [q,r] [hx,lx,y] = genQuotRem w False q r (Just hx) lx y -genSimplePrim _ MO_F32_Fabs [dst] [src] = genFloatAbs W32 dst src -genSimplePrim _ MO_F64_Fabs [dst] [src] = genFloatAbs W64 dst src -genSimplePrim _ MO_F32_Sqrt [dst] [src] = genFloatSqrt FF32 dst src -genSimplePrim _ MO_F64_Sqrt [dst] [src] = genFloatSqrt FF64 dst src -genSimplePrim bid MO_F32_Sin [dst] [src] = genLibCCall bid (fsLit "sinf") [dst] [src] -genSimplePrim bid MO_F32_Cos [dst] [src] = genLibCCall bid (fsLit "cosf") [dst] [src] -genSimplePrim bid MO_F32_Tan [dst] [src] = genLibCCall bid (fsLit "tanf") [dst] [src] -genSimplePrim bid MO_F32_Exp [dst] [src] = genLibCCall bid (fsLit "expf") [dst] [src] -genSimplePrim bid MO_F32_ExpM1 [dst] [src] = genLibCCall bid (fsLit "expm1f") [dst] [src] -genSimplePrim bid MO_F32_Log [dst] [src] = genLibCCall bid (fsLit "logf") [dst] [src] -genSimplePrim bid MO_F32_Log1P [dst] [src] = genLibCCall bid (fsLit "log1pf") [dst] [src] -genSimplePrim bid MO_F32_Asin [dst] [src] = genLibCCall bid (fsLit "asinf") [dst] [src] -genSimplePrim bid MO_F32_Acos [dst] [src] = genLibCCall bid (fsLit "acosf") [dst] [src] -genSimplePrim bid MO_F32_Atan [dst] [src] = genLibCCall bid (fsLit "atanf") [dst] [src] -genSimplePrim bid MO_F32_Sinh [dst] [src] = genLibCCall bid (fsLit "sinhf") [dst] [src] -genSimplePrim bid MO_F32_Cosh [dst] [src] = genLibCCall bid (fsLit "coshf") [dst] [src] -genSimplePrim bid MO_F32_Tanh [dst] [src] = genLibCCall bid (fsLit "tanhf") [dst] [src] -genSimplePrim bid MO_F32_Pwr [dst] [x,y] = genLibCCall bid (fsLit "powf") [dst] [x,y] -genSimplePrim bid MO_F32_Asinh [dst] [src] = genLibCCall bid (fsLit "asinhf") [dst] [src] -genSimplePrim bid MO_F32_Acosh [dst] [src] = genLibCCall bid (fsLit "acoshf") [dst] [src] -genSimplePrim bid MO_F32_Atanh [dst] [src] = genLibCCall bid (fsLit "atanhf") [dst] [src] -genSimplePrim bid MO_F64_Sin [dst] [src] = genLibCCall bid (fsLit "sin") [dst] [src] -genSimplePrim bid MO_F64_Cos [dst] [src] = genLibCCall bid (fsLit "cos") [dst] [src] -genSimplePrim bid MO_F64_Tan [dst] [src] = genLibCCall bid (fsLit "tan") [dst] [src] -genSimplePrim bid MO_F64_Exp [dst] [src] = genLibCCall bid (fsLit "exp") [dst] [src] -genSimplePrim bid MO_F64_ExpM1 [dst] [src] = genLibCCall bid (fsLit "expm1") [dst] [src] -genSimplePrim bid MO_F64_Log [dst] [src] = genLibCCall bid (fsLit "log") [dst] [src] -genSimplePrim bid MO_F64_Log1P [dst] [src] = genLibCCall bid (fsLit "log1p") [dst] [src] -genSimplePrim bid MO_F64_Asin [dst] [src] = genLibCCall bid (fsLit "asin") [dst] [src] -genSimplePrim bid MO_F64_Acos [dst] [src] = genLibCCall bid (fsLit "acos") [dst] [src] -genSimplePrim bid MO_F64_Atan [dst] [src] = genLibCCall bid (fsLit "atan") [dst] [src] -genSimplePrim bid MO_F64_Sinh [dst] [src] = genLibCCall bid (fsLit "sinh") [dst] [src] -genSimplePrim bid MO_F64_Cosh [dst] [src] = genLibCCall bid (fsLit "cosh") [dst] [src] -genSimplePrim bid MO_F64_Tanh [dst] [src] = genLibCCall bid (fsLit "tanh") [dst] [src] -genSimplePrim bid MO_F64_Pwr [dst] [x,y] = genLibCCall bid (fsLit "pow") [dst] [x,y] -genSimplePrim bid MO_F64_Asinh [dst] [src] = genLibCCall bid (fsLit "asinh") [dst] [src] -genSimplePrim bid MO_F64_Acosh [dst] [src] = genLibCCall bid (fsLit "acosh") [dst] [src] -genSimplePrim bid MO_F64_Atanh [dst] [src] = genLibCCall bid (fsLit "atanh") [dst] [src] -genSimplePrim bid MO_SuspendThread [tok] [rs,i] = genRTSCCall bid (fsLit "suspendThread") [tok] [rs,i] -genSimplePrim bid MO_ResumeThread [rs] [tok] = genRTSCCall bid (fsLit "resumeThread") [rs] [tok] -genSimplePrim bid MO_I64_Quot [dst] [x,y] = genPrimCCall bid (fsLit "hs_quotInt64") [dst] [x,y] -genSimplePrim bid MO_I64_Rem [dst] [x,y] = genPrimCCall bid (fsLit "hs_remInt64") [dst] [x,y] -genSimplePrim bid MO_W64_Quot [dst] [x,y] = genPrimCCall bid (fsLit "hs_quotWord64") [dst] [x,y] -genSimplePrim bid MO_W64_Rem [dst] [x,y] = genPrimCCall bid (fsLit "hs_remWord64") [dst] [x,y] -genSimplePrim bid (MO_VS_Quot 16 W8) [dst] [x,y] = genPrimCCall bid (fsLit "hs_quotInt8X16") [dst] [x,y] -genSimplePrim bid (MO_VS_Quot 8 W16) [dst] [x,y] = genPrimCCall bid (fsLit "hs_quotInt16X8") [dst] [x,y] -genSimplePrim bid (MO_VS_Quot 4 W32) [dst] [x,y] = genPrimCCall bid (fsLit "hs_quotInt32X4") [dst] [x,y] -genSimplePrim bid (MO_VS_Quot 2 W64) [dst] [x,y] = genPrimCCall bid (fsLit "hs_quotInt64X2") [dst] [x,y] -genSimplePrim _ op@(MO_VS_Quot {}) _ _ = pprPanic "Unsupported vector instruction for the native code generator:" (pprCallishMachOp op) -genSimplePrim bid (MO_VS_Rem 16 W8) [dst] [x,y] = genPrimCCall bid (fsLit "hs_remInt8X16") [dst] [x,y] -genSimplePrim bid (MO_VS_Rem 8 W16) [dst] [x,y] = genPrimCCall bid (fsLit "hs_remInt16X8") [dst] [x,y] -genSimplePrim bid (MO_VS_Rem 4 W32) [dst] [x,y] = genPrimCCall bid (fsLit "hs_remInt32X4") [dst] [x,y] -genSimplePrim bid (MO_VS_Rem 2 W64) [dst] [x,y] = genPrimCCall bid (fsLit "hs_remInt64X2") [dst] [x,y] -genSimplePrim _ op@(MO_VS_Rem {}) _ _ = pprPanic "Unsupported vector instruction for the native code generator:" (pprCallishMachOp op) -genSimplePrim bid (MO_VU_Quot 16 W8) [dst] [x,y] = genPrimCCall bid (fsLit "hs_quotWord8X16") [dst] [x,y] -genSimplePrim bid (MO_VU_Quot 8 W16) [dst] [x,y] = genPrimCCall bid (fsLit "hs_quotWord16X8") [dst] [x,y] -genSimplePrim bid (MO_VU_Quot 4 W32) [dst] [x,y] = genPrimCCall bid (fsLit "hs_quotWord32X4") [dst] [x,y] -genSimplePrim bid (MO_VU_Quot 2 W64) [dst] [x,y] = genPrimCCall bid (fsLit "hs_quotWord64X2") [dst] [x,y] -genSimplePrim _ op@(MO_VU_Quot {}) _ _ = pprPanic "Unsupported vector instruction for the native code generator:" (pprCallishMachOp op) -genSimplePrim bid (MO_VU_Rem 16 W8) [dst] [x,y] = genPrimCCall bid (fsLit "hs_remWord8X16") [dst] [x,y] -genSimplePrim bid (MO_VU_Rem 8 W16) [dst] [x,y] = genPrimCCall bid (fsLit "hs_remWord16X8") [dst] [x,y] -genSimplePrim bid (MO_VU_Rem 4 W32) [dst] [x,y] = genPrimCCall bid (fsLit "hs_remWord32X4") [dst] [x,y] -genSimplePrim bid (MO_VU_Rem 2 W64) [dst] [x,y] = genPrimCCall bid (fsLit "hs_remWord64X2") [dst] [x,y] -genSimplePrim _ op@(MO_VU_Rem {}) _ _ = pprPanic "Unsupported vector instruction for the native code generator:" (pprCallishMachOp op) -genSimplePrim bid MO_I64X2_Min [dst] [x,y] = genPrimCCall bid (fsLit "hs_minInt64X2") [dst] [x,y] -genSimplePrim bid MO_I64X2_Max [dst] [x,y] = genPrimCCall bid (fsLit "hs_maxInt64X2") [dst] [x,y] -genSimplePrim bid MO_W64X2_Min [dst] [x,y] = genPrimCCall bid (fsLit "hs_minWord64X2") [dst] [x,y] -genSimplePrim bid MO_W64X2_Max [dst] [x,y] = genPrimCCall bid (fsLit "hs_maxWord64X2") [dst] [x,y] -genSimplePrim _ op dst args = do +genPrim (MO_AtomicRMW width amop) [dst] [addr, n] + = genAtomicRMW width amop dst addr n +genPrim (MO_Ctz width) [dst] [src] + = genCtz width dst src +genPrim (MO_UF_Conv width) [dst] [src] + = genWordToFloat width dst src +genPrim (MO_Memcpy align) [] [dst,src,n] = genMemCpy align dst src n +genPrim (MO_Memmove align) [] [dst,src,n] = genMemMove align dst src n +genPrim (MO_Memcmp align) [res] [dst,src,n] = genMemCmp align res dst src n +genPrim (MO_Memset align) [] [dst,c,n] = genMemSet align dst c n +genPrim MO_AcquireFence [] [] = return nilOL -- barriers compile to no code on x86/x86-64; +genPrim MO_ReleaseFence [] [] = return nilOL -- we keep it this long in order to prevent earlier optimisations. +genPrim MO_SeqCstFence [] [] = return $ unitOL MFENCE +genPrim MO_Touch [] [_] = return nilOL +genPrim (MO_Prefetch_Data n) [] [src] = genPrefetchData n src +genPrim (MO_BSwap width) [dst] [src] = genByteSwap width dst src +genPrim (MO_BRev width) [dst] [src] = genBitRev width dst src +genPrim (MO_PopCnt width) [dst] [src] = genPopCnt width dst src +genPrim (MO_Pdep width) [dst] [src,mask] = genPdep width dst src mask +genPrim (MO_Pext width) [dst] [src,mask] = genPext width dst src mask +genPrim (MO_Clz width) [dst] [src] = genClz width dst src +genPrim (MO_AtomicRead w mo) [dst] [addr] = genAtomicRead w mo dst addr +genPrim (MO_AtomicWrite w mo) [] [addr,val] = genAtomicWrite w mo addr val +genPrim (MO_Cmpxchg width) [dst] [addr,old,new] = genCmpXchg width dst addr old new +genPrim (MO_Xchg width) [dst] [addr, value] = genXchg width dst addr value +genPrim (MO_AddWordC w) [r,c] [x,y] = genAddSubRetCarry w ADD_CC (const Nothing) CARRY r c x y +genPrim (MO_SubWordC w) [r,c] [x,y] = genAddSubRetCarry w SUB_CC (const Nothing) CARRY r c x y +genPrim (MO_AddIntC w) [r,c] [x,y] = genAddSubRetCarry w ADD_CC (Just . ADD_CC) OFLO r c x y +genPrim (MO_SubIntC w) [r,c] [x,y] = genAddSubRetCarry w SUB_CC (const Nothing) OFLO r c x y +genPrim (MO_Add2 w) [h,l] [x,y] = genAddWithCarry w h l x y +genPrim (MO_U_Mul2 w) [h,l] [x,y] = genUnsignedLargeMul w h l x y +genPrim (MO_S_Mul2 w) [c,h,l] [x,y] = genSignedLargeMul w c h l x y +genPrim (MO_S_QuotRem w) [q,r] [x,y] = genQuotRem w True q r Nothing x y +genPrim (MO_U_QuotRem w) [q,r] [x,y] = genQuotRem w False q r Nothing x y +genPrim (MO_U_QuotRem2 w) [q,r] [hx,lx,y] = genQuotRem w False q r (Just hx) lx y +genPrim MO_F32_Fabs [dst] [src] = genFloatAbs W32 dst src +genPrim MO_F64_Fabs [dst] [src] = genFloatAbs W64 dst src +genPrim MO_F32_Sqrt [dst] [src] = genFloatSqrt FF32 dst src +genPrim MO_F64_Sqrt [dst] [src] = genFloatSqrt FF64 dst src +genPrim MO_F32_Sin [dst] [src] = genLibCCall (fsLit "sinf") [dst] [src] +genPrim MO_F32_Cos [dst] [src] = genLibCCall (fsLit "cosf") [dst] [src] +genPrim MO_F32_Tan [dst] [src] = genLibCCall (fsLit "tanf") [dst] [src] +genPrim MO_F32_Exp [dst] [src] = genLibCCall (fsLit "expf") [dst] [src] +genPrim MO_F32_ExpM1 [dst] [src] = genLibCCall (fsLit "expm1f") [dst] [src] +genPrim MO_F32_Log [dst] [src] = genLibCCall (fsLit "logf") [dst] [src] +genPrim MO_F32_Log1P [dst] [src] = genLibCCall (fsLit "log1pf") [dst] [src] +genPrim MO_F32_Asin [dst] [src] = genLibCCall (fsLit "asinf") [dst] [src] +genPrim MO_F32_Acos [dst] [src] = genLibCCall (fsLit "acosf") [dst] [src] +genPrim MO_F32_Atan [dst] [src] = genLibCCall (fsLit "atanf") [dst] [src] +genPrim MO_F32_Sinh [dst] [src] = genLibCCall (fsLit "sinhf") [dst] [src] +genPrim MO_F32_Cosh [dst] [src] = genLibCCall (fsLit "coshf") [dst] [src] +genPrim MO_F32_Tanh [dst] [src] = genLibCCall (fsLit "tanhf") [dst] [src] +genPrim MO_F32_Pwr [dst] [x,y] = genLibCCall (fsLit "powf") [dst] [x,y] +genPrim MO_F32_Asinh [dst] [src] = genLibCCall (fsLit "asinhf") [dst] [src] +genPrim MO_F32_Acosh [dst] [src] = genLibCCall (fsLit "acoshf") [dst] [src] +genPrim MO_F32_Atanh [dst] [src] = genLibCCall (fsLit "atanhf") [dst] [src] +genPrim MO_F64_Sin [dst] [src] = genLibCCall (fsLit "sin") [dst] [src] +genPrim MO_F64_Cos [dst] [src] = genLibCCall (fsLit "cos") [dst] [src] +genPrim MO_F64_Tan [dst] [src] = genLibCCall (fsLit "tan") [dst] [src] +genPrim MO_F64_Exp [dst] [src] = genLibCCall (fsLit "exp") [dst] [src] +genPrim MO_F64_ExpM1 [dst] [src] = genLibCCall (fsLit "expm1") [dst] [src] +genPrim MO_F64_Log [dst] [src] = genLibCCall (fsLit "log") [dst] [src] +genPrim MO_F64_Log1P [dst] [src] = genLibCCall (fsLit "log1p") [dst] [src] +genPrim MO_F64_Asin [dst] [src] = genLibCCall (fsLit "asin") [dst] [src] +genPrim MO_F64_Acos [dst] [src] = genLibCCall (fsLit "acos") [dst] [src] +genPrim MO_F64_Atan [dst] [src] = genLibCCall (fsLit "atan") [dst] [src] +genPrim MO_F64_Sinh [dst] [src] = genLibCCall (fsLit "sinh") [dst] [src] +genPrim MO_F64_Cosh [dst] [src] = genLibCCall (fsLit "cosh") [dst] [src] +genPrim MO_F64_Tanh [dst] [src] = genLibCCall (fsLit "tanh") [dst] [src] +genPrim MO_F64_Pwr [dst] [x,y] = genLibCCall (fsLit "pow") [dst] [x,y] +genPrim MO_F64_Asinh [dst] [src] = genLibCCall (fsLit "asinh") [dst] [src] +genPrim MO_F64_Acosh [dst] [src] = genLibCCall (fsLit "acosh") [dst] [src] +genPrim MO_F64_Atanh [dst] [src] = genLibCCall (fsLit "atanh") [dst] [src] +genPrim MO_SuspendThread [tok] [rs,i] = genRTSCCall (fsLit "suspendThread") [tok] [rs,i] +genPrim MO_ResumeThread [rs] [tok] = genRTSCCall (fsLit "resumeThread") [rs] [tok] +genPrim MO_I64_Quot [dst] [x,y] = genPrimCCall (fsLit "hs_quotInt64") [dst] [x,y] +genPrim MO_I64_Rem [dst] [x,y] = genPrimCCall (fsLit "hs_remInt64") [dst] [x,y] +genPrim MO_W64_Quot [dst] [x,y] = genPrimCCall (fsLit "hs_quotWord64") [dst] [x,y] +genPrim MO_W64_Rem [dst] [x,y] = genPrimCCall (fsLit "hs_remWord64") [dst] [x,y] +genPrim (MO_VS_Quot 16 W8) [dst] [x,y] = genPrimCCall (fsLit "hs_quotInt8X16") [dst] [x,y] +genPrim (MO_VS_Quot 8 W16) [dst] [x,y] = genPrimCCall (fsLit "hs_quotInt16X8") [dst] [x,y] +genPrim (MO_VS_Quot 4 W32) [dst] [x,y] = genPrimCCall (fsLit "hs_quotInt32X4") [dst] [x,y] +genPrim (MO_VS_Quot 2 W64) [dst] [x,y] = genPrimCCall (fsLit "hs_quotInt64X2") [dst] [x,y] +genPrim op@(MO_VS_Quot {}) _ _ = pprPanic "Unsupported vector instruction for the native code generator:" (pprCallishMachOp op) +genPrim (MO_VS_Rem 16 W8) [dst] [x,y] = genPrimCCall (fsLit "hs_remInt8X16") [dst] [x,y] +genPrim (MO_VS_Rem 8 W16) [dst] [x,y] = genPrimCCall (fsLit "hs_remInt16X8") [dst] [x,y] +genPrim (MO_VS_Rem 4 W32) [dst] [x,y] = genPrimCCall (fsLit "hs_remInt32X4") [dst] [x,y] +genPrim (MO_VS_Rem 2 W64) [dst] [x,y] = genPrimCCall (fsLit "hs_remInt64X2") [dst] [x,y] +genPrim op@(MO_VS_Rem {}) _ _ = pprPanic "Unsupported vector instruction for the native code generator:" (pprCallishMachOp op) +genPrim (MO_VU_Quot 16 W8) [dst] [x,y] = genPrimCCall (fsLit "hs_quotWord8X16") [dst] [x,y] +genPrim (MO_VU_Quot 8 W16) [dst] [x,y] = genPrimCCall (fsLit "hs_quotWord16X8") [dst] [x,y] +genPrim (MO_VU_Quot 4 W32) [dst] [x,y] = genPrimCCall (fsLit "hs_quotWord32X4") [dst] [x,y] +genPrim (MO_VU_Quot 2 W64) [dst] [x,y] = genPrimCCall (fsLit "hs_quotWord64X2") [dst] [x,y] +genPrim op@(MO_VU_Quot {}) _ _ = pprPanic "Unsupported vector instruction for the native code generator:" (pprCallishMachOp op) +genPrim (MO_VU_Rem 16 W8) [dst] [x,y] = genPrimCCall (fsLit "hs_remWord8X16") [dst] [x,y] +genPrim (MO_VU_Rem 8 W16) [dst] [x,y] = genPrimCCall (fsLit "hs_remWord16X8") [dst] [x,y] +genPrim (MO_VU_Rem 4 W32) [dst] [x,y] = genPrimCCall (fsLit "hs_remWord32X4") [dst] [x,y] +genPrim (MO_VU_Rem 2 W64) [dst] [x,y] = genPrimCCall (fsLit "hs_remWord64X2") [dst] [x,y] +genPrim op@(MO_VU_Rem {}) _ _ = pprPanic "Unsupported vector instruction for the native code generator:" (pprCallishMachOp op) +genPrim MO_I64X2_Min [dst] [x,y] = genPrimCCall (fsLit "hs_minInt64X2") [dst] [x,y] +genPrim MO_I64X2_Max [dst] [x,y] = genPrimCCall (fsLit "hs_maxInt64X2") [dst] [x,y] +genPrim MO_W64X2_Min [dst] [x,y] = genPrimCCall (fsLit "hs_minWord64X2") [dst] [x,y] +genPrim MO_W64X2_Max [dst] [x,y] = genPrimCCall (fsLit "hs_maxWord64X2") [dst] [x,y] +genPrim op dst args = do platform <- ncgPlatform <$> getConfig - pprPanic "genSimplePrim: unhandled primop" (ppr (pprCallishMachOp op, dst, fmap (pdoc platform) args)) + pprPanic "genPrim: unhandled primop" (ppr (pprCallishMachOp op, dst, fmap (pdoc platform) args)) {- Note [Evaluate C-call arguments before placing in destination registers] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -4507,8 +4487,8 @@ genForeignCall{32,64}. -} -- | See Note [Evaluate C-call arguments before placing in destination registers] -evalArgs :: BlockId -> [CmmActual] -> NatM (InstrBlock, [CmmActual]) -evalArgs bid actuals +evalArgs :: [CmmActual] -> NatM (InstrBlock, [CmmActual]) +evalArgs actuals | any loadIntoRegMightClobberOtherReg actuals = do regs_blks <- mapM evalArg actuals return (concatOL $ map fst regs_blks, map snd regs_blks) @@ -4519,9 +4499,11 @@ evalArgs bid actuals evalArg actual = do platform <- getPlatform lreg <- newLocalReg $ cmmExprType platform actual - (instrs, bid1) <- stmtToInstrs bid $ CmmAssign (CmmLocal lreg) actual + cur <- getCurrentBlock + instrs <- stmtToInstrs $ CmmAssign (CmmLocal lreg) actual -- The above assignment shouldn't change the current block - massert (isNothing bid1) + cur' <- getCurrentBlock + massert (cur == cur') return (instrs, CmmReg $ CmmLocal lreg) newLocalReg :: CmmType -> NatM LocalReg @@ -4556,27 +4538,25 @@ loadIntoRegMightClobberOtherReg _ = True -- | Generate C call to the given function in ghc-prim genPrimCCall - :: BlockId - -> FastString + :: FastString -> [CmmFormal] -> [CmmActual] -> NatM InstrBlock -genPrimCCall bid lbl_txt dsts args = do +genPrimCCall lbl_txt dsts args = do config <- getConfig -- FIXME: we should use mkForeignLabel instead of mkCmmCodeLabel let lbl = mkCmmCodeLabel ghcInternalUnitId lbl_txt addr <- cmmMakeDynamicReference config CallReference lbl let conv = ForeignConvention CCallConv [] [] CmmMayReturn - genCCall bid addr conv dsts args + genCCall addr conv dsts args -- | Generate C call to the given function in libc genLibCCall - :: BlockId - -> FastString + :: FastString -> [CmmFormal] -> [CmmActual] -> NatM InstrBlock -genLibCCall bid lbl_txt dsts args = do +genLibCCall lbl_txt dsts args = do config <- getConfig -- Assume we can call these functions directly, and that they're not in a dynamic library. -- TODO: Why is this ok? Under linux this code will be in libm.so @@ -4584,37 +4564,35 @@ genLibCCall bid lbl_txt dsts args = do let lbl = mkForeignLabel lbl_txt ForeignLabelInThisPackage IsFunction addr <- cmmMakeDynamicReference config CallReference lbl let conv = ForeignConvention CCallConv [] [] CmmMayReturn - genCCall bid addr conv dsts args + genCCall addr conv dsts args -- | Generate C call to the given function in the RTS genRTSCCall - :: BlockId - -> FastString + :: FastString -> [CmmFormal] -> [CmmActual] -> NatM InstrBlock -genRTSCCall bid lbl_txt dsts args = do +genRTSCCall lbl_txt dsts args = do config <- getConfig -- Assume we can call these functions directly, and that they're not in a dynamic library. let lbl = mkForeignLabel lbl_txt ForeignLabelInThisPackage IsFunction addr <- cmmMakeDynamicReference config CallReference lbl let conv = ForeignConvention CCallConv [] [] CmmMayReturn - genCCall bid addr conv dsts args + genCCall addr conv dsts args -- | Generate a real C call to the given address with the given convention genCCall - :: BlockId - -> CmmExpr + :: CmmExpr -> ForeignConvention -> [CmmFormal] -> [CmmActual] -> NatM InstrBlock -genCCall bid addr conv@(ForeignConvention _ argHints _ _) dest_regs args = do +genCCall addr conv@(ForeignConvention _ argHints _ _) dest_regs args = do platform <- getPlatform is32Bit <- is32BitPlatform let args_hints = zip args (argHints ++ repeat NoHint) prom_args = map (maybePromoteCArgToW32 platform) args_hints - (instrs0, args') <- evalArgs bid prom_args + (instrs0, args') <- evalArgs prom_args instrs1 <- if is32Bit then genCCall32 addr conv dest_regs args' else genCCall64 addr conv dest_regs args' @@ -5575,8 +5553,8 @@ read the table and to compute the target address. However: -- | Generate a JMP_TBL instruction -- -- See Note [Jump tables] -genSwitch :: CmmExpr -> SwitchTargets -> BlockId -> NatM InstrBlock -genSwitch expr targets bid = do +genSwitch :: CmmExpr -> SwitchTargets -> NatM InstrBlock +genSwitch expr targets = do config <- getConfig let platform = ncgPlatform config expr_w = cmmExprWidth platform expr @@ -5595,7 +5573,6 @@ genSwitch expr targets bid = do fmt = archWordFormat is32bit table_lbl <- getNewLabelNat - let bid_lbl = blockLbl bid let table_section = Section ReadOnlyData table_lbl -- see Note [Jump tables] for a description of the following 3 variants. @@ -5607,6 +5584,9 @@ genSwitch expr targets bid = do -- way (via cmmMakeDynamicReference). (reg,e_code) <- getNonClobberedReg indexExpr -- getNonClobberedReg because it needs to survive across t_code and j_code (tableReg,t_code) <- getNonClobberedReg =<< cmmMakeDynamicReference config DataReference table_lbl + -- We make the jump table entries relative to the current block to ensure we don't + -- overflow. + bid_lbl <- blockLbl <$> currentBlock (targetReg,j_code) <- getSomeReg =<< cmmMakeDynamicReference config DataReference bid_lbl pure $ e_code `appOL` t_code `appOL` j_code `appOL` toOL [ ADD fmt (OpAddr (AddrBaseIndex (EABaseReg tableReg) (EAIndex reg (platformWordSizeInBytes platform)) (ImmInt 0))) @@ -6124,14 +6104,13 @@ invertCondBranches (Just cfg) keep bs = invert [] = [] genAtomicRMW - :: BlockId - -> Width + :: Width -> AtomicMachOp -> LocalReg -> CmmExpr -> CmmExpr - -> NatM (InstrBlock, Maybe BlockId) -genAtomicRMW bid width amop dst addr n = do + -> NatM InstrBlock +genAtomicRMW width amop dst addr n = do Amode amode addr_code <- if amop `elem` [AMO_Add, AMO_Sub] then getAmode addr @@ -6141,28 +6120,28 @@ genAtomicRMW bid width amop dst addr n = do platform <- ncgPlatform <$> getConfig let dst_r = getRegisterReg platform (CmmLocal dst) - (code, lbl) <- op_code dst_r arg amode - return (addr_code `appOL` arg_code arg `appOL` code, Just lbl) + code <- op_code dst_r arg amode + return (addr_code `appOL` arg_code arg `appOL` code) where -- Code for the operation op_code :: Reg -- Destination reg -> Reg -- Register containing argument -> AddrMode -- Address of location to mutate - -> NatM (OrdList Instr,BlockId) -- TODO: Return Maybe BlockId + -> NatM (OrdList Instr) op_code dst_r arg amode = do case amop of -- In the common case where dst_r is a virtual register the -- final move should go away, because it's the last use of arg -- and the first use of dst_r. - AMO_Add -> return $ (toOL [ LOCK (XADD format (OpReg arg) (OpAddr amode)) - , MOV format (OpReg arg) (OpReg dst_r) - ], bid) - AMO_Sub -> return $ (toOL [ NEGI format (OpReg arg) - , LOCK (XADD format (OpReg arg) (OpAddr amode)) - , MOV format (OpReg arg) (OpReg dst_r) - ], bid) - -- In these cases we need a new block id, and have to return it so - -- that later instruction selection can reference it. + AMO_Add -> return $ toOL [ LOCK (XADD format (OpReg arg) (OpAddr amode)) + , MOV format (OpReg arg) (OpReg dst_r) + ] + AMO_Sub -> return $ toOL [ NEGI format (OpReg arg) + , LOCK (XADD format (OpReg arg) (OpAddr amode)) + , MOV format (OpReg arg) (OpReg dst_r) + ] + -- In these cases we need a new block id, and set it as current block + -- so that later instruction selection can reference it. AMO_And -> cmpxchg_code (\ src dst -> unitOL $ AND format src dst) AMO_Nand -> cmpxchg_code (\ src dst -> toOL [ AND format src dst , NOT format dst @@ -6173,7 +6152,7 @@ genAtomicRMW bid width amop dst addr n = do -- Simulate operation that lacks a dedicated instruction using -- cmpxchg. cmpxchg_code :: (Operand -> Operand -> OrdList Instr) - -> NatM (OrdList Instr, BlockId) + -> NatM (OrdList Instr) cmpxchg_code instrs = do lbl1 <- getBlockIdNat lbl2 <- getBlockIdNat @@ -6182,11 +6161,12 @@ genAtomicRMW bid width amop dst addr n = do --Record inserted blocks -- We turn A -> B into A -> A' -> A'' -> B -- with a self loop on A'. - addImmediateSuccessorNat bid lbl1 - addImmediateSuccessorNat lbl1 lbl2 - updateCfgNat (addWeightEdge lbl1 lbl1 0) + -- See Note [Introducing cfg edges inside basic blocks] + _ <- continueInNewBlock lbl1 + _ <- continueInNewBlock lbl2 + addColdSelfLoop lbl1 - return $ (toOL + return $ toOL [ MOV format (OpAddr amode) (OpReg eax) , JXX ALWAYS lbl1 , NEWBLOCK lbl1 @@ -6201,27 +6181,25 @@ genAtomicRMW bid width amop dst addr n = do -- why this basic block is required. , JXX ALWAYS lbl2 , NEWBLOCK lbl2 - ], - lbl2) + ] format = intFormat width -- | Count trailing zeroes -genCtz :: BlockId -> Width -> LocalReg -> CmmExpr -> NatM (InstrBlock, Maybe BlockId) -genCtz bid width dst src = do +genCtz :: Width -> LocalReg -> CmmExpr -> NatM InstrBlock +genCtz width dst src = do is32Bit <- is32BitPlatform if is32Bit && width == W64 - then genCtz64_32 bid dst src - else (,Nothing) <$> genCtzGeneric width dst src + then genCtz64_32 dst src + else genCtzGeneric width dst src -- | Count trailing zeroes -- -- 64-bit width on 32-bit architecture genCtz64_32 - :: BlockId - -> LocalReg + :: LocalReg -> CmmExpr - -> NatM (InstrBlock, Maybe BlockId) -genCtz64_32 bid dst src = do + -> NatM InstrBlock +genCtz64_32 dst src = do RegCode64 vcode rhi rlo <- iselExpr64 src let dst_r = getLocalRegReg dst lbl1 <- getBlockIdNat @@ -6229,13 +6207,12 @@ genCtz64_32 bid dst src = do tmp_r <- getNewRegNat II64 -- New CFG Edges: - -- bid -> lbl2 - -- bid -> lbl1 -> lbl2 - -- We also changes edges originating at bid to start at lbl2 instead. - weights <- getCfgWeights - updateCfgNat (addWeightEdge bid lbl1 110 . - addWeightEdge lbl1 lbl2 110 . - addImmediateSuccessor weights bid lbl2) + -- cur -> lbl2 + -- cur -> lbl1 -> lbl2 + -- We also change edges originating at the current block to start at lbl2 + -- instead. + -- lbl1 is only skipped when src is zero, so it is the likely branch here. + addCondBlock lbl1 True lbl2 -- The following instruction sequence corresponds to the pseudo-code -- @@ -6260,7 +6237,7 @@ genCtz64_32 bid dst src = do , NEWBLOCK lbl2 ]) - return (instrs, Just lbl2) + return instrs -- | Count trailing zeroes -- @@ -6308,15 +6285,14 @@ genCtzGeneric width dst src = do -- Unroll memcpy calls if the number of bytes to copy isn't too large (cf -- ncgInlineThresholdMemcpy). Otherwise, call C's memcpy. genMemCpy - :: BlockId - -> Int + :: Int -> CmmExpr -> CmmExpr -> CmmExpr -> NatM InstrBlock -genMemCpy bid align dst src arg_n = do +genMemCpy align dst src arg_n = do - let libc_memcpy = genLibCCall bid (fsLit "memcpy") [] [dst,src,arg_n] + let libc_memcpy = genLibCCall (fsLit "memcpy") [] [dst,src,arg_n] case arg_n of CmmLit (CmmInt n _) -> do @@ -6399,15 +6375,14 @@ genMemCpyInlineMaybe align dst src n = do -- Unroll memset calls if the number of bytes to copy isn't too large (cf -- ncgInlineThresholdMemset). Otherwise, call C's memset. genMemSet - :: BlockId - -> Int + :: Int -> CmmExpr -> CmmExpr -> CmmExpr -> NatM InstrBlock -genMemSet bid align dst arg_c arg_n = do +genMemSet align dst arg_c arg_n = do - let libc_memset = genLibCCall bid (fsLit "memset") [] [dst,arg_c,arg_n] + let libc_memset = genLibCCall (fsLit "memset") [] [dst,arg_c,arg_n] case (arg_c,arg_n) of (CmmLit (CmmInt c _), CmmLit (CmmInt n _)) -> do @@ -6503,17 +6478,17 @@ genMemSetInlineMaybe align dst c n = do go4 dst_r (fromInteger n) -genMemMove :: BlockId -> p -> CmmActual -> CmmActual -> CmmActual -> NatM InstrBlock -genMemMove bid _align dst src n = do +genMemMove :: p -> CmmActual -> CmmActual -> CmmActual -> NatM InstrBlock +genMemMove _align dst src n = do -- TODO: generate inline assembly when under a given threshold (similarly to -- memcpy and memset) - genLibCCall bid (fsLit "memmove") [] [dst,src,n] + genLibCCall (fsLit "memmove") [] [dst,src,n] -genMemCmp :: BlockId -> p -> CmmFormal -> CmmActual -> CmmActual -> CmmActual -> NatM InstrBlock -genMemCmp bid _align res dst src n = do +genMemCmp :: p -> CmmFormal -> CmmActual -> CmmActual -> CmmActual -> NatM InstrBlock +genMemCmp _align res dst src n = do -- TODO: generate inline assembly when under a given threshold (similarly to -- memcpy and memset) - genLibCCall bid (fsLit "memcmp") [res] [dst,src,n] + genLibCCall (fsLit "memcmp") [res] [dst,src,n] genPrefetchData :: Int -> CmmExpr -> NatM (OrdList Instr) genPrefetchData n src = do @@ -6575,14 +6550,14 @@ genByteSwap width dst src = do code_src <- getAnyReg src return $ code_src dst_r `appOL` unitOL (BSWAP format dst_r) -genBitRev :: BlockId -> Width -> CmmFormal -> CmmActual -> NatM InstrBlock -genBitRev bid width dst src = do +genBitRev :: Width -> CmmFormal -> CmmActual -> NatM InstrBlock +genBitRev width dst src = do -- Here the C implementation (hs_bitrevN) is used as there is no x86 -- instruction to reverse a word's bit order. - genPrimCCall bid (bRevLabel width) [dst] [src] + genPrimCCall (bRevLabel width) [dst] [src] -genPopCnt :: BlockId -> Width -> LocalReg -> CmmExpr -> NatM InstrBlock -genPopCnt bid width dst src = do +genPopCnt :: Width -> LocalReg -> CmmExpr -> NatM InstrBlock +genPopCnt width dst src = do config <- getConfig let platform = ncgPlatform config @@ -6611,11 +6586,11 @@ genPopCnt bid width dst src = do -- generate C call to hs_popcntN in ghc-prim -- TODO: we could directly generate the assembly to index popcount_tab -- here instead of doing it by calling a C function - genPrimCCall bid (popCntLabel width) [dst] [src] + genPrimCCall (popCntLabel width) [dst] [src] -genPdep :: BlockId -> Width -> LocalReg -> CmmExpr -> CmmExpr -> NatM InstrBlock -genPdep bid width dst src mask = do +genPdep :: Width -> LocalReg -> CmmExpr -> CmmExpr -> NatM InstrBlock +genPdep width dst src mask = do config <- getConfig let platform = ncgPlatform config @@ -6642,11 +6617,11 @@ genPdep bid width dst src mask = do ) else -- generate C call to hs_pdepN in ghc-prim - genPrimCCall bid (pdepLabel width) [dst] [src,mask] + genPrimCCall (pdepLabel width) [dst] [src,mask] -genPext :: BlockId -> Width -> LocalReg -> CmmExpr -> CmmExpr -> NatM InstrBlock -genPext bid width dst src mask = do +genPext :: Width -> LocalReg -> CmmExpr -> CmmExpr -> NatM InstrBlock +genPext width dst src mask = do config <- getConfig if ncgBmiVersion config >= Just BMI2 then do @@ -6670,17 +6645,17 @@ genPext bid width dst src mask = do ) else -- generate C call to hs_pextN in ghc-prim - genPrimCCall bid (pextLabel width) [dst] [src,mask] + genPrimCCall (pextLabel width) [dst] [src,mask] -genClz :: BlockId -> Width -> CmmFormal -> CmmActual -> NatM InstrBlock -genClz bid width dst src = do +genClz :: Width -> CmmFormal -> CmmActual -> NatM InstrBlock +genClz width dst src = do is32Bit <- is32BitPlatform config <- getConfig if is32Bit && width == W64 then -- Fallback to `hs_clz64` on i386 - genPrimCCall bid (clzLabel width) [dst] [src] + genPrimCCall (clzLabel width) [dst] [src] else do code_src <- getAnyReg src @@ -6777,8 +6752,8 @@ The constant 65536.0 (= 0x47800000 in float32 bit-pattern) is loaded via a MOV + MOVD, avoiding a memory load. -} -genWordToFloat :: BlockId -> Width -> CmmFormal -> CmmActual -> NatM (InstrBlock, Maybe BlockId) -genWordToFloat bid width dst src = do +genWordToFloat :: Width -> CmmFormal -> CmmActual -> NatM InstrBlock +genWordToFloat width dst src = do is32Bit <- is32BitPlatform platform <- getPlatform @@ -6837,7 +6812,7 @@ genWordToFloat bid width dst src = do , ADD dstFormat (OpReg tmp_v) (OpReg dst_r) -- dst_r = float(high)*65536.0 + float(low) ] _ -> panic ("genWordToFloat: unsupported source operand format: " ++ show srcFormat) - pure (code, Nothing) + pure code else do -- See Note [Word-to-float conversion on x86-64] half_r <- getNewRegNat srcFormat @@ -6847,19 +6822,9 @@ genWordToFloat bid width dst src = do lblSmall <- getBlockIdNat lblAfter <- getBlockIdNat - -- We're building a diamond CFG: - -- bid -> lblSmall -> lblAfter -> origSucc - -- \-> lblLarge ->/ - -- addImmediateSuccessorNat moves bid's original successor to lblAfter, - -- then we fix up the other edges. - addImmediateSuccessorNat bid lblAfter -- Small values (MSB clear, i.e. < 2^63) are assumed more common in - -- practice, hence the higher weight on the lblSmall edge. - updateCfgNat ( addWeightEdge bid lblSmall 100 - . addWeightEdge bid lblLarge 50 - . addWeightEdge lblSmall lblAfter 1 - . addWeightEdge lblLarge lblAfter 1 - . delEdge bid lblAfter ) + -- practice, making lblSmall the likely branch of the diamond. + addDiamondFlow lblSmall lblLarge lblAfter let code = appOL (code_src) $ toOL @@ -6882,7 +6847,7 @@ genWordToFloat bid width dst src = do , JXX ALWAYS lblAfter , NEWBLOCK lblAfter ] - return (code, Just lblAfter) + return code genAtomicRead :: Width -> MemoryOrdering -> LocalReg -> CmmExpr -> NatM InstrBlock genAtomicRead width _mord dst addr = do @@ -6901,14 +6866,13 @@ genAtomicWrite width mord addr val = do return $ if needs_fence then code `snocOL` MFENCE else code genCmpXchg - :: BlockId - -> Width + :: Width -> LocalReg -> CmmExpr -> CmmExpr -> CmmExpr -> NatM InstrBlock -genCmpXchg bid width dst addr old new = do +genCmpXchg width dst addr old new = do is32Bit <- is32BitPlatform -- On x86 we don't have enough registers to use cmpxchg with a -- complicated addressing mode, so on that architecture we @@ -6932,7 +6896,7 @@ genCmpXchg bid width dst addr old new = do `appOL` code else -- generate C call to hs_cmpxchgN in ghc-prim - genPrimCCall bid (cmpxchgLabel width) [dst] [addr,old,new] + genPrimCCall (cmpxchgLabel width) [dst] [addr,old,new] -- TODO: implement cmpxchg8b instruction genXchg :: Width -> LocalReg -> CmmExpr -> CmmExpr -> NatM InstrBlock View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a8d57da7c14594a6a29a869e10437c… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a8d57da7c14594a6a29a869e10437c… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc][wip/ak/spec-loop] Specialise: Stop looping on recursive dictionaries in interestingDict
by Andreas Klebinger (＠AndreasK) 28 Aug '26

28 Aug '26

Andreas Klebinger pushed to branch wip/ak/spec-loop at Glasgow Haskell Compiler / GHC Commits: 1702aa29 by Andreas Klebinger at 2026-08-28T14:36:04+02:00 Specialise: Stop looping on recursive dictionaries in interestingDict interestingDict now doesn't look through loopbreaker unfoldings. Doing so would cause infinite loops on certain dictionaries. Fixes #27705. - - - - - 6 changed files: - + changelog.d/T27705 - compiler/GHC/Core/Opt/Specialise.hs - + testsuite/tests/simplCore/should_run/T27705.hs - + testsuite/tests/simplCore/should_run/T27705.stdout - + testsuite/tests/simplCore/should_run/T27705_Inst.hs - testsuite/tests/simplCore/should_run/all.T Changes: ===================================== changelog.d/T27705 ===================================== @@ -0,0 +1,5 @@ +section: compiler +synopsis: Fixed an issue that caused the specializer to sometimes loop on recursive dictionary superclasses. +issues: #27705 +mrs: !16559 + ===================================== compiler/GHC/Core/Opt/Specialise.hs ===================================== @@ -3120,8 +3120,8 @@ interestingDict :: SpecEnv -> CoreExpr -> Bool -- This is a subtle and important function -- See Note [Interesting dictionary arguments] interestingDict env (Var v) -- See (ID3) and (ID5) + -- (ID6.a) Might fail for loop breaker dicts but that seems fine. | Just rhs <- maybeUnfoldingTemplate (idUnfolding v) - -- Might fail for loop breaker dicts but that seems fine. = interestingDict env rhs interestingDict env arg -- Main Plan: use exprIsConApp_maybe @@ -3136,9 +3136,9 @@ interestingDict env arg -- Main Plan: use exprIsConApp_maybe , isIPClass cls -- See (ID5) -> False - -- Otherwise we are unwrapping a unary type class + -- Shouldn't happen. | otherwise - -> exprIsHNF arg -- See (ID7) + -> pprTraceDebug "shouldn't happen anymore" (ppr arg) $ exprIsHNF arg -- See (ID7) | Just (_, _, data_con, _tys, args) <- exprIsConApp_maybe in_scope_env arg , Just cls <- tyConClass_maybe (dataConTyCon data_con) @@ -3152,7 +3152,8 @@ interestingDict env arg -- Main Plan: use exprIsConApp_maybe where arg_ty = exprType arg definitely_not_ip_like = not (couldBeIPLike arg_ty) - in_scope_env = ISE (substInScopeSet $ se_subst env) realIdUnfolding + -- idUnfolding rather than realIdUnfolding: See (ID6.a) + in_scope_env = ISE (substInScopeSet $ se_subst env) idUnfolding {- Note [Ticks on applications] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -3268,11 +3269,27 @@ case we can clearly specialise. But there are wrinkles: (Remember: a constraint tuple is just a class with N superclasses and no methods.) See discussion on #26831. -(ID7) A unary (single-method) class is currently represented by (meth |> co). We - will unwrap the cast (see (ID5)) and then want to reply "yes" if the method - has any struture. We rather arbitrarily use `exprIsHNF` for this. (We plan a - new story for unary classes, see #23109, and this special case will become - irrelevant.) +(ID6.a) If we deal with a recursive dictionary as in #27705 we want to avoid + infinite recursion while recursing into superclasses. + + For example we might have: + + class D1 a => D2 a + class D2 a => D1 a + + The primary concern is that we want to avoid looping on recursive instances. + We can achieve this by simply not looking through loop breakers by using idUnfolding + rather than realIdUnfolding. + + It's possible that this prevents specialization of edge cases that have loop breakers + in their recursive loop. But even if we can find a dictionary like this the simplifier + won't look through loopbreaker dictionaries either killing any potential benefit. + So while we could handle this case via a already-seen set or fuel we simply don't bother + for now. + +(ID7) A unary (single-method) class is currently handled by the same path as regular dicts + since they are represented by faking a regular Dictionary. + See Note [Unary class magic] for the details. (ID8) Sadly, if `exprIsConApp_maybe` says Nothing, we still want to treat a non-trivial argument as interesting. In T19695 we have this: ===================================== testsuite/tests/simplCore/should_run/T27705.hs ===================================== @@ -0,0 +1,9 @@ +module Main where + +import T27705_Inst + +-- The dictionaries (D1/D2) are mutually recursive. We have to watch +-- out for the specializer looping on them. This was first detected in #22802 +-- but no test was added, which caused it to break again #27705 :( +main :: IO () +main = print (b (3 :: Int)) ===================================== testsuite/tests/simplCore/should_run/T27705.stdout ===================================== @@ -0,0 +1 @@ +42 ===================================== testsuite/tests/simplCore/should_run/T27705_Inst.hs ===================================== @@ -0,0 +1,13 @@ +{-# LANGUAGE UndecidableInstances, UndecidableSuperClasses, FlexibleInstances #-} +module T27705_Inst where + +-- The two dictionaries are mutually recursive, and we have to ensure the specialiser +-- doesn't loop when it's peaking through their unfoldings. +class D2 a => D1 a +class D1 a => D2 a +instance D2 Int => D1 Int +instance D1 Int => D2 Int + +{-# NOINLINE b #-} +b :: D1 a => a -> Int +b _ = 42 ===================================== testsuite/tests/simplCore/should_run/all.T ===================================== @@ -123,3 +123,5 @@ test('T24359b', normal, compile_and_run, ['-O']) test('T23429', normal, compile_and_run, ['-O']) test('T27071', normal, compile_and_run, ['-O -fworker-wrapper-cbv']) test('T27005', [], multimod_compile_and_run, ['T27005', '-O']) +test('T27705', [extra_hc_opts('+RTS -M500M -RTS')], multimod_compile_and_run, + ['T27705', '-O2 -fexpose-all-unfoldings']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1702aa29bb30b34b5be7c860b2ff88b… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1702aa29bb30b34b5be7c860b2ff88b… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 6 commits: GHCi: Fix order of `PackageDBFlag`s for interactive home unit
by Marge Bot (＠marge-bot) 28 Aug '26

28 Aug '26

Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 06fde293 by fendor at 2026-08-28T06:06:44-04:00 GHCi: Fix order of `PackageDBFlag`s for interactive home unit `PackageDBFlag`s are stored in reverse order of cli specification. When sorting the `PackageDBFlag`s by longest common prefix, we need thus to reverse the package db stacks before calculating the prefix. We make sure to reverse the package db stack for the interactive home unit to uphold that later specified package dbs overwrite earlier ones. Resolved and adds regression test for #27640 - - - - - 024c4d04 by fendor at 2026-08-28T06:07:23-04:00 Reuse the UnitIndexCache after initialising multiple home units - - - - - 55326fa0 by Alan Zimmerman at 2026-08-28T06:08:03-04:00 EPA: Some Haddock processing tweaks These changes to the Haddock postprocessing should not change behaviour, but just bring it more closely in line with the original, changed at 44309cd377f And add some haddock exactprint tests to show they work. - - - - - 0ae971c1 by Andreas Klebinger at 2026-08-28T06:47:22-04:00 hadrian: Deprecate quickest flavour. It was more of a trap for new users than actually beneficial so we deprecate it and suggest quick+no_dynamic_libs to users instead. - - - - - c270f3a2 by Andreas Klebinger at 2026-08-28T06:47:22-04:00 cmm: Always favour entry block during block deduplication. We now always keep the first block in the CmmGraph. This way we avoid the need to update the entry info table. Failing to do so caused #27722. Fixes #27722. - - - - - 1eab24e6 by Andreas Klebinger at 2026-08-28T06:47:23-04:00 test: FamAppCachePerf - Only collect bytes allocated. Fixes 27747 - - - - - 34 changed files: - changelog.d/T27202 - + changelog.d/T27722-cbe-entry-block.md - changelog.d/unit-index - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Driver/Session/Units.hs - compiler/GHC/Parser/PostProcess/Haddock.hs - ghc/GHCi/UI.hs - hadrian/README.md - hadrian/doc/cross-compile.md - hadrian/doc/flavours.md - hadrian/doc/make.md - hadrian/doc/windows.md - hadrian/hadrian.cabal - hadrian/src/CommandLine.hs - hadrian/src/Flavour.hs - hadrian/src/Settings.hs - − hadrian/src/Settings/Flavours/Quickest.hs - + testsuite/tests/ghci/prog-mhu007/Makefile - + testsuite/tests/ghci/prog-mhu007/a/A.hs - + testsuite/tests/ghci/prog-mhu007/all.T - + testsuite/tests/ghci/prog-mhu007/b/B.hs - + testsuite/tests/ghci/prog-mhu007/prog-mhu007.script - + testsuite/tests/ghci/prog-mhu007/prog-mhu007.stdout - + testsuite/tests/ghci/prog-mhu007/testpkg-bar/Bar.hs - + testsuite/tests/ghci/prog-mhu007/testpkg-bar/testpkg-bar.pkg - + testsuite/tests/ghci/prog-mhu007/testpkg-foo/Foo.hs - + testsuite/tests/ghci/prog-mhu007/testpkg-foo/testpkg-foo.pkg - + testsuite/tests/ghci/prog-mhu007/unitA - + testsuite/tests/ghci/prog-mhu007/unitB - testsuite/tests/perf/compiler/all.T - + testsuite/tests/printer/Haddock1.hs - testsuite/tests/printer/Makefile - testsuite/tests/printer/all.T - utils/ghc-toolchain/src/GHC/Toolchain/Target.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/07be45d391d4bf91805206ddb19a25… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/07be45d391d4bf91805206ddb19a25… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc][wip/mangoiv/fix-nightly-messup] nightlies: output yaml to file only
by Magnus (＠MangoIV) 28 Aug '26

28 Aug '26

Magnus pushed to branch wip/mangoiv/fix-nightly-messup at Glasgow Haskell Compiler / GHC Commits: c2cb025d by mangoiv at 2026-08-28T12:23:23+02:00 nightlies: output yaml to file only Previously we would just output the metadata to stdout which risks that it's clobbered by incidental debugt output. We now output to file only. Fixes #27511 - - - - - 2 changed files: - .gitlab-ci.yml - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py Changes: ===================================== .gitlab-ci.yml ===================================== @@ -1280,7 +1280,7 @@ ghcup-metadata-nightly: artifacts: false - job: project-version script: - - nix shell -f .gitlab/rel_eng -c ghcup-metadata --metadata ghcup-0.0.7.yaml --date="$(date -d $CI_PIPELINE_CREATED_AT +%Y-%m-%d)" --pipeline-id="$CI_PIPELINE_ID" --version="$ProjectVersion" > "metadata_test.yaml" + - nix shell -f .gitlab/rel_eng -c ghcup-metadata --metadata ghcup-0.0.7.yaml --date="$(date -d $CI_PIPELINE_CREATED_AT +%Y-%m-%d)" --pipeline-id="$CI_PIPELINE_ID" --version="$ProjectVersion" metadata_test.yaml rules: - if: $NIGHTLY ===================================== .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py ===================================== @@ -324,6 +324,7 @@ def main() -> None: # TODO: We could work out the --version from the project-version CI job. parser.add_argument('--version', required=True, type=str, help='Version of the GHC compiler') parser.add_argument('--date', required=True, type=str, help='Date of the compiler release') + parser.add_argument('output_path', nargs='?', type=Path, help='Path to write the output to, if not set, dump to stdout') args = parser.parse_args() project = gl.projects.get(1, lazy=True) @@ -352,13 +353,14 @@ def main() -> None: with open(args.metadata, 'r') as file: ghcup_metadata = yaml.safe_load(file) if args.version in ghcup_metadata['ghcupDownloads']['GHC']: - # if there are days without a commit, then the nightly metadata - # is up to date by default, no need to fail, no need to upload anything - print("Refusing to override existing version in metadata, exiting") - sys.exit() + eprint("GHCUp nightly run produced the same metadata as last night") setNightlyTags(ghcup_metadata) ghcup_metadata['ghcupDownloads']['GHC'][args.version] = new_yaml - print(yaml.dump(ghcup_metadata)) + if args.output_path: + with open(args.output_path, 'w') as ofile: + yaml.dump(ghcup_metadata, ofile) + else: + print(yaml.dump(ghcup_metadata)) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c2cb025d26572f2a2b32a930c1532f8… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c2cb025d26572f2a2b32a930c1532f8… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0