Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
0ddd0fdc by soulomoon at 2025-09-28T19:24:10-04:00
Remove hptAllInstances usage during upsweep
Previously, during the upsweep phase when
checking safe imports, we were loading the module
interface with runTcInteractive, which in turn calls
hptAllInstances. This accesses non-below modules
from the home package table.
Change the implementation of checkSafeImports
to use initTcWithGbl and loadSysInterface to load the
module interface, since we already have TcGblEnv at hand.
This eliminates the unnecessary use of runTcInteractive
and hptAllInstances during the upsweep phase.
- - - - -
e05c496c by Ben Gamari at 2025-09-28T19:24:59-04:00
base: Update changelog to reflect timing of IOPort# removal
This change will make 9.14 afterall.
- - - - -
bdc9d130 by Cheng Shao at 2025-09-28T19:25:45-04:00
rts: fix wasm JSFFI initialization constructor code
This commit fixes wasm JSFFI initialization constructor code so that
the constructor is self-contained and avoids invoking a fake
__main_argc_argv function. The previous approach of reusing
__main_void logic in wasi-libc saves a tiny bit of code, at the
expense of link-time trouble whenever GHC links a wasm module without
-no-hs-main, in which case the driver-generated main function would
clash with the definition here, resulting in a linker error. It's
simply better to avoid messing with the main function, and it would
additionally allow linking wasm32-wasi command modules that does make
use of synchronous JSFFI.
- - - - -
5d59fc8f by Cheng Shao at 2025-09-28T19:26:27-04:00
rts: provide stub implementations of ExecPage functions for wasm
This patch provides stub implementations of ExecPage functions for
wasm. They are never actually invoked at runtime for any non-TNTC
platform, yet they can cause link-time errors of missing symbols when
the GHCi.InfoTable module gets linked into the final wasm module (e.g.
a GHC API program).
- - - - -
a4d664c7 by Cheng Shao at 2025-09-29T17:29:22+02:00
compiler/ghci: replace the LoadDLL message with LoadDLLs
As a part of #25407, this commit changes the LoadDLL message to
LoadDLLs, which takes a list of DLL paths to load and returns the list
of remote pointer handles. The wasm dyld is refactored to take
advantage of LoadDLLs and harvest background parallelism. On other
platforms, LoadDLLs is based on a fallback codepath that does
sequential loading.
The driver is not actually emitting singular LoadDLLs message with
multiple DLLs yet, this is left in subsequent commits.
Co-authored-by: Codex
- - - - -
c7fc4bae by Cheng Shao at 2025-09-29T17:29:22+02:00
driver: separate downsweep/upsweep phase in loadPackages'
This commit refactors GHC.Linker.Loader.loadPackages' to be separated
into downsweep/upsweep phases:
- The downsweep phase performs dependency analysis and generates a
list of topologically sorted packages to load
- The upsweep phase sequentially loads these packages by calling
loadPackage
This is a necessary refactoring to make it possible to make loading of
DLLs concurrent.
- - - - -
ab180104 by Cheng Shao at 2025-09-29T17:57:19+02:00
driver: emit single LoadDLLs message to load multiple DLLs
This commit refactors the driver so that it emits a single LoadDLLs
message to load multiple DLLs in GHC.Linker.Loader.loadPackages'.
Closes #25407.
-------------------------
Metric Increase:
MultiLayerModulesTH_OneShot
TcPlugin_RewritePerf
-------------------------
Co-authored-by: Codex
- - - - -
6bf800f3 by Sean D. Gillespie at 2025-09-29T15:35:41-04:00
Fix SIZED_BIN_OP_TY_INT casts in RTS interpreter
Correct `SIZED_BIN_OP_TY_INT` cast to integer. Previously, it cast
its second operand as its parameter `ty`. This does not currently
cause any issues, since we are only using it for bit shifts.
Fixes #26287
- - - - -
15 changed files:
- compiler/GHC/Driver/Main.hs
- compiler/GHC/Driver/Plugins.hs
- compiler/GHC/Linker/Loader.hs
- compiler/GHC/Linker/MacOS.hs
- compiler/GHC/Linker/Types.hs
- compiler/GHC/Runtime/Interpreter.hs
- libraries/base/changelog.md
- libraries/ghci/GHCi/Message.hs
- libraries/ghci/GHCi/ObjLink.hs
- libraries/ghci/GHCi/Run.hs
- rts/ExecPage.c
- rts/Interpreter.c
- rts/wasm/JSFFI.c
- testsuite/tests/rts/linker/T2615.hs
- utils/jsffi/dyld.mjs
Changes:
=====================================
compiler/GHC/Driver/Main.hs
=====================================
@@ -165,7 +165,7 @@ import GHC.JS.Syntax
import GHC.IfaceToCore ( typecheckIface, typecheckWholeCoreBindings )
-import GHC.Iface.Load ( ifaceStats, writeIface, flagsToIfCompression, getGhcPrimIface )
+import GHC.Iface.Load ( ifaceStats, writeIface, flagsToIfCompression, getGhcPrimIface, loadSysInterface )
import GHC.Iface.Make
import GHC.Iface.Recomp
import GHC.Iface.Tidy
@@ -1765,7 +1765,7 @@ hscCheckSafe' m l = do
-- so we need to call 'getModuleInterface' to load from disk
case iface of
Just _ -> return iface
- Nothing -> snd `fmap` (liftIO $ getModuleInterface hsc_env m)
+ Nothing -> liftIO $ initIfaceLoad hsc_env (Just <$> loadSysInterface (text "checkSafeImports") m)
-- | Check the list of packages are trusted.
=====================================
compiler/GHC/Driver/Plugins.hs
=====================================
@@ -421,7 +421,7 @@ loadExternalPlugins ps = do
loadExternalPluginLib :: FilePath -> IO ()
loadExternalPluginLib path = do
-- load library
- loadDLL path >>= \case
+ loadDLLs [path] >>= \case
Left errmsg -> pprPanic "loadExternalPluginLib"
(vcat [ text "Can't load plugin library"
, text " Library path: " <> text path
=====================================
compiler/GHC/Linker/Loader.hs
=====================================
@@ -1,6 +1,7 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE ViewPatterns #-}
--
-- (c) The University of Glasgow 2002-2006
@@ -535,7 +536,7 @@ preloadLib interp hsc_env lib_paths framework_paths pls lib_spec = do
return pls
DLL dll_unadorned -> do
- maybe_errstr <- loadDLL interp (platformSOName platform dll_unadorned)
+ maybe_errstr <- loadDLLs interp [platformSOName platform dll_unadorned]
case maybe_errstr of
Right _ -> maybePutStrLn logger "done"
Left mm | platformOS platform /= OSDarwin ->
@@ -545,14 +546,14 @@ preloadLib interp hsc_env lib_paths framework_paths pls lib_spec = do
-- since (apparently) some things install that way - see
-- ticket #8770.
let libfile = ("lib" ++ dll_unadorned) <.> "so"
- err2 <- loadDLL interp libfile
+ err2 <- loadDLLs interp [libfile]
case err2 of
Right _ -> maybePutStrLn logger "done"
Left _ -> preloadFailed mm lib_paths lib_spec
return pls
DLLPath dll_path -> do
- do maybe_errstr <- loadDLL interp dll_path
+ do maybe_errstr <- loadDLLs interp [dll_path]
case maybe_errstr of
Right _ -> maybePutStrLn logger "done"
Left mm -> preloadFailed mm lib_paths lib_spec
@@ -892,7 +893,7 @@ dynLoadObjs interp hsc_env pls@LoaderState{..} objs = do
-- if we got this far, extend the lifetime of the library file
changeTempFilesLifetime tmpfs TFL_GhcSession [soFile]
- m <- loadDLL interp soFile
+ m <- loadDLLs interp [soFile]
case m of
Right _ -> return $! pls { temp_sos = (libPath, libName) : temp_sos }
Left err -> linkFail msg (text err)
@@ -1129,51 +1130,91 @@ loadPackages interp hsc_env new_pkgs = do
loadPackages' :: Interp -> HscEnv -> [UnitId] -> LoaderState -> IO LoaderState
loadPackages' interp hsc_env new_pks pls = do
- pkgs' <- link (pkgs_loaded pls) new_pks
- return $! pls { pkgs_loaded = pkgs'
- }
+ (reverse -> pkgs_info_list, pkgs_almost_loaded) <-
+ downsweep
+ ([], pkgs_loaded pls)
+ new_pks
+ loaded_pkgs_info_list <- loadPackage interp hsc_env pkgs_info_list
+ evaluate $
+ pls
+ { pkgs_loaded =
+ foldl'
+ ( \pkgs (new_pkg_info, (hs_cls, extra_cls, loaded_dlls)) ->
+ adjustUDFM
+ ( \old_pkg_info ->
+ old_pkg_info
+ { loaded_pkg_hs_objs = hs_cls,
+ loaded_pkg_non_hs_objs = extra_cls,
+ loaded_pkg_hs_dlls = loaded_dlls
+ }
+ )
+ pkgs
+ (Packages.unitId new_pkg_info)
+ )
+ pkgs_almost_loaded
+ (zip pkgs_info_list loaded_pkgs_info_list)
+ }
where
- link :: PkgsLoaded -> [UnitId] -> IO PkgsLoaded
- link pkgs new_pkgs =
- foldM link_one pkgs new_pkgs
-
- link_one pkgs new_pkg
- | new_pkg `elemUDFM` pkgs -- Already linked
- = return pkgs
-
- | Just pkg_cfg <- lookupUnitId (hsc_units hsc_env) new_pkg
- = do { let deps = unitDepends pkg_cfg
- -- Link dependents first
- ; pkgs' <- link pkgs deps
- -- Now link the package itself
- ; (hs_cls, extra_cls, loaded_dlls) <- loadPackage interp hsc_env pkg_cfg
- ; let trans_deps = unionManyUniqDSets [ addOneToUniqDSet (loaded_pkg_trans_deps loaded_pkg_info) dep_pkg
- | dep_pkg <- deps
- , Just loaded_pkg_info <- pure (lookupUDFM pkgs' dep_pkg)
- ]
- ; return (addToUDFM pkgs' new_pkg (LoadedPkgInfo new_pkg hs_cls extra_cls loaded_dlls trans_deps)) }
-
- | otherwise
- = throwGhcExceptionIO (CmdLineError ("unknown package: " ++ unpackFS (unitIdFS new_pkg)))
-
-
-loadPackage :: Interp -> HscEnv -> UnitInfo -> IO ([LibrarySpec], [LibrarySpec], [RemotePtr LoadedDLL])
-loadPackage interp hsc_env pkg
+ -- The downsweep process takes an initial 'PkgsLoaded' and uses it
+ -- to memoize new packages to load when recursively downsweeping
+ -- the dependencies. The returned 'PkgsLoaded' is popularized with
+ -- placeholder 'LoadedPkgInfo' for new packages yet to be loaded,
+ -- which need to be modified later to fill in the missing fields.
+ --
+ -- The [UnitInfo] list is an accumulated *reverse* topologically
+ -- sorted list of new packages to load: 'downsweep_one' appends a
+ -- package to its head after that package's transitive
+ -- dependencies go into that list. There are no duplicate items in
+ -- this list due to memoization.
+ downsweep ::
+ ([UnitInfo], PkgsLoaded) -> [UnitId] -> IO ([UnitInfo], PkgsLoaded)
+ downsweep = foldlM downsweep_one
+
+ downsweep_one ::
+ ([UnitInfo], PkgsLoaded) -> UnitId -> IO ([UnitInfo], PkgsLoaded)
+ downsweep_one (pkgs_info_list, pkgs) new_pkg
+ | new_pkg `elemUDFM` pkgs = pure (pkgs_info_list, pkgs)
+ | Just new_pkg_info <- lookupUnitId (hsc_units hsc_env) new_pkg = do
+ let new_pkg_deps = unitDepends new_pkg_info
+ (pkgs_info_list', pkgs') <- downsweep (pkgs_info_list, pkgs) new_pkg_deps
+ let new_pkg_trans_deps =
+ unionManyUniqDSets
+ [ addOneToUniqDSet (loaded_pkg_trans_deps loaded_pkg_info) dep_pkg
+ | dep_pkg <- new_pkg_deps,
+ loaded_pkg_info <- maybeToList $ pkgs' `lookupUDFM` dep_pkg
+ ]
+ pure
+ ( new_pkg_info : pkgs_info_list',
+ addToUDFM pkgs' new_pkg $
+ LoadedPkgInfo
+ { loaded_pkg_uid = new_pkg,
+ loaded_pkg_hs_objs = [],
+ loaded_pkg_non_hs_objs = [],
+ loaded_pkg_hs_dlls = [],
+ loaded_pkg_trans_deps = new_pkg_trans_deps
+ }
+ )
+ | otherwise =
+ throwGhcExceptionIO
+ (CmdLineError ("unknown package: " ++ unpackFS (unitIdFS new_pkg)))
+
+loadPackage :: Interp -> HscEnv -> [UnitInfo] -> IO [([LibrarySpec], [LibrarySpec], [RemotePtr LoadedDLL])]
+loadPackage interp hsc_env pkgs
= do
let dflags = hsc_dflags hsc_env
let logger = hsc_logger hsc_env
platform = targetPlatform dflags
is_dyn = interpreterDynamic interp
- dirs | is_dyn = map ST.unpack $ Packages.unitLibraryDynDirs pkg
- | otherwise = map ST.unpack $ Packages.unitLibraryDirs pkg
+ dirs | is_dyn = [map ST.unpack $ Packages.unitLibraryDynDirs pkg | pkg <- pkgs]
+ | otherwise = [map ST.unpack $ Packages.unitLibraryDirs pkg | pkg <- pkgs]
- let hs_libs = map ST.unpack $ Packages.unitLibraries pkg
+ let hs_libs = [map ST.unpack $ Packages.unitLibraries pkg | pkg <- pkgs]
-- The FFI GHCi import lib isn't needed as
-- GHC.Linker.Loader + rts/Linker.c link the
-- interpreted references to FFI to the compiled FFI.
-- We therefore filter it out so that we don't get
-- duplicate symbol errors.
- hs_libs' = filter ("HSffi" /=) hs_libs
+ hs_libs' = filter ("HSffi" /=) <$> hs_libs
-- Because of slight differences between the GHC dynamic linker and
-- the native system linker some packages have to link with a
@@ -1182,53 +1223,62 @@ loadPackage interp hsc_env pkg
-- libs do not exactly match the .so/.dll equivalents. So if the
-- package file provides an "extra-ghci-libraries" field then we use
-- that instead of the "extra-libraries" field.
- extdeplibs = map ST.unpack (if null (Packages.unitExtDepLibsGhc pkg)
+ extdeplibs = [map ST.unpack (if null (Packages.unitExtDepLibsGhc pkg)
then Packages.unitExtDepLibsSys pkg
- else Packages.unitExtDepLibsGhc pkg)
- linkerlibs = [ lib | '-':'l':lib <- (map ST.unpack $ Packages.unitLinkerOptions pkg) ]
- extra_libs = extdeplibs ++ linkerlibs
+ else Packages.unitExtDepLibsGhc pkg) | pkg <- pkgs]
+ linkerlibs = [[ lib | '-':'l':lib <- (map ST.unpack $ Packages.unitLinkerOptions pkg) ] | pkg <- pkgs]
+ extra_libs = zipWith (++) extdeplibs linkerlibs
-- See Note [Fork/Exec Windows]
gcc_paths <- getGCCPaths logger dflags (platformOS platform)
- dirs_env <- addEnvPaths "LIBRARY_PATH" dirs
+ dirs_env <- traverse (addEnvPaths "LIBRARY_PATH") dirs
hs_classifieds
- <- mapM (locateLib interp hsc_env True dirs_env gcc_paths) hs_libs'
+ <- sequenceA [mapM (locateLib interp hsc_env True dirs_env_ gcc_paths) hs_libs'_ | (dirs_env_, hs_libs'_) <- zip dirs_env hs_libs' ]
extra_classifieds
- <- mapM (locateLib interp hsc_env False dirs_env gcc_paths) extra_libs
- let classifieds = hs_classifieds ++ extra_classifieds
+ <- sequenceA [mapM (locateLib interp hsc_env False dirs_env_ gcc_paths) extra_libs_ | (dirs_env_, extra_libs_) <- zip dirs_env extra_libs]
+ let classifieds = zipWith (++) hs_classifieds extra_classifieds
-- Complication: all the .so's must be loaded before any of the .o's.
- let known_hs_dlls = [ dll | DLLPath dll <- hs_classifieds ]
- known_extra_dlls = [ dll | DLLPath dll <- extra_classifieds ]
- known_dlls = known_hs_dlls ++ known_extra_dlls
+ let known_hs_dlls = [[ dll | DLLPath dll <- hs_classifieds_ ] | hs_classifieds_ <- hs_classifieds]
+ known_extra_dlls = [ dll | extra_classifieds_ <- extra_classifieds, DLLPath dll <- extra_classifieds_ ]
+ known_dlls = concat known_hs_dlls ++ known_extra_dlls
#if defined(CAN_LOAD_DLL)
- dlls = [ dll | DLL dll <- classifieds ]
+ dlls = [ dll | classifieds_ <- classifieds, DLL dll <- classifieds_ ]
#endif
- objs = [ obj | Objects objs <- classifieds
- , obj <- objs ]
- archs = [ arch | Archive arch <- classifieds ]
+ objs = [ obj | classifieds_ <- classifieds, Objects objs <- classifieds_
+ , obj <- objs]
+ archs = [ arch | classifieds_ <- classifieds, Archive arch <- classifieds_ ]
-- Add directories to library search paths
let dll_paths = map takeDirectory known_dlls
- all_paths = nub $ map normalise $ dll_paths ++ dirs
+ all_paths = nub $ map normalise $ dll_paths ++ concat dirs
all_paths_env <- addEnvPaths "LD_LIBRARY_PATH" all_paths
pathCache <- mapM (addLibrarySearchPath interp) all_paths_env
maybePutSDoc logger
- (text "Loading unit " <> pprUnitInfoForUser pkg <> text " ... ")
+ (text "Loading units " <> vcat (map pprUnitInfoForUser pkgs) <> text " ... ")
#if defined(CAN_LOAD_DLL)
- loadFrameworks interp platform pkg
+ forM_ pkgs $ loadFrameworks interp platform
-- See Note [Crash early load_dyn and locateLib]
-- Crash early if can't load any of `known_dlls`
- mapM_ (load_dyn interp hsc_env True) known_extra_dlls
- loaded_dlls <- mapMaybeM (load_dyn interp hsc_env True) known_hs_dlls
+ _ <- load_dyn interp hsc_env True known_extra_dlls
+
+ -- We pass [[FilePath]] of dlls to load and flattens the list
+ -- before doing a LoadDLLs. The returned list of RemotePtrs
+ -- would need to be regrouped to the same shape of the input
+ -- [[FilePath]], each group's [RemotePtr LoadedDLL]
+ -- corresponds to the DLL handles of a Haskell unit.
+ let regroup :: [[a]] -> [b] -> [[b]]
+ regroup [] _ = []
+ regroup (l:ls) xs = xs0: regroup ls xs1 where (xs0, xs1) = splitAt (length l) xs
+ loaded_dlls <- regroup known_hs_dlls <$> load_dyn interp hsc_env True (concat known_hs_dlls)
-- For remaining `dlls` crash early only when there is surely
-- no package's DLL around ... (not is_dyn)
- mapM_ (load_dyn interp hsc_env (not is_dyn) . platformSOName platform) dlls
+ _ <- load_dyn interp hsc_env (not is_dyn) $ map (platformSOName platform) dlls
#else
- let loaded_dlls = []
+ let loaded_dlls = replicate (length pkgs) []
#endif
-- After loading all the DLLs, we can load the static objects.
-- Ordering isn't important here, because we do one final link
@@ -1248,9 +1298,9 @@ loadPackage interp hsc_env pkg
if succeeded ok
then do
maybePutStrLn logger "done."
- return (hs_classifieds, extra_classifieds, loaded_dlls)
- else let errmsg = text "unable to load unit `"
- <> pprUnitInfoForUser pkg <> text "'"
+ pure $ zip3 hs_classifieds extra_classifieds loaded_dlls
+ else let errmsg = text "unable to load units `"
+ <> vcat (map pprUnitInfoForUser pkgs) <> text "'"
in throwGhcExceptionIO (InstallationError (showSDoc dflags errmsg))
{-
@@ -1300,12 +1350,12 @@ restriction very easily.
-- we have already searched the filesystem; the strings passed to load_dyn
-- can be passed directly to loadDLL. They are either fully-qualified
-- ("/usr/lib/libfoo.so"), or unqualified ("libfoo.so"). In the latter case,
--- loadDLL is going to search the system paths to find the library.
-load_dyn :: Interp -> HscEnv -> Bool -> FilePath -> IO (Maybe (RemotePtr LoadedDLL))
-load_dyn interp hsc_env crash_early dll = do
- r <- loadDLL interp dll
+-- loadDLLs is going to search the system paths to find the library.
+load_dyn :: Interp -> HscEnv -> Bool -> [FilePath] -> IO [RemotePtr LoadedDLL]
+load_dyn interp hsc_env crash_early dlls = do
+ r <- loadDLLs interp dlls
case r of
- Right loaded_dll -> pure (Just loaded_dll)
+ Right loaded_dlls -> pure loaded_dlls
Left err ->
if crash_early
then cmdLineErrorIO err
@@ -1314,7 +1364,7 @@ load_dyn interp hsc_env crash_early dll = do
$ reportDiagnostic logger
neverQualify diag_opts
noSrcSpan (WarningWithFlag Opt_WarnMissedExtraSharedLib) $ withPprStyle defaultUserStyle (note err)
- pure Nothing
+ pure []
where
diag_opts = initDiagOpts (hsc_dflags hsc_env)
logger = hsc_logger hsc_env
@@ -1370,7 +1420,7 @@ locateLib interp hsc_env is_hs lib_dirs gcc_dirs lib0
-- then look in library-dirs and inplace GCC for a static library (libfoo.a)
-- then try "gcc --print-file-name" to search gcc's search path
-- for a dynamic library (#5289)
- -- otherwise, assume loadDLL can find it
+ -- otherwise, assume loadDLLs can find it
--
-- The logic is a bit complicated, but the rationale behind it is that
-- loading a shared library for us is O(1) while loading an archive is
=====================================
compiler/GHC/Linker/MacOS.hs
=====================================
@@ -162,7 +162,7 @@ loadFramework interp extraPaths rootname
-- sorry for the hardcoded paths, I hope they won't change anytime soon:
defaultFrameworkPaths = ["/Library/Frameworks", "/System/Library/Frameworks"]
- -- Try to call loadDLL for each candidate path.
+ -- Try to call loadDLLs for each candidate path.
--
-- See Note [macOS Big Sur dynamic libraries]
findLoadDLL [] errs =
@@ -170,7 +170,7 @@ loadFramework interp extraPaths rootname
-- has no built-in paths for frameworks: give up
return $ Just errs
findLoadDLL (p:ps) errs =
- do { dll <- loadDLL interp (p fwk_file)
+ do { dll <- loadDLLs interp [p fwk_file]
; case dll of
Right _ -> return Nothing
Left err -> findLoadDLL ps ((p ++ ": " ++ err):errs)
=====================================
compiler/GHC/Linker/Types.hs
=====================================
@@ -494,7 +494,7 @@ data LibrarySpec
| DLL String -- "Unadorned" name of a .DLL/.so
-- e.g. On unix "qt" denotes "libqt.so"
-- On Windows "burble" denotes "burble.DLL" or "libburble.dll"
- -- loadDLL is platform-specific and adds the lib/.so/.DLL
+ -- loadDLLs is platform-specific and adds the lib/.so/.DLL
-- suffixes platform-dependently
| DLLPath FilePath -- Absolute or relative pathname to a dynamic library
=====================================
compiler/GHC/Runtime/Interpreter.hs
=====================================
@@ -38,7 +38,7 @@ module GHC.Runtime.Interpreter
, lookupSymbol
, lookupSymbolInDLL
, lookupClosure
- , loadDLL
+ , loadDLLs
, loadArchive
, loadObj
, unloadObj
@@ -559,13 +559,13 @@ withSymbolCache interp str determine_addr = do
purgeLookupSymbolCache :: Interp -> IO ()
purgeLookupSymbolCache interp = purgeInterpSymbolCache (interpSymbolCache interp)
--- | loadDLL loads a dynamic library using the OS's native linker
+-- | 'loadDLLs' loads dynamic libraries using the OS's native linker
-- (i.e. dlopen() on Unix, LoadLibrary() on Windows). It takes either
--- an absolute pathname to the file, or a relative filename
--- (e.g. "libfoo.so" or "foo.dll"). In the latter case, loadDLL
--- searches the standard locations for the appropriate library.
-loadDLL :: Interp -> String -> IO (Either String (RemotePtr LoadedDLL))
-loadDLL interp str = interpCmd interp (LoadDLL str)
+-- absolute pathnames to the files, or relative filenames
+-- (e.g. "libfoo.so" or "foo.dll"). In the latter case, 'loadDLLs'
+-- searches the standard locations for the appropriate libraries.
+loadDLLs :: Interp -> [String] -> IO (Either String [RemotePtr LoadedDLL])
+loadDLLs interp strs = interpCmd interp (LoadDLLs strs)
loadArchive :: Interp -> String -> IO ()
loadArchive interp path = do
@@ -761,4 +761,3 @@ readIModModBreaks hug mod = imodBreaks_modBreaks . expectJust <$> readIModBreaks
fromEvalResult :: EvalResult a -> IO a
fromEvalResult (EvalException e) = throwIO (fromSerializableException e)
fromEvalResult (EvalSuccess a) = return a
-
=====================================
libraries/base/changelog.md
=====================================
@@ -6,7 +6,6 @@
* Fix issues with toRational for types capable to represent infinite and not-a-number values ([CLC proposal #338](https://github.com/haskell/core-libraries-committee/issues/338))
* Ensure that `rationalToFloat` and `rationalToDouble` always inline in the end. ([CLC proposal #356](https://github.com/haskell/core-libraries-committee/issues/356))
* Modify the implementation of `Data.List.sortOn` to use `(>)` instead of `compare`. ([CLC proposal #332](https://github.com/haskell/core-libraries-committee/issues/332))
- * `GHC.Exts.IOPort#` and its related operations have been removed ([CLC #213](https://github.com/haskell/core-libraries-committee/issues/213))
* Add `thenA` and `thenM`. ([CLC proposal #351](https://github.com/haskell/core-libraries-committee/issues/351))
* Fix bug where `naturalAndNot` was incorrectly truncating results ([CLC proposal #350](github.com/haskell/core-libraries-committee/issues/350))
* Remove extra laziness from `Data.Bifunctor.Bifunctor` instances for all tuples to have the same laziness as their `Data.Functor.Functor` counterparts (i.e. they became more strict than before) ([CLC proposal #339](https://github.com/haskell/core-libraries-committee/issues/339))
@@ -37,7 +36,7 @@
* `GHC.TypeNats.Internal`
* `GHC.ExecutionStack.Internal`.
* Deprecate `GHC.JS.Prim.Internal.Build`, as per [CLC #329](https://github.com/haskell/core-libraries-committee/issues/329)
-
+ * `GHC.Exts.IOPort#` and its related operations have been removed ([CLC #213](https://github.com/haskell/core-libraries-committee/issues/213))
* Fix incorrect results of `integerPowMod` when the base is 0 and the exponent is negative, and `integerRecipMod` when the modulus is zero ([#26017](https://gitlab.haskell.org/ghc/ghc/-/issues/26017)).
* Fix the rewrite rule for `scanl'` not being strict in the first element of the output list ([#26143](https://gitlab.haskell.org/ghc/ghc/-/issues/26143)).
=====================================
libraries/ghci/GHCi/Message.hs
=====================================
@@ -89,7 +89,7 @@ data Message a where
LookupSymbol :: String -> Message (Maybe (RemotePtr ()))
LookupSymbolInDLL :: RemotePtr LoadedDLL -> String -> Message (Maybe (RemotePtr ()))
LookupClosure :: String -> Message (Maybe HValueRef)
- LoadDLL :: String -> Message (Either String (RemotePtr LoadedDLL))
+ LoadDLLs :: [String] -> Message (Either String [RemotePtr LoadedDLL])
LoadArchive :: String -> Message () -- error?
LoadObj :: String -> Message () -- error?
UnloadObj :: String -> Message () -- error?
@@ -448,7 +448,7 @@ data BreakModule
-- that type isn't available here.
data BreakUnitId
--- | A dummy type that tags pointers returned by 'LoadDLL'.
+-- | A dummy type that tags pointers returned by 'LoadDLLs'.
data LoadedDLL
-- SomeException can't be serialized because it contains dynamic
@@ -564,7 +564,7 @@ getMessage = do
1 -> Msg <$> return InitLinker
2 -> Msg <$> LookupSymbol <$> get
3 -> Msg <$> LookupClosure <$> get
- 4 -> Msg <$> LoadDLL <$> get
+ 4 -> Msg <$> LoadDLLs <$> get
5 -> Msg <$> LoadArchive <$> get
6 -> Msg <$> LoadObj <$> get
7 -> Msg <$> UnloadObj <$> get
@@ -610,7 +610,7 @@ putMessage m = case m of
InitLinker -> putWord8 1
LookupSymbol str -> putWord8 2 >> put str
LookupClosure str -> putWord8 3 >> put str
- LoadDLL str -> putWord8 4 >> put str
+ LoadDLLs strs -> putWord8 4 >> put strs
LoadArchive str -> putWord8 5 >> put str
LoadObj str -> putWord8 6 >> put str
UnloadObj str -> putWord8 7 >> put str
=====================================
libraries/ghci/GHCi/ObjLink.hs
=====================================
@@ -12,7 +12,7 @@
-- dynamic linker.
module GHCi.ObjLink
( initObjLinker, ShouldRetainCAFs(..)
- , loadDLL
+ , loadDLLs
, loadArchive
, loadObj
, unloadObj
@@ -31,6 +31,7 @@ import GHCi.RemoteTypes
import GHCi.Message (LoadedDLL)
import Control.Exception (throwIO, ErrorCall(..))
import Control.Monad ( when )
+import Data.Foldable
import Foreign.C
import Foreign.Marshal.Alloc ( alloca, free )
import Foreign ( nullPtr, peek )
@@ -43,6 +44,10 @@ import Control.Exception (catch, evaluate)
import GHC.Wasm.Prim
#endif
+#if defined(wasm32_HOST_ARCH)
+import Data.List (intercalate)
+#endif
+
-- ---------------------------------------------------------------------------
-- RTS Linker Interface
-- ---------------------------------------------------------------------------
@@ -67,20 +72,25 @@ data ShouldRetainCAFs
initObjLinker :: ShouldRetainCAFs -> IO ()
initObjLinker _ = pure ()
-loadDLL :: String -> IO (Either String (Ptr LoadedDLL))
-loadDLL f =
+-- Batch load multiple DLLs at once via dyld to enable a single
+-- dependency resolution and more parallel compilation. We pass a
+-- NUL-delimited JSString to avoid array marshalling on wasm.
+loadDLLs :: [String] -> IO (Either String [Ptr LoadedDLL])
+loadDLLs fs =
m `catch` \(err :: JSException) ->
- pure $ Left $ "loadDLL failed for " <> f <> ": " <> show err
+ pure $ Left $ "loadDLLs failed: " <> show err
where
+ packed :: JSString
+ packed = toJSString (intercalate ['\0'] fs)
m = do
- evaluate =<< js_loadDLL (toJSString f)
- pure $ Right nullPtr
+ evaluate =<< js_loadDLLs packed
+ pure $ Right (replicate (length fs) nullPtr)
-- See Note [Variable passing in JSFFI] for where
-- __ghc_wasm_jsffi_dyld comes from
-foreign import javascript safe "__ghc_wasm_jsffi_dyld.loadDLL($1)"
- js_loadDLL :: JSString -> IO ()
+foreign import javascript safe "__ghc_wasm_jsffi_dyld.loadDLLs($1)"
+ js_loadDLLs :: JSString -> IO ()
loadArchive :: String -> IO ()
loadArchive f = throwIO $ ErrorCall $ "loadArchive: unsupported on wasm for " <> f
@@ -241,6 +251,16 @@ resolveObjs = do
r <- c_resolveObjs
return (r /= 0)
+loadDLLs :: [String] -> IO (Either String [Ptr LoadedDLL])
+loadDLLs = foldrM load_one $ Right []
+ where
+ load_one _ err@(Left _) = pure err
+ load_one p (Right dlls) = do
+ r <- loadDLL p
+ pure $ case r of
+ Left err -> Left err
+ Right dll -> Right $ dll : dlls
+
-- ---------------------------------------------------------------------------
-- Foreign declarations to RTS entry points which does the real work;
-- ---------------------------------------------------------------------------
=====================================
libraries/ghci/GHCi/Run.hs
=====================================
@@ -57,7 +57,7 @@ run m = case m of
#if defined(javascript_HOST_ARCH)
LoadObj p -> withCString p loadJS
InitLinker -> notSupportedJS m
- LoadDLL {} -> notSupportedJS m
+ LoadDLLs {} -> notSupportedJS m
LoadArchive {} -> notSupportedJS m
UnloadObj {} -> notSupportedJS m
AddLibrarySearchPath {} -> notSupportedJS m
@@ -69,7 +69,7 @@ run m = case m of
LookupClosure str -> lookupJSClosure str
#else
InitLinker -> initObjLinker RetainCAFs
- LoadDLL str -> fmap toRemotePtr <$> loadDLL str
+ LoadDLLs strs -> fmap (map toRemotePtr) <$> loadDLLs strs
LoadArchive str -> loadArchive str
LoadObj str -> loadObj str
UnloadObj str -> unloadObj str
=====================================
rts/ExecPage.c
=====================================
@@ -10,15 +10,23 @@
#include "linker/MMap.h"
ExecPage *allocateExecPage(void) {
+#if defined(wasm32_HOST_ARCH)
+ return NULL;
+#else
ExecPage *page = (ExecPage *) mmapAnon(getPageSize());
return page;
+#endif
}
void freezeExecPage(ExecPage *page) {
+#if !defined(wasm32_HOST_ARCH)
mprotectForLinker(page, getPageSize(), MEM_READ_EXECUTE);
flushExec(getPageSize(), page);
+#endif
}
void freeExecPage(ExecPage *page) {
+#if !defined(wasm32_HOST_ARCH)
munmapForLinker(page, getPageSize(), "freeExecPage");
+#endif
}
=====================================
rts/Interpreter.c
=====================================
@@ -2599,11 +2599,11 @@ run_BCO:
#define SIZED_BIN_OP_TY_INT(op,ty) \
{ \
if(sizeof(ty) > sizeof(StgWord)) { \
- ty r = ((ty) ReadSpW64(0)) op ((ty) ReadSpW(2)); \
+ ty r = ((ty) ReadSpW64(0)) op ((StgInt) ReadSpW(2)); \
Sp_addW(1); \
SpW64(0) = (StgWord64) r; \
} else { \
- ty r = ((ty) ReadSpW(0)) op ((ty) ReadSpW(1)); \
+ ty r = ((ty) ReadSpW(0)) op ((StgInt) ReadSpW(1)); \
Sp_addW(1); \
SpW(0) = (StgWord) r; \
}; \
=====================================
rts/wasm/JSFFI.c
=====================================
@@ -5,6 +5,8 @@
#include "Threads.h"
#include "sm/Sanity.h"
+#include
+
#if defined(__wasm_reference_types__)
extern HsBool rts_JSFFI_flag;
@@ -12,21 +14,8 @@ extern HsStablePtr rts_threadDelay_impl;
extern StgClosure ghczminternal_GHCziInternalziWasmziPrimziImports_raiseJSException_closure;
extern StgClosure ghczminternal_GHCziInternalziWasmziPrimziConcziInternal_threadDelay_closure;
-int __main_void(void);
-
-int __main_argc_argv(int, char*[]);
-
-int __main_argc_argv(int argc, char *argv[]) {
- RtsConfig __conf = defaultRtsConfig;
- __conf.rts_opts_enabled = RtsOptsAll;
- __conf.rts_hs_main = false;
- hs_init_ghc(&argc, &argv, __conf);
- // See Note [threadDelay on wasm] for details.
- rts_JSFFI_flag = HS_BOOL_TRUE;
- getStablePtr((StgPtr)&ghczminternal_GHCziInternalziWasmziPrimziImports_raiseJSException_closure);
- rts_threadDelay_impl = getStablePtr((StgPtr)&ghczminternal_GHCziInternalziWasmziPrimziConcziInternal_threadDelay_closure);
- return 0;
-}
+__attribute__((__weak__))
+int __main_argc_argv(int argc, char *argv[]);
// Note [JSFFI initialization]
// ~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -66,11 +55,69 @@ int __main_argc_argv(int argc, char *argv[]) {
// by the GHC codegen, and priority 102 to the initialization logic
// here to ensure hs_init_ghc() sees everything it needs to see.
__attribute__((constructor(102))) static void __ghc_wasm_jsffi_init(void) {
- // See
- // https://gitlab.haskell.org/ghc/wasi-libc/-/blob/master/libc-bottom-half/sour...
- // for its definition. It initializes some libc state, then calls
- // __main_argc_argv defined above.
- __main_void();
+ // If linking static code without -no-hs-main, then the driver
+ // emitted main() is in charge of its own RTS initialization, so
+ // skip.
+#if !defined(__PIC__)
+ if (__main_argc_argv) {
+ return;
+ }
+#endif
+
+ // Code below is mirrored from
+ // https://gitlab.haskell.org/haskell-wasm/wasi-libc/-/blob/master/libc-bottom-...,
+ // fetches argc/argv using wasi api
+ __wasi_errno_t err;
+
+ // Get the sizes of the arrays we'll have to create to copy in the args.
+ size_t argv_buf_size;
+ size_t argc;
+ err = __wasi_args_sizes_get(&argc, &argv_buf_size);
+ if (err != __WASI_ERRNO_SUCCESS) {
+ _Exit(EX_OSERR);
+ }
+
+ // Add 1 for the NULL pointer to mark the end, and check for overflow.
+ size_t num_ptrs = argc + 1;
+ if (num_ptrs == 0) {
+ _Exit(EX_SOFTWARE);
+ }
+
+ // Allocate memory for storing the argument chars.
+ char *argv_buf = malloc(argv_buf_size);
+ if (argv_buf == NULL) {
+ _Exit(EX_SOFTWARE);
+ }
+
+ // Allocate memory for the array of pointers. This uses `calloc` both to
+ // handle overflow and to initialize the NULL pointer at the end.
+ char **argv = calloc(num_ptrs, sizeof(char *));
+ if (argv == NULL) {
+ free(argv_buf);
+ _Exit(EX_SOFTWARE);
+ }
+
+ // Fill the argument chars, and the argv array with pointers into those chars.
+ // TODO: Remove the casts on `argv_ptrs` and `argv_buf` once the witx is
+ // updated with char8 support.
+ err = __wasi_args_get((uint8_t **)argv, (uint8_t *)argv_buf);
+ if (err != __WASI_ERRNO_SUCCESS) {
+ free(argv_buf);
+ free(argv);
+ _Exit(EX_OSERR);
+ }
+
+ // Now that we have argc/argv, proceed to initialize the GHC RTS
+ RtsConfig __conf = defaultRtsConfig;
+ __conf.rts_opts_enabled = RtsOptsAll;
+ __conf.rts_hs_main = false;
+ hs_init_ghc((int *)&argc, &argv, __conf);
+ // See Note [threadDelay on wasm] for details.
+ rts_JSFFI_flag = HS_BOOL_TRUE;
+ getStablePtr((
+ StgPtr)&ghczminternal_GHCziInternalziWasmziPrimziImports_raiseJSException_closure);
+ rts_threadDelay_impl = getStablePtr((
+ StgPtr)&ghczminternal_GHCziInternalziWasmziPrimziConcziInternal_threadDelay_closure);
}
typedef __externref_t HsJSVal;
=====================================
testsuite/tests/rts/linker/T2615.hs
=====================================
@@ -4,7 +4,7 @@ library_name = "libfoo_script_T2615.so" -- this is really a linker script
main = do
initObjLinker RetainCAFs
- result <- loadDLL library_name
+ result <- loadDLLs [library_name]
case result of
Right _ -> putStrLn (library_name ++ " loaded successfully")
Left x -> putStrLn ("error: " ++ x)
=====================================
utils/jsffi/dyld.mjs
=====================================
@@ -9,7 +9,7 @@
// iserv (GHCi.Server.defaultServer). This part only runs in
// nodejs.
// 2. Dynamic linker: provide RTS linker interfaces like
-// loadDLL/lookupSymbol etc which are imported by wasm iserv. This
+// loadDLLs/lookupSymbol etc which are imported by wasm iserv. This
// part can run in browsers as well.
//
// When GHC starts external interpreter for the wasm target, it starts
@@ -50,7 +50,7 @@
//
// *** What works right now and what doesn't work yet?
//
-// loadDLL & bytecode interpreter work. Template Haskell & ghci work.
+// loadDLLs & bytecode interpreter work. Template Haskell & ghci work.
// Profiled dynamic code works. Compiled code and bytecode can all be
// loaded, though the side effects are constrained to what's supported
// by wasi preview1: we map the full host filesystem into wasm cause
@@ -777,17 +777,17 @@ class DyLD {
return this.#rpc.findSystemLibrary(f);
}
- // When we do loadDLL, we first perform "downsweep" which return a
+ // When we do loadDLLs, we first perform "downsweep" which return a
// toposorted array of dependencies up to itself, then sequentially
// load the downsweep result.
//
// The rationale of a separate downsweep phase, instead of a simple
- // recursive loadDLL function is: V8 delegates async
+ // recursive loadDLLs function is: V8 delegates async
// WebAssembly.compile to a background worker thread pool. To
// maintain consistent internal linker state, we *must* load each so
// file sequentially, but it's okay to kick off compilation asap,
// store the Promise in downsweep result and await for the actual
- // WebAssembly.Module in loadDLL logic. This way we can harness some
+ // WebAssembly.Module in loadDLLs logic. This way we can harness some
// background parallelism.
async #downsweep(p) {
const toks = p.split("/");
@@ -828,8 +828,26 @@ class DyLD {
return acc;
}
- // The real stuff
- async loadDLL(p) {
+ // Batch load multiple DLLs in one go.
+ // Accepts a NUL-delimited string of paths to avoid array marshalling.
+ // Each path can be absolute or a soname; dependency resolution is
+ // performed across the full set to enable maximal parallel compile
+ // while maintaining sequential instantiation order.
+ async loadDLLs(packed) {
+ // Normalize input to an array of strings. When called from Haskell
+ // we pass a single JSString containing NUL-separated paths.
+ const paths = (typeof packed === "string"
+ ? (packed.length === 0 ? [] : packed.split("\0"))
+ : [packed] // tolerate an accidental single path object
+ ).filter((s) => s.length > 0).reverse();
+
+ // Compute a single downsweep plan for the whole batch.
+ // Note: #downsweep mutates #loadedSos to break cycles and dedup.
+ const plan = [];
+ for (const p of paths) {
+ plan.push(...(await this.#downsweep(p)));
+ }
+
for (const {
memSize,
memP2Align,
@@ -837,7 +855,7 @@ class DyLD {
tableP2Align,
modp,
soname,
- } of await this.#downsweep(p)) {
+ } of plan) {
const import_obj = {
wasi_snapshot_preview1: this.#wasi.wasiImport,
env: {
@@ -1131,7 +1149,7 @@ export async function main({ rpc, libdir, ghciSoPath, args }) {
rpc,
});
await dyld.addLibrarySearchPath(libdir);
- await dyld.loadDLL(ghciSoPath);
+ await dyld.loadDLLs(ghciSoPath);
const reader = rpc.readStream.getReader();
const writer = rpc.writeStream.getWriter();
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/61264f284c101f2bfe5b71edcdb038b...
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/61264f284c101f2bfe5b71edcdb038b...
You're receiving this email because of your account on gitlab.haskell.org.
