- ghc-commits - Haskell.org

[Git][ghc/ghc][wip/T26226] ghci: always enable the internal-interpreter flag
by Teo Camarasu (＠teo) 25 Jul '25

25 Jul '25

Teo Camarasu pushed to branch wip/T26226 at Glasgow Haskell Compiler / GHC Commits: 81fc5795 by Teo Camarasu at 2025-07-25T20:05:15+01:00 ghci: always enable the internal-interpreter flag Building iserv requires the modules hidden behind the ghci internal-interpreter flag. This flag exists because these modules depend on parts of the TemplateHaskell interface, and historically we couldn't distinguish between the boot and the in-tree TH interface. This meant that these modules could only be built in stage0 if we've ensured that the boot TH interface matches the in-tree one. This restriction no longer holds as of https://gitlab.haskell.org/ghc/ghc/-/merge_requests/12306. Removing this flag simplifies our logic, and is a step towards enabling using TH in bootstrapping (https://gitlab.haskell.org/ghc/ghc/-/issues/24624) - - - - - 3 changed files: - hadrian/src/Settings/Packages.hs - libraries/ghci/GHCi/Run.hs - libraries/ghci/ghci.cabal.in Changes: ===================================== hadrian/src/Settings/Packages.hs ===================================== @@ -25,10 +25,6 @@ packageArgs = do -- See: https://gitlab.haskell.org/ghc/ghc/issues/16809. cross = flag CrossCompiling - -- Check if the bootstrap compiler has the same version as the one we - -- are building. This is used to build cross-compilers - bootCross = (==) <$> ghcVersionStage (stage0InTree) <*> ghcVersionStage Stage1 - compilerStageOption f = buildingCompilerStage' . f =<< expr flavour cursesIncludeDir <- getSetting CursesIncludeDir @@ -128,39 +124,9 @@ packageArgs = do --------------------------------- ghci --------------------------------- , package ghci ? mconcat - [ - -- The use case here is that we want to build @iserv-proxy@ for the - -- cross compiler. That one needs to be compiled by the bootstrap - -- compiler as it needs to run on the host. Hence @iserv@ needs - -- @GHCi.TH@, @GHCi.Message@, @GHCi.Run@, and @GHCi.Server@ from - -- @ghci@. And those are behind the @-finternal-interpreter@ flag. - -- - -- But it may not build if we have made some changes to ghci's - -- dependencies (see #16051). - -- - -- To fix this properly Hadrian would need to: - -- * first build a compiler for the build platform (stage1 is enough) - -- * use it as a bootstrap compiler to build the stage1 cross-compiler - -- - -- The issue is that "configure" would have to be executed twice (for - -- the build platform and for the cross-platform) and Hadrian would - -- need to be fixed to support two different stage1 compilers. - -- - -- The workaround we use is to check if the bootstrap compiler has - -- the same version as the one we are building. In this case we can - -- avoid the first step above and directly build with - -- `-finternal-interpreter`. - -- - -- TODO: Note that in that case we also do not need to build most of - -- the Stage1 libraries, as we already know that the bootstrap - -- compiler comes with the same versions as the one we are building. - -- - builder (Cabal Setup) ? cabalExtraDirs ffiIncludeDir ffiLibraryDir + [ builder (Cabal Setup) ? cabalExtraDirs ffiIncludeDir ffiLibraryDir , builder (Cabal Flags) ? mconcat - [ ifM stage0 - (andM [cross, bootCross] `cabalFlag` "internal-interpreter") - (arg "internal-interpreter") - , stage0 `cabalFlag` "bootstrap" + [ stage0 `cabalFlag` "bootstrap" ] ] ===================================== libraries/ghci/GHCi/Run.hs ===================================== @@ -260,7 +260,11 @@ sandboxIO opts io = do -- rethrow :: EvalOpts -> IO a -> IO a rethrow EvalOpts{..} io = +#if MIN_VERSION_base(4,20,0) catchNoPropagate io $ \(ExceptionWithContext cx se) -> do +#else + catch io $ \se -> do +#endif -- If -fbreak-on-error, we break unconditionally, -- but with care of not breaking twice if breakOnError && not breakOnException @@ -271,7 +275,11 @@ rethrow EvalOpts{..} io = Just UserInterrupt -> return () -- In any other case, we don't want to break _ -> poke exceptionFlag 0 +#if MIN_VERSION_base(4,20,0) rethrowIO (ExceptionWithContext cx se) +#else + throwIO se +#endif -- -- While we're waiting for the sandbox thread to return a result, if ===================================== libraries/ghci/ghci.cabal.in ===================================== @@ -17,11 +17,6 @@ cabal-version: >=1.10 build-type: Simple extra-source-files: changelog.md -Flag internal-interpreter - Description: Build with internal interpreter support. - Default: False - Manual: True - Flag bootstrap Description: Enabled when building the stage1 compiler in order to vendor the in-tree @@ -56,23 +51,19 @@ library TupleSections UnboxedTuples - if flag(internal-interpreter) - CPP-Options: -DHAVE_INTERNAL_INTERPRETER + if !arch(javascript) exposed-modules: - GHCi.Run - GHCi.Debugger - GHCi.CreateBCO - GHCi.ObjLink - GHCi.Signals - GHCi.StaticPtrTable - GHCi.TH - GHCi.Server - - if !arch(javascript) - exposed-modules: - GHCi.InfoTable + GHCi.InfoTable exposed-modules: + GHCi.Run + GHCi.Debugger + GHCi.CreateBCO + GHCi.ObjLink + GHCi.Signals + GHCi.StaticPtrTable + GHCi.TH + GHCi.Server GHCi.BreakArray GHCi.BinaryArray GHCi.Message View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/81fc57955b29ee78557470d1beb9451… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/81fc57955b29ee78557470d1beb9451… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/T26226] ghci: always enable the internal-interpreter flag
by Teo Camarasu (＠teo) 25 Jul '25

25 Jul '25

Teo Camarasu pushed to branch wip/T26226 at Glasgow Haskell Compiler / GHC Commits: 9da5afc5 by Teo Camarasu at 2025-07-25T19:29:51+01:00 ghci: always enable the internal-interpreter flag Building iserv requires the modules hidden behind the ghci internal-interpreter flag. This flag exists because these modules depend on parts of the TemplateHaskell interface, and historically we couldn't distinguish between the boot and the in-tree TH interface. This meant that these modules could only be built in stage0 if we've ensured that the boot TH interface matches the in-tree one. This restriction no longer holds as of https://gitlab.haskell.org/ghc/ghc/-/merge_requests/12306. Removing this flag simplifies our logic, and is a step towards enabling using TH in bootstrapping (https://gitlab.haskell.org/ghc/ghc/-/issues/24624) - - - - - 3 changed files: - hadrian/src/Settings/Packages.hs - libraries/ghci/GHCi/Run.hs - libraries/ghci/ghci.cabal.in Changes: ===================================== hadrian/src/Settings/Packages.hs ===================================== @@ -128,39 +128,9 @@ packageArgs = do --------------------------------- ghci --------------------------------- , package ghci ? mconcat - [ - -- The use case here is that we want to build @iserv-proxy@ for the - -- cross compiler. That one needs to be compiled by the bootstrap - -- compiler as it needs to run on the host. Hence @iserv@ needs - -- @GHCi.TH@, @GHCi.Message@, @GHCi.Run@, and @GHCi.Server@ from - -- @ghci@. And those are behind the @-finternal-interpreter@ flag. - -- - -- But it may not build if we have made some changes to ghci's - -- dependencies (see #16051). - -- - -- To fix this properly Hadrian would need to: - -- * first build a compiler for the build platform (stage1 is enough) - -- * use it as a bootstrap compiler to build the stage1 cross-compiler - -- - -- The issue is that "configure" would have to be executed twice (for - -- the build platform and for the cross-platform) and Hadrian would - -- need to be fixed to support two different stage1 compilers. - -- - -- The workaround we use is to check if the bootstrap compiler has - -- the same version as the one we are building. In this case we can - -- avoid the first step above and directly build with - -- `-finternal-interpreter`. - -- - -- TODO: Note that in that case we also do not need to build most of - -- the Stage1 libraries, as we already know that the bootstrap - -- compiler comes with the same versions as the one we are building. - -- - builder (Cabal Setup) ? cabalExtraDirs ffiIncludeDir ffiLibraryDir + [ builder (Cabal Setup) ? cabalExtraDirs ffiIncludeDir ffiLibraryDir , builder (Cabal Flags) ? mconcat - [ ifM stage0 - (andM [cross, bootCross] `cabalFlag` "internal-interpreter") - (arg "internal-interpreter") - , stage0 `cabalFlag` "bootstrap" + [ stage0 `cabalFlag` "bootstrap" ] ] ===================================== libraries/ghci/GHCi/Run.hs ===================================== @@ -260,7 +260,11 @@ sandboxIO opts io = do -- rethrow :: EvalOpts -> IO a -> IO a rethrow EvalOpts{..} io = +#if MIN_VERSION_base(4,20,0) catchNoPropagate io $ \(ExceptionWithContext cx se) -> do +#else + catch io $ \se -> do +#endif -- If -fbreak-on-error, we break unconditionally, -- but with care of not breaking twice if breakOnError && not breakOnException @@ -271,7 +275,11 @@ rethrow EvalOpts{..} io = Just UserInterrupt -> return () -- In any other case, we don't want to break _ -> poke exceptionFlag 0 +#if MIN_VERSION_base(4,20,0) rethrowIO (ExceptionWithContext cx se) +#else + throwIO se +#endif -- -- While we're waiting for the sandbox thread to return a result, if ===================================== libraries/ghci/ghci.cabal.in ===================================== @@ -17,11 +17,6 @@ cabal-version: >=1.10 build-type: Simple extra-source-files: changelog.md -Flag internal-interpreter - Description: Build with internal interpreter support. - Default: False - Manual: True - Flag bootstrap Description: Enabled when building the stage1 compiler in order to vendor the in-tree @@ -56,23 +51,19 @@ library TupleSections UnboxedTuples - if flag(internal-interpreter) - CPP-Options: -DHAVE_INTERNAL_INTERPRETER + if !arch(javascript) exposed-modules: - GHCi.Run - GHCi.Debugger - GHCi.CreateBCO - GHCi.ObjLink - GHCi.Signals - GHCi.StaticPtrTable - GHCi.TH - GHCi.Server - - if !arch(javascript) - exposed-modules: - GHCi.InfoTable + GHCi.InfoTable exposed-modules: + GHCi.Run + GHCi.Debugger + GHCi.CreateBCO + GHCi.ObjLink + GHCi.Signals + GHCi.StaticPtrTable + GHCi.TH + GHCi.Server GHCi.BreakArray GHCi.BinaryArray GHCi.Message View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9da5afc52e16ce6c584b1bad9e67d07… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9da5afc52e16ce6c584b1bad9e67d07… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Pushed new branch wip/T26226
by Teo Camarasu (＠teo) 25 Jul '25

25 Jul '25

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

1 0

[Git][ghc/ghc][wip/haanss/depdir] 17 commits: Add Data.List.NonEmpty.mapMaybe
by Hassan Al-Awwadi (＠hassan.awwadi) 25 Jul '25

25 Jul '25

Hassan Al-Awwadi pushed to branch wip/haanss/depdir at Glasgow Haskell Compiler / GHC Commits: cc650b4b by Andrew Lelechenko at 2025-07-17T12:30:24-04:00 Add Data.List.NonEmpty.mapMaybe As per https://github.com/haskell/core-libraries-committee/issues/337 - - - - - 360fa82c by Duncan Coutts at 2025-07-17T12:31:14-04:00 base: Deprecate GHC.Weak.Finalize.runFinalizerBatch https://github.com/haskell/core-libraries-committee/issues/342 - - - - - f4e8466c by Alan Zimmerman at 2025-07-17T12:31:55-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. - - - - - 8b731e3c by Matthew Pickering at 2025-07-21T13:36:43-04:00 level imports: Fix infinite loop with cyclic module imports I didn't anticipate that downsweep would run before we checked for cyclic imports. Therefore we need to use the reachability function which handles cyclic graphs. Fixes #26087 - - - - - d751a9f1 by Pierre Thierry at 2025-07-21T13:37:28-04:00 Fix documentation about deriving from generics - - - - - f8d9d016 by Andrew Lelechenko at 2025-07-22T21:13:28-04:00 Fix issues with toRational for types capable to represent infinite and not-a-number values This commit fixes all of the following pitfalls: > toRational (read "Infinity" :: Double) 179769313486231590772930519078902473361797697894230657273430081157732675805500963132708477322407536021120113879871393357658789768814416622492847430639474124377767893424865485276302219601246094119453082952085005768838150682342462881473913110540827237163350510684586298239947245938479716304835356329624224137216 % 1 > toRational (read "NaN" :: Double) 269653970229347386159395778618353710042696546841345985910145121736599013708251444699062715983611304031680170819807090036488184653221624933739271145959211186566651840137298227914453329401869141179179624428127508653257226023513694322210869665811240855745025766026879447359920868907719574457253034494436336205824 % 1 > realToFrac (read "NaN" :: Double) -- With -O0 Infinity > realToFrac (read "NaN" :: Double) -- With -O1 NaN > realToFrac (read "NaN" :: Double) :: CDouble Infinity > realToFrac (read "NaN" :: CDouble) :: Double Infinity Implements https://github.com/haskell/core-libraries-committee/issues/338 - - - - - 5dabc718 by Zubin Duggal at 2025-07-22T21:14:10-04:00 haddock: Don't warn about missing link destinations for derived names. Fixes #26114 - - - - - 9c3a0937 by Matthew Pickering at 2025-07-22T21:14:52-04:00 template haskell: use a precise condition when implicitly lifting Implicit lifting corrects a level error by replacing references to `x` with `$(lift x)`, therefore you can use a level `n` binding at level `n + 1`, if it can be lifted. Therefore, we now have a precise check that the use level is 1 more than the bind level. Before this bug was not observable as you only had 0 and 1 contexts but it is easily evident when using explicit level imports. Fixes #26088 - - - - - 5144b22f by Andreas Klebinger at 2025-07-22T21:15:34-04:00 Add since tag and more docs for do-clever-arg-eta-expansion Fixes #26113 - - - - - c865623b by Andreas Klebinger at 2025-07-22T21:15:34-04:00 Add since tag for -fexpose-overloaded-unfoldings Fixes #26112 - - - - - 49a44ab7 by Simon Hengel at 2025-07-23T17:59:55+07:00 Refactor GHC.Driver.Errors.printMessages - - - - - 84711c39 by Simon Hengel at 2025-07-23T18:27:34+07:00 Respect `-fdiagnostics-as-json` for error messages from pre-processors (fixes #25480) - - - - - d046b5ab by Simon Hengel at 2025-07-24T06:12:05-04:00 Include the rendered message in -fdiagnostics-as-json output This implements #26173. - - - - - d2b89603 by Ben Gamari at 2025-07-24T06:12:47-04:00 rts/Interpreter: Factor out ctoi tuple info tables into data Instead of a massive case let's put this into data which we can reuse elsewhere. - - - - - 4bc78496 by Sebastian Graf at 2025-07-24T16:19:34-04:00 CprAnal: Detect recursive newtypes (#25944) While `cprTransformDataConWork` handles recursive data con workers, it did not detect the case when a newtype is responsible for the recursion. This is now detected in the `Cast` case of `cprAnal`. The same reproducer made it clear that `isRecDataCon` lacked congruent handling for `AppTy` and `CastTy`, now fixed. Furthermore, the new repro case T25944 triggered this bug via an infinite loop in `cprFix`, caused by the infelicity in `isRecDataCon`. While it should be much less likely to trigger such an infinite loop now that `isRecDataCon` has been fixed, I made sure to abort the loop after 10 iterations and emitting a warning instead. Fixes #25944. - - - - - 0a583689 by Sylvain Henry at 2025-07-24T16:20:26-04:00 STM: don't create a transaction in the rhs of catchRetry# (#26028) We don't need to create a transaction for the rhs of (catchRetry#) because contrary to the lhs we don't need to abort it on retry. Moreover it is particularly harmful if we have code such as (#26028): let cN = readTVar vN >> retry tree = c1 `orElse` (c2 `orElse` (c3 `orElse` ...)) atomically tree Because it will stack transactions for the rhss and the read-sets of all the transactions will be iteratively merged in O(n^2) after the execution of the most nested retry. - - - - - 7fb97bf2 by Hassan Al-Awwadi at 2025-07-25T20:01:19+02:00 Adds the fucnction addDependentDirectory to Q, resolving issue #26148. This function adds a new directory to the list of things a module depends upon. That means that when the contents of the directory change, the recompilation checker will notice this and the module will be recompiled. Documentation has also been added for addDependentFunction and addDependentDirectory in the user guide. - - - - - 77 changed files: - compiler/GHC/Core/Opt/CprAnal.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Driver/Errors.hs - compiler/GHC/Hs/ImpExp.hs - compiler/GHC/HsToCore/Usage.hs - compiler/GHC/Iface/Make.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/Iface/Recomp/Types.hs - compiler/GHC/Parser.y - compiler/GHC/Rename/Splice.hs - compiler/GHC/SysTools/Process.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/GHC/Tc/Types.hs - compiler/GHC/Tc/Utils/Monad.hs - compiler/GHC/Types/Error.hs - compiler/GHC/Unit/Finder.hs - compiler/GHC/Unit/Finder/Types.hs - compiler/GHC/Unit/Module/Deps.hs - compiler/GHC/Unit/Module/Graph.hs - compiler/GHC/Utils/Logger.hs - docs/users_guide/9.14.1-notes.rst - + docs/users_guide/diagnostics-as-json-schema-1_2.json - docs/users_guide/separate_compilation.rst - docs/users_guide/using-optimisation.rst - docs/users_guide/using.rst - ghc/GHCi/UI.hs - libraries/base/changelog.md - libraries/base/src/Data/List/NonEmpty.hs - libraries/base/src/GHC/Generics.hs - libraries/base/src/GHC/Weak/Finalize.hs - libraries/ghc-internal/src/GHC/Internal/Float.hs - libraries/ghc-internal/src/GHC/Internal/Real.hs - libraries/ghc-internal/src/GHC/Internal/TH/Syntax.hs - libraries/ghci/GHCi/Message.hs - libraries/ghci/GHCi/TH.hs - libraries/template-haskell/Language/Haskell/TH/Syntax.hs - rts/Interpreter.c - rts/PrimOps.cmm - rts/RaiseAsync.c - rts/STM.c - testsuite/.gitignore - + testsuite/tests/cpranal/sigs/T25944.hs - + testsuite/tests/cpranal/sigs/T25944.stderr - testsuite/tests/cpranal/sigs/all.T - testsuite/tests/driver/json.stderr - testsuite/tests/driver/json_warn.stderr - testsuite/tests/haddock/haddock_testsuite/Makefile - + testsuite/tests/haddock/haddock_testsuite/T26114.hs - + testsuite/tests/haddock/haddock_testsuite/T26114.stdout - testsuite/tests/haddock/haddock_testsuite/all.T - 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/interface-stability/template-haskell-exports.stdout - + testsuite/tests/lib/stm/T26028.hs - + testsuite/tests/lib/stm/T26028.stdout - + testsuite/tests/lib/stm/all.T - testsuite/tests/numeric/should_run/T9810.stdout - testsuite/tests/printer/Makefile - + testsuite/tests/printer/TestLevelImports.hs - + testsuite/tests/printer/TestNamedDefaults.hs - testsuite/tests/printer/all.T - + testsuite/tests/splice-imports/T26087.stderr - + testsuite/tests/splice-imports/T26087A.hs - + testsuite/tests/splice-imports/T26087B.hs - + testsuite/tests/splice-imports/T26088.stderr - + testsuite/tests/splice-imports/T26088A.hs - + testsuite/tests/splice-imports/T26088B.hs - testsuite/tests/splice-imports/all.T - testsuite/tests/th/Makefile - + testsuite/tests/th/TH_Depends_Dir.hs - + testsuite/tests/th/TH_Depends_Dir.stdout - + testsuite/tests/th/TH_Depends_Dir_External.hs - testsuite/tests/th/all.T - utils/check-exact/ExactPrint.hs - utils/haddock/haddock-api/src/Haddock/Interface/Rename.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/029703a1dd46cd092b7813d4cfa4cf… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/029703a1dd46cd092b7813d4cfa4cf… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/romes/26227] 3 commits: ghc-toolchain: Make "tgt rts linker only supports shared libs" function on Target
by Rodrigo Mesquita (＠alt-romes) 25 Jul '25

