From c205ecd251b0e576c3a4ae8b05f2c70f1878d337 Mon Sep 17 00:00:00 2001
From: Cheng Shao <terrorjack@type.dance>
Date: Fri, 4 Oct 2024 19:44:23 +0000
Subject: [PATCH] hadrian/compiler: implement
 targetRTSLinkerOnlySupportsSharedLibs

This patch implements the targetRTSLinkerOnlySupportsSharedLibs
predicate in hadrian. Its definition in hadrian is the single source
of truth, and the information propagates to ghc settings file, ghc
driver and testsuite driver. It is used in various places to ensure
dynamic dependency is selected when the target RTS linker only
supports loading dynamic code.

(cherry picked from commit 8c74a0eda41255ead134f05598f5da70992a7054)
---
 compiler/GHC/Driver/Session.hs           |  1 +
 compiler/GHC/Platform.hs                 |  1 +
 compiler/GHC/Settings.hs                 |  4 ++++
 compiler/GHC/Settings/IO.hs              |  2 ++
 hadrian/bindist/Makefile                 |  1 +
 hadrian/bindist/config.mk.in             |  8 ++++++--
 hadrian/src/Oracles/Flag.hs              | 24 +++++++++++++++++++++++-
 hadrian/src/Oracles/TestSettings.hs      |  2 ++
 hadrian/src/Rules/Generate.hs            |  1 +
 hadrian/src/Settings/Builders/RunTest.hs |  4 ++++
 testsuite/driver/testglobals.py          |  3 +++
 testsuite/ghc-config/ghc-config.hs       |  1 +
 12 files changed, 49 insertions(+), 3 deletions(-)

diff --git a/compiler/GHC/Driver/Session.hs b/compiler/GHC/Driver/Session.hs
index e236f934ef2..f2e1d36e8a5 100644
--- a/compiler/GHC/Driver/Session.hs
+++ b/compiler/GHC/Driver/Session.hs
@@ -130,6 +130,7 @@ module GHC.Driver.Session (
         sTargetPlatformString,
         sGhcWithInterpreter,
         sLibFFI,
+        sTargetRTSLinkerOnlySupportsSharedLibs,
         GhcNameVersion(..),
         FileSettings(..),
         PlatformMisc(..),
diff --git a/compiler/GHC/Platform.hs b/compiler/GHC/Platform.hs
index 273082cdb6a..42f2aa041e3 100644
--- a/compiler/GHC/Platform.hs
+++ b/compiler/GHC/Platform.hs
@@ -287,6 +287,7 @@ data PlatformMisc = PlatformMisc
   , platformMisc_ghcWithInterpreter   :: Bool
   , platformMisc_libFFI               :: Bool
   , platformMisc_llvmTarget           :: String
+  , platformMisc_targetRTSLinkerOnlySupportsSharedLibs :: Bool
   }
 
 platformSOName :: Platform -> FilePath -> FilePath
diff --git a/compiler/GHC/Settings.hs b/compiler/GHC/Settings.hs
index 61d8b797acf..0529c292e37 100644
--- a/compiler/GHC/Settings.hs
+++ b/compiler/GHC/Settings.hs
@@ -65,6 +65,7 @@ module GHC.Settings
   , sTargetPlatformString
   , sGhcWithInterpreter
   , sLibFFI
+  , sTargetRTSLinkerOnlySupportsSharedLibs
   ) where
 
 import GHC.Prelude
@@ -304,3 +305,6 @@ sGhcWithInterpreter :: Settings -> Bool
 sGhcWithInterpreter = platformMisc_ghcWithInterpreter . sPlatformMisc
 sLibFFI :: Settings -> Bool
 sLibFFI = platformMisc_libFFI . sPlatformMisc
+
+sTargetRTSLinkerOnlySupportsSharedLibs :: Settings -> Bool
+sTargetRTSLinkerOnlySupportsSharedLibs = platformMisc_targetRTSLinkerOnlySupportsSharedLibs . sPlatformMisc
diff --git a/compiler/GHC/Settings/IO.hs b/compiler/GHC/Settings/IO.hs
index 690ff98c4a0..4f67fa4e3ad 100644
--- a/compiler/GHC/Settings/IO.hs
+++ b/compiler/GHC/Settings/IO.hs
@@ -164,6 +164,7 @@ initSettings top_dir = do
 
   let iserv_prog = libexec "ghc-iserv"
 
+  targetRTSLinkerOnlySupportsSharedLibs <- getBooleanSetting "target RTS linker only supports shared libraries"
   ghcWithInterpreter <- getBooleanSetting "Use interpreter"
   useLibFFI <- getBooleanSetting "Use LibFFI"
 
@@ -240,6 +241,7 @@ initSettings top_dir = do
       , platformMisc_ghcWithInterpreter = ghcWithInterpreter
       , platformMisc_libFFI = useLibFFI
       , platformMisc_llvmTarget = llvmTarget
+      , platformMisc_targetRTSLinkerOnlySupportsSharedLibs = targetRTSLinkerOnlySupportsSharedLibs
       }
 
     , sRawSettings    = settingsList
