[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 6 commits: linker: add --optimistic-linking flag
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Tue Oct 22 15:40:48 UTC 2024
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
25121dbc by doyougnu at 2024-10-22T09:38:18-04:00
linker: add --optimistic-linking flag
This patch adds:
- the --optimistic-linking flag which binds unknown symbols in the
runtime linker to 0xDEADBEEF instead of exiting with failure
- The test T25240 which tests these flags using dead code in the FFI system.
- closes #25240
This patch is part of the upstreaming haskell.nix patches project.
- - - - -
f19e076d by doyougnu at 2024-10-22T09:38:18-04:00
ghc-internal: hide linkerOptimistic in MiscFlags
- - - - -
edc02197 by Cheng Shao at 2024-10-22T09:38:54-04:00
hadrian: fix bindist executable wrapper logic for cross targets
This commit fixes an oversight of hadrian wrapper generation logic:
when doing cross compilation, `wrapper` is called on executable names
with cross prefix, therefore we must use `isSuffixOf` when matching to
take the cross prefix into account. Also add missing cross prefix to
ghci wrapper content and fix hsc2hs wrapper logic.
- - - - -
20ba7893 by Andreas Klebinger at 2024-10-22T11:40:33-04:00
mkTick: Push ticks through unsafeCoerce#.
unsafeCoerce# doesn't exist at runtime so we should treat it like a Cast
for the purpose of mkTick.
This means if we have `{-# SCC foo #-} (unsafeCoerce# trivial_expr))` we
now push the scope part of the cost centre up to `trivial_expr` at which
point we can discard it completely if the expression is trivial enough.
This fixes #25212.
- - - - -
c5e1ac81 by Cheng Shao at 2024-10-22T11:40:33-04:00
hadrian: enable late-CCS for perf flavour as well
This patch enables late-CCS for perf flavour so that the testsuite can
pass for perf as well. Fixes #25308.
- - - - -
45657a96 by Cheng Shao at 2024-10-22T11:40:34-04:00
hadrian: make sure ghc-bin internal-interpreter is disabled for stage0 when not cross compiling
This patch disables internal-interpreter flag for stage0 ghc-bin when
not cross compiling, see added comment for explanation. Fixes #25406.
- - - - -
27 changed files:
- compiler/GHC/Core/Utils.hs
- compiler/GHC/Types/Tickish.hs
- docs/users_guide/9.14.1-notes.rst
- docs/users_guide/runtime_control.rst
- hadrian/bindist/Makefile
- hadrian/doc/flavours.md
- hadrian/src/Rules/BinaryDist.hs
- hadrian/src/Settings/Flavours/Performance.hs
- hadrian/src/Settings/Flavours/Release.hs
- hadrian/src/Settings/Packages.hs
- libraries/ghc-internal/src/GHC/Internal/RTS/Flags.hsc
- rts/Linker.c
- rts/RtsFlags.c
- rts/include/rts/Flags.h
- rts/linker/elf_got.c
- + testsuite/tests/ghci/linking/T25240/Makefile
- + testsuite/tests/ghci/linking/T25240/T25240.hs
- + testsuite/tests/ghci/linking/T25240/T25240.stderr
- + testsuite/tests/ghci/linking/T25240/T25240a.hs
- + testsuite/tests/ghci/linking/T25240/all.T
- testsuite/tests/ghci/should_run/T18064.stderr
- testsuite/tests/rts/linker/T11223/T11223_link_order_a_b_2_fail.stderr
- 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
- testsuite/tests/rts/linker/T11223/T11223_simple_duplicate_lib.stderr
- testsuite/tests/rts/linker/T11223/T11223_simple_duplicate_lib.stderr-ws-32-mingw32
- testsuite/tests/rts/linker/T11223/T11223_simple_duplicate_lib.stderr-ws-64-mingw32
Changes:
=====================================
compiler/GHC/Core/Utils.hs
=====================================
@@ -305,7 +305,6 @@ mkTick t orig_expr = mkTick' id id orig_expr
-- Some ticks (cost-centres) can be split in two, with the
-- non-counting part having laxer placement properties.
canSplit = tickishCanSplit t && tickishPlace (mkNoCount t) /= tickishPlace t
-
-- mkTick' handles floating of ticks *into* the expression.
-- In this function, `top` is applied after adding the tick, and `rest` before.
-- This will result in applications that look like (top $ Tick t $ rest expr).
@@ -316,6 +315,10 @@ mkTick t orig_expr = mkTick' id id orig_expr
-> CoreExpr -- current expression
-> CoreExpr
mkTick' top rest expr = case expr of
+ -- Float ticks into unsafe coerce the same way we would do with a cast.
+ Case scrut bndr ty alts@[Alt ac abs _rhs]
+ | Just rhs <- isUnsafeEqualityCase scrut bndr alts
+ -> top $ mkTick' (\e -> Case scrut bndr ty [Alt ac abs e]) rest rhs
-- Cost centre ticks should never be reordered relative to each
-- other. Therefore we can stop whenever two collide.
@@ -1251,7 +1254,7 @@ Note [Tick trivial]
Ticks are only trivial if they are pure annotations. If we treat
"tick<n> x" as trivial, it will be inlined inside lambdas and the
entry count will be skewed, for example. Furthermore "scc<n> x" will
-turn into just "x" in mkTick.
+turn into just "x" in mkTick. At least if `x` is not a function.
Note [Empty case is trivial]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~
=====================================
compiler/GHC/Types/Tickish.hs
=====================================
@@ -295,13 +295,15 @@ tickishCanSplit _ = False
mkNoCount :: GenTickish pass -> GenTickish pass
mkNoCount n | not (tickishCounts n) = n
| not (tickishCanSplit n) = panic "mkNoCount: Cannot split!"
-mkNoCount n at ProfNote{} = n {profNoteCount = False}
+mkNoCount n at ProfNote{} = let n' = n {profNoteCount = False}
+ in assert (profNoteCount n) n'
mkNoCount _ = panic "mkNoCount: Undefined split!"
mkNoScope :: GenTickish pass -> GenTickish pass
mkNoScope n | tickishScoped n == NoScope = n
| not (tickishCanSplit n) = panic "mkNoScope: Cannot split!"
-mkNoScope n at ProfNote{} = n {profNoteScope = False}
+mkNoScope n at ProfNote{} = let n' = n {profNoteScope = False}
+ in assert (profNoteCount n) n'
mkNoScope _ = panic "mkNoScope: Undefined split!"
-- | Return @True@ if this source annotation compiles to some backend
=====================================
docs/users_guide/9.14.1-notes.rst
=====================================
@@ -29,6 +29,10 @@ GHCi
Runtime system
~~~~~~~~~~~~~~
+- Add new runtime flag :rts-flag:`--optimistic-linking` which instructs the
+ runtime linker to continue in the presence of unknown symbols. By default this
+ flag is not passed, preserving previous behavior.
+
Cmm
~~~
=====================================
docs/users_guide/runtime_control.rst
=====================================
@@ -397,6 +397,11 @@ Miscellaneous RTS options
heap larger than 1T. ``-xr`` is a no-op if GHC is configured with
``--disable-large-address-space`` or if the platform is 32-bit.
+.. rts-flag:: --optimistic-linking
+
+ If given, instruct the runtime linker to try to continue linking in the
+ presence of an unresolved symbol.
+
.. _rts-options-gc:
RTS options to control the garbage collector
=====================================
hadrian/bindist/Makefile
=====================================
@@ -243,7 +243,7 @@ install_wrappers: install_bin_libdir install_hsc2hs_wrapper
.PHONY: install_hsc2hs_wrapper
install_hsc2hs_wrapper:
@echo Copying hsc2hs wrapper
- cp mk/hsc2hs wrappers/hsc2hs-ghc-$(ProjectVersion)
+ cp mk/hsc2hs wrappers/$(CrossCompilePrefix)hsc2hs-ghc-$(ProjectVersion)
PKG_CONFS = $(shell find "$(DESTDIR)$(ActualLibsDir)/package.conf.d" -name '*.conf' | sed "s: :\0xxx\0:g")
.PHONY: update_package_db
=====================================
hadrian/doc/flavours.md
=====================================
@@ -107,7 +107,7 @@ when compiling the `compiler` library, and `hsGhc` when compiling/linking the GH
<td>-O2</td>
</tr>
<tr>
- <th>release (same as perf with -haddock and +late-ccs)</td>
+ <th>release (same as perf with -haddock)</td>
<td></td>
<td>-O<br>-H64m</td>
<td>-O<br>-H64m</td>
@@ -323,7 +323,7 @@ The supported transformers are listed below:
</tr>
<tr>
<td><code>late_ccs</code></td>
- <td>Enable <code>-fprof-late</code> in profiled libraries.</td>
+ <td>Enable <code>-fprof-late</code> in profiled libraries. Enabled in <code>perf</code> and <code>release</code> flavours.</td>
</tr>
<tr>
<td><code>dump_stg</code></td>
=====================================
hadrian/src/Rules/BinaryDist.hs
=====================================
@@ -437,13 +437,14 @@ pkgToWrappers pkg = do
| otherwise -> pure []
wrapper :: FilePath -> Action String
-wrapper "ghc" = ghcWrapper
-wrapper "ghc-pkg" = ghcPkgWrapper
-wrapper "ghci" = ghciScriptWrapper
-wrapper "haddock" = haddockWrapper
-wrapper "hsc2hs" = hsc2hsWrapper
-wrapper "runghc" = runGhcWrapper
-wrapper "runhaskell" = runGhcWrapper
+wrapper wrapper_name
+ | "runghc" `isSuffixOf` wrapper_name = runGhcWrapper
+ | "ghc" `isSuffixOf` wrapper_name = ghcWrapper
+ | "ghc-pkg" `isSuffixOf` wrapper_name = ghcPkgWrapper
+ | "ghci" `isSuffixOf` wrapper_name = ghciScriptWrapper
+ | "haddock" `isSuffixOf` wrapper_name = haddockWrapper
+ | "hsc2hs" `isSuffixOf` wrapper_name = hsc2hsWrapper
+ | "runhaskell" `isSuffixOf` wrapper_name = runGhcWrapper
wrapper _ = commonWrapper
-- | Wrapper scripts for different programs. Common is default wrapper.
@@ -473,9 +474,10 @@ runGhcWrapper = pure $ "exec \"$executablename\" -f \"$exedir/ghc\" ${1+\"$@\"}\
-- | --interactive flag.
ghciScriptWrapper :: Action String
ghciScriptWrapper = do
+ prefix <- crossPrefix
version <- setting ProjectVersion
pure $ unlines
- [ "executable=\"$bindir/ghc-" ++ version ++ "\""
+ [ "executable=\"$bindir/" ++ prefix ++ "ghc-" ++ version ++ "\""
, "exec $executable --interactive \"$@\"" ]
-- | When not on Windows, we want to ship the 3 flavours of the iserv program
@@ -548,4 +550,3 @@ createGhcii outDir = do
[ "#!/bin/sh"
, "exec \"$(dirname \"$0\")\"/ghc --interactive \"$@\""
]
-
=====================================
hadrian/src/Settings/Flavours/Performance.hs
=====================================
@@ -6,7 +6,7 @@ import {-# SOURCE #-} Settings.Default
-- Please update doc/flavours.md when changing this file.
performanceFlavour :: Flavour
-performanceFlavour = splitSections $ defaultFlavour
+performanceFlavour = splitSections $ enableLateCCS $ defaultFlavour
{ name = "perf"
, extraArgs = performanceArgs <> defaultHaddockExtraArgs }
=====================================
hadrian/src/Settings/Flavours/Release.hs
=====================================
@@ -4,4 +4,4 @@ import Settings.Flavours.Performance
import Flavour
releaseFlavour :: Flavour
-releaseFlavour = enableLateCCS $ enableHaddock performanceFlavour { name = "release" }
+releaseFlavour = enableHaddock performanceFlavour { name = "release" }
=====================================
hadrian/src/Settings/Packages.hs
=====================================
@@ -107,7 +107,16 @@ packageArgs = do
, compilerStageOption ghcDebugAssertions ? arg "-DDEBUG" ]
, builder (Cabal Flags) ? mconcat
- [ expr ghcWithInterpreter `cabalFlag` "internal-interpreter"
+ [
+ -- When cross compiling, enable for stage0 to get ghci
+ -- support. But when not cross compiling, disable for
+ -- stage0, otherwise we introduce extra dependencies
+ -- like haskeline etc, and mixing stageBoot/stage0 libs
+ -- can cause extra trouble (e.g. #25406)
+ expr ghcWithInterpreter ?
+ ifM (expr cross)
+ (arg "internal-interpreter")
+ (notStage0 `cabalFlag` "internal-interpreter")
, ifM stage0
-- We build a threaded stage 1 if the bootstrapping compiler
-- supports it.
=====================================
libraries/ghc-internal/src/GHC/Internal/RTS/Flags.hsc
=====================================
@@ -162,6 +162,8 @@ data MiscFlags = MiscFlags
, disableDelayedOsMemoryReturn :: Bool
, internalCounters :: Bool
, linkerAlwaysPic :: Bool
+ -- TODO: #25354 uncomment to expose this flag to base.
+ -- , linkerOptimistic :: Bool
, linkerMemBase :: Word
-- ^ address to ask the OS for memory for the linker, 0 ==> off
, ioManager :: IoManagerFlag
=====================================
rts/Linker.c
=====================================
@@ -967,10 +967,20 @@ SymbolAddr* lookupSymbol( SymbolName* lbl )
// lookupDependentSymbol directly.
SymbolAddr* r = lookupDependentSymbol(lbl, NULL, NULL);
if (!r) {
- errorBelch("^^ Could not load '%s', dependency unresolved. "
- "See top entry above.\n", lbl);
- IF_DEBUG(linker, printLoadedObjects());
- fflush(stderr);
+ if (!RtsFlags.MiscFlags.linkerOptimistic) {
+ errorBelch("^^ Could not load '%s', dependency unresolved. "
+ "See top entry above. You might consider using --optimistic-linking\n",
+ lbl);
+ IF_DEBUG(linker, printLoadedObjects());
+ fflush(stderr);
+ } else {
+ // if --optimistic-linking is passed into the RTS we allow the linker
+ // to optimistically continue
+ errorBelch("^^ Could not load '%s', dependency unresolved, "
+ "optimistically continuing\n",
+ lbl);
+ r = (void*) 0xDEADBEEF;
+ }
}
if (!runPendingInitializers()) {
=====================================
rts/RtsFlags.c
=====================================
@@ -269,6 +269,7 @@ void initRtsFlagsDefaults(void)
RtsFlags.MiscFlags.disableDelayedOsMemoryReturn = false;
RtsFlags.MiscFlags.internalCounters = false;
RtsFlags.MiscFlags.linkerAlwaysPic = DEFAULT_LINKER_ALWAYS_PIC;
+ RtsFlags.MiscFlags.linkerOptimistic = false;
RtsFlags.MiscFlags.linkerMemBase = 0;
RtsFlags.MiscFlags.ioManager = IO_MNGR_FLAG_AUTO;
#if defined(THREADED_RTS) && defined(mingw32_HOST_OS)
@@ -998,6 +999,11 @@ error = true;
OPTION_UNSAFE;
RtsFlags.MiscFlags.generate_dump_file = true;
}
+ else if (strequal("optimistic-linking",
+ &rts_argv[arg][2])) {
+ OPTION_UNSAFE;
+ RtsFlags.MiscFlags.linkerOptimistic = true;
+ }
else if (strequal("null-eventlog-writer",
&rts_argv[arg][2])) {
OPTION_UNSAFE;
=====================================
rts/include/rts/Flags.h
=====================================
@@ -267,6 +267,7 @@ typedef struct _MISC_FLAGS {
there as well. */
bool internalCounters; /* See Note [Internal Counters Stats] */
bool linkerAlwaysPic; /* Assume the object code is always PIC */
+ bool linkerOptimistic; /* Should the runtime linker optimistically continue */
StgWord linkerMemBase; /* address to ask the OS for memory
* for the linker, NULL ==> off */
IO_MANAGER_FLAG ioManager; /* The I/O manager to use. */
=====================================
rts/linker/elf_got.c
=====================================
@@ -97,9 +97,22 @@ fillGot(ObjectCode * oc) {
if(0 == strncmp(symbol->name,"_GLOBAL_OFFSET_TABLE_",21)) {
symbol->addr = oc->info->got_start;
} else {
- errorBelch("Failed to lookup symbol: %s\n",
+ errorBelch("Failed to lookup symbol: %s,"
+ " you might consider using --optimistic-linking\n",
symbol->name);
- return EXIT_FAILURE;
+
+ // if --optimistic-linking is passed into the
+ // RTS we allow the linker to optimistically
+ // continue
+ if (RtsFlags.MiscFlags.linkerOptimistic) {
+ errorBelch("Failed to lookup symbol: %s,"
+ " optimistically continuing.\n",
+ symbol->name);
+ symbol->addr = (void*) 0xDEADBEEF;
+ } else {
+ return EXIT_FAILURE;
+ }
+
}
}
} else {
=====================================
testsuite/tests/ghci/linking/T25240/Makefile
=====================================
@@ -0,0 +1,7 @@
+TOP=../../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
+
+.PHONY: T25240
+T25240:
+ "$(TEST_HC)" $(TEST_HC_OPTS_INTERACTIVE) T25240a.hs T25240.hs +RTS --optimistic-linking -RTS
=====================================
testsuite/tests/ghci/linking/T25240/T25240.hs
=====================================
@@ -0,0 +1,17 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+{-
+
+When the RTS linker loads the T25240a module to run the pure foo splice, it
+tries to resolve the func symbol even if this function isn't required to run the
+splice code, i.e., its dead code. This test checks that by passing the
+--optimistic-linking flag the RTS linker continues to link even in the presence
+of unknown symbols.
+
+-}
+
+module T25240 where
+
+import T25240a
+
+$(pure foo)
=====================================
testsuite/tests/ghci/linking/T25240/T25240.stderr
=====================================
@@ -0,0 +1,2 @@
+ghc: ^^ Could not load 'func', dependency unresolved, optimistically continuing
+
=====================================
testsuite/tests/ghci/linking/T25240/T25240a.hs
=====================================
@@ -0,0 +1,13 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+
+module T25240a
+ ( foo, func
+ ) where
+
+
+foo :: [a]
+foo = []
+
+foreign import ccall "func"
+ func :: Int -> Int
=====================================
testsuite/tests/ghci/linking/T25240/all.T
=====================================
@@ -0,0 +1,3 @@
+# skip on darwin because the leading underscores will make the test fail
+test('T25240', [when(leading_underscore(),skip), req_rts_linker, extra_files(['T25240a.hs'])],
+ makefile_test, ['T25240'])
=====================================
testsuite/tests/ghci/should_run/T18064.stderr
=====================================
@@ -1,2 +1,2 @@
-<interactive>: ^^ Could not load 'blah', dependency unresolved. See top entry above.
+<interactive>: ^^ Could not load 'blah', dependency unresolved. See top entry above. You might consider using --optimistic-linking
=====================================
testsuite/tests/rts/linker/T11223/T11223_link_order_a_b_2_fail.stderr
=====================================
@@ -9,7 +9,7 @@ This could be caused by:
* Specifying the same object file twice on the GHCi command line
* An incorrect `package.conf' entry, causing some object to be
loaded twice.
-ghc-stage2: ^^ Could not load 'c', dependency unresolved. See top entry above.
+ghc-stage2: ^^ Could not load 'c', dependency unresolved. See top entry above. You might consider using --optimistic-linking
GHC.ByteCode.Linker: can't find label
=====================================
testsuite/tests/rts/linker/T11223/T11223_link_order_a_b_2_fail.stderr-ws-32-mingw32
=====================================
@@ -9,7 +9,7 @@ This could be caused by:
* Specifying the same object file twice on the GHCi command line
* An incorrect `package.conf' entry, causing some object to be
loaded twice.
-ghc-stage2.exe: ^^ Could not load '_c', dependency unresolved. See top entry above.
+ghc-stage2.exe: ^^ Could not load '_c', dependency unresolved. See top entry above. You might consider using --optimistic-linking
GHC.ByteCode.Linker: can't find label
=====================================
testsuite/tests/rts/linker/T11223/T11223_link_order_a_b_2_fail.stderr-ws-64-mingw32
=====================================
@@ -9,7 +9,7 @@ This could be caused by:
* Specifying the same object file twice on the GHCi command line
* An incorrect `package.conf' entry, causing some object to be
loaded twice.
-ghc-stage2.exe: ^^ Could not load 'c', dependency unresolved. See top entry above.
+ghc-stage2.exe: ^^ Could not load 'c', dependency unresolved. See top entry above. You might consider using --optimistic-linking
GHC.ByteCode.Linker: can't find label
=====================================
testsuite/tests/rts/linker/T11223/T11223_simple_duplicate_lib.stderr
=====================================
@@ -9,7 +9,7 @@ This could be caused by:
* Specifying the same object file twice on the GHCi command line
* An incorrect `package.conf' entry, causing some object to be
loaded twice.
-ghc-stage2: ^^ Could not load 'c', dependency unresolved. See top entry above.
+ghc-stage2: ^^ Could not load 'c', dependency unresolved. See top entry above. You might consider using --optimistic-linking
GHC.ByteCode.Linker: can't find label
=====================================
testsuite/tests/rts/linker/T11223/T11223_simple_duplicate_lib.stderr-ws-32-mingw32
=====================================
@@ -9,7 +9,7 @@ This could be caused by:
* Specifying the same object file twice on the GHCi command line
* An incorrect `package.conf' entry, causing some object to be
loaded twice.
-ghc-stage2.exe: ^^ Could not load '_c', dependency unresolved. See top entry above.
+ghc-stage2.exe: ^^ Could not load '_c', dependency unresolved. See top entry above. You might consider using --optimistic-linking
GHC.ByteCode.Linker: can't find label
=====================================
testsuite/tests/rts/linker/T11223/T11223_simple_duplicate_lib.stderr-ws-64-mingw32
=====================================
@@ -9,7 +9,7 @@ This could be caused by:
* Specifying the same object file twice on the GHCi command line
* An incorrect `package.conf' entry, causing some object to be
loaded twice.
-ghc-stage2.exe: ^^ Could not load 'c', dependency unresolved. See top entry above.
+ghc-stage2.exe: ^^ Could not load 'c', dependency unresolved. See top entry above. You might consider using --optimistic-linking
GHC.ByteCode.Linker: can't find label
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/73e7175865378652bc12b3af80cb8d6861904e1b...45657a96f5a9420f5f5270fe9aafc2e8bfba81fa
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/73e7175865378652bc12b3af80cb8d6861904e1b...45657a96f5a9420f5f5270fe9aafc2e8bfba81fa
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20241022/3758d4b4/attachment-0001.html>
More information about the ghc-commits
mailing list