-
Notifications
You must be signed in to change notification settings - Fork 37
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
Make installed geordi self-contained.
- Loading branch information
Showing
10 changed files
with
164 additions
and
89 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -1,13 +1,24 @@ | ||
| import Distribution.Simple | ||
| import Distribution.Simple.Setup (ConfigFlags) | ||
| import Distribution.PackageDescription (PackageDescription) | ||
| import Distribution.Simple.Setup (ConfigFlags, InstallFlags) | ||
| import Distribution.PackageDescription (PackageDescription(..)) | ||
| import Distribution.Simple.LocalBuildInfo (LocalBuildInfo(..)) | ||
| import Distribution.Simple.InstallDirs (prefix, fromPathTemplate) | ||
| import Distribution.Simple.InstallDirs (initialPathTemplateEnv, prefix, bindir, datadir, datasubdir, fromPathTemplate, installDirsTemplateEnv, packageTemplateEnv, substPathTemplate) | ||
| import System.Posix.Files (setFileMode, ownerModes) | ||
|
|
||
| main :: IO () | ||
| main = defaultMainWithHooks $ autoconfUserHooks { postConf = myPostConf } | ||
| main = defaultMainWithHooks $ autoconfUserHooks { postInst = myPostInst } | ||
|
|
||
| myPostConf :: Args -> ConfigFlags -> PackageDescription -> LocalBuildInfo -> IO () | ||
| myPostConf args flags pkg_descr lbi = do | ||
| writeFile "prefix" $ fromPathTemplate $ prefix $ installDirTemplates lbi | ||
| postConf autoconfUserHooks args flags pkg_descr lbi | ||
| myPostInst :: Args -> InstallFlags -> PackageDescription -> LocalBuildInfo -> IO () | ||
| myPostInst args flags pkg_descr lbi = do | ||
| (pre, _:post) <- fmap (span (/= "DATA=\"\"") . lines) $ readFile "scripts/compile-prelude" | ||
| let | ||
| idt = installDirTemplates lbi | ||
| env = installDirsTemplateEnv idt | ||
| idt' = fmap (fromPathTemplate | ||
| . substPathTemplate env | ||
| . substPathTemplate (packageTemplateEnv (package pkg_descr))) idt | ||
| -- This makes little sense to me, but it works... | ||
| to = bindir idt' ++ "/geordi-compile-prelude" | ||
| writeFile to $ unlines $ pre ++ ["DATA=\"" ++ datadir idt' ++ "/" ++ datasubdir idt' ++ "/\""] ++ post | ||
| setFileMode to ownerModes | ||
| postInst autoconfUserHooks args flags pkg_descr lbi |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -1,14 +1,19 @@ | ||
| #!/bin/sh | ||
| set -eu | ||
| DATA=`cat prefix`/share/geordi-0 | ||
| RT="${DATA}/rt" | ||
|
|
||
| DATA="" | ||
| if [ "${DATA}" = "" ] ; then | ||
| echo "Run geordi-compile-prelude instead." | ||
| exit 1 | ||
| fi | ||
|
|
||
| . "${DATA}/compile-config" | ||
| cd prelude | ||
| cd "${DATA}/prelude" | ||
| $GXX $COMPILE_FLAGS -c prelude.cpp tracked.cpp type_strings.cpp more_ostreaming.cpp | ||
| cd .. | ||
| rm -f "${RT}/prelude.a" | ||
| ar -rsc "${RT}/prelude.a" prelude/*.o | ||
| $GXX $COMPILE_FLAGS -c -x c++-header prelude/prelude.hpp -o "${RT}/prelude.hpp.gch" | ||
| chmod 644 "${RT}/prelude.a" "${RT}/prelude.hpp.gch" | ||
| cp prelude/terse.hpp "${RT}/" | ||
| $GXX $COMPILE_FLAGS -fPIC -shared -Wl,-soname,libtpreload.so.0 -o "${RT}/libtpreload.so.0.0" prelude/tpreload.cpp | ||
| cd "${DATA}" | ||
| rm -f rt/prelude.a | ||
| ar -rsc rt/prelude.a prelude/*.o | ||
| $GXX $COMPILE_FLAGS -c -x c++-header prelude/prelude.hpp -o rt/prelude.hpp.gch | ||
| chmod 644 rt/prelude.a rt/prelude.hpp.gch | ||
| cp prelude/terse.hpp rt/ | ||
| $GXX $COMPILE_FLAGS -fPIC -shared -Wl,-soname,libtpreload.so.0 -o rt/libtpreload.so.0.0 prelude/tpreload.cpp |
This file was deleted.
Oops, something went wrong.
This file was deleted.
Oops, something went wrong.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,30 @@ | ||
| {-# LANGUAGE PatternGuards #-} | ||
|
|
||
| module CompileConfig where | ||
|
|
||
| import qualified Data.Map as Map | ||
| import qualified Data.Char as Char | ||
| import qualified Data.Maybe as Maybe | ||
| import Control.Applicative ((<*>)) | ||
| import Paths_geordi (getDataFileName) | ||
| import Prelude hiding ((.)) | ||
| import Util (readFileNow, (.)) | ||
|
|
||
| data CompileConfig = CompileConfig { gxxPath :: FilePath, compileFlags, linkFlags :: [String] } | ||
|
|
||
| readCompileConfig :: IO CompileConfig | ||
| readCompileConfig = do | ||
| l ← lines . (getDataFileName file >>= readFileNow) | ||
| let | ||
| m = Map.fromList $ Maybe.catMaybes $ (uncurry parseLine .) $ zip [1..] l | ||
| var k = maybe (fail $ "Missing variable in " ++ file ++ ": " ++ k) return (Map.lookup k m) | ||
| CompileConfig . var "GXX" <*> (words . var "COMPILE_FLAGS") <*> (words . var "LINK_FLAGS") | ||
| where | ||
| file = "compile-config" | ||
| parseLine :: Int -> String -> Maybe (String, String) | ||
| parseLine linenum line | ||
| | s@(c:_) <- dropWhile Char.isSpace line, c /= '#' = | ||
| case span (/= '=') s of | ||
| (key, _ : right) | [(value, _)] ← reads right -> Just (key, value) | ||
| _ -> error $ "Syntax error on line " ++ show linenum ++ " in " ++ file ++ "." | ||
| | otherwise = Nothing |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,81 @@ | ||
| {-# LANGUAGE UnicodeSyntax, PatternGuards #-} | ||
|
|
||
| import System.Posix (createFile, createDirectory, closeFd, | ||
| FileMode, unionFileModes, accessModes, nullFileMode, | ||
| ownerReadMode, ownerWriteMode, ownerExecuteMode, | ||
| groupReadMode, groupWriteMode, groupExecuteMode, | ||
| otherReadMode, otherWriteMode, otherExecuteMode, | ||
| setFileCreationMask) | ||
| import System.Process (readProcessWithExitCode) | ||
| import System.Exit (ExitCode(..)) | ||
| import System.Directory (createDirectoryIfMissing, copyFile, doesFileExist) | ||
| import System.FilePath (takeDirectory, (</>)) | ||
| import System.IO (hFlush, stdout) | ||
| import System.IO.Unsafe (unsafePerformIO) | ||
| import System.Environment (getEnv) | ||
| import Control.Monad (when, forM) | ||
| import Text.Regex (matchRegex, mkRegex) | ||
| import Data.Maybe (catMaybes) | ||
| import Data.List (nub) | ||
| import Util (findM, (.)) | ||
| import Prelude hiding ((.)) | ||
| import Prelude.Unicode | ||
| import Paths_geordi (getDataFileName) | ||
| import CompileConfig | ||
|
|
||
| split_paths :: String → [FilePath] | ||
| split_paths [] = [] | ||
| split_paths s | (f, r) ← span (/= ':') s = f : split_paths (drop 1 r) | ||
|
|
||
| which :: String → IO (Maybe FilePath) | ||
| which s = getEnv "PATH" >>= findM doesFileExist . (s:) . map (</> s) . filter (not . null) . split_paths | ||
|
|
||
| modes :: [FileMode] → FileMode | ||
| modes = foldl1 unionFileModes | ||
|
|
||
| readModes, writeModes, executeModes :: FileMode | ||
| readModes = modes [ownerReadMode, groupReadMode, otherReadMode] | ||
| writeModes = modes [ownerWriteMode, groupWriteMode, otherWriteMode] | ||
| executeModes = modes [ownerExecuteMode, groupExecuteMode, otherExecuteMode] | ||
|
|
||
| ldd :: FilePath → IO [FilePath] | ||
| ldd f = do | ||
| (status, out, err) ← readProcessWithExitCode "ldd" [f] "" | ||
| if status ≠ ExitSuccess then error err else do | ||
| return $ map head $ catMaybes $ map (matchRegex $ mkRegex "[[:blank:]](/[^[:blank:]]*)") $ lines $ out | ||
|
|
||
| compiler_files :: IO [FilePath] | ||
| compiler_files = (nub .) $ do | ||
| gxx ← gxxPath . readCompileConfig | ||
| let | ||
| query_gxx q = do | ||
| (status, out, err) ← readProcessWithExitCode gxx [q] "" | ||
| if status /= ExitSuccess then error err else do | ||
| return $ head $ lines out | ||
| fs ← (concat .) $ forM l $ \f → do | ||
| out ← query_gxx $ "-print-file-name=" ++ f | ||
| return $ if out ≠ f then [out] else [] | ||
| fs' ← (concat .) $ forM ["as", "ld"] $ \p → do | ||
| mf ← query_gxx ("-print-prog-name=" ++ p) >>= which | ||
| case mf of | ||
| Nothing → error $ "could not find " ++ p | ||
| Just f → (f:) . ldd f | ||
| gxxlibs ← ldd gxx | ||
| return $ gxx : gxxlibs ++ fs ++ fs' | ||
| 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" | ||
|
|
||
| main :: IO () | ||
| main = do | ||
| setFileCreationMask $ modes [groupWriteMode, otherWriteMode] | ||
| rt ← getDataFileName "rt" | ||
| putStr $ "Setting up " ++ rt ++ " ..." | ||
| hFlush stdout | ||
| (compiler_files >>=) $ mapM_ $ \f → do | ||
| let to = rt ++ "/" ++ f -- can't use </> here because f is absolute | ||
| createDirectoryIfMissing True $ takeDirectory to | ||
| copyFile f to | ||
| setFileCreationMask nullFileMode | ||
| createFile (rt </> "lock") readModes >>= closeFd | ||
| createFile (rt </> "t") accessModes >>= closeFd | ||
| forM ["t.cpp", "t.s", "t.o"] $ (>>= closeFd) . flip createFile (unionFileModes writeModes readModes) . (rt </>) | ||
| putStrLn " done." |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters