X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FSysTools.lhs;h=a4ea987be7aaff8e865a1c48733a9af370819bca;hb=814edf44433801e37318ce79082ac6991dbc87dd;hp=3eb574438e46bd48892ecdd863bbe7925cacf433;hpb=9be618cdf99b04ce7eef6eeabc168b59174bb843;p=ghc-hetmet.git diff --git a/compiler/main/SysTools.lhs b/compiler/main/SysTools.lhs index 3eb5744..a4ea987 100644 --- 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, @@ -20,6 +21,7 @@ module SysTools ( runWindres, runLlvmOpt, runLlvmLlc, + readElfSection, touch, -- String -> String -> IO () copy, @@ -58,6 +60,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 @@ -448,6 +452,27 @@ 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} %************************************************************************