25 Jul '25

Rodrigo Mesquita pushed to branch wip/romes/26227 at Glasgow Haskell Compiler / GHC Commits: 2975183b by Rodrigo Mesquita at 2025-07-25T18:01:42+01:00 ghc-toolchain: Make "tgt rts linker only supports shared libs" function on Target Just like with "Support SMP", "target RTS linker only supports shared libraries" is a predicate on a `Target` so we can just compute it when necessary from the given `Target`. Towards #26227 - - - - - 94ed0d7f by Rodrigo Mesquita at 2025-07-25T18:01:42+01:00 WIP on Use interpreter - - - - - b9ed03c7 by Rodrigo Mesquita at 2025-07-25T18:01:50+01:00 Revert "WIP on Use interpreter" This reverts commit 94ed0d7fbd3f9eb59269607892f4b84cee25e6fd. - - - - - 6 changed files: - compiler/GHC/Driver/Session.hs - compiler/GHC/Settings/IO.hs - hadrian/bindist/Makefile - hadrian/src/Oracles/Flag.hs - hadrian/src/Rules/Generate.hs - utils/ghc-toolchain/src/GHC/Toolchain/Target.hs Changes: ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -3501,6 +3501,7 @@ compilerInfo dflags ("target has libm", queryBool tgtHasLibm), ("target has .ident directive", queryBool tgtSupportsIdentDirective), ("target has subsections via symbols", queryBool tgtSupportsSubsectionsViaSymbols), + ("target RTS linker only supports shared libraries", queryBool tgtRTSLinkerOnlySupportsSharedLibs), ("Unregisterised", queryBool tgtUnregisterised), ("LLVM target", query tgtLlvmTarget), ("LLVM llc command", queryCmdMaybe id tgtLlc), ===================================== compiler/GHC/Settings/IO.hs ===================================== @@ -146,7 +146,6 @@ initSettings top_dir = do pure (ld_r_path, map Option ld_r_args) iserv_prog = libexec "ghc-iserv" - targetRTSLinkerOnlySupportsSharedLibs <- getBooleanSetting "target RTS linker only supports shared libraries" ghcWithInterpreter <- getBooleanSetting "Use interpreter" baseUnitId <- getSetting_raw "base unit-id" @@ -231,7 +230,7 @@ initSettings top_dir = do , platformMisc_ghcWithInterpreter = ghcWithInterpreter , platformMisc_libFFI = tgtUseLibffiForAdjustors target , platformMisc_llvmTarget = tgtLlvmTarget target - , platformMisc_targetRTSLinkerOnlySupportsSharedLibs = targetRTSLinkerOnlySupportsSharedLibs + , platformMisc_targetRTSLinkerOnlySupportsSharedLibs = tgtRTSLinkerOnlySupportsSharedLibs target } , sRawSettings = settingsList ===================================== hadrian/bindist/Makefile ===================================== @@ -86,7 +86,6 @@ WrapperBinsDir=${bindir} lib/settings : config.mk @rm -f $@ @echo '[("unlit command", "$$topdir/../bin/$(CrossCompilePrefix)unlit")' >> $@ - @echo ',("target RTS linker only supports shared libraries", "$(TargetRTSLinkerOnlySupportsSharedLibs)")' >> $@ @echo ',("Use interpreter", "$(GhcWithInterpreter)")' >> $@ @echo ',("RTS ways", "$(GhcRTSWays)")' >> $@ @echo ',("Relative Global Package DB", "package.conf.d")' >> $@ ===================================== hadrian/src/Oracles/Flag.hs ===================================== @@ -80,23 +80,8 @@ platformSupportsGhciObjects = do only_shared_libs <- targetRTSLinkerOnlySupportsSharedLibs pure $ has_merge_objs && not only_shared_libs --- | Does the target RTS linker only support loading shared libraries? --- If true, this has several implications: --- 1. The GHC driver must not do loadArchive/loadObj etc and must --- always do loadDLL, regardless of whether host GHC is dynamic or --- not. --- 2. The GHC driver will always enable -dynamic-too when compiling --- vanilla way with TH codegen requirement. --- 3. ghci will always enforce dynamic ways even if -dynamic or --- -dynamic-too is not explicitly passed. --- 4. Cabal must not build ghci objects since it's not supported by --- the target. --- 5. The testsuite driver will use dyn way for TH/ghci tests even --- when host GHC is static. --- 6. TH/ghci doesn't work if stage1 is built without shared libraries --- (e.g. quickest/fully_static). targetRTSLinkerOnlySupportsSharedLibs :: Action Bool -targetRTSLinkerOnlySupportsSharedLibs = anyTargetArch [ ArchWasm32 ] +targetRTSLinkerOnlySupportsSharedLibs = queryTargetTarget Toolchain.tgtRTSLinkerOnlySupportsSharedLibs arSupportsDashL :: Stage -> Action Bool arSupportsDashL stage = Toolchain.arSupportsDashL . tgtAr <$> targetStage stage ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -484,7 +484,6 @@ generateSettings settingsFile = do settings <- traverse sequence $ [ ("unlit command", ("$topdir/../bin/" <>) <$> expr (programName (ctx { Context.package = unlit }))) - , ("target RTS linker only supports shared libraries", expr $ yesNo <$> targetRTSLinkerOnlySupportsSharedLibs) , ("Use interpreter", expr $ yesNo <$> ghcWithInterpreter (predStage stage)) , ("RTS ways", escapeArgs . map show . Set.toList <$> getRtsWays) , ("Relative Global Package DB", pure rel_pkg_db) ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Target.hs ===================================== @@ -9,7 +9,7 @@ module GHC.Toolchain.Target , WordSize(..), wordSize2Bytes -- ** Queries - , tgtSupportsSMP + , tgtSupportsSMP, tgtRTSLinkerOnlySupportsSharedLibs -- ** Lenses , _tgtCC, _tgtCxx, _tgtCpp, _tgtHsCpp @@ -183,6 +183,26 @@ tgtSupportsSMP Target{..} = do | goodArch -> True | otherwise -> False +-- | Does the target RTS linker only support loading shared libraries? +-- If true, this has several implications: +-- 1. The GHC driver must not do loadArchive/loadObj etc and must +-- always do loadDLL, regardless of whether host GHC is dynamic or +-- not. +-- 2. The GHC driver will always enable -dynamic-too when compiling +-- vanilla way with TH codegen requirement. +-- 3. ghci will always enforce dynamic ways even if -dynamic or +-- -dynamic-too is not explicitly passed. +-- 4. Cabal must not build ghci objects since it's not supported by +-- the target. +-- 5. The testsuite driver will use dyn way for TH/ghci tests even +-- when host GHC is static. +-- 6. TH/ghci doesn't work if stage1 is built without shared libraries +-- (e.g. quickest/fully_static). +tgtRTSLinkerOnlySupportsSharedLibs :: Target -> Bool +tgtRTSLinkerOnlySupportsSharedLibs Target{tgtArchOs} = + archOS_arch tgtArchOs `elem` + [ ArchWasm32 ] + -------------------------------------------------------------------------------- -- Lenses -------------------------------------------------------------------------------- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/059c5ac350a34c66e854368d28d0b9… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/059c5ac350a34c66e854368d28d0b9… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/T20264] More wibbles exp around mkPolyAbsLams
by Simon Peyton Jones (＠simonpj) 25 Jul '25

25 Jul '25

