Modified the C backend so that it will put the forward declarations into a header file and include that

This commit is contained in:
Neil Brown 2009-04-01 14:35:47 +00:00
parent b830b27066
commit 219bfd9ce1
4 changed files with 66 additions and 29 deletions

41
Main.hs
View File

@ -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"

View File

@ -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

View File

@ -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 [","]

View File

@ -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: