Rename "extra-gcc-opts" to "settings", and start generalising it

[ghc-hetmet.git] / compiler / main / SysTools.lhs

diff --git a/compiler/main/SysTools.lhs b/compiler/main/SysTools.lhs
index d33fd6c..9bc26cf 100644 (file)
--- a/compiler/main/SysTools.lhs
+++ b/compiler/main/SysTools.lhs
@@ -7,6 +7,7 @@
 -----------------------------------------------------------------------------
 
 \begin{code}
+{-# OPTIONS -fno-warn-unused-do-bind #-}
 module SysTools (
         -- Initialisation
         initSysTools,
@@ -14,17 +15,17 @@ module SysTools (
         -- Interface to system tools
         runUnlit, runCpp, runCc, -- [Option] -> IO ()
         runPp,                   -- [Option] -> IO ()
-        runMangle, runSplit,     -- [Option] -> IO ()
+        runSplit,                -- [Option] -> IO ()
         runAs, runLink,          -- [Option] -> IO ()
         runMkDLL,
         runWindres,
         runLlvmOpt,
         runLlvmLlc,
+        readElfSection,
 
         touch,                  -- String -> String -> IO ()
         copy,
         copyWithHeader,
-        getExtraViaCOpts,
 
         -- Temporary-file management
         setTmpDir,
@@ -58,6 +59,8 @@ import System.Directory
 import Data.Char
 import Data.List
 import qualified Data.Map as Map
+import Text.ParserCombinators.ReadP hiding (char)
+import qualified Text.ParserCombinators.ReadP as R
 
 #ifndef mingw32_HOST_OS
 import qualified System.Posix.Internals
@@ -158,6 +161,19 @@ initSysTools mbMinusB dflags0
                 -- NB: top_dir is assumed to be in standard Unix
                 -- format, '/' separated
 
+        ; let settingsFile = top_dir </> "settings"
+        ; settingsStr <- readFile settingsFile
+        ; mySettings <- case maybeReadFuzzy settingsStr of
+                        Just s ->
+                            return s
+                        Nothing ->
+                            pgmError ("Can't parse " ++ show settingsFile)
+        ; let getSetting key = case lookup key mySettings of
+                               Just xs ->
+                                   return xs
+                               Nothing -> pgmError ("No entry for " ++ show key ++ " in " ++ show settingsFile)
+        ; myExtraGccViaCFlags <- getSetting "GCC extra via C opts"
+
         ; let installed :: FilePath -> FilePath
               installed file = top_dir </> file
               installed_mingw_bin file = top_dir </> ".." </> "mingw" </> "bin" </> file
@@ -171,9 +187,8 @@ initSysTools mbMinusB dflags0
                 -- architecture-specific stuff is done when building Config.hs
               unlit_path = installed cGHC_UNLIT_PGM
 
-                -- split and mangle are Perl scripts
+                -- split is a Perl script
               split_script  = installed cGHC_SPLIT_PGM
-              mangle_script = installed cGHC_MANGLER_PGM
 
               windres_path  = installed_mingw_bin "windres"
 
@@ -194,7 +209,7 @@ initSysTools mbMinusB dflags0
                 | isWindowsHost = installed cGHC_TOUCHY_PGM
                 | otherwise     = "touch"
               -- On Win32 we don't want to rely on #!/bin/perl, so we prepend
-              -- a call to Perl to get the invocation of split and mangle.
+              -- a call to Perl to get the invocation of split.
               -- On Unix, scripts are invoked using the '#!' method.  Binary
               -- installations of GHC on Unix place the correct line on the
               -- front of the script at installation time, so we don't want
@@ -202,9 +217,6 @@ initSysTools mbMinusB dflags0
               (split_prog,  split_args)
                 | isWindowsHost = (perl_path,    [Option split_script])
                 | otherwise     = (split_script, [])
-              (mangle_prog, mangle_args)
-                | isWindowsHost = (perl_path,   [Option mangle_script])
-                | otherwise     = (mangle_script, [])
               (mkdll_prog, mkdll_args)
                 | not isWindowsHost
                     = panic "Can't build DLLs on a non-Win32 system"
@@ -229,12 +241,13 @@ initSysTools mbMinusB dflags0
                         ghcUsagePath = ghc_usage_msg_path,
                         ghciUsagePath = ghci_usage_msg_path,
                         topDir  = top_dir,
+                        settings = mySettings,
+                        extraGccViaCFlags = words myExtraGccViaCFlags,
                         systemPackageConfig = pkgconfig_path,
                         pgm_L   = unlit_path,
                         pgm_P   = cpp_path,
                         pgm_F   = "",
                         pgm_c   = (gcc_prog,[]),
-                        pgm_m   = (mangle_prog,mangle_args),
                         pgm_s   = (split_prog,split_args),
                         pgm_a   = (as_prog,[]),
                         pgm_l   = (ld_prog,[]),
@@ -372,11 +385,6 @@ getGccEnv opts =
         = (path, '\"' : head b_dirs ++ "\";" ++ paths)
   mangle_path other = other
 
-runMangle :: DynFlags -> [Option] -> IO ()
-runMangle dflags args = do
-  let (p,args0) = pgm_m dflags
-  runSomething dflags "Mangler" p (args0++args)
-
 runSplit :: DynFlags -> [Option] -> IO ()
 runSplit dflags args = do
   let (p,args0) = pgm_s dflags
@@ -454,10 +462,26 @@ copyWithHeader dflags purpose maybe_header from to = do
   hClose hout
   hClose hin
 
-getExtraViaCOpts :: DynFlags -> IO [String]
-getExtraViaCOpts dflags = do
-  f <- readFile (topDir dflags </> "extra-gcc-opts")
-  return (words f)
+-- | read the contents of the named section in an ELF object as a
+-- String.
+readElfSection :: DynFlags -> String -> FilePath -> IO (Maybe String)
+readElfSection _dflags section exe = do
+  let
+     prog = "readelf"
+     args = [Option "-p", Option section, FileOption "" exe]
+  --
+  r <- readProcessWithExitCode prog (filter notNull (map showOpt args)) ""
+  case r of
+    (ExitSuccess, out, _err) -> return (doFilter (lines out))
+    _ -> return Nothing
+ where
+  doFilter [] = Nothing
+  doFilter (s:r) = case readP_to_S parse s of
+                    [(p,"")] -> Just p
+                    _r       -> doFilter r
+   where parse = do
+           skipSpaces; R.char '['; skipSpaces; string "0]"; skipSpaces;
+           munch (const True)
 \end{code}
 
 %************************************************************************
@@ -489,8 +513,8 @@ cleanTempFilesExcept dflags dont_delete
    $ do let ref = filesToClean dflags
         files <- readIORef ref
         let (to_keep, to_delete) = partition (`elem` dont_delete) files
-        removeTmpFiles dflags to_delete
         writeIORef ref to_keep
+        removeTmpFiles dflags to_delete
 
 
 -- find a temporary name that doesn't already exist.