Modified the C backend so that it will put the forward declarations into a header file and include that
This commit is contained in:
parent
b830b27066
commit
219bfd9ce1
41
Main.hs
41
Main.hs
|
@ -251,7 +251,12 @@ compileFull inputFile moutputFile
|
||||||
|
|
||||||
-- Translate input file to C/C++
|
-- Translate input file to C/C++
|
||||||
let cFile = outputFile ++ extension
|
let cFile = outputFile ++ extension
|
||||||
withOutputFile cFile $ compile ModeCompile inputFile
|
hFile = outputFile ++ ".h"
|
||||||
|
iFile = outputFile ++ ".inc"
|
||||||
|
lift $ withOutputFile cFile $ \hb ->
|
||||||
|
withOutputFile hFile $ \hh ->
|
||||||
|
withOutputFile iFile $ \hi ->
|
||||||
|
compile ModeCompile inputFile ((hb, hh, hi), hFile)
|
||||||
noteFile cFile
|
noteFile cFile
|
||||||
when (csRunIndent optsPS) $
|
when (csRunIndent optsPS) $
|
||||||
exec $ "indent " ++ cFile
|
exec $ "indent " ++ cFile
|
||||||
|
@ -271,7 +276,7 @@ compileFull inputFile moutputFile
|
||||||
exec $ cCommand sFile oFile (csCompilerFlags optsPS)
|
exec $ cCommand sFile oFile (csCompilerFlags optsPS)
|
||||||
-- Analyse the assembly for stack sizes, and output a
|
-- Analyse the assembly for stack sizes, and output a
|
||||||
-- "post" C file
|
-- "post" C file
|
||||||
withOutputFile postCFile $ postCAnalyse sFile
|
lift $ withOutputFile postCFile $ \h -> postCAnalyse sFile ((h,intErr,intErr),intErr)
|
||||||
-- Compile this new "post" C file into an object file
|
-- Compile this new "post" C file into an object file
|
||||||
exec $ cCommand postCFile postOFile (csCompilerFlags optsPS)
|
exec $ cCommand postCFile postOFile (csCompilerFlags optsPS)
|
||||||
-- Link the object files into a binary
|
-- Link the object files into a binary
|
||||||
|
@ -292,13 +297,16 @@ compileFull inputFile moutputFile
|
||||||
liftIO $ removeFiles tempFiles
|
liftIO $ removeFiles tempFiles
|
||||||
|
|
||||||
where
|
where
|
||||||
|
intErr :: a
|
||||||
|
intErr = error "Internal error involving handles"
|
||||||
|
|
||||||
noteFile :: Monad m => FilePath -> StateT [FilePath] m ()
|
noteFile :: Monad m => FilePath -> StateT [FilePath] m ()
|
||||||
noteFile fp = modify (\fps -> (fp:fps))
|
noteFile fp = modify (\fps -> (fp:fps))
|
||||||
|
|
||||||
withOutputFile :: FilePath -> (Handle -> PassM ()) -> StateT [FilePath] PassM ()
|
withOutputFile :: FilePath -> (Handle -> PassM ()) -> PassM ()
|
||||||
withOutputFile path func
|
withOutputFile path func
|
||||||
= do handle <- liftIO $ openFile path WriteMode
|
= do handle <- liftIO $ openFile path WriteMode
|
||||||
lift $ func handle
|
func handle
|
||||||
liftIO $ hClose handle
|
liftIO $ hClose handle
|
||||||
|
|
||||||
exec :: String -> StateT [FilePath] PassM ()
|
exec :: String -> StateT [FilePath] PassM ()
|
||||||
|
@ -310,17 +318,22 @@ compileFull inputFile moutputFile
|
||||||
ExitFailure n -> dieReport (Nothing, "Command \"" ++ cmd ++ "\" failed: exited with code: " ++ show n)
|
ExitFailure n -> dieReport (Nothing, "Command \"" ++ cmd ++ "\" failed: exited with code: " ++ show n)
|
||||||
|
|
||||||
-- | Picks out the handle from the options and passes it to the function:
|
-- | Picks out the handle from the options and passes it to the function:
|
||||||
useOutputOptions :: (Handle -> PassM ()) -> PassM ()
|
useOutputOptions :: (((Handle, Handle, Handle), String) -> PassM ()) -> PassM ()
|
||||||
useOutputOptions func
|
useOutputOptions func
|
||||||
= do optsPS <- get
|
= do optsPS <- get
|
||||||
case csOutputFile optsPS of
|
withHandleFor (csOutputFile optsPS) $ \hb ->
|
||||||
"-" -> func stdout
|
withHandleFor (csOutputHeaderFile optsPS) $ \hh ->
|
||||||
file ->
|
withHandleFor (csOutputIncFile optsPS) $ \hi ->
|
||||||
|
func ((hb, hh, hi), csOutputHeaderFile optsPS)
|
||||||
|
where
|
||||||
|
withHandleFor "-" func = func stdout
|
||||||
|
withHandleFor file func =
|
||||||
do progress $ "Writing output file " ++ file
|
do progress $ "Writing output file " ++ file
|
||||||
f <- liftIO $ openFile file WriteMode
|
f <- liftIO $ openFile file WriteMode
|
||||||
func f
|
func f
|
||||||
liftIO $ hClose f
|
liftIO $ hClose f
|
||||||
|
|
||||||
|
|
||||||
showTokens :: Bool -> [Token] -> String
|
showTokens :: Bool -> [Token] -> String
|
||||||
showTokens html ts = evalState (mapM showToken ts >>* spaceOut) 0
|
showTokens html ts = evalState (mapM showToken ts >>* spaceOut) 0
|
||||||
where
|
where
|
||||||
|
@ -359,8 +372,8 @@ showTokens html ts = evalState (mapM showToken ts >>* spaceOut) 0
|
||||||
-- | Compile a file.
|
-- | Compile a file.
|
||||||
-- This is written in the PassM monad -- as are most of the things it calls --
|
-- This is written in the PassM monad -- as are most of the things it calls --
|
||||||
-- because then it's very easy to pass the state around.
|
-- because then it's very easy to pass the state around.
|
||||||
compile :: CompMode -> String -> Handle -> PassM ()
|
compile :: CompMode -> String -> ((Handle, Handle, Handle), String) -> PassM ()
|
||||||
compile mode fn outHandle
|
compile mode fn (outHandles@(outHandle, _, _), headerName)
|
||||||
= do optsPS <- get
|
= do optsPS <- get
|
||||||
|
|
||||||
debug "{{{ Parse"
|
debug "{{{ Parse"
|
||||||
|
@ -411,8 +424,8 @@ compile mode fn outHandle
|
||||||
let generator :: A.AST -> PassM ()
|
let generator :: A.AST -> PassM ()
|
||||||
generator
|
generator
|
||||||
= case csBackend optsPS of
|
= case csBackend optsPS of
|
||||||
BackendC -> generateC outHandle
|
BackendC -> generateC outHandles headerName
|
||||||
BackendCPPCSP -> generateCPPCSP outHandle
|
BackendCPPCSP -> generateCPPCSP outHandles headerName
|
||||||
BackendDumpAST -> liftIO . hPutStr outHandle . pshow
|
BackendDumpAST -> liftIO . hPutStr outHandle . pshow
|
||||||
BackendSource -> (liftIO . hPutStr outHandle) <.< showCode
|
BackendSource -> (liftIO . hPutStr outHandle) <.< showCode
|
||||||
generator ast2
|
generator ast2
|
||||||
|
@ -421,8 +434,8 @@ compile mode fn outHandle
|
||||||
progress "Done"
|
progress "Done"
|
||||||
|
|
||||||
-- | Analyse an assembly file.
|
-- | Analyse an assembly file.
|
||||||
postCAnalyse :: String -> Handle -> PassM ()
|
postCAnalyse :: String -> ((Handle, Handle, Handle), String) -> PassM ()
|
||||||
postCAnalyse fn outHandle
|
postCAnalyse fn ((outHandle, _, _), _)
|
||||||
= do asm <- liftIO $ readFile fn
|
= do asm <- liftIO $ readFile fn
|
||||||
|
|
||||||
progress "Analysing assembly"
|
progress "Analysing assembly"
|
||||||
|
|
|
@ -155,11 +155,11 @@ cgenOps = GenOps {
|
||||||
--}}}
|
--}}}
|
||||||
|
|
||||||
--{{{ top-level
|
--{{{ top-level
|
||||||
generateC :: Handle -> A.AST -> PassM ()
|
generateC :: (Handle, Handle, Handle) -> String -> A.AST -> PassM ()
|
||||||
generateC = generate cgenOps
|
generateC = generate cgenOps
|
||||||
|
|
||||||
cgenTopLevel :: A.AST -> CGen ()
|
cgenTopLevel :: String -> A.AST -> CGen ()
|
||||||
cgenTopLevel s
|
cgenTopLevel headerName s
|
||||||
= do tell ["#define occam_INT_size ", show cIntSize,"\n"]
|
= do tell ["#define occam_INT_size ", show cIntSize,"\n"]
|
||||||
tell ["#include <tock_support_cif.h>\n"]
|
tell ["#include <tock_support_cif.h>\n"]
|
||||||
cs <- getCompState
|
cs <- getCompState
|
||||||
|
@ -168,8 +168,10 @@ cgenTopLevel s
|
||||||
killChans <- sequence [csmLift $ makeNonce "tlp_channel_kill" | _ <- tlpChans]
|
killChans <- sequence [csmLift $ makeNonce "tlp_channel_kill" | _ <- tlpChans]
|
||||||
workspaces <- sequence [csmLift $ makeNonce "tlp_channel_ws" | _ <- tlpChans]
|
workspaces <- sequence [csmLift $ makeNonce "tlp_channel_ws" | _ <- tlpChans]
|
||||||
|
|
||||||
sequence_ $ map (call genForwardDeclaration)
|
tellToHeader $ sequence_ $ map (call genForwardDeclaration)
|
||||||
(listify (const True :: A.Specification -> Bool) s)
|
(listify (const True :: A.Specification -> Bool) s)
|
||||||
|
|
||||||
|
tell ["#include \"", dropPath headerName, "\"\n"]
|
||||||
|
|
||||||
sequence_ [tell ["extern int ", nameString n, "_stack_size;\n"]
|
sequence_ [tell ["extern int ", nameString n, "_stack_size;\n"]
|
||||||
| n <- (Set.toList $ csParProcs cs)
|
| n <- (Set.toList $ csParProcs cs)
|
||||||
|
@ -230,6 +232,8 @@ cgenTopLevel s
|
||||||
\ return 0;\n\
|
\ return 0;\n\
|
||||||
\}\n"]
|
\}\n"]
|
||||||
where
|
where
|
||||||
|
dropPath = reverse . takeWhile (/= '/') . reverse
|
||||||
|
|
||||||
mungeExternalName (_:cs) = [if c == '.' then '_' else c | c <- cs]
|
mungeExternalName (_:cs) = [if c == '.' then '_' else c | c <- cs]
|
||||||
|
|
||||||
-- | Allocate a TLP channel handler process, and return the function that
|
-- | Allocate a TLP channel handler process, and return the function that
|
||||||
|
|
|
@ -32,6 +32,7 @@ import Errors
|
||||||
import Metadata
|
import Metadata
|
||||||
import Pass
|
import Pass
|
||||||
import qualified Properties as Prop
|
import qualified Properties as Prop
|
||||||
|
import Utils
|
||||||
|
|
||||||
cCppCommonPreReq :: [Property]
|
cCppCommonPreReq :: [Property]
|
||||||
cCppCommonPreReq =
|
cCppCommonPreReq =
|
||||||
|
@ -53,9 +54,15 @@ cCppCommonPreReq =
|
||||||
,Prop.typesResolvedInState
|
,Prop.typesResolvedInState
|
||||||
]
|
]
|
||||||
|
|
||||||
|
type CGenOutput = Either [String] Handle
|
||||||
|
data CGenOutputs = CGenOutputs
|
||||||
|
{ cgenBody :: CGenOutput
|
||||||
|
, cgenHeader :: CGenOutput
|
||||||
|
, cgenOccamInc :: CGenOutput
|
||||||
|
}
|
||||||
|
|
||||||
--{{{ monad definition
|
--{{{ monad definition
|
||||||
type CGen' = StateT (Either [String] Handle) PassM
|
type CGen' = StateT CGenOutputs PassM
|
||||||
type CGen = ReaderT GenOps CGen'
|
type CGen = ReaderT GenOps CGen'
|
||||||
|
|
||||||
instance Die CGen where
|
instance Die CGen where
|
||||||
|
@ -67,11 +74,21 @@ instance CSMR CGen' where
|
||||||
instance CSMR CGen where
|
instance CSMR CGen where
|
||||||
getCompState = lift getCompState
|
getCompState = lift getCompState
|
||||||
|
|
||||||
|
-- Do not nest calls to this function!
|
||||||
|
tellToHeader :: CGen a -> CGen a
|
||||||
|
tellToHeader act
|
||||||
|
= do st <- get
|
||||||
|
put $ st { cgenBody = cgenHeader st }
|
||||||
|
x <- act
|
||||||
|
st' <- get
|
||||||
|
put $ st' { cgenBody = cgenBody st, cgenHeader = cgenBody st' }
|
||||||
|
return x
|
||||||
|
|
||||||
tell :: [String] -> CGen ()
|
tell :: [String] -> CGen ()
|
||||||
tell x = do st <- get
|
tell x = do st <- get
|
||||||
case st of
|
case cgenBody st of
|
||||||
Left prev -> put $ Left (prev ++ x)
|
Left prev -> put $ st { cgenBody = Left (prev ++ x) }
|
||||||
Right h -> liftIO $ mapM_ (hPutStr h) x
|
Right h -> liftIO $ mapM_ (hPutStr h) x
|
||||||
|
|
||||||
csmLift :: PassM a -> CGen a
|
csmLift :: PassM a -> CGen a
|
||||||
csmLift = lift . lift
|
csmLift = lift . lift
|
||||||
|
@ -173,7 +190,7 @@ data GenOps = GenOps {
|
||||||
genStructured :: forall a b. Data a => A.Structured a -> (Meta -> a -> CGen b) -> CGen [b],
|
genStructured :: forall a b. Data a => A.Structured a -> (Meta -> a -> CGen b) -> CGen [b],
|
||||||
genTimerRead :: A.Variable -> A.Variable -> CGen (),
|
genTimerRead :: A.Variable -> A.Variable -> CGen (),
|
||||||
genTimerWait :: A.Expression -> CGen (),
|
genTimerWait :: A.Expression -> CGen (),
|
||||||
genTopLevel :: A.AST -> CGen (),
|
genTopLevel :: String -> A.AST -> CGen (),
|
||||||
genTypeSymbol :: String -> A.Type -> CGen (),
|
genTypeSymbol :: String -> A.Type -> CGen (),
|
||||||
genUnfoldedExpression :: A.Expression -> CGen (),
|
genUnfoldedExpression :: A.Expression -> CGen (),
|
||||||
genUnfoldedVariable :: Meta -> A.Variable -> CGen (),
|
genUnfoldedVariable :: Meta -> A.Variable -> CGen (),
|
||||||
|
@ -228,8 +245,11 @@ instance CGenCall (a -> b -> c -> d -> e -> CGen z) where
|
||||||
fget :: (GenOps -> a) -> CGen a
|
fget :: (GenOps -> a) -> CGen a
|
||||||
fget = asks
|
fget = asks
|
||||||
|
|
||||||
generate :: GenOps -> Handle -> A.AST -> PassM ()
|
-- Handles are body, header, occam-inc
|
||||||
generate ops h ast = evalStateT (runReaderT (call genTopLevel ast) ops) (Right h)
|
generate :: GenOps -> (Handle, Handle, Handle) -> String -> A.AST -> PassM ()
|
||||||
|
generate ops (hb, hh, hi) hname ast
|
||||||
|
= evalStateT (runReaderT (call genTopLevel hname ast) ops)
|
||||||
|
(CGenOutputs (Right hb) (Right hh) (Right hi))
|
||||||
|
|
||||||
genComma :: CGen ()
|
genComma :: CGen ()
|
||||||
genComma = tell [","]
|
genComma = tell [","]
|
||||||
|
|
|
@ -122,7 +122,7 @@ chansToAny = cppOnlyPass "Transform channels to ANY"
|
||||||
|
|
||||||
--{{{ top-level
|
--{{{ top-level
|
||||||
-- | Transforms the given AST into a pass that generates C++ code.
|
-- | Transforms the given AST into a pass that generates C++ code.
|
||||||
generateCPPCSP :: Handle -> A.AST -> PassM ()
|
generateCPPCSP :: (Handle, Handle, Handle) -> String -> A.AST -> PassM ()
|
||||||
generateCPPCSP = generate cppgenOps
|
generateCPPCSP = generate cppgenOps
|
||||||
|
|
||||||
cppcspPrereq :: [Property]
|
cppcspPrereq :: [Property]
|
||||||
|
@ -130,8 +130,8 @@ cppcspPrereq = cCppCommonPreReq ++ [Prop.allChansToAnyOrProtocol]
|
||||||
|
|
||||||
|
|
||||||
-- | Generates the top-level code for an AST.
|
-- | Generates the top-level code for an AST.
|
||||||
cppgenTopLevel :: A.AST -> CGen ()
|
cppgenTopLevel :: String -> A.AST -> CGen ()
|
||||||
cppgenTopLevel s
|
cppgenTopLevel headerName s
|
||||||
= do tell ["#define occam_INT_size ", show cxxIntSize,"\n"]
|
= do tell ["#define occam_INT_size ", show cxxIntSize,"\n"]
|
||||||
tell ["#include <tock_support_cppcsp.h>\n"]
|
tell ["#include <tock_support_cppcsp.h>\n"]
|
||||||
--In future, these declarations could be moved to a header file:
|
--In future, these declarations could be moved to a header file:
|
||||||
|
|
Loading…
Reference in New Issue
Block a user