never executed always true always false
    1 
    2 {-# LANGUAGE ScopedTypeVariables #-}
    3 
    4 {-
    5 -----------------------------------------------------------------------------
    6 --
    7 -- (c) The University of Glasgow 2001-2003
    8 --
    9 -- Access to system tools: gcc, cp, rm etc
   10 --
   11 -----------------------------------------------------------------------------
   12 -}
   13 
   14 module GHC.SysTools (
   15         -- * Initialisation
   16         initSysTools,
   17         lazyInitLlvmConfig,
   18 
   19         -- * Interface to system tools
   20         module GHC.SysTools.Tasks,
   21         module GHC.SysTools.Info,
   22 
   23         -- * Fast file copy
   24         copyFile,
   25         copyHandle,
   26         copyWithHeader,
   27 
   28         -- * General utilities
   29         Option(..),
   30         expandTopDir,
   31  ) where
   32 
   33 import GHC.Prelude
   34 
   35 import GHC.Settings.Utils
   36 
   37 import GHC.Utils.Panic
   38 import GHC.Driver.Session
   39 
   40 import GHC.Linker.ExtraObj
   41 import GHC.SysTools.Info
   42 import GHC.SysTools.Tasks
   43 import GHC.SysTools.BaseDir
   44 import GHC.Settings.IO
   45 
   46 import Control.Monad.Trans.Except (runExceptT)
   47 import System.FilePath
   48 import System.IO
   49 import System.IO.Unsafe (unsafeInterleaveIO)
   50 import Foreign.Marshal.Alloc (allocaBytes)
   51 import System.Directory (copyFile)
   52 
   53 {-
   54 Note [How GHC finds toolchain utilities]
   55 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
   56 
   57 GHC.SysTools.initSysProgs figures out exactly where all the auxiliary programs
   58 are, and initialises mutable variables to make it easy to call them.
   59 To do this, it makes use of definitions in Config.hs, which is a Haskell
   60 file containing variables whose value is figured out by the build system.
   61 
   62 Config.hs contains two sorts of things
   63 
   64   cGCC,         The *names* of the programs
   65   cCPP            e.g.  cGCC = gcc
   66   cUNLIT                cCPP = gcc -E
   67   etc           They do *not* include paths
   68 
   69 
   70   cUNLIT_DIR   The *path* to the directory containing unlit, split etc
   71   cSPLIT_DIR   *relative* to the root of the build tree,
   72                    for use when running *in-place* in a build tree (only)
   73 
   74 
   75 ---------------------------------------------
   76 NOTES for an ALTERNATIVE scheme (i.e *not* what is currently implemented):
   77 
   78 Another hair-brained scheme for simplifying the current tool location
   79 nightmare in GHC: Simon originally suggested using another
   80 configuration file along the lines of GCC's specs file - which is fine
   81 except that it means adding code to read yet another configuration
   82 file.  What I didn't notice is that the current package.conf is
   83 general enough to do this:
   84 
   85 Package
   86     {name = "tools",    import_dirs = [],  source_dirs = [],
   87      library_dirs = [], hs_libraries = [], extra_libraries = [],
   88      include_dirs = [], c_includes = [],   package_deps = [],
   89      extra_ghc_opts = ["-pgmc/usr/bin/gcc","-pgml${topdir}/bin/unlit", ... etc.],
   90      extra_cc_opts = [], extra_ld_opts = []}
   91 
   92 Which would have the advantage that we get to collect together in one
   93 place the path-specific package stuff with the path-specific tool
   94 stuff.
   95                 End of NOTES
   96 ---------------------------------------------
   97 
   98 ************************************************************************
   99 *                                                                      *
  100 \subsection{Initialisation}
  101 *                                                                      *
  102 ************************************************************************
  103 -}
  104 
  105 -- Note [LLVM configuration]
  106 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  107 -- The `llvm-targets` and `llvm-passes` files are shipped with GHC and contain
  108 -- information needed by the LLVM backend to invoke `llc` and `opt`.
  109 -- Specifically:
  110 --
  111 --  * llvm-targets maps autoconf host triples to the corresponding LLVM
  112 --    `data-layout` declarations. This information is extracted from clang using
  113 --    the script in utils/llvm-targets/gen-data-layout.sh and should be updated
  114 --    whenever we target a new version of LLVM.
  115 --
  116 --  * llvm-passes maps GHC optimization levels to sets of LLVM optimization
  117 --    flags that GHC should pass to `opt`.
  118 --
  119 -- This information is contained in files rather the GHC source to allow users
  120 -- to add new targets to GHC without having to recompile the compiler.
  121 --
  122 -- Since this information is only needed by the LLVM backend we load it lazily
  123 -- with unsafeInterleaveIO. Consequently it is important that we lazily pattern
  124 -- match on LlvmConfig until we actually need its contents.
  125 
  126 lazyInitLlvmConfig :: String
  127                -> IO LlvmConfig
  128 lazyInitLlvmConfig top_dir
  129   = unsafeInterleaveIO $ do    -- see Note [LLVM configuration]
  130       targets <- readAndParse "llvm-targets"
  131       passes <- readAndParse "llvm-passes"
  132       return $ LlvmConfig { llvmTargets = fmap mkLlvmTarget <$> targets,
  133                             llvmPasses = passes }
  134   where
  135     readAndParse :: Read a => String -> IO a
  136     readAndParse name =
  137       do let llvmConfigFile = top_dir </> name
  138          llvmConfigStr <- readFile llvmConfigFile
  139          case maybeReadFuzzy llvmConfigStr of
  140            Just s -> return s
  141            Nothing -> pgmError ("Can't parse " ++ show llvmConfigFile)
  142 
  143     mkLlvmTarget :: (String, String, String) -> LlvmTarget
  144     mkLlvmTarget (dl, cpu, attrs) = LlvmTarget dl cpu (words attrs)
  145 
  146 
  147 initSysTools :: String          -- TopDir path
  148              -> IO Settings     -- Set all the mutable variables above, holding
  149                                 --      (a) the system programs
  150                                 --      (b) the package-config file
  151                                 --      (c) the GHC usage message
  152 initSysTools top_dir = do
  153   res <- runExceptT $ initSettings top_dir
  154   case res of
  155     Right a -> pure a
  156     Left (SettingsError_MissingData msg) -> pgmError msg
  157     Left (SettingsError_BadData msg) -> pgmError msg
  158 
  159 {- Note [Windows stack usage]
  160 
  161 See: #8870 (and #8834 for related info) and #12186
  162 
  163 On Windows, occasionally we need to grow the stack. In order to do
  164 this, we would normally just bump the stack pointer - but there's a
  165 catch on Windows.
  166 
  167 If the stack pointer is bumped by more than a single page, then the
  168 pages between the initial pointer and the resulting location must be
  169 properly committed by the Windows virtual memory subsystem. This is
  170 only needed in the event we bump by more than one page (i.e 4097 bytes
  171 or more).
  172 
  173 Windows compilers solve this by emitting a call to a special function
  174 called _chkstk, which does this committing of the pages for you.
  175 
  176 The reason this was causing a segfault was because due to the fact the
  177 new code generator tends to generate larger functions, we needed more
  178 stack space in GHC itself. In the x86 codegen, we needed approximately
  179 ~12kb of stack space in one go, which caused the process to segfault,
  180 as the intervening pages were not committed.
  181 
  182 GCC can emit such a check for us automatically but only when the flag
  183 -fstack-check is used.
  184 
  185 See https://gcc.gnu.org/onlinedocs/gnat_ugn/Stack-Overflow-Checking.html
  186 for more information.
  187 
  188 -}
  189 
  190 -- | Copy remaining bytes from the first Handle to the second one
  191 copyHandle :: Handle -> Handle -> IO ()
  192 copyHandle hin hout = do
  193   let buf_size = 8192
  194   allocaBytes buf_size $ \ptr -> do
  195     let go = do
  196           c <- hGetBuf hin ptr buf_size
  197           hPutBuf hout ptr c
  198           if c == 0 then return () else go
  199     go
  200 
  201 -- | Copy file after printing the given header
  202 copyWithHeader :: String -> FilePath -> FilePath -> IO ()
  203 copyWithHeader header from to =
  204   withBinaryFile to WriteMode $ \hout -> do
  205     -- write the header string in UTF-8.  The header is something like
  206     --   {-# LINE "foo.hs" #-}
  207     -- and we want to make sure a Unicode filename isn't mangled.
  208     hSetEncoding hout utf8
  209     hPutStr hout header
  210     withBinaryFile from ReadMode $ \hin ->
  211       copyHandle hin hout