Use latin1 code page on Windows for response files.
[ghc.git] / compiler / main / SysTools.hs
1 {-
2 -----------------------------------------------------------------------------
3 --
4 -- (c) The University of Glasgow 2001-2003
5 --
6 -- Access to system tools: gcc, cp, rm etc
7 --
8 -----------------------------------------------------------------------------
9 -}
10
11 {-# LANGUAGE CPP, ScopedTypeVariables #-}
12
13 module SysTools (
14 -- Initialisation
15 initSysTools,
16
17 -- Interface to system tools
18 runUnlit, runCpp, runCc, -- [Option] -> IO ()
19 runPp, -- [Option] -> IO ()
20 runSplit, -- [Option] -> IO ()
21 runAs, runLink, runLibtool, -- [Option] -> IO ()
22 runMkDLL,
23 runWindres,
24 runLlvmOpt,
25 runLlvmLlc,
26 runClang,
27 figureLlvmVersion,
28
29 getLinkerInfo,
30 getCompilerInfo,
31
32 linkDynLib,
33
34 askCc,
35
36 touch, -- String -> String -> IO ()
37 copy,
38 copyWithHeader,
39
40 -- Temporary-file management
41 setTmpDir,
42 newTempName, newTempLibName,
43 cleanTempDirs, cleanTempFiles, cleanTempFilesExcept,
44 addFilesToClean,
45
46 Option(..),
47
48 -- frameworks
49 getPkgFrameworkOpts,
50 getFrameworkOpts
51
52
53 ) where
54
55 #include "HsVersions.h"
56
57 import DriverPhases
58 import Module
59 import Packages
60 import Config
61 import Outputable
62 import ErrUtils
63 import Panic
64 import Platform
65 import Util
66 import DynFlags
67 import Exception
68
69 import LlvmCodeGen.Base (llvmVersionStr, supportedLlvmVersion)
70
71 import Data.IORef
72 import Control.Monad
73 import System.Exit
74 import System.Environment
75 import System.FilePath
76 import System.IO
77 import System.IO.Error as IO
78 import System.Directory
79 import Data.Char
80 import Data.List
81 import qualified Data.Map as Map
82
83 #ifndef mingw32_HOST_OS
84 import qualified System.Posix.Internals
85 #else /* Must be Win32 */
86 import Foreign
87 import Foreign.C.String
88 import qualified System.Win32.Info as Info
89 import Control.Exception (finally)
90 import Foreign.Ptr (FunPtr, castPtrToFunPtr)
91 import System.Win32.Types (DWORD, LPTSTR, HANDLE)
92 import System.Win32.Types (failIfNull, failIf, iNVALID_HANDLE_VALUE)
93 import System.Win32.File (createFile,closeHandle, gENERIC_READ, fILE_SHARE_READ, oPEN_EXISTING, fILE_ATTRIBUTE_NORMAL, fILE_FLAG_BACKUP_SEMANTICS )
94 import System.Win32.DLL (loadLibrary, getProcAddress)
95 import Data.Bits((.|.))
96 #endif
97
98 import System.Process
99 import Control.Concurrent
100 import FastString
101 import SrcLoc ( SrcLoc, mkSrcLoc, noSrcSpan, mkSrcSpan )
102
103 #ifdef mingw32_HOST_OS
104 # if defined(i386_HOST_ARCH)
105 # define WINDOWS_CCONV stdcall
106 # elif defined(x86_64_HOST_ARCH)
107 # define WINDOWS_CCONV ccall
108 # else
109 # error Unknown mingw32 arch
110 # endif
111 #endif
112
113 {-
114 How GHC finds its files
115 ~~~~~~~~~~~~~~~~~~~~~~~
116
117 [Note topdir]
118
119 GHC needs various support files (library packages, RTS etc), plus
120 various auxiliary programs (cp, gcc, etc). It starts by finding topdir,
121 the root of GHC's support files
122
123 On Unix:
124 - ghc always has a shell wrapper that passes a -B<dir> option
125
126 On Windows:
127 - ghc never has a shell wrapper.
128 - we can find the location of the ghc binary, which is
129 $topdir/bin/<something>.exe
130 where <something> may be "ghc", "ghc-stage2", or similar
131 - we strip off the "bin/<something>.exe" to leave $topdir.
132
133 from topdir we can find package.conf, ghc-asm, etc.
134
135
136 SysTools.initSysProgs figures out exactly where all the auxiliary programs
137 are, and initialises mutable variables to make it easy to call them.
138 To to this, it makes use of definitions in Config.hs, which is a Haskell
139 file containing variables whose value is figured out by the build system.
140
141 Config.hs contains two sorts of things
142
143 cGCC, The *names* of the programs
144 cCPP e.g. cGCC = gcc
145 cUNLIT cCPP = gcc -E
146 etc They do *not* include paths
147
148
149 cUNLIT_DIR The *path* to the directory containing unlit, split etc
150 cSPLIT_DIR *relative* to the root of the build tree,
151 for use when running *in-place* in a build tree (only)
152
153
154
155 ---------------------------------------------
156 NOTES for an ALTERNATIVE scheme (i.e *not* what is currently implemented):
157
158 Another hair-brained scheme for simplifying the current tool location
159 nightmare in GHC: Simon originally suggested using another
160 configuration file along the lines of GCC's specs file - which is fine
161 except that it means adding code to read yet another configuration
162 file. What I didn't notice is that the current package.conf is
163 general enough to do this:
164
165 Package
166 {name = "tools", import_dirs = [], source_dirs = [],
167 library_dirs = [], hs_libraries = [], extra_libraries = [],
168 include_dirs = [], c_includes = [], package_deps = [],
169 extra_ghc_opts = ["-pgmc/usr/bin/gcc","-pgml${topdir}/bin/unlit", ... etc.],
170 extra_cc_opts = [], extra_ld_opts = []}
171
172 Which would have the advantage that we get to collect together in one
173 place the path-specific package stuff with the path-specific tool
174 stuff.
175 End of NOTES
176 ---------------------------------------------
177
178 ************************************************************************
179 * *
180 \subsection{Initialisation}
181 * *
182 ************************************************************************
183 -}
184
185 initSysTools :: Maybe String -- Maybe TopDir path (without the '-B' prefix)
186 -> IO Settings -- Set all the mutable variables above, holding
187 -- (a) the system programs
188 -- (b) the package-config file
189 -- (c) the GHC usage message
190 initSysTools mbMinusB
191 = do top_dir <- findTopDir mbMinusB
192 -- see [Note topdir]
193 -- NB: top_dir is assumed to be in standard Unix
194 -- format, '/' separated
195
196 let settingsFile = top_dir </> "settings"
197 platformConstantsFile = top_dir </> "platformConstants"
198 installed :: FilePath -> FilePath
199 installed file = top_dir </> file
200 libexec :: FilePath -> FilePath
201 libexec file = top_dir </> "bin" </> file
202
203 settingsStr <- readFile settingsFile
204 platformConstantsStr <- readFile platformConstantsFile
205 mySettings <- case maybeReadFuzzy settingsStr of
206 Just s ->
207 return s
208 Nothing ->
209 pgmError ("Can't parse " ++ show settingsFile)
210 platformConstants <- case maybeReadFuzzy platformConstantsStr of
211 Just s ->
212 return s
213 Nothing ->
214 pgmError ("Can't parse " ++
215 show platformConstantsFile)
216 let getSetting key = case lookup key mySettings of
217 Just xs ->
218 return $ case stripPrefix "$topdir" xs of
219 Just [] ->
220 top_dir
221 Just xs'@(c:_)
222 | isPathSeparator c ->
223 top_dir ++ xs'
224 _ ->
225 xs
226 Nothing -> pgmError ("No entry for " ++ show key ++ " in " ++ show settingsFile)
227 getBooleanSetting key = case lookup key mySettings of
228 Just "YES" -> return True
229 Just "NO" -> return False
230 Just xs -> pgmError ("Bad value for " ++ show key ++ ": " ++ show xs)
231 Nothing -> pgmError ("No entry for " ++ show key ++ " in " ++ show settingsFile)
232 readSetting key = case lookup key mySettings of
233 Just xs ->
234 case maybeRead xs of
235 Just v -> return v
236 Nothing -> pgmError ("Failed to read " ++ show key ++ " value " ++ show xs)
237 Nothing -> pgmError ("No entry for " ++ show key ++ " in " ++ show settingsFile)
238 crossCompiling <- getBooleanSetting "cross compiling"
239 targetArch <- readSetting "target arch"
240 targetOS <- readSetting "target os"
241 targetWordSize <- readSetting "target word size"
242 targetUnregisterised <- getBooleanSetting "Unregisterised"
243 targetHasGnuNonexecStack <- readSetting "target has GNU nonexec stack"
244 targetHasIdentDirective <- readSetting "target has .ident directive"
245 targetHasSubsectionsViaSymbols <- readSetting "target has subsections via symbols"
246 myExtraGccViaCFlags <- getSetting "GCC extra via C opts"
247 -- On Windows, mingw is distributed with GHC,
248 -- so we look in TopDir/../mingw/bin
249 -- It would perhaps be nice to be able to override this
250 -- with the settings file, but it would be a little fiddly
251 -- to make that possible, so for now you can't.
252 gcc_prog <- getSetting "C compiler command"
253 gcc_args_str <- getSetting "C compiler flags"
254 gccSupportsNoPie <- getBooleanSetting "C compiler supports -no-pie"
255 cpp_prog <- getSetting "Haskell CPP command"
256 cpp_args_str <- getSetting "Haskell CPP flags"
257 let unreg_gcc_args = if targetUnregisterised
258 then ["-DNO_REGS", "-DUSE_MINIINTERPRETER"]
259 else []
260 -- TABLES_NEXT_TO_CODE affects the info table layout.
261 tntc_gcc_args
262 | mkTablesNextToCode targetUnregisterised
263 = ["-DTABLES_NEXT_TO_CODE"]
264 | otherwise = []
265 cpp_args= map Option (words cpp_args_str)
266 gcc_args = map Option (words gcc_args_str
267 ++ unreg_gcc_args
268 ++ tntc_gcc_args)
269 ldSupportsCompactUnwind <- getBooleanSetting "ld supports compact unwind"
270 ldSupportsBuildId <- getBooleanSetting "ld supports build-id"
271 ldSupportsFilelist <- getBooleanSetting "ld supports filelist"
272 ldIsGnuLd <- getBooleanSetting "ld is GNU ld"
273 perl_path <- getSetting "perl command"
274
275 let pkgconfig_path = installed "package.conf.d"
276 ghc_usage_msg_path = installed "ghc-usage.txt"
277 ghci_usage_msg_path = installed "ghci-usage.txt"
278
279 -- For all systems, unlit, split, mangle are GHC utilities
280 -- architecture-specific stuff is done when building Config.hs
281 unlit_path = libexec cGHC_UNLIT_PGM
282
283 -- split is a Perl script
284 split_script = libexec cGHC_SPLIT_PGM
285
286 windres_path <- getSetting "windres command"
287 libtool_path <- getSetting "libtool command"
288
289 tmpdir <- getTemporaryDirectory
290
291 touch_path <- getSetting "touch command"
292
293 let -- On Win32 we don't want to rely on #!/bin/perl, so we prepend
294 -- a call to Perl to get the invocation of split.
295 -- On Unix, scripts are invoked using the '#!' method. Binary
296 -- installations of GHC on Unix place the correct line on the
297 -- front of the script at installation time, so we don't want
298 -- to wire-in our knowledge of $(PERL) on the host system here.
299 (split_prog, split_args)
300 | isWindowsHost = (perl_path, [Option split_script])
301 | otherwise = (split_script, [])
302 mkdll_prog <- getSetting "dllwrap command"
303 let mkdll_args = []
304
305 -- cpp is derived from gcc on all platforms
306 -- HACK, see setPgmP below. We keep 'words' here to remember to fix
307 -- Config.hs one day.
308
309
310 -- Other things being equal, as and ld are simply gcc
311 gcc_link_args_str <- getSetting "C compiler link flags"
312 let as_prog = gcc_prog
313 as_args = gcc_args
314 ld_prog = gcc_prog
315 ld_args = gcc_args ++ map Option (words gcc_link_args_str)
316
317 -- We just assume on command line
318 lc_prog <- getSetting "LLVM llc command"
319 lo_prog <- getSetting "LLVM opt command"
320
321 let iserv_prog = libexec "ghc-iserv"
322
323 let platform = Platform {
324 platformArch = targetArch,
325 platformOS = targetOS,
326 platformWordSize = targetWordSize,
327 platformUnregisterised = targetUnregisterised,
328 platformHasGnuNonexecStack = targetHasGnuNonexecStack,
329 platformHasIdentDirective = targetHasIdentDirective,
330 platformHasSubsectionsViaSymbols = targetHasSubsectionsViaSymbols,
331 platformIsCrossCompiling = crossCompiling
332 }
333
334 return $ Settings {
335 sTargetPlatform = platform,
336 sTmpDir = normalise tmpdir,
337 sGhcUsagePath = ghc_usage_msg_path,
338 sGhciUsagePath = ghci_usage_msg_path,
339 sTopDir = top_dir,
340 sRawSettings = mySettings,
341 sExtraGccViaCFlags = words myExtraGccViaCFlags,
342 sSystemPackageConfig = pkgconfig_path,
343 sLdSupportsCompactUnwind = ldSupportsCompactUnwind,
344 sLdSupportsBuildId = ldSupportsBuildId,
345 sLdSupportsFilelist = ldSupportsFilelist,
346 sLdIsGnuLd = ldIsGnuLd,
347 sGccSupportsNoPie = gccSupportsNoPie,
348 sProgramName = "ghc",
349 sProjectVersion = cProjectVersion,
350 sPgm_L = unlit_path,
351 sPgm_P = (cpp_prog, cpp_args),
352 sPgm_F = "",
353 sPgm_c = (gcc_prog, gcc_args),
354 sPgm_s = (split_prog,split_args),
355 sPgm_a = (as_prog, as_args),
356 sPgm_l = (ld_prog, ld_args),
357 sPgm_dll = (mkdll_prog,mkdll_args),
358 sPgm_T = touch_path,
359 sPgm_windres = windres_path,
360 sPgm_libtool = libtool_path,
361 sPgm_lo = (lo_prog,[]),
362 sPgm_lc = (lc_prog,[]),
363 sPgm_i = iserv_prog,
364 sOpt_L = [],
365 sOpt_P = [],
366 sOpt_F = [],
367 sOpt_c = [],
368 sOpt_a = [],
369 sOpt_l = [],
370 sOpt_windres = [],
371 sOpt_lo = [],
372 sOpt_lc = [],
373 sOpt_i = [],
374 sPlatformConstants = platformConstants
375 }
376
377 -- returns a Unix-format path (relying on getBaseDir to do so too)
378 findTopDir :: Maybe String -- Maybe TopDir path (without the '-B' prefix).
379 -> IO String -- TopDir (in Unix format '/' separated)
380 findTopDir (Just minusb) = return (normalise minusb)
381 findTopDir Nothing
382 = do -- Get directory of executable
383 maybe_exec_dir <- getBaseDir
384 case maybe_exec_dir of
385 -- "Just" on Windows, "Nothing" on unix
386 Nothing -> throwGhcExceptionIO (InstallationError "missing -B<dir> option")
387 Just dir -> return dir
388
389 {-
390 ************************************************************************
391 * *
392 \subsection{Running an external program}
393 * *
394 ************************************************************************
395 -}
396
397 runUnlit :: DynFlags -> [Option] -> IO ()
398 runUnlit dflags args = do
399 let prog = pgm_L dflags
400 opts = getOpts dflags opt_L
401 runSomething dflags "Literate pre-processor" prog
402 (map Option opts ++ args)
403
404 runCpp :: DynFlags -> [Option] -> IO ()
405 runCpp dflags args = do
406 let (p,args0) = pgm_P dflags
407 args1 = map Option (getOpts dflags opt_P)
408 args2 = [Option "-Werror" | gopt Opt_WarnIsError dflags]
409 ++ [Option "-Wundef" | wopt Opt_WarnCPPUndef dflags]
410 mb_env <- getGccEnv args2
411 runSomethingFiltered dflags id "C pre-processor" p
412 (args0 ++ args1 ++ args2 ++ args) mb_env
413
414 runPp :: DynFlags -> [Option] -> IO ()
415 runPp dflags args = do
416 let prog = pgm_F dflags
417 opts = map Option (getOpts dflags opt_F)
418 runSomething dflags "Haskell pre-processor" prog (args ++ opts)
419
420 runCc :: DynFlags -> [Option] -> IO ()
421 runCc dflags args = do
422 let (p,args0) = pgm_c dflags
423 args1 = map Option (getOpts dflags opt_c)
424 args2 = args0 ++ args1 ++ args
425 mb_env <- getGccEnv args2
426 runSomethingResponseFile dflags cc_filter "C Compiler" p args2 mb_env
427 where
428 -- discard some harmless warnings from gcc that we can't turn off
429 cc_filter = unlines . doFilter . lines
430
431 {-
432 gcc gives warnings in chunks like so:
433 In file included from /foo/bar/baz.h:11,
434 from /foo/bar/baz2.h:22,
435 from wibble.c:33:
436 /foo/flibble:14: global register variable ...
437 /foo/flibble:15: warning: call-clobbered r...
438 We break it up into its chunks, remove any call-clobbered register
439 warnings from each chunk, and then delete any chunks that we have
440 emptied of warnings.
441 -}
442 doFilter = unChunkWarnings . filterWarnings . chunkWarnings []
443 -- We can't assume that the output will start with an "In file inc..."
444 -- line, so we start off expecting a list of warnings rather than a
445 -- location stack.
446 chunkWarnings :: [String] -- The location stack to use for the next
447 -- list of warnings
448 -> [String] -- The remaining lines to look at
449 -> [([String], [String])]
450 chunkWarnings loc_stack [] = [(loc_stack, [])]
451 chunkWarnings loc_stack xs
452 = case break loc_stack_start xs of
453 (warnings, lss:xs') ->
454 case span loc_start_continuation xs' of
455 (lsc, xs'') ->
456 (loc_stack, warnings) : chunkWarnings (lss : lsc) xs''
457 _ -> [(loc_stack, xs)]
458
459 filterWarnings :: [([String], [String])] -> [([String], [String])]
460 filterWarnings [] = []
461 -- If the warnings are already empty then we are probably doing
462 -- something wrong, so don't delete anything
463 filterWarnings ((xs, []) : zs) = (xs, []) : filterWarnings zs
464 filterWarnings ((xs, ys) : zs) = case filter wantedWarning ys of
465 [] -> filterWarnings zs
466 ys' -> (xs, ys') : filterWarnings zs
467
468 unChunkWarnings :: [([String], [String])] -> [String]
469 unChunkWarnings [] = []
470 unChunkWarnings ((xs, ys) : zs) = xs ++ ys ++ unChunkWarnings zs
471
472 loc_stack_start s = "In file included from " `isPrefixOf` s
473 loc_start_continuation s = " from " `isPrefixOf` s
474 wantedWarning w
475 | "warning: call-clobbered register used" `isContainedIn` w = False
476 | otherwise = True
477
478 isContainedIn :: String -> String -> Bool
479 xs `isContainedIn` ys = any (xs `isPrefixOf`) (tails ys)
480
481 askCc :: DynFlags -> [Option] -> IO String
482 askCc dflags args = do
483 let (p,args0) = pgm_c dflags
484 args1 = map Option (getOpts dflags opt_c)
485 args2 = args0 ++ args1 ++ args
486 mb_env <- getGccEnv args2
487 runSomethingWith dflags "gcc" p args2 $ \real_args ->
488 readCreateProcessWithExitCode' (proc p real_args){ env = mb_env }
489
490 -- Similar to System.Process.readCreateProcessWithExitCode, but stderr is
491 -- inherited from the parent process, and output to stderr is not captured.
492 readCreateProcessWithExitCode'
493 :: CreateProcess
494 -> IO (ExitCode, String) -- ^ stdout
495 readCreateProcessWithExitCode' proc = do
496 (_, Just outh, _, pid) <-
497 createProcess proc{ std_out = CreatePipe }
498
499 -- fork off a thread to start consuming the output
500 output <- hGetContents outh
501 outMVar <- newEmptyMVar
502 _ <- forkIO $ evaluate (length output) >> putMVar outMVar ()
503
504 -- wait on the output
505 takeMVar outMVar
506 hClose outh
507
508 -- wait on the process
509 ex <- waitForProcess pid
510
511 return (ex, output)
512
513 replaceVar :: (String, String) -> [(String, String)] -> [(String, String)]
514 replaceVar (var, value) env =
515 (var, value) : filter (\(var',_) -> var /= var') env
516
517 -- | Version of @System.Process.readProcessWithExitCode@ that takes a
518 -- key-value tuple to insert into the environment.
519 readProcessEnvWithExitCode
520 :: String -- ^ program path
521 -> [String] -- ^ program args
522 -> (String, String) -- ^ addition to the environment
523 -> IO (ExitCode, String, String) -- ^ (exit_code, stdout, stderr)
524 readProcessEnvWithExitCode prog args env_update = do
525 current_env <- getEnvironment
526 readCreateProcessWithExitCode (proc prog args) {
527 env = Just (replaceVar env_update current_env) } ""
528
529 -- Don't let gcc localize version info string, #8825
530 c_locale_env :: (String, String)
531 c_locale_env = ("LANGUAGE", "C")
532
533 -- If the -B<dir> option is set, add <dir> to PATH. This works around
534 -- a bug in gcc on Windows Vista where it can't find its auxiliary
535 -- binaries (see bug #1110).
536 getGccEnv :: [Option] -> IO (Maybe [(String,String)])
537 getGccEnv opts =
538 if null b_dirs
539 then return Nothing
540 else do env <- getEnvironment
541 return (Just (map mangle_path env))
542 where
543 (b_dirs, _) = partitionWith get_b_opt opts
544
545 get_b_opt (Option ('-':'B':dir)) = Left dir
546 get_b_opt other = Right other
547
548 mangle_path (path,paths) | map toUpper path == "PATH"
549 = (path, '\"' : head b_dirs ++ "\";" ++ paths)
550 mangle_path other = other
551
552 runSplit :: DynFlags -> [Option] -> IO ()
553 runSplit dflags args = do
554 let (p,args0) = pgm_s dflags
555 runSomething dflags "Splitter" p (args0++args)
556
557 runAs :: DynFlags -> [Option] -> IO ()
558 runAs dflags args = do
559 let (p,args0) = pgm_a dflags
560 args1 = map Option (getOpts dflags opt_a)
561 args2 = args0 ++ args1 ++ args
562 mb_env <- getGccEnv args2
563 runSomethingFiltered dflags id "Assembler" p args2 mb_env
564
565 -- | Run the LLVM Optimiser
566 runLlvmOpt :: DynFlags -> [Option] -> IO ()
567 runLlvmOpt dflags args = do
568 let (p,args0) = pgm_lo dflags
569 args1 = map Option (getOpts dflags opt_lo)
570 runSomething dflags "LLVM Optimiser" p (args0 ++ args1 ++ args)
571
572 -- | Run the LLVM Compiler
573 runLlvmLlc :: DynFlags -> [Option] -> IO ()
574 runLlvmLlc dflags args = do
575 let (p,args0) = pgm_lc dflags
576 args1 = map Option (getOpts dflags opt_lc)
577 runSomething dflags "LLVM Compiler" p (args0 ++ args1 ++ args)
578
579 -- | Run the clang compiler (used as an assembler for the LLVM
580 -- backend on OS X as LLVM doesn't support the OS X system
581 -- assembler)
582 runClang :: DynFlags -> [Option] -> IO ()
583 runClang dflags args = do
584 -- we simply assume its available on the PATH
585 let clang = "clang"
586 -- be careful what options we call clang with
587 -- see #5903 and #7617 for bugs caused by this.
588 (_,args0) = pgm_a dflags
589 args1 = map Option (getOpts dflags opt_a)
590 args2 = args0 ++ args1 ++ args
591 mb_env <- getGccEnv args2
592 Exception.catch (do
593 runSomethingFiltered dflags id "Clang (Assembler)" clang args2 mb_env
594 )
595 (\(err :: SomeException) -> do
596 errorMsg dflags $
597 text ("Error running clang! you need clang installed to use the" ++
598 " LLVM backend") $+$
599 text "(or GHC tried to execute clang incorrectly)"
600 throwIO err
601 )
602
603 -- | Figure out which version of LLVM we are running this session
604 figureLlvmVersion :: DynFlags -> IO (Maybe (Int, Int))
605 figureLlvmVersion dflags = do
606 let (pgm,opts) = pgm_lc dflags
607 args = filter notNull (map showOpt opts)
608 -- we grab the args even though they should be useless just in
609 -- case the user is using a customised 'llc' that requires some
610 -- of the options they've specified. llc doesn't care what other
611 -- options are specified when '-version' is used.
612 args' = args ++ ["-version"]
613 ver <- catchIO (do
614 (pin, pout, perr, _) <- runInteractiveProcess pgm args'
615 Nothing Nothing
616 {- > llc -version
617 LLVM (http://llvm.org/):
618 LLVM version 3.5.2
619 ...
620 -}
621 hSetBinaryMode pout False
622 _ <- hGetLine pout
623 vline <- dropWhile (not . isDigit) `fmap` hGetLine pout
624 v <- case span (/= '.') vline of
625 ("",_) -> fail "no digits!"
626 (x,y) -> return (read x
627 , read $ takeWhile isDigit $ drop 1 y)
628
629 hClose pin
630 hClose pout
631 hClose perr
632 return $ Just v
633 )
634 (\err -> do
635 debugTraceMsg dflags 2
636 (text "Error (figuring out LLVM version):" <+>
637 text (show err))
638 errorMsg dflags $ vcat
639 [ text "Warning:", nest 9 $
640 text "Couldn't figure out LLVM version!" $$
641 text ("Make sure you have installed LLVM " ++
642 llvmVersionStr supportedLlvmVersion) ]
643 return Nothing)
644 return ver
645
646 {- Note [Windows stack usage]
647
648 See: Trac #8870 (and #8834 for related info) and #12186
649
650 On Windows, occasionally we need to grow the stack. In order to do
651 this, we would normally just bump the stack pointer - but there's a
652 catch on Windows.
653
654 If the stack pointer is bumped by more than a single page, then the
655 pages between the initial pointer and the resulting location must be
656 properly committed by the Windows virtual memory subsystem. This is
657 only needed in the event we bump by more than one page (i.e 4097 bytes
658 or more).
659
660 Windows compilers solve this by emitting a call to a special function
661 called _chkstk, which does this committing of the pages for you.
662
663 The reason this was causing a segfault was because due to the fact the
664 new code generator tends to generate larger functions, we needed more
665 stack space in GHC itself. In the x86 codegen, we needed approximately
666 ~12kb of stack space in one go, which caused the process to segfault,
667 as the intervening pages were not committed.
668
669 GCC can emit such a check for us automatically but only when the flag
670 -fstack-check is used.
671
672 See https://gcc.gnu.org/onlinedocs/gnat_ugn/Stack-Overflow-Checking.html
673 for more information.
674
675 -}
676
677 {- Note [Run-time linker info]
678
679 See also: Trac #5240, Trac #6063, Trac #10110
680
681 Before 'runLink', we need to be sure to get the relevant information
682 about the linker we're using at runtime to see if we need any extra
683 options. For example, GNU ld requires '--reduce-memory-overheads' and
684 '--hash-size=31' in order to use reasonable amounts of memory (see
685 trac #5240.) But this isn't supported in GNU gold.
686
687 Generally, the linker changing from what was detected at ./configure
688 time has always been possible using -pgml, but on Linux it can happen
689 'transparently' by installing packages like binutils-gold, which
690 change what /usr/bin/ld actually points to.
691
692 Clang vs GCC notes:
693
694 For gcc, 'gcc -Wl,--version' gives a bunch of output about how to
695 invoke the linker before the version information string. For 'clang',
696 the version information for 'ld' is all that's output. For this
697 reason, we typically need to slurp up all of the standard error output
698 and look through it.
699
700 Other notes:
701
702 We cache the LinkerInfo inside DynFlags, since clients may link
703 multiple times. The definition of LinkerInfo is there to avoid a
704 circular dependency.
705
706 -}
707
708 {- Note [ELF needed shared libs]
709
710 Some distributions change the link editor's default handling of
711 ELF DT_NEEDED tags to include only those shared objects that are
712 needed to resolve undefined symbols. For Template Haskell we need
713 the last temporary shared library also if it is not needed for the
714 currently linked temporary shared library. We specify --no-as-needed
715 to override the default. This flag exists in GNU ld and GNU gold.
716
717 The flag is only needed on ELF systems. On Windows (PE) and Mac OS X
718 (Mach-O) the flag is not needed.
719
720 -}
721
722 {- Note [Windows static libGCC]
723
724 The GCC versions being upgraded to in #10726 are configured with
725 dynamic linking of libgcc supported. This results in libgcc being
726 linked dynamically when a shared library is created.
727
728 This introduces thus an extra dependency on GCC dll that was not
729 needed before by shared libraries created with GHC. This is a particular
730 issue on Windows because you get a non-obvious error due to this missing
731 dependency. This dependent dll is also not commonly on your path.
732
733 For this reason using the static libgcc is preferred as it preserves
734 the same behaviour that existed before. There are however some very good
735 reasons to have the shared version as well as described on page 181 of
736 https://gcc.gnu.org/onlinedocs/gcc-5.2.0/gcc.pdf :
737
738 "There are several situations in which an application should use the
739 shared ‘libgcc’ instead of the static version. The most common of these
740 is when the application wishes to throw and catch exceptions across different
741 shared libraries. In that case, each of the libraries as well as the application
742 itself should use the shared ‘libgcc’. "
743
744 -}
745
746 neededLinkArgs :: LinkerInfo -> [Option]
747 neededLinkArgs (GnuLD o) = o
748 neededLinkArgs (GnuGold o) = o
749 neededLinkArgs (DarwinLD o) = o
750 neededLinkArgs (SolarisLD o) = o
751 neededLinkArgs (AixLD o) = o
752 neededLinkArgs UnknownLD = []
753
754 -- Grab linker info and cache it in DynFlags.
755 getLinkerInfo :: DynFlags -> IO LinkerInfo
756 getLinkerInfo dflags = do
757 info <- readIORef (rtldInfo dflags)
758 case info of
759 Just v -> return v
760 Nothing -> do
761 v <- getLinkerInfo' dflags
762 writeIORef (rtldInfo dflags) (Just v)
763 return v
764
765 -- See Note [Run-time linker info].
766 getLinkerInfo' :: DynFlags -> IO LinkerInfo
767 getLinkerInfo' dflags = do
768 let platform = targetPlatform dflags
769 os = platformOS platform
770 (pgm,args0) = pgm_l dflags
771 args1 = map Option (getOpts dflags opt_l)
772 args2 = args0 ++ args1
773 args3 = filter notNull (map showOpt args2)
774
775 -- Try to grab the info from the process output.
776 parseLinkerInfo stdo _stde _exitc
777 | any ("GNU ld" `isPrefixOf`) stdo =
778 -- GNU ld specifically needs to use less memory. This especially
779 -- hurts on small object files. Trac #5240.
780 -- Set DT_NEEDED for all shared libraries. Trac #10110.
781 -- TODO: Investigate if these help or hurt when using split sections.
782 return (GnuLD $ map Option ["-Wl,--hash-size=31",
783 "-Wl,--reduce-memory-overheads",
784 -- ELF specific flag
785 -- see Note [ELF needed shared libs]
786 "-Wl,--no-as-needed"])
787
788 | any ("GNU gold" `isPrefixOf`) stdo =
789 -- GNU gold only needs --no-as-needed. Trac #10110.
790 -- ELF specific flag, see Note [ELF needed shared libs]
791 return (GnuGold [Option "-Wl,--no-as-needed"])
792
793 -- Unknown linker.
794 | otherwise = fail "invalid --version output, or linker is unsupported"
795
796 -- Process the executable call
797 info <- catchIO (do
798 case os of
799 OSSolaris2 ->
800 -- Solaris uses its own Solaris linker. Even all
801 -- GNU C are recommended to configure with Solaris
802 -- linker instead of using GNU binutils linker. Also
803 -- all GCC distributed with Solaris follows this rule
804 -- precisely so we assume here, the Solaris linker is
805 -- used.
806 return $ SolarisLD []
807 OSAIX ->
808 -- IBM AIX uses its own non-binutils linker as well
809 return $ AixLD []
810 OSDarwin ->
811 -- Darwin has neither GNU Gold or GNU LD, but a strange linker
812 -- that doesn't support --version. We can just assume that's
813 -- what we're using.
814 return $ DarwinLD []
815 OSiOS ->
816 -- Ditto for iOS
817 return $ DarwinLD []
818 OSMinGW32 ->
819 -- GHC doesn't support anything but GNU ld on Windows anyway.
820 -- Process creation is also fairly expensive on win32, so
821 -- we short-circuit here.
822 return $ GnuLD $ map Option
823 [ -- Reduce ld memory usage
824 "-Wl,--hash-size=31"
825 , "-Wl,--reduce-memory-overheads"
826 -- Emit gcc stack checks
827 -- Note [Windows stack usage]
828 , "-fstack-check"
829 -- Force static linking of libGCC
830 -- Note [Windows static libGCC]
831 , "-static-libgcc" ]
832 _ -> do
833 -- In practice, we use the compiler as the linker here. Pass
834 -- -Wl,--version to get linker version info.
835 (exitc, stdo, stde) <- readProcessEnvWithExitCode pgm
836 (["-Wl,--version"] ++ args3)
837 c_locale_env
838 -- Split the output by lines to make certain kinds
839 -- of processing easier. In particular, 'clang' and 'gcc'
840 -- have slightly different outputs for '-Wl,--version', but
841 -- it's still easy to figure out.
842 parseLinkerInfo (lines stdo) (lines stde) exitc
843 )
844 (\err -> do
845 debugTraceMsg dflags 2
846 (text "Error (figuring out linker information):" <+>
847 text (show err))
848 errorMsg dflags $ hang (text "Warning:") 9 $
849 text "Couldn't figure out linker information!" $$
850 text "Make sure you're using GNU ld, GNU gold" <+>
851 text "or the built in OS X linker, etc."
852 return UnknownLD)
853 return info
854
855 -- Grab compiler info and cache it in DynFlags.
856 getCompilerInfo :: DynFlags -> IO CompilerInfo
857 getCompilerInfo dflags = do
858 info <- readIORef (rtccInfo dflags)
859 case info of
860 Just v -> return v
861 Nothing -> do
862 v <- getCompilerInfo' dflags
863 writeIORef (rtccInfo dflags) (Just v)
864 return v
865
866 -- See Note [Run-time linker info].
867 getCompilerInfo' :: DynFlags -> IO CompilerInfo
868 getCompilerInfo' dflags = do
869 let (pgm,_) = pgm_c dflags
870 -- Try to grab the info from the process output.
871 parseCompilerInfo _stdo stde _exitc
872 -- Regular GCC
873 | any ("gcc version" `isInfixOf`) stde =
874 return GCC
875 -- Regular clang
876 | any ("clang version" `isInfixOf`) stde =
877 return Clang
878 -- XCode 5.1 clang
879 | any ("Apple LLVM version 5.1" `isPrefixOf`) stde =
880 return AppleClang51
881 -- XCode 5 clang
882 | any ("Apple LLVM version" `isPrefixOf`) stde =
883 return AppleClang
884 -- XCode 4.1 clang
885 | any ("Apple clang version" `isPrefixOf`) stde =
886 return AppleClang
887 -- Unknown linker.
888 | otherwise = fail "invalid -v output, or compiler is unsupported"
889
890 -- Process the executable call
891 info <- catchIO (do
892 (exitc, stdo, stde) <-
893 readProcessEnvWithExitCode pgm ["-v"] c_locale_env
894 -- Split the output by lines to make certain kinds
895 -- of processing easier.
896 parseCompilerInfo (lines stdo) (lines stde) exitc
897 )
898 (\err -> do
899 debugTraceMsg dflags 2
900 (text "Error (figuring out C compiler information):" <+>
901 text (show err))
902 errorMsg dflags $ hang (text "Warning:") 9 $
903 text "Couldn't figure out C compiler information!" $$
904 text "Make sure you're using GNU gcc, or clang"
905 return UnknownCC)
906 return info
907
908 runLink :: DynFlags -> [Option] -> IO ()
909 runLink dflags args = do
910 -- See Note [Run-time linker info]
911 linkargs <- neededLinkArgs `fmap` getLinkerInfo dflags
912 let (p,args0) = pgm_l dflags
913 args1 = map Option (getOpts dflags opt_l)
914 args2 = args0 ++ linkargs ++ args1 ++ args
915 mb_env <- getGccEnv args2
916 runSomethingResponseFile dflags ld_filter "Linker" p args2 mb_env
917 where
918 ld_filter = case (platformOS (targetPlatform dflags)) of
919 OSSolaris2 -> sunos_ld_filter
920 _ -> id
921 {-
922 SunOS/Solaris ld emits harmless warning messages about unresolved
923 symbols in case of compiling into shared library when we do not
924 link against all the required libs. That is the case of GHC which
925 does not link against RTS library explicitly in order to be able to
926 choose the library later based on binary application linking
927 parameters. The warnings look like:
928
929 Undefined first referenced
930 symbol in file
931 stg_ap_n_fast ./T2386_Lib.o
932 stg_upd_frame_info ./T2386_Lib.o
933 templatezmhaskell_LanguageziHaskellziTHziLib_litE_closure ./T2386_Lib.o
934 templatezmhaskell_LanguageziHaskellziTHziLib_appE_closure ./T2386_Lib.o
935 templatezmhaskell_LanguageziHaskellziTHziLib_conE_closure ./T2386_Lib.o
936 templatezmhaskell_LanguageziHaskellziTHziSyntax_mkNameGzud_closure ./T2386_Lib.o
937 newCAF ./T2386_Lib.o
938 stg_bh_upd_frame_info ./T2386_Lib.o
939 stg_ap_ppp_fast ./T2386_Lib.o
940 templatezmhaskell_LanguageziHaskellziTHziLib_stringL_closure ./T2386_Lib.o
941 stg_ap_p_fast ./T2386_Lib.o
942 stg_ap_pp_fast ./T2386_Lib.o
943 ld: warning: symbol referencing errors
944
945 this is actually coming from T2386 testcase. The emitting of those
946 warnings is also a reason why so many TH testcases fail on Solaris.
947
948 Following filter code is SunOS/Solaris linker specific and should
949 filter out only linker warnings. Please note that the logic is a
950 little bit more complex due to the simple reason that we need to preserve
951 any other linker emitted messages. If there are any. Simply speaking
952 if we see "Undefined" and later "ld: warning:..." then we omit all
953 text between (including) the marks. Otherwise we copy the whole output.
954 -}
955 sunos_ld_filter :: String -> String
956 sunos_ld_filter = unlines . sunos_ld_filter' . lines
957 sunos_ld_filter' x = if (undefined_found x && ld_warning_found x)
958 then (ld_prefix x) ++ (ld_postfix x)
959 else x
960 breakStartsWith x y = break (isPrefixOf x) y
961 ld_prefix = fst . breakStartsWith "Undefined"
962 undefined_found = not . null . snd . breakStartsWith "Undefined"
963 ld_warn_break = breakStartsWith "ld: warning: symbol referencing errors"
964 ld_postfix = tail . snd . ld_warn_break
965 ld_warning_found = not . null . snd . ld_warn_break
966
967
968 runLibtool :: DynFlags -> [Option] -> IO ()
969 runLibtool dflags args = do
970 linkargs <- neededLinkArgs `fmap` getLinkerInfo dflags
971 let args1 = map Option (getOpts dflags opt_l)
972 args2 = [Option "-static"] ++ args1 ++ args ++ linkargs
973 libtool = pgm_libtool dflags
974 mb_env <- getGccEnv args2
975 runSomethingFiltered dflags id "Linker" libtool args2 mb_env
976
977 runMkDLL :: DynFlags -> [Option] -> IO ()
978 runMkDLL dflags args = do
979 let (p,args0) = pgm_dll dflags
980 args1 = args0 ++ args
981 mb_env <- getGccEnv (args0++args)
982 runSomethingFiltered dflags id "Make DLL" p args1 mb_env
983
984 runWindres :: DynFlags -> [Option] -> IO ()
985 runWindres dflags args = do
986 let (gcc, gcc_args) = pgm_c dflags
987 windres = pgm_windres dflags
988 opts = map Option (getOpts dflags opt_windres)
989 quote x = "\"" ++ x ++ "\""
990 args' = -- If windres.exe and gcc.exe are in a directory containing
991 -- spaces then windres fails to run gcc. We therefore need
992 -- to tell it what command to use...
993 Option ("--preprocessor=" ++
994 unwords (map quote (gcc :
995 map showOpt gcc_args ++
996 map showOpt opts ++
997 ["-E", "-xc", "-DRC_INVOKED"])))
998 -- ...but if we do that then if windres calls popen then
999 -- it can't understand the quoting, so we have to use
1000 -- --use-temp-file so that it interprets it correctly.
1001 -- See #1828.
1002 : Option "--use-temp-file"
1003 : args
1004 mb_env <- getGccEnv gcc_args
1005 runSomethingFiltered dflags id "Windres" windres args' mb_env
1006
1007 touch :: DynFlags -> String -> String -> IO ()
1008 touch dflags purpose arg =
1009 runSomething dflags purpose (pgm_T dflags) [FileOption "" arg]
1010
1011 copy :: DynFlags -> String -> FilePath -> FilePath -> IO ()
1012 copy dflags purpose from to = copyWithHeader dflags purpose Nothing from to
1013
1014 copyWithHeader :: DynFlags -> String -> Maybe String -> FilePath -> FilePath
1015 -> IO ()
1016 copyWithHeader dflags purpose maybe_header from to = do
1017 showPass dflags purpose
1018
1019 hout <- openBinaryFile to WriteMode
1020 hin <- openBinaryFile from ReadMode
1021 ls <- hGetContents hin -- inefficient, but it'll do for now. ToDo: speed up
1022 maybe (return ()) (header hout) maybe_header
1023 hPutStr hout ls
1024 hClose hout
1025 hClose hin
1026 where
1027 -- write the header string in UTF-8. The header is something like
1028 -- {-# LINE "foo.hs" #-}
1029 -- and we want to make sure a Unicode filename isn't mangled.
1030 header h str = do
1031 hSetEncoding h utf8
1032 hPutStr h str
1033 hSetBinaryMode h True
1034
1035
1036
1037 {-
1038 ************************************************************************
1039 * *
1040 \subsection{Managing temporary files
1041 * *
1042 ************************************************************************
1043 -}
1044
1045 cleanTempDirs :: DynFlags -> IO ()
1046 cleanTempDirs dflags
1047 = unless (gopt Opt_KeepTmpFiles dflags)
1048 $ mask_
1049 $ do let ref = dirsToClean dflags
1050 ds <- atomicModifyIORef' ref $ \ds -> (Map.empty, ds)
1051 removeTmpDirs dflags (Map.elems ds)
1052
1053 cleanTempFiles :: DynFlags -> IO ()
1054 cleanTempFiles dflags
1055 = unless (gopt Opt_KeepTmpFiles dflags)
1056 $ mask_
1057 $ do let ref = filesToClean dflags
1058 fs <- atomicModifyIORef' ref $ \fs -> ([],fs)
1059 removeTmpFiles dflags fs
1060
1061 cleanTempFilesExcept :: DynFlags -> [FilePath] -> IO ()
1062 cleanTempFilesExcept dflags dont_delete
1063 = unless (gopt Opt_KeepTmpFiles dflags)
1064 $ mask_
1065 $ do let ref = filesToClean dflags
1066 to_delete <- atomicModifyIORef' ref $ \files ->
1067 let (to_keep,to_delete) = partition (`elem` dont_delete) files
1068 in (to_keep,to_delete)
1069 removeTmpFiles dflags to_delete
1070
1071
1072 -- Return a unique numeric temp file suffix
1073 newTempSuffix :: DynFlags -> IO Int
1074 newTempSuffix dflags = atomicModifyIORef' (nextTempSuffix dflags) $ \n -> (n+1,n)
1075
1076 -- Find a temporary name that doesn't already exist.
1077 newTempName :: DynFlags -> Suffix -> IO FilePath
1078 newTempName dflags extn
1079 = do d <- getTempDir dflags
1080 findTempName (d </> "ghc_") -- See Note [Deterministic base name]
1081 where
1082 findTempName :: FilePath -> IO FilePath
1083 findTempName prefix
1084 = do n <- newTempSuffix dflags
1085 let filename = prefix ++ show n <.> extn
1086 b <- doesFileExist filename
1087 if b then findTempName prefix
1088 else do -- clean it up later
1089 consIORef (filesToClean dflags) filename
1090 return filename
1091
1092 newTempLibName :: DynFlags -> Suffix -> IO (FilePath, FilePath, String)
1093 newTempLibName dflags extn
1094 = do d <- getTempDir dflags
1095 findTempName d ("ghc_")
1096 where
1097 findTempName :: FilePath -> String -> IO (FilePath, FilePath, String)
1098 findTempName dir prefix
1099 = do n <- newTempSuffix dflags -- See Note [Deterministic base name]
1100 let libname = prefix ++ show n
1101 filename = dir </> "lib" ++ libname <.> extn
1102 b <- doesFileExist filename
1103 if b then findTempName dir prefix
1104 else do -- clean it up later
1105 consIORef (filesToClean dflags) filename
1106 return (filename, dir, libname)
1107
1108
1109 -- Return our temporary directory within tmp_dir, creating one if we
1110 -- don't have one yet.
1111 getTempDir :: DynFlags -> IO FilePath
1112 getTempDir dflags = do
1113 mapping <- readIORef dir_ref
1114 case Map.lookup tmp_dir mapping of
1115 Nothing -> do
1116 pid <- getProcessID
1117 let prefix = tmp_dir </> "ghc" ++ show pid ++ "_"
1118 mask_ $ mkTempDir prefix
1119 Just dir -> return dir
1120 where
1121 tmp_dir = tmpDir dflags
1122 dir_ref = dirsToClean dflags
1123
1124 mkTempDir :: FilePath -> IO FilePath
1125 mkTempDir prefix = do
1126 n <- newTempSuffix dflags
1127 let our_dir = prefix ++ show n
1128
1129 -- 1. Speculatively create our new directory.
1130 createDirectory our_dir
1131
1132 -- 2. Update the dirsToClean mapping unless an entry already exists
1133 -- (i.e. unless another thread beat us to it).
1134 their_dir <- atomicModifyIORef' dir_ref $ \mapping ->
1135 case Map.lookup tmp_dir mapping of
1136 Just dir -> (mapping, Just dir)
1137 Nothing -> (Map.insert tmp_dir our_dir mapping, Nothing)
1138
1139 -- 3. If there was an existing entry, return it and delete the
1140 -- directory we created. Otherwise return the directory we created.
1141 case their_dir of
1142 Nothing -> do
1143 debugTraceMsg dflags 2 $
1144 text "Created temporary directory:" <+> text our_dir
1145 return our_dir
1146 Just dir -> do
1147 removeDirectory our_dir
1148 return dir
1149 `catchIO` \e -> if isAlreadyExistsError e
1150 then mkTempDir prefix else ioError e
1151
1152 -- Note [Deterministic base name]
1153 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1154 --
1155 -- The filename of temporary files, especially the basename of C files, can end
1156 -- up in the output in some form, e.g. as part of linker debug information. In the
1157 -- interest of bit-wise exactly reproducible compilation (#4012), the basename of
1158 -- the temporary file no longer contains random information (it used to contain
1159 -- the process id).
1160 --
1161 -- This is ok, as the temporary directory used contains the pid (see getTempDir).
1162
1163 addFilesToClean :: DynFlags -> [FilePath] -> IO ()
1164 -- May include wildcards [used by DriverPipeline.run_phase SplitMangle]
1165 addFilesToClean dflags new_files
1166 = atomicModifyIORef' (filesToClean dflags) $ \files -> (new_files++files, ())
1167
1168 removeTmpDirs :: DynFlags -> [FilePath] -> IO ()
1169 removeTmpDirs dflags ds
1170 = traceCmd dflags "Deleting temp dirs"
1171 ("Deleting: " ++ unwords ds)
1172 (mapM_ (removeWith dflags removeDirectory) ds)
1173
1174 removeTmpFiles :: DynFlags -> [FilePath] -> IO ()
1175 removeTmpFiles dflags fs
1176 = warnNon $
1177 traceCmd dflags "Deleting temp files"
1178 ("Deleting: " ++ unwords deletees)
1179 (mapM_ (removeWith dflags removeFile) deletees)
1180 where
1181 -- Flat out refuse to delete files that are likely to be source input
1182 -- files (is there a worse bug than having a compiler delete your source
1183 -- files?)
1184 --
1185 -- Deleting source files is a sign of a bug elsewhere, so prominently flag
1186 -- the condition.
1187 warnNon act
1188 | null non_deletees = act
1189 | otherwise = do
1190 putMsg dflags (text "WARNING - NOT deleting source files:" <+> hsep (map text non_deletees))
1191 act
1192
1193 (non_deletees, deletees) = partition isHaskellUserSrcFilename fs
1194
1195 removeWith :: DynFlags -> (FilePath -> IO ()) -> FilePath -> IO ()
1196 removeWith dflags remover f = remover f `catchIO`
1197 (\e ->
1198 let msg = if isDoesNotExistError e
1199 then text "Warning: deleting non-existent" <+> text f
1200 else text "Warning: exception raised when deleting"
1201 <+> text f <> colon
1202 $$ text (show e)
1203 in debugTraceMsg dflags 2 msg
1204 )
1205
1206 -----------------------------------------------------------------------------
1207 -- Running an external program
1208
1209 runSomething :: DynFlags
1210 -> String -- For -v message
1211 -> String -- Command name (possibly a full path)
1212 -- assumed already dos-ified
1213 -> [Option] -- Arguments
1214 -- runSomething will dos-ify them
1215 -> IO ()
1216
1217 runSomething dflags phase_name pgm args =
1218 runSomethingFiltered dflags id phase_name pgm args Nothing
1219
1220 -- | Run a command, placing the arguments in an external response file.
1221 --
1222 -- This command is used in order to avoid overlong command line arguments on
1223 -- Windows. The command line arguments are first written to an external,
1224 -- temporary response file, and then passed to the linker via @filepath.
1225 -- response files for passing them in. See:
1226 --
1227 -- https://gcc.gnu.org/wiki/Response_Files
1228 -- https://ghc.haskell.org/trac/ghc/ticket/10777
1229 runSomethingResponseFile
1230 :: DynFlags -> (String->String) -> String -> String -> [Option]
1231 -> Maybe [(String,String)] -> IO ()
1232
1233 runSomethingResponseFile dflags filter_fn phase_name pgm args mb_env =
1234 runSomethingWith dflags phase_name pgm args $ \real_args -> do
1235 fp <- getResponseFile real_args
1236 let args = ['@':fp]
1237 r <- builderMainLoop dflags filter_fn pgm args mb_env
1238 return (r,())
1239 where
1240 getResponseFile args = do
1241 fp <- newTempName dflags "rsp"
1242 withFile fp WriteMode $ \h -> do
1243 #if defined(mingw32_HOST_OS)
1244 hSetEncoding h latin1
1245 #else
1246 hSetEncoding h utf8
1247 #endif
1248 hPutStr h $ unlines $ map escape args
1249 return fp
1250
1251 -- Note: Response files have backslash-escaping, double quoting, and are
1252 -- whitespace separated (some implementations use newline, others any
1253 -- whitespace character). Therefore, escape any backslashes, newlines, and
1254 -- double quotes in the argument, and surround the content with double
1255 -- quotes.
1256 --
1257 -- Another possibility that could be considered would be to convert
1258 -- backslashes in the argument to forward slashes. This would generally do
1259 -- the right thing, since backslashes in general only appear in arguments
1260 -- as part of file paths on Windows, and the forward slash is accepted for
1261 -- those. However, escaping is more reliable, in case somehow a backslash
1262 -- appears in a non-file.
1263 escape x = concat
1264 [ "\""
1265 , concatMap
1266 (\c ->
1267 case c of
1268 '\\' -> "\\\\"
1269 '\n' -> "\\n"
1270 '\"' -> "\\\""
1271 _ -> [c])
1272 x
1273 , "\""
1274 ]
1275
1276 runSomethingFiltered
1277 :: DynFlags -> (String->String) -> String -> String -> [Option]
1278 -> Maybe [(String,String)] -> IO ()
1279
1280 runSomethingFiltered dflags filter_fn phase_name pgm args mb_env = do
1281 runSomethingWith dflags phase_name pgm args $ \real_args -> do
1282 r <- builderMainLoop dflags filter_fn pgm real_args mb_env
1283 return (r,())
1284
1285 runSomethingWith
1286 :: DynFlags -> String -> String -> [Option]
1287 -> ([String] -> IO (ExitCode, a))
1288 -> IO a
1289
1290 runSomethingWith dflags phase_name pgm args io = do
1291 let real_args = filter notNull (map showOpt args)
1292 cmdLine = showCommandForUser pgm real_args
1293 traceCmd dflags phase_name cmdLine $ handleProc pgm phase_name $ io real_args
1294
1295 handleProc :: String -> String -> IO (ExitCode, r) -> IO r
1296 handleProc pgm phase_name proc = do
1297 (rc, r) <- proc `catchIO` handler
1298 case rc of
1299 ExitSuccess{} -> return r
1300 ExitFailure n -> throwGhcExceptionIO (
1301 ProgramError ("`" ++ takeFileName pgm ++ "'" ++
1302 " failed in phase `" ++ phase_name ++ "'." ++
1303 " (Exit code: " ++ show n ++ ")"))
1304 where
1305 handler err =
1306 if IO.isDoesNotExistError err
1307 then does_not_exist
1308 else throwGhcExceptionIO (ProgramError $ show err)
1309
1310 does_not_exist = throwGhcExceptionIO (InstallationError ("could not execute: " ++ pgm))
1311
1312
1313 builderMainLoop :: DynFlags -> (String -> String) -> FilePath
1314 -> [String] -> Maybe [(String, String)]
1315 -> IO ExitCode
1316 builderMainLoop dflags filter_fn pgm real_args mb_env = do
1317 chan <- newChan
1318 (hStdIn, hStdOut, hStdErr, hProcess) <- runInteractiveProcess pgm real_args Nothing mb_env
1319
1320 -- and run a loop piping the output from the compiler to the log_action in DynFlags
1321 hSetBuffering hStdOut LineBuffering
1322 hSetBuffering hStdErr LineBuffering
1323 _ <- forkIO (readerProc chan hStdOut filter_fn)
1324 _ <- forkIO (readerProc chan hStdErr filter_fn)
1325 -- we don't want to finish until 2 streams have been completed
1326 -- (stdout and stderr)
1327 -- nor until 1 exit code has been retrieved.
1328 rc <- loop chan hProcess (2::Integer) (1::Integer) ExitSuccess
1329 -- after that, we're done here.
1330 hClose hStdIn
1331 hClose hStdOut
1332 hClose hStdErr
1333 return rc
1334 where
1335 -- status starts at zero, and increments each time either
1336 -- a reader process gets EOF, or the build proc exits. We wait
1337 -- for all of these to happen (status==3).
1338 -- ToDo: we should really have a contingency plan in case any of
1339 -- the threads dies, such as a timeout.
1340 loop _ _ 0 0 exitcode = return exitcode
1341 loop chan hProcess t p exitcode = do
1342 mb_code <- if p > 0
1343 then getProcessExitCode hProcess
1344 else return Nothing
1345 case mb_code of
1346 Just code -> loop chan hProcess t (p-1) code
1347 Nothing
1348 | t > 0 -> do
1349 msg <- readChan chan
1350 case msg of
1351 BuildMsg msg -> do
1352 log_action dflags dflags NoReason SevInfo noSrcSpan defaultUserStyle msg
1353 loop chan hProcess t p exitcode
1354 BuildError loc msg -> do
1355 log_action dflags dflags NoReason SevError (mkSrcSpan loc loc) defaultUserStyle msg
1356 loop chan hProcess t p exitcode
1357 EOF ->
1358 loop chan hProcess (t-1) p exitcode
1359 | otherwise -> loop chan hProcess t p exitcode
1360
1361 readerProc :: Chan BuildMessage -> Handle -> (String -> String) -> IO ()
1362 readerProc chan hdl filter_fn =
1363 (do str <- hGetContents hdl
1364 loop (linesPlatform (filter_fn str)) Nothing)
1365 `finally`
1366 writeChan chan EOF
1367 -- ToDo: check errors more carefully
1368 -- ToDo: in the future, the filter should be implemented as
1369 -- a stream transformer.
1370 where
1371 loop [] Nothing = return ()
1372 loop [] (Just err) = writeChan chan err
1373 loop (l:ls) in_err =
1374 case in_err of
1375 Just err@(BuildError srcLoc msg)
1376 | leading_whitespace l -> do
1377 loop ls (Just (BuildError srcLoc (msg $$ text l)))
1378 | otherwise -> do
1379 writeChan chan err
1380 checkError l ls
1381 Nothing -> do
1382 checkError l ls
1383 _ -> panic "readerProc/loop"
1384
1385 checkError l ls
1386 = case parseError l of
1387 Nothing -> do
1388 writeChan chan (BuildMsg (text l))
1389 loop ls Nothing
1390 Just (file, lineNum, colNum, msg) -> do
1391 let srcLoc = mkSrcLoc (mkFastString file) lineNum colNum
1392 loop ls (Just (BuildError srcLoc (text msg)))
1393
1394 leading_whitespace [] = False
1395 leading_whitespace (x:_) = isSpace x
1396
1397 parseError :: String -> Maybe (String, Int, Int, String)
1398 parseError s0 = case breakColon s0 of
1399 Just (filename, s1) ->
1400 case breakIntColon s1 of
1401 Just (lineNum, s2) ->
1402 case breakIntColon s2 of
1403 Just (columnNum, s3) ->
1404 Just (filename, lineNum, columnNum, s3)
1405 Nothing ->
1406 Just (filename, lineNum, 0, s2)
1407 Nothing -> Nothing
1408 Nothing -> Nothing
1409
1410 breakColon :: String -> Maybe (String, String)
1411 breakColon xs = case break (':' ==) xs of
1412 (ys, _:zs) -> Just (ys, zs)
1413 _ -> Nothing
1414
1415 breakIntColon :: String -> Maybe (Int, String)
1416 breakIntColon xs = case break (':' ==) xs of
1417 (ys, _:zs)
1418 | not (null ys) && all isAscii ys && all isDigit ys ->
1419 Just (read ys, zs)
1420 _ -> Nothing
1421
1422 data BuildMessage
1423 = BuildMsg !SDoc
1424 | BuildError !SrcLoc !SDoc
1425 | EOF
1426
1427 traceCmd :: DynFlags -> String -> String -> IO a -> IO a
1428 -- trace the command (at two levels of verbosity)
1429 traceCmd dflags phase_name cmd_line action
1430 = do { let verb = verbosity dflags
1431 ; showPass dflags phase_name
1432 ; debugTraceMsg dflags 3 (text cmd_line)
1433 ; case flushErr dflags of
1434 FlushErr io -> io
1435
1436 -- And run it!
1437 ; action `catchIO` handle_exn verb
1438 }
1439 where
1440 handle_exn _verb exn = do { debugTraceMsg dflags 2 (char '\n')
1441 ; debugTraceMsg dflags 2 (text "Failed:" <+> text cmd_line <+> text (show exn))
1442 ; throwGhcExceptionIO (ProgramError (show exn))}
1443
1444 {-
1445 ************************************************************************
1446 * *
1447 \subsection{Support code}
1448 * *
1449 ************************************************************************
1450 -}
1451
1452 -----------------------------------------------------------------------------
1453 -- Define getBaseDir :: IO (Maybe String)
1454
1455 getBaseDir :: IO (Maybe String)
1456 #if defined(mingw32_HOST_OS)
1457 -- Assuming we are running ghc, accessed by path $(stuff)/bin/ghc.exe,
1458 -- return the path $(stuff)/lib.
1459 getBaseDir = try_size 2048 -- plenty, PATH_MAX is 512 under Win32.
1460 where
1461 try_size size = allocaArray (fromIntegral size) $ \buf -> do
1462 ret <- c_GetModuleFileName nullPtr buf size
1463 case ret of
1464 0 -> return Nothing
1465 _ | ret < size -> do path <- peekCWString buf
1466 real <- getFinalPath path -- try to resolve symlinks paths
1467 return $ (Just . rootDir . sanitize . maybe path id) real
1468 | otherwise -> try_size (size * 2)
1469
1470 -- getFinalPath returns paths in full raw form.
1471 -- Unfortunately GHC isn't set up to handle these
1472 -- So if the call succeeded, we need to drop the
1473 -- \\?\ prefix.
1474 sanitize s = if "\\\\?\\" `isPrefixOf` s
1475 then drop 4 s
1476 else s
1477
1478 rootDir s = case splitFileName $ normalise s of
1479 (d, ghc_exe)
1480 | lower ghc_exe `elem` ["ghc.exe",
1481 "ghc-stage1.exe",
1482 "ghc-stage2.exe",
1483 "ghc-stage3.exe"] ->
1484 case splitFileName $ takeDirectory d of
1485 -- ghc is in $topdir/bin/ghc.exe
1486 (d', bin) | lower bin == "bin" -> takeDirectory d' </> "lib"
1487 _ -> fail
1488 _ -> fail
1489 where fail = panic ("can't decompose ghc.exe path: " ++ show s)
1490 lower = map toLower
1491
1492 foreign import WINDOWS_CCONV unsafe "windows.h GetModuleFileNameW"
1493 c_GetModuleFileName :: Ptr () -> CWString -> Word32 -> IO Word32
1494
1495 -- Attempt to resolve symlinks in order to find the actual location GHC
1496 -- is located at. See Trac #11759.
1497 getFinalPath :: FilePath -> IO (Maybe FilePath)
1498 getFinalPath name = do
1499 dllHwnd <- failIfNull "LoadLibray" $ loadLibrary "kernel32.dll"
1500 -- Note: The API GetFinalPathNameByHandleW is only available starting from Windows Vista.
1501 -- This means that we can't bind directly to it since it may be missing.
1502 -- Instead try to find it's address at runtime and if we don't succeed consider the
1503 -- function failed.
1504 addr_m <- (fmap Just $ failIfNull "getProcAddress" $ getProcAddress dllHwnd "GetFinalPathNameByHandleW")
1505 `catch` (\(_ :: SomeException) -> return Nothing)
1506 case addr_m of
1507 Nothing -> return Nothing
1508 Just addr -> do handle <- failIf (==iNVALID_HANDLE_VALUE) "CreateFile"
1509 $ createFile name
1510 gENERIC_READ
1511 fILE_SHARE_READ
1512 Nothing
1513 oPEN_EXISTING
1514 (fILE_ATTRIBUTE_NORMAL .|. fILE_FLAG_BACKUP_SEMANTICS)
1515 Nothing
1516 let fnPtr = makeGetFinalPathNameByHandle $ castPtrToFunPtr addr
1517 path <- Info.try "GetFinalPathName"
1518 (\buf len -> fnPtr handle buf len 0) 512
1519 `finally` closeHandle handle
1520 return $ Just path
1521
1522 type GetFinalPath = HANDLE -> LPTSTR -> DWORD -> DWORD -> IO DWORD
1523
1524 foreign import WINDOWS_CCONV unsafe "dynamic"
1525 makeGetFinalPathNameByHandle :: FunPtr GetFinalPath -> GetFinalPath
1526 #else
1527 getBaseDir = return Nothing
1528 #endif
1529
1530 #ifdef mingw32_HOST_OS
1531 foreign import ccall unsafe "_getpid" getProcessID :: IO Int -- relies on Int == Int32 on Windows
1532 #else
1533 getProcessID :: IO Int
1534 getProcessID = System.Posix.Internals.c_getpid >>= return . fromIntegral
1535 #endif
1536
1537 -- Divvy up text stream into lines, taking platform dependent
1538 -- line termination into account.
1539 linesPlatform :: String -> [String]
1540 #if !defined(mingw32_HOST_OS)
1541 linesPlatform ls = lines ls
1542 #else
1543 linesPlatform "" = []
1544 linesPlatform xs =
1545 case lineBreak xs of
1546 (as,xs1) -> as : linesPlatform xs1
1547 where
1548 lineBreak "" = ("","")
1549 lineBreak ('\r':'\n':xs) = ([],xs)
1550 lineBreak ('\n':xs) = ([],xs)
1551 lineBreak (x:xs) = let (as,bs) = lineBreak xs in (x:as,bs)
1552
1553 #endif
1554
1555 {-
1556 Note [No PIE eating while linking]
1557 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1558 As of 2016 some Linux distributions (e.g. Debian) have started enabling -pie by
1559 default in their gcc builds. This is incompatible with -r as it implies that we
1560 are producing an executable. Consequently, we must manually pass -no-pie to gcc
1561 when joining object files or linking dynamic libraries. See #12759.
1562 -}
1563
1564 linkDynLib :: DynFlags -> [String] -> [InstalledUnitId] -> IO ()
1565 linkDynLib dflags0 o_files dep_packages
1566 = do
1567 let -- This is a rather ugly hack to fix dynamically linked
1568 -- GHC on Windows. If GHC is linked with -threaded, then
1569 -- it links against libHSrts_thr. But if base is linked
1570 -- against libHSrts, then both end up getting loaded,
1571 -- and things go wrong. We therefore link the libraries
1572 -- with the same RTS flags that we link GHC with.
1573 dflags1 = if cGhcThreaded then addWay' WayThreaded dflags0
1574 else dflags0
1575 dflags2 = if cGhcDebugged then addWay' WayDebug dflags1
1576 else dflags1
1577 dflags = updateWays dflags2
1578
1579 verbFlags = getVerbFlags dflags
1580 o_file = outputFile dflags
1581
1582 pkgs <- getPreloadPackagesAnd dflags dep_packages
1583
1584 let pkg_lib_paths = collectLibraryPaths dflags pkgs
1585 let pkg_lib_path_opts = concatMap get_pkg_lib_path_opts pkg_lib_paths
1586 get_pkg_lib_path_opts l
1587 | ( osElfTarget (platformOS (targetPlatform dflags)) ||
1588 osMachOTarget (platformOS (targetPlatform dflags)) ) &&
1589 dynLibLoader dflags == SystemDependent &&
1590 WayDyn `elem` ways dflags
1591 = ["-L" ++ l, "-Wl,-rpath", "-Wl," ++ l]
1592 | otherwise = ["-L" ++ l]
1593
1594 let lib_paths = libraryPaths dflags
1595 let lib_path_opts = map ("-L"++) lib_paths
1596
1597 -- We don't want to link our dynamic libs against the RTS package,
1598 -- because the RTS lib comes in several flavours and we want to be
1599 -- able to pick the flavour when a binary is linked.
1600 -- On Windows we need to link the RTS import lib as Windows does
1601 -- not allow undefined symbols.
1602 -- The RTS library path is still added to the library search path
1603 -- above in case the RTS is being explicitly linked in (see #3807).
1604 let platform = targetPlatform dflags
1605 os = platformOS platform
1606 pkgs_no_rts = case os of
1607 OSMinGW32 ->
1608 pkgs
1609 _ ->
1610 filter ((/= rtsUnitId) . packageConfigId) pkgs
1611 let pkg_link_opts = let (package_hs_libs, extra_libs, other_flags) = collectLinkOpts dflags pkgs_no_rts
1612 in package_hs_libs ++ extra_libs ++ other_flags
1613
1614 -- probably _stub.o files
1615 -- and last temporary shared object file
1616 let extra_ld_inputs = ldInputs dflags
1617
1618 -- frameworks
1619 pkg_framework_opts <- getPkgFrameworkOpts dflags platform
1620 (map unitId pkgs)
1621 let framework_opts = getFrameworkOpts dflags platform
1622
1623 case os of
1624 OSMinGW32 -> do
1625 -------------------------------------------------------------
1626 -- Making a DLL
1627 -------------------------------------------------------------
1628 let output_fn = case o_file of
1629 Just s -> s
1630 Nothing -> "HSdll.dll"
1631
1632 runLink dflags (
1633 map Option verbFlags
1634 ++ [ Option "-o"
1635 , FileOption "" output_fn
1636 , Option "-shared"
1637 ] ++
1638 [ FileOption "-Wl,--out-implib=" (output_fn ++ ".a")
1639 | gopt Opt_SharedImplib dflags
1640 ]
1641 ++ map (FileOption "") o_files
1642
1643 -- Permit the linker to auto link _symbol to _imp_symbol
1644 -- This lets us link against DLLs without needing an "import library"
1645 ++ [Option "-Wl,--enable-auto-import"]
1646
1647 ++ extra_ld_inputs
1648 ++ map Option (
1649 lib_path_opts
1650 ++ pkg_lib_path_opts
1651 ++ pkg_link_opts
1652 ))
1653 OSDarwin -> do
1654 -------------------------------------------------------------------
1655 -- Making a darwin dylib
1656 -------------------------------------------------------------------
1657 -- About the options used for Darwin:
1658 -- -dynamiclib
1659 -- Apple's way of saying -shared
1660 -- -undefined dynamic_lookup:
1661 -- Without these options, we'd have to specify the correct
1662 -- dependencies for each of the dylibs. Note that we could
1663 -- (and should) do without this for all libraries except
1664 -- the RTS; all we need to do is to pass the correct
1665 -- HSfoo_dyn.dylib files to the link command.
1666 -- This feature requires Mac OS X 10.3 or later; there is
1667 -- a similar feature, -flat_namespace -undefined suppress,
1668 -- which works on earlier versions, but it has other
1669 -- disadvantages.
1670 -- -single_module
1671 -- Build the dynamic library as a single "module", i.e. no
1672 -- dynamic binding nonsense when referring to symbols from
1673 -- within the library. The NCG assumes that this option is
1674 -- specified (on i386, at least).
1675 -- -install_name
1676 -- Mac OS/X stores the path where a dynamic library is (to
1677 -- be) installed in the library itself. It's called the
1678 -- "install name" of the library. Then any library or
1679 -- executable that links against it before it's installed
1680 -- will search for it in its ultimate install location.
1681 -- By default we set the install name to the absolute path
1682 -- at build time, but it can be overridden by the
1683 -- -dylib-install-name option passed to ghc. Cabal does
1684 -- this.
1685 -------------------------------------------------------------------
1686
1687 let output_fn = case o_file of { Just s -> s; Nothing -> "a.out"; }
1688
1689 instName <- case dylibInstallName dflags of
1690 Just n -> return n
1691 Nothing -> return $ "@rpath" `combine` (takeFileName output_fn)
1692 runLink dflags (
1693 map Option verbFlags
1694 ++ [ Option "-dynamiclib"
1695 , Option "-o"
1696 , FileOption "" output_fn
1697 ]
1698 ++ map Option o_files
1699 ++ [ Option "-undefined",
1700 Option "dynamic_lookup",
1701 Option "-single_module" ]
1702 ++ (if platformArch platform == ArchX86_64
1703 then [ ]
1704 else [ Option "-Wl,-read_only_relocs,suppress" ])
1705 ++ [ Option "-install_name", Option instName ]
1706 ++ map Option lib_path_opts
1707 ++ extra_ld_inputs
1708 ++ map Option framework_opts
1709 ++ map Option pkg_lib_path_opts
1710 ++ map Option pkg_link_opts
1711 ++ map Option pkg_framework_opts
1712 )
1713 OSiOS -> throwGhcExceptionIO (ProgramError "dynamic libraries are not supported on iOS target")
1714 _ -> do
1715 -------------------------------------------------------------------
1716 -- Making a DSO
1717 -------------------------------------------------------------------
1718
1719 let output_fn = case o_file of { Just s -> s; Nothing -> "a.out"; }
1720 let bsymbolicFlag = -- we need symbolic linking to resolve
1721 -- non-PIC intra-package-relocations
1722 ["-Wl,-Bsymbolic"]
1723
1724 runLink dflags (
1725 map Option verbFlags
1726 ++ [ Option "-o"
1727 , FileOption "" output_fn
1728 ]
1729 -- See Note [No PIE eating when linking]
1730 ++ (if sGccSupportsNoPie (settings dflags)
1731 then [Option "-no-pie"]
1732 else [])
1733 ++ map Option o_files
1734 ++ [ Option "-shared" ]
1735 ++ map Option bsymbolicFlag
1736 -- Set the library soname. We use -h rather than -soname as
1737 -- Solaris 10 doesn't support the latter:
1738 ++ [ Option ("-Wl,-h," ++ takeFileName output_fn) ]
1739 ++ extra_ld_inputs
1740 ++ map Option lib_path_opts
1741 ++ map Option pkg_lib_path_opts
1742 ++ map Option pkg_link_opts
1743 )
1744
1745 getPkgFrameworkOpts :: DynFlags -> Platform -> [InstalledUnitId] -> IO [String]
1746 getPkgFrameworkOpts dflags platform dep_packages
1747 | platformUsesFrameworks platform = do
1748 pkg_framework_path_opts <- do
1749 pkg_framework_paths <- getPackageFrameworkPath dflags dep_packages
1750 return $ map ("-F" ++) pkg_framework_paths
1751
1752 pkg_framework_opts <- do
1753 pkg_frameworks <- getPackageFrameworks dflags dep_packages
1754 return $ concat [ ["-framework", fw] | fw <- pkg_frameworks ]
1755
1756 return (pkg_framework_path_opts ++ pkg_framework_opts)
1757
1758 | otherwise = return []
1759
1760 getFrameworkOpts :: DynFlags -> Platform -> [String]
1761 getFrameworkOpts dflags platform
1762 | platformUsesFrameworks platform = framework_path_opts ++ framework_opts
1763 | otherwise = []
1764 where
1765 framework_paths = frameworkPaths dflags
1766 framework_path_opts = map ("-F" ++) framework_paths
1767
1768 frameworks = cmdlineFrameworks dflags
1769 -- reverse because they're added in reverse order from the cmd line:
1770 framework_opts = concat [ ["-framework", fw]
1771 | fw <- reverse frameworks ]