Rip out runtime linker/compiler checks

8 files changed, 3 insertions, 365 deletions

diff --git a/compiler/GHC/Driver/Backend.hs b/compiler/GHC/Driver/Backend.hs
index e59f0a51f7..f5ed4cb023 100644
--- a/compiler/GHC/Driver/Backend.hs
+++ b/compiler/GHC/Driver/Backend.hs
@@ -58,8 +58,6 @@ module GHC.Driver.Backend
    , DefunctionalizedCodeOutput(..)
      -- *** Back-end functions for assembly
    , DefunctionalizedPostHscPipeline(..)
-   , DefunctionalizedAssemblerProg(..)
-   , DefunctionalizedAssemblerInfoGetter(..)
      -- *** Other back-end functions
    , DefunctionalizedCDefs(..)
      -- ** Names of back ends (for API clients of version 9.4 or earlier)
@@ -94,8 +92,6 @@ module GHC.Driver.Backend
    , backendSupportsHpc
    , backendSupportsCImport
    , backendSupportsCExport
-   , backendAssemblerProg
-   , backendAssemblerInfoGetter
    , backendCDefs
    , backendCodeOutput
    , backendUseJSLinker
@@ -348,40 +344,6 @@ data PrimitiveImplementation
   deriving Show
 
 
--- | Names a function that runs the assembler, of this type:
---
--- > Logger -> DynFlags -> Platform -> [Option] -> IO ()
---
--- The functions so named are defined in "GHC.Driver.Pipeline.Execute".
-
-data DefunctionalizedAssemblerProg
-  = StandardAssemblerProg
-       -- ^ Use the standard system assembler
-  | JSAssemblerProg
-       -- ^ JS Backend compile to JS via Stg, and so does not use any assembler
-  | DarwinClangAssemblerProg
-       -- ^ If running on Darwin, use the assembler from the @clang@
-       -- toolchain.  Otherwise use the standard system assembler.
-
-
-
--- | Names a function that discover from what toolchain the assembler
--- is coming, of this type:
---
--- > Logger -> DynFlags -> Platform -> IO CompilerInfo
---
--- The functions so named are defined in "GHC.Driver.Pipeline.Execute".
-
-data DefunctionalizedAssemblerInfoGetter
-  = StandardAssemblerInfoGetter
-       -- ^ Interrogate the standard system assembler
-  | JSAssemblerInfoGetter
-       -- ^ If using the JS backend; return 'Emscripten'
-  | DarwinClangAssemblerInfoGetter
-       -- ^ If running on Darwin, return `Clang`; otherwise
-       -- interrogate the standard system assembler.
-
-
 -- | Names a function that generates code and writes the results to a
 --  file, of this type:
 --
@@ -770,45 +732,6 @@ backendSupportsCExport (Named JavaScript)  = True
 backendSupportsCExport (Named Interpreter) = False
 backendSupportsCExport (Named NoBackend)   = True
 
--- | This (defunctionalized) function runs the assembler
--- used on the code that is written by this back end.  A
--- program determined by a combination of back end,
--- `DynFlags`, and `Platform` is run with the given
--- `Option`s.
---
--- The function's type is
--- @
--- Logger -> DynFlags -> Platform -> [Option] -> IO ()
--- @
---
--- This field is usually defaulted.
-backendAssemblerProg :: Backend -> DefunctionalizedAssemblerProg
-backendAssemblerProg (Named NCG)  = StandardAssemblerProg
-backendAssemblerProg (Named LLVM) = DarwinClangAssemblerProg
-backendAssemblerProg (Named ViaC) = StandardAssemblerProg
-backendAssemblerProg (Named JavaScript)  = JSAssemblerProg
-backendAssemblerProg (Named Interpreter) = StandardAssemblerProg
-backendAssemblerProg (Named NoBackend)   = StandardAssemblerProg
-
--- | This (defunctionalized) function is used to retrieve
--- an enumeration value that characterizes the C/assembler
--- part of a toolchain.  The function caches the info in a
--- mutable variable that is part of the `DynFlags`.
---
--- The function's type is
--- @
--- Logger -> DynFlags -> Platform -> IO CompilerInfo
--- @
---
--- This field is usually defaulted.
-backendAssemblerInfoGetter :: Backend -> DefunctionalizedAssemblerInfoGetter
-backendAssemblerInfoGetter (Named NCG)         = StandardAssemblerInfoGetter
-backendAssemblerInfoGetter (Named LLVM)        = DarwinClangAssemblerInfoGetter
-backendAssemblerInfoGetter (Named ViaC)        = StandardAssemblerInfoGetter
-backendAssemblerInfoGetter (Named JavaScript)  = JSAssemblerInfoGetter
-backendAssemblerInfoGetter (Named Interpreter) = StandardAssemblerInfoGetter
-backendAssemblerInfoGetter (Named NoBackend)   = StandardAssemblerInfoGetter
-
 -- | When using this back end, it may be necessary or
 -- advisable to pass some `-D` options to a C compiler.
 -- This (defunctionalized) function produces those
