Duncan Coutts pushed to branch wip/dcoutts/windows-dlls-experimental at Glasgow Haskell Compiler / GHC Commits: f7379956 by Duncan Coutts at 2026-04-28T22:08:53+01:00 Fixup: merge mistake from foreign-label-source-refactoring on top of cmm-imports - - - - - 12f32953 by Duncan Coutts at 2026-04-28T22:08:53+01:00 Use response files for hadrian linking with ghc (support long command lines) In future support for windows dynamic linking, we expect long command lines for linking dll files with ghc. Experiments with dynamic linking the ghc-internal library yielded a link command well over 32kb. We did not encounter this before for static libs, since we already use ar's @file feature (if available, which it is for the llvm toolchain). Co-authored-by: David Eichmann - - - - - f8aa77ce by Duncan Coutts at 2026-04-28T22:08:53+01:00 Use __attribute__((dllimport)) for external RTS symbol declarations This is needed to be hygenic about DLL symbol imports and exports. The attribute is ignored on platforms other than Windows. Use of the attribute however means that external data symbols do not have a compile-time constant address (they are loaded using an indirection). This means we have to adjust the rtsSyms initial linker table so that it is a local constant in a function, rather than a global constant. We now define it within a function that pre-populates the symbol table with the RTS symbols. - - - - - 38a785e6 by Duncan Coutts at 2026-04-28T22:08:53+01:00 Fix the rts linker declarations for a few data symbols and ensure that the (windows only) rts_IOManagerIsWin32Native data symbol is marked as externally visible. - - - - - 146a2773 by David Eichmann at 2026-04-28T22:08:53+01:00 Hadrian: Disable runtime pseudo relocations for RTS on windows hosts - - - - - 8515501c by Duncan Coutts at 2026-04-28T22:08:54+01:00 Hadrian: remove legacy rts .so symlinks For compatibility with the old makefile based build system, hadrian had rules to generate symlinks from unversioned to versioned names for the rts .so/.dynlib file, like libHSrts-ghcx.y.so -> libHSrts-1.0.3-ghcx.y.so We no longer need these symlinks since the makefile build system has been retired some time ago. The need for these symlinks is awkward on windows where we cannot (in practice) create symlinks. So rather than make them conditional (non-windows), just remove them entirely. - - - - - f619d4b9 by Duncan Coutts at 2026-04-28T22:08:54+01:00 Enable -dynamic-too on Windows, and static top level constructors To make -dynamic-too work on Windows we have to enable top level static constructors as well. Otherwise the static and dynamic output differs in ways that are incompatible with -dynamic-too. Enabling top level constructors also significantly reduces the number of exported symbols, which is useful since on Windows where there is a 64k limit. Historically top level constructors did not work for Windows Dlls, but with the modern toolchain (llvm lld or gcc ld and Mingw) we can use "pseudo relocations" to patch up the initialised data when the .dll is loaded. This is much like ELF relocations, but is performed by the Mingw C library, using data tables generated by ld/lld. - - - - - b10aafe7 by Duncan Coutts at 2026-04-28T22:08:54+01:00 Enable dynamic lib support on Windows The build system will now try to build dynamic libs. - - - - - d8139e1d by Duncan Coutts at 2026-04-28T22:08:54+01:00 Hadrian: only build executable modules in the one way they will be used Previously, for an executable, the modules that are part of the exeutable itself (so not in lib dependencies) can be built in multiple ways. This makes use of the info about the ways that would be used for library modules. In particular, if the library ways include vanilla and dynamic, then the executable modules will be built with -dynamic-too. This is obviously a waste of time. This commit changes the defaultLibraryWays so that for exeutable packages it only picks the single program way. This involves factoring out a programWay helper from the existing programContext function. - - - - - 23a3a960 by Duncan Coutts at 2026-04-28T22:08:54+01:00 Update defaultDynamicGhcPrograms to use windows target not host The inability to build ghc dynamically is about the windows as the target machine, not as the host machine. Add a comment to explain why we limit it on windows for now. - - - - - 9b0ddfde by Duncan Coutts at 2026-04-28T22:08:54+01:00 Only build the ghc lib the dynamic way if supported It is not supported on Windows, yet. The problem is that we hit the 64k limit on the number of exported symbols for a single dll. We delegate to the defaultDynamicGhcPrograms predicate to decide if it is supported. - - - - - 16 changed files: - compiler/GHC/Cmm/Parser.y - compiler/GHC/Driver/Session.hs - compiler/GHC/Stg/Utils.hs - hadrian/src/Builder.hs - hadrian/src/Hadrian/Builder.hs - hadrian/src/Oracles/Flag.hs - hadrian/src/Rules/Register.hs - hadrian/src/Rules/Rts.hs - hadrian/src/Settings/Builders/Ghc.hs - hadrian/src/Settings/Default.hs - hadrian/src/Settings/Packages.hs - hadrian/src/Settings/Program.hs - rts/IOManager.h - rts/Linker.c - rts/RtsSymbols.c - rts/RtsSymbols.h Changes: ===================================== compiler/GHC/Cmm/Parser.y ===================================== @@ -668,25 +668,29 @@ importName -- an unnamed Haskell package. This corresponds on Windows/PE to -- __declspec(dllimport) in C. | 'extern' NAME - { ($2, mkForeignLabel $2 ForeignLabelInExternalPackage IsFunction) } + { ($2, mkForeignLabel $2 ForeignLabelInExternalPackage + ForeignLabelIsFunction) } -- A data label imported from another unamed shared library. -- This corresponds on Windows/PE to __declspec(dllimport) in C (but -- cmm doesn't know about data vs function symbols so we have to say). | 'extern' 'DATA' NAME - { ($3, mkForeignLabel $3 ForeignLabelInExternalPackage IsData) } + { ($3, mkForeignLabel $3 ForeignLabelInExternalPackage + ForeignLabelIsData) } -- A code label imported from the shared library for a Haskell package -- with the given UnitId. Such labels behave as local when used within -- the specified unit, or as extern otherwise. | STRING NAME - { ($2, mkForeignLabel $2 (ForeignLabelInPackage (UnitId (mkFastString $1))) IsFunction) } + { ($2, mkForeignLabel $2 (ForeignLabelInPackage (UnitId (mkFastString $1))) + ForeignLabelIsFunction) } -- A data label imported from the shared library for a Haskell package -- with the given UnitId. Such labels behave as local when used within -- the specified unit, or as extern otherwise. | STRING 'DATA' NAME - { ($3, mkForeignLabel $3 (ForeignLabelInPackage (UnitId (mkFastString $1))) IsData) } + { ($3, mkForeignLabel $3 (ForeignLabelInPackage (UnitId (mkFastString $1))) + ForeignLabelIsData) } names :: { [FastString] } ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -3624,7 +3624,7 @@ compilerInfo dflags ("target has RTS linker", showBool $ platformHasRTSLinker platform), ("Target default backend", show $ platformDefaultBackend platform), -- Whether or not we support @-dynamic-too@ - ("Support dynamic-too", showBool $ not isWindows), + ("Support dynamic-too", "YES"), -- Whether or not we support the @-j@ flag with @--make@. ("Support parallel --make", "YES"), -- Whether or not we support "Foo from foo-0.1-XXX:Foo" syntax in @@ -3659,7 +3659,6 @@ compilerInfo dflags showBool True = "YES" showBool False = "NO" platform = targetPlatform dflags - isWindows = platformOS platform == OSMinGW32 expandDirectories = expandToolDir (toolDir dflags) . expandTopDir (topDir dflags) query :: (Target -> a) -> a query f = f (rawTarget dflags) @@ -3757,11 +3756,6 @@ makeDynFlagsConsistent :: DynFlags -> (DynFlags, [Warn], [Located SDoc]) -- ensure that a later change doesn't invalidate an earlier check. -- Be careful not to introduce potential loops! makeDynFlagsConsistent dflags - -- Disable -dynamic-too on Windows (#8228, #7134, #5987) - | os == OSMinGW32 && gopt Opt_BuildDynamicToo dflags - = let dflags' = gopt_unset dflags Opt_BuildDynamicToo - warn = "-dynamic-too is not supported on Windows" - in loop dflags' warn -- Disable -dynamic-too if we are are compiling with -dynamic already, otherwise -- you get two dynamic object files (.o and .dyn_o). (#20436) | ways dflags `hasWay` WayDyn && gopt Opt_BuildDynamicToo dflags ===================================== compiler/GHC/Stg/Utils.hs ===================================== @@ -128,6 +128,9 @@ stripStgTicksTopE p = go go other = other -- | Do we allow the given top-level (static) ConApp? +-- +-- Currently this is unconditionally True, but historically it has been more +-- complicated, so the mechanism to choose otherwise is still here for now. allowTopLevelConApp :: Platform -> Bool -- is Opt_ExternalDynamicRefs enabled? @@ -138,22 +141,18 @@ allowTopLevelConApp allowTopLevelConApp platform ext_dyn_refs this_mod con args -- we're not using dynamic linking | not ext_dyn_refs = True - -- if the target OS is Windows, we only allow top-level ConApps if they don't - -- reference external names (Windows DLLs have a problem with static cross-DLL - -- refs) - | platformOS platform == OSMinGW32 = not is_external_con_app + + -- On Windows, for now, always use top level constructor applications, and + -- rely on Mingw "pseudo relocations" to make this work. We might want to + -- have a flag to control this behaviour, because using pseudo-relocations + -- can be incompatible with some security restrictions, but note that + -- ghc-internal and everything would need to be rebuilt. Note also that + -- dynamic top level con apps increases symbol exports a lot. + | platformOS platform == OSMinGW32 = True + -- otherwise, allowed -- Sylvain: shouldn't this be False when (ext_dyn_refs && is_external_con_app)? | otherwise = True - where - is_external_con_app = isDynLinkName platform this_mod (dataConName con) || any is_dll_arg args - - -- NB: typePrimRep1 is legit because any free variables won't have - -- unlifted type (there are no unlifted things at top level) - is_dll_arg :: StgArg -> Bool - is_dll_arg (StgVarArg v) = isAddrRep (typePrimRep1 (idType v)) - && isDynLinkName platform this_mod (idName v) - is_dll_arg _ = False -- True of machine addresses; these are the things that don't work across DLLs. -- The key point here is that VoidRep comes out False, so that a top level ===================================== hadrian/src/Builder.hs ===================================== @@ -346,11 +346,7 @@ instance H.Builder Builder where Haddock BuildPackage -> runHaddock path buildArgs buildInputs - Ghc FindHsDependencies _ -> do - -- Use a response file for ghc -M invocations, to - -- avoid issues with command line size limit on - -- Windows (#26637) - runGhcWithResponse path buildArgs buildInputs + Ghc _ _ -> runGhcWithResponse path buildArgs buildInputs buildOptions HsCpp -> captureStdout @@ -394,16 +390,18 @@ runHaddock haddockPath flagArgs fileInputs = withTempFile $ \tmp -> do writeFile' tmp $ escapeArgs fileInputs cmd [haddockPath] flagArgs ('@' : tmp) -runGhcWithResponse :: FilePath -> [String] -> [FilePath] -> Action () -runGhcWithResponse ghcPath flagArgs fileInputs = withTempFile $ \tmp -> do - - writeFile' tmp $ escapeArgs fileInputs - - -- We can't put the flags in a response file, because some flags - -- require empty arguments (such as the -dep-suffix flag), but - -- that isn't supported yet due to #26560. - cmd [ghcPath] flagArgs ('@' : tmp) - +-- | Use a response file for ghc invocations to avoid issues with command line +-- size limit on Windows (#26637). +runGhcWithResponse :: FilePath -- ^ Path to ghc + -> [String] -- ^ Arguments passed on the command line + -> [FilePath] -- ^ Input file paths (passed via response file) + -> [CmdOption] + -> Action () +runGhcWithResponse ghcPath buildArgs buildInputs buildOptions = withTempFile $ \tmp -> do + let tmpContents = escapeArgs buildInputs + putVerbose $ "Build Inputs (" <> tmp <> "): " <> show buildInputs + writeFile' tmp tmpContents + cmd [ghcPath] buildArgs ('@' : tmp) buildOptions -- TODO: Some builders are required only on certain platforms. For example, -- 'Objdump' is only required on OpenBSD and AIX. Add support for platform ===================================== hadrian/src/Hadrian/Builder.hs ===================================== @@ -29,7 +29,9 @@ import Hadrian.Utilities -- | This data structure captures all information relevant to invoking a builder. data BuildInfo = BuildInfo { - -- | Command line arguments. + -- | Command line arguments. Some builders (e.g. Ar, Ghc, Haddock) omit + -- buildInputs from buildArgs so that buildInputs can be passed separately + -- using a response file. buildArgs :: [String], -- | Input files. buildInputs :: [FilePath], ===================================== hadrian/src/Oracles/Flag.hs ===================================== @@ -82,11 +82,10 @@ arSupportsAtFile stage = Toolchain.arSupportsAtFile . tgtAr <$> targetStage stag platformSupportsSharedLibs :: Action Bool -- FIXME: This is querying about the target but is named "platformXXX", targetSupportsSharedLibs would be better platformSupportsSharedLibs = do - windows <- isWinTarget ppc_linux <- (&&) <$> anyTargetArch [ ArchPPC ] <*> anyTargetOs [ OSLinux ] solaris <- (&&) <$> anyTargetArch [ ArchX86 ] <*> anyTargetOs [ OSSolaris2 ] javascript <- anyTargetArch [ ArchJavaScript ] - return $ not (windows || javascript || ppc_linux || solaris) + return $ not (javascript || ppc_linux || solaris) -- | Does the target support threaded RTS? targetSupportsThreadedRts :: Action Bool ===================================== hadrian/src/Rules/Register.hs ===================================== @@ -12,7 +12,6 @@ import Hadrian.BuildPath import Hadrian.Expression import Hadrian.Haskell.Cabal import Packages -import Rules.Rts import Settings import Target import Utilities @@ -88,14 +87,9 @@ parseToBuildSubdirectory root = do -- * Registering registerPackages :: [Context] -> Action () -registerPackages ctxs = do +registerPackages ctxs = need =<< mapM pkgRegisteredLibraryFile ctxs - -- Dynamic RTS library files need symlinks (Rules.Rts.rtsRules). - forM_ ctxs $ \ ctx -> when (package ctx == rts) $ do - ways <- interpretInContext ctx (getLibraryWays <> getRtsWays) - needRtsSymLinks (stage ctx) ways - -- | Register a package and initialise the corresponding package database if -- need be. Note that we only register packages in 'Stage0' and 'Stage1'. registerPackageRules :: [(Resource, Int)] -> Stage -> Inplace -> Rules () ===================================== hadrian/src/Rules/Rts.hs ===================================== @@ -1,10 +1,5 @@ -{-# LANGUAGE MultiWayIf #-} +module Rules.Rts (rtsRules) where -module Rules.Rts (rtsRules, needRtsSymLinks) where - -import qualified Data.Set as Set - -import Packages (rts) import Hadrian.Utilities import Settings.Builders.Common @@ -12,18 +7,7 @@ import Settings.Builders.Common -- library files (see Rules.Library.libraryRules). rtsRules :: Rules () rtsRules = priority 3 $ do - -- Dynamic RTS library files need symlinks without the dummy version number. - -- This is for backwards compatibility (the old make build system omitted the - -- dummy version number). root <- buildRootRules - [ root -/- "**/libHSrts_*-ghc*.so", - root -/- "**/libHSrts_*-ghc*.dylib", - root -/- "**/libHSrts-ghc*.so", - root -/- "**/libHSrts-ghc*.dylib"] - |%> \ rtsLibFilePath' -> createFileLink - (addRtsDummyVersion $ takeFileName rtsLibFilePath') - rtsLibFilePath' - -- Solve the recursive dependency between the rts and ghc-internal -- on Windows by creating an import lib for the ghc-internal dll, -- to be linked into the rts dll. @@ -37,35 +21,3 @@ buildGhcInternalImportLib target = do output = target -- the .dll.a import lib need [input] runBuilder Dlltool ["-d", input, "-l", output] [input] [output] - --- Need symlinks generated by rtsRules. -needRtsSymLinks :: Stage -> Set.Set Way -> Action () -needRtsSymLinks stage rtsWays - = forM_ (Set.filter (wayUnit Dynamic) rtsWays) $ \ way -> do - let ctx = Context stage rts way Final - distDir <- distDynDir ctx - rtsLibFile <- takeFileName <$> pkgLibraryFile ctx - need [removeRtsDummyVersion (distDir rtsLibFile)] - -prefix, versionlessPrefix :: String -versionlessPrefix = "libHSrts" -prefix = versionlessPrefix ++ "-1.0.3" - --- removeRtsDummyVersion "a/libHSrts-1.0-ghc1.2.3.4.so" --- == "a/libHSrts-ghc1.2.3.4.so" -removeRtsDummyVersion :: FilePath -> FilePath -removeRtsDummyVersion = replaceLibFilePrefix prefix versionlessPrefix - --- addRtsDummyVersion "a/libHSrts-ghc1.2.3.4.so" --- == "a/libHSrts-1.0-ghc1.2.3.4.so" -addRtsDummyVersion :: FilePath -> FilePath -addRtsDummyVersion = replaceLibFilePrefix versionlessPrefix prefix - -replaceLibFilePrefix :: String -> String -> FilePath -> FilePath -replaceLibFilePrefix oldPrefix newPrefix oldFilePath = let - oldFileName = takeFileName oldFilePath - newFileName = maybe - (error $ "Expected RTS library file to start with " ++ oldPrefix) - (newPrefix ++) - (stripPrefix oldPrefix oldFileName) - in replaceFileName oldFilePath newFileName ===================================== hadrian/src/Settings/Builders/Ghc.hs ===================================== @@ -62,7 +62,6 @@ compileAndLinkHs = (builder (Ghc CompileHs) ||^ builder (Ghc LinkHs)) ? do [ arg "-fwrite-ide-info" , arg "-hiedir", arg hie_path ] - , getInputs , arg "-o", arg =<< getOutput ] compileC :: Args @@ -78,7 +77,6 @@ compileC = builder (Ghc CompileCWithGhc) ? do , mconcat (map (map ("-optc" ++) <$>) ccArgs) , defaultGhcWarningsArgs , arg "-c" - , getInputs , arg "-o" , arg =<< getOutput ] @@ -95,7 +93,6 @@ compileCxx = builder (Ghc CompileCppWithGhc) ? do , mconcat (map (map ("-optcxx" ++) <$>) ccArgs) , defaultGhcWarningsArgs , arg "-c" - , getInputs , arg "-o" , arg =<< getOutput ] ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -44,6 +44,7 @@ import Settings.Builders.SplitSections import Settings.Builders.RunTest import Settings.Builders.Xelatex import Settings.Packages +import Settings.Program import Settings.Warnings import qualified Hadrian.Builder.Git import Settings.Builders.Win32Tarballs @@ -215,12 +216,32 @@ testsuitePackages = return ([ timeout | windowsHost ] ++ [ checkPpr, checkExact, -- * We build 'profiling' way when stage > Stage0. -- * We build 'dynamic' way when stage > Stage0 and the platform supports it. defaultLibraryWays :: Ways -defaultLibraryWays = Set.fromList <$> - mconcat - [ pure [vanilla] - , notStage0 ? pure [profiling] - , notStage0 ? platformSupportsSharedLibs ? pure [dynamic, profilingDynamic] - ] +defaultLibraryWays = do + pkg <- getPackage + if isLibrary pkg + + -- modules for libraries get built several ways + then Set.fromList <$> + mconcat + [ pure [vanilla] + , notStage0 ? pure [profiling] + , notStage0 ? platformSupportsSharedLibs + ? onlyDynGhcLibIfSupported + ? pure [dynamic, profilingDynamic] + ] + + -- modules for executables get built only one way + else do stage <- getStage + Set.singleton <$> expr (programWay stage pkg) + +-- | Only build the ghc library the dynamic way, if the platform supports it. +-- +onlyDynGhcLibIfSupported :: Predicate +onlyDynGhcLibIfSupported = do + pkg <- getPackage + if pkg == compiler + then expr defaultDynamicGhcPrograms + else pure True -- | Default build ways for the RTS. defaultRtsWays :: Ways @@ -310,7 +331,10 @@ defaultFlavour = Flavour defaultDynamicGhcPrograms :: Action Bool defaultDynamicGhcPrograms = do supportsShared <- platformSupportsSharedLibs - return (not windowsHost && supportsShared) + winTarget <- isWinTarget + -- For now, don't build dynamic ghc on windows because we hit dll + -- symbol limits for the ghc library. + return (supportsShared && not winTarget) -- | All 'Builder'-dependent command line arguments. defaultBuilderArgs :: Args ===================================== hadrian/src/Settings/Packages.hs ===================================== @@ -321,6 +321,7 @@ rtsPackageArgs = package rts ? do , Profiling `wayUnit` way ? arg "-DPROFILING" , Threaded `wayUnit` way ? arg "-DTHREADED_RTS" , notM targetSupportsSMP ? arg "-optc-DNOSMP" + , isWinHost ? arg "-optl-Wl,--disable-runtime-pseudo-reloc" -- See Note [AutoApply.cmm for vectors] in genapply/Main.hs -- ===================================== hadrian/src/Settings/Program.hs ===================================== @@ -1,5 +1,6 @@ module Settings.Program ( programContext + , programWay , ghcWithInterpreter ) where @@ -17,18 +18,21 @@ import Settings.Builders.Common (anyTargetOs, anyTargetArch, isArmTarget) -- get a context/contexts for a given stage and package. programContext :: Stage -> Package -> Action Context programContext stage pkg = do - profiled <- askGhcProfiled stage - dynGhcProgs <- askDynGhcPrograms --dynamicGhcPrograms =<< flavour - return $ Context stage pkg (wayFor profiled dynGhcProgs) Final + way <- programWay stage pkg + return $ Context stage pkg way Final - where wayFor prof dyn - | prof && dyn = profilingDynamic - | pkg == ghc && prof && notStage0 stage = profiling - | dyn && notStage0 stage = dynamic - | otherwise = vanilla +programWay :: Stage -> Package -> Action Way +programWay stage pkg = + wayFor <$> askGhcProfiled stage <*> askDynGhcPrograms + where + wayFor prof dyn + | prof && dyn = profilingDynamic + | pkg == ghc && prof && notStage0 stage = profiling + | dyn && notStage0 stage = dynamic + | otherwise = vanilla - notStage0 (Stage0 {}) = False - notStage0 _ = True + notStage0 (Stage0 {}) = False + notStage0 _ = True -- | When cross compiling, enable for stage0 to get ghci -- support. But when not cross compiling, disable for ===================================== rts/IOManager.h ===================================== @@ -21,6 +21,15 @@ #include "sm/GC.h" // for evac_fn +#if defined(mingw32_HOST_OS) +/* Global var (only on Windows) that is exported (hence before BeginPrivate.h) + * to be shared with the I/O code in the base library to tell us which style + * of I/O manager we are using: one that uses the Windows native API HANDLEs, + * or one that uses Posix style fds. + */ +extern bool rts_IOManagerIsWin32Native; +#endif + #include "BeginPrivate.h" /* The ./configure gives us a set of CPP flags, one for each named I/O manager: @@ -160,14 +169,6 @@ typedef enum { /* Global var to tell us which I/O manager impl we are using */ extern IOManagerType iomgr_type; -#if defined(mingw32_HOST_OS) -/* Global var (only on Windows) that is exported to be shared with the I/O code - * in the base library to tell us which style of I/O manager we are using: one - * that uses the Windows native API HANDLEs, or one that uses Posix style fds. - */ -extern bool rts_IOManagerIsWin32Native; -#endif - /* The CapIOManager is the per-capability data structure belonging to the I/O * manager. It is defined in full in IOManagerInternals.h. The opaque forward ===================================== rts/Linker.c ===================================== @@ -478,16 +478,7 @@ initLinker_ (int retain_cafs) symhash = allocStrHashTable(); /* populate the symbol table with stuff from the RTS */ - IF_DEBUG(linker, debugBelch("populating linker symbol table with built-in RTS symbols\n")); - for (const RtsSymbolVal *sym = rtsSyms; sym->lbl != NULL; sym++) { - IF_DEBUG(linker, debugBelch("initLinker: inserting rts symbol %s, %p\n", sym->lbl, sym->addr)); - if (! ghciInsertSymbolTable(WSTR("(GHCi built-in symbols)"), - symhash, sym->lbl, sym->addr, - sym->strength, sym->type, 0, NULL)) { - barf("ghciInsertSymbolTable failed"); - } - } - IF_DEBUG(linker, debugBelch("done with built-in RTS symbols\n")); + initLinkerRtsSyms(symhash); /* Add extra symbols. rtsExtraSyms() is a weakly defined symbol in the rts, * that can be overrided by linking in an object with a corresponding ===================================== rts/RtsSymbols.c ===================================== @@ -9,6 +9,8 @@ #include "ghcplatform.h" #include "Rts.h" #include "RtsSymbols.h" +#include "LinkerInternals.h" +#include "PathUtils.h" #include "TopHandler.h" #include "HsFFI.h" @@ -51,6 +53,19 @@ extern char **environ; /* ----------------------------------------------------------------------------- * Symbols to be inserted into the RTS symbol table. + * + * Note [Naming Scheme for Symbol Macros] + * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + * + * SymI_*: symbol is internal to the RTS. It resides in an object + * file/library that is statically. + * SymE_*: symbol is external to the RTS library. It might be linked + * dynamically. + * + * Sym*_HasProto : the symbol prototype is imported in an include file + * or defined explicitly + * Sym*_NeedsProto: the symbol is undefined and we add a dummy + * default proto extern void sym(void); */ #define Maybe_Stable_Names SymI_HasProto(stg_mkWeakzh) \ @@ -162,7 +177,7 @@ extern char **environ; SymI_HasProto(stg_asyncWritezh) \ SymI_HasProto(stg_asyncDoProczh) \ SymI_HasProto(rts_InstallConsoleEvent) \ - SymI_HasProto(rts_IOManagerIsWin32Native) \ + SymI_HasDataProto(rts_IOManagerIsWin32Native) \ SymI_HasProto(rts_ConsoleHandlerDone) \ SymI_NeedsProto(__mingw_module_is_dll) \ RTS_WIN64_ONLY(SymI_NeedsProto(___chkstk_ms)) \ @@ -912,7 +927,7 @@ extern char **environ; SymI_HasProto(freeExecPage) \ SymI_HasProto(getAllocations) \ SymI_HasProto(revertCAFs) \ - SymI_HasProto(RtsFlags) \ + SymI_HasDataProto(RtsFlags) \ SymI_NeedsDataProto(rts_breakpoint_io_action) \ SymI_NeedsDataProto(rts_stop_next_breakpoint) \ SymI_NeedsDataProto(rts_stop_on_exception) \ @@ -923,9 +938,9 @@ extern char **environ; SymI_NeedsProto(rts_enableStopAfterReturn) \ SymI_NeedsProto(rts_disableStopAfterReturn) \ SymI_HasProto(stopTimer) \ - SymI_HasProto(n_capabilities) \ - SymI_HasProto(max_n_capabilities) \ - SymI_HasProto(enabled_capabilities) \ + SymI_HasDataProto(n_capabilities) \ + SymI_HasDataProto(max_n_capabilities) \ + SymI_HasDataProto(enabled_capabilities) \ SymI_HasDataProto(stg_traceEventzh) \ SymI_HasDataProto(stg_traceMarkerzh) \ SymI_HasDataProto(stg_traceBinaryEventzh) \ @@ -1143,12 +1158,27 @@ extern char **environ; SymI_HasProto(hs_word2float64) -/* entirely bogus claims about types of these symbols */ -#define SymI_NeedsProto(vvv) extern void vvv(void); -#define SymI_NeedsDataProto(vvv) extern StgWord vvv[]; -#define SymE_NeedsProto(vvv) SymI_NeedsProto(vvv); -#define SymE_NeedsDataProto(vvv) SymI_NeedsDataProto(vvv); -#define SymE_HasProto(vvv) SymI_HasProto(vvv); +/* Declare prototypes for the symbols that need it, so we can refer + * to them in the rtsSyms table below. + * + * In particular, for the external ones (SymE_*) we use the dllimport attribute + * to indicate that (on Windows) they come from external DLLs. This attribute + * is ignored on other platforms. + * + * The claims about the types of these symbols are entirely bogus. + */ +#if defined(mingw32_HOST_OS) && defined(DYNAMIC) +#define DLLIMPORT __attribute__((dllimport)) +#else +#define DLLIMPORT /**/ +#endif + +#define SymI_NeedsProto(vvv) extern void vvv(void); +#define SymI_NeedsDataProto(vvv) extern StgWord vvv[]; +#define SymE_NeedsProto(vvv) extern DLLIMPORT void vvv(void); +#define SymE_NeedsDataProto(vvv) extern DLLIMPORT StgWord vvv[]; + +#define SymE_HasProto(vvv) /**/ #define SymI_HasProto(vvv) /**/ #define SymI_HasDataProto(vvv) /**/ #define SymI_HasProto_redirect(vvv,xxx,strength,ty) /**/ @@ -1177,6 +1207,8 @@ RTS_SYMBOLS_PRIM #undef SymE_NeedsProto #undef SymE_NeedsDataProto +/* See Note [Naming Scheme for Symbol Macros] */ + #define SymI_HasProto(vvv) { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \ (void*)(&(vvv)), STRENGTH_NORMAL, SYM_TYPE_CODE }, #define SymI_HasDataProto(vvv) { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \ @@ -1197,7 +1229,16 @@ RTS_SYMBOLS_PRIM { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \ (void*)(&(xxx)), strength, ty }, -RtsSymbolVal rtsSyms[] = { + +/* Populate the symbol table with stuff from the RTS. */ +void initLinkerRtsSyms (StrHashTable *symhash) { + + /* The address of data symbols with the dllimport attribute are not + * compile-time constants and so cannot be used in constant initialisers. + * For this reason, rtsSyms is a local variable within this function + * rather than a global constant (as it was historically). + */ + const RtsSymbolVal rtsSyms[] = { RTS_SYMBOLS RTS_RET_SYMBOLS RTS_POSIX_ONLY_SYMBOLS @@ -1212,7 +1253,19 @@ RtsSymbolVal rtsSyms[] = { RTS_SYMBOLS_PRIM SymI_HasDataProto(nonmoving_write_barrier_enabled) { 0, 0, STRENGTH_NORMAL, SYM_TYPE_CODE } /* sentinel */ -}; + }; + + IF_DEBUG(linker, debugBelch("populating linker symbol table with built-in RTS symbols\n")); + for (const RtsSymbolVal *sym = rtsSyms; sym->lbl != NULL; sym++) { + IF_DEBUG(linker, debugBelch("initLinker: inserting rts symbol %s, %p\n", sym->lbl, sym->addr)); + if (! ghciInsertSymbolTable(WSTR("(GHCi built-in symbols)"), + symhash, sym->lbl, sym->addr, + sym->strength, sym->type, 0, NULL)) { + barf("ghciInsertSymbolTable failed"); + } + } + IF_DEBUG(linker, debugBelch("done with built-in RTS symbols\n")); +} // Note [Extra RTS symbols] ===================================== rts/RtsSymbols.h ===================================== @@ -9,6 +9,7 @@ #pragma once #include "ghcautoconf.h" +#include "Hash.h" #if defined(LEADING_UNDERSCORE) #define MAYBE_LEADING_UNDERSCORE_STR(s) ("_" s) @@ -46,7 +47,7 @@ typedef struct _RtsSymbolVal { SymType type; } RtsSymbolVal; -extern RtsSymbolVal rtsSyms[]; +void initLinkerRtsSyms (StrHashTable *symhash); extern RtsSymbolVal* __attribute__((weak)) rtsExtraSyms(void); View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9b5778cbdee0bba703072661297bb65... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9b5778cbdee0bba703072661297bb65... You're receiving this email because of your account on gitlab.haskell.org.