driver: check if clang is the assembler when passing clang specific arguments (#19827)

Previously we assumed that the assembler was the same as the c compiler,
but we allow setting them to different programs with -pgmc and -pgma.

3 files changed, 34 insertions, 15 deletions

diff --git a/compiler/GHC/Driver/Pipeline.hs b/compiler/GHC/Driver/Pipeline.hs
index e766fda3c7..9a5fa6819e 100644
--- a/compiler/GHC/Driver/Pipeline.hs
+++ b/compiler/GHC/Driver/Pipeline.hs
@@ -1598,11 +1598,13 @@ runPhase (RealPhase (As with_cpp)) input_fn
 
         -- 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 | backend dflags == LLVM
+        let (as_prog, get_asm_info) | backend dflags == LLVM
                     , platformOS platform == OSDarwin
-                    = GHC.SysTools.runClang
+                    = (GHC.SysTools.runClang, pure Clang)
                     | otherwise
-                    = GHC.SysTools.runAs
+                    = (GHC.SysTools.runAs, liftIO $ getAssemblerInfo logger dflags)
+
+        asmInfo <- get_asm_info
 
         let cmdline_include_paths = includePaths dflags
         let pic_c_flags = picCCOpts dflags
@@ -1614,7 +1616,6 @@ runPhase (RealPhase (As with_cpp)) input_fn
         -- might be a hierarchical module.
         liftIO $ createDirectoryIfMissing True (takeDirectory output_fn)
 
-        ccInfo <- liftIO $ getCompilerInfo logger dflags
         let global_includes = [ GHC.SysTools.Option ("-I" ++ p)
                               | p <- includePathsGlobal cmdline_include_paths ]
         let local_includes = [ GHC.SysTools.Option ("-iquote" ++ p)
@@ -1643,7 +1644,7 @@ runPhase (RealPhase (As with_cpp)) input_fn
                        ++ (if platformArch (targetPlatform dflags) == ArchSPARC
                            then [GHC.SysTools.Option "-mcpu=v9"]
                            else [])
-                       ++ (if any (ccInfo ==) [Clang, AppleClang, AppleClang51]
+                       ++ (if any (asmInfo ==) [Clang, AppleClang, AppleClang51]
                             then [GHC.SysTools.Option "-Qunused-arguments"]
                             else [])
                        ++ [ GHC.SysTools.Option "-x"
diff --git a/compiler/GHC/Driver/Session.hs b/compiler/GHC/Driver/Session.hs
index 6a2f4c6b73..12782af0a8 100644
--- a/compiler/GHC/Driver/Session.hs
+++ b/compiler/GHC/Driver/Session.hs
@@ -654,9 +654,12 @@ data DynFlags = DynFlags {
   -- | Run-time linker information (what options we need, etc.)
   rtldInfo              :: IORef (Maybe LinkerInfo),
 
-  -- | Run-time compiler information
+  -- | 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.
@@ -1047,6 +1050,7 @@ initDynFlags dflags = do
  refDynamicTooFailed <- newIORef (not platformCanGenerateDynamicToo)
  refRtldInfo <- newIORef Nothing
  refRtccInfo <- newIORef Nothing
+ refRtasmInfo <- newIORef Nothing
  canUseUnicode <- do let enc = localeEncoding
                          str = "‘’"
                      (withCString enc str $ \cstr ->
@@ -1069,7 +1073,8 @@ initDynFlags dflags = do
         canUseColor   = stderrSupportsAnsiColors,
         colScheme     = colScheme',
         rtldInfo      = refRtldInfo,
-        rtccInfo      = refRtccInfo
+        rtccInfo      = refRtccInfo,
+        rtasmInfo     = refRtasmInfo
         }
 
 -- | The normal 'DynFlags'. Note that they are not suitable for use in this form
@@ -1237,6 +1242,7 @@ defaultDynFlags mySettings llvmConfig =
         avx512pf = 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/SysTools/Info.hs b/compiler/GHC/SysTools/Info.hs
index b53d0fb567..733c2eaade 100644
--- a/compiler/GHC/SysTools/Info.hs
+++ b/compiler/GHC/SysTools/Info.hs
@@ -205,22 +205,34 @@ getLinkerInfo' logger dflags = do
         return UnknownLD
     )
 
--- Grab compiler info and cache it in DynFlags.
+-- | 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
-      v <- getCompilerInfo' logger dflags
+      let pgm = pgm_c dflags
+      v <- getCompilerInfo' logger dflags 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 dflags pgm
+      writeIORef (rtasmInfo dflags) (Just v)
+      return v
+
 -- See Note [Run-time linker info].
-getCompilerInfo' :: Logger -> DynFlags -> IO CompilerInfo
-getCompilerInfo' logger dflags = do
-  let pgm = pgm_c dflags
-      -- Try to grab the info from the process output.
+getCompilerInfo' :: Logger -> DynFlags -> String -> IO CompilerInfo
+getCompilerInfo' logger dflags pgm = do
+  let -- Try to grab the info from the process output.
       parseCompilerInfo _stdo stde _exitc
         -- Regular GCC
         | any ("gcc version" `isInfixOf`) stde =
@@ -240,8 +252,8 @@ getCompilerInfo' logger dflags = do
         -- Xcode 4.1 clang
         | any ("Apple clang version" `isPrefixOf`) stde =
           return AppleClang
-         -- Unknown linker.
-        | otherwise = fail $ "invalid -v output, or compiler is unsupported: " ++ unlines stde
+         -- Unknown compiler.
+        | otherwise = fail $ "invalid -v output, or compiler is unsupported (" ++ pgm ++ "): " ++ unlines stde
 
   -- Process the executable call
   catchIO (do