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