never executed always true always false
1
2 {-# LANGUAGE LambdaCase #-}
3 {-# LANGUAGE ScopedTypeVariables #-}
4
5 module GHC.Settings.IO
6 ( SettingsError (..)
7 , initSettings
8 ) where
9
10 import GHC.Prelude
11
12 import GHC.Settings.Utils
13
14 import GHC.Settings.Config
15 import GHC.Utils.CliOption
16 import GHC.Utils.Fingerprint
17 import GHC.Platform
18 import GHC.Utils.Panic
19 import GHC.Settings
20 import GHC.SysTools.BaseDir
21
22 import Control.Monad.Trans.Except
23 import Control.Monad.IO.Class
24 import qualified Data.Map as Map
25 import System.FilePath
26 import System.Directory
27
28 data SettingsError
29 = SettingsError_MissingData String
30 | SettingsError_BadData String
31
32 initSettings
33 :: forall m
34 . MonadIO m
35 => String -- ^ TopDir path
36 -> ExceptT SettingsError m Settings
37 initSettings top_dir = do
38 -- see Note [topdir: How GHC finds its files]
39 -- NB: top_dir is assumed to be in standard Unix
40 -- format, '/' separated
41 mtool_dir <- liftIO $ findToolDir top_dir
42 -- see Note [tooldir: How GHC finds mingw on Windows]
43
44 let installed :: FilePath -> FilePath
45 installed file = top_dir </> file
46 libexec :: FilePath -> FilePath
47 libexec file = top_dir </> "bin" </> file
48 settingsFile = installed "settings"
49
50 readFileSafe :: FilePath -> ExceptT SettingsError m String
51 readFileSafe path = liftIO (doesFileExist path) >>= \case
52 True -> liftIO $ readFile path
53 False -> throwE $ SettingsError_MissingData $ "Missing file: " ++ path
54
55 settingsStr <- readFileSafe settingsFile
56 settingsList <- case maybeReadFuzzy settingsStr of
57 Just s -> pure s
58 Nothing -> throwE $ SettingsError_BadData $
59 "Can't parse " ++ show settingsFile
60 let mySettings = Map.fromList settingsList
61 -- See Note [Settings file] for a little more about this file. We're
62 -- just partially applying those functions and throwing 'Left's; they're
63 -- written in a very portable style to keep ghc-boot light.
64 let getSetting key = either pgmError pure $
65 getRawFilePathSetting top_dir settingsFile mySettings key
66 getToolSetting :: String -> ExceptT SettingsError m String
67 getToolSetting key = expandToolDir mtool_dir <$> getSetting key
68 getBooleanSetting :: String -> ExceptT SettingsError m Bool
69 getBooleanSetting key = either pgmError pure $
70 getRawBooleanSetting settingsFile mySettings key
71 targetPlatformString <- getSetting "target platform string"
72 myExtraGccViaCFlags <- getSetting "GCC extra via C opts"
73 -- On Windows, mingw is distributed with GHC,
74 -- so we look in TopDir/../mingw/bin,
75 -- as well as TopDir/../../mingw/bin for hadrian.
76 -- It would perhaps be nice to be able to override this
77 -- with the settings file, but it would be a little fiddly
78 -- to make that possible, so for now you can't.
79 cc_prog <- getToolSetting "C compiler command"
80 cc_args_str <- getSetting "C compiler flags"
81 cxx_args_str <- getSetting "C++ compiler flags"
82 gccSupportsNoPie <- getBooleanSetting "C compiler supports -no-pie"
83 cpp_prog <- getToolSetting "Haskell CPP command"
84 cpp_args_str <- getSetting "Haskell CPP flags"
85
86 platform <- either pgmError pure $ getTargetPlatform settingsFile mySettings
87
88 let unreg_cc_args = if platformUnregisterised platform
89 then ["-DNO_REGS", "-DUSE_MINIINTERPRETER"]
90 else []
91 cpp_args = map Option (words cpp_args_str)
92 cc_args = words cc_args_str ++ unreg_cc_args
93 cxx_args = words cxx_args_str
94 ldSupportsCompactUnwind <- getBooleanSetting "ld supports compact unwind"
95 ldSupportsBuildId <- getBooleanSetting "ld supports build-id"
96 ldSupportsFilelist <- getBooleanSetting "ld supports filelist"
97 ldIsGnuLd <- getBooleanSetting "ld is GNU ld"
98
99 let globalpkgdb_path = installed "package.conf.d"
100 ghc_usage_msg_path = installed "ghc-usage.txt"
101 ghci_usage_msg_path = installed "ghci-usage.txt"
102
103 -- For all systems, unlit, split, mangle are GHC utilities
104 -- architecture-specific stuff is done when building Config.hs
105 unlit_path <- getToolSetting "unlit command"
106
107 windres_path <- getToolSetting "windres command"
108 libtool_path <- getToolSetting "libtool command"
109 ar_path <- getToolSetting "ar command"
110 otool_path <- getToolSetting "otool command"
111 install_name_tool_path <- getToolSetting "install_name_tool command"
112 ranlib_path <- getToolSetting "ranlib command"
113
114 touch_path <- getToolSetting "touch command"
115
116 mkdll_prog <- getToolSetting "dllwrap command"
117 let mkdll_args = []
118
119 -- cpp is derived from gcc on all platforms
120 -- HACK, see setPgmP below. We keep 'words' here to remember to fix
121 -- Config.hs one day.
122
123
124 -- Other things being equal, as and ld are simply gcc
125 cc_link_args_str <- getSetting "C compiler link flags"
126 let as_prog = cc_prog
127 as_args = map Option cc_args
128 ld_prog = cc_prog
129 ld_args = map Option (cc_args ++ words cc_link_args_str)
130 ld_r_prog <- getToolSetting "Merge objects command"
131 ld_r_args <- getSetting "Merge objects flags"
132
133 llvmTarget <- getSetting "LLVM target"
134
135 -- We just assume on command line
136 lc_prog <- getSetting "LLVM llc command"
137 lo_prog <- getSetting "LLVM opt command"
138 lcc_prog <- getSetting "LLVM clang command"
139
140 let iserv_prog = libexec "ghc-iserv"
141
142 ghcWithInterpreter <- getBooleanSetting "Use interpreter"
143 useLibFFI <- getBooleanSetting "Use LibFFI"
144
145 return $ Settings
146 { sGhcNameVersion = GhcNameVersion
147 { ghcNameVersion_programName = "ghc"
148 , ghcNameVersion_projectVersion = cProjectVersion
149 }
150
151 , sFileSettings = FileSettings
152 { fileSettings_ghcUsagePath = ghc_usage_msg_path
153 , fileSettings_ghciUsagePath = ghci_usage_msg_path
154 , fileSettings_toolDir = mtool_dir
155 , fileSettings_topDir = top_dir
156 , fileSettings_globalPackageDatabase = globalpkgdb_path
157 }
158
159 , sToolSettings = ToolSettings
160 { toolSettings_ldSupportsCompactUnwind = ldSupportsCompactUnwind
161 , toolSettings_ldSupportsBuildId = ldSupportsBuildId
162 , toolSettings_ldSupportsFilelist = ldSupportsFilelist
163 , toolSettings_ldIsGnuLd = ldIsGnuLd
164 , toolSettings_ccSupportsNoPie = gccSupportsNoPie
165
166 , toolSettings_pgm_L = unlit_path
167 , toolSettings_pgm_P = (cpp_prog, cpp_args)
168 , toolSettings_pgm_F = ""
169 , toolSettings_pgm_c = cc_prog
170 , toolSettings_pgm_a = (as_prog, as_args)
171 , toolSettings_pgm_l = (ld_prog, ld_args)
172 , toolSettings_pgm_lm = (ld_r_prog, map Option $ words ld_r_args)
173 , toolSettings_pgm_dll = (mkdll_prog,mkdll_args)
174 , toolSettings_pgm_T = touch_path
175 , toolSettings_pgm_windres = windres_path
176 , toolSettings_pgm_libtool = libtool_path
177 , toolSettings_pgm_ar = ar_path
178 , toolSettings_pgm_otool = otool_path
179 , toolSettings_pgm_install_name_tool = install_name_tool_path
180 , toolSettings_pgm_ranlib = ranlib_path
181 , toolSettings_pgm_lo = (lo_prog,[])
182 , toolSettings_pgm_lc = (lc_prog,[])
183 , toolSettings_pgm_lcc = (lcc_prog,[])
184 , toolSettings_pgm_i = iserv_prog
185 , toolSettings_opt_L = []
186 , toolSettings_opt_P = []
187 , toolSettings_opt_P_fingerprint = fingerprint0
188 , toolSettings_opt_F = []
189 , toolSettings_opt_c = cc_args
190 , toolSettings_opt_cxx = cxx_args
191 , toolSettings_opt_a = []
192 , toolSettings_opt_l = []
193 , toolSettings_opt_lm = []
194 , toolSettings_opt_windres = []
195 , toolSettings_opt_lcc = []
196 , toolSettings_opt_lo = []
197 , toolSettings_opt_lc = []
198 , toolSettings_opt_i = []
199
200 , toolSettings_extraGccViaCFlags = words myExtraGccViaCFlags
201 }
202
203 , sTargetPlatform = platform
204 , sPlatformMisc = PlatformMisc
205 { platformMisc_targetPlatformString = targetPlatformString
206 , platformMisc_ghcWithInterpreter = ghcWithInterpreter
207 , platformMisc_libFFI = useLibFFI
208 , platformMisc_llvmTarget = llvmTarget
209 }
210
211 , sRawSettings = settingsList
212 }
213
214 getTargetPlatform
215 :: FilePath -- ^ Settings filepath (for error messages)
216 -> RawSettings -- ^ Raw settings file contents
217 -> Either String Platform
218 getTargetPlatform settingsFile settings = do
219 let
220 getBooleanSetting = getRawBooleanSetting settingsFile settings
221 readSetting :: (Show a, Read a) => String -> Either String a
222 readSetting = readRawSetting settingsFile settings
223
224 targetArchOS <- getTargetArchOS settingsFile settings
225 targetWordSize <- readSetting "target word size"
226 targetWordBigEndian <- getBooleanSetting "target word big endian"
227 targetLeadingUnderscore <- getBooleanSetting "Leading underscore"
228 targetUnregisterised <- getBooleanSetting "Unregisterised"
229 targetHasGnuNonexecStack <- getBooleanSetting "target has GNU nonexec stack"
230 targetHasIdentDirective <- getBooleanSetting "target has .ident directive"
231 targetHasSubsectionsViaSymbols <- getBooleanSetting "target has subsections via symbols"
232 targetHasLibm <- getBooleanSetting "target has libm"
233 crossCompiling <- getBooleanSetting "cross compiling"
234 tablesNextToCode <- getBooleanSetting "Tables next to code"
235
236 pure $ Platform
237 { platformArchOS = targetArchOS
238 , platformWordSize = targetWordSize
239 , platformByteOrder = if targetWordBigEndian then BigEndian else LittleEndian
240 , platformUnregisterised = targetUnregisterised
241 , platformHasGnuNonexecStack = targetHasGnuNonexecStack
242 , platformHasIdentDirective = targetHasIdentDirective
243 , platformHasSubsectionsViaSymbols = targetHasSubsectionsViaSymbols
244 , platformIsCrossCompiling = crossCompiling
245 , platformLeadingUnderscore = targetLeadingUnderscore
246 , platformTablesNextToCode = tablesNextToCode
247 , platformHasLibm = targetHasLibm
248 , platform_constants = Nothing -- will be filled later when loading (or building) the RTS unit
249 }