July 2025 - ghc-commits

[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 6 commits: x86 NCG: Better lowering for shuffleFloatX4# and shuffleDoubleX2#
by Marge Bot (＠marge-bot) 17 Jul '25

17 Jul '25

Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 7ee22fd5 by ARATA Mizuki at 2025-07-17T06:05:30-04:00 x86 NCG: Better lowering for shuffleFloatX4# and shuffleDoubleX2# The new implementation * make use of specialized instructions like (V)UNPCK{L,H}{PS,PD}, and * do not require -mavx. Close #26096 Co-authored-by: sheaf <sam.derbyshire(a)gmail.com> - - - - - c6cd2da1 by Jappie Klooster at 2025-07-17T06:06:20-04:00 Update interact docs to explain about buffering We need to tell the user to set to the appropriate buffer format. Otherwise, this function may get randomly stuck, or just behave confusingly. issue: https://gitlab.haskell.org/ghc/ghc/-/issues/26131 NB, I'm running this with cabal *NOT* ghci. ghci messes with buffering anyway. ```haskell interaction :: String -> String interaction "jappie" = "hi" interaction "jakob" = "hello" interaction x = "unkown input: " <> x main :: IO () main = interact interaction ``` so in my input (prefixed by `>`) I get: ``` > jappie unkown input: jappie ``` we confirmed later this was due to lack of \n matching. Anyway movnig on to more unexpected stuff: ```haskell main :: IO () main = do interact (concatMap interaction . lines) ``` get's stuck forever. actually `^D` (ctrl+d) unstucks it and runs all input as expected. for example you can get: ``` > sdfkds > fakdsf unkown input: sdfkdsunkown input: fakdsf ``` This program works! ```haskell interaction :: String -> String interaction "jappie" = "hi \n" interaction "jakob" = "hello \n" interaction x = "unkown input: " <> x <> "\n" main :: IO () main = do interact (concatMap interaction . lines) ``` the reason is that linebuffering is set for both in and output by default. so lines eats the input lines, and all the \n postfixes make sure the buffer is put out. - - - - - 9fa590a6 by Zubin Duggal at 2025-07-17T06:07:03-04:00 fetch_gitlab: Ensure we copy users_guide.pdf and Haddock.pdf to the release docs directory Fixes #24093 - - - - - 69fc6ed5 by Andrew Lelechenko at 2025-07-17T06:39:50-04:00 Add Data.List.NonEmpty.mapMaybe As per https://github.com/haskell/core-libraries-committee/issues/337 - - - - - 4ea42459 by Duncan Coutts at 2025-07-17T06:40:00-04:00 base: Deprecate GHC.Weak.Finalize.runFinalizerBatch https://github.com/haskell/core-libraries-committee/issues/342 - - - - - 6e97e52b by Alan Zimmerman at 2025-07-17T06:40:01-04:00 EPA: Update exact printing based on GHC 9.14 tests As a result of migrating the GHC ghc-9.14 branch tests to ghc-exactprint in https://github.com/alanz/ghc-exactprint/tree/ghc-9.14, a couple of discrepancies were picked up - The opening paren for a DefaultDecl was printed in the wrong place - The import declaration level specifiers were not printed. This commit adds those fixes, and some tests for them. The tests brought to light that the ImportDecl ppr instance had not been updated for level specifiers, so it updates that too. - - - - - 29 changed files: - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToAsm/X86/Instr.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs - compiler/GHC/Hs/ImpExp.hs - compiler/GHC/Parser.y - docs/users_guide/9.14.1-notes.rst - libraries/base/changelog.md - libraries/base/src/Data/List/NonEmpty.hs - libraries/base/src/GHC/Weak/Finalize.hs - libraries/ghc-internal/src/GHC/Internal/System/IO.hs - testsuite/tests/interface-stability/base-exports.stdout - testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs - testsuite/tests/interface-stability/base-exports.stdout-mingw32 - testsuite/tests/interface-stability/base-exports.stdout-ws-32 - testsuite/tests/printer/Makefile - + testsuite/tests/printer/TestLevelImports.hs - + testsuite/tests/printer/TestNamedDefaults.hs - testsuite/tests/printer/all.T - testsuite/tests/simd/should_run/all.T - + testsuite/tests/simd/should_run/doublex2_shuffle.hs - + testsuite/tests/simd/should_run/doublex2_shuffle.stdout - + testsuite/tests/simd/should_run/doublex2_shuffle_baseline.hs - + testsuite/tests/simd/should_run/doublex2_shuffle_baseline.stdout - + testsuite/tests/simd/should_run/floatx4_shuffle.hs - + testsuite/tests/simd/should_run/floatx4_shuffle.stdout - + testsuite/tests/simd/should_run/floatx4_shuffle_baseline.hs - + testsuite/tests/simd/should_run/floatx4_shuffle_baseline.stdout - utils/check-exact/ExactPrint.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/782033f310cca2eb953307ab64ada4… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/782033f310cca2eb953307ab64ada4… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] fetch_gitlab: Ensure we copy users_guide.pdf and Haddock.pdf to the release docs directory
by Marge Bot (＠marge-bot) 17 Jul '25

17 Jul '25

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 9fa590a6 by Zubin Duggal at 2025-07-17T06:07:03-04:00 fetch_gitlab: Ensure we copy users_guide.pdf and Haddock.pdf to the release docs directory Fixes #24093 - - - - - 1 changed file: - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py Changes: ===================================== .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py ===================================== @@ -134,6 +134,9 @@ def fetch_artifacts(release: str, pipeline_id: int, logging.info(f'extracted docs {f} to {dest}') index_path = destdir / 'docs' / 'index.html' index_path.replace(dest / 'index.html') + pdfs = list(destdir.glob('*.pdf')) + for f in pdfs: + f.replace(dest / f.name) elif job.name == 'hackage-doc-tarball': dest = dest_dir / 'hackage_docs' logging.info(f'moved hackage_docs to {dest}') View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9fa590a6e27545995cdcf419ed7a650… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9fa590a6e27545995cdcf419ed7a650… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] Update interact docs to explain about buffering
by Marge Bot (＠marge-bot) 17 Jul '25

17 Jul '25

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: c6cd2da1 by Jappie Klooster at 2025-07-17T06:06:20-04:00 Update interact docs to explain about buffering We need to tell the user to set to the appropriate buffer format. Otherwise, this function may get randomly stuck, or just behave confusingly. issue: https://gitlab.haskell.org/ghc/ghc/-/issues/26131 NB, I'm running this with cabal *NOT* ghci. ghci messes with buffering anyway. ```haskell interaction :: String -> String interaction "jappie" = "hi" interaction "jakob" = "hello" interaction x = "unkown input: " <> x main :: IO () main = interact interaction ``` so in my input (prefixed by `>`) I get: ``` > jappie unkown input: jappie ``` we confirmed later this was due to lack of \n matching. Anyway movnig on to more unexpected stuff: ```haskell main :: IO () main = do interact (concatMap interaction . lines) ``` get's stuck forever. actually `^D` (ctrl+d) unstucks it and runs all input as expected. for example you can get: ``` > sdfkds > fakdsf unkown input: sdfkdsunkown input: fakdsf ``` This program works! ```haskell interaction :: String -> String interaction "jappie" = "hi \n" interaction "jakob" = "hello \n" interaction x = "unkown input: " <> x <> "\n" main :: IO () main = do interact (concatMap interaction . lines) ``` the reason is that linebuffering is set for both in and output by default. so lines eats the input lines, and all the \n postfixes make sure the buffer is put out. - - - - - 1 changed file: - libraries/ghc-internal/src/GHC/Internal/System/IO.hs Changes: ===================================== libraries/ghc-internal/src/GHC/Internal/System/IO.hs ===================================== @@ -425,6 +425,21 @@ getContents' = hGetContents' stdin -- -- This operation may fail with the same errors as 'getContents' and 'putStr'. -- +-- If it doesn't produce output the buffering settings may not be +-- correct, use ^D (ctrl+D) to close stdin which forces +-- the buffer to be consumed. +-- +-- You may wish to set the buffering style appropriate to your program's +-- needs before using this function, for example: +-- +-- @ +-- main :: IO () +-- main = do +-- hSetBuffering stdin LineBuffering +-- hSetBuffering stdout NoBuffering +-- interact (concatMap (\str -> str ++ str) . L.lines) +-- @ +-- -- ==== __Examples__ -- -- >>> interact (\str -> str ++ str) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c6cd2da1343dd7f7cb8952ede849b7e… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c6cd2da1343dd7f7cb8952ede849b7e… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] x86 NCG: Better lowering for shuffleFloatX4# and shuffleDoubleX2#
by Marge Bot (＠marge-bot) 17 Jul '25

17 Jul '25

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 7ee22fd5 by ARATA Mizuki at 2025-07-17T06:05:30-04:00 x86 NCG: Better lowering for shuffleFloatX4# and shuffleDoubleX2# The new implementation * make use of specialized instructions like (V)UNPCK{L,H}{PS,PD}, and * do not require -mavx. Close #26096 Co-authored-by: sheaf <sam.derbyshire(a)gmail.com> - - - - - 13 changed files: - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToAsm/X86/Instr.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs - docs/users_guide/9.14.1-notes.rst - testsuite/tests/simd/should_run/all.T - + testsuite/tests/simd/should_run/doublex2_shuffle.hs - + testsuite/tests/simd/should_run/doublex2_shuffle.stdout - + testsuite/tests/simd/should_run/doublex2_shuffle_baseline.hs - + testsuite/tests/simd/should_run/doublex2_shuffle_baseline.stdout - + testsuite/tests/simd/should_run/floatx4_shuffle.hs - + testsuite/tests/simd/should_run/floatx4_shuffle.stdout - + testsuite/tests/simd/should_run/floatx4_shuffle_baseline.hs - + testsuite/tests/simd/should_run/floatx4_shuffle_baseline.stdout The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7ee22fd53bea1c69780613c339feee9… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7ee22fd53bea1c69780613c339feee9… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/romes/26202] 2 commits: cabal-reinstall: Pass --strict to Happy
by Rodrigo Mesquita (＠alt-romes) 17 Jul '25

17 Jul '25

Rodrigo Mesquita pushed to branch wip/romes/26202 at Glasgow Haskell Compiler / GHC Commits: addf49bb by Rodrigo Mesquita at 2025-07-17T10:38:59+01:00 cabal-reinstall: Pass --strict to Happy This is necessary to make the generated Parser build successfully This mimics Hadrian, which always passes --strict to happy. Fixes #26202 - - - - - a0aacf65 by Rodrigo Mesquita at 2025-07-17T10:39:04+01:00 genprimopcode: Require higher happy version I've bumped the happy version to forbid deprecated Happy versions which don't successfully compile. - - - - - 2 changed files: - cabal.project-reinstall - utils/genprimopcode/genprimopcode.cabal Changes: ===================================== cabal.project-reinstall ===================================== @@ -69,6 +69,8 @@ constraints: ghc +internal-interpreter +dynamic-system-linke, any.pretty installed, any.template-haskell installed +package * + happy-options: --strict benchmarks: False tests: False ===================================== utils/genprimopcode/genprimopcode.cabal ===================================== @@ -32,4 +32,4 @@ Executable genprimopcode Build-Depends: base >= 4 && < 5, array if flag(build-tool-depends) - build-tool-depends: alex:alex >= 3.2.6, happy:happy >= 1.20.0 + build-tool-depends: alex:alex >= 3.2.6, happy:happy >= 2.1.5 || == 1.20.0 || == 1.20.1.1 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/dedc53121ae97c51e7d00c5cd9e605… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/dedc53121ae97c51e7d00c5cd9e605… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/romes/26202] cabal-reinstall: Pass --strict to Happy
by Rodrigo Mesquita (＠alt-romes) 17 Jul '25

17 Jul '25

Rodrigo Mesquita pushed to branch wip/romes/26202 at Glasgow Haskell Compiler / GHC Commits: dedc5312 by Rodrigo Mesquita at 2025-07-17T10:24:28+01:00 cabal-reinstall: Pass --strict to Happy This is necessary to make the generated Parser build successfully This mimics Hadrian, which always passes --strict to happy. Fixes #26202 - - - - - 1 changed file: - cabal.project-reinstall Changes: ===================================== cabal.project-reinstall ===================================== @@ -69,6 +69,8 @@ constraints: ghc +internal-interpreter +dynamic-system-linke, any.pretty installed, any.template-haskell installed +program-default-options + happy-options: --strict benchmarks: False tests: False View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/dedc53121ae97c51e7d00c5cd9e6055… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/dedc53121ae97c51e7d00c5cd9e6055… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Pushed new branch wip/az/exactprint-updates
by Alan Zimmerman (＠alanz) 16 Jul '25

16 Jul '25

Alan Zimmerman pushed new branch wip/az/exactprint-updates at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/az/exactprint-updates You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/mapMaybe-for-nonEmpty] 16 commits: Bump win32-tarballs to v0.9
by Bodigrim (＠Bodigrim) 16 Jul '25

