1{- 2 Mackerel: a strawman device definition DSL for Barrelfish 3 4 Copyright (c) 2007-2011, ETH Zurich. 5 All rights reserved. 6 7 This file is distributed under the terms in the attached LICENSE file. 8 If you do not find this file, copies can be found by writing to: 9 ETH Zurich D-INFK, Haldeneggsteig 4, CH-8092 Zurich. Attn: Systems Group. 10-} 11 12module Main where 13 14import System.IO 15import System.IO.Error 16import System.Console.GetOpt 17import System.FilePath 18import System.Exit 19import System.Environment 20import Data.Maybe 21import Data.List 22import Text.ParserCombinators.Parsec as Parsec 23import Text.Printf 24import qualified MackerelParser 25import qualified BitFieldDriver 26import qualified ShiftDriver 27import Checks 28import Dev 29import Control.Exception 30 31-- 32-- Command line options and parsing code 33-- 34 35-- Datatypes for carrying command options around 36data Target = BitFieldDriver | ShiftDriver | NullDriver deriving (Eq, Show) 37 38data Options = Options { 39 opt_infilename :: Maybe String, 40 opt_outfilename :: Maybe String, 41 opt_includedirs :: [String], 42 opt_target :: Target, 43 opt_usage_error :: Bool, 44 opt_verbosity :: Integer 45 } deriving (Show,Eq) 46 47defaultOptions :: Options 48defaultOptions = Options { 49 opt_infilename = Nothing, 50 opt_outfilename = Nothing, 51 opt_includedirs = [], 52 opt_target = ShiftDriver, 53 opt_usage_error = False, 54 opt_verbosity = 1 } 55 56-- For driving System.GetOpt 57options :: [OptDescr (Options -> Options)] 58options = 59 [ Option ['c'] ["input-file"] 60 (ReqArg (\f opts -> opts { opt_infilename = Just f } ) "file") 61 "input file" 62 , Option ['I'] ["include-dir"] 63 (ReqArg (\ d opts -> opts { opt_includedirs = opt_includedirs opts ++ [d] }) "dir") 64 "include directory (can be given multiple times)" 65 , Option ['v'] ["verbose"] 66 (NoArg (\ opts -> opts { opt_verbosity = opt_verbosity opts + 1 } )) 67 "increase verbosity level" 68 , Option ['o'] ["output"] 69 (ReqArg (\ f opts -> opts { opt_outfilename = Just f }) "file") 70 "output file name" 71 , Option ['S'] ["shift-driver"] 72 (NoArg (\ opts -> opts { opt_target = ShiftDriver } )) 73 "use shift driver (default; preferred)" 74 , Option ['n'] ["null-driver"] 75 (NoArg (\ opts -> opts { opt_target = NullDriver } )) 76 "use null output driver (don't generate any C)" 77 , Option ['B'] ["bitfield-driver"] 78 (NoArg (\ opts -> opts { opt_target = BitFieldDriver } )) 79 "use bitfield driver (deprecrated: do not use)" 80 ] 81 82-- 83-- Set the correct default input and output files 84-- 85 86defaultOutput :: Options -> Options 87defaultOutput opts = 88 case opt_outfilename opts of 89 (Just _) -> 90 opts 91 Nothing -> 92 opts { opt_outfilename = 93 Just (case opt_infilename opts of 94 (Just i) -> 95 ((dropExtension $ takeFileName i) ++ "_dev.h") 96 Nothing -> "mackerel_output.h" 97 ) 98 } 99 100defaultInput :: Options -> [String] -> IO (Options) 101defaultInput opts [f] = 102 if isNothing $ opt_infilename opts 103 then return (defaultOutput (opts { opt_infilename = Just f })) 104 else usageError [] 105defaultInput opts [] = 106 if (isJust $ opt_infilename opts) 107 then return (defaultOutput opts) 108 else usageError [] 109defaultInput _ _ = usageError [] 110 111compilerOpts :: [String] -> IO (Options) 112compilerOpts argv = 113 case getOpt Permute options argv of 114 (o,n,[]) -> defaultInput (foldl (flip id) defaultOptions o) n 115 (_,_,errs) -> usageError errs 116 117usageError :: [String] -> IO (Options) 118usageError errs = 119 ioError (userError (concat errs ++ usageInfo usage options)) 120 where usage = "Usage: mackerel <options> <input file>" 121 122-- 123-- Processing source files 124--- 125 126-- Null compilation 127nullCompiler :: String -> String -> Dev.Rec -> String 128nullCompiler _ _ _ = "" 129 130-- Perform run-time checks 131run_checks :: String -> Dev.Rec -> IO String 132run_checks input_fn dev = 133 case (Checks.check_all input_fn dev) of 134 Just errors -> 135 do { (hPutStrLn stderr (unlines [ e ++ "\n" | e <-errors])) 136 ; System.Exit.exitWith (ExitFailure 1) 137 } 138 Nothing -> do { return "" } 139 140-- Parsing the input file into an AST 141parseFile :: String -> IO MackerelParser.DeviceFile 142parseFile fname = do 143 src <- readFile fname 144 case (runParser MackerelParser.devfile () fname src) of 145 Left err -> ioError $ userError ("Parse error at: " ++ (show err)) 146 Right x -> return x 147 148-- Traverse the include path to find an import file 149findImport :: [String] -> String -> IO MackerelParser.DeviceFile 150findImport [] f = 151 ioError (userError $ printf "Can't find import '%s'" f) 152findImport (d:t) f = 153 do 154 catch (parseFile (d </> f)) 155 (\e -> (if isDoesNotExistError e then findImport t f else ioError e)) 156 157-- Perform the transitive closure of all the imports 158 159resolveImports :: [MackerelParser.DeviceFile] -> [String] 160 -> IO [MackerelParser.DeviceFile] 161resolveImports dfl path = 162 let allimports = nub $ concat [ il | (MackerelParser.DeviceFile _ il) <- dfl ] 163 gotimports = [ n | (MackerelParser.DeviceFile (MackerelParser.Device n _ _ _ _) _) <- dfl ] 164 required = allimports \\ gotimports 165 in 166 case required of 167 [] -> return dfl 168 (t:_) -> do { i <- (findImport path (t ++ ".dev")) 169 ; resolveImports (dfl ++ [i]) path 170 } 171 172testentry :: IO () 173testentry = 174 let input_fn = "../../devices/xapic.dev" 175 output_fn = "x2apic.dev.h" 176 includedirs = ["../../devices"] 177 in 178 do { hPutStrLn stdout ("IN: " ++ input_fn) 179 ; hPutStrLn stdout ("OUT: " ++ output_fn) 180 ; df <- parseFile input_fn 181 ; dfl <- resolveImports [df] includedirs 182 ; let dev = make_dev df (tail dfl) in 183 do { _ <- run_checks input_fn dev 184 ; outFileD <- openFile output_fn WriteMode 185 ; hPutStr outFileD (ShiftDriver.compile input_fn output_fn dev) 186 ; hClose outFileD 187 } 188 } 189 190 191-- Main entry point of Mackernel 192main :: IO () 193main = do { cli <- System.Environment.getArgs 194 ; opts <- compilerOpts cli 195 ; let input_fn = fromJust $ opt_infilename opts 196 output_fn = fromJust $ opt_outfilename opts 197 in 198 do { df <- parseFile input_fn 199 ; dfl <- resolveImports [df] (opt_includedirs opts) 200 ; let dev = make_dev df (tail dfl) in 201 do { _ <- run_checks input_fn dev 202 ; outFileD <- openFile output_fn WriteMode 203 ; hPutStr outFileD ((case (opt_target opts) of 204 NullDriver -> nullCompiler 205 ShiftDriver -> ShiftDriver.compile 206 BitFieldDriver -> BitFieldDriver.compile) 207 input_fn output_fn dev) 208 ; hClose outFileD 209 } 210 } 211 } 212