[Git][ghc/ghc][wip/base-unit-hash] driver: Always link against "base" package when one shot linking
Zubin (@wz1000)
gitlab at gitlab.haskell.org
Wed Nov 20 10:46:21 UTC 2024
Zubin pushed to branch wip/base-unit-hash at Glasgow Haskell Compiler / GHC
Commits:
36138977 by Matthew Pickering at 2024-11-20T16:16:10+05:30
driver: Always link against "base" package when one shot linking
The default value for base-unit-id is stored in the settings file.
At install time, this can be set by using the BASE_UNIT_ID environment
variable.
At runtime, the value can be set by `-base-unit-id` flag.
For whether all this is a good idea, see #25382
Fixes #25382
- - - - -
13 changed files:
- compiler/GHC/Driver/DynFlags.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/Settings.hs
- compiler/GHC/Settings/IO.hs
- compiler/GHC/Unit/State.hs
- distrib/configure.ac.in
- docs/users_guide/packages.rst
- hadrian/bindist/Makefile
- hadrian/bindist/config.mk.in
- hadrian/src/Rules/Generate.hs
- testsuite/tests/driver/Makefile
- + testsuite/tests/driver/T25382.hs
- testsuite/tests/driver/all.T
Changes:
=====================================
compiler/GHC/Driver/DynFlags.hs
=====================================
@@ -62,6 +62,10 @@ module GHC.Driver.DynFlags (
versionedAppDir, versionedFilePath,
extraGccViaCFlags, globalPackageDatabasePath,
+ --
+ baseUnitId,
+
+
-- * Include specifications
IncludeSpecs(..), addGlobalInclude, addQuoteInclude, flattenIncludes,
addImplicitQuoteInclude,
@@ -165,6 +169,8 @@ data DynFlags = DynFlags {
-- formerly Settings
ghcNameVersion :: {-# UNPACK #-} !GhcNameVersion,
fileSettings :: {-# UNPACK #-} !FileSettings,
+ unitSettings :: {-# UNPACK #-} !UnitSettings,
+
targetPlatform :: Platform, -- Filled in by SysTools
toolSettings :: {-# UNPACK #-} !ToolSettings,
platformMisc :: {-# UNPACK #-} !PlatformMisc,
@@ -634,6 +640,7 @@ defaultDynFlags mySettings =
splitInfo = Nothing,
ghcNameVersion = sGhcNameVersion mySettings,
+ unitSettings = sUnitSettings mySettings,
fileSettings = sFileSettings mySettings,
toolSettings = sToolSettings mySettings,
targetPlatform = sTargetPlatform mySettings,
@@ -1484,6 +1491,11 @@ versionedAppDir appname platform = do
versionedFilePath :: ArchOS -> FilePath
versionedFilePath platform = uniqueSubdir platform
+-- | Access the unit-id of the version of `base` which we will automatically link
+-- against.
+baseUnitId :: DynFlags -> UnitId
+baseUnitId dflags = unitSettings_baseUnitId (unitSettings dflags)
+
-- SDoc
-------------------------------------------
-- | Initialize the pretty-printing options
=====================================
compiler/GHC/Driver/Session.hs
=====================================
@@ -80,6 +80,9 @@ module GHC.Driver.Session (
safeDirectImpsReq, safeImplicitImpsReq,
unsafeFlags, unsafeFlagsForInfer,
+ -- ** base
+ baseUnitId,
+
-- ** System tool settings and locations
Settings(..),
sProgramName,
@@ -390,6 +393,7 @@ settings :: DynFlags -> Settings
settings dflags = Settings
{ sGhcNameVersion = ghcNameVersion dflags
, sFileSettings = fileSettings dflags
+ , sUnitSettings = unitSettings dflags
, sTargetPlatform = targetPlatform dflags
, sToolSettings = toolSettings dflags
, sPlatformMisc = platformMisc dflags
@@ -488,6 +492,10 @@ opt_las dflags = toolSettings_opt_las $ toolSettings dflags
opt_i :: DynFlags -> [String]
opt_i dflags= toolSettings_opt_i $ toolSettings dflags
+
+setBaseUnitId :: String -> DynP ()
+setBaseUnitId s = upd $ \d -> d { unitSettings = UnitSettings (stringToUnitId s) }
+
-----------------------------------------------------------------------------
{-
@@ -2053,6 +2061,7 @@ package_flags_deps = [
(NoArg (setGeneralFlag Opt_DistrustAllPackages))
, make_ord_flag defFlag "trust" (HasArg trustPackage)
, make_ord_flag defFlag "distrust" (HasArg distrustPackage)
+ , make_ord_flag defFlag "base-unit-id" (HasArg setBaseUnitId)
]
where
setPackageEnv env = upd $ \s -> s { packageEnv = Just env }
=====================================
compiler/GHC/Settings.hs
=====================================
@@ -5,6 +5,7 @@ module GHC.Settings
( Settings (..)
, ToolSettings (..)
, FileSettings (..)
+ , UnitSettings(..)
, GhcNameVersion (..)
, Platform (..)
, PlatformMisc (..)
@@ -73,6 +74,7 @@ import GHC.Prelude
import GHC.Utils.CliOption
import GHC.Utils.Fingerprint
import GHC.Platform
+import GHC.Unit.Types
data Settings = Settings
{ sGhcNameVersion :: {-# UNPACk #-} !GhcNameVersion
@@ -80,12 +82,15 @@ data Settings = Settings
, sTargetPlatform :: Platform -- Filled in by SysTools
, sToolSettings :: {-# UNPACK #-} !ToolSettings
, sPlatformMisc :: {-# UNPACK #-} !PlatformMisc
+ , sUnitSettings :: !UnitSettings
-- You shouldn't need to look things up in rawSettings directly.
-- They should have their own fields instead.
, sRawSettings :: [(String, String)]
}
+data UnitSettings = UnitSettings { unitSettings_baseUnitId :: !UnitId }
+
-- | Settings for other executables GHC calls.
--
-- Probably should further split down by phase, or split between
=====================================
compiler/GHC/Settings/IO.hs
=====================================
@@ -19,6 +19,7 @@ import GHC.Utils.Panic
import GHC.ResponseFile
import GHC.Settings
import GHC.SysTools.BaseDir
+import GHC.Unit.Types
import Data.Char
import Control.Monad.Trans.Except
@@ -174,6 +175,8 @@ initSettings top_dir = do
ghcWithInterpreter <- getBooleanSetting "Use interpreter"
useLibFFI <- getBooleanSetting "Use LibFFI"
+ baseUnitId <- getSetting "base unit-id"
+
return $ Settings
{ sGhcNameVersion = GhcNameVersion
{ ghcNameVersion_programName = "ghc"
@@ -188,6 +191,11 @@ initSettings top_dir = do
, fileSettings_globalPackageDatabase = globalpkgdb_path
}
+ , sUnitSettings = UnitSettings
+ {
+ unitSettings_baseUnitId = stringToUnitId baseUnitId
+ }
+
, sToolSettings = ToolSettings
{ toolSettings_ldSupportsCompactUnwind = ldSupportsCompactUnwind
, toolSettings_ldSupportsFilelist = ldSupportsFilelist
=====================================
compiler/GHC/Unit/State.hs
=====================================
@@ -364,9 +364,13 @@ initUnitConfig dflags cached_dbs home_units =
autoLink
| not (gopt Opt_AutoLinkPackages dflags) = []
- -- By default we add ghc-internal & rts to the preload units (when they are
+ -- By default we add base, ghc-internal and rts to the preload units (when they are
-- found in the unit database) except when we are building them
- | otherwise = filter (hu_id /=) [ghcInternalUnitId, rtsUnitId]
+ --
+ -- Since "base" is not wired in, then the unit-id is discovered
+ -- from the settings file by default, but can be overriden by power-users
+ -- by specifying `-base-unit-id` flag.
+ | otherwise = filter (hu_id /=) [baseUnitId dflags, ghcInternalUnitId, rtsUnitId]
-- if the home unit is indefinite, it means we are type-checking it only
-- (not producing any code). Hence we can use virtual units instantiated
=====================================
distrib/configure.ac.in
=====================================
@@ -366,6 +366,16 @@ if test "x$UseLibdw" = "xYES" ; then
fi
AC_SUBST(UseLibdw)
+dnl What is the version of the base library which we are going to use?
+dnl The user can use BASE_UNIT_ID at install time to point the compiler to
+dnl use a different base if they are going to guarantee it is available.
+BaseUnitId=@BaseUnitId@
+if test -n "$BASE_UNIT_ID"; then
+ BaseUnitId="$BASE_UNIT_ID"
+fi
+
+AC_SUBST(BaseUnitId)
+
FP_SETTINGS
# We get caught by
=====================================
docs/users_guide/packages.rst
=====================================
@@ -239,9 +239,28 @@ The GHC command line options that control packages are:
:type: dynamic
:category:
- By default, GHC will automatically link in the ``base`` and ``rts``
+ By default, GHC will automatically link in the ``base``, ``ghc-internal`` and ``rts``
packages. This flag disables that behaviour.
+ The unit-id of the ``base`` package which is automatically linked can be set using
+ the :ghc-flag:`-base-unit-id ⟨unit-id⟩` flag.
+
+.. ghc-flag:: -base-unit-id ⟨unit-id⟩
+ :shortdesc: The unit-id of the "base" package, which will be automatically linked.
+ :type: dynamic
+ :category:
+ :since: 9.12.1
+
+ By default the compiler will link against the ``base``, ``ghc-internal``,
+ and ``rts`` package, this flag controls what the ``base`` package linked
+ against is.
+
+ You should only need to pass this flag if you really know what you are doing.
+ Distributors can set a default unit-id for base at install time by specifying
+ the ``BASE_UNIT_ID`` environment variable.
+
+
+
.. ghc-flag:: -this-unit-id ⟨unit-id⟩
:shortdesc: Compile to be part of unit (i.e. package)
⟨unit-id⟩
=====================================
hadrian/bindist/Makefile
=====================================
@@ -142,6 +142,7 @@ lib/settings : config.mk
@echo ',("Use LibFFI", "$(UseLibffiForAdjustors)")' >> $@
@echo ',("RTS expects libdw", "$(GhcRtsWithLibdw)")' >> $@
@echo ',("Relative Global Package DB", "package.conf.d")' >> $@
+ @echo ',("base unit-id", "$(BaseUnitId)")' >> $@
@echo "]" >> $@
# We need to install binaries relative to libraries.
=====================================
hadrian/bindist/config.mk.in
=====================================
@@ -134,6 +134,7 @@ CrossCompiling = @CrossCompiling@
CrossCompilePrefix = @CrossCompilePrefix@
GhcUnregisterised = @Unregisterised@
EnableDistroToolchain = @SettingsUseDistroMINGW@
+BaseUnitId = @BaseUnitId@
# The THREADED_RTS requires `BaseReg` to be in a register and the
# `GhcUnregisterised` mode doesn't allow that.
=====================================
hadrian/src/Rules/Generate.hs
=====================================
@@ -435,6 +435,7 @@ bindistRules = do
, interpolateVar "UseLibdw" $ fmap yesNo $ interp $ getFlag UseLibdw
, interpolateVar "UseLibffiForAdjustors" $ yesNo <$> getTarget tgtUseLibffiForAdjustors
, interpolateVar "GhcWithSMP" $ yesNo <$> targetSupportsSMP
+ , interpolateVar "BaseUnitId" $ pkgUnitId Stage1 base
]
where
interp = interpretInContext (semiEmptyTarget Stage2)
@@ -471,6 +472,14 @@ generateSettings settingsFile = do
Stage2 -> get_pkg_db Stage1
Stage3 -> get_pkg_db Stage2
+ -- The unit-id of the base package which is always linked against (#25382)
+ base_unit_id <- expr $ do
+ case stage of
+ Stage0 {} -> error "Unable to generate settings for stage0"
+ Stage1 -> pkgUnitId Stage1 base
+ Stage2 -> pkgUnitId Stage1 base
+ Stage3 -> pkgUnitId Stage2 base
+
let rel_pkg_db = makeRelativeNoSysLink (dropFileName settingsFile) package_db_path
settings <- traverse sequence $
@@ -531,6 +540,7 @@ generateSettings settingsFile = do
, ("Use LibFFI", expr $ yesNo <$> useLibffiForAdjustors)
, ("RTS expects libdw", yesNo <$> getFlag UseLibdw)
, ("Relative Global Package DB", pure rel_pkg_db)
+ , ("base unit-id", pure base_unit_id)
]
let showTuple (k, v) = "(" ++ show k ++ ", " ++ show v ++ ")"
pure $ case settings of
=====================================
testsuite/tests/driver/Makefile
=====================================
@@ -808,3 +808,8 @@ T23339B:
"$(TEST_HC)" -tmpdir "$(PWD)/tmp" $(TEST_HC_OPTS) -v0 T23339B.hs -finfo-table-map
# Check that the file is kept and is the right one
find . -name "*.c" -exec cat {} \; | grep "init__ip_init"
+
+# Test that base is linked against implicitly
+T25382:
+ "$(TEST_HC)" $(TEST_HC_OPTS) -c T25382.hs
+ "$(TEST_HC)" $(TEST_HC_OPTS) T25382.o -o main
=====================================
testsuite/tests/driver/T25382.hs
=====================================
@@ -0,0 +1,7 @@
+module Main where
+
+import Data.Complex
+
+main = do
+ x <- readLn :: IO (Complex Int)
+ print $ realPart x
=====================================
testsuite/tests/driver/all.T
=====================================
@@ -330,3 +330,4 @@ test('T23944', [unless(have_dynamic(), skip), extra_files(['T23944A.hs'])], mult
test('T24286', [cxx_src, unless(have_profiling(), skip), extra_files(['T24286.cpp'])], compile, ['-prof -no-hs-main'])
test('T24839', [unless(arch('x86_64') or arch('aarch64'), skip), extra_files(["t24839_sub.S"])], compile_and_run, ['t24839_sub.S'])
test('t25150', [extra_files(["t25150"])], multimod_compile, ['Main.hs', '-v0 -working-dir t25150/dir a.c'])
+test('T25382', normal, makefile_test, [])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3613897714089f4470d8700afc0dcee4741b126d
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3613897714089f4470d8700afc0dcee4741b126d
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20241120/d4001f02/attachment-0001.html>
More information about the ghc-commits
mailing list