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