Simon Peyton Jones pushed to branch wip/T20264 at Glasgow Haskell Compiler / GHC Commits: d03142f5 by Simon Peyton Jones at 2025-07-25T17:46:56+01:00 More wibbles exp around mkPolyAbsLams - - - - - 6 changed files: - compiler/GHC/Core/Opt/Exitify.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/Types/Basic.hs - compiler/GHC/Types/Id.hs Changes: ===================================== compiler/GHC/Core/Opt/Exitify.hs ===================================== @@ -224,16 +224,11 @@ exitifyRec in_scope pairs -- We have something to float out! | otherwise - = do { -- Assemble the RHS of the exit join point - -- Reminder: see GHC.Core.Utils - -- Note [Type-lets and abstracting over free variables] - let rhs = mkCoreAbsLams abs_vars e - avoid = in_scope `extendInScopeSetList` captured - join_arity = count (isNothing . tyVarUnfolding_maybe) abs_vars - -- Remember this binding under a suitable name - ; v <- addExit avoid join_arity rhs - -- And jump to it from here - ; return $ mkAbsVarApps (Var v) abs_vars } + = do { let avoid = in_scope `extendInScopeSetList` captured + -- Create the new join-point binding, recording it in the monad + ; j <- addExitBinding avoid abs_vars e + -- Return a call of that join point + ; return $ mkAbsVarApps (Var j) abs_vars } where -- Used to detect exit expressions that are already proper exit jumps @@ -263,24 +258,27 @@ exitifyRec in_scope pairs captures_join_points = any isJoinId abs_vars -addExit :: InScopeSet -> JoinArity -> CoreExpr -> ExitifyM JoinId -addExit in_scope join_arity rhs +addExitBinding :: InScopeSet -> AbsVars -> CoreExpr -> ExitifyM JoinId +addExitBinding avoid1 abs_vars join_body = do { fs <- S.get - ; let ty = exprType rhs - avoid = in_scope `extendInScopeSetList` (map fst fs) - `extendInScopeSet` exit_id1 -- just cosmetics - -- avoid: pick a new unique, that is disjoint from - -- * the free variables of the whole joinrec - -- * any bound variables (captured) - -- * any exit join points created so far (in `fs`) - - exit_id1 = mkSysLocal (fsLit "exit") initExitJoinUnique ManyTy ty - exit_id2 = uniqAway avoid exit_id1 - - bind_pr@(exit_id3,_) = mkNewJoinPointBinding exit_id2 join_arity rhs - -- NB: mkNewJoinPointBinding does eta-expansion if needed, - -- to make sure that the join-point binding has the - -- right number of lambdas all lined up at the top + ; let join_rhs = mkCoreAbsLams abs_vars join_body + -- mkCoreAbsLams: see GHC.Core.Utils + -- Note [Type-lets and abstracting over free variables] + join_arity = count (isNothing . tyVarUnfolding_maybe) abs_vars + + avoid2 = avoid1 `extendInScopeSetList` (map fst fs) + `extendInScopeSet` exit_id1 -- just cosmetics + -- avoid2: pick a new unique, that is disjoint from + -- * avoid1: the free variables of the whole joinrec + -- plus any bound variables (captured) + -- * adding exit join points created so far (in `fs`) + + join_ty = exprType join_rhs + exit_id1 = mkSysLocal (fsLit "exit") initExitJoinUnique ManyTy join_ty + exit_id2 = uniqAway avoid2 exit_id1 + + bind_pr@(exit_id3,_) = mkNewJoinPointBinding exit_id2 join_arity join_rhs + -- NB: mkNewJoinPointBinding adds the JoinId tag ; S.put (bind_pr : fs) ; return exit_id3 } ===================================== compiler/GHC/Core/Opt/Simplify/Env.hs ===================================== @@ -1095,7 +1095,8 @@ simplBinder !env bndr | otherwise = simplIdBndr env bndr --------------- -simplTyVarBndr :: SimplEnv -> InTyVar -> SimplM (SimplEnv, OutTyVar) +simplTyVarBndr :: HasDebugCallStack + => SimplEnv -> InTyVar -> SimplM (SimplEnv, OutTyVar) simplTyVarBndr env tv = do { let (env', tv1) = substTyVarBndr env tv ; seqTyVar tv1 `seq` return (env', tv1) } @@ -1387,7 +1388,7 @@ substTy env ty = Type.substTy (getTCvSubst env) ty substTyVar :: SimplEnv -> TyVar -> Type substTyVar env tv = Type.substTyVar (getTCvSubst env) tv -substTyVarBndr :: SimplEnv -> TyVar -> (SimplEnv, TyVar) +substTyVarBndr :: HasDebugCallStack => SimplEnv -> TyVar -> (SimplEnv, TyVar) substTyVarBndr env tv = case Type.substTyVarBndr (getTCvSubst env) tv of (Subst in_scope' _ tv_env' cv_env', tv') ===================================== compiler/GHC/Core/Opt/SpecConstr.hs ===================================== @@ -1312,6 +1312,7 @@ data ArgOcc = NoOcc -- Doesn't occur at all; or a type argument | ScrutOcc -- See Note [ScrutOcc] (DataConEnv [ArgOcc]) -- [ArgOcc]: how the sub-components are used + -- /including/ (existential) tyvar binders deadArgOcc :: ArgOcc -> Bool deadArgOcc (ScrutOcc {}) = False @@ -2717,24 +2718,27 @@ argToPat1 env in_scope val_env arg arg_occ _arg_str -- Ignore `_wf` here; see Note [ConVal work-free-ness] (2) , not (ignoreDataCon env dc) -- See Note [NoSpecConstr] , Just arg_occs <- mb_scrut dc - = do { let (ty_args, rest_args) = splitAtList (dataConUnivTyVars dc) args - con_str, matched_str :: [StrictnessMark] - -- con_str corresponds 1-1 with the /value/ arguments - -- matched_str corresponds 1-1 with /all/ arguments + = do { let -- `con_str` corresponds 1-1 with the /value/ arguments + -- `all_str` corresponds 1-1 with /all/ arguments + con_str, all_str :: [StrictnessMark] con_str = dataConRepStrictness dc - matched_str = match_vals con_str rest_args - -- ; pprTraceM "bangs" (ppr (length rest_args == length con_str) $$ - -- ppr dc $$ - -- ppr con_str $$ - -- ppr rest_args $$ - -- ppr (map isTypeArg rest_args)) - ; prs <- zipWith3M (argToPat env in_scope val_env) rest_args arg_occs matched_str - ; let args' = map sndOf3 prs :: [CoreArg] - ; assertPpr (length con_str == length (filter isRuntimeArg rest_args)) - ( ppr con_str $$ ppr rest_args $$ - ppr (length con_str) $$ ppr (length rest_args) - ) $ return () - ; return (True, mkConApp dc (ty_args ++ args'), concat (map thdOf3 prs)) } + all_str = match_vals con_str args + + -- `arg_occs` corresponnds 1-1 with the binders of a data con + -- pattern, which omits the universal tyvars. We extend with + -- `UnkOcc` for the universals to get `all_arg_occs` + all_arg_occs :: [ArgOcc] + all_arg_occs = map (const UnkOcc) (dataConUnivTyVars dc) ++ arg_occs + + ; triples :: [(Bool, CoreArg, [Id])] <- zipWith3M (argToPat env in_scope val_env) + args all_arg_occs all_str + + ; let args' = map sndOf3 triples :: [CoreArg] + cbv_ids = concat (map thdOf3 triples) :: [Id] + + ; assertPpr (length con_str == valArgCount args) + (ppr dc $$ ppr args $$ ppr arg_occs) $ + return (True, mkConApp dc args', cbv_ids) } where mb_scrut dc = case arg_occ of ScrutOcc bs | Just occs <- lookupUFM bs dc @@ -2743,6 +2747,8 @@ argToPat1 env in_scope val_env arg arg_occ _arg_str -> Just (repeat UnkOcc) | otherwise -> Nothing + + match_vals :: [StrictnessMark] -> [CoreExpr] -> [StrictnessMark] match_vals bangs (arg:args) | isTypeArg arg = NotMarkedStrict : match_vals bangs args @@ -2828,6 +2834,8 @@ mkTyPat :: InScopeSet -> Type -> Type -- The tyvars `a` and `b` might have been in scope at the call site, -- but not at the definition site. We want a call pattern -- f @a @a (K @a) a +-- Here we are silently relying on non-shadowing; it's no good if a +-- /different/ `b` is in scope at the definition site! mkTyPat in_scope ty = expandSomeTyVarUnfoldings not_in_scope ty where ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -3115,26 +3115,56 @@ type AbsVar = Var type AbsVars = [AbsVar] type TaggedAbsVars t = [TaggedBndr t] -mkPolyAbsLams :: (b -> AbsVar, Var -> b -> b) - -> [b] -> Expr b -> Expr b +mkPolyAbsLams :: forall b. (b -> AbsVar, Var -> b -> b) + -> [b] -> Expr b -> Expr b -- `mkPolyAbsLams` is polymorphic in (get,set) so that we can -- use it for both CoreExpr and LevelledExpr {-# INLINE mkPolyAbsLams #-} -mkPolyAbsLams (get,set) bndrs body - = go bndrs +mkPolyAbsLams (getter,setter) bndrs body + = go emptyVarSet [] bndrs where - go [] = body - go (bndr:bndrs) + go :: TyVarSet -- Earlier TyVar bndrs that have TyVarUnfoldings + -> [Bind b] -- Accumulated impedence-matching bindings (reversed) + -> [b] -- Binders, bs + -> Expr b -- The resulting lambda + go _ binds [] = mkLets (reverse binds) body + + go unf_tvs binds (bndr:bndrs) + | Just ty <- tyVarUnfolding_maybe var - = Let (NonRec bndr (Type ty)) $ - go bndrs + = go (unf_tvs `extendVarSet` var) (NonRec bndr (Type ty) : binds) bndrs + + | isTyVar var, change_ty + , let binds' | isDeadBinder var = binds + | otherwise = NonRec bndr (Type (mkTyVarTy var1)) : binds + = Lam (setter var1 bndr) (go unf_tvs binds' bndrs) + + | isId var, change_ty || change_unf + , let binds' | isDeadBinder var = binds + | otherwise = NonRec bndr (Var id2) : binds + = Lam (setter id2 bndr) (go unf_tvs binds' bndrs) + | otherwise - = Lam bndr' (go bndrs) + = Lam bndr (go unf_tvs binds bndrs) where - var = get bndr - -- zap: We are going to lambda-abstract, so nuke any IdInfo - bndr' | isId var = set (setIdInfo var vanillaIdInfo) bndr - | otherwise = bndr + var = getter bndr + var_ty = varType var + + (change_ty, var1) = update_type var + (change_unf, id2) = zap_unfolding var1 -- Only used for Ids + + -- zap_unfolding: We are going to lambda-abstract, so nuke any IdInfo + zap_unfolding var | isId var, hasSomeUnfolding (idUnfolding var) + = (True, setIdInfo var vanillaIdInfo) + | otherwise + = (False, var) + + -- update_type: expand unfoldings of any tyvars in `unf_tvs` + update_type var | not (isEmptyVarSet unf_tvs) + , anyFreeVarsOfType (`elemVarSet` unf_tvs) var_ty + = (True, setVarType var (expandTyVarUnfoldings unf_tvs var_ty)) + | otherwise + = (False, var) mkCoreAbsLams :: AbsVars -> CoreExpr -> CoreExpr -- Specialise for CoreExpr ===================================== compiler/GHC/Types/Basic.hs ===================================== @@ -73,7 +73,7 @@ module GHC.Types.Basic ( isDeadOcc, isStrongLoopBreaker, isWeakLoopBreaker, isManyOccs, isNoOccInfo, strongLoopBreaker, weakLoopBreaker, - TyCoOccInfo(..), plusTyCoOccInfo, isOneTyCoOcc, + TyCoOccInfo(..), plusTyCoOccInfo, isOneTyCoOcc, isDeadTyCoOcc, InsideLam(..), BranchCount, oneBranch, @@ -1395,6 +1395,10 @@ isOneTyCoOcc :: TyCoOccInfo -> Bool isOneTyCoOcc TyCoOne = True isOneTyCoOcc _ = False +isDeadTyCoOcc :: TyCoOccInfo -> Bool +isDeadTyCoOcc TyCoDead = True +isDeadTyCoOcc _ = False + plusTyCoOccInfo :: TyCoOccInfo -> TyCoOccInfo -> TyCoOccInfo plusTyCoOccInfo TyCoDead occ = occ plusTyCoOccInfo occ TyCoDead = occ ===================================== compiler/GHC/Types/Id.hs ===================================== @@ -133,12 +133,7 @@ import GHC.Types.Id.Info import GHC.Types.Basic -- Imported and re-exported -import GHC.Types.Var( Id, CoVar, JoinId, - InId, InVar, - OutId, OutVar, - idInfo, idDetails, setIdDetails, globaliseId, idMult, - isId, isLocalId, isGlobalId, isExportedId, - setIdMult, updateIdTypeAndMult, updateIdTypeButNotMult, updateIdTypeAndMultM) +import GHC.Types.Var import qualified GHC.Types.Var as Var import GHC.Core ( CoreExpr, CoreRule, Unfolding(..), IdUnfoldingFun @@ -233,12 +228,6 @@ setIdUnique = Var.setVarUnique setIdType :: Id -> Type -> Id setIdType id ty = seqType ty `seq` Var.setVarType id ty -setIdExported :: Id -> Id -setIdExported = Var.setIdExported - -setIdNotExported :: Id -> Id -setIdNotExported = Var.setIdNotExported - localiseId :: Id -> Id -- Make an Id with the same unique and type as the -- incoming Id, but with an *Internal* Name and *LocalId* flavour @@ -250,9 +239,6 @@ localiseId id where name = idName id -lazySetIdInfo :: Id -> IdInfo -> Id -lazySetIdInfo = Var.lazySetIdInfo - setIdInfo :: Id -> IdInfo -> Id setIdInfo id info = info `seq` (lazySetIdInfo id info) -- Try to avoid space leaks by seq'ing @@ -624,9 +610,12 @@ isImplicitId id idIsFrom :: Module -> Id -> Bool idIsFrom mod id = nameIsLocalOrFrom mod (idName id) -isDeadBinder :: Id -> Bool -isDeadBinder bndr | isId bndr = isDeadOcc (idOccInfo bndr) - | otherwise = False -- TyVars count as not dead +isDeadBinder :: Var -> Bool +-- This predicate works on any Var, not just Ids +-- So this module isn't the ideal place for it; but moving it +-- elsewhere just gives silly module loops +isDeadBinder bndr | isId bndr = isDeadOcc (idOccInfo bndr) + | otherwise = isDeadTyCoOcc (tyVarOccInfo bndr) {- ************************************************************************ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d03142f5aa758ee1298296d3e5c9384… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d03142f5aa758ee1298296d3e5c9384… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 8 commits: Renaming around predicate types
by Marge Bot (＠marge-bot) 25 Jul '25

25 Jul '25

Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: a49eca26 by Simon Peyton Jones at 2025-07-25T09:49:58+01:00 Renaming around predicate types .. we were (as it turned out) abstracting over type-class selectors in SPECIALISATION rules! Wibble isEqPred - - - - - f80375dd by Simon Peyton Jones at 2025-07-25T09:49:58+01:00 Refactor of Specialise.hs This patch just tidies up `specHeader` a bit, removing one of its many results, and adding some comments. No change in behaviour. Also add a few more `HasDebugCallStack` contexts. - - - - - 1bd12371 by Simon Peyton Jones at 2025-07-25T09:49:58+01:00 Improve treatment of SPECIALISE pragmas -- again! This MR does another major refactor of the way that SPECIALISE pragmas work, to fix #26115, #26116, #26117. * We now /always/ solve forall-constraints in an all-or-nothing way. See Note [Solving a Wanted forall-constraint] in GHC.Tc.Solver.Solve This means we might have unsolved quantified constraints, which need to be reported. See `inert_insts` in `getUnsolvedInerts`. * I refactored the short-cut solver for type classes to work by recursively calling the solver rather than by having a little baby solver that kept being not clever enough. See Note [Shortcut solving] in GHC.Tc.Solver.Dict * I totally rewrote the desugaring of SPECIALISE pragmas, again. The new story is in Note [Desugaring new-form SPECIALISE pragmas] in GHC.HsToCore.Binds Both old-form and new-form SPECIALISE pragmas now route through the same function `dsSpec_help`. The tricky function `decomposeRuleLhs` is now used only for user-written RULES, not for SPECIALISE pragmas. * I improved `solveOneFromTheOther` to account for rewriter sets. Previously it would solve a non-rewritten dict from a rewritten one. For equalities we were already dealing with this, in Some incidental refactoring * A small refactor: `ebv_tcvs` in `EvBindsBar` now has a list of coercions, rather than a set of tyvars. We just delay taking the free vars. * GHC.Core.FVs.exprFVs now returns /all/ free vars. Use `exprLocalFVs` for Local vars. Reason: I wanted another variant for /evidence/ variables. * Ues `EvId` in preference to `EvVar`. (Evidence variables are always Ids.) Rename `isEvVar` to `isEvId`. * I moved `inert_safehask` out of `InertCans` and into `InertSet` where it more properly belongs. Compiler-perf changes: * There was a palpable bug (#26117) which this MR fixes in newWantedEvVar, which bypassed all the subtle overlapping-Given and shortcutting logic. (See the new `newWantedEvVar`.) Fixing this but leads to extra dictionary bindings; they are optimised away quickly but they made CoOpt_Read allocate 3.6% more. * Hpapily T15164 improves. * The net compiler-allocation change is 0.0% Metric Decrease: T15164 Metric Increase: CoOpt_Read T12425 - - - - - 953fd8f1 by Simon Peyton Jones at 2025-07-25T09:49:58+01:00 Solve forall-constraints immediately, or not at all This MR refactors the constraint solver to solve forall-constraints immediately, rather than emitting an implication constraint to be solved later. The most immediate motivation was that when solving quantified constraints in SPECIALISE pragmas, we really really don't want to leave behind half- solved implications. Also it's in tune with the approach of the new short-cut solver, which recursively invokes the solver. It /also/ saves quite a bit of plumbing; e.g - The `wl_implics` field of `WorkList` is gone, - The types of `solveSimpleWanteds` and friends are simplified. - An EvFun contains binding, rather than an EvBindsVar ref-cell that will in the future contain bindings. That makes `evVarsOfTerm` simpler. Much nicer. It also improves error messages a bit. All described in Note [Solving a Wanted forall-constraint] in GHC.Tc.Solver.Solve. One tiresome point: in the tricky case of `inferConstraintsCoerceBased` we make a forall-constraint. This we /do/ want to partially solve, so we can infer a suitable context. (I'd be quite happy to force the user to write a context, bt I don't want to change behavior.) So we want to generate an /implication/ constraint in `emitPredSpecConstraints` rather than a /forall-constraint/ as we were doing before. Discussed in (WFA3) of the above Note. Incidental refactoring * `GHC.Tc.Deriv.Infer.inferConstraints` was consulting the state monad for the DerivEnv that the caller had just consulted. Nicer to pass it as an argument I think, so I have done that. No change in behaviour. - - - - - 6921ab42 by Simon Peyton Jones at 2025-07-25T09:49:58+01:00 Remove duplicated code in Ast.hs for evTermFreeVars This is just a tidy up. - - - - - 1165f587 by Simon Peyton Jones at 2025-07-25T09:49:58+01:00 Small tc-tracing changes only - - - - - 3cbf1dd2 by Simon Hengel at 2025-07-25T12:06:23-04:00 Respect `-fdiagnostics-as-json` for core diagnostics (see #24113) - - - - - d11d023a by Andrew Lelechenko at 2025-07-25T12:06:23-04:00 docs: add since pragma to Data.List.NonEmpty.mapMaybe - - - - - 80 changed files: - compiler/GHC/Core.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Make.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Predicate.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/Subst.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/Unfold/Make.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Errors/Ppr.hs - compiler/GHC/HsToCore/Pmc/Solver/Types.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Tc/Deriv.hs - compiler/GHC/Tc/Deriv/Infer.hs - compiler/GHC/Tc/Deriv/Utils.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/Gen/Sig.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Default.hs - compiler/GHC/Tc/Solver/Dict.hs - compiler/GHC/Tc/Solver/Equality.hs - compiler/GHC/Tc/Solver/InertSet.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Solver/Rewrite.hs - compiler/GHC/Tc/Solver/Solve.hs - + compiler/GHC/Tc/Solver/Solve.hs-boot - compiler/GHC/Tc/Solver/Types.hs - compiler/GHC/Tc/TyCl/PatSyn.hs - compiler/GHC/Tc/Types/Constraint.hs - compiler/GHC/Tc/Types/Evidence.hs - compiler/GHC/Tc/Types/Origin.hs - compiler/GHC/Tc/Utils/Monad.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Utils/Unify.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Tc/Zonk/Type.hs - compiler/GHC/Types/Var.hs - libraries/base/src/Data/List/NonEmpty.hs - testsuite/tests/deriving/should_compile/T20815.hs - testsuite/tests/deriving/should_fail/T12768.stderr - testsuite/tests/deriving/should_fail/T1496.stderr - testsuite/tests/deriving/should_fail/T5498.stderr - testsuite/tests/deriving/should_fail/T7148.stderr - testsuite/tests/deriving/should_fail/T7148a.stderr - testsuite/tests/hiefile/should_run/HieQueries.stdout - testsuite/tests/impredicative/T17332.stderr - testsuite/tests/quantified-constraints/T15290a.stderr - testsuite/tests/quantified-constraints/T19690.stderr - testsuite/tests/quantified-constraints/T19921.stderr - testsuite/tests/quantified-constraints/T21006.stderr - testsuite/tests/roles/should_fail/RolesIArray.stderr - + testsuite/tests/simplCore/should_compile/T26115.hs - + testsuite/tests/simplCore/should_compile/T26115.stderr - + testsuite/tests/simplCore/should_compile/T26116.hs - + testsuite/tests/simplCore/should_compile/T26116.stderr - + testsuite/tests/simplCore/should_compile/T26117.hs - + testsuite/tests/simplCore/should_compile/T26117.stderr - testsuite/tests/simplCore/should_compile/all.T - testsuite/tests/typecheck/should_compile/T12427a.stderr - testsuite/tests/typecheck/should_compile/T23171.hs - testsuite/tests/typecheck/should_compile/TcSpecPragmas.stderr - testsuite/tests/typecheck/should_fail/T14605.hs - testsuite/tests/typecheck/should_fail/T14605.stderr - testsuite/tests/typecheck/should_fail/T15801.stderr - testsuite/tests/typecheck/should_fail/T18640a.stderr - testsuite/tests/typecheck/should_fail/T18640b.stderr - testsuite/tests/typecheck/should_fail/T19627.stderr - testsuite/tests/typecheck/should_fail/T21530b.stderr - testsuite/tests/typecheck/should_fail/T22912.stderr - testsuite/tests/typecheck/should_fail/tcfail174.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a196da4c36b9e7bcc5423a2e121f8d… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a196da4c36b9e7bcc5423a2e121f8d… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/romes/26227] 5 commits: ghc-toolchain: Move TgtHasLibm to per-Target file
by Rodrigo Mesquita (＠alt-romes) 25 Jul '25

25 Jul '25

Rodrigo Mesquita pushed to branch wip/romes/26227 at Glasgow Haskell Compiler / GHC Commits: cb228d86 by Rodrigo Mesquita at 2025-07-25T17:06:08+01:00 ghc-toolchain: Move TgtHasLibm to per-Target file TargetHasLibm is now part of the per-target configuration Towards #26227 - - - - - 562b2551 by Rodrigo Mesquita at 2025-07-25T17:06:12+01:00 ghc-toolchain: Move UseLibdw to per-Target file To support DWARF unwinding, the RTS must be built with the -f+libdw flag and with the -DUSE_LIBDW macro definition. These flags are passed on build by Hadrian when --enable-dwarf-unwinding is specified at configure time. Whether the RTS was built with support for DWARF is a per-target property, and as such, it was moved to the per-target GHC.Toolchain.Target.Target file. Additionally, we keep in the target file the include and library paths for finding libdw, since libdw should be checked at configure time (be it by configure, or ghc-toolchain, that libdw is properly available). Preserving the user-given include paths for libdw facilitates in the future building the RTS on demand for a given target (if we didn't keep that user input, we couldn't) Towards #26227 - - - - - ea6f901b by Rodrigo Mesquita at 2025-07-25T17:06:15+01:00 ghc-toolchain: Make "Support SMP" a query on a Toolchain.Target "Support SMP" is merely a function of target, so we can represent it as such in `ghc-toolchain`. Hadrian queries the Target using this predicate to determine how to build GHC, and GHC queries the Target similarly to report under --info whether it "Support SMP" Towards #26227 - - - - - 4754b0fd by Rodrigo Mesquita at 2025-07-25T17:06:16+01:00 ghc-toolchain: Make "tgt rts linker only supports shared libs" function on Target Just like with "Support SMP", "target RTS linker only supports shared libraries" is a predicate on a `Target` so we can just compute it when necessary from the given `Target`. Towards #26227 - - - - - 059c5ac3 by Rodrigo Mesquita at 2025-07-25T17:06:16+01:00 WIP on Use interpreter - - - - - 19 changed files: - compiler/GHC/Driver/Session.hs - compiler/GHC/Settings/IO.hs - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cfg/default.host.target.in - hadrian/cfg/default.target.in - hadrian/cfg/system.config.in - hadrian/src/Oracles/Flag.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Settings/Packages.hs - m4/fp_find_libdw.m4 - m4/ghc_toolchain.m4 - m4/prep_target_file.m4 - utils/ghc-toolchain/exe/Main.hs - utils/ghc-toolchain/ghc-toolchain.cabal - + utils/ghc-toolchain/src/GHC/Toolchain/Library.hs - utils/ghc-toolchain/src/GHC/Toolchain/PlatformDetails.hs - utils/ghc-toolchain/src/GHC/Toolchain/Target.hs Changes: ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -3498,8 +3498,10 @@ compilerInfo dflags ("target word size", query $ show . wordSize2Bytes . tgtWordSize), ("target word big endian", queryBool $ (\case BigEndian -> True; LittleEndian -> False) . tgtEndianness), ("target has GNU nonexec stack", queryBool tgtSupportsGnuNonexecStack), + ("target has libm", queryBool tgtHasLibm), ("target has .ident directive", queryBool tgtSupportsIdentDirective), ("target has subsections via symbols", queryBool tgtSupportsSubsectionsViaSymbols), + ("target RTS linker only supports shared libraries", queryBool tgtRTSLinkerOnlySupportsSharedLibs) ("Unregisterised", queryBool tgtUnregisterised), ("LLVM target", query tgtLlvmTarget), ("LLVM llc command", queryCmdMaybe id tgtLlc), @@ -3507,7 +3509,8 @@ compilerInfo dflags ("LLVM llvm-as command", queryCmdMaybe id tgtLlvmAs), ("LLVM llvm-as flags", queryFlagsMaybe id tgtLlvmAs), ("Tables next to code", queryBool tgtTablesNextToCode), - ("Leading underscore", queryBool tgtSymbolsHaveLeadingUnderscore) + ("Leading underscore", queryBool tgtSymbolsHaveLeadingUnderscore), + ("RTS expects libdw", queryBool (isJust . tgtRTSWithLibdw)) ] ++ [("Project version", projectVersion dflags), ("Project Git commit id", cProjectGitCommitId), @@ -3525,6 +3528,9 @@ compilerInfo dflags ("target os string", stringEncodeOS (platformOS (targetPlatform dflags))), ("target arch string", stringEncodeArch (platformArch (targetPlatform dflags))), ("target word size in bits", show (platformWordSizeInBits (targetPlatform dflags))), + -- keep "duplicate" of "Have interpreter" for backwards compatibility, + -- since we used to show both... + ("Use interpreter", showBool $ platformMisc_ghcWithInterpreter $ platformMisc dflags), ("Have interpreter", showBool $ platformMisc_ghcWithInterpreter $ platformMisc dflags), ("Object splitting supported", showBool False), ("Have native code generator", showBool $ platformNcgSupported platform), @@ -3544,6 +3550,7 @@ compilerInfo dflags -- If true, we require that the 'id' field in installed package info -- match what is passed to the @-this-unit-id@ flag for modules -- built in it + ("Support SMP", queryBool tgtSupportsSMP), ("Requires unified installed package IDs", "YES"), -- Whether or not we support the @-this-package-key@ flag. Prefer -- "Uses unit IDs" over it. We still say yes even if @-this-package-key@ ===================================== compiler/GHC/Settings/IO.hs ===================================== @@ -97,10 +97,6 @@ initSettings top_dir = do getTool :: (Target -> Program) -> (String, [String]) getTool key = (getToolPath key, getToolFlags key) - -- See Note [Settings file] for a little more about this file. We're - -- just partially applying those functions and throwing 'Left's; they're - -- written in a very portable style to keep ghc-boot light. - targetHasLibm <- getBooleanSetting "target has libm" let (cc_prog, cc_args0) = getTool (ccProgram . tgtCCompiler) (cxx_prog, cxx_args) = getTool (cxxProgram . tgtCxxCompiler) @@ -109,7 +105,7 @@ initSettings top_dir = do (js_cpp_prog, js_cpp_args) = getTool (maybe (Program "" []) jsCppProgram . tgtJsCPreprocessor) (cmmCpp_prog, cmmCpp_args) = getTool (cmmCppProgram . tgtCmmCPreprocessor) - platform = getTargetPlatform targetHasLibm target + platform = getTargetPlatform target unreg_cc_args = if platformUnregisterised platform then ["-DNO_REGS", "-DUSE_MINIINTERPRETER"] @@ -150,7 +146,6 @@ initSettings top_dir = do pure (ld_r_path, map Option ld_r_args) iserv_prog = libexec "ghc-iserv" - targetRTSLinkerOnlySupportsSharedLibs <- getBooleanSetting "target RTS linker only supports shared libraries" ghcWithInterpreter <- getBooleanSetting "Use interpreter" baseUnitId <- getSetting_raw "base unit-id" @@ -235,15 +230,15 @@ initSettings top_dir = do , platformMisc_ghcWithInterpreter = ghcWithInterpreter , platformMisc_libFFI = tgtUseLibffiForAdjustors target , platformMisc_llvmTarget = tgtLlvmTarget target - , platformMisc_targetRTSLinkerOnlySupportsSharedLibs = targetRTSLinkerOnlySupportsSharedLibs + , platformMisc_targetRTSLinkerOnlySupportsSharedLibs = tgtRTSLinkerOnlySupportsSharedLibs target } , sRawSettings = settingsList , sRawTarget = target } -getTargetPlatform :: Bool {-^ Does target have libm -} -> Target -> Platform -getTargetPlatform targetHasLibm Target{..} = Platform +getTargetPlatform :: Target -> Platform +getTargetPlatform Target{..} = Platform { platformArchOS = tgtArchOs , platformWordSize = case tgtWordSize of WS4 -> PW4 WS8 -> PW8 @@ -255,6 +250,6 @@ getTargetPlatform targetHasLibm Target{..} = Platform , platformIsCrossCompiling = not tgtLocallyExecutable , platformLeadingUnderscore = tgtSymbolsHaveLeadingUnderscore , platformTablesNextToCode = tgtTablesNextToCode - , platformHasLibm = targetHasLibm + , platformHasLibm = tgtHasLibm , platform_constants = Nothing -- will be filled later when loading (or building) the RTS unit } ===================================== hadrian/bindist/Makefile ===================================== @@ -85,13 +85,9 @@ WrapperBinsDir=${bindir} # N.B. this is duplicated from includes/ghc.mk. lib/settings : config.mk @rm -f $@ - @echo '[("target has libm", "$(TargetHasLibm)")' >> $@ - @echo ',("unlit command", "$$topdir/../bin/$(CrossCompilePrefix)unlit")' >> $@ - @echo ',("target RTS linker only supports shared libraries", "$(TargetRTSLinkerOnlySupportsSharedLibs)")' >> $@ + @echo '[("unlit command", "$$topdir/../bin/$(CrossCompilePrefix)unlit")' >> $@ @echo ',("Use interpreter", "$(GhcWithInterpreter)")' >> $@ - @echo ',("Support SMP", "$(GhcWithSMP)")' >> $@ @echo ',("RTS ways", "$(GhcRTSWays)")' >> $@ - @echo ',("RTS expects libdw", "$(GhcRtsWithLibdw)")' >> $@ @echo ',("Relative Global Package DB", "package.conf.d")' >> $@ @echo ',("base unit-id", "$(BaseUnitId)")' >> $@ @echo "]" >> $@ ===================================== hadrian/bindist/config.mk.in ===================================== @@ -172,7 +172,7 @@ UseLibffiForAdjustors=@UseLibffiForAdjustors@ # GHC needs arch-specific tweak at least in # rts/Libdw.c:set_initial_registers() -GhcRtsWithLibdw=$(strip $(if $(filter $(TargetArch_CPP),i386 x86_64 s390x),@UseLibdw@,NO)) +UseLibdw=$(strip $(if $(filter $(TargetArch_CPP),i386 x86_64 s390x),@UseLibdw@,NO)) #----------------------------------------------------------------------------- # Settings ===================================== hadrian/cfg/default.host.target.in ===================================== @@ -12,6 +12,8 @@ Target , tgtUnregisterised = False , tgtTablesNextToCode = True , tgtUseLibffiForAdjustors = True +, tgtHasLibm = True +, tgtRTSWithLibdw = Nothing , tgtCCompiler = Cc {ccProgram = Program {prgPath = "@CC_STAGE0@", prgFlags = @CONF_CC_OPTS_STAGE0List@}} , tgtCxxCompiler = Cxx {cxxProgram = Program {prgPath = "@CC_STAGE0@", prgFlags = @CONF_CXX_OPTS_STAGE0List@}} , tgtCPreprocessor = Cpp {cppProgram = Program {prgPath = "@CPPCmd_STAGE0@", prgFlags = @CONF_CPP_OPTS_STAGE0List@}} ===================================== hadrian/cfg/default.target.in ===================================== @@ -12,6 +12,8 @@ Target , tgtUnregisterised = @UnregisterisedBool@ , tgtTablesNextToCode = @TablesNextToCodeBool@ , tgtUseLibffiForAdjustors = @UseLibffiForAdjustorsBool@ +, tgtHasLibm = @TargetHasLibmBool@ +, tgtRTSWithLibdw = @UseLibdwMaybeLibrary@ , tgtCCompiler = Cc {ccProgram = Program {prgPath = "@CC@", prgFlags = @CONF_CC_OPTS_STAGE2List@}} , tgtCxxCompiler = Cxx {cxxProgram = Program {prgPath = "@CXX@", prgFlags = @CONF_CXX_OPTS_STAGE2List@}} , tgtCPreprocessor = Cpp {cppProgram = Program {prgPath = "@CPPCmd@", prgFlags = @CONF_CPP_OPTS_STAGE2List@}} ===================================== hadrian/cfg/system.config.in ===================================== @@ -81,8 +81,6 @@ project-git-commit-id = @ProjectGitCommitId@ # See Note [tooldir: How GHC finds mingw on Windows] settings-use-distro-mingw = @EnableDistroToolchain@ -target-has-libm = @TargetHasLibm@ - # Include and library directories: #================================= @@ -101,9 +99,6 @@ use-system-ffi = @UseSystemLibFFI@ ffi-include-dir = @FFIIncludeDir@ ffi-lib-dir = @FFILibDir@ -libdw-include-dir = @LibdwIncludeDir@ -libdw-lib-dir = @LibdwLibDir@ - libnuma-include-dir = @LibNumaIncludeDir@ libnuma-lib-dir = @LibNumaLibDir@ @@ -113,7 +108,6 @@ libzstd-lib-dir = @LibZstdLibDir@ # Optional Dependencies: #======================= -use-lib-dw = @UseLibdw@ use-lib-zstd = @UseLibZstd@ static-lib-zstd = @UseStaticLibZstd@ use-lib-numa = @UseLibNuma@ ===================================== hadrian/src/Oracles/Flag.hs ===================================== @@ -7,7 +7,7 @@ module Oracles.Flag ( targetRTSLinkerOnlySupportsSharedLibs, targetSupportsThreadedRts, targetSupportsSMP, - useLibffiForAdjustors, + useLibffiForAdjustors, useLibdw, arSupportsDashL, arSupportsAtFile ) where @@ -29,7 +29,6 @@ data Flag = CrossCompiling | UseSystemFfi | BootstrapThreadedRts | BootstrapEventLoggingRts - | UseLibdw | UseLibnuma | UseLibzstd | StaticLibzstd @@ -53,7 +52,6 @@ flag f = do UseSystemFfi -> "use-system-ffi" BootstrapThreadedRts -> "bootstrap-threaded-rts" BootstrapEventLoggingRts -> "bootstrap-event-logging-rts" - UseLibdw -> "use-lib-dw" UseLibnuma -> "use-lib-numa" UseLibzstd -> "use-lib-zstd" StaticLibzstd -> "static-lib-zstd" @@ -82,23 +80,8 @@ platformSupportsGhciObjects = do only_shared_libs <- targetRTSLinkerOnlySupportsSharedLibs pure $ has_merge_objs && not only_shared_libs --- | Does the target RTS linker only support loading shared libraries? --- If true, this has several implications: --- 1. The GHC driver must not do loadArchive/loadObj etc and must --- always do loadDLL, regardless of whether host GHC is dynamic or --- not. --- 2. The GHC driver will always enable -dynamic-too when compiling --- vanilla way with TH codegen requirement. --- 3. ghci will always enforce dynamic ways even if -dynamic or --- -dynamic-too is not explicitly passed. --- 4. Cabal must not build ghci objects since it's not supported by --- the target. --- 5. The testsuite driver will use dyn way for TH/ghci tests even --- when host GHC is static. --- 6. TH/ghci doesn't work if stage1 is built without shared libraries --- (e.g. quickest/fully_static). targetRTSLinkerOnlySupportsSharedLibs :: Action Bool -targetRTSLinkerOnlySupportsSharedLibs = anyTargetArch [ ArchWasm32 ] +targetRTSLinkerOnlySupportsSharedLibs = queryTargetTarget Toolchain.tgtRTSLinkerOnlySupportsSharedLibs arSupportsDashL :: Stage -> Action Bool arSupportsDashL stage = Toolchain.arSupportsDashL . tgtAr <$> targetStage stage @@ -123,27 +106,10 @@ targetSupportsThreadedRts = do -- | Does the target support the -N RTS flag? targetSupportsSMP :: Action Bool -targetSupportsSMP = do - unreg <- queryTargetTarget tgtUnregisterised - armVer <- targetArmVersion - goodArch <- (||) <$> - anyTargetArch [ ArchX86 - , ArchX86_64 - , ArchPPC - , ArchPPC_64 ELF_V1 - , ArchPPC_64 ELF_V2 - , ArchAArch64 - , ArchS390X - , ArchRISCV64 - , ArchLoongArch64 ] <*> isArmTarget - if -- The THREADED_RTS requires `BaseReg` to be in a register and the - -- Unregisterised mode doesn't allow that. - | unreg -> return False - -- We don't support load/store barriers pre-ARMv7. See #10433. - | Just ver <- armVer - , ver < ARMv7 -> return False - | goodArch -> return True - | otherwise -> return False +targetSupportsSMP = queryTargetTarget Toolchain.tgtSupportsSMP useLibffiForAdjustors :: Action Bool useLibffiForAdjustors = queryTargetTarget tgtUseLibffiForAdjustors + +useLibdw :: Action Bool +useLibdw = queryTargetTarget (isJust . tgtRTSWithLibdw) ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -54,8 +54,6 @@ data Setting = CursesIncludeDir | GmpLibDir | IconvIncludeDir | IconvLibDir - | LibdwIncludeDir - | LibdwLibDir | LibnumaIncludeDir | LibnumaLibDir | LibZstdIncludeDir @@ -94,8 +92,6 @@ setting key = lookupSystemConfig $ case key of GmpLibDir -> "gmp-lib-dir" IconvIncludeDir -> "iconv-include-dir" IconvLibDir -> "iconv-lib-dir" - LibdwIncludeDir -> "libdw-include-dir" - LibdwLibDir -> "libdw-lib-dir" LibnumaIncludeDir -> "libnuma-include-dir" LibnumaLibDir -> "libnuma-lib-dir" LibZstdIncludeDir -> "libzstd-include-dir" ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -432,7 +432,7 @@ bindistRules = do , interpolateVar "TargetWordBigEndian" $ getTarget isBigEndian , interpolateVar "TargetWordSize" $ getTarget wordSize , interpolateVar "Unregisterised" $ yesNo <$> getTarget tgtUnregisterised - , interpolateVar "UseLibdw" $ fmap yesNo $ interp $ getFlag UseLibdw + , interpolateVar "UseLibdw" $ yesNo <$> getTarget (isJust . tgtRTSWithLibdw) , interpolateVar "UseLibffiForAdjustors" $ yesNo <$> getTarget tgtUseLibffiForAdjustors , interpolateVar "GhcWithSMP" $ yesNo <$> targetSupportsSMP , interpolateVar "BaseUnitId" $ pkgUnitId Stage1 base @@ -484,12 +484,8 @@ generateSettings settingsFile = do settings <- traverse sequence $ [ ("unlit command", ("$topdir/../bin/" <>) <$> expr (programName (ctx { Context.package = unlit }))) - , ("target has libm", expr $ lookupSystemConfig "target-has-libm") - , ("target RTS linker only supports shared libraries", expr $ yesNo <$> targetRTSLinkerOnlySupportsSharedLibs) , ("Use interpreter", expr $ yesNo <$> ghcWithInterpreter (predStage stage)) - , ("Support SMP", expr $ yesNo <$> targetSupportsSMP) , ("RTS ways", escapeArgs . map show . Set.toList <$> getRtsWays) - , ("RTS expects libdw", yesNo <$> getFlag UseLibdw) , ("Relative Global Package DB", pure rel_pkg_db) , ("base unit-id", pure base_unit_id) ] ===================================== hadrian/src/Settings/Packages.hs ===================================== @@ -8,6 +8,7 @@ import Packages import Settings import Settings.Builders.Common (wayCcArgs) +import qualified GHC.Toolchain.Library as Lib import GHC.Toolchain.Target import GHC.Platform.ArchOS import Data.Version.Extra @@ -304,8 +305,8 @@ rtsPackageArgs = package rts ? do useSystemFfi <- getFlag UseSystemFfi ffiIncludeDir <- getSetting FfiIncludeDir ffiLibraryDir <- getSetting FfiLibDir - libdwIncludeDir <- getSetting LibdwIncludeDir - libdwLibraryDir <- getSetting LibdwLibDir + libdwIncludeDir <- queryTarget (Lib.includePath <=< tgtRTSWithLibdw) + libdwLibraryDir <- queryTarget (Lib.libraryPath <=< tgtRTSWithLibdw) libnumaIncludeDir <- getSetting LibnumaIncludeDir libnumaLibraryDir <- getSetting LibnumaLibDir libzstdIncludeDir <- getSetting LibZstdIncludeDir @@ -443,7 +444,7 @@ rtsPackageArgs = package rts ? do , flag UseLibpthread `cabalFlag` "need-pthread" , flag UseLibbfd `cabalFlag` "libbfd" , flag NeedLibatomic `cabalFlag` "need-atomic" - , flag UseLibdw `cabalFlag` "libdw" + , useLibdw `cabalFlag` "libdw" , flag UseLibnuma `cabalFlag` "libnuma" , flag UseLibzstd `cabalFlag` "libzstd" , flag StaticLibzstd `cabalFlag` "static-libzstd" @@ -453,7 +454,7 @@ rtsPackageArgs = package rts ? do , Debug `wayUnit` way `cabalFlag` "find-ptr" ] , builder (Cabal Setup) ? mconcat - [ cabalExtraDirs libdwIncludeDir libdwLibraryDir + [ useLibdw ? cabalExtraDirs (fromMaybe "" libdwIncludeDir) (fromMaybe "" libdwLibraryDir) , cabalExtraDirs libnumaIncludeDir libnumaLibraryDir , cabalExtraDirs libzstdIncludeDir libzstdLibraryDir , useSystemFfi ? cabalExtraDirs ffiIncludeDir ffiLibraryDir @@ -467,7 +468,7 @@ rtsPackageArgs = package rts ? do , builder HsCpp ? pure [ "-DTOP=" ++ show top ] - , builder HsCpp ? flag UseLibdw ? arg "-DUSE_LIBDW" ] + , builder HsCpp ? useLibdw ? arg "-DUSE_LIBDW" ] -- Compile various performance-critical pieces *without* -fPIC -dynamic -- even when building a shared library. If we don't do this, then the ===================================== m4/fp_find_libdw.m4 ===================================== @@ -29,11 +29,11 @@ AC_DEFUN([FP_FIND_LIBDW], AC_ARG_ENABLE(dwarf-unwind, [AS_HELP_STRING([--enable-dwarf-unwind], [Enable DWARF unwinding support in the runtime system via elfutils' libdw [default=no]])], - [], - [enable_dwarf_unwind=no]) + [FP_CAPITALIZE_YES_NO(["$enableval"], [enable_dwarf_unwind])], + [enable_dwarf_unwind=NO]) UseLibdw=NO - if test "$enable_dwarf_unwind" != "no" ; then + if test "$enable_dwarf_unwind" != "NO" ; then CFLAGS2="$CFLAGS" CFLAGS="$LIBDW_CFLAGS $CFLAGS" LDFLAGS2="$LDFLAGS" @@ -43,7 +43,7 @@ AC_DEFUN([FP_FIND_LIBDW], [AC_CHECK_LIB(dw, dwfl_attach_state, [UseLibdw=YES])]) - if test "x:$enable_dwarf_unwind:$UseLibdw" = "x:yes:NO" ; then + if test "x:$enable_dwarf_unwind:$UseLibdw" = "x:YES:NO" ; then AC_MSG_ERROR([Cannot find system libdw (required by --enable-dwarf-unwind)]) fi ===================================== m4/ghc_toolchain.m4 ===================================== @@ -120,6 +120,7 @@ AC_DEFUN([FIND_GHC_TOOLCHAIN], ENABLE_GHC_TOOLCHAIN_ARG([tables-next-to-code], [$TablesNextToCode]) ENABLE_GHC_TOOLCHAIN_ARG([ld-override], [$enable_ld_override]) ENABLE_GHC_TOOLCHAIN_ARG([libffi-adjustors], [$UseLibffiForAdjustors]) + ENABLE_GHC_TOOLCHAIN_ARG([dwarf-unwind], [$enable_dwarf_unwind]) dnl We store USER_* variants of all user-specified flags to pass them over to ghc-toolchain. ADD_GHC_TOOLCHAIN_ARG_CHOOSE([cc-opt], [$USER_CONF_CC_OPTS_STAGE2], [$USER_CFLAGS]) @@ -130,6 +131,8 @@ AC_DEFUN([FIND_GHC_TOOLCHAIN], ADD_GHC_TOOLCHAIN_ARG([hs-cpp-opt], [$USER_HS_CPP_ARGS]) ADD_GHC_TOOLCHAIN_ARG([js-cpp-opt], [$USER_JS_CPP_ARGS]) ADD_GHC_TOOLCHAIN_ARG([cmm-cpp-opt], [$USER_CMM_CPP_ARGS]) + ADD_GHC_TOOLCHAIN_ARG([libdw-includes], [$LibdwIncludeDir]) + ADD_GHC_TOOLCHAIN_ARG([libdw-libraries], [$LibdwLibDir]) INVOKE_GHC_TOOLCHAIN() ===================================== m4/prep_target_file.m4 ===================================== @@ -78,6 +78,22 @@ AC_DEFUN([PREP_MAYBE_PROGRAM],[ AC_SUBST([$1MaybeProg]) ]) +# PREP_MAYBE_LIBRARY +# ========================= +# +# Introduce a substitution [$1MaybeProg] with +# * Nothing, if $$1 is empty or "NO" +# * Just the library otherwise +AC_DEFUN([PREP_MAYBE_LIBRARY],[ + if test -z "$$1" || test "$$1" = "NO"; then + $1MaybeLibrary=Nothing + else + PREP_LIST([$2]) + $1MaybeLibrary="Just (Library { libName = \"$2\", includePath = \"$3\", libraryPath = \"$4\" })" + fi + AC_SUBST([$1MaybeLibrary]) +]) + # PREP_MAYBE_STRING # ========================= # @@ -157,6 +173,7 @@ AC_DEFUN([PREP_TARGET_FILE],[ PREP_BOOLEAN([Unregisterised]) PREP_BOOLEAN([TablesNextToCode]) PREP_BOOLEAN([UseLibffiForAdjustors]) + PREP_BOOLEAN([TargetHasLibm]) PREP_BOOLEAN([ArIsGNUAr]) PREP_BOOLEAN([ArNeedsRanLib]) PREP_NOT_BOOLEAN([CrossCompiling]) @@ -179,6 +196,10 @@ AC_DEFUN([PREP_TARGET_FILE],[ PREP_LIST([CONF_CXX_OPTS_STAGE2]) PREP_LIST([CONF_CC_OPTS_STAGE2]) + PREP_MAYBE_STRING([LibdwIncludeDir]) + PREP_MAYBE_STRING([LibdwLibDir]) + PREP_MAYBE_LIBRARY([UseLibdw], [dw], [$LibdwIncludeDirMaybeStr], [$LibdwLibDirMaybeStr]) + dnl Host target PREP_BOOLEAN([ArSupportsAtFile_STAGE0]) PREP_BOOLEAN([ArSupportsDashL_STAGE0]) @@ -188,7 +209,6 @@ AC_DEFUN([PREP_TARGET_FILE],[ PREP_LIST([CONF_CXX_OPTS_STAGE0]) PREP_LIST([CONF_GCC_LINKER_OPTS_STAGE0]) - if test -z "$MergeObjsCmd"; then MergeObjsCmdMaybe=Nothing else ===================================== utils/ghc-toolchain/exe/Main.hs ===================================== @@ -62,6 +62,12 @@ data Opts = Opts -- see #23857 and #22550 for the very unfortunate story. , optLd :: ProgOpt , optUnregisterised :: Maybe Bool + + -- dwarf unwinding + , optDwarfUnwind :: Maybe Bool + , optLibdwIncludes :: Maybe FilePath + , optLibdwLibraries :: Maybe FilePath + , optTablesNextToCode :: Maybe Bool , optUseLibFFIForAdjustors :: Maybe Bool , optLdOverride :: Maybe Bool @@ -112,6 +118,9 @@ emptyOpts = Opts , optOtool = po0 , optInstallNameTool = po0 , optUnregisterised = Nothing + , optDwarfUnwind = Nothing + , optLibdwIncludes = Nothing + , optLibdwLibraries = Nothing , optTablesNextToCode = Nothing , optUseLibFFIForAdjustors = Nothing , optLdOverride = Nothing @@ -157,13 +166,18 @@ _optOutput = Lens optOutput (\x o -> o {optOutput=x}) _optTargetPrefix :: Lens Opts (Maybe String) _optTargetPrefix = Lens optTargetPrefix (\x o -> o {optTargetPrefix=x}) -_optLocallyExecutable, _optUnregisterised, _optTablesNextToCode, _optUseLibFFIForAdjustors, _optLdOvveride :: Lens Opts (Maybe Bool) +_optLocallyExecutable, _optUnregisterised, _optTablesNextToCode, _optUseLibFFIForAdjustors, _optLdOvveride, _optDwarfUnwind :: Lens Opts (Maybe Bool) _optLocallyExecutable = Lens optLocallyExecutable (\x o -> o {optLocallyExecutable=x}) _optUnregisterised = Lens optUnregisterised (\x o -> o {optUnregisterised=x}) +_optDwarfUnwind = Lens optDwarfUnwind (\x o -> o {optDwarfUnwind=x}) _optTablesNextToCode = Lens optTablesNextToCode (\x o -> o {optTablesNextToCode=x}) _optUseLibFFIForAdjustors = Lens optUseLibFFIForAdjustors (\x o -> o {optUseLibFFIForAdjustors=x}) _optLdOvveride = Lens optLdOverride (\x o -> o {optLdOverride=x}) +_optLibdwIncludes, _optLibdwLibraries :: Lens Opts (Maybe FilePath) +_optLibdwIncludes = Lens optLibdwIncludes (\x o -> o {optLibdwIncludes=x}) +_optLibdwLibraries = Lens optLibdwLibraries (\x o -> o {optLibdwLibraries=x}) + _optVerbosity :: Lens Opts Int _optVerbosity = Lens optVerbosity (\x o -> o {optVerbosity=x}) @@ -185,6 +199,7 @@ options = , enableDisable "libffi-adjustors" "the use of libffi for adjustors, even on platforms which have support for more efficient, native adjustor implementations." _optUseLibFFIForAdjustors , enableDisable "ld-override" "override gcc's default linker" _optLdOvveride , enableDisable "locally-executable" "the use of a target prefix which will be added to all tool names when searching for toolchain components" _optLocallyExecutable + , enableDisable "dwarf-unwind" "Enable DWARF unwinding support in the runtime system via elfutils' libdw" _optDwarfUnwind ] ++ concat [ progOpts "cc" "C compiler" _optCc @@ -206,6 +221,9 @@ options = , progOpts "ld" "linker" _optLd , progOpts "otool" "otool utility" _optOtool , progOpts "install-name-tool" "install-name-tool utility" _optInstallNameTool + ] ++ + [ Option [] ["libdw-includes"] (ReqArg (set _optLibdwIncludes . Just) "PATH") "Look for libdw headers in this extra path" + , Option [] ["libdw-libraries"] (ReqArg (set _optLibdwLibraries . Just) "PATH") "Look for the libdw library in this extra path" ] where progOpts :: String -> String -> Lens Opts ProgOpt -> [OptDescr (Opts -> Opts)] @@ -486,6 +504,10 @@ mkTarget opts = do tgtSupportsSubsectionsViaSymbols <- checkSubsectionsViaSymbols archOs cc tgtSupportsIdentDirective <- checkIdentDirective cc tgtSupportsGnuNonexecStack <- checkGnuNonexecStack archOs cc + tgtHasLibm <- checkTargetHasLibm cc + tgtRTSWithLibdw <- case optDwarfUnwind opts of + Just True -> checkTargetHasLibdw cc (optLibdwIncludes opts) (optLibdwLibraries opts) + _ -> pure Nothing -- code generator configuration tgtUnregisterised <- determineUnregisterised archOs (optUnregisterised opts) @@ -526,6 +548,8 @@ mkTarget opts = do , tgtUnregisterised , tgtTablesNextToCode , tgtUseLibffiForAdjustors = tgtUseLibffi + , tgtHasLibm + , tgtRTSWithLibdw , tgtSymbolsHaveLeadingUnderscore , tgtSupportsSubsectionsViaSymbols , tgtSupportsIdentDirective ===================================== utils/ghc-toolchain/ghc-toolchain.cabal ===================================== @@ -12,6 +12,7 @@ library exposed-modules: GHC.Toolchain, GHC.Toolchain.Lens, + GHC.Toolchain.Library, GHC.Toolchain.Monad, GHC.Toolchain.PlatformDetails, GHC.Toolchain.Prelude, ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Library.hs ===================================== @@ -0,0 +1,22 @@ +module GHC.Toolchain.Library + ( Library(..) + ) + where + +import System.FilePath +import GHC.Toolchain.Prelude + +data Library = Library { libName :: String + , includePath :: Maybe FilePath + , libraryPath :: Maybe FilePath + } + deriving (Read, Eq, Ord) + +instance Show Library where + -- Normalise filepaths before showing to aid with diffing the target files. + show (Library n i l) = unwords + [ "Library { libName = ", show n + , ", includePath = ", show (normalise <$> i) + , ", libraryPath =", show (normalise <$> l) + , "}"] + ===================================== utils/ghc-toolchain/src/GHC/Toolchain/PlatformDetails.hs ===================================== @@ -5,6 +5,8 @@ module GHC.Toolchain.PlatformDetails , checkSubsectionsViaSymbols , checkIdentDirective , checkGnuNonexecStack + , checkTargetHasLibm + , checkTargetHasLibdw ) where import Data.List (isInfixOf) @@ -16,6 +18,7 @@ import GHC.Toolchain.Prelude import GHC.Toolchain.Utils import GHC.Toolchain.Target import GHC.Toolchain.Program +import GHC.Toolchain.Library import GHC.Toolchain.Tools.Cc import GHC.Toolchain.Tools.Nm @@ -112,8 +115,6 @@ checkEndianness__BYTE_ORDER__ cc = checking "endianness (__BYTE_ORDER__)" $ do , "#endif" ] - - checkLeadingUnderscore :: Cc -> Nm -> M Bool checkLeadingUnderscore cc nm = checking ctxt $ withTempDir $ \dir -> do let test_o = dir </> "test.o" @@ -156,12 +157,68 @@ checkGnuNonexecStack archOs = , asmStmt ".section .text" ] +checkTargetHasLibm :: Cc -> M Bool +checkTargetHasLibm cc = testLib cc "m" "atan" Nothing + +checkTargetHasLibdw :: Cc -> Maybe FilePath -> Maybe FilePath -> M (Maybe Library) +checkTargetHasLibdw cc mincludeDir mlibDir = do + b1 <- testHeader cc "elfutils/libdwfl.h" mincludeDir + b2 <- testLib cc "dw" "dwfl_attach_state" mlibDir + return $ + if b1 && b2 + then Just + Library{ libName = "dw" + , includePath = mincludeDir, libraryPath = mlibDir} + else Nothing + + +-------------------------------------------------------------------------------- +-- Utilities +-------------------------------------------------------------------------------- + asmStmt :: String -> String asmStmt s = "__asm__(\"" ++ foldMap escape s ++ "\");" where escape '"' = "\\\"" escape c = [c] +-- | Check whether a lib is found and can be linked against. +-- Like @AC_CHECK_LIB@. +testLib :: Cc + -> String -- ^ Lib name + -> String -- ^ Lib symbol + -> Maybe FilePath -- ^ Library dir (-L) + -> M Bool +testLib cc0 libname symbol mlibDir = testCompile ("whether target has lib" ++ libname) prog cc2 + where + cc1 = cc0 & _ccProgram % _prgFlags %++ ("-l" ++ libname) + cc2 | Just libDir <- mlibDir + = cc1 & _ccProgram % _prgFlags %++ ("-L" ++ libDir) + | otherwise = cc1 + prog = unlines + [ "char " ++ symbol ++ " (void);" + , "int" + , "main (void)" + , "{" + , "return " ++ symbol ++ " ();" + , " ;" + , " return 0;" + , "}" + ] + +-- | Like @AC_CHECK_HEADER@ +testHeader :: Cc + -> String -- ^ Header to check for + -> Maybe FilePath -- ^ Extra path + -> M Bool +testHeader cc0 header mincludeDir = testCompile ("whether target has <" ++ header ++ ">") prog cc1 + where + cc1 | Just includeDir <- mincludeDir + = cc0 & _ccProgram % _prgFlags %++ ("-I" ++ includeDir) + | otherwise = cc0 + prog = unlines + [ "#include <" ++ header ++ ">" ] + -- | Try compiling a program, returning 'True' if successful. testCompile :: String -> String -> Cc -> M Bool testCompile what program cc = checking what $ withTempDir $ \dir -> do ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Target.hs ===================================== @@ -1,5 +1,6 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE MultiWayIf #-} module GHC.Toolchain.Target ( -- * A Toolchain Target @@ -7,6 +8,9 @@ module GHC.Toolchain.Target , WordSize(..), wordSize2Bytes + -- ** Queries + , tgtSupportsSMP, tgtRTSLinkerOnlySupportsSharedLibs + -- ** Lenses , _tgtCC, _tgtCxx, _tgtCpp, _tgtHsCpp @@ -19,6 +23,7 @@ import GHC.Platform.ArchOS import GHC.Toolchain.Prelude import GHC.Toolchain.Program +import GHC.Toolchain.Library import GHC.Toolchain.Tools.Cc import GHC.Toolchain.Tools.Cxx @@ -56,6 +61,13 @@ data Target = Target -- , tgtHasThreadedRts :: Bool -- We likely just need this when bootstrapping , tgtUseLibffiForAdjustors :: Bool -- ^ We need to know whether or not to include libffi headers, and generate additional code for it + , tgtHasLibm :: Bool + -- ^ Does this target have a libm library that should always be linked against? + + -- RTS capabilities + , tgtRTSWithLibdw :: Maybe Library + -- ^ Whether this target RTS is built with libdw support (for DWARF + -- unwinding), and if yes, the 'Library' configuration. -- C toolchain , tgtCCompiler :: Cc @@ -121,6 +133,8 @@ instance Show Target where , ", tgtUnregisterised = " ++ show tgtUnregisterised , ", tgtTablesNextToCode = " ++ show tgtTablesNextToCode , ", tgtUseLibffiForAdjustors = " ++ show tgtUseLibffiForAdjustors + , ", tgtHasLibm = " ++ show tgtHasLibm + , ", tgtRTSWithLibdw = " ++ show tgtRTSWithLibdw , ", tgtCCompiler = " ++ show tgtCCompiler , ", tgtCxxCompiler = " ++ show tgtCxxCompiler , ", tgtCPreprocessor = " ++ show tgtCPreprocessor @@ -141,6 +155,54 @@ instance Show Target where , "}" ] +-------------------------------------------------------------------------------- +-- Queries +-------------------------------------------------------------------------------- + +tgtSupportsSMP :: Target -> Bool +tgtSupportsSMP Target{..} = do + let goodArch = + isARM (archOS_arch tgtArchOs) + || archOS_arch tgtArchOs `elem` + [ ArchX86 + , ArchX86_64 + , ArchPPC + , ArchPPC_64 ELF_V1 + , ArchPPC_64 ELF_V2 + , ArchAArch64 + , ArchS390X + , ArchRISCV64 + , ArchLoongArch64 ] + + if -- The THREADED_RTS requires `BaseReg` to be in a register and the + -- Unregisterised mode doesn't allow that. + | tgtUnregisterised -> False + -- We don't support load/store barriers pre-ARMv7. See #10433. + | ArchARM ver _ _ <- archOS_arch tgtArchOs + , ver < ARMv7 -> False + | goodArch -> True + | otherwise -> False + +-- | Does the target RTS linker only support loading shared libraries? +-- If true, this has several implications: +-- 1. The GHC driver must not do loadArchive/loadObj etc and must +-- always do loadDLL, regardless of whether host GHC is dynamic or +-- not. +-- 2. The GHC driver will always enable -dynamic-too when compiling +-- vanilla way with TH codegen requirement. +-- 3. ghci will always enforce dynamic ways even if -dynamic or +-- -dynamic-too is not explicitly passed. +-- 4. Cabal must not build ghci objects since it's not supported by +-- the target. +-- 5. The testsuite driver will use dyn way for TH/ghci tests even +-- when host GHC is static. +-- 6. TH/ghci doesn't work if stage1 is built without shared libraries +-- (e.g. quickest/fully_static). +tgtRTSLinkerOnlySupportsSharedLibs :: Target -> Bool +tgtRTSLinkerOnlySupportsSharedLibs Target{tgtArchOs} = + archOS_arch tgtArchOs `elem` + [ ArchWasm32 ] + -------------------------------------------------------------------------------- -- Lenses -------------------------------------------------------------------------------- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a8dcb223fff342e8ab95813e0acf57… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a8dcb223fff342e8ab95813e0acf57… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/romes/26227] 4 commits: ghc-toolchain: Move UseLibdw to per-Target file
by Rodrigo Mesquita (＠alt-romes) 25 Jul '25

25 Jul '25

Rodrigo Mesquita pushed to branch wip/romes/26227 at Glasgow Haskell Compiler / GHC Commits: 24d95540 by Rodrigo Mesquita at 2025-07-25T16:57:35+01:00 ghc-toolchain: Move UseLibdw to per-Target file To support DWARF unwinding, the RTS must be built with the -f+libdw flag and with the -DUSE_LIBDW macro definition. These flags are passed on build by Hadrian when --enable-dwarf-unwinding is specified at configure time. Whether the RTS was built with support for DWARF is a per-target property, and as such, it was moved to the per-target GHC.Toolchain.Target.Target file. Additionally, we keep in the target file the include and library paths for finding libdw, since libdw should be checked at configure time (be it by configure, or ghc-toolchain, that libdw is properly available). Preserving the user-given include paths for libdw facilitates in the future building the RTS on demand for a given target (if we didn't keep that user input, we couldn't) - - - - - d3dac95c by Rodrigo Mesquita at 2025-07-25T16:58:52+01:00 ghc-toolchain: Make "Support SMP" a query on a Toolchain.Target "Support SMP" is merely a function of target, so we can represent it as such in `ghc-toolchain`. Hadrian queries the Target using this predicate to determine how to build GHC, and GHC queries the Target similarly to report under --info whether it "Support SMP" Towards #26227 - - - - - 65b5878c by Rodrigo Mesquita at 2025-07-25T16:58:52+01:00 ghc-toolchain: Make "tgt rts linker only supports shared libs" function on Target Just like with "Support SMP", "target RTS linker only supports shared libraries" is a predicate on a `Target` so we can just compute it when necessary from the given `Target`. Towards #26227 - - - - - a8dcb223 by Rodrigo Mesquita at 2025-07-25T17:05:54+01:00 WIP on Use interpreter - - - - - 19 changed files: - compiler/GHC/Driver/Session.hs - compiler/GHC/Settings/IO.hs - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cfg/default.host.target.in - hadrian/cfg/default.target.in - hadrian/cfg/system.config.in - hadrian/src/Oracles/Flag.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Settings/Packages.hs - m4/fp_find_libdw.m4 - m4/ghc_toolchain.m4 - m4/prep_target_file.m4 - utils/ghc-toolchain/exe/Main.hs - utils/ghc-toolchain/ghc-toolchain.cabal - + utils/ghc-toolchain/src/GHC/Toolchain/Library.hs - utils/ghc-toolchain/src/GHC/Toolchain/PlatformDetails.hs - utils/ghc-toolchain/src/GHC/Toolchain/Target.hs Changes: ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -3501,6 +3501,7 @@ compilerInfo dflags ("target has libm", queryBool tgtHasLibm), ("target has .ident directive", queryBool tgtSupportsIdentDirective), ("target has subsections via symbols", queryBool tgtSupportsSubsectionsViaSymbols), + ("target RTS linker only supports shared libraries", queryBool tgtRTSLinkerOnlySupportsSharedLibs) ("Unregisterised", queryBool tgtUnregisterised), ("LLVM target", query tgtLlvmTarget), ("LLVM llc command", queryCmdMaybe id tgtLlc), @@ -3508,7 +3509,8 @@ compilerInfo dflags ("LLVM llvm-as command", queryCmdMaybe id tgtLlvmAs), ("LLVM llvm-as flags", queryFlagsMaybe id tgtLlvmAs), ("Tables next to code", queryBool tgtTablesNextToCode), - ("Leading underscore", queryBool tgtSymbolsHaveLeadingUnderscore) + ("Leading underscore", queryBool tgtSymbolsHaveLeadingUnderscore), + ("RTS expects libdw", queryBool (isJust . tgtRTSWithLibdw)) ] ++ [("Project version", projectVersion dflags), ("Project Git commit id", cProjectGitCommitId), @@ -3526,6 +3528,9 @@ compilerInfo dflags ("target os string", stringEncodeOS (platformOS (targetPlatform dflags))), ("target arch string", stringEncodeArch (platformArch (targetPlatform dflags))), ("target word size in bits", show (platformWordSizeInBits (targetPlatform dflags))), + -- keep "duplicate" of "Have interpreter" for backwards compatibility, + -- since we used to show both... + ("Use interpreter", showBool $ platformMisc_ghcWithInterpreter $ platformMisc dflags), ("Have interpreter", showBool $ platformMisc_ghcWithInterpreter $ platformMisc dflags), ("Object splitting supported", showBool False), ("Have native code generator", showBool $ platformNcgSupported platform), @@ -3545,6 +3550,7 @@ compilerInfo dflags -- If true, we require that the 'id' field in installed package info -- match what is passed to the @-this-unit-id@ flag for modules -- built in it + ("Support SMP", queryBool tgtSupportsSMP), ("Requires unified installed package IDs", "YES"), -- Whether or not we support the @-this-package-key@ flag. Prefer -- "Uses unit IDs" over it. We still say yes even if @-this-package-key@ ===================================== compiler/GHC/Settings/IO.hs ===================================== @@ -146,7 +146,6 @@ initSettings top_dir = do pure (ld_r_path, map Option ld_r_args) iserv_prog = libexec "ghc-iserv" - targetRTSLinkerOnlySupportsSharedLibs <- getBooleanSetting "target RTS linker only supports shared libraries" ghcWithInterpreter <- getBooleanSetting "Use interpreter" baseUnitId <- getSetting_raw "base unit-id" @@ -231,7 +230,7 @@ initSettings top_dir = do , platformMisc_ghcWithInterpreter = ghcWithInterpreter , platformMisc_libFFI = tgtUseLibffiForAdjustors target , platformMisc_llvmTarget = tgtLlvmTarget target - , platformMisc_targetRTSLinkerOnlySupportsSharedLibs = targetRTSLinkerOnlySupportsSharedLibs + , platformMisc_targetRTSLinkerOnlySupportsSharedLibs = tgtRTSLinkerOnlySupportsSharedLibs target } , sRawSettings = settingsList ===================================== hadrian/bindist/Makefile ===================================== @@ -86,11 +86,8 @@ WrapperBinsDir=${bindir} lib/settings : config.mk @rm -f $@ @echo '[("unlit command", "$$topdir/../bin/$(CrossCompilePrefix)unlit")' >> $@ - @echo ',("target RTS linker only supports shared libraries", "$(TargetRTSLinkerOnlySupportsSharedLibs)")' >> $@ @echo ',("Use interpreter", "$(GhcWithInterpreter)")' >> $@ - @echo ',("Support SMP", "$(GhcWithSMP)")' >> $@ @echo ',("RTS ways", "$(GhcRTSWays)")' >> $@ - @echo ',("RTS expects libdw", "$(GhcRtsWithLibdw)")' >> $@ @echo ',("Relative Global Package DB", "package.conf.d")' >> $@ @echo ',("base unit-id", "$(BaseUnitId)")' >> $@ @echo "]" >> $@ ===================================== hadrian/bindist/config.mk.in ===================================== @@ -172,7 +172,7 @@ UseLibffiForAdjustors=@UseLibffiForAdjustors@ # GHC needs arch-specific tweak at least in # rts/Libdw.c:set_initial_registers() -GhcRtsWithLibdw=$(strip $(if $(filter $(TargetArch_CPP),i386 x86_64 s390x),@UseLibdw@,NO)) +UseLibdw=$(strip $(if $(filter $(TargetArch_CPP),i386 x86_64 s390x),@UseLibdw@,NO)) #----------------------------------------------------------------------------- # Settings ===================================== hadrian/cfg/default.host.target.in ===================================== @@ -13,6 +13,7 @@ Target , tgtTablesNextToCode = True , tgtUseLibffiForAdjustors = True , tgtHasLibm = True +, tgtRTSWithLibdw = Nothing , tgtCCompiler = Cc {ccProgram = Program {prgPath = "@CC_STAGE0@", prgFlags = @CONF_CC_OPTS_STAGE0List@}} , tgtCxxCompiler = Cxx {cxxProgram = Program {prgPath = "@CC_STAGE0@", prgFlags = @CONF_CXX_OPTS_STAGE0List@}} , tgtCPreprocessor = Cpp {cppProgram = Program {prgPath = "@CPPCmd_STAGE0@", prgFlags = @CONF_CPP_OPTS_STAGE0List@}} ===================================== hadrian/cfg/default.target.in ===================================== @@ -13,6 +13,7 @@ Target , tgtTablesNextToCode = @TablesNextToCodeBool@ , tgtUseLibffiForAdjustors = @UseLibffiForAdjustorsBool@ , tgtHasLibm = @TargetHasLibmBool@ +, tgtRTSWithLibdw = @UseLibdwMaybeLibrary@ , tgtCCompiler = Cc {ccProgram = Program {prgPath = "@CC@", prgFlags = @CONF_CC_OPTS_STAGE2List@}} , tgtCxxCompiler = Cxx {cxxProgram = Program {prgPath = "@CXX@", prgFlags = @CONF_CXX_OPTS_STAGE2List@}} , tgtCPreprocessor = Cpp {cppProgram = Program {prgPath = "@CPPCmd@", prgFlags = @CONF_CPP_OPTS_STAGE2List@}} ===================================== hadrian/cfg/system.config.in ===================================== @@ -99,9 +99,6 @@ use-system-ffi = @UseSystemLibFFI@ ffi-include-dir = @FFIIncludeDir@ ffi-lib-dir = @FFILibDir@ -libdw-include-dir = @LibdwIncludeDir@ -libdw-lib-dir = @LibdwLibDir@ - libnuma-include-dir = @LibNumaIncludeDir@ libnuma-lib-dir = @LibNumaLibDir@ @@ -111,7 +108,6 @@ libzstd-lib-dir = @LibZstdLibDir@ # Optional Dependencies: #======================= -use-lib-dw = @UseLibdw@ use-lib-zstd = @UseLibZstd@ static-lib-zstd = @UseStaticLibZstd@ use-lib-numa = @UseLibNuma@ ===================================== hadrian/src/Oracles/Flag.hs ===================================== @@ -7,7 +7,7 @@ module Oracles.Flag ( targetRTSLinkerOnlySupportsSharedLibs, targetSupportsThreadedRts, targetSupportsSMP, - useLibffiForAdjustors, + useLibffiForAdjustors, useLibdw, arSupportsDashL, arSupportsAtFile ) where @@ -29,7 +29,6 @@ data Flag = CrossCompiling | UseSystemFfi | BootstrapThreadedRts | BootstrapEventLoggingRts - | UseLibdw | UseLibnuma | UseLibzstd | StaticLibzstd @@ -53,7 +52,6 @@ flag f = do UseSystemFfi -> "use-system-ffi" BootstrapThreadedRts -> "bootstrap-threaded-rts" BootstrapEventLoggingRts -> "bootstrap-event-logging-rts" - UseLibdw -> "use-lib-dw" UseLibnuma -> "use-lib-numa" UseLibzstd -> "use-lib-zstd" StaticLibzstd -> "static-lib-zstd" @@ -82,23 +80,8 @@ platformSupportsGhciObjects = do only_shared_libs <- targetRTSLinkerOnlySupportsSharedLibs pure $ has_merge_objs && not only_shared_libs --- | Does the target RTS linker only support loading shared libraries? --- If true, this has several implications: --- 1. The GHC driver must not do loadArchive/loadObj etc and must --- always do loadDLL, regardless of whether host GHC is dynamic or --- not. --- 2. The GHC driver will always enable -dynamic-too when compiling --- vanilla way with TH codegen requirement. --- 3. ghci will always enforce dynamic ways even if -dynamic or --- -dynamic-too is not explicitly passed. --- 4. Cabal must not build ghci objects since it's not supported by --- the target. --- 5. The testsuite driver will use dyn way for TH/ghci tests even --- when host GHC is static. --- 6. TH/ghci doesn't work if stage1 is built without shared libraries --- (e.g. quickest/fully_static). targetRTSLinkerOnlySupportsSharedLibs :: Action Bool -targetRTSLinkerOnlySupportsSharedLibs = anyTargetArch [ ArchWasm32 ] +targetRTSLinkerOnlySupportsSharedLibs = queryTargetTarget Toolchain.tgtRTSLinkerOnlySupportsSharedLibs arSupportsDashL :: Stage -> Action Bool arSupportsDashL stage = Toolchain.arSupportsDashL . tgtAr <$> targetStage stage @@ -123,27 +106,10 @@ targetSupportsThreadedRts = do -- | Does the target support the -N RTS flag? targetSupportsSMP :: Action Bool -targetSupportsSMP = do - unreg <- queryTargetTarget tgtUnregisterised - armVer <- targetArmVersion - goodArch <- (||) <$> - anyTargetArch [ ArchX86 - , ArchX86_64 - , ArchPPC - , ArchPPC_64 ELF_V1 - , ArchPPC_64 ELF_V2 - , ArchAArch64 - , ArchS390X - , ArchRISCV64 - , ArchLoongArch64 ] <*> isArmTarget - if -- The THREADED_RTS requires `BaseReg` to be in a register and the - -- Unregisterised mode doesn't allow that. - | unreg -> return False - -- We don't support load/store barriers pre-ARMv7. See #10433. - | Just ver <- armVer - , ver < ARMv7 -> return False - | goodArch -> return True - | otherwise -> return False +targetSupportsSMP = queryTargetTarget Toolchain.tgtSupportsSMP useLibffiForAdjustors :: Action Bool useLibffiForAdjustors = queryTargetTarget tgtUseLibffiForAdjustors + +useLibdw :: Action Bool +useLibdw = queryTargetTarget (isJust . tgtRTSWithLibdw) ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -54,8 +54,6 @@ data Setting = CursesIncludeDir | GmpLibDir | IconvIncludeDir | IconvLibDir - | LibdwIncludeDir - | LibdwLibDir | LibnumaIncludeDir | LibnumaLibDir | LibZstdIncludeDir @@ -94,8 +92,6 @@ setting key = lookupSystemConfig $ case key of GmpLibDir -> "gmp-lib-dir" IconvIncludeDir -> "iconv-include-dir" IconvLibDir -> "iconv-lib-dir" - LibdwIncludeDir -> "libdw-include-dir" - LibdwLibDir -> "libdw-lib-dir" LibnumaIncludeDir -> "libnuma-include-dir" LibnumaLibDir -> "libnuma-lib-dir" LibZstdIncludeDir -> "libzstd-include-dir" ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -432,7 +432,7 @@ bindistRules = do , interpolateVar "TargetWordBigEndian" $ getTarget isBigEndian , interpolateVar "TargetWordSize" $ getTarget wordSize , interpolateVar "Unregisterised" $ yesNo <$> getTarget tgtUnregisterised - , interpolateVar "UseLibdw" $ fmap yesNo $ interp $ getFlag UseLibdw + , interpolateVar "UseLibdw" $ yesNo <$> getTarget (isJust . tgtRTSWithLibdw) , interpolateVar "UseLibffiForAdjustors" $ yesNo <$> getTarget tgtUseLibffiForAdjustors , interpolateVar "GhcWithSMP" $ yesNo <$> targetSupportsSMP , interpolateVar "BaseUnitId" $ pkgUnitId Stage1 base @@ -484,11 +484,8 @@ generateSettings settingsFile = do settings <- traverse sequence $ [ ("unlit command", ("$topdir/../bin/" <>) <$> expr (programName (ctx { Context.package = unlit }))) - , ("target RTS linker only supports shared libraries", expr $ yesNo <$> targetRTSLinkerOnlySupportsSharedLibs) , ("Use interpreter", expr $ yesNo <$> ghcWithInterpreter (predStage stage)) - , ("Support SMP", expr $ yesNo <$> targetSupportsSMP) , ("RTS ways", escapeArgs . map show . Set.toList <$> getRtsWays) - , ("RTS expects libdw", yesNo <$> getFlag UseLibdw) , ("Relative Global Package DB", pure rel_pkg_db) , ("base unit-id", pure base_unit_id) ] ===================================== hadrian/src/Settings/Packages.hs ===================================== @@ -8,6 +8,7 @@ import Packages import Settings import Settings.Builders.Common (wayCcArgs) +import qualified GHC.Toolchain.Library as Lib import GHC.Toolchain.Target import GHC.Platform.ArchOS import Data.Version.Extra @@ -304,8 +305,8 @@ rtsPackageArgs = package rts ? do useSystemFfi <- getFlag UseSystemFfi ffiIncludeDir <- getSetting FfiIncludeDir ffiLibraryDir <- getSetting FfiLibDir - libdwIncludeDir <- getSetting LibdwIncludeDir - libdwLibraryDir <- getSetting LibdwLibDir + libdwIncludeDir <- queryTarget (Lib.includePath <=< tgtRTSWithLibdw) + libdwLibraryDir <- queryTarget (Lib.libraryPath <=< tgtRTSWithLibdw) libnumaIncludeDir <- getSetting LibnumaIncludeDir libnumaLibraryDir <- getSetting LibnumaLibDir libzstdIncludeDir <- getSetting LibZstdIncludeDir @@ -443,7 +444,7 @@ rtsPackageArgs = package rts ? do , flag UseLibpthread `cabalFlag` "need-pthread" , flag UseLibbfd `cabalFlag` "libbfd" , flag NeedLibatomic `cabalFlag` "need-atomic" - , flag UseLibdw `cabalFlag` "libdw" + , useLibdw `cabalFlag` "libdw" , flag UseLibnuma `cabalFlag` "libnuma" , flag UseLibzstd `cabalFlag` "libzstd" , flag StaticLibzstd `cabalFlag` "static-libzstd" @@ -453,7 +454,7 @@ rtsPackageArgs = package rts ? do , Debug `wayUnit` way `cabalFlag` "find-ptr" ] , builder (Cabal Setup) ? mconcat - [ cabalExtraDirs libdwIncludeDir libdwLibraryDir + [ useLibdw ? cabalExtraDirs (fromMaybe "" libdwIncludeDir) (fromMaybe "" libdwLibraryDir) , cabalExtraDirs libnumaIncludeDir libnumaLibraryDir , cabalExtraDirs libzstdIncludeDir libzstdLibraryDir , useSystemFfi ? cabalExtraDirs ffiIncludeDir ffiLibraryDir @@ -467,7 +468,7 @@ rtsPackageArgs = package rts ? do , builder HsCpp ? pure [ "-DTOP=" ++ show top ] - , builder HsCpp ? flag UseLibdw ? arg "-DUSE_LIBDW" ] + , builder HsCpp ? useLibdw ? arg "-DUSE_LIBDW" ] -- Compile various performance-critical pieces *without* -fPIC -dynamic -- even when building a shared library. If we don't do this, then the ===================================== m4/fp_find_libdw.m4 ===================================== @@ -29,11 +29,11 @@ AC_DEFUN([FP_FIND_LIBDW], AC_ARG_ENABLE(dwarf-unwind, [AS_HELP_STRING([--enable-dwarf-unwind], [Enable DWARF unwinding support in the runtime system via elfutils' libdw [default=no]])], - [], - [enable_dwarf_unwind=no]) + [FP_CAPITALIZE_YES_NO(["$enableval"], [enable_dwarf_unwind])], + [enable_dwarf_unwind=NO]) UseLibdw=NO - if test "$enable_dwarf_unwind" != "no" ; then + if test "$enable_dwarf_unwind" != "NO" ; then CFLAGS2="$CFLAGS" CFLAGS="$LIBDW_CFLAGS $CFLAGS" LDFLAGS2="$LDFLAGS" @@ -43,7 +43,7 @@ AC_DEFUN([FP_FIND_LIBDW], [AC_CHECK_LIB(dw, dwfl_attach_state, [UseLibdw=YES])]) - if test "x:$enable_dwarf_unwind:$UseLibdw" = "x:yes:NO" ; then + if test "x:$enable_dwarf_unwind:$UseLibdw" = "x:YES:NO" ; then AC_MSG_ERROR([Cannot find system libdw (required by --enable-dwarf-unwind)]) fi ===================================== m4/ghc_toolchain.m4 ===================================== @@ -120,6 +120,7 @@ AC_DEFUN([FIND_GHC_TOOLCHAIN], ENABLE_GHC_TOOLCHAIN_ARG([tables-next-to-code], [$TablesNextToCode]) ENABLE_GHC_TOOLCHAIN_ARG([ld-override], [$enable_ld_override]) ENABLE_GHC_TOOLCHAIN_ARG([libffi-adjustors], [$UseLibffiForAdjustors]) + ENABLE_GHC_TOOLCHAIN_ARG([dwarf-unwind], [$enable_dwarf_unwind]) dnl We store USER_* variants of all user-specified flags to pass them over to ghc-toolchain. ADD_GHC_TOOLCHAIN_ARG_CHOOSE([cc-opt], [$USER_CONF_CC_OPTS_STAGE2], [$USER_CFLAGS]) @@ -130,6 +131,8 @@ AC_DEFUN([FIND_GHC_TOOLCHAIN], ADD_GHC_TOOLCHAIN_ARG([hs-cpp-opt], [$USER_HS_CPP_ARGS]) ADD_GHC_TOOLCHAIN_ARG([js-cpp-opt], [$USER_JS_CPP_ARGS]) ADD_GHC_TOOLCHAIN_ARG([cmm-cpp-opt], [$USER_CMM_CPP_ARGS]) + ADD_GHC_TOOLCHAIN_ARG([libdw-includes], [$LibdwIncludeDir]) + ADD_GHC_TOOLCHAIN_ARG([libdw-libraries], [$LibdwLibDir]) INVOKE_GHC_TOOLCHAIN() ===================================== m4/prep_target_file.m4 ===================================== @@ -78,6 +78,22 @@ AC_DEFUN([PREP_MAYBE_PROGRAM],[ AC_SUBST([$1MaybeProg]) ]) +# PREP_MAYBE_LIBRARY +# ========================= +# +# Introduce a substitution [$1MaybeProg] with +# * Nothing, if $$1 is empty or "NO" +# * Just the library otherwise +AC_DEFUN([PREP_MAYBE_LIBRARY],[ + if test -z "$$1" || test "$$1" = "NO"; then + $1MaybeLibrary=Nothing + else + PREP_LIST([$2]) + $1MaybeLibrary="Just (Library { libName = \"$2\", includePath = \"$3\", libraryPath = \"$4\" })" + fi + AC_SUBST([$1MaybeLibrary]) +]) + # PREP_MAYBE_STRING # ========================= # @@ -180,6 +196,10 @@ AC_DEFUN([PREP_TARGET_FILE],[ PREP_LIST([CONF_CXX_OPTS_STAGE2]) PREP_LIST([CONF_CC_OPTS_STAGE2]) + PREP_MAYBE_STRING([LibdwIncludeDir]) + PREP_MAYBE_STRING([LibdwLibDir]) + PREP_MAYBE_LIBRARY([UseLibdw], [dw], [$LibdwIncludeDirMaybeStr], [$LibdwLibDirMaybeStr]) + dnl Host target PREP_BOOLEAN([ArSupportsAtFile_STAGE0]) PREP_BOOLEAN([ArSupportsDashL_STAGE0]) @@ -189,7 +209,6 @@ AC_DEFUN([PREP_TARGET_FILE],[ PREP_LIST([CONF_CXX_OPTS_STAGE0]) PREP_LIST([CONF_GCC_LINKER_OPTS_STAGE0]) - if test -z "$MergeObjsCmd"; then MergeObjsCmdMaybe=Nothing else ===================================== utils/ghc-toolchain/exe/Main.hs ===================================== @@ -62,6 +62,12 @@ data Opts = Opts -- see #23857 and #22550 for the very unfortunate story. , optLd :: ProgOpt , optUnregisterised :: Maybe Bool + + -- dwarf unwinding + , optDwarfUnwind :: Maybe Bool + , optLibdwIncludes :: Maybe FilePath + , optLibdwLibraries :: Maybe FilePath + , optTablesNextToCode :: Maybe Bool , optUseLibFFIForAdjustors :: Maybe Bool , optLdOverride :: Maybe Bool @@ -112,6 +118,9 @@ emptyOpts = Opts , optOtool = po0 , optInstallNameTool = po0 , optUnregisterised = Nothing + , optDwarfUnwind = Nothing + , optLibdwIncludes = Nothing + , optLibdwLibraries = Nothing , optTablesNextToCode = Nothing , optUseLibFFIForAdjustors = Nothing , optLdOverride = Nothing @@ -157,13 +166,18 @@ _optOutput = Lens optOutput (\x o -> o {optOutput=x}) _optTargetPrefix :: Lens Opts (Maybe String) _optTargetPrefix = Lens optTargetPrefix (\x o -> o {optTargetPrefix=x}) -_optLocallyExecutable, _optUnregisterised, _optTablesNextToCode, _optUseLibFFIForAdjustors, _optLdOvveride :: Lens Opts (Maybe Bool) +_optLocallyExecutable, _optUnregisterised, _optTablesNextToCode, _optUseLibFFIForAdjustors, _optLdOvveride, _optDwarfUnwind :: Lens Opts (Maybe Bool) _optLocallyExecutable = Lens optLocallyExecutable (\x o -> o {optLocallyExecutable=x}) _optUnregisterised = Lens optUnregisterised (\x o -> o {optUnregisterised=x}) +_optDwarfUnwind = Lens optDwarfUnwind (\x o -> o {optDwarfUnwind=x}) _optTablesNextToCode = Lens optTablesNextToCode (\x o -> o {optTablesNextToCode=x}) _optUseLibFFIForAdjustors = Lens optUseLibFFIForAdjustors (\x o -> o {optUseLibFFIForAdjustors=x}) _optLdOvveride = Lens optLdOverride (\x o -> o {optLdOverride=x}) +_optLibdwIncludes, _optLibdwLibraries :: Lens Opts (Maybe FilePath) +_optLibdwIncludes = Lens optLibdwIncludes (\x o -> o {optLibdwIncludes=x}) +_optLibdwLibraries = Lens optLibdwLibraries (\x o -> o {optLibdwLibraries=x}) + _optVerbosity :: Lens Opts Int _optVerbosity = Lens optVerbosity (\x o -> o {optVerbosity=x}) @@ -185,6 +199,7 @@ options = , enableDisable "libffi-adjustors" "the use of libffi for adjustors, even on platforms which have support for more efficient, native adjustor implementations." _optUseLibFFIForAdjustors , enableDisable "ld-override" "override gcc's default linker" _optLdOvveride , enableDisable "locally-executable" "the use of a target prefix which will be added to all tool names when searching for toolchain components" _optLocallyExecutable + , enableDisable "dwarf-unwind" "Enable DWARF unwinding support in the runtime system via elfutils' libdw" _optDwarfUnwind ] ++ concat [ progOpts "cc" "C compiler" _optCc @@ -206,6 +221,9 @@ options = , progOpts "ld" "linker" _optLd , progOpts "otool" "otool utility" _optOtool , progOpts "install-name-tool" "install-name-tool utility" _optInstallNameTool + ] ++ + [ Option [] ["libdw-includes"] (ReqArg (set _optLibdwIncludes . Just) "PATH") "Look for libdw headers in this extra path" + , Option [] ["libdw-libraries"] (ReqArg (set _optLibdwLibraries . Just) "PATH") "Look for the libdw library in this extra path" ] where progOpts :: String -> String -> Lens Opts ProgOpt -> [OptDescr (Opts -> Opts)] @@ -487,6 +505,9 @@ mkTarget opts = do tgtSupportsIdentDirective <- checkIdentDirective cc tgtSupportsGnuNonexecStack <- checkGnuNonexecStack archOs cc tgtHasLibm <- checkTargetHasLibm cc + tgtRTSWithLibdw <- case optDwarfUnwind opts of + Just True -> checkTargetHasLibdw cc (optLibdwIncludes opts) (optLibdwLibraries opts) + _ -> pure Nothing -- code generator configuration tgtUnregisterised <- determineUnregisterised archOs (optUnregisterised opts) @@ -528,6 +549,7 @@ mkTarget opts = do , tgtTablesNextToCode , tgtUseLibffiForAdjustors = tgtUseLibffi , tgtHasLibm + , tgtRTSWithLibdw , tgtSymbolsHaveLeadingUnderscore , tgtSupportsSubsectionsViaSymbols , tgtSupportsIdentDirective ===================================== utils/ghc-toolchain/ghc-toolchain.cabal ===================================== @@ -12,6 +12,7 @@ library exposed-modules: GHC.Toolchain, GHC.Toolchain.Lens, + GHC.Toolchain.Library, GHC.Toolchain.Monad, GHC.Toolchain.PlatformDetails, GHC.Toolchain.Prelude, ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Library.hs ===================================== @@ -0,0 +1,22 @@ +module GHC.Toolchain.Library + ( Library(..) + ) + where + +import System.FilePath +import GHC.Toolchain.Prelude + +data Library = Library { libName :: String + , includePath :: Maybe FilePath + , libraryPath :: Maybe FilePath + } + deriving (Read, Eq, Ord) + +instance Show Library where + -- Normalise filepaths before showing to aid with diffing the target files. + show (Library n i l) = unwords + [ "Library { libName = ", show n + , ", includePath = ", show (normalise <$> i) + , ", libraryPath =", show (normalise <$> l) + , "}"] + ===================================== utils/ghc-toolchain/src/GHC/Toolchain/PlatformDetails.hs ===================================== @@ -6,6 +6,7 @@ module GHC.Toolchain.PlatformDetails , checkIdentDirective , checkGnuNonexecStack , checkTargetHasLibm + , checkTargetHasLibdw ) where import Data.List (isInfixOf) @@ -17,6 +18,7 @@ import GHC.Toolchain.Prelude import GHC.Toolchain.Utils import GHC.Toolchain.Target import GHC.Toolchain.Program +import GHC.Toolchain.Library import GHC.Toolchain.Tools.Cc import GHC.Toolchain.Tools.Nm @@ -156,25 +158,66 @@ checkGnuNonexecStack archOs = ] checkTargetHasLibm :: Cc -> M Bool -checkTargetHasLibm cc0 = testCompile "whether target has libm" prog cc +checkTargetHasLibm cc = testLib cc "m" "atan" Nothing + +checkTargetHasLibdw :: Cc -> Maybe FilePath -> Maybe FilePath -> M (Maybe Library) +checkTargetHasLibdw cc mincludeDir mlibDir = do + b1 <- testHeader cc "elfutils/libdwfl.h" mincludeDir + b2 <- testLib cc "dw" "dwfl_attach_state" mlibDir + return $ + if b1 && b2 + then Just + Library{ libName = "dw" + , includePath = mincludeDir, libraryPath = mlibDir} + else Nothing + + +-------------------------------------------------------------------------------- +-- Utilities +-------------------------------------------------------------------------------- + +asmStmt :: String -> String +asmStmt s = "__asm__(\"" ++ foldMap escape s ++ "\");" where - cc = cc0 & _ccProgram % _prgFlags %++ "-lm" + escape '"' = "\\\"" + escape c = [c] + +-- | Check whether a lib is found and can be linked against. +-- Like @AC_CHECK_LIB@. +testLib :: Cc + -> String -- ^ Lib name + -> String -- ^ Lib symbol + -> Maybe FilePath -- ^ Library dir (-L) + -> M Bool +testLib cc0 libname symbol mlibDir = testCompile ("whether target has lib" ++ libname) prog cc2 + where + cc1 = cc0 & _ccProgram % _prgFlags %++ ("-l" ++ libname) + cc2 | Just libDir <- mlibDir + = cc1 & _ccProgram % _prgFlags %++ ("-L" ++ libDir) + | otherwise = cc1 prog = unlines - [ "char atan (void);" + [ "char " ++ symbol ++ " (void);" , "int" , "main (void)" , "{" - , "return atan ();" + , "return " ++ symbol ++ " ();" , " ;" , " return 0;" , "}" ] -asmStmt :: String -> String -asmStmt s = "__asm__(\"" ++ foldMap escape s ++ "\");" +-- | Like @AC_CHECK_HEADER@ +testHeader :: Cc + -> String -- ^ Header to check for + -> Maybe FilePath -- ^ Extra path + -> M Bool +testHeader cc0 header mincludeDir = testCompile ("whether target has <" ++ header ++ ">") prog cc1 where - escape '"' = "\\\"" - escape c = [c] + cc1 | Just includeDir <- mincludeDir + = cc0 & _ccProgram % _prgFlags %++ ("-I" ++ includeDir) + | otherwise = cc0 + prog = unlines + [ "#include <" ++ header ++ ">" ] -- | Try compiling a program, returning 'True' if successful. testCompile :: String -> String -> Cc -> M Bool ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Target.hs ===================================== @@ -1,5 +1,6 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE MultiWayIf #-} module GHC.Toolchain.Target ( -- * A Toolchain Target @@ -7,6 +8,9 @@ module GHC.Toolchain.Target , WordSize(..), wordSize2Bytes + -- ** Queries + , tgtSupportsSMP, tgtRTSLinkerOnlySupportsSharedLibs + -- ** Lenses , _tgtCC, _tgtCxx, _tgtCpp, _tgtHsCpp @@ -19,6 +23,7 @@ import GHC.Platform.ArchOS import GHC.Toolchain.Prelude import GHC.Toolchain.Program +import GHC.Toolchain.Library import GHC.Toolchain.Tools.Cc import GHC.Toolchain.Tools.Cxx @@ -56,11 +61,14 @@ data Target = Target -- , tgtHasThreadedRts :: Bool -- We likely just need this when bootstrapping , tgtUseLibffiForAdjustors :: Bool -- ^ We need to know whether or not to include libffi headers, and generate additional code for it - - -- Target support , tgtHasLibm :: Bool -- ^ Does this target have a libm library that should always be linked against? + -- RTS capabilities + , tgtRTSWithLibdw :: Maybe Library + -- ^ Whether this target RTS is built with libdw support (for DWARF + -- unwinding), and if yes, the 'Library' configuration. + -- C toolchain , tgtCCompiler :: Cc , tgtCxxCompiler :: Cxx @@ -126,6 +134,7 @@ instance Show Target where , ", tgtTablesNextToCode = " ++ show tgtTablesNextToCode , ", tgtUseLibffiForAdjustors = " ++ show tgtUseLibffiForAdjustors , ", tgtHasLibm = " ++ show tgtHasLibm + , ", tgtRTSWithLibdw = " ++ show tgtRTSWithLibdw , ", tgtCCompiler = " ++ show tgtCCompiler , ", tgtCxxCompiler = " ++ show tgtCxxCompiler , ", tgtCPreprocessor = " ++ show tgtCPreprocessor @@ -146,6 +155,54 @@ instance Show Target where , "}" ] +-------------------------------------------------------------------------------- +-- Queries +-------------------------------------------------------------------------------- + +tgtSupportsSMP :: Target -> Bool +tgtSupportsSMP Target{..} = do + let goodArch = + isARM (archOS_arch tgtArchOs) + || archOS_arch tgtArchOs `elem` + [ ArchX86 + , ArchX86_64 + , ArchPPC + , ArchPPC_64 ELF_V1 + , ArchPPC_64 ELF_V2 + , ArchAArch64 + , ArchS390X + , ArchRISCV64 + , ArchLoongArch64 ] + + if -- The THREADED_RTS requires `BaseReg` to be in a register and the + -- Unregisterised mode doesn't allow that. + | tgtUnregisterised -> False + -- We don't support load/store barriers pre-ARMv7. See #10433. + | ArchARM ver _ _ <- archOS_arch tgtArchOs + , ver < ARMv7 -> False + | goodArch -> True + | otherwise -> False + +-- | Does the target RTS linker only support loading shared libraries? +-- If true, this has several implications: +-- 1. The GHC driver must not do loadArchive/loadObj etc and must +-- always do loadDLL, regardless of whether host GHC is dynamic or +-- not. +-- 2. The GHC driver will always enable -dynamic-too when compiling +-- vanilla way with TH codegen requirement. +-- 3. ghci will always enforce dynamic ways even if -dynamic or +-- -dynamic-too is not explicitly passed. +-- 4. Cabal must not build ghci objects since it's not supported by +-- the target. +-- 5. The testsuite driver will use dyn way for TH/ghci tests even +-- when host GHC is static. +-- 6. TH/ghci doesn't work if stage1 is built without shared libraries +-- (e.g. quickest/fully_static). +tgtRTSLinkerOnlySupportsSharedLibs :: Target -> Bool +tgtRTSLinkerOnlySupportsSharedLibs Target{tgtArchOs} = + archOS_arch tgtArchOs `elem` + [ ArchWasm32 ] + -------------------------------------------------------------------------------- -- Lenses -------------------------------------------------------------------------------- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/628dc2a9fa2124b8a0ef133cde74d3… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/628dc2a9fa2124b8a0ef133cde74d3… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/romes/26227] 2 commits: ghc-toolchain: Move TgtHasLibm to per-Target file
by Rodrigo Mesquita (＠alt-romes) 25 Jul '25

25 Jul '25

Rodrigo Mesquita pushed to branch wip/romes/26227 at Glasgow Haskell Compiler / GHC Commits: fdf9efe4 by Rodrigo Mesquita at 2025-07-25T12:24:40+01:00 ghc-toolchain: Move TgtHasLibm to per-Target file TargetHasLibm is now part of the per-target configuration Towards #26227 - - - - - 628dc2a9 by Rodrigo Mesquita at 2025-07-25T16:02:49+01:00 ghc-toolchain: Move UseLibdw to per-Target file To support DWARF unwinding, the RTS must be built with the -f+libdw flag and with the -DUSE_LIBDW macro definition. These flags are passed on build by Hadrian when --enable-dwarf-unwinding is specified at configure time. Whether the RTS was built with support for DWARF is a per-target property, and as such, it was moved to the per-target GHC.Toolchain.Target.Target file. Additionally, we keep in the target file the include and library paths for finding libdw, since libdw should be checked at configure time (be it by configure, or ghc-toolchain, that libdw is properly available). Preserving the user-given include paths for libdw facilitates in the future building the RTS on demand for a given target (if we didn't keep that user input, we couldn't) - - - - - 19 changed files: - compiler/GHC/Driver/Session.hs - compiler/GHC/Settings/IO.hs - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cfg/default.host.target.in - hadrian/cfg/default.target.in - hadrian/cfg/system.config.in - hadrian/src/Oracles/Flag.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Settings/Packages.hs - m4/fp_find_libdw.m4 - m4/ghc_toolchain.m4 - m4/prep_target_file.m4 - utils/ghc-toolchain/exe/Main.hs - utils/ghc-toolchain/ghc-toolchain.cabal - + utils/ghc-toolchain/src/GHC/Toolchain/Library.hs - utils/ghc-toolchain/src/GHC/Toolchain/PlatformDetails.hs - utils/ghc-toolchain/src/GHC/Toolchain/Target.hs Changes: ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -3498,6 +3498,7 @@ compilerInfo dflags ("target word size", query $ show . wordSize2Bytes . tgtWordSize), ("target word big endian", queryBool $ (\case BigEndian -> True; LittleEndian -> False) . tgtEndianness), ("target has GNU nonexec stack", queryBool tgtSupportsGnuNonexecStack), + ("target has libm", queryBool tgtHasLibm), ("target has .ident directive", queryBool tgtSupportsIdentDirective), ("target has subsections via symbols", queryBool tgtSupportsSubsectionsViaSymbols), ("Unregisterised", queryBool tgtUnregisterised), @@ -3508,6 +3509,7 @@ compilerInfo dflags ("LLVM llvm-as flags", queryFlagsMaybe id tgtLlvmAs), ("Tables next to code", queryBool tgtTablesNextToCode), ("Leading underscore", queryBool tgtSymbolsHaveLeadingUnderscore) + ("RTS expects libdw", queryBool (isJust . tgtRTSWithLibdw)), ] ++ [("Project version", projectVersion dflags), ("Project Git commit id", cProjectGitCommitId), ===================================== compiler/GHC/Settings/IO.hs ===================================== @@ -97,10 +97,6 @@ initSettings top_dir = do getTool :: (Target -> Program) -> (String, [String]) getTool key = (getToolPath key, getToolFlags key) - -- See Note [Settings file] for a little more about this file. We're - -- just partially applying those functions and throwing 'Left's; they're - -- written in a very portable style to keep ghc-boot light. - targetHasLibm <- getBooleanSetting "target has libm" let (cc_prog, cc_args0) = getTool (ccProgram . tgtCCompiler) (cxx_prog, cxx_args) = getTool (cxxProgram . tgtCxxCompiler) @@ -109,7 +105,7 @@ initSettings top_dir = do (js_cpp_prog, js_cpp_args) = getTool (maybe (Program "" []) jsCppProgram . tgtJsCPreprocessor) (cmmCpp_prog, cmmCpp_args) = getTool (cmmCppProgram . tgtCmmCPreprocessor) - platform = getTargetPlatform targetHasLibm target + platform = getTargetPlatform target unreg_cc_args = if platformUnregisterised platform then ["-DNO_REGS", "-DUSE_MINIINTERPRETER"] @@ -242,8 +238,8 @@ initSettings top_dir = do , sRawTarget = target } -getTargetPlatform :: Bool {-^ Does target have libm -} -> Target -> Platform -getTargetPlatform targetHasLibm Target{..} = Platform +getTargetPlatform :: Target -> Platform +getTargetPlatform Target{..} = Platform { platformArchOS = tgtArchOs , platformWordSize = case tgtWordSize of WS4 -> PW4 WS8 -> PW8 @@ -255,6 +251,6 @@ getTargetPlatform targetHasLibm Target{..} = Platform , platformIsCrossCompiling = not tgtLocallyExecutable , platformLeadingUnderscore = tgtSymbolsHaveLeadingUnderscore , platformTablesNextToCode = tgtTablesNextToCode - , platformHasLibm = targetHasLibm + , platformHasLibm = tgtHasLibm , platform_constants = Nothing -- will be filled later when loading (or building) the RTS unit } ===================================== hadrian/bindist/Makefile ===================================== @@ -85,13 +85,11 @@ WrapperBinsDir=${bindir} # N.B. this is duplicated from includes/ghc.mk. lib/settings : config.mk @rm -f $@ - @echo '[("target has libm", "$(TargetHasLibm)")' >> $@ - @echo ',("unlit command", "$$topdir/../bin/$(CrossCompilePrefix)unlit")' >> $@ + @echo '[("unlit command", "$$topdir/../bin/$(CrossCompilePrefix)unlit")' >> $@ @echo ',("target RTS linker only supports shared libraries", "$(TargetRTSLinkerOnlySupportsSharedLibs)")' >> $@ @echo ',("Use interpreter", "$(GhcWithInterpreter)")' >> $@ @echo ',("Support SMP", "$(GhcWithSMP)")' >> $@ @echo ',("RTS ways", "$(GhcRTSWays)")' >> $@ - @echo ',("RTS expects libdw", "$(GhcRtsWithLibdw)")' >> $@ @echo ',("Relative Global Package DB", "package.conf.d")' >> $@ @echo ',("base unit-id", "$(BaseUnitId)")' >> $@ @echo "]" >> $@ ===================================== hadrian/bindist/config.mk.in ===================================== @@ -172,7 +172,7 @@ UseLibffiForAdjustors=@UseLibffiForAdjustors@ # GHC needs arch-specific tweak at least in # rts/Libdw.c:set_initial_registers() -GhcRtsWithLibdw=$(strip $(if $(filter $(TargetArch_CPP),i386 x86_64 s390x),@UseLibdw@,NO)) +UseLibdw=$(strip $(if $(filter $(TargetArch_CPP),i386 x86_64 s390x),@UseLibdw@,NO)) #----------------------------------------------------------------------------- # Settings ===================================== hadrian/cfg/default.host.target.in ===================================== @@ -12,6 +12,8 @@ Target , tgtUnregisterised = False , tgtTablesNextToCode = True , tgtUseLibffiForAdjustors = True +, tgtHasLibm = True +, tgtRTSWithLibdw = Nothing , tgtCCompiler = Cc {ccProgram = Program {prgPath = "@CC_STAGE0@", prgFlags = @CONF_CC_OPTS_STAGE0List@}} , tgtCxxCompiler = Cxx {cxxProgram = Program {prgPath = "@CC_STAGE0@", prgFlags = @CONF_CXX_OPTS_STAGE0List@}} , tgtCPreprocessor = Cpp {cppProgram = Program {prgPath = "@CPPCmd_STAGE0@", prgFlags = @CONF_CPP_OPTS_STAGE0List@}} ===================================== hadrian/cfg/default.target.in ===================================== @@ -12,6 +12,8 @@ Target , tgtUnregisterised = @UnregisterisedBool@ , tgtTablesNextToCode = @TablesNextToCodeBool@ , tgtUseLibffiForAdjustors = @UseLibffiForAdjustorsBool@ +, tgtHasLibm = @TargetHasLibmBool@ +, tgtRTSWithLibdw = @UseLibdwMaybeLibrary@ , tgtCCompiler = Cc {ccProgram = Program {prgPath = "@CC@", prgFlags = @CONF_CC_OPTS_STAGE2List@}} , tgtCxxCompiler = Cxx {cxxProgram = Program {prgPath = "@CXX@", prgFlags = @CONF_CXX_OPTS_STAGE2List@}} , tgtCPreprocessor = Cpp {cppProgram = Program {prgPath = "@CPPCmd@", prgFlags = @CONF_CPP_OPTS_STAGE2List@}} ===================================== hadrian/cfg/system.config.in ===================================== @@ -81,8 +81,6 @@ project-git-commit-id = @ProjectGitCommitId@ # See Note [tooldir: How GHC finds mingw on Windows] settings-use-distro-mingw = @EnableDistroToolchain@ -target-has-libm = @TargetHasLibm@ - # Include and library directories: #================================= @@ -101,9 +99,6 @@ use-system-ffi = @UseSystemLibFFI@ ffi-include-dir = @FFIIncludeDir@ ffi-lib-dir = @FFILibDir@ -libdw-include-dir = @LibdwIncludeDir@ -libdw-lib-dir = @LibdwLibDir@ - libnuma-include-dir = @LibNumaIncludeDir@ libnuma-lib-dir = @LibNumaLibDir@ @@ -113,7 +108,6 @@ libzstd-lib-dir = @LibZstdLibDir@ # Optional Dependencies: #======================= -use-lib-dw = @UseLibdw@ use-lib-zstd = @UseLibZstd@ static-lib-zstd = @UseStaticLibZstd@ use-lib-numa = @UseLibNuma@ ===================================== hadrian/src/Oracles/Flag.hs ===================================== @@ -7,7 +7,7 @@ module Oracles.Flag ( targetRTSLinkerOnlySupportsSharedLibs, targetSupportsThreadedRts, targetSupportsSMP, - useLibffiForAdjustors, + useLibffiForAdjustors, useLibdw, arSupportsDashL, arSupportsAtFile ) where @@ -29,7 +29,6 @@ data Flag = CrossCompiling | UseSystemFfi | BootstrapThreadedRts | BootstrapEventLoggingRts - | UseLibdw | UseLibnuma | UseLibzstd | StaticLibzstd @@ -53,7 +52,6 @@ flag f = do UseSystemFfi -> "use-system-ffi" BootstrapThreadedRts -> "bootstrap-threaded-rts" BootstrapEventLoggingRts -> "bootstrap-event-logging-rts" - UseLibdw -> "use-lib-dw" UseLibnuma -> "use-lib-numa" UseLibzstd -> "use-lib-zstd" StaticLibzstd -> "static-lib-zstd" @@ -147,3 +145,6 @@ targetSupportsSMP = do useLibffiForAdjustors :: Action Bool useLibffiForAdjustors = queryTargetTarget tgtUseLibffiForAdjustors + +useLibdw :: Action Bool +useLibdw = queryTargetTarget (isJust . tgtRTSWithLibdw) ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -54,8 +54,6 @@ data Setting = CursesIncludeDir | GmpLibDir | IconvIncludeDir | IconvLibDir - | LibdwIncludeDir - | LibdwLibDir | LibnumaIncludeDir | LibnumaLibDir | LibZstdIncludeDir @@ -94,8 +92,6 @@ setting key = lookupSystemConfig $ case key of GmpLibDir -> "gmp-lib-dir" IconvIncludeDir -> "iconv-include-dir" IconvLibDir -> "iconv-lib-dir" - LibdwIncludeDir -> "libdw-include-dir" - LibdwLibDir -> "libdw-lib-dir" LibnumaIncludeDir -> "libnuma-include-dir" LibnumaLibDir -> "libnuma-lib-dir" LibZstdIncludeDir -> "libzstd-include-dir" ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -432,7 +432,7 @@ bindistRules = do , interpolateVar "TargetWordBigEndian" $ getTarget isBigEndian , interpolateVar "TargetWordSize" $ getTarget wordSize , interpolateVar "Unregisterised" $ yesNo <$> getTarget tgtUnregisterised - , interpolateVar "UseLibdw" $ fmap yesNo $ interp $ getFlag UseLibdw + , interpolateVar "UseLibdw" $ yesNo <$> getTarget (isJust . tgtRTSWithLibdw) , interpolateVar "UseLibffiForAdjustors" $ yesNo <$> getTarget tgtUseLibffiForAdjustors , interpolateVar "GhcWithSMP" $ yesNo <$> targetSupportsSMP , interpolateVar "BaseUnitId" $ pkgUnitId Stage1 base @@ -484,12 +484,10 @@ generateSettings settingsFile = do settings <- traverse sequence $ [ ("unlit command", ("$topdir/../bin/" <>) <$> expr (programName (ctx { Context.package = unlit }))) - , ("target has libm", expr $ lookupSystemConfig "target-has-libm") , ("target RTS linker only supports shared libraries", expr $ yesNo <$> targetRTSLinkerOnlySupportsSharedLibs) , ("Use interpreter", expr $ yesNo <$> ghcWithInterpreter (predStage stage)) , ("Support SMP", expr $ yesNo <$> targetSupportsSMP) , ("RTS ways", escapeArgs . map show . Set.toList <$> getRtsWays) - , ("RTS expects libdw", yesNo <$> getFlag UseLibdw) , ("Relative Global Package DB", pure rel_pkg_db) , ("base unit-id", pure base_unit_id) ] ===================================== hadrian/src/Settings/Packages.hs ===================================== @@ -8,6 +8,7 @@ import Packages import Settings import Settings.Builders.Common (wayCcArgs) +import qualified GHC.Toolchain.Library as Lib import GHC.Toolchain.Target import GHC.Platform.ArchOS import Data.Version.Extra @@ -304,8 +305,8 @@ rtsPackageArgs = package rts ? do useSystemFfi <- getFlag UseSystemFfi ffiIncludeDir <- getSetting FfiIncludeDir ffiLibraryDir <- getSetting FfiLibDir - libdwIncludeDir <- getSetting LibdwIncludeDir - libdwLibraryDir <- getSetting LibdwLibDir + libdwIncludeDir <- queryTarget (Lib.includePath <=< tgtRTSWithLibdw) + libdwLibraryDir <- queryTarget (Lib.libraryPath <=< tgtRTSWithLibdw) libnumaIncludeDir <- getSetting LibnumaIncludeDir libnumaLibraryDir <- getSetting LibnumaLibDir libzstdIncludeDir <- getSetting LibZstdIncludeDir @@ -443,7 +444,7 @@ rtsPackageArgs = package rts ? do , flag UseLibpthread `cabalFlag` "need-pthread" , flag UseLibbfd `cabalFlag` "libbfd" , flag NeedLibatomic `cabalFlag` "need-atomic" - , flag UseLibdw `cabalFlag` "libdw" + , useLibdw `cabalFlag` "libdw" , flag UseLibnuma `cabalFlag` "libnuma" , flag UseLibzstd `cabalFlag` "libzstd" , flag StaticLibzstd `cabalFlag` "static-libzstd" @@ -453,7 +454,7 @@ rtsPackageArgs = package rts ? do , Debug `wayUnit` way `cabalFlag` "find-ptr" ] , builder (Cabal Setup) ? mconcat - [ cabalExtraDirs libdwIncludeDir libdwLibraryDir + [ useLibdw ? cabalExtraDirs (fromMaybe "" libdwIncludeDir) (fromMaybe "" libdwLibraryDir) , cabalExtraDirs libnumaIncludeDir libnumaLibraryDir , cabalExtraDirs libzstdIncludeDir libzstdLibraryDir , useSystemFfi ? cabalExtraDirs ffiIncludeDir ffiLibraryDir @@ -467,7 +468,7 @@ rtsPackageArgs = package rts ? do , builder HsCpp ? pure [ "-DTOP=" ++ show top ] - , builder HsCpp ? flag UseLibdw ? arg "-DUSE_LIBDW" ] + , builder HsCpp ? useLibdw ? arg "-DUSE_LIBDW" ] -- Compile various performance-critical pieces *without* -fPIC -dynamic -- even when building a shared library. If we don't do this, then the ===================================== m4/fp_find_libdw.m4 ===================================== @@ -29,11 +29,11 @@ AC_DEFUN([FP_FIND_LIBDW], AC_ARG_ENABLE(dwarf-unwind, [AS_HELP_STRING([--enable-dwarf-unwind], [Enable DWARF unwinding support in the runtime system via elfutils' libdw [default=no]])], - [], - [enable_dwarf_unwind=no]) + [FP_CAPITALIZE_YES_NO(["$enableval"], [enable_dwarf_unwind])], + [enable_dwarf_unwind=NO]) UseLibdw=NO - if test "$enable_dwarf_unwind" != "no" ; then + if test "$enable_dwarf_unwind" != "NO" ; then CFLAGS2="$CFLAGS" CFLAGS="$LIBDW_CFLAGS $CFLAGS" LDFLAGS2="$LDFLAGS" @@ -43,7 +43,7 @@ AC_DEFUN([FP_FIND_LIBDW], [AC_CHECK_LIB(dw, dwfl_attach_state, [UseLibdw=YES])]) - if test "x:$enable_dwarf_unwind:$UseLibdw" = "x:yes:NO" ; then + if test "x:$enable_dwarf_unwind:$UseLibdw" = "x:YES:NO" ; then AC_MSG_ERROR([Cannot find system libdw (required by --enable-dwarf-unwind)]) fi ===================================== m4/ghc_toolchain.m4 ===================================== @@ -120,6 +120,7 @@ AC_DEFUN([FIND_GHC_TOOLCHAIN], ENABLE_GHC_TOOLCHAIN_ARG([tables-next-to-code], [$TablesNextToCode]) ENABLE_GHC_TOOLCHAIN_ARG([ld-override], [$enable_ld_override]) ENABLE_GHC_TOOLCHAIN_ARG([libffi-adjustors], [$UseLibffiForAdjustors]) + ENABLE_GHC_TOOLCHAIN_ARG([dwarf-unwind], [$enable_dwarf_unwind]) dnl We store USER_* variants of all user-specified flags to pass them over to ghc-toolchain. ADD_GHC_TOOLCHAIN_ARG_CHOOSE([cc-opt], [$USER_CONF_CC_OPTS_STAGE2], [$USER_CFLAGS]) @@ -130,6 +131,8 @@ AC_DEFUN([FIND_GHC_TOOLCHAIN], ADD_GHC_TOOLCHAIN_ARG([hs-cpp-opt], [$USER_HS_CPP_ARGS]) ADD_GHC_TOOLCHAIN_ARG([js-cpp-opt], [$USER_JS_CPP_ARGS]) ADD_GHC_TOOLCHAIN_ARG([cmm-cpp-opt], [$USER_CMM_CPP_ARGS]) + ADD_GHC_TOOLCHAIN_ARG([libdw-includes], [$LibdwIncludeDir]) + ADD_GHC_TOOLCHAIN_ARG([libdw-libraries], [$LibdwLibDir]) INVOKE_GHC_TOOLCHAIN() ===================================== m4/prep_target_file.m4 ===================================== @@ -78,6 +78,22 @@ AC_DEFUN([PREP_MAYBE_PROGRAM],[ AC_SUBST([$1MaybeProg]) ]) +# PREP_MAYBE_LIBRARY +# ========================= +# +# Introduce a substitution [$1MaybeProg] with +# * Nothing, if $$1 is empty or "NO" +# * Just the library otherwise +AC_DEFUN([PREP_MAYBE_LIBRARY],[ + if test -z "$$1" || test "$$1" = "NO"; then + $1MaybeLibrary=Nothing + else + PREP_LIST([$2]) + $1MaybeLibrary="Just (Library { libName = \"$2\", includePath = \"$3\", libraryPath = \"$4\" })" + fi + AC_SUBST([$1MaybeLibrary]) +]) + # PREP_MAYBE_STRING # ========================= # @@ -157,6 +173,7 @@ AC_DEFUN([PREP_TARGET_FILE],[ PREP_BOOLEAN([Unregisterised]) PREP_BOOLEAN([TablesNextToCode]) PREP_BOOLEAN([UseLibffiForAdjustors]) + PREP_BOOLEAN([TargetHasLibm]) PREP_BOOLEAN([ArIsGNUAr]) PREP_BOOLEAN([ArNeedsRanLib]) PREP_NOT_BOOLEAN([CrossCompiling]) @@ -179,6 +196,10 @@ AC_DEFUN([PREP_TARGET_FILE],[ PREP_LIST([CONF_CXX_OPTS_STAGE2]) PREP_LIST([CONF_CC_OPTS_STAGE2]) + PREP_MAYBE_STRING([LibdwIncludeDir]) + PREP_MAYBE_STRING([LibdwLibDir]) + PREP_MAYBE_LIBRARY([UseLibdw], [dw], [$LibdwIncludeDirMaybeStr], [$LibdwLibDirMaybeStr]) + dnl Host target PREP_BOOLEAN([ArSupportsAtFile_STAGE0]) PREP_BOOLEAN([ArSupportsDashL_STAGE0]) @@ -188,7 +209,6 @@ AC_DEFUN([PREP_TARGET_FILE],[ PREP_LIST([CONF_CXX_OPTS_STAGE0]) PREP_LIST([CONF_GCC_LINKER_OPTS_STAGE0]) - if test -z "$MergeObjsCmd"; then MergeObjsCmdMaybe=Nothing else ===================================== utils/ghc-toolchain/exe/Main.hs ===================================== @@ -62,6 +62,12 @@ data Opts = Opts -- see #23857 and #22550 for the very unfortunate story. , optLd :: ProgOpt , optUnregisterised :: Maybe Bool + + -- dwarf unwinding + , optDwarfUnwind :: Maybe Bool + , optLibdwIncludes :: Maybe FilePath + , optLibdwLibraries :: Maybe FilePath + , optTablesNextToCode :: Maybe Bool , optUseLibFFIForAdjustors :: Maybe Bool , optLdOverride :: Maybe Bool @@ -112,6 +118,9 @@ emptyOpts = Opts , optOtool = po0 , optInstallNameTool = po0 , optUnregisterised = Nothing + , optDwarfUnwind = Nothing + , optLibdwIncludes = Nothing + , optLibdwLibraries = Nothing , optTablesNextToCode = Nothing , optUseLibFFIForAdjustors = Nothing , optLdOverride = Nothing @@ -157,13 +166,18 @@ _optOutput = Lens optOutput (\x o -> o {optOutput=x}) _optTargetPrefix :: Lens Opts (Maybe String) _optTargetPrefix = Lens optTargetPrefix (\x o -> o {optTargetPrefix=x}) -_optLocallyExecutable, _optUnregisterised, _optTablesNextToCode, _optUseLibFFIForAdjustors, _optLdOvveride :: Lens Opts (Maybe Bool) +_optLocallyExecutable, _optUnregisterised, _optTablesNextToCode, _optUseLibFFIForAdjustors, _optLdOvveride, _optDwarfUnwind :: Lens Opts (Maybe Bool) _optLocallyExecutable = Lens optLocallyExecutable (\x o -> o {optLocallyExecutable=x}) _optUnregisterised = Lens optUnregisterised (\x o -> o {optUnregisterised=x}) +_optDwarfUnwind = Lens optDwarfUnwind (\x o -> o {optDwarfUnwind=x}) _optTablesNextToCode = Lens optTablesNextToCode (\x o -> o {optTablesNextToCode=x}) _optUseLibFFIForAdjustors = Lens optUseLibFFIForAdjustors (\x o -> o {optUseLibFFIForAdjustors=x}) _optLdOvveride = Lens optLdOverride (\x o -> o {optLdOverride=x}) +_optLibdwIncludes, _optLibdwLibraries :: Lens Opts (Maybe FilePath) +_optLibdwIncludes = Lens optLibdwIncludes (\x o -> o {optLibdwIncludes=x}) +_optLibdwLibraries = Lens optLibdwLibraries (\x o -> o {optLibdwLibraries=x}) + _optVerbosity :: Lens Opts Int _optVerbosity = Lens optVerbosity (\x o -> o {optVerbosity=x}) @@ -185,6 +199,7 @@ options = , enableDisable "libffi-adjustors" "the use of libffi for adjustors, even on platforms which have support for more efficient, native adjustor implementations." _optUseLibFFIForAdjustors , enableDisable "ld-override" "override gcc's default linker" _optLdOvveride , enableDisable "locally-executable" "the use of a target prefix which will be added to all tool names when searching for toolchain components" _optLocallyExecutable + , enableDisable "dwarf-unwind" "Enable DWARF unwinding support in the runtime system via elfutils' libdw" _optDwarfUnwind ] ++ concat [ progOpts "cc" "C compiler" _optCc @@ -206,6 +221,9 @@ options = , progOpts "ld" "linker" _optLd , progOpts "otool" "otool utility" _optOtool , progOpts "install-name-tool" "install-name-tool utility" _optInstallNameTool + ] ++ + [ Option [] ["libdw-includes"] (ReqArg (set _optLibdwIncludes . Just) "PATH") "Look for libdw headers in this extra path" + , Option [] ["libdw-libraries"] (ReqArg (set _optLibdwLibraries . Just) "PATH") "Look for the libdw library in this extra path" ] where progOpts :: String -> String -> Lens Opts ProgOpt -> [OptDescr (Opts -> Opts)] @@ -486,6 +504,10 @@ mkTarget opts = do tgtSupportsSubsectionsViaSymbols <- checkSubsectionsViaSymbols archOs cc tgtSupportsIdentDirective <- checkIdentDirective cc tgtSupportsGnuNonexecStack <- checkGnuNonexecStack archOs cc + tgtHasLibm <- checkTargetHasLibm cc + tgtRTSWithLibdw <- case optDwarfUnwind opts of + Just True -> checkTargetHasLibdw cc (optLibdwIncludes opts) (optLibdwLibraries opts) + _ -> pure Nothing -- code generator configuration tgtUnregisterised <- determineUnregisterised archOs (optUnregisterised opts) @@ -526,6 +548,8 @@ mkTarget opts = do , tgtUnregisterised , tgtTablesNextToCode , tgtUseLibffiForAdjustors = tgtUseLibffi + , tgtHasLibm + , tgtRTSWithLibdw , tgtSymbolsHaveLeadingUnderscore , tgtSupportsSubsectionsViaSymbols , tgtSupportsIdentDirective ===================================== utils/ghc-toolchain/ghc-toolchain.cabal ===================================== @@ -12,6 +12,7 @@ library exposed-modules: GHC.Toolchain, GHC.Toolchain.Lens, + GHC.Toolchain.Library, GHC.Toolchain.Monad, GHC.Toolchain.PlatformDetails, GHC.Toolchain.Prelude, ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Library.hs ===================================== @@ -0,0 +1,22 @@ +module GHC.Toolchain.Library + ( Library(..) + ) + where + +import System.FilePath +import GHC.Toolchain.Prelude + +data Library = Library { libName :: String + , includePath :: Maybe FilePath + , libraryPath :: Maybe FilePath + } + deriving (Read, Eq, Ord) + +instance Show Library where + -- Normalise filepaths before showing to aid with diffing the target files. + show (Library n i l) = unwords + [ "Library { libName = ", show n + , ", includePath = ", show (normalise <$> i) + , ", libraryPath =", show (normalise <$> l) + , "}"] + ===================================== utils/ghc-toolchain/src/GHC/Toolchain/PlatformDetails.hs ===================================== @@ -5,6 +5,8 @@ module GHC.Toolchain.PlatformDetails , checkSubsectionsViaSymbols , checkIdentDirective , checkGnuNonexecStack + , checkTargetHasLibm + , checkTargetHasLibdw ) where import Data.List (isInfixOf) @@ -16,6 +18,7 @@ import GHC.Toolchain.Prelude import GHC.Toolchain.Utils import GHC.Toolchain.Target import GHC.Toolchain.Program +import GHC.Toolchain.Library import GHC.Toolchain.Tools.Cc import GHC.Toolchain.Tools.Nm @@ -112,8 +115,6 @@ checkEndianness__BYTE_ORDER__ cc = checking "endianness (__BYTE_ORDER__)" $ do , "#endif" ] - - checkLeadingUnderscore :: Cc -> Nm -> M Bool checkLeadingUnderscore cc nm = checking ctxt $ withTempDir $ \dir -> do let test_o = dir </> "test.o" @@ -156,12 +157,68 @@ checkGnuNonexecStack archOs = , asmStmt ".section .text" ] +checkTargetHasLibm :: Cc -> M Bool +checkTargetHasLibm cc = testLib cc "m" "atan" Nothing + +checkTargetHasLibdw :: Cc -> Maybe FilePath -> Maybe FilePath -> M (Maybe Library) +checkTargetHasLibdw cc mincludeDir mlibDir = do + b1 <- testHeader cc "elfutils/libdwfl.h" mincludeDir + b2 <- testLib cc "dw" "dwfl_attach_state" mlibDir + return $ + if b1 && b2 + then Just + Library{ libName = "dw" + , includePath = mincludeDir, libraryPath = mlibDir} + else Nothing + + +-------------------------------------------------------------------------------- +-- Utilities +-------------------------------------------------------------------------------- + asmStmt :: String -> String asmStmt s = "__asm__(\"" ++ foldMap escape s ++ "\");" where escape '"' = "\\\"" escape c = [c] +-- | Check whether a lib is found and can be linked against. +-- Like @AC_CHECK_LIB@. +testLib :: Cc + -> String -- ^ Lib name + -> String -- ^ Lib symbol + -> Maybe FilePath -- ^ Library dir (-L) + -> M Bool +testLib cc0 libname symbol mlibDir = testCompile ("whether target has lib" ++ libname) prog cc2 + where + cc1 = cc0 & _ccProgram % _prgFlags %++ ("-l" ++ libname) + cc2 | Just libDir <- mlibDir + = cc1 & _ccProgram % _prgFlags %++ ("-L" ++ libDir) + | otherwise = cc1 + prog = unlines + [ "char " ++ symbol ++ " (void);" + , "int" + , "main (void)" + , "{" + , "return " ++ symbol ++ " ();" + , " ;" + , " return 0;" + , "}" + ] + +-- | Like @AC_CHECK_HEADER@ +testHeader :: Cc + -> String -- ^ Header to check for + -> Maybe FilePath -- ^ Extra path + -> M Bool +testHeader cc0 header mincludeDir = testCompile ("whether target has <" ++ header ++ ">") prog cc1 + where + cc1 | Just includeDir <- mincludeDir + = cc0 & _ccProgram % _prgFlags %++ ("-I" ++ includeDir) + | otherwise = cc0 + prog = unlines + [ "#include <" ++ header ++ ">" ] + -- | Try compiling a program, returning 'True' if successful. testCompile :: String -> String -> Cc -> M Bool testCompile what program cc = checking what $ withTempDir $ \dir -> do ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Target.hs ===================================== @@ -19,6 +19,7 @@ import GHC.Platform.ArchOS import GHC.Toolchain.Prelude import GHC.Toolchain.Program +import GHC.Toolchain.Library import GHC.Toolchain.Tools.Cc import GHC.Toolchain.Tools.Cxx @@ -56,6 +57,13 @@ data Target = Target -- , tgtHasThreadedRts :: Bool -- We likely just need this when bootstrapping , tgtUseLibffiForAdjustors :: Bool -- ^ We need to know whether or not to include libffi headers, and generate additional code for it + , tgtHasLibm :: Bool + -- ^ Does this target have a libm library that should always be linked against? + + -- RTS capabilities + , tgtRTSWithLibdw :: Maybe Library + -- ^ Whether this target RTS is built with libdw support (for DWARF + -- unwinding), and if yes, the 'Library' configuration. -- C toolchain , tgtCCompiler :: Cc @@ -121,6 +129,8 @@ instance Show Target where , ", tgtUnregisterised = " ++ show tgtUnregisterised , ", tgtTablesNextToCode = " ++ show tgtTablesNextToCode , ", tgtUseLibffiForAdjustors = " ++ show tgtUseLibffiForAdjustors + , ", tgtHasLibm = " ++ show tgtHasLibm + , ", tgtRTSWithLibdw = " ++ show tgtRTSWithLibdw , ", tgtCCompiler = " ++ show tgtCCompiler , ", tgtCxxCompiler = " ++ show tgtCxxCompiler , ", tgtCPreprocessor = " ++ show tgtCPreprocessor View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/35a0006e9b23d57c1767f937b425e1… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/35a0006e9b23d57c1767f937b425e1… You're receiving this email because of your account on gitlab.haskell.org.

1 0