diff --git a/compiler/GHC/Driver/Main.hs b/compiler/GHC/Driver/Main.hs
index 3321d1203f..42ec18fcfa 100644
--- a/compiler/GHC/Driver/Main.hs
+++ b/compiler/GHC/Driver/Main.hs
@@ -336,41 +336,11 @@ initHscEnv mb_top_dir = do
   mySettings <- initSysTools top_dir
   dflags <- initDynFlags (defaultDynFlags mySettings)
   hsc_env <- newHscEnv top_dir dflags
-  checkBrokenTablesNextToCode (hsc_logger hsc_env) dflags
   setUnsafeGlobalDynFlags dflags
    -- c.f. DynFlags.parseDynamicFlagsFull, which
    -- creates DynFlags and sets the UnsafeGlobalDynFlags
   return hsc_env
 
--- | The binutils linker on ARM emits unnecessary R_ARM_COPY relocations which
--- breaks tables-next-to-code in dynamically linked modules. This
--- check should be more selective but there is currently no released
--- version where this bug is fixed.
--- See https://sourceware.org/bugzilla/show_bug.cgi?id=16177 and
--- https://gitlab.haskell.org/ghc/ghc/issues/4210#note_78333
-checkBrokenTablesNextToCode :: Logger -> DynFlags -> IO ()
-checkBrokenTablesNextToCode logger dflags = do
-  let invalidLdErr = "Tables-next-to-code not supported on ARM \
-                     \when using binutils ld (please see: \
-                     \https://sourceware.org/bugzilla/show_bug.cgi?id=16177)"
-  broken <- checkBrokenTablesNextToCode' logger dflags
-  when broken (panic invalidLdErr)
-
-checkBrokenTablesNextToCode' :: Logger -> DynFlags -> IO Bool
-checkBrokenTablesNextToCode' logger dflags
-  | not (isARM arch)               = return False
-  | ways dflags `hasNotWay` WayDyn = return False
-  | not tablesNextToCode           = return False
-  | otherwise                      = do
-    linkerInfo <- liftIO $ GHC.SysTools.getLinkerInfo logger dflags
-    case linkerInfo of
-      GnuLD _  -> return True
-      _        -> return False
-  where platform = targetPlatform dflags
-        arch = platformArch platform
-        tablesNextToCode = platformTablesNextToCode platform
-
-
 -- -----------------------------------------------------------------------------
 
 getDiagnostics :: Hsc (Messages GhcMessage)
diff --git a/compiler/GHC/Driver/Pipeline/Execute.hs b/compiler/GHC/Driver/Pipeline/Execute.hs
index 84113df8eb..9a8f17e26b 100644
--- a/compiler/GHC/Driver/Pipeline/Execute.hs
+++ b/compiler/GHC/Driver/Pipeline/Execute.hs
@@ -291,14 +291,6 @@ runAsPhase with_cpp pipe_env hsc_env location input_fn = do
         let unit_env   = hsc_unit_env hsc_env
         let platform   = ue_platform unit_env
 
