/src/Mkrt.hs

 1{-# LANGUAGE UnicodeSyntax, ViewPatterns #-}
 2
 3import System.Posix (createFile, createDirectory, closeFd,
 4  FileMode, unionFileModes, accessModes, nullFileMode,
 5  ownerReadMode, ownerWriteMode, ownerExecuteMode,
 6  groupReadMode, groupWriteMode, groupExecuteMode, 
 7  otherReadMode, otherWriteMode, otherExecuteMode,
 8  setFileCreationMask)
 9import System.Process (readProcessWithExitCode)
10import System.Exit (ExitCode(..))
11import System.Directory (createDirectoryIfMissing, copyFile, doesFileExist)
12import System.FilePath (takeDirectory, (</>))
13import System.IO (hFlush, stdout)
14import System.IO.Unsafe (unsafePerformIO)
15import System.Environment (getEnv)
16import Control.Monad (when, forM)
17import Text.Regex (matchRegex, mkRegex)
18import Data.Maybe (mapMaybe)
19import Data.List (nub)
20import Util (findM, (.))
21import Prelude hiding ((.))
22import Prelude.Unicode
23import Paths_geordi (getDataFileName)
24import CompileConfig
25
26split_paths :: String ? [FilePath]
27split_paths [] = []
28split_paths (span (/= ':') ? (f, r)) = f : split_paths (drop 1 r)
29
30which :: String ? IO (Maybe FilePath)
31which s = getEnv "PATH" >>= findM doesFileExist . (s:) . map (</> s) . filter (not . null) . split_paths
32
33modes :: [FileMode] ? FileMode
34modes = foldl1 unionFileModes
35
36readModes, writeModes, executeModes :: FileMode
37readModes = modes [ownerReadMode, groupReadMode, otherReadMode]
38writeModes = modes [ownerWriteMode, groupWriteMode, otherWriteMode]
39executeModes = modes [ownerExecuteMode, groupExecuteMode, otherExecuteMode]
40
41ldd :: FilePath ? IO [FilePath]
42ldd f = do
43  (status, out, err) ? readProcessWithExitCode "ldd" [f] ""
44  if status ? ExitSuccess then error err else do
45  return $ map head $ mapMaybe (matchRegex $ mkRegex "[[:blank:]](/[^[:blank:]]*)") $ lines out
46
47compiler_files :: IO [FilePath]
48compiler_files = (nub .) $ do
49  gxx ? gxxPath . readCompileConfig
50  let
51    query_gxx q = do
52      (status, out, err) ? readProcessWithExitCode gxx [q] ""
53      if status /= ExitSuccess then error err else do
54      return $ head $ lines out
55  fs ? (concat .) $ forM l $ \f ? do
56    out ? query_gxx $ "-print-file-name=" ++ f
57    return [out | out ? f]
58  fs' ? (concat .) $ forM ["cc1plus", "as", "ld"] $ \p ? do
59    mf ? query_gxx ("-print-prog-name=" ++ p) >>= which
60    case mf of
61      Nothing ? error $ "could not find " ++ p
62      Just f ? (f:) . ldd f
63  gxxlibs ? ldd gxx
64  return $ gxx : gxxlibs ++ fs ++ fs'
65 where l = words "crt1.o crti.o crtn.o crtbegin.o crtend.o libgcc.a libgcc_s.so libstdc++.so libstdc++.so.6 libmcheck.a libc.so libc_nonshared.a libm.so libm.so.6 libc.so.6 libgcc_s.so.1"
66
67main :: IO ()
68main = do
69  setFileCreationMask $ modes [groupWriteMode, otherWriteMode]
70  rt ? getDataFileName "rt"
71  putStr $ "Setting up " ++ rt ++ " ..."
72  hFlush stdout
73  (compiler_files >>=) $ mapM_ $ \f ? do
74    let to = rt ++ "/" ++ f -- can't use </> here because f is absolute
75    createDirectoryIfMissing True $ takeDirectory to
76    copyFile f to
77  setFileCreationMask nullFileMode
78  createFile (rt </> "lock") readModes >>= closeFd
79  createFile (rt </> "t") accessModes >>= closeFd
80  forM ["t.cpp", "t.s", "t.o"] $ (>>= closeFd) . flip createFile (unionFileModes writeModes readModes) . (rt </>)
81  putStrLn " done."