diff --git a/hadrian/bindist/Makefile b/hadrian/bindist/Makefile
index 75cc857ad21..8208ed4bb48 100644
--- a/hadrian/bindist/Makefile
+++ b/hadrian/bindist/Makefile
@@ -133,6 +133,7 @@ lib/settings : config.mk
 	@echo ',("LLVM llvm-as command", "$(SettingsLlvmAsCommand)")' >> $@
 	@echo ',("Use inplace MinGW toolchain", "$(SettingsUseDistroMINGW)")' >> $@
 	@echo
+	@echo ',("target RTS linker only supports shared libraries", "$(TargetRTSLinkerOnlySupportsSharedLibs)")' >> $@
 	@echo ',("Use interpreter", "$(GhcWithInterpreter)")' >> $@
 	@echo ',("Support SMP", "$(GhcWithSMP)")' >> $@
 	@echo ',("RTS ways", "$(GhcRTSWays)")' >> $@
diff --git a/hadrian/bindist/config.mk.in b/hadrian/bindist/config.mk.in
index 407d480ea3b..76b9c725180 100644
--- a/hadrian/bindist/config.mk.in
+++ b/hadrian/bindist/config.mk.in
@@ -150,6 +150,12 @@ endif
 # `GhcUnregisterised` mode doesn't allow that.
 GhcWithSMP := $(strip $(if $(filter YESNO, $(ArchSupportsSMP)$(GhcUnregisterised)),YES,NO))
 
+ifeq "$(TargetArch_CPP)" "wasm32"
+TargetRTSLinkerOnlySupportsSharedLibs=YES
+else
+TargetRTSLinkerOnlySupportsSharedLibs=NO
+endif
+
 # Whether to include GHCi in the compiler.  Depends on whether the RTS linker
 # has support for this OS/ARCH combination.
 OsSupportsGHCi=$(strip $(patsubst $(TargetOS_CPP), YES, $(findstring $(TargetOS_CPP), mingw32 linux solaris2 freebsd dragonfly netbsd openbsd darwin kfreebsdgnu)))
@@ -237,5 +243,3 @@ SettingsLlcCommand = @SettingsLlcCommand@
 SettingsOptCommand = @SettingsOptCommand@
 SettingsLlvmAsCommand = @SettingsLlvmAsCommand@
 SettingsUseDistroMINGW = @SettingsUseDistroMINGW@
-
-
diff --git a/hadrian/src/Oracles/Flag.hs b/hadrian/src/Oracles/Flag.hs
index 98784c5525a..af4e268fb85 100644
--- a/hadrian/src/Oracles/Flag.hs
+++ b/hadrian/src/Oracles/Flag.hs
@@ -4,6 +4,7 @@ module Oracles.Flag (
     Flag (..), flag, getFlag,
     platformSupportsSharedLibs,
     platformSupportsGhciObjects,
+    targetRTSLinkerOnlySupportsSharedLibs,
     targetSupportsThreadedRts,
     targetSupportsSMP,
     useLibffiForAdjustors,
@@ -76,7 +77,28 @@ getFlag = expr . flag
 -- when appropriate).
 platformSupportsGhciObjects :: Action Bool
 -- FIXME: The name of the function is not entirely clear about which platform, it would be better named targetSupportsGhciObjects
-platformSupportsGhciObjects = isJust <$> queryTargetTarget tgtMergeObjs
+platformSupportsGhciObjects = do
+    has_merge_objs <- isJust <$> queryTargetTarget tgtMergeObjs
+    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 ]
 
 arSupportsDashL :: Stage -> Action Bool
 arSupportsDashL stage = Toolchain.arSupportsDashL . tgtAr <$> targetStage stage
diff --git a/hadrian/src/Oracles/TestSettings.hs b/hadrian/src/Oracles/TestSettings.hs
index 98da420fb33..76bf389f232 100644
--- a/hadrian/src/Oracles/TestSettings.hs
+++ b/hadrian/src/Oracles/TestSettings.hs
@@ -31,6 +31,7 @@ data TestSetting = TestHostOS
                  | TestGhcWithNativeCodeGen
                  | TestGhcWithInterpreter
                  | TestGhcCrossCompiling
+                 | TestRTSLinkerForceDyn
                  | TestGhcWithRtsLinker
                  | TestGhcUnregisterised
                  | TestGhcTablesNextToCode
@@ -63,6 +64,7 @@ testSetting key = do
         TestGhcWithNativeCodeGen  -> "GhcWithNativeCodeGen"
         TestGhcWithInterpreter    -> "GhcWithInterpreter"
         TestGhcCrossCompiling     -> "CrossCompiling"
+        TestRTSLinkerForceDyn     -> "TargetRTSLinkerOnlySupportsSharedLibs"
         TestGhcWithRtsLinker      -> "GhcWithRtsLinker"
         TestGhcUnregisterised     -> "GhcUnregisterised"
         TestGhcTablesNextToCode   -> "GhcTablesNextToCode"