-        -- LLVM from version 3.0 onwards doesn't support the OS X system
-        -- assembler, so we use clang as the assembler instead. (#5636)
-        let (as_prog, get_asm_info) =
-                ( applyAssemblerProg $ backendAssemblerProg (backend dflags)
-                , applyAssemblerInfoGetter $ backendAssemblerInfoGetter (backend dflags)
-                )
-        asmInfo <- get_asm_info logger dflags platform
-
         let cmdline_include_paths = includePaths dflags
         let pic_c_flags = picCCOpts dflags
 
@@ -315,7 +307,7 @@ runAsPhase with_cpp pipe_env hsc_env location input_fn = do
                                 includePathsQuoteImplicit cmdline_include_paths]
         let runAssembler inputFilename outputFilename
               = withAtomicRename outputFilename $ \temp_outputFilename ->
-                    as_prog
+                    runAs
                        logger dflags
                        platform
                        (local_includes ++ global_includes
@@ -400,35 +392,6 @@ runForeignJsPhase pipe_env hsc_env _location input_fn = do
   embedJsFile logger dflags tmpfs unit_env input_fn output_fn
   return output_fn
 
-
-applyAssemblerInfoGetter
-    :: DefunctionalizedAssemblerInfoGetter
-    -> Logger -> DynFlags -> Platform -> IO CompilerInfo
-applyAssemblerInfoGetter StandardAssemblerInfoGetter logger dflags _platform =
-    getAssemblerInfo logger dflags
-applyAssemblerInfoGetter JSAssemblerInfoGetter _ _ _ =
-    pure Emscripten
-applyAssemblerInfoGetter DarwinClangAssemblerInfoGetter logger dflags platform =
-    if platformOS platform == OSDarwin then
-        pure Clang
-    else
-        getAssemblerInfo logger dflags
-
-applyAssemblerProg
-    :: DefunctionalizedAssemblerProg
-    -> Logger -> DynFlags -> Platform -> [Option] -> IO ()
-applyAssemblerProg StandardAssemblerProg logger dflags _platform =
-    runAs logger dflags
-applyAssemblerProg JSAssemblerProg logger dflags _platform =
-    runEmscripten logger dflags
-applyAssemblerProg DarwinClangAssemblerProg logger dflags platform =
-    if platformOS platform == OSDarwin then
-        runClang logger dflags
-    else
-        runAs logger dflags
-
-
-
 runCcPhase :: Phase -> PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> IO FilePath
 runCcPhase cc_phase pipe_env hsc_env location input_fn = do
   let dflags    = hsc_dflags hsc_env
diff --git a/compiler/GHC/Driver/Session.hs b/compiler/GHC/Driver/Session.hs
index 84962f7868..ac0f01f83b 100644
--- a/compiler/GHC/Driver/Session.hs
+++ b/compiler/GHC/Driver/Session.hs
@@ -721,15 +721,6 @@ data DynFlags = DynFlags {
   avx512pf              :: Bool, -- Enable AVX-512 PreFetch Instructions.
   fma                   :: Bool, -- ^ Enable FMA instructions.
 
-  -- | Run-time linker information (what options we need, etc.)
-  rtldInfo              :: IORef (Maybe LinkerInfo),
-
-  -- | Run-time C compiler information
-  rtccInfo              :: IORef (Maybe CompilerInfo),
-
-  -- | Run-time assembler information
-  rtasmInfo              :: IORef (Maybe CompilerInfo),
-
   -- Constants used to control the amount of optimization done.
 
   -- | Max size, in bytes, of inline array allocations.
@@ -1101,9 +1092,6 @@ setDynamicNow dflags0 =
 initDynFlags :: DynFlags -> IO DynFlags
 initDynFlags dflags = do
  let
- refRtldInfo <- newIORef Nothing
- refRtccInfo <- newIORef Nothing
- refRtasmInfo <- newIORef Nothing
  canUseUnicode <- do let enc = localeEncoding
                          str = "‘’"
                      (withCString enc str $ \cstr ->
@@ -1125,9 +1113,6 @@ initDynFlags dflags = do
         useColor      = useColor',
         canUseColor   = stderrSupportsAnsiColors,
         colScheme     = colScheme',
-        rtldInfo      = refRtldInfo,
-        rtccInfo      = refRtccInfo,
-        rtasmInfo     = refRtasmInfo,
         tmpDir        = TempDir tmp_dir
         }
 
@@ -1306,9 +1291,6 @@ defaultDynFlags mySettings =
         avx512f = False,
         avx512pf = False,
         fma = False,
-        rtldInfo = panic "defaultDynFlags: no rtldInfo",
-        rtccInfo = panic "defaultDynFlags: no rtccInfo",
-        rtasmInfo = panic "defaultDynFlags: no rtasmInfo",
 
         maxInlineAllocSize = 128,
         maxInlineMemcpyInsns = 32,
diff --git a/compiler/GHC/Linker/ExtraObj.hs b/compiler/GHC/Linker/ExtraObj.hs
index 97f2bd5b07..cc9ffa5f3b 100644
--- a/compiler/GHC/Linker/ExtraObj.hs
+++ b/compiler/GHC/Linker/ExtraObj.hs
@@ -12,7 +12,6 @@ module GHC.Linker.ExtraObj
    , mkNoteObjsToLinkIntoBinary
    , checkLinkInfo
    , getLinkInfo
-   , getCompilerInfo
    , ghcLinkInfoSectionName
    , ghcLinkInfoNoteName
    , platformSupportsSavingLinkOpts
@@ -52,7 +51,6 @@ mkExtraObj logger tmpfs dflags unit_state extn xs
  = do cFile <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule extn
       oFile <- newTempName logger tmpfs (tmpDir dflags) TFL_GhcSession "o"
       writeFile cFile xs
-      ccInfo <- liftIO $ getCompilerInfo logger dflags
       runCc Nothing logger tmpfs dflags
             ([Option        "-c",
               FileOption "" cFile,
@@ -60,7 +58,7 @@ mkExtraObj logger tmpfs dflags unit_state extn xs
               FileOption "" oFile]
               ++ if extn /= "s"
                     then cOpts
-                    else asmOpts ccInfo)
+                    else [])
       return oFile
     where
       -- Pass a different set of options to the C compiler depending one whether
@@ -70,14 +68,6 @@ mkExtraObj logger tmpfs dflags unit_state extn xs
                     ++ map (FileOption "-I" . ST.unpack)
                             (unitIncludeDirs $ unsafeLookupUnit unit_state rtsUnit)
 
-      -- When compiling assembler code, we drop the usual C options, and if the
-      -- compiler is Clang, we add an extra argument to tell Clang to ignore
-      -- unused command line options. See trac #11684.
-      asmOpts ccInfo =
-            if any (ccInfo ==) [Clang, AppleClang, AppleClang51]
-                then [Option "-Qunused-arguments"]
-                else []
-
 -- When linking a binary, we need to create a C main() function that
 -- starts everything off.  This used to be compiled statically as part
 -- of the RTS, but that made it hard to change the -rtsopts setting,
diff --git a/compiler/GHC/SysTools/Info.hs b/compiler/GHC/SysTools/Info.hs
index d9ebe58cae..22e91bcad1 100644
--- a/compiler/GHC/SysTools/Info.hs
+++ b/compiler/GHC/SysTools/Info.hs
@@ -54,190 +54,3 @@ circular dependency.
 
 -}
 
