2d4d520c77
Consolidating to one simulator to get simulator builds running again. The source setup is still for multiple potential targets so it remains reasonably easy to add different architectures like x86 to the Haskell model if needed.
134 lines
4.2 KiB
Haskell
134 lines
4.2 KiB
Haskell
#!/usr/bin/env runhaskell
|
|
{-# LANGUAGE ViewPatterns #-}
|
|
--
|
|
-- Copyright 2014, General Dynamics C4 Systems
|
|
--
|
|
-- This software may be distributed and modified according to the terms of
|
|
-- the GNU General Public License version 2. Note that NO WARRANTY is provided.
|
|
-- See "LICENSE_GPLv2.txt" for details.
|
|
--
|
|
-- @TAG(GD_GPL)
|
|
--
|
|
|
|
module Main where
|
|
import Control.Applicative((<$>))
|
|
import Distribution.Simple
|
|
import Distribution.PackageDescription
|
|
import System.Directory
|
|
import Distribution.PackageDescription.Parse
|
|
import Distribution.Verbosity
|
|
import qualified Distribution.ModuleName
|
|
import Distribution.Simple.Setup
|
|
import System.Process
|
|
import System.Exit
|
|
import System.Environment(getArgs)
|
|
import Data.List(isPrefixOf, find)
|
|
import Control.Monad(unless, liftM)
|
|
|
|
targets =
|
|
[ ("arm-qemu", ("ARM", "QEmu")) ]
|
|
|
|
bootModules =
|
|
[ "Kernel/CSpace"
|
|
, "Kernel/Thread"
|
|
, "Kernel/FaultHandler"
|
|
, "Kernel/VSpace"
|
|
, "Kernel/Init"
|
|
, "Model/PSpace"
|
|
, "Object/TCB"
|
|
, "Object/CNode"
|
|
, "Object/ObjectType"
|
|
]
|
|
|
|
platformModules =
|
|
[ "Machine.Hardware"
|
|
]
|
|
|
|
archModules =
|
|
[ "API.Types"
|
|
, "API.Invocation"
|
|
, "Kernel.VSpace"
|
|
, "Kernel.Thread"
|
|
, "Object.ObjectType"
|
|
, "Object.Structures"
|
|
, "Object.Interrupt"
|
|
, "Object.Instances"
|
|
, "Object.TCB"
|
|
, "Model.StateData"
|
|
, "Machine.RegisterSet"
|
|
, "Machine.Hardware"
|
|
]
|
|
|
|
targetModules arch platform =
|
|
(map (\a -> "SEL4." ++ a ++ "." ++ arch) archModules) ++
|
|
(map (\a -> "SEL4." ++ a ++ "." ++ arch_platform) platformModules)
|
|
where arch_platform = arch ++ "." ++ platform
|
|
|
|
ghcOptions arch platform =
|
|
[ "-DTARGET=" ++ arch
|
|
, "-DTARGET_" ++ arch
|
|
, "-DPLATFORM=" ++ platform
|
|
, "-DPLATFORM_" ++ platform
|
|
]
|
|
|
|
bootFiles = map moduleToLHSName bootModules
|
|
where
|
|
moduleToLHSName f = "src/SEL4/" ++
|
|
(map (\a -> if a == '.' then '/' else a) f) ++ ".lhs"
|
|
|
|
main :: IO ()
|
|
main = do
|
|
args <- getArgs
|
|
let targetPrefix = "--with-target="
|
|
let targetArg = find (targetPrefix `isPrefixOf`) args
|
|
let targetName = liftM (drop (length targetPrefix)) targetArg
|
|
let args' = filter (not . isPrefixOf targetPrefix) args
|
|
let hooks = simpleUserHooks {
|
|
preBuild = \args flags -> do
|
|
generateHSBoot
|
|
(preBuild simpleUserHooks) args flags,
|
|
readDesc = do
|
|
cabalfile <- generateTempCabalFile "SEL4.cabal" targetName
|
|
v <- readPackageDescription normal $ cabalfile
|
|
removeFile cabalfile
|
|
return $ Just v
|
|
}
|
|
defaultMainWithHooksArgs hooks args'
|
|
|
|
printKnownTargets :: IO ()
|
|
printKnownTargets = do
|
|
putStrLn "Recognised targets are:"
|
|
mapM_ (putStrLn.('\t':).fst) targets
|
|
|
|
|
|
generateTempCabalFile :: String -> Maybe String -> IO String
|
|
generateTempCabalFile fn targetName = do
|
|
case (do name <- targetName
|
|
(name, (arch, platform)) <- find ((==name).fst) targets
|
|
return (name, arch, platform)) of
|
|
Nothing -> do
|
|
putStrLn "Please specify a target: --with-target=<target>"
|
|
printKnownTargets
|
|
fail "No target"
|
|
Just (name, arch, platform) -> do
|
|
lns <- fmap lines $ readFile fn
|
|
writeFile (fn ++ "." ++ name) $ unlines (concatMap (f arch platform) lns)
|
|
return (fn ++ "." ++ name)
|
|
where f arch platform (span (== ' ') -> (length -> indentation, str)) | "$TARGET-SPECIFIC-STUFF" `isPrefixOf` str = generateArchSpecificLines arch platform indentation
|
|
f _ _ x = [x]
|
|
|
|
generateArchSpecificLines :: String -> String -> Int -> [String]
|
|
generateArchSpecificLines arch platform indentation =
|
|
[replicate indentation ' ' ++ "other-modules:" ++ unwords (targetModules arch platform)
|
|
,replicate indentation ' ' ++ "cpp-options:" ++ unwords (ghcOptions arch platform)]
|
|
|
|
generateHSBoot :: IO ()
|
|
generateHSBoot = mapM_ generateHSBoot' bootFiles
|
|
where
|
|
generateHSBoot' n = do
|
|
putStrLn ("Generating boot file for " ++ n)
|
|
r <- system ("perl mkhsboot.pl -l <" ++ n ++ " >"
|
|
++ n ++ "-boot")
|
|
unless (r == ExitSuccess) $ error "Couldn't generate boot file"
|
|
|
|
|