diff --git a/hadrian/src/Rules/Generate.hs b/hadrian/src/Rules/Generate.hs
index 032cc2a60b4..f9d6ef7bee2 100644
--- a/hadrian/src/Rules/Generate.hs
+++ b/hadrian/src/Rules/Generate.hs
@@ -444,6 +444,7 @@ generateSettings = do
         , ("LLVM llvm-as command", expr $ settingsFileSetting ToolchainSetting_LlvmAsCommand)
         , ("Use inplace MinGW toolchain", expr $ settingsFileSetting ToolchainSetting_DistroMinGW)
 
+        , ("target RTS linker only supports shared libraries", expr $ yesNo <$> targetRTSLinkerOnlySupportsSharedLibs)
         , ("Use interpreter", expr $ yesNo <$> ghcWithInterpreter)
         , ("Support SMP", expr $ yesNo <$> targetSupportsSMP)
         , ("RTS ways", escapeArgs . map show . Set.toList <$> getRtsWays)
diff --git a/hadrian/src/Settings/Builders/RunTest.hs b/hadrian/src/Settings/Builders/RunTest.hs
index 9f90c30328c..8d47882f1cd 100644
--- a/hadrian/src/Settings/Builders/RunTest.hs
+++ b/hadrian/src/Settings/Builders/RunTest.hs
@@ -68,6 +68,7 @@ data TestCompilerArgs = TestCompilerArgs{
  ,   withNativeCodeGen :: Bool
  ,   withInterpreter   :: Bool
  ,   cross             :: Bool
+ ,   interpForceDyn    :: Bool
  ,   unregisterised    :: Bool
  ,   tables_next_to_code :: Bool
  ,   targetWithSMP       :: Bool  -- does the target support SMP
@@ -103,6 +104,7 @@ inTreeCompilerArgs stg = do
     -- have different values? Currently not possible to express.
     leadingUnderscore   <- queryTargetTarget tgtSymbolsHaveLeadingUnderscore
     withInterpreter     <- ghcWithInterpreter
+    interpForceDyn      <- targetRTSLinkerOnlySupportsSharedLibs
     unregisterised      <- queryTargetTarget tgtUnregisterised
     tables_next_to_code <- queryTargetTarget tgtTablesNextToCode
     targetWithSMP       <- targetSupportsSMP
@@ -160,6 +162,7 @@ outOfTreeCompilerArgs = do
     withNativeCodeGen   <- getBooleanSetting TestGhcWithNativeCodeGen
     withInterpreter     <- getBooleanSetting TestGhcWithInterpreter
     cross               <- getBooleanSetting TestGhcCrossCompiling
+    interpForceDyn      <- getBooleanSetting TestRTSLinkerForceDyn
     unregisterised      <- getBooleanSetting TestGhcUnregisterised
     tables_next_to_code <- getBooleanSetting TestGhcTablesNextToCode
     targetWithSMP       <- targetSupportsSMP
@@ -277,6 +280,7 @@ runTestBuilderArgs = builder Testsuite ? do
 
             , arg "-e", arg $ "config.have_interp=" ++ show withInterpreter
             , arg "-e", arg $ "config.cross=" ++ show cross
+            , arg "-e", arg $ "config.interp_force_dyn=" ++ show interpForceDyn
             , arg "-e", arg $ "config.unregisterised=" ++ show unregisterised
             , arg "-e", arg $ "config.tables_next_to_code=" ++ show tables_next_to_code
 
diff --git a/testsuite/driver/testglobals.py b/testsuite/driver/testglobals.py
index 9b16fa9dd61..4e7edd84245 100644
--- a/testsuite/driver/testglobals.py
+++ b/testsuite/driver/testglobals.py
@@ -132,6 +132,9 @@ class TestConfig:
 
         # Are we cross-compiling?
         self.cross = False
+        
+        # Does the RTS linker only support loading shared libraries?
+        self.interp_force_dyn = False
 
         # Do we have RTS linker?
         self.have_RTS_linker = False
diff --git a/testsuite/ghc-config/ghc-config.hs b/testsuite/ghc-config/ghc-config.hs
index c50090240ad..95f58d06789 100644
--- a/testsuite/ghc-config/ghc-config.hs
+++ b/testsuite/ghc-config/ghc-config.hs
@@ -29,6 +29,7 @@ main = do
   getGhcFieldOrFail fields "GhcRTSWays" "RTS ways"
   getGhcFieldOrFail fields "GhcLibdir" "LibDir"
   getGhcFieldOrFail fields "GhcGlobalPackageDb" "Global Package DB"
+  getGhcFieldOrDefault fields "TargetRTSLinkerOnlySupportsSharedLibs" "target RTS linker only supports shared libraries" "NO"
   getGhcFieldOrDefault fields "GhcDynamic" "GHC Dynamic" "NO"
   getGhcFieldOrDefault fields "GhcProfiled" "GHC Profiled" "NO"
   getGhcFieldOrDefault fields "LeadingUnderscore" "Leading underscore" "NO"
-- 
GitLab