-{- Note [ELF needed shared libs]
-   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Some distributions change the link editor's default handling of
-ELF DT_NEEDED tags to include only those shared objects that are
-needed to resolve undefined symbols. For Template Haskell we need
-the last temporary shared library also if it is not needed for the
-currently linked temporary shared library. We specify --no-as-needed
-to override the default. This flag exists in GNU ld and GNU gold.
-
-The flag is only needed on ELF systems. On Windows (PE) and Mac OS X
-(Mach-O) the flag is not needed.
-
--}
-
-neededLinkArgs :: LinkerInfo -> [Option]
-neededLinkArgs (GnuLD o)     = o
-neededLinkArgs (Mold o)      = o
-neededLinkArgs (GnuGold o)   = o
-neededLinkArgs (LlvmLLD o)   = o
-neededLinkArgs (DarwinLD o)  = o
-neededLinkArgs (SolarisLD o) = o
-neededLinkArgs (AixLD o)     = o
-neededLinkArgs UnknownLD     = []
-
--- Grab linker info and cache it in DynFlags.
-getLinkerInfo :: Logger -> DynFlags -> IO LinkerInfo
-getLinkerInfo logger dflags = do
-  info <- readIORef (rtldInfo dflags)
-  case info of
-    Just v  -> return v
-    Nothing -> do
-      v <- getLinkerInfo' logger dflags
-      writeIORef (rtldInfo dflags) (Just v)
-      return v
-
--- See Note [Run-time linker info].
-getLinkerInfo' :: Logger -> DynFlags -> IO LinkerInfo
-getLinkerInfo' logger dflags = do
-  let platform = targetPlatform dflags
-      os = platformOS platform
-      (pgm,args0) = pgm_l dflags
-      args1       = map Option (getOpts dflags opt_l)
-      args2       = args0 ++ args1
-      args3       = filter notNull (map showOpt args2)
-
-      -- Try to grab the info from the process output.
-      parseLinkerInfo stdo _stde _exitc
-        | any ("GNU ld" `isPrefixOf`) stdo =
-          -- Set DT_NEEDED for all shared libraries. #10110.
-          return (GnuLD $ map Option [-- ELF specific flag
-                                      -- see Note [ELF needed shared libs]
-                                      "-Wl,--no-as-needed"])
-
-        | any ("mold" `isPrefixOf`) stdo =
-          return (Mold $ map Option [ --see Note [ELF needed shared libs]
-                                      "-Wl,--no-as-needed"])
-
-        | any ("GNU gold" `isPrefixOf`) stdo =
-          -- GNU gold only needs --no-as-needed. #10110.
-          -- ELF specific flag, see Note [ELF needed shared libs]
-          return (GnuGold [Option "-Wl,--no-as-needed"])
-
-        | any (\line -> "LLD" `isPrefixOf` line || "LLD" `elem` words line) stdo =
-          return (LlvmLLD $ map Option [ --see Note [ELF needed shared libs]
-                                        "-Wl,--no-as-needed" | osElfTarget os || os == OSMinGW32 ])
-
-         -- Unknown linker.
-        | otherwise = fail "invalid --version output, or linker is unsupported"
-
-  -- Process the executable call
-  catchIO (
-    case os of
-      OSSolaris2 ->
-        -- Solaris uses its own Solaris linker. Even all
-        -- GNU C are recommended to configure with Solaris
-        -- linker instead of using GNU binutils linker. Also
-        -- all GCC distributed with Solaris follows this rule
-        -- precisely so we assume here, the Solaris linker is
-        -- used.
-        return $ SolarisLD []
-      OSAIX ->
-        -- IBM AIX uses its own non-binutils linker as well
-        return $ AixLD []
-      OSDarwin ->
-        -- Darwin has neither GNU Gold or GNU LD, but a strange linker
-        -- that doesn't support --version. We can just assume that's
-        -- what we're using.
-        return $ DarwinLD []
-      OSMinGW32 ->
-        -- GHC doesn't support anything but GNU ld on Windows anyway.
-        -- Process creation is also fairly expensive on win32, so
-        -- we short-circuit here.
-        return $ GnuLD $ map Option
-          [ -- Emit stack checks
-            -- See Note [Windows stack allocations]
-           "-fstack-check"
-          ]
-      _ -> do
-        -- In practice, we use the compiler as the linker here. Pass
-        -- -Wl,--version to get linker version info.
-        (exitc, stdo, stde) <- readProcessEnvWithExitCode pgm
-                               (["-Wl,--version"] ++ args3)
-                               c_locale_env
-        -- Split the output by lines to make certain kinds
-        -- of processing easier. In particular, 'clang' and 'gcc'
-        -- have slightly different outputs for '-Wl,--version', but
-        -- it's still easy to figure out.
-        parseLinkerInfo (lines stdo) (lines stde) exitc
-    )
-    (\err -> do
-        debugTraceMsg logger 2
-            (text "Error (figuring out linker information):" <+>
-             text (show err))
-        errorMsg logger $ hang (text "Warning:") 9 $
-          text "Couldn't figure out linker information!" $$
-          text "Make sure you're using GNU ld, GNU gold" <+>
-          text "or the built in OS X linker, etc."
-        return UnknownLD
-    )
-
--- | Grab compiler info and cache it in DynFlags.
-getCompilerInfo :: Logger -> DynFlags -> IO CompilerInfo
-getCompilerInfo logger dflags = do
-  info <- readIORef (rtccInfo dflags)
-  case info of
-    Just v  -> return v
-    Nothing -> do
-      let pgm = pgm_c dflags
-      v <- getCompilerInfo' logger pgm
-      writeIORef (rtccInfo dflags) (Just v)
-      return v
-
--- | Grab assembler info and cache it in DynFlags.
-getAssemblerInfo :: Logger -> DynFlags -> IO CompilerInfo
-getAssemblerInfo logger dflags = do
-  info <- readIORef (rtasmInfo dflags)
-  case info of
-    Just v  -> return v
-    Nothing -> do
-      let (pgm, _) = pgm_a dflags
-      v <- getCompilerInfo' logger pgm
-      writeIORef (rtasmInfo dflags) (Just v)
-      return v
-
--- See Note [Run-time linker info].
-getCompilerInfo' :: Logger -> String -> IO CompilerInfo
-getCompilerInfo' logger pgm = do
-  let -- Try to grab the info from the process output.
-      parseCompilerInfo _stdo stde _exitc
-        -- Regular GCC
-        | any ("gcc version" `isInfixOf`) stde =
-          return GCC
-        -- Regular clang
-        | any ("clang version" `isInfixOf`) stde =
-          return Clang
-        -- FreeBSD clang
-        | any ("FreeBSD clang version" `isInfixOf`) stde =
-          return Clang
-        -- Xcode 5.1 clang
-        | any ("Apple LLVM version 5.1" `isPrefixOf`) stde =
-          return AppleClang51
-        -- Xcode 5 clang
-        | any ("Apple LLVM version" `isPrefixOf`) stde =
-          return AppleClang
-        -- Xcode 4.1 clang
-        | any ("Apple clang version" `isPrefixOf`) stde =
-          return AppleClang
-         -- Unknown compiler.
-        | otherwise = fail $ "invalid -v output, or compiler is unsupported (" ++ pgm ++ "): " ++ unlines stde
-
-  -- Process the executable call
-  catchIO (do
-      (exitc, stdo, stde) <-
-          readProcessEnvWithExitCode pgm ["-v"] c_locale_env
-      -- Split the output by lines to make certain kinds
-      -- of processing easier.
-      parseCompilerInfo (lines stdo) (lines stde) exitc
-      )
-      (\err -> do
-          debugTraceMsg logger 2
-              (text "Error (figuring out C compiler information):" <+>
-               text (show err))
-          errorMsg logger $ hang (text "Warning:") 9 $
-            text "Couldn't figure out C compiler information!" $$
-            text "Make sure you're using GNU gcc, or clang"
-          return UnknownCC
-      )
diff --git a/compiler/GHC/SysTools/Tasks.hs b/compiler/GHC/SysTools/Tasks.hs
index 463cf39145..4e7dfe8e9a 100644
--- a/compiler/GHC/SysTools/Tasks.hs
+++ b/compiler/GHC/SysTools/Tasks.hs
@@ -278,15 +278,12 @@ figureLlvmVersion logger dflags = traceSystoolCommand logger "llc" $ do
 
 runLink :: Logger -> TmpFs -> DynFlags -> [Option] -> IO ()
 runLink logger tmpfs dflags args = traceSystoolCommand logger "linker" $ do
-  -- See Note [Run-time linker info]
-  --
   -- `-optl` args come at the end, so that later `-l` options
   -- given there manually can fill in symbols needed by
   -- Haskell libraries coming in via `args`.
-  linkargs <- neededLinkArgs `fmap` getLinkerInfo logger dflags
   let (p,args0) = pgm_l dflags
       optl_args = map Option (getOpts dflags opt_l)
-      args2     = args0 ++ linkargs ++ args ++ optl_args
+      args2     = args0 ++ args ++ optl_args
   mb_env <- getGccEnv args2
   runSomethingResponseFile logger tmpfs dflags ld_filter "Linker" p args2 mb_env
   where
diff --git a/nofib b/nofib
-Subproject 2cee92861c43ac74154bbd155a83f9f4ad0b9f2
+Subproject c99a289c531e8dc4efdee61ba72038e8acac805