16 Jul '25

Bodigrim pushed to branch wip/mapMaybe-for-nonEmpty at Glasgow Haskell Compiler / GHC Commits: 73082769 by Ben Gamari at 2025-07-15T16:56:38-04:00 Bump win32-tarballs to v0.9 - - - - - 3b63b254 by Ben Gamari at 2025-07-15T16:56:39-04:00 rts/LoadArchive: Handle null terminated string tables As of `llvm-ar` now emits filename tables terminated with null characters instead of the usual POSIX `/\n` sequence. Fixes #26150. - - - - - 195f6527 by Tamar Christina at 2025-07-15T16:56:39-04:00 rts: rename label so name doesn't conflict with param - - - - - 63373b95 by Tamar Christina at 2025-07-15T16:56:39-04:00 rts: Handle API set symbol versioning conflicts - - - - - 48e9aa3e by Tamar Christina at 2025-07-15T16:56:39-04:00 rts: Mark API set symbols as HIDDEN and correct symbol type - - - - - 959e827a by Tamar Christina at 2025-07-15T16:56:39-04:00 rts: Implement WEAK EXTERNAL undef redirection by target symbol name - - - - - 65f19293 by Ben Gamari at 2025-07-15T16:56:39-04:00 rts/LoadArchive: Handle string table entries terminated with / llvm-ar appears to terminate string table entries with `/\n` [1]. This matters in the case of thin archives, since the filename is used. In the past this worked since `llvm-ar` would produce archives with "small" filenames when possible. However, now it appears to always use the string table. [1] https://github.com/llvm/llvm-project/blob/bfb686bb5ba503e9386dc899e1ebbe248… - - - - - 9cbb3ef5 by Ben Gamari at 2025-07-15T16:56:39-04:00 testsuite: Mark T12497 as fixed Thanks to the LLVM toolchain update. Closes #22694. - - - - - 2854407e by Ben Gamari at 2025-07-15T16:56:39-04:00 testsuite: Accept new output of T11223_link_order_a_b_2_fail on Windows The archive member number changed due to the fact that llvm-ar now uses a string table. - - - - - 28439593 by Ben Gamari at 2025-07-15T16:56:39-04:00 rts/linker/PEi386: Implement IMAGE_REL_AMD64_SECREL This appears to now be used by libc++ as distributed by msys2. - - - - - 2b053755 by Tamar Christina at 2025-07-15T16:56:39-04:00 rts: Cleanup merge resolution residue in lookupSymbolInDLL_PEi386 and make safe without dependent - - - - - e8acd2e7 by Wen Kokke at 2025-07-16T08:37:04-04:00 Remove the `profile_id` parameter from various RTS functions. Various RTS functions took a `profile_id` parameter, intended to be used to distinguish parallel heap profile breakdowns (e.g., `-hT` and `-hi`). However, this feature was never implemented and the `profile_id` parameter was set to 0 throughout the RTS. This commit removes the parameter but leaves the hardcoded profile ID in the functions that emit the encoded eventlog events as to not change the protocol. The affected functions are `traceHeapProfBegin`, `postHeapProfBegin`, `traceHeapProfSampleString`, `postHeapProfSampleString`, `traceHeapProfSampleCostCentre`, and `postHeapProfSampleCostCentre`. - - - - - 76d392a2 by Wen Kokke at 2025-07-16T08:37:04-04:00 Make `traceHeapProfBegin` an init event. - - - - - bbaa44a7 by Peng Fan at 2025-07-16T16:50:42-04:00 NCG/LA64: Support finer-grained DBAR hints For LA664 and newer uarchs, they have made finer granularity hints available: Bit4: ordering or completion (0: completion, 1: ordering) Bit3: barrier for previous read (0: true, 1: false) Bit2: barrier for previous write (0: true, 1: false) Bit1: barrier for succeeding read (0: true, 1: false) Bit0: barrier for succeeding write (0: true, 1: false) And not affect the existing models because other hints are treated as 'dbar 0' there. - - - - - 7da86e16 by Andreas Klebinger at 2025-07-16T16:51:25-04:00 Disable -fprof-late-overloaded-calls for join points. Currently GHC considers cost centres as destructive to join contexts. Or in other words this is not considered valid: join f x = ... in ... -> scc<tick> jmp This makes the functionality of `-fprof-late-overloaded-calls` not feasible for join points in general. We used to try to work around this by putting the ticks on the rhs of the join point rather than around the jump. However beyond the loss of accuracy this was broken for recursive join points as we ended up with something like: rec-join f x = scc<tick> ... jmp f x Which similarly is not valid as the tick once again destroys the tail call. One might think we could limit ourselves to non-recursive tail calls and do something clever like: join f x = scc<tick> ... in ... jmp f x And sometimes this works! But sometimes the full rhs would look something like: join g x = .... join f x = scc<tick> ... -> jmp g x Which, would again no longer be valid. I believe in the long run we can make cost centre ticks non-destructive to join points. Or we could keep track of where we are/are not allowed to insert a cost centre. But in the short term I will simply disable the annotation of join calls under this flag. - - - - - 547be38f by Andrew Lelechenko at 2025-07-16T23:07:34+01:00 Add Data.List.NonEmpty.mapMaybe As per https://github.com/haskell/core-libraries-committee/issues/337 - - - - - 23 changed files: - compiler/GHC/CmmToAsm/LA64/CodeGen.hs - compiler/GHC/CmmToAsm/LA64/Instr.hs - compiler/GHC/CmmToAsm/LA64/Ppr.hs - compiler/GHC/Core/LateCC/OverloadedCalls.hs - docs/users_guide/profiling.rst - libraries/base/changelog.md - libraries/base/src/Data/List/NonEmpty.hs - mk/get-win32-tarballs.py - rts/ProfHeap.c - rts/RetainerSet.c - rts/Trace.c - rts/Trace.h - rts/eventlog/EventLog.c - rts/eventlog/EventLog.h - rts/linker/LoadArchive.c - rts/linker/PEi386.c - testsuite/tests/interface-stability/base-exports.stdout - testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs - testsuite/tests/interface-stability/base-exports.stdout-mingw32 - testsuite/tests/interface-stability/base-exports.stdout-ws-32 - testsuite/tests/rts/all.T - testsuite/tests/rts/linker/T11223/T11223_link_order_a_b_2_fail.stderr-ws-32-mingw32 - testsuite/tests/rts/linker/T11223/T11223_link_order_a_b_2_fail.stderr-ws-64-mingw32 Changes: ===================================== compiler/GHC/CmmToAsm/LA64/CodeGen.hs ===================================== @@ -1910,13 +1910,12 @@ genCCall target dest_regs arg_regs = do MO_W64X2_Max -> unsupported mop -- Memory Ordering - -- A hint value of 0 is mandatory by default, and it indicates a fully functional synchronization barrier. - -- Only after all previous load/store access operations are completely executed, the DBAR 0 instruction can be executed; - -- and only after the execution of DBAR 0 is completed, all subsequent load/store access operations can be executed. - - MO_AcquireFence -> pure (unitOL (DBAR Hint0)) - MO_ReleaseFence -> pure (unitOL (DBAR Hint0)) - MO_SeqCstFence -> pure (unitOL (DBAR Hint0)) + -- Support finer-grained DBAR hints for LA664 and newer uarchs. + -- These are treated as DBAR 0 on older uarchs, so we can start + -- to unconditionally emit the new hints right away. + MO_AcquireFence -> pure (unitOL (DBAR HintAcquire)) + MO_ReleaseFence -> pure (unitOL (DBAR HintRelease)) + MO_SeqCstFence -> pure (unitOL (DBAR HintSeqcst)) MO_Touch -> pure nilOL -- Keep variables live (when using interior pointers) -- Prefetch @@ -1954,12 +1953,11 @@ genCCall target dest_regs arg_regs = do MemOrderAcquire -> toOL [ ann moDescr (LD (intFormat w) (OpReg w dst) (OpAddr $ AddrReg p)), - DBAR Hint0 + DBAR HintAcquire ] - MemOrderSeqCst -> toOL [ - ann moDescr (DBAR Hint0), - LD (intFormat w) (OpReg w dst) (OpAddr $ AddrReg p), - DBAR Hint0 + MemOrderSeqCst -> toOL [ + ann moDescr (LD (intFormat w) (OpReg w dst) (OpAddr $ AddrReg p)), + DBAR HintSeqcst ] _ -> panic $ "Unexpected MemOrderRelease on an AtomicRead: " ++ show mo dst = getRegisterReg platform (CmmLocal dst_reg) @@ -1974,15 +1972,9 @@ genCCall target dest_regs arg_regs = do (val, fmt_val, code_val) <- getSomeReg val_reg let instrs = case ord of MemOrderRelaxed -> unitOL $ ann moDescr (ST fmt_val (OpReg w val) (OpAddr $ AddrReg p)) - MemOrderRelease -> toOL [ - ann moDescr (DBAR Hint0), - ST fmt_val (OpReg w val) (OpAddr $ AddrReg p) - ] - MemOrderSeqCst -> toOL [ - ann moDescr (DBAR Hint0), - ST fmt_val (OpReg w val) (OpAddr $ AddrReg p), - DBAR Hint0 - ] + -- implement with AMSWAPDB + MemOrderRelease -> unitOL $ ann moDescr (AMSWAPDB fmt_val (OpReg w zeroReg) (OpReg w val) (OpReg w p)) + MemOrderSeqCst -> unitOL $ ann moDescr (AMSWAPDB fmt_val (OpReg w zeroReg) (OpReg w val) (OpReg w p)) _ -> panic $ "Unexpected MemOrderAcquire on an AtomicWrite" ++ show mo moDescr = (text . show) mo code = ===================================== compiler/GHC/CmmToAsm/LA64/Instr.hs ===================================== @@ -169,6 +169,7 @@ regUsageOfInstr platform instr = case instr of -- LDCOND dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) -- STCOND dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) -- 7. Atomic Memory Access Instructions -------------------------------------- + AMSWAPDB _ dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) -- 8. Barrier Instructions --------------------------------------------------- DBAR _hint -> usage ([], []) IBAR _hint -> usage ([], []) @@ -343,13 +344,13 @@ patchRegsOfInstr instr env = case instr of STX f o1 o2 -> STX f (patchOp o1) (patchOp o2) LDPTR f o1 o2 -> LDPTR f (patchOp o1) (patchOp o2) STPTR f o1 o2 -> STPTR f (patchOp o1) (patchOp o2) - PRELD o1 o2 -> PRELD (patchOp o1) (patchOp o2) + PRELD o1 o2 -> PRELD (patchOp o1) (patchOp o2) -- 6. Bound Check Memory Access Instructions --------------------------------- -- LDCOND o1 o2 o3 -> LDCOND (patchOp o1) (patchOp o2) (patchOp o3) -- STCOND o1 o2 o3 -> STCOND (patchOp o1) (patchOp o2) (patchOp o3) -- 7. Atomic Memory Access Instructions -------------------------------------- + AMSWAPDB f o1 o2 o3 -> AMSWAPDB f (patchOp o1) (patchOp o2) (patchOp o3) -- 8. Barrier Instructions --------------------------------------------------- - -- TODO: need fix DBAR o1 -> DBAR o1 IBAR o1 -> IBAR o1 -- 11. Floating Point Instructions ------------------------------------------- @@ -734,6 +735,7 @@ data Instr | PRELD Operand Operand -- 6. Bound Check Memory Access Instructions --------------------------------- -- 7. Atomic Memory Access Instructions -------------------------------------- + | AMSWAPDB Format Operand Operand Operand -- 8. Barrier Instructions --------------------------------------------------- | DBAR BarrierType | IBAR BarrierType @@ -755,8 +757,13 @@ data Instr -- fnmadd: d = - r1 * r2 - r3 | FMA FMASign Operand Operand Operand Operand --- TODO: Not complete. -data BarrierType = Hint0 +data BarrierType + = Hint0 + | Hint700 + | HintAcquire + | HintRelease + | HintSeqcst + deriving (Eq, Show) instrCon :: Instr -> String instrCon i = @@ -847,6 +854,7 @@ instrCon i = LDPTR{} -> "LDPTR" STPTR{} -> "STPTR" PRELD{} -> "PRELD" + AMSWAPDB{} -> "AMSWAPDB" DBAR{} -> "DBAR" IBAR{} -> "IBAR" FCVT{} -> "FCVT" ===================================== compiler/GHC/CmmToAsm/LA64/Ppr.hs ===================================== @@ -1015,6 +1015,10 @@ pprInstr platform instr = case instr of -- LD{GT/LE}.{B/H/W/D}, ST{GT/LE}.{B/H/W/D} -- 7. Atomic Memory Access Instructions -------------------------------------- -- AM{SWAP/ADD/AND/OR/XOR/MAX/MIN}[DB].{W/D}, AM{MAX/MIN}[_DB].{WU/DU} + AMSWAPDB II8 o1 o2 o3 -> op3 (text "\tamswap_db.b") o1 o2 o3 + AMSWAPDB II16 o1 o2 o3 -> op3 (text "\tamswap_db.h") o1 o2 o3 + AMSWAPDB II32 o1 o2 o3 -> op3 (text "\tamswap_db.w") o1 o2 o3 + AMSWAPDB II64 o1 o2 o3 -> op3 (text "\tamswap_db.d") o1 o2 o3 -- AM.{SWAP/ADD}[_DB].{B/H} -- AMCAS[_DB].{B/H/W/D} -- LL.{W/D}, SC.{W/D} @@ -1112,19 +1116,28 @@ pprInstr platform instr = case instr of op3 op o1 o2 o3 = line $ op <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3 op4 op o1 o2 o3 o4 = line $ op <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3 <> comma <+> pprOp platform o4 {- - -- TODO: Support dbar with different hints. + Support dbar with different hints. On LoongArch uses "dbar 0" (full completion barrier) for everything. But the full completion barrier has no performance to tell, so Loongson-3A6000 and newer processors have made finer granularity hints available: + Hint 0x700: barrier for "read after read" from the same address. Bit4: ordering or completion (0: completion, 1: ordering) Bit3: barrier for previous read (0: true, 1: false) Bit2: barrier for previous write (0: true, 1: false) Bit1: barrier for succeeding read (0: true, 1: false) Bit0: barrier for succeeding write (0: true, 1: false) + + DBAR 0b10100: acquire + DBAR 0b10010: release + DBAR 0b10000: seqcst -} pprBarrierType Hint0 = text "0x0" + pprBarrierType HintSeqcst = text "0x10" + pprBarrierType HintRelease = text "0x12" + pprBarrierType HintAcquire = text "0x14" + pprBarrierType Hint700 = text "0x700" floatPrecission o | isSingleOp o = text "s" | isDoubleOp o = text "d" | otherwise = pprPanic "Impossible floating point precission: " (pprOp platform o) ===================================== compiler/GHC/Core/LateCC/OverloadedCalls.hs ===================================== @@ -20,7 +20,6 @@ import GHC.Core.Make import GHC.Core.Predicate import GHC.Core.Type import GHC.Core.Utils -import GHC.Tc.Utils.TcType import GHC.Types.Id import GHC.Types.Name import GHC.Types.SrcLoc @@ -29,6 +28,41 @@ import GHC.Types.Var type OverloadedCallsCCState = Strict.Maybe SrcSpan +{- Note [Overloaded Calls and join points] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Currently GHC considers cost centres as destructive to +join contexts. Or in other words this is not considered valid: + + join f x = ... + in + ... -> scc<tick> jmp + +This makes the functionality of `-fprof-late-overloaded-calls` not feasible +for join points in general. We used to try to work around this by putting the +ticks on the rhs of the join point rather than around the jump. However beyond +the loss of accuracy this was broken for recursive join points as we ended up +with something like: + + rec-join f x = scc<tick> ... jmp f x + +Which similarly is not valid as the tick once again destroys the tail call. +One might think we could limit ourselves to non-recursive tail calls and do +something clever like: + + join f x = scc<tick> ... + in ... jmp f x + +And sometimes this works! But sometimes the full rhs would look something like: + + join g x = .... + join f x = scc<tick> ... -> jmp g x + +Which, would again no longer be valid. I believe in the long run we can make +cost centre ticks non-destructive to join points. Or we could keep track of +where we are/are not allowed to insert a cost centre. But in the short term I will +simply disable the annotation of join calls under this flag. +-} + -- | Insert cost centres on function applications with dictionary arguments. The -- source locations attached to the cost centres is approximated based on the -- "closest" source note encountered in the traversal. @@ -52,21 +86,10 @@ overloadedCallsCC = CoreBndr -> LateCCM OverloadedCallsCCState CoreExpr -> LateCCM OverloadedCallsCCState CoreExpr - wrap_if_join b pexpr = do + wrap_if_join _b pexpr = do + -- See Note [Overloaded Calls and join points] expr <- pexpr - if isJoinId b && isOverloadedTy (exprType expr) then do - let - cc_name :: FastString - cc_name = fsLit "join-rhs-" `appendFS` getOccFS b - - cc_srcspan <- - fmap (Strict.fromMaybe (UnhelpfulSpan UnhelpfulNoLocationInfo)) $ - lift $ gets lateCCState_extra - - insertCC cc_name cc_srcspan expr - else - return expr - + return expr processExpr :: CoreExpr -> LateCCM OverloadedCallsCCState CoreExpr processExpr expr = @@ -99,6 +122,7 @@ overloadedCallsCC = -- Avoid instrumenting join points. -- (See comment in processBind above) + -- Also see Note [Overloaded Calls and join points] && not (isJoinVarExpr f) then do -- Extract a name and source location from the function being ===================================== docs/users_guide/profiling.rst ===================================== @@ -571,9 +571,7 @@ of your profiled program will be different to that of the unprofiled one. Some overloaded calls may not be annotated, specifically in cases where the optimizer turns an overloaded function into a join point. Calls to such functions will not be wrapped in ``SCC`` annotations, since it would make - them non-tail calls, which is a requirement for join points. Instead, - ``SCC`` annotations are added around the body of overloaded join variables - and given distinct names (``join-rhs-<var>``) to avoid confusion. + them non-tail calls, which is a requirement for join points. .. ghc-flag:: -fprof-cafs :shortdesc: Auto-add ``SCC``\\ s to all CAFs ===================================== libraries/base/changelog.md ===================================== @@ -1,5 +1,8 @@ # Changelog for [`base` package](http://hackage.haskell.org/package/base) +## 4.23.0.0 *TBA* + * Add `Data.List.NonEmpty.mapMaybe`. ([CLC proposal #337](https://github.com/haskell/core-libraries-committee/issues/337)) + ## 4.22.0.0 *TBA* * Define `displayException` of `SomeAsyncException` to unwrap the exception. ([CLC proposal #309](https://github.com/haskell/core-libraries-committee/issues/309)) ===================================== libraries/base/src/Data/List/NonEmpty.hs ===================================== @@ -78,6 +78,7 @@ module Data.List.NonEmpty ( , span -- :: (a -> Bool) -> NonEmpty a -> ([a], [a]) , break -- :: (a -> Bool) -> NonEmpty a -> ([a], [a]) , filter -- :: (a -> Bool) -> NonEmpty a -> [a] + , mapMaybe -- :: (a -> Maybe b) -> NonEmpty a -> [b] , partition -- :: (a -> Bool) -> NonEmpty a -> ([a],[a]) , group -- :: (Foldable f, Eq a) => f a -> [NonEmpty a] , groupBy -- :: Foldable f => (a -> a -> Bool) -> f a -> [NonEmpty a] @@ -118,6 +119,7 @@ import qualified Prelude import Control.Applicative (Applicative (..), Alternative (many)) import qualified Data.List as List +import qualified Data.Maybe as List (mapMaybe) import GHC.Internal.Data.Foldable hiding (length, toList) import qualified GHC.Internal.Data.Foldable as Foldable import GHC.Internal.Data.Function (on) @@ -442,6 +444,14 @@ break p = span (not . p) filter :: (a -> Bool) -> NonEmpty a -> [a] filter p = List.filter p . toList +-- | The 'mapMaybe' function is a version of 'map' which can throw +-- out elements. In particular, the functional argument returns +-- something of type @'Maybe' b@. If this is 'Nothing', no element +-- is added on to the result list. If it is @'Just' b@, then @b@ is +-- included in the result list. +mapMaybe :: (a -> Maybe b) -> NonEmpty a -> [b] +mapMaybe f (x :| xs) = maybe id (:) (f x) $ List.mapMaybe f xs + -- | The 'partition' function takes a predicate @p@ and a stream -- @xs@, and returns a pair of lists. The first list corresponds to the -- elements of @xs@ for which @p@ holds; the second corresponds to the ===================================== mk/get-win32-tarballs.py ===================================== @@ -8,7 +8,7 @@ import argparse import sys from sys import stderr -TARBALL_VERSION = '0.8' +TARBALL_VERSION = '0.9' BASE_URL = "https://downloads.haskell.org/ghc/mingw/{}".format(TARBALL_VERSION) DEST = Path('ghc-tarballs/mingw-w64') ARCHS = ['x86_64', 'sources'] ===================================== rts/ProfHeap.c ===================================== @@ -557,7 +557,7 @@ initHeapProfiling(void) restore_locale(); - traceHeapProfBegin(0); + traceInitEvent(traceHeapProfBegin); } void @@ -896,17 +896,17 @@ dumpCensus( Census *census ) // Eventlog - traceHeapProfSampleString(0, "VOID", + traceHeapProfSampleString("VOID", (census->void_total * sizeof(W_))); - traceHeapProfSampleString(0, "LAG", + traceHeapProfSampleString("LAG", ((census->not_used - census->void_total) * sizeof(W_))); - traceHeapProfSampleString(0, "USE", + traceHeapProfSampleString("USE", ((census->used - census->drag_total) * sizeof(W_))); - traceHeapProfSampleString(0, "INHERENT_USE", + traceHeapProfSampleString("INHERENT_USE", (census->prim * sizeof(W_))); - traceHeapProfSampleString(0, "DRAG", + traceHeapProfSampleString("DRAG", (census->drag_total * sizeof(W_))); traceHeapProfSampleEnd(era); @@ -941,33 +941,33 @@ dumpCensus( Census *census ) switch (RtsFlags.ProfFlags.doHeapProfile) { case HEAP_BY_CLOSURE_TYPE: fprintf(hp_file, "%s", (char *)ctr->identity); - traceHeapProfSampleString(0, (char *)ctr->identity, + traceHeapProfSampleString((char *)ctr->identity, count * sizeof(W_)); break; case HEAP_BY_INFO_TABLE: fprintf(hp_file, "%p", ctr->identity); char str[100]; sprintf(str, "%p", ctr->identity); - traceHeapProfSampleString(0, str, count * sizeof(W_)); + traceHeapProfSampleString(str, count * sizeof(W_)); break; #if defined(PROFILING) case HEAP_BY_CCS: fprint_ccs(hp_file, (CostCentreStack *)ctr->identity, RtsFlags.ProfFlags.ccsLength); - traceHeapProfSampleCostCentre(0, (CostCentreStack *)ctr->identity, + traceHeapProfSampleCostCentre((CostCentreStack *)ctr->identity, count * sizeof(W_)); break; case HEAP_BY_ERA: fprintf(hp_file, "%" FMT_Word, (StgWord)ctr->identity); char str_era[100]; sprintf(str_era, "%" FMT_Word, (StgWord)ctr->identity); - traceHeapProfSampleString(0, str_era, count * sizeof(W_)); + traceHeapProfSampleString(str_era, count * sizeof(W_)); break; case HEAP_BY_MOD: case HEAP_BY_DESCR: case HEAP_BY_TYPE: fprintf(hp_file, "%s", (char *)ctr->identity); - traceHeapProfSampleString(0, (char *)ctr->identity, + traceHeapProfSampleString((char *)ctr->identity, count * sizeof(W_)); break; case HEAP_BY_RETAINER: ===================================== rts/RetainerSet.c ===================================== @@ -238,7 +238,7 @@ printRetainerSetShort(FILE *f, RetainerSet *rs, W_ total_size, uint32_t max_leng } } fputs(tmp, f); - traceHeapProfSampleString(0, tmp, total_size); + traceHeapProfSampleString(tmp, total_size); } /* ----------------------------------------------------------------------------- ===================================== rts/Trace.c ===================================== @@ -647,10 +647,10 @@ void traceTaskDelete_ (Task *task) } } -void traceHeapProfBegin(StgWord8 profile_id) +void traceHeapProfBegin(void) { if (eventlog_enabled) { - postHeapProfBegin(profile_id); + postHeapProfBegin(); } } void traceHeapBioProfSampleBegin(StgInt era, StgWord64 time) @@ -674,11 +674,10 @@ void traceHeapProfSampleEnd(StgInt era) } } -void traceHeapProfSampleString(StgWord8 profile_id, - const char *label, StgWord residency) +void traceHeapProfSampleString(const char *label, StgWord residency) { if (eventlog_enabled) { - postHeapProfSampleString(profile_id, label, residency); + postHeapProfSampleString(label, residency); } } @@ -718,11 +717,10 @@ void traceHeapProfCostCentre(StgWord32 ccID, } // This one is for .hp samples -void traceHeapProfSampleCostCentre(StgWord8 profile_id, - CostCentreStack *stack, StgWord residency) +void traceHeapProfSampleCostCentre(CostCentreStack *stack, StgWord residency) { if (eventlog_enabled) { - postHeapProfSampleCostCentre(profile_id, stack, residency); + postHeapProfSampleCostCentre(stack, residency); } } ===================================== rts/Trace.h ===================================== @@ -303,20 +303,18 @@ void traceTaskMigrate_ (Task *task, void traceTaskDelete_ (Task *task); -void traceHeapProfBegin(StgWord8 profile_id); +void traceHeapProfBegin(void); void traceHeapProfSampleBegin(StgInt era); void traceHeapBioProfSampleBegin(StgInt era, StgWord64 time); void traceHeapProfSampleEnd(StgInt era); -void traceHeapProfSampleString(StgWord8 profile_id, - const char *label, StgWord residency); +void traceHeapProfSampleString(const char *label, StgWord residency); #if defined(PROFILING) void traceHeapProfCostCentre(StgWord32 ccID, const char *label, const char *module, const char *srcloc, StgBool is_caf); -void traceHeapProfSampleCostCentre(StgWord8 profile_id, - CostCentreStack *stack, StgWord residency); +void traceHeapProfSampleCostCentre(CostCentreStack *stack, StgWord residency); void traceProfSampleCostCentre(Capability *cap, CostCentreStack *stack, StgWord ticks); @@ -369,14 +367,14 @@ void flushTrace(void); #define traceTaskCreate_(taskID, cap) /* nothing */ #define traceTaskMigrate_(taskID, cap, new_cap) /* nothing */ #define traceTaskDelete_(taskID) /* nothing */ -#define traceHeapProfBegin(profile_id) /* nothing */ +#define traceHeapProfBegin() /* nothing */ #define traceHeapProfCostCentre(ccID, label, module, srcloc, is_caf) /* nothing */ #define traceIPE(ipe) /* nothing */ #define traceHeapProfSampleBegin(era) /* nothing */ #define traceHeapBioProfSampleBegin(era, time) /* nothing */ #define traceHeapProfSampleEnd(era) /* nothing */ -#define traceHeapProfSampleCostCentre(profile_id, stack, residency) /* nothing */ -#define traceHeapProfSampleString(profile_id, label, residency) /* nothing */ +#define traceHeapProfSampleCostCentre(stack, residency) /* nothing */ +#define traceHeapProfSampleString(label, residency) /* nothing */ #define traceConcMarkBegin() /* nothing */ #define traceConcMarkEnd(marked_obj_count) /* nothing */ ===================================== rts/eventlog/EventLog.c ===================================== @@ -95,6 +95,13 @@ bool eventlog_enabled; // protected by state_change_mutex to ensure * buffer size, EVENT_LOG_SIZE. We must ensure that no variable-length event * exceeds this limit. For this reason we impose maximum length limits on * fields which may have unbounded values. + * + * Note [Profile ID] + * ~~~~~~~~~~~~~~~~~ + * The profile ID field of eventlog entries is reserved for future use, + * with an eye towards supporting multiple parallel heap profiles. + * In the current RTS, the profile ID is hardcoded to 0. + * */ static const EventLogWriter *event_log_writer = NULL; @@ -1219,7 +1226,7 @@ static HeapProfBreakdown getHeapProfBreakdown(void) } } -void postHeapProfBegin(StgWord8 profile_id) +void postHeapProfBegin(void) { ACQUIRE_LOCK(&eventBufMutex); PROFILING_FLAGS *flags = &RtsFlags.ProfFlags; @@ -1244,7 +1251,8 @@ void postHeapProfBegin(StgWord8 profile_id) CHECK(!ensureRoomForVariableEvent(&eventBuf, len)); postEventHeader(&eventBuf, EVENT_HEAP_PROF_BEGIN); postPayloadSize(&eventBuf, len); - postWord8(&eventBuf, profile_id); + // See Note [Profile ID]. + postWord8(&eventBuf, 0); postWord64(&eventBuf, TimeToNS(flags->heapProfileInterval)); postWord32(&eventBuf, getHeapProfBreakdown()); postStringLen(&eventBuf, flags->modSelector, modSelector_len); @@ -1286,8 +1294,7 @@ void postHeapProfSampleEnd(StgInt era) RELEASE_LOCK(&eventBufMutex); } -void postHeapProfSampleString(StgWord8 profile_id, - const char *label, +void postHeapProfSampleString(const char *label, StgWord64 residency) { ACQUIRE_LOCK(&eventBufMutex); @@ -1296,7 +1303,8 @@ void postHeapProfSampleString(StgWord8 profile_id, CHECK(!ensureRoomForVariableEvent(&eventBuf, len)); postEventHeader(&eventBuf, EVENT_HEAP_PROF_SAMPLE_STRING); postPayloadSize(&eventBuf, len); - postWord8(&eventBuf, profile_id); + // See Note [Profile ID]. + postWord8(&eventBuf, 0); postWord64(&eventBuf, residency); postStringLen(&eventBuf, label, label_len); RELEASE_LOCK(&eventBufMutex); @@ -1325,8 +1333,7 @@ void postHeapProfCostCentre(StgWord32 ccID, RELEASE_LOCK(&eventBufMutex); } -void postHeapProfSampleCostCentre(StgWord8 profile_id, - CostCentreStack *stack, +void postHeapProfSampleCostCentre(CostCentreStack *stack, StgWord64 residency) { ACQUIRE_LOCK(&eventBufMutex); @@ -1340,7 +1347,8 @@ void postHeapProfSampleCostCentre(StgWord8 profile_id, CHECK(!ensureRoomForVariableEvent(&eventBuf, len)); postEventHeader(&eventBuf, EVENT_HEAP_PROF_SAMPLE_COST_CENTRE); postPayloadSize(&eventBuf, len); - postWord8(&eventBuf, profile_id); + // See Note [Profile ID]. + postWord8(&eventBuf, 0); postWord64(&eventBuf, residency); postWord8(&eventBuf, depth); for (ccs = stack; ===================================== rts/eventlog/EventLog.h ===================================== @@ -163,14 +163,13 @@ void postTaskMigrateEvent (EventTaskId taskId, void postTaskDeleteEvent (EventTaskId taskId); -void postHeapProfBegin(StgWord8 profile_id); +void postHeapProfBegin(void); void postHeapProfSampleBegin(StgInt era); void postHeapBioProfSampleBegin(StgInt era, StgWord64 time_ns); void postHeapProfSampleEnd(StgInt era); -void postHeapProfSampleString(StgWord8 profile_id, - const char *label, +void postHeapProfSampleString(const char *label, StgWord64 residency); #if defined(PROFILING) @@ -180,8 +179,7 @@ void postHeapProfCostCentre(StgWord32 ccID, const char *srcloc, StgBool is_caf); -void postHeapProfSampleCostCentre(StgWord8 profile_id, - CostCentreStack *stack, +void postHeapProfSampleCostCentre(CostCentreStack *stack, StgWord64 residency); void postProfSampleCostCentre(Capability *cap, ===================================== rts/linker/LoadArchive.c ===================================== @@ -223,21 +223,22 @@ lookupGNUArchiveIndex(int gnuFileIndexSize, char **fileName_, char* gnuFileIndex, pathchar* path, size_t* thisFileNameSize, size_t* fileNameSize) { - int n; char *fileName = *fileName_; if (isdigit(fileName[1])) { - int i; - for (n = 2; isdigit(fileName[n]); n++) - ; - - fileName[n] = '\0'; - n = atoi(fileName + 1); if (gnuFileIndex == NULL) { errorBelch("loadArchive: GNU-variant filename " "without an index while reading from `%" PATH_FMT "'", path); return false; } + + int n; + for (n = 2; isdigit(fileName[n]); n++) + ; + + char *end; + fileName[n] = '\0'; + n = strtol(fileName + 1, &end, 10); if (n < 0 || n > gnuFileIndexSize) { errorBelch("loadArchive: GNU-variant filename " "offset %d out of range [0..%d] " @@ -245,17 +246,27 @@ lookupGNUArchiveIndex(int gnuFileIndexSize, char **fileName_, n, gnuFileIndexSize, path); return false; } - if (n != 0 && gnuFileIndex[n - 1] != '\n') { + + // Check that the previous entry ends with the expected + // end-of-string delimiter. +#if defined(mingw32_HOST_OS) +#define IS_SYMBOL_DELIMITER(STR) (STR =='\n' || STR == '\0') +#else +#define IS_SYMBOL_DELIMITER(STR) (STR =='\n') +#endif + if (n != 0 && !IS_SYMBOL_DELIMITER(gnuFileIndex[n - 1])) { errorBelch("loadArchive: GNU-variant filename offset " "%d invalid (range [0..%d]) while reading " "filename from `%" PATH_FMT "'", n, gnuFileIndexSize, path); return false; } - for (i = n; gnuFileIndex[i] != '\n'; i++) + + int i; + for (i = n; !IS_SYMBOL_DELIMITER(gnuFileIndex[i]); i++) ; - size_t FileNameSize = i - n - 1; + size_t FileNameSize = i - n; if (FileNameSize >= *fileNameSize) { /* Double it to avoid potentially continually increasing it by 1 */ @@ -264,6 +275,13 @@ lookupGNUArchiveIndex(int gnuFileIndexSize, char **fileName_, "loadArchive(fileName)"); } memcpy(fileName, gnuFileIndex + n, FileNameSize); + + + /* llvm-ar terminates string table entries with `/\n`. */ + if (fileName[FileNameSize-1] == '/') { + FileNameSize--; + } + fileName[FileNameSize] = '\0'; *thisFileNameSize = FileNameSize; } ===================================== rts/linker/PEi386.c ===================================== @@ -342,6 +342,98 @@ Finally, we enter `ocResolve`, where we resolve relocations and and allocate jump islands (using the m32 allocator for backing storage) as necessary. + Note [Windows API Set] + ~~~~~~~~~~~~~~~~~~~~~~ + Windows has a concept called API Sets [1][2] which is intended to be Windows's + equivalent to glibc's symbolic versioning. It is also used to handle the API + surface difference between different device classes. e.g. the API might be + handled differently between a desktop and tablet. + + This is handled through two mechanisms: + + 1. Direct Forward: These use import libraries to manage to first level + redirection. So what used to be in ucrt.dll is now redirected based on + ucrt.lib. Every API now points to a possible different set of API sets + each following the API set contract: + + * The name must begin either with the string api- or ext-. + * Names that begin with api- represent APIs that exist on all Windows + editions that satisfy the API's version requirements. + * Names that begin with ext- represent APIs that may not exist on all + Windows editions. + * The name must end with the sequence l<n>-<n>-<n>, where n consists of + decimal digits. + * The body of the name can be alphanumeric characters, or dashes (-). + * The name is case insensitive. + + Here are some examples of API set contract names: + + - api-ms-win-core-ums-l1-1-0 + - ext-ms-win-com-ole32-l1-1-5 + - ext-ms-win-ntuser-window-l1-1-0 + - ext-ms-win-ntuser-window-l1-1-1 + + Forward references don't require anything special from the calling + application in that the Windows loader through "LoadLibrary" will + automatically load the right reference for you if given an API set + name including the ".dll" suffix. For example: + + INFO: DLL api-ms-win-eventing-provider-l1-1-0.dll was redirected to C:\WINDOWS\SYSTEM32\kernelbase.dll by API set + INFO: DLL api-ms-win-core-apiquery-l1-1-0.dll was redirected to C:\WINDOWS\SYSTEM32\ntdll.dll by API set + INFO: DLL api-ms-win-core-processthreads-l1-1-3.dll was redirected to C:\WINDOWS\SYSTEM32\kernelbase.dll by API set + INFO: DLL api-ms-win-core-processthreads-l1-1-2.dll was redirected to C:\WINDOWS\SYSTEM32\kernelbase.dll by API set + INFO: DLL api-ms-win-core-processthreads-l1-1-1.dll was redirected to C:\WINDOWS\SYSTEM32\kernelbase.dll by API set + INFO: DLL api-ms-win-core-processthreads-l1-1-0.dll was redirected to C:\WINDOWS\SYSTEM32\kernelbase.dll by API set + INFO: DLL api-ms-win-core-registry-l1-1-0.dll was redirected to C:\WINDOWS\SYSTEM32\kernelbase.dll by API set + INFO: DLL api-ms-win-core-heap-l1-1-0.dll was redirected to C:\WINDOWS\SYSTEM32\kernelbase.dll by API set + INFO: DLL api-ms-win-core-heap-l2-1-0.dll was redirected to C:\WINDOWS\SYSTEM32\kernelbase.dll by API set + INFO: DLL api-ms-win-core-memory-l1-1-1.dll was redirected to C:\WINDOWS\SYSTEM32\kernelbase.dll by API set + INFO: DLL api-ms-win-core-memory-l1-1-0.dll was redirected to C:\WINDOWS\SYSTEM32\kernelbase.dll by API set + INFO: DLL api-ms-win-core-memory-l1-1-2.dll was redirected to C:\WINDOWS\SYSTEM32\kernelbase.dll by API set + INFO: DLL api-ms-win-core-handle-l1-1-0.dll was redirected to C:\WINDOWS\SYSTEM32\kernelbase.dll by API set + + Which shows how the loader has redirected some of the references used + by ghci. + + Historically though we've treated shared libs lazily. We would load\ + the shared library, but not resolve the symbol immediately and wait until + the symbol is requested to iterate in order through the shared libraries. + + This assumes that you ever only had one version of a symbol. i.e. we had + an assumption that all exported symbols in different shared libraries + should be the same, because most of the time they come from re-exporting + from a base library. This is a bit of a weak assumption and doesn't hold + with API Sets. + + For that reason the loader now resolves symbols immediately, and because + we now resolve using BIND_NOW we must make sure that a symbol loaded + through an OC has precedent because the BIND_NOW refernce was not asked + for. For that reason we load the symbols for API sets with the + SYM_TYPE_DUP_DISCARD flag set. + + 2. Reverse forwarders: This is when the application has a direct reference + to the old name of an API. e.g. if GHC still used "msvcrt.dll" or + "ucrt.dll" we would have had to deal with this case. In this case the + loader intercepts the call and if it exists the dll is loaded. There is + an extra indirection as you go from foo.dll => api-ms-foo-1.dll => foo_imp.dll + + But if the API doesn't exist on the device it's resolved to a stub in the + API set that if called will result in an error should it be called [3]. + + This means that usages of GetProcAddress and LoadLibrary to check for the + existance of a function aren't safe, because they'll always succeed, but may + result in a pointer to the stub rather than the actual function. + + WHat does this mean for the RTS linker? Nothing. We don't have a fallback + for if the function doesn't exist. The RTS is merely just executing what + it was told to run. It's writers of libraries that have to be careful when + doing dlopen()/LoadLibrary. + + + [1] https://learn.microsoft.com/en-us/windows/win32/apiindex/windows-apisets + [2] https://mingwpy.github.io/ucrt.html#api-set-implementation + [3] https://learn.microsoft.com/en-us/windows/win32/apiindex/detect-api-set-ava… + */ #include "Rts.h" @@ -882,7 +974,7 @@ addDLL_PEi386( const pathchar *dll_name, HINSTANCE *loaded ) goto error; } } else { - goto loaded; /* We're done. DLL has been loaded. */ + goto loaded_ok; /* We're done. DLL has been loaded. */ } } } @@ -890,7 +982,7 @@ addDLL_PEi386( const pathchar *dll_name, HINSTANCE *loaded ) // We failed to load goto error; -loaded: +loaded_ok: addLoadedDll(&loaded_dll_cache, dll_name, instance); addDLLHandle(buf, instance); if (loaded) { @@ -1055,7 +1147,8 @@ bool checkAndLoadImportLibrary( pathchar* arch_name, char* member_name, FILE* f // We must call `addDLL_PEi386` directly rather than `addDLL` because `addDLL` // is now a wrapper around `loadNativeObj` which acquires a lock which we // already have here. - const char* result = addDLL_PEi386(dll, NULL); + HINSTANCE instance; + const char* result = addDLL_PEi386(dll, &instance); stgFree(image); @@ -1069,6 +1162,28 @@ bool checkAndLoadImportLibrary( pathchar* arch_name, char* member_name, FILE* f } stgFree(dll); + + // See Note [Windows API Set] + // We must immediately tie the symbol to the shared library. The easiest + // way is to load the symbol immediately. We already have all the + // information so might as well + SymbolAddr* sym = lookupSymbolInDLL_PEi386 (symbol, instance, dll, NULL); + + // Could be an import descriptor etc, skip if no symbol. + if (!sym) + return true; + + // The symbol must have been found, and we can add it to the RTS symbol table + IF_DEBUG(linker, debugBelch("checkAndLoadImportLibrary: resolved symbol %s to %p\n", symbol, sym)); + // Because the symbol has been loaded before we actually need it, if a + // stronger reference wants to add a duplicate we should discard this + // one to preserve link order. + SymType symType = SYM_TYPE_DUP_DISCARD | SYM_TYPE_HIDDEN; + symType |= hdr.Type == IMPORT_OBJECT_CODE ? SYM_TYPE_CODE : SYM_TYPE_DATA; + + if (!ghciInsertSymbolTable(dll, symhash, symbol, sym, false, symType, NULL)) + return false; + return true; } @@ -1198,7 +1313,7 @@ lookupSymbolInDLL_PEi386 ( const SymbolName* lbl, HINSTANCE instance, pathchar* it generates call *__imp_foo, and __imp_foo here has exactly the same semantics as in __imp_foo = GetProcAddress(..., "foo") */ - if (sym == NULL && strncmp (lbl, "__imp_", 6) == 0) { + if (sym == NULL && dependent && strncmp (lbl, "__imp_", 6) == 0) { sym = GetProcAddress(instance, lbl + 6); if (sym != NULL) { @@ -1214,12 +1329,6 @@ lookupSymbolInDLL_PEi386 ( const SymbolName* lbl, HINSTANCE instance, pathchar* } } - sym = GetProcAddress(instance, lbl); - if (sym != NULL) { - /*debugBelch("found %s in %s\n", lbl,dll_name);*/ - return sym; - } - return NULL; } @@ -1821,6 +1930,27 @@ ocGetNames_PEi386 ( ObjectCode* oc ) } if(NULL != targetSection) addr = (SymbolAddr*) ((size_t) targetSection->start + getSymValue(info, targetSym)); + else + { + // Do the symbol lookup based on name, this follows Microsoft's weak external's + // format 3 specifications. Example header generated: + // api-ms-win-crt-stdio-l1-1-0.dll: file format pe-x86-64 + // + // SYMBOL TABLE: + // [ 0](sec -1)(fl 0x00)(ty 0)(scl 3) (nx 0) 0x0000000000000000 @comp.id + // [ 1](sec -1)(fl 0x00)(ty 0)(scl 3) (nx 0) 0x0000000000000000 @feat.00 + // [ 2](sec 0)(fl 0x00)(ty 0)(scl 2) (nx 0) 0x0000000000000000 _write + // [ 3](sec 0)(fl 0x00)(ty 0)(scl 105) (nx 1) 0x0000000000000000 write + // AUX lnno 3 size 0x0 tagndx 2 + // + // https://learn.microsoft.com/en-us/windows/win32/debug/pe-format#auxiliary-f… + SymbolName *target_sname = get_sym_name (getSymShortName (info, targetSym), oc); + if (target_sname) + addr = lookupSymbol_PEi386 (target_sname, oc, &type); + + IF_DEBUG(linker, debugBelch("weak external symbol @ %s => %s resolved to %p\n", \ + sname, target_sname, addr)); + } } else if ( secNumber == IMAGE_SYM_UNDEFINED && symValue > 0) { /* This symbol isn't in any section at all, ie, global bss. @@ -2115,6 +2245,13 @@ ocResolve_PEi386 ( ObjectCode* oc ) *(uint64_t *)pP = S + A; break; } + case 11: /* IMAGE_REL_AMD64_SECREL (PE constant 11) */ + { + uint64_t offset = S - (uint64_t) section.start; + CHECK((uint32_t) offset == offset); + *(uint32_t *)pP = offset + A; + break; + } case 2: /* R_X86_64_32 (ELF constant 10) - IMAGE_REL_AMD64_ADDR32 (PE constant 2) */ case 3: /* IMAGE_REL_AMD64_ADDR32NB (PE constant 3) */ case 17: /* R_X86_64_32S ELF constant, no PE mapping. See note [ELF constant in PE file] */ ===================================== testsuite/tests/interface-stability/base-exports.stdout ===================================== @@ -1467,6 +1467,7 @@ module Data.List.NonEmpty where last :: forall a. NonEmpty a -> a length :: forall a. NonEmpty a -> GHC.Internal.Types.Int map :: forall a b. (a -> b) -> NonEmpty a -> NonEmpty b + mapMaybe :: forall a b. (a -> GHC.Internal.Maybe.Maybe b) -> NonEmpty a -> [b] nonEmpty :: forall a. [a] -> GHC.Internal.Maybe.Maybe (NonEmpty a) nub :: forall a. GHC.Internal.Classes.Eq a => NonEmpty a -> NonEmpty a nubBy :: forall a. (a -> a -> GHC.Internal.Types.Bool) -> NonEmpty a -> NonEmpty a ===================================== testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs ===================================== @@ -1467,6 +1467,7 @@ module Data.List.NonEmpty where last :: forall a. NonEmpty a -> a length :: forall a. NonEmpty a -> GHC.Internal.Types.Int map :: forall a b. (a -> b) -> NonEmpty a -> NonEmpty b + mapMaybe :: forall a b. (a -> GHC.Internal.Maybe.Maybe b) -> NonEmpty a -> [b] nonEmpty :: forall a. [a] -> GHC.Internal.Maybe.Maybe (NonEmpty a) nub :: forall a. GHC.Internal.Classes.Eq a => NonEmpty a -> NonEmpty a nubBy :: forall a. (a -> a -> GHC.Internal.Types.Bool) -> NonEmpty a -> NonEmpty a ===================================== testsuite/tests/interface-stability/base-exports.stdout-mingw32 ===================================== @@ -1467,6 +1467,7 @@ module Data.List.NonEmpty where last :: forall a. NonEmpty a -> a length :: forall a. NonEmpty a -> GHC.Internal.Types.Int map :: forall a b. (a -> b) -> NonEmpty a -> NonEmpty b + mapMaybe :: forall a b. (a -> GHC.Internal.Maybe.Maybe b) -> NonEmpty a -> [b] nonEmpty :: forall a. [a] -> GHC.Internal.Maybe.Maybe (NonEmpty a) nub :: forall a. GHC.Internal.Classes.Eq a => NonEmpty a -> NonEmpty a nubBy :: forall a. (a -> a -> GHC.Internal.Types.Bool) -> NonEmpty a -> NonEmpty a ===================================== testsuite/tests/interface-stability/base-exports.stdout-ws-32 ===================================== @@ -1467,6 +1467,7 @@ module Data.List.NonEmpty where last :: forall a. NonEmpty a -> a length :: forall a. NonEmpty a -> GHC.Internal.Types.Int map :: forall a b. (a -> b) -> NonEmpty a -> NonEmpty b + mapMaybe :: forall a b. (a -> GHC.Internal.Maybe.Maybe b) -> NonEmpty a -> [b] nonEmpty :: forall a. [a] -> GHC.Internal.Maybe.Maybe (NonEmpty a) nub :: forall a. GHC.Internal.Classes.Eq a => NonEmpty a -> NonEmpty a nubBy :: forall a. (a -> a -> GHC.Internal.Types.Bool) -> NonEmpty a -> NonEmpty a ===================================== testsuite/tests/rts/all.T ===================================== @@ -426,9 +426,7 @@ test('T10296b', [only_ways(['threaded2'])], compile_and_run, ['']) test('numa001', [ extra_run_opts('8'), unless(unregisterised(), extra_ways(['debug_numa'])), req_ghc_with_threaded_rts ] , compile_and_run, ['']) -test('T12497', [ unless(opsys('mingw32'), skip), expect_broken(22694) - ], - makefile_test, ['T12497']) +test('T12497', unless(opsys('mingw32'), skip), makefile_test, ['T12497']) test('T13617', [ unless(opsys('mingw32'), skip)], makefile_test, ['T13617']) ===================================== testsuite/tests/rts/linker/T11223/T11223_link_order_a_b_2_fail.stderr-ws-32-mingw32 ===================================== @@ -3,7 +3,7 @@ GHC runtime linker: fatal error: I found a duplicate definition for symbol whilst processing object file E:\ghc-dev\msys64\home\Tamar\ghc\testsuite\tests\rts\T11223\T11223_link_order_a_b_2_fail.run\libfoo_link_lib_3.a The symbol was previously defined in - E:\ghc-dev\msys64\home\Tamar\ghc\testsuite\tests\rts\T11223\T11223_link_order_a_b_2_fail.run\libbar_link_lib_3.a(#2:bar_link_lib_3.o) + E:\ghc-dev\msys64\home\Tamar\ghc\testsuite\tests\rts\T11223\T11223_link_order_a_b_2_fail.run\libbar_link_lib_3.a(#3:bar_link_lib_3.o) This could be caused by: * Loading two different object files which export the same symbol * Specifying the same object file twice on the GHCi command line ===================================== testsuite/tests/rts/linker/T11223/T11223_link_order_a_b_2_fail.stderr-ws-64-mingw32 ===================================== @@ -3,7 +3,7 @@ GHC runtime linker: fatal error: I found a duplicate definition for symbol whilst processing object file E:\ghc-dev\msys64\home\Tamar\ghc\testsuite\tests\rts\T11223\T11223_link_order_a_b_2_fail.run\libfoo_link_lib_3.a The symbol was previously defined in - E:\ghc-dev\msys64\home\Tamar\ghc\testsuite\tests\rts\T11223\T11223_link_order_a_b_2_fail.run\libbar_link_lib_3.a(#2:bar_link_lib_3.o) + E:\ghc-dev\msys64\home\Tamar\ghc\testsuite\tests\rts\T11223\T11223_link_order_a_b_2_fail.run\libbar_link_lib_3.a(#3:bar_link_lib_3.o) This could be caused by: * Loading two different object files which export the same symbol * Specifying the same object file twice on the GHCi command line View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ca9801eb27c2712f29b031505d6878… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ca9801eb27c2712f29b031505d6878… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/T23162-spj] Comments only [skip ci]
by Simon Peyton Jones (＠simonpj) 16 Jul '25

