GitLab

David Eichmann pushed to branch wip/davide/ghc-internal-def at Glasgow Haskell Compiler / GHC

Commits:

9e751925

by David Eichmann at 2026-05-19T17:15:50+01:00

Hadrian: create a ghc-internal .def file per ghc-internal dll

The .def file generated from rts/win32/libHSghc-internal.def.in contains
the name of the ghc-internal dll, but that differs based on if the dll
is inplace/final and what way it is. Previously, this was not accounted
for and inconsistent dlls names where used. That led to failure when
loading dlls are runtime in experiments with windows dynamic linking.

5 changed files:

hadrian/src/Rules/Generate.hs
hadrian/src/Rules/Library.hs
hadrian/src/Rules/Rts.hs
rts/.gitignore
rts/win32/libHSghc-internal.def.in

Changes:

hadrian/src/Rules/Generate.hs

@@ -377,7 +377,6 @@ templateRules = do
      , interpolateSetting "ProjectPatchLevel1" ProjectPatchLevel1
      , interpolateSetting "ProjectPatchLevel2" ProjectPatchLevel2
+     ]
 -  templateRule "rts/win32/libHSghc-internal.def" projectVersion
    templateRule "docs/index.html" $ packageUnitIds Stage1
    templateRule "docs/users_guide/ghc_config.py" $ mconcat
      [ projectVersion

hadrian/src/Rules/Library.hs

@@ -20,6 +20,7 @@ import Utilities
  import Data.Time.Clock
  import Rules.Generate (generatedDependencies)
  import Oracles.Flag
 +import Oracles.Setting (setting, Setting (ProjectVersionForLib, ProjectVersion))
  -- * Library 'Rules'
@@ -203,10 +204,20 @@ extraObjects context
      | package context == rts = do
            target   <- interpretInContext context getStagedTarget
 -          builddir <- buildPath context
 -          return [ builddir -/- "libHSghc-internal.dll.a"
 -                 | archOS_OS (tgtArchOs target) == OSMinGW32
 -                 , Dynamic `wayUnit` way context ]
 +          if not (archOS_OS (tgtArchOs target) == OSMinGW32
 +                && Dynamic `wayUnit` way context)
 +          then return []
 +          else do
 +            -- Find the ghc-internal library file name
 +            ghcInternalDllName <- takeFileName <$> pkgLibraryFile (Context {
 +                    stage = stage context,
 +                    way = way context,
 +                    iplace = iplace context,
 +                    package = ghcInternal
 +                })
++
 +            builddir <- buildPath context
 +            return [ builddir -/- ghcInternalDllName <> ".a"]
      | otherwise = return []

hadrian/src/Rules/Rts.hs

@@ -29,11 +29,19 @@ rtsRules = priority 3 $ do
      -- to be linked into the rts dll.
      forM_ [Stage1, Stage2, Stage3 ] $ \ stage -> do
          let buildPath = root -/- buildDir (rtsContext stage)
 -        buildPath -/- "libHSghc-internal.dll.a" %> buildGhcInternalImportLib
 +        buildPath -/- "libHSghc-internal-*.def" %> buildGhcInternalImportDef
 +        buildPath -/- "libHSghc-internal-*.dll.a" %> buildGhcInternalImportLib
++
 +buildGhcInternalImportDef :: FilePath -> Action ()
 +buildGhcInternalImportDef target = do
 +    templateIn <- readFile' "rts/win32/libHSghc-internal.def.in"
 +    let dllName = (dropExtension (takeFileName target)) <.> "dll"
 +        templateOut = replace "@GhcInternalDll@" dllName templateIn
 +    writeFile' target templateOut
  buildGhcInternalImportLib :: FilePath -> Action ()
  buildGhcInternalImportLib target = do
 -    let input  = "rts/win32/libHSghc-internal.def"
 +    let input = (dropExtension (dropExtension target)) <.> "def" -- the .def file
          output = target -- the .dll.a import lib
      need [input]
      runBuilder Dlltool ["-d", input, "-l", output] [input] [output]

rts/.gitignore

@@ -20,4 +20,3 @@
  /ghcautoconf.h.autoconf.in
  /ghcautoconf.h.autoconf
  /include/ghcautoconf.h
 -/win32/libHSghc-internal.def

rts/win32/libHSghc-internal.def.in

 -LIBRARY libHSghc-internal-@ProjectVersionForLib@.0-ghc@ProjectVersion@.dll
 +LIBRARY @GhcInternalDll@
  EXPORTS
      init_ghc_hs_iface