module Language.Atom.MSP430.Compile (
MSP430Compilation (..),
mspProgram, wiringProgram, simpleProgram, energiaProgram,
mspCompile
) where
import Language.Atom
import Control.Monad
import System.IO
data MSP430Compilation = MSP430Compilation {
setupFn :: Maybe (Atom ()),
setupFnName :: String,
loopFn :: Maybe (Atom ()),
loopFnName :: String,
timerAISR :: Maybe (Atom ()),
timerAISRName :: String,
watchdogISR :: Maybe (Atom ()),
watchdogISRName :: String,
port1ISR :: Maybe (Atom ()),
port1ISRName :: String,
port2ISR :: Maybe (Atom ()),
port2ISRName :: String,
mainFile :: String,
emitMainFn :: Bool
}
mspProgram :: MSP430Compilation
mspProgram = MSP430Compilation {
setupFn = Nothing,
setupFnName = "setup",
loopFn = Nothing,
loopFnName = "loop",
timerAISR = Nothing,
timerAISRName = "timerAISR",
watchdogISR = Nothing,
watchdogISRName = "wdtISR",
port1ISR = Nothing,
port1ISRName = "p1ISR",
port2ISR = Nothing,
port2ISRName = "p2ISR",
mainFile = "main.c",
emitMainFn = True
}
wiringProgram :: Atom () -> Atom () -> MSP430Compilation
wiringProgram s l = mspProgram {
setupFn = Just s,
loopFn = Just l
}
simpleProgram :: Atom () -> MSP430Compilation
simpleProgram s = mspProgram {
setupFn = Just s
}
energiaProgram :: Atom () -> Atom () -> MSP430Compilation
energiaProgram s l = mspProgram {
setupFn = Just s,
loopFn = Just l,
emitMainFn = False
}
mspCompile :: String -> MSP430Compilation -> IO ()
mspCompile h c = do
let headers = unlines $ map (\h -> "#include \"msp430" ++ h ++ ".h\"") [h]
let compile' = maybeCompile defaults {
cRuleCoverage = False,
cAssert = False,
cCode = \_ _ _ -> (headers, "")
}
compile' (setupFnName c) (setupFn c)
compile' (loopFnName c) (loopFn c)
compile' (timerAISRName c) (timerAISR c)
compile' (watchdogISRName c) (watchdogISR c)
compile' (port1ISRName c) (port1ISR c)
compile' (port2ISRName c) (port2ISR c)
putStrLn $ "Generating " ++ mainFile c ++ "..."
hFlush stdout
withFile (mainFile c) WriteMode $ \h -> do
let put = hPutStrLn h
let header' = maybeHeader h
let interrupt' = maybeInterrupt h
header' (setupFnName c) (setupFn c)
header' (loopFnName c) (loopFn c)
header' (timerAISRName c) (timerAISR c)
header' (watchdogISRName c) (watchdogISR c)
header' (port1ISRName c) (port1ISR c)
header' (port2ISRName c) (port2ISR c)
when (emitMainFn c) $ do
put headers
put "\nint main(void) {"
case setupFn c of
Just f -> put $ " " ++ setupFnName c ++ "();"
Nothing -> return ()
case loopFn c of
Just f -> put $ " while(1) " ++ loopFnName c ++ "();"
Nothing -> return ()
put " return 0;"
put "}\n"
interrupt' (watchdogISR c) (watchdogISRName c) "WDT_VECTOR"
interrupt' (timerAISR c) (timerAISRName c) "TIMERA0_VECTOR"
interrupt' (port1ISR c) (port1ISRName c) "PORT1_VECTOR"
interrupt' (port2ISR c) (port2ISRName c) "PORT2_VECTOR"
return ()
maybeCompile s n f = case f of
Nothing -> return ()
Just fn -> do
putStrLn $ "Compiling " ++ n ++ "..."
hFlush stdout
compile n s fn
return ()
maybeHeader h header f = case f of
Just _ -> hPutStrLn h $ "#include \"" ++ header ++ ".h\""
Nothing -> return ()
maybeInterrupt h a n v = case a of
Just _ -> do
let put = hPutStrLn h
put $ "#pragma vector=" ++ v
put $ "__interrupt void __" ++ n ++ "(void) {"
put $ " " ++ n ++ "();"
put "}\n"
Nothing -> return ()