16 Jul '25

Simon Peyton Jones pushed to branch wip/T23162-spj at Glasgow Haskell Compiler / GHC Commits: 848e1dcb by Simon Peyton Jones at 2025-07-16T22:55:31+01:00 Comments only [skip ci] - - - - - 2 changed files: - compiler/GHC/Tc/Solver/FunDeps.hs - testsuite/tests/typecheck/should_compile/tc126.hs Changes: ===================================== compiler/GHC/Tc/Solver/FunDeps.hs ===================================== @@ -256,12 +256,12 @@ Consider T4254b: From the ambiguity check on the type signature we get [G] FD Int b [W] FD Int beta - If we ineract that Wanted with /both/ the t0p-level instance, /and/ the + If we interact that Wanted with /both/ the top-level instance, /and/ the local Given, we'll get beta ~ Int and beta ~ b respectively. That would generate (b~Bool), which would fai. I think it doesn't matter which of the two we pick, but historically we have - picked teh local-fundeps firs. + picked the local-fundeps first. (DFL2) Try solving from top-level instances before fundeps. From the definition `foo = op` we get ===================================== testsuite/tests/typecheck/should_compile/tc126.hs ===================================== @@ -35,3 +35,50 @@ g2 = f (f (f [0::Int])) -- The outer f repeats the exercise, so g2::Int -- This is the definition that Hugs rejects + +{- +start iteration=0 + [W] $dBug_aET {0} :: Bug (Int -> Int) a_aER[tau:1] r_aES[tau:1] (CDictCan) + [W] $dBug_aEW {0} :: Bug (Int -> Int) [r_aFd[tau:1]] a_aER[tau:1] (CDictCan) + [W] $dBug_aF0 {0} :: Bug (Int -> Int) [Int] [r_aFd[tau:1]] (CDictCan)} +--> + [W] $dBug_aET {0} :: Bug (Int -> Int) a_aER[tau:1] r_aES[tau:1] (CDictCan) + [W] $dBug_aEW {0} :: Bug (Int -> Int) [r_aFd[tau:1]] a_aER[tau:1] (CDictCan) + [W] $dBug_aF0 {0} :: Bug (Int -> Int) Int r_aFd[tau:1] (CDictCan)} +--> fds + a_aER := [r_aFf] + r_fD := Int + +start iteration=1 + [W] $dBug_aET {0} :: Bug (Int -> Int) [r_aFf[tau:1]] r_aES[tau:1] (CDictCan) + [W] $dBug_aEW {0} :: Bug (Int -> Int) [r_aFd[tau:1]] [r_aFf][tau:1]] (CDictCan) + [W] $dBug_aF0 {0} :: Bug (Int -> Int) Int Int (CDictCan)} +--> (solve aF0, instance for aEW) + [W] $dBug_aET {0} :: Bug (Int -> Int) [r_aFf[tau:1]] r_aES[tau:1] (CDictCan) + [W] $dBug_aFg {1} :: Bug (Int -> Int) Int r_aFf[tau:1] (CDictCan)} +--> fds + r_aES := [r_aFh] -- fresh r_aFh + r_aFf := Int + +start iteration=2 + [W] $dBug_aET {0} :: Bug (Int -> Int) [Int] [r_afH[tau:1]] (CDictCan) + [W] $dBug_aFg {1} :: Bug (Int -> Int) Int Int (CDictCan)} +--> (solve afG instance for aET + [W] $dBug_aFi {1} :: Bug (Int -> Int) Int r_aFh[tau:1] (CDictCan)} +--> fds + f_afH := Int + +start iteration 3 + [W] $dBug_aFi {1} :: Bug (Int -> Int) Int Int (CDictCan)} +--> solve + + + + [W] $dBug_aCv {0} :: Bug (Int -> Int) [r_aCL[tau:1]] r_aCu[tau:1] (CDictCan) + [W] $dBug_aEI {1} :: Bug (Int -> Int) Int r_aCL[tau:1] (CDictCan)} +--> + r_aCL := Int + r_aCu := [ r_new ] -- r_aEJ + + [W] Bug (Int -> Int) Int r_new +-} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/848e1dcbd1e191f70c411c0697cc5a6… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/848e1dcbd1e191f70c411c0697cc5a6… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/T26115] Wibble imports
by Simon Peyton Jones (＠simonpj) 16 Jul '25

16 Jul '25

Simon Peyton Jones pushed to branch wip/T26115 at Glasgow Haskell Compiler / GHC Commits: c8241b8a by Simon Peyton Jones at 2025-07-16T22:38:37+01:00 Wibble imports - - - - - 1 changed file: - compiler/GHC/Core/Opt/Specialise.hs Changes: ===================================== compiler/GHC/Core/Opt/Specialise.hs ===================================== @@ -70,8 +70,6 @@ import GHC.Core.Subst (substTickish) import GHC.Core.TyCon (tyConClass_maybe) import GHC.Core.DataCon (dataConTyCon) -import Control.Monad - {- ************************************************************************ * * View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c8241b8a27c5682347d3923453996aa… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c8241b8a27c5682347d3923453996aa… You're receiving this email because of your account on gitlab.haskell.org.

1 0