[Git][ghc/ghc][wip/llvm-as] Use specific clang assembler when compiling with -fllvm
Matthew Pickering (@mpickering)
gitlab at gitlab.haskell.org
Wed Jan 31 11:45:59 UTC 2024
Matthew Pickering pushed to branch wip/llvm-as at Glasgow Haskell Compiler / GHC
Commits:
d25857e1 by Matthew Pickering at 2024-01-31T11:45:15+00:00
Use specific clang assembler when compiling with -fllvm
There are situations where LLVM will produce assembly which older gcc
toolchains can't handle. For example on Deb10, it seems that LLVM >= 13
produces assembly which the default gcc doesn't support.
A more robust solution in the long term is to require a specific LLVM
compatible assembler when using -fllvm.
Fixes #16354
- - - - -
18 changed files:
- compiler/GHC/Driver/Pipeline.hs
- compiler/GHC/Driver/Pipeline/Execute.hs
- compiler/GHC/Driver/Pipeline/Phases.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/Settings.hs
- compiler/GHC/Settings/IO.hs
- compiler/GHC/SysTools/Tasks.hs
- configure.ac
- distrib/configure.ac.in
- docs/users_guide/9.10.1-notes.rst
- docs/users_guide/phases.rst
- hadrian/bindist/Makefile
- hadrian/bindist/config.mk.in
- hadrian/cfg/system.config.in
- hadrian/src/Oracles/Setting.hs
- hadrian/src/Rules/Generate.hs
- m4/find_llvm_prog.m4
- m4/fp_settings.m4
Changes:
=====================================
compiler/GHC/Driver/Pipeline.hs
=====================================
@@ -830,6 +830,12 @@ asPipeline use_cpp pipe_env hsc_env location input_fn =
StopAs -> return Nothing
_ -> Just <$> use (T_As use_cpp pipe_env hsc_env location input_fn)
+lasPipeline :: P m => Bool -> PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> m (Maybe ObjFile)
+lasPipeline use_cpp pipe_env hsc_env location input_fn =
+ case stop_phase pipe_env of
+ StopAs -> return Nothing
+ _ -> Just <$> use (T_LlvmAs use_cpp pipe_env hsc_env location input_fn)
+
viaCPipeline :: P m => Phase -> PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> m (Maybe FilePath)
viaCPipeline c_phase pipe_env hsc_env location input_fn = do
out_fn <- use (T_Cc c_phase pipe_env hsc_env location input_fn)
@@ -853,7 +859,7 @@ llvmManglePipeline pipe_env hsc_env location llc_fn = do
if gopt Opt_NoLlvmMangler (hsc_dflags hsc_env)
then return llc_fn
else use (T_LlvmMangle pipe_env hsc_env llc_fn)
- asPipeline False pipe_env hsc_env location mangled_fn
+ lasPipeline False pipe_env hsc_env location mangled_fn
cmmCppPipeline :: P m => PipeEnv -> HscEnv -> FilePath -> m (Maybe FilePath)
cmmCppPipeline pipe_env hsc_env input_fn = do
=====================================
compiler/GHC/Driver/Pipeline/Execute.hs
=====================================
@@ -145,6 +145,8 @@ runPhase (T_LlvmOpt pipe_env hsc_env input_fn) =
runLlvmOptPhase pipe_env hsc_env input_fn
runPhase (T_LlvmLlc pipe_env hsc_env input_fn) =
runLlvmLlcPhase pipe_env hsc_env input_fn
+runPhase (T_LlvmAs cpp pipe_env hsc_env location input_fn) = do
+ runLlvmAsPhase cpp pipe_env hsc_env location input_fn
runPhase (T_LlvmMangle pipe_env hsc_env input_fn) =
runLlvmManglePhase pipe_env hsc_env input_fn
runPhase (T_MergeForeign pipe_env hsc_env input_fn fos) =
@@ -282,8 +284,9 @@ runLlvmOptPhase pipe_env hsc_env input_fn = do
return output_fn
-runAsPhase :: Bool -> PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> IO FilePath
-runAsPhase with_cpp pipe_env hsc_env location input_fn = do
+-- Run either 'clang' or 'gcc' phases
+runGenericAsPhase :: (Logger -> DynFlags -> [Option] -> IO ()) -> [Option] -> Bool -> PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> IO FilePath
+runGenericAsPhase run_as extra_opts with_cpp pipe_env hsc_env location input_fn = do
let dflags = hsc_dflags hsc_env
let logger = hsc_logger hsc_env
@@ -303,7 +306,7 @@ runAsPhase with_cpp pipe_env hsc_env location input_fn = do
includePathsQuoteImplicit cmdline_include_paths]
let runAssembler inputFilename outputFilename
= withAtomicRename outputFilename $ \temp_outputFilename ->
- runAs
+ run_as
logger dflags
(local_includes ++ global_includes
-- See Note [-fPIC for assembler]
@@ -326,13 +329,24 @@ runAsPhase with_cpp pipe_env hsc_env location input_fn = do
, GHC.SysTools.FileOption "" inputFilename
, GHC.SysTools.Option "-o"
, GHC.SysTools.FileOption "" temp_outputFilename
- ])
+ ] ++ extra_opts)
debugTraceMsg logger 4 (text "Running the assembler")
runAssembler input_fn output_fn
return output_fn
+-- Invoke `clang` to assemble a .S file produced by LLvm toolchain
+runLlvmAsPhase :: Bool -> PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> IO FilePath
+runLlvmAsPhase =
+ runGenericAsPhase runLlvmAs [ GHC.SysTools.Option "-Wno-unused-command-line-argument" ]
+
+-- Invoke 'gcc' to assemble a .S file
+runAsPhase :: Bool -> PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> IO FilePath
+runAsPhase =
+ runGenericAsPhase runAs []
+
+
-- Note [JS Backend .o file procedure]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
=====================================
compiler/GHC/Driver/Pipeline/Phases.hs
=====================================
@@ -47,6 +47,7 @@ data TPhase res where
T_ForeignJs :: PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> TPhase FilePath
T_LlvmOpt :: PipeEnv -> HscEnv -> FilePath -> TPhase FilePath
T_LlvmLlc :: PipeEnv -> HscEnv -> FilePath -> TPhase FilePath
+ T_LlvmAs :: Bool -> PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> TPhase FilePath
T_LlvmMangle :: PipeEnv -> HscEnv -> FilePath -> TPhase FilePath
T_MergeForeign :: PipeEnv -> HscEnv -> FilePath -> [FilePath] -> TPhase FilePath
=====================================
compiler/GHC/Driver/Session.hs
=====================================
@@ -108,6 +108,7 @@ module GHC.Driver.Session (
sPgm_ranlib,
sPgm_lo,
sPgm_lc,
+ sPgm_las,
sPgm_i,
sOpt_L,
sOpt_P,
@@ -136,10 +137,10 @@ module GHC.Driver.Session (
extraGccViaCFlags, globalPackageDatabasePath,
pgm_L, pgm_P, pgm_F, pgm_c, pgm_cxx, pgm_cpp, pgm_a, pgm_l, pgm_lm,
pgm_T, pgm_windres, pgm_ar,
- pgm_ranlib, pgm_lo, pgm_lc, pgm_i,
+ pgm_ranlib, pgm_lo, pgm_lc, pgm_las, pgm_i,
opt_L, opt_P, opt_F, opt_c, opt_cxx, opt_a, opt_l, opt_lm, opt_i,
opt_P_signature,
- opt_windres, opt_lo, opt_lc,
+ opt_windres, opt_lo, opt_lc, opt_las,
updatePlatformConstants,
-- ** Manipulating DynFlags
@@ -416,6 +417,8 @@ pgm_lo :: DynFlags -> (String,[Option])
pgm_lo dflags = toolSettings_pgm_lo $ toolSettings dflags
pgm_lc :: DynFlags -> (String,[Option])
pgm_lc dflags = toolSettings_pgm_lc $ toolSettings dflags
+pgm_las :: DynFlags -> (String,[Option])
+pgm_las dflags = toolSettings_pgm_las $ toolSettings dflags
pgm_i :: DynFlags -> String
pgm_i dflags = toolSettings_pgm_i $ toolSettings dflags
opt_L :: DynFlags -> [String]
@@ -453,6 +456,8 @@ opt_lo :: DynFlags -> [String]
opt_lo dflags= toolSettings_opt_lo $ toolSettings dflags
opt_lc :: DynFlags -> [String]
opt_lc dflags= toolSettings_opt_lc $ toolSettings dflags
+opt_las :: DynFlags -> [String]
+opt_las dflags = toolSettings_opt_las $ toolSettings dflags
opt_i :: DynFlags -> [String]
opt_i dflags= toolSettings_opt_i $ toolSettings dflags
@@ -1057,6 +1062,8 @@ dynamic_flags_deps = [
$ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_lo = (f,[]) }
, make_ord_flag defFlag "pgmlc"
$ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_lc = (f,[]) }
+ , make_ord_flag defFlag "pgmlas"
+ $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_las = (f,[]) }
, make_ord_flag defFlag "pgmlm"
$ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_lm =
if null f then Nothing else Just (f,[]) }
@@ -1112,6 +1119,8 @@ dynamic_flags_deps = [
$ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_opt_lo = f : toolSettings_opt_lo s }
, make_ord_flag defFlag "optlc"
$ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_opt_lc = f : toolSettings_opt_lc s }
+ , make_ord_flag defFlag "optlas"
+ $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_opt_las = f : toolSettings_opt_las s }
, make_ord_flag defFlag "opti"
$ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_opt_i = f : toolSettings_opt_i s }
, make_ord_flag defFlag "optL"
=====================================
compiler/GHC/Settings.hs
=====================================
@@ -41,6 +41,7 @@ module GHC.Settings
, sPgm_ranlib
, sPgm_lo
, sPgm_lc
+ , sPgm_las
, sPgm_i
, sOpt_L
, sOpt_P
@@ -118,6 +119,8 @@ data ToolSettings = ToolSettings
toolSettings_pgm_lo :: (String, [Option])
, -- | LLVM: llc static compiler
toolSettings_pgm_lc :: (String, [Option])
+ -- | LLVM: assembler
+ , toolSettings_pgm_las :: (String, [Option])
, toolSettings_pgm_i :: String
-- options for particular phases
@@ -137,6 +140,7 @@ data ToolSettings = ToolSettings
toolSettings_opt_lo :: [String]
, -- | LLVM: llc static compiler
toolSettings_opt_lc :: [String]
+ , toolSettings_opt_las :: [String]
, -- | iserv options
toolSettings_opt_i :: [String]
@@ -233,6 +237,8 @@ sPgm_lo :: Settings -> (String, [Option])
sPgm_lo = toolSettings_pgm_lo . sToolSettings
sPgm_lc :: Settings -> (String, [Option])
sPgm_lc = toolSettings_pgm_lc . sToolSettings
+sPgm_las :: Settings -> (String, [Option])
+sPgm_las = toolSettings_pgm_las . sToolSettings
sPgm_i :: Settings -> String
sPgm_i = toolSettings_pgm_i . sToolSettings
sOpt_L :: Settings -> [String]
=====================================
compiler/GHC/Settings/IO.hs
=====================================
@@ -149,6 +149,7 @@ initSettings top_dir = do
-- We just assume on command line
lc_prog <- getSetting "LLVM llc command"
lo_prog <- getSetting "LLVM opt command"
+ las_prog <- getSetting "LLVM llvm-as command"
let iserv_prog = libexec "ghc-iserv"
@@ -196,6 +197,7 @@ initSettings top_dir = do
, toolSettings_pgm_ranlib = ranlib_path
, toolSettings_pgm_lo = (lo_prog,[])
, toolSettings_pgm_lc = (lc_prog,[])
+ , toolSettings_pgm_las = (las_prog, [])
, toolSettings_pgm_i = iserv_prog
, toolSettings_opt_L = []
, toolSettings_opt_P = []
@@ -209,6 +211,7 @@ initSettings top_dir = do
, toolSettings_opt_windres = []
, toolSettings_opt_lo = []
, toolSettings_opt_lc = []
+ , toolSettings_opt_las = []
, toolSettings_opt_i = []
, toolSettings_extraGccViaCFlags = extraGccViaCFlags
=====================================
compiler/GHC/SysTools/Tasks.hs
=====================================
@@ -215,6 +215,14 @@ runLlvmLlc logger dflags args = traceSystoolCommand logger "llc" $ do
args1 = map Option (getOpts dflags opt_lc)
runSomething logger "LLVM Compiler" p (args0 ++ args1 ++ args)
+-- | Run the LLVM Assembler
+runLlvmAs :: Logger -> DynFlags -> [Option] -> IO ()
+runLlvmAs logger dflags args = traceSystoolCommand logger "llvm-as" $ do
+ let (p,args0) = pgm_las dflags
+ args1 = map Option (getOpts dflags opt_las)
+ runSomething logger "LLVM assembler" p (args0 ++ args1 ++ args)
+
+
runEmscripten :: Logger -> DynFlags -> [Option] -> IO ()
runEmscripten logger dflags args = traceSystoolCommand logger "emcc" $ do
let (p,args0) = pgm_a dflags
=====================================
configure.ac
=====================================
@@ -526,6 +526,13 @@ FIND_LLVM_PROG([OPT], [opt], [$LlvmMinVersion], [$LlvmMaxVersion])
OptCmd="$OPT"
AC_SUBST([OptCmd])
+dnl ** Which LLVM assembler to use?
+dnl --------------------------------------------------------------
+AC_ARG_VAR(LLVMAS,[Use as the path to LLVM's assembler (typically clang) [default=autodetect]])
+FIND_LLVM_PROG([LLVMAS], [clang], [$LlvmMinVersion], [$LlvmMaxVersion])
+LlvmAsCmd="$LLVMAS"
+AC_SUBST([LlvmAsCmd])
+
dnl --------------------------------------------------------------
dnl End of configure script option section
dnl --------------------------------------------------------------
@@ -1042,7 +1049,8 @@ echo "\
Using LLVM tools
llc : $LlcCmd
- opt : $OptCmd"
+ opt : $OptCmd
+ llvm-as : $LlvmAsCmd"
if test "$HSCOLOUR" = ""; then
echo "
=====================================
distrib/configure.ac.in
=====================================
@@ -163,6 +163,13 @@ FIND_LLVM_PROG([OPT], [opt], [$LlvmMinVersion], [$LlvmMaxVersion])
OptCmd="$OPT"
AC_SUBST([OptCmd])
+dnl ** Which LLVM assembler to use?
+dnl --------------------------------------------------------------
+AC_ARG_VAR(LLVMAS,[Use as the path to LLVM's assembler (typically clang) [default=autodetect]])
+FIND_LLVM_PROG([LLVMAS], [clang], [$LlvmMinVersion], [$LlvmMaxVersion])
+LlvmAsCmd="$LLVMAS"
+AC_SUBST([LlvmAsCmd])
+
dnl ** Check gcc version and flags we need to pass it **
FP_GCC_VERSION
FP_GCC_SUPPORTS_NO_PIE
=====================================
docs/users_guide/9.10.1-notes.rst
=====================================
@@ -129,6 +129,12 @@ Compiler
- Late plugins have been added. These are plugins which can access and/or modify
the core of a module after optimization and after interface creation. See :ghc-ticket:`24254`.
+- If you use :ghc-flag:`-fllvm` we now use an assembler from the LLVM toolchain rather than
+ the preconfigured assembler. This is typically ``clang``. The ``LLVMAS`` environment
+ variable can be specified at configure time to instruct GHC which ``clang`` to use.
+ This means that if you are using ``-fllvm`` you now need ``lcc``, ``opt`` and ``clang``
+ available.
+
GHCi
~~~~
=====================================
docs/users_guide/phases.rst
=====================================
@@ -59,6 +59,13 @@ given compilation phase:
Use ⟨cmd⟩ as the LLVM compiler.
+.. ghc-flag:: -pgmlas ⟨cmd⟩
+ :shortdesc: Use ⟨cmd⟩ as the LLVM assembler
+ :type: dynamic
+ :category: phase-programs
+
+ Use ⟨cmd⟩ as the LLVM assembler
+
.. ghc-flag:: -pgms ⟨cmd⟩
:shortdesc: Use ⟨cmd⟩ as the splitter
:type: dynamic
@@ -218,6 +225,13 @@ the following flags:
Pass ⟨option⟩ to the LLVM compiler.
+.. ghc-flag:: -optlas ⟨option⟩
+ :shortdesc: pass ⟨option⟩ to the LLVM assembler
+ :type: dynamic
+ :category: phase-options
+
+ Pass ⟨option⟩ to the LLVM assembler (typically clang).
+
.. ghc-flag:: -opta ⟨option⟩
:shortdesc: pass ⟨option⟩ to the assembler
:type: dynamic
=====================================
hadrian/bindist/Makefile
=====================================
@@ -133,6 +133,7 @@ lib/settings : config.mk
@echo ',("LLVM target", "$(LLVMTarget_CPP)")' >> $@
@echo ',("LLVM llc command", "$(SettingsLlcCommand)")' >> $@
@echo ',("LLVM opt command", "$(SettingsOptCommand)")' >> $@
+ @echo ',("LLVM llvm-as command", "$(SettingsLlvmAsCommand)")' >> $@
@echo ',("Use inplace MinGW toolchain", "$(SettingsUseDistroMINGW)")' >> $@
@echo
@echo ',("Use interpreter", "$(GhcWithInterpreter)")' >> $@
=====================================
hadrian/bindist/config.mk.in
=====================================
@@ -230,5 +230,6 @@ SettingsLibtoolCommand = @SettingsLibtoolCommand@
SettingsTouchCommand = @SettingsTouchCommand@
SettingsLlcCommand = @SettingsLlcCommand@
SettingsOptCommand = @SettingsOptCommand@
+SettingsLlvmAsCommand = @SettingsLlvmAsCommand@
SettingsUseDistroMINGW = @SettingsUseDistroMINGW@
=====================================
hadrian/cfg/system.config.in
=====================================
@@ -85,6 +85,7 @@ settings-install_name_tool-command = @SettingsInstallNameToolCommand@
settings-touch-command = @SettingsTouchCommand@
settings-llc-command = @SettingsLlcCommand@
settings-opt-command = @SettingsOptCommand@
+settings-llvm-as-command = @SettingsLlvmAsCommand@
settings-use-distro-mingw = @SettingsUseDistroMINGW@
target-has-libm = @TargetHasLibm@
=====================================
hadrian/src/Oracles/Setting.hs
=====================================
@@ -89,6 +89,7 @@ data ToolchainSetting
| ToolchainSetting_TouchCommand
| ToolchainSetting_LlcCommand
| ToolchainSetting_OptCommand
+ | ToolchainSetting_LlvmAsCommand
| ToolchainSetting_DistroMinGW
-- | Look up the value of a 'Setting' in @cfg/system.config@, tracking the
@@ -140,6 +141,7 @@ settingsFileSetting key = lookupSystemConfig $ case key of
ToolchainSetting_TouchCommand -> "settings-touch-command"
ToolchainSetting_LlcCommand -> "settings-llc-command"
ToolchainSetting_OptCommand -> "settings-opt-command"
+ ToolchainSetting_LlvmAsCommand -> "settings-llvm-as-command"
ToolchainSetting_DistroMinGW -> "settings-use-distro-mingw" -- ROMES:TODO: This option doesn't seem to be in ghc-toolchain yet. It corresponds to EnableDistroToolchain
-- | An expression that looks up the value of a 'Setting' in @cfg/system.config@,
=====================================
hadrian/src/Rules/Generate.hs
=====================================
@@ -398,6 +398,7 @@ generateSettings = do
, ("LLVM target", queryTarget tgtLlvmTarget)
, ("LLVM llc command", expr $ settingsFileSetting ToolchainSetting_LlcCommand)
, ("LLVM opt command", expr $ settingsFileSetting ToolchainSetting_OptCommand)
+ , ("LLVM llvm-as command", expr $ settingsFileSetting ToolchainSetting_LlvmAsCommand)
, ("Use inplace MinGW toolchain", expr $ settingsFileSetting ToolchainSetting_DistroMinGW)
, ("Use interpreter", expr $ yesNo <$> ghcWithInterpreter)
=====================================
m4/find_llvm_prog.m4
=====================================
@@ -14,7 +14,7 @@ AC_DEFUN([FIND_LLVM_PROG],[
PROG_VERSION_CANDIDATES=$(for llvmVersion in `seq $(($4-1)) -1 $3`; do echo "$2-$llvmVersion $2-$llvmVersion.0 $2$llvmVersion"; done)
AC_CHECK_TOOLS([$1], [$PROG_VERSION_CANDIDATES $2], [])
AS_IF([test x"$$1" != x],[
- PROG_VERSION=`$$1 --version | awk '/.*version [[0-9\.]]+/{for(i=1;i<=NF;i++){ if(\$i ~ /^[[0-9\.]]+$/){print \$i}}}'`
+ PROG_VERSION=`$$1 --version | sed -n -e 's/.*version \(\([[0-9]]\+\.\)\+[[0-9]]\+\).*/\1/gp'`
AS_IF([test x"$PROG_VERSION" = x],
[AC_MSG_RESULT(no)
$1=""
=====================================
m4/fp_settings.m4
=====================================
@@ -123,6 +123,11 @@ AC_DEFUN([FP_SETTINGS],
fi
SettingsOptCommand="$OptCmd"
+ if test -z "$LlvmAsCmd"; then
+ LlvmAsCmd="clang"
+ fi
+ SettingsLlvmAsCommand="$LlvmAsCmd"
+
# Mac-only tools
if test -z "$OtoolCmd"; then
OtoolCmd="otool"
@@ -156,5 +161,6 @@ AC_DEFUN([FP_SETTINGS],
AC_SUBST(SettingsTouchCommand)
AC_SUBST(SettingsLlcCommand)
AC_SUBST(SettingsOptCommand)
+ AC_SUBST(SettingsLlvmAsCommand)
AC_SUBST(SettingsUseDistroMINGW)
])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d25857e114fc648ecdaeb558c1f42c8108907c3b
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d25857e114fc648ecdaeb558c1f42c8108907c3b
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20240131/3cdb44e6/attachment-0001.html>
More information about the ghc-commits
mailing list