[Git][ghc/ghc][wip/T25793] 2 commits: compiler: Add export list to GHC.SysTools.Tasks
Ben Gamari (@bgamari)
gitlab at gitlab.haskell.org
Tue Feb 25 19:53:43 UTC 2025
Ben Gamari pushed to branch wip/T25793 at Glasgow Haskell Compiler / GHC
Commits:
34558fa2 by Ben Gamari at 2025-02-25T14:53:31-05:00
compiler: Add export list to GHC.SysTools.Tasks
- - - - -
a684d9fe by Ben Gamari at 2025-02-25T14:53:31-05:00
compiler: Pass --target to llvm-as
As noted in #25793, this is necessary due to potential ambiguity on
Apple machines with Rosetta.
- - - - -
7 changed files:
- compiler/GHC/Settings/IO.hs
- compiler/GHC/SysTools/Tasks.hs
- distrib/configure.ac.in
- hadrian/cfg/system.config.in
- hadrian/src/Oracles/Setting.hs
- hadrian/src/Rules/Generate.hs
- m4/fp_settings.m4
Changes:
=====================================
compiler/GHC/Settings/IO.hs
=====================================
@@ -168,6 +168,7 @@ initSettings top_dir = do
lc_prog <- getSetting "LLVM llc command"
lo_prog <- getSetting "LLVM opt command"
las_prog <- getSetting "LLVM llvm-as command"
+ las_args <- map Option . unescapeArgs <$> getSetting "LLVM llvm-as flags"
let iserv_prog = libexec "ghc-iserv"
@@ -225,7 +226,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_las = (las_prog, las_args)
, toolSettings_pgm_i = iserv_prog
, toolSettings_opt_L = []
, toolSettings_opt_P = []
=====================================
compiler/GHC/SysTools/Tasks.hs
=====================================
@@ -7,7 +7,26 @@
-- (c) The GHC Team 2017
--
-----------------------------------------------------------------------------
-module GHC.SysTools.Tasks where
+module GHC.SysTools.Tasks
+ ( runUnlit
+ , SourceCodePreprocessor(..)
+ , runSourceCodePreprocessor
+ , runPp
+ , runCc
+ , askLd
+ , runAs
+ , runLlvmOpt
+ , runLlvmLlc
+ , runLlvmAs
+ , runEmscripten
+ , figureLlvmVersion
+ , runMergeObjects
+ , runAr
+ , askOtool
+ , runInstallNameTool
+ , runRanlib
+ , runWindres
+ ) where
import GHC.Prelude
import GHC.ForeignSrcLang
=====================================
distrib/configure.ac.in
=====================================
@@ -214,6 +214,13 @@ FIND_LLVM_PROG([LLVMAS], [clang], [$LlvmMinVersion], [$LlvmMaxVersion])
LlvmAsCmd="$LLVMAS"
AC_SUBST([LlvmAsCmd])
+dnl We know that `clang` supports `--target` and it is necessary to pass it
+dnl lest we see #25793.
+if test -z "$LlvmAsFlags" ; then
+ LlvmAsFlags="--target=$LlvmTarget"
+fi
+AC_SUBST([LlvmAsFlags])
+
dnl ** Check gcc version and flags we need to pass it **
FP_GCC_VERSION
FP_GCC_SUPPORTS_NO_PIE
=====================================
hadrian/cfg/system.config.in
=====================================
@@ -85,6 +85,7 @@ settings-install_name_tool-command = @SettingsInstallNameToolCommand@
settings-llc-command = @SettingsLlcCommand@
settings-opt-command = @SettingsOptCommand@
settings-llvm-as-command = @SettingsLlvmAsCommand@
+settings-llvm-as-flags = @SettingsLlvmAsFlags@
settings-use-distro-mingw = @SettingsUseDistroMINGW@
target-has-libm = @TargetHasLibm@
=====================================
hadrian/src/Oracles/Setting.hs
=====================================
@@ -91,6 +91,7 @@ data ToolchainSetting
| ToolchainSetting_LlcCommand
| ToolchainSetting_OptCommand
| ToolchainSetting_LlvmAsCommand
+ | ToolchainSetting_LlvmAsFlags
| ToolchainSetting_DistroMinGW
-- | Look up the value of a 'Setting' in @cfg/system.config@, tracking the
@@ -144,6 +145,7 @@ settingsFileSetting key = lookupSystemConfig $ case key of
ToolchainSetting_LlcCommand -> "settings-llc-command"
ToolchainSetting_OptCommand -> "settings-opt-command"
ToolchainSetting_LlvmAsCommand -> "settings-llvm-as-command"
+ ToolchainSetting_LlvmAsFlags -> "settings-llvm-as-flags"
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
=====================================
@@ -528,6 +528,7 @@ generateSettings settingsFile = do
, ("LLVM llc command", expr $ settingsFileSetting ToolchainSetting_LlcCommand)
, ("LLVM opt command", expr $ settingsFileSetting ToolchainSetting_OptCommand)
, ("LLVM llvm-as command", expr $ settingsFileSetting ToolchainSetting_LlvmAsCommand)
+ , ("LLVM llvm-as flags", expr $ settingsFileSetting ToolchainSetting_LlvmAsFlags)
, ("Use inplace MinGW toolchain", expr $ settingsFileSetting ToolchainSetting_DistroMinGW)
, ("target RTS linker only supports shared libraries", expr $ yesNo <$> targetRTSLinkerOnlySupportsSharedLibs)
=====================================
m4/fp_settings.m4
=====================================
@@ -89,6 +89,7 @@ AC_DEFUN([FP_SETTINGS],
SettingsLlcCommand="$LlcCmd"
SettingsOptCommand="$OptCmd"
SettingsLlvmAsCommand="$LlvmAsCmd"
+ SettingsLlvmAsFlags="$LlvmAsCmd"
if test "$EnableDistroToolchain" = "YES"; then
# If the user specified --enable-distro-toolchain then we just use the
@@ -131,6 +132,7 @@ AC_DEFUN([FP_SETTINGS],
SUBST_TOOLDIR([SettingsLlcCommand])
SUBST_TOOLDIR([SettingsOptCommand])
SUBST_TOOLDIR([SettingsLlvmAsCommand])
+ SUBST_TOOLDIR([SettingsLlvmAsFlags])
fi
# Mac-only tools
@@ -171,5 +173,6 @@ AC_DEFUN([FP_SETTINGS],
AC_SUBST(SettingsLlcCommand)
AC_SUBST(SettingsOptCommand)
AC_SUBST(SettingsLlvmAsCommand)
+ AC_SUBST(SettingsLlvmAsFlags)
AC_SUBST(SettingsUseDistroMINGW)
])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bb9bd644d769edb43c5be6150d1b17526f6cb67a...a684d9feb8cfa2b19a93f42de4a5832e819a5d0d
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bb9bd644d769edb43c5be6150d1b17526f6cb67a...a684d9feb8cfa2b19a93f42de4a5832e819a5d0d
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/20250225/db1fd3e1/attachment-0001.html>
More information about the ghc-commits
mailing list