From 219bfd9ce114882c07ef8c746ae1403b99afffe7 Mon Sep 17 00:00:00 2001 From: Neil Brown Date: Wed, 1 Apr 2009 14:35:47 +0000 Subject: [PATCH] Modified the C backend so that it will put the forward declarations into a header file and include that --- Main.hs | 41 +++++++++++++++++++++++++------------- backends/GenerateC.hs | 14 ++++++++----- backends/GenerateCBased.hs | 34 ++++++++++++++++++++++++------- backends/GenerateCPPCSP.hs | 6 +++--- 4 files changed, 66 insertions(+), 29 deletions(-) diff --git a/Main.hs b/Main.hs index f970cc0..ef5268d 100644 --- a/Main.hs +++ b/Main.hs @@ -251,7 +251,12 @@ compileFull inputFile moutputFile -- Translate input file to C/C++ 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 when (csRunIndent optsPS) $ exec $ "indent " ++ cFile @@ -271,7 +276,7 @@ compileFull inputFile moutputFile exec $ cCommand sFile oFile (csCompilerFlags optsPS) -- Analyse the assembly for stack sizes, and output a -- "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 exec $ cCommand postCFile postOFile (csCompilerFlags optsPS) -- Link the object files into a binary @@ -292,13 +297,16 @@ compileFull inputFile moutputFile liftIO $ removeFiles tempFiles where + intErr :: a + intErr = error "Internal error involving handles" + noteFile :: Monad m => FilePath -> StateT [FilePath] m () noteFile fp = modify (\fps -> (fp:fps)) - withOutputFile :: FilePath -> (Handle -> PassM ()) -> StateT [FilePath] PassM () + withOutputFile :: FilePath -> (Handle -> PassM ()) -> PassM () withOutputFile path func = do handle <- liftIO $ openFile path WriteMode - lift $ func handle + func handle liftIO $ hClose handle exec :: String -> StateT [FilePath] PassM () @@ -310,17 +318,22 @@ compileFull inputFile moutputFile 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: -useOutputOptions :: (Handle -> PassM ()) -> PassM () +useOutputOptions :: (((Handle, Handle, Handle), String) -> PassM ()) -> PassM () useOutputOptions func = do optsPS <- get - case csOutputFile optsPS of - "-" -> func stdout - file -> + withHandleFor (csOutputFile optsPS) $ \hb -> + withHandleFor (csOutputHeaderFile optsPS) $ \hh -> + withHandleFor (csOutputIncFile optsPS) $ \hi -> + func ((hb, hh, hi), csOutputHeaderFile optsPS) + where + withHandleFor "-" func = func stdout + withHandleFor file func = do progress $ "Writing output file " ++ file f <- liftIO $ openFile file WriteMode func f liftIO $ hClose f + showTokens :: Bool -> [Token] -> String showTokens html ts = evalState (mapM showToken ts >>* spaceOut) 0 where @@ -359,8 +372,8 @@ showTokens html ts = evalState (mapM showToken ts >>* spaceOut) 0 -- | Compile a file. -- 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. -compile :: CompMode -> String -> Handle -> PassM () -compile mode fn outHandle +compile :: CompMode -> String -> ((Handle, Handle, Handle), String) -> PassM () +compile mode fn (outHandles@(outHandle, _, _), headerName) = do optsPS <- get debug "{{{ Parse" @@ -411,8 +424,8 @@ compile mode fn outHandle let generator :: A.AST -> PassM () generator = case csBackend optsPS of - BackendC -> generateC outHandle - BackendCPPCSP -> generateCPPCSP outHandle + BackendC -> generateC outHandles headerName + BackendCPPCSP -> generateCPPCSP outHandles headerName BackendDumpAST -> liftIO . hPutStr outHandle . pshow BackendSource -> (liftIO . hPutStr outHandle) <.< showCode generator ast2 @@ -421,8 +434,8 @@ compile mode fn outHandle progress "Done" -- | Analyse an assembly file. -postCAnalyse :: String -> Handle -> PassM () -postCAnalyse fn outHandle +postCAnalyse :: String -> ((Handle, Handle, Handle), String) -> PassM () +postCAnalyse fn ((outHandle, _, _), _) = do asm <- liftIO $ readFile fn progress "Analysing assembly" diff --git a/backends/GenerateC.hs b/backends/GenerateC.hs index d18e70c..2ec6bd9 100644 --- a/backends/GenerateC.hs +++ b/backends/GenerateC.hs @@ -155,11 +155,11 @@ cgenOps = GenOps { --}}} --{{{ top-level -generateC :: Handle -> A.AST -> PassM () +generateC :: (Handle, Handle, Handle) -> String -> A.AST -> PassM () generateC = generate cgenOps -cgenTopLevel :: A.AST -> CGen () -cgenTopLevel s +cgenTopLevel :: String -> A.AST -> CGen () +cgenTopLevel headerName s = do tell ["#define occam_INT_size ", show cIntSize,"\n"] tell ["#include \n"] cs <- getCompState @@ -168,8 +168,10 @@ cgenTopLevel s killChans <- sequence [csmLift $ makeNonce "tlp_channel_kill" | _ <- tlpChans] workspaces <- sequence [csmLift $ makeNonce "tlp_channel_ws" | _ <- tlpChans] - sequence_ $ map (call genForwardDeclaration) - (listify (const True :: A.Specification -> Bool) s) + tellToHeader $ sequence_ $ map (call genForwardDeclaration) + (listify (const True :: A.Specification -> Bool) s) + + tell ["#include \"", dropPath headerName, "\"\n"] sequence_ [tell ["extern int ", nameString n, "_stack_size;\n"] | n <- (Set.toList $ csParProcs cs) @@ -230,6 +232,8 @@ cgenTopLevel s \ return 0;\n\ \}\n"] where + dropPath = reverse . takeWhile (/= '/') . reverse + mungeExternalName (_:cs) = [if c == '.' then '_' else c | c <- cs] -- | Allocate a TLP channel handler process, and return the function that diff --git a/backends/GenerateCBased.hs b/backends/GenerateCBased.hs index fde4ce9..040e174 100644 --- a/backends/GenerateCBased.hs +++ b/backends/GenerateCBased.hs @@ -32,6 +32,7 @@ import Errors import Metadata import Pass import qualified Properties as Prop +import Utils cCppCommonPreReq :: [Property] cCppCommonPreReq = @@ -53,9 +54,15 @@ cCppCommonPreReq = ,Prop.typesResolvedInState ] +type CGenOutput = Either [String] Handle +data CGenOutputs = CGenOutputs + { cgenBody :: CGenOutput + , cgenHeader :: CGenOutput + , cgenOccamInc :: CGenOutput + } --{{{ monad definition -type CGen' = StateT (Either [String] Handle) PassM +type CGen' = StateT CGenOutputs PassM type CGen = ReaderT GenOps CGen' instance Die CGen where @@ -67,11 +74,21 @@ instance CSMR CGen' where instance CSMR CGen where 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 x = do st <- get - case st of - Left prev -> put $ Left (prev ++ x) - Right h -> liftIO $ mapM_ (hPutStr h) x + case cgenBody st of + Left prev -> put $ st { cgenBody = Left (prev ++ x) } + Right h -> liftIO $ mapM_ (hPutStr h) x csmLift :: PassM a -> CGen a 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], genTimerRead :: A.Variable -> A.Variable -> CGen (), genTimerWait :: A.Expression -> CGen (), - genTopLevel :: A.AST -> CGen (), + genTopLevel :: String -> A.AST -> CGen (), genTypeSymbol :: String -> A.Type -> CGen (), genUnfoldedExpression :: A.Expression -> 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 = asks -generate :: GenOps -> Handle -> A.AST -> PassM () -generate ops h ast = evalStateT (runReaderT (call genTopLevel ast) ops) (Right h) +-- Handles are body, header, occam-inc +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 = tell [","] diff --git a/backends/GenerateCPPCSP.hs b/backends/GenerateCPPCSP.hs index a05157f..2089465 100644 --- a/backends/GenerateCPPCSP.hs +++ b/backends/GenerateCPPCSP.hs @@ -122,7 +122,7 @@ chansToAny = cppOnlyPass "Transform channels to ANY" --{{{ top-level -- | 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 cppcspPrereq :: [Property] @@ -130,8 +130,8 @@ cppcspPrereq = cCppCommonPreReq ++ [Prop.allChansToAnyOrProtocol] -- | Generates the top-level code for an AST. -cppgenTopLevel :: A.AST -> CGen () -cppgenTopLevel s +cppgenTopLevel :: String -> A.AST -> CGen () +cppgenTopLevel headerName s = do tell ["#define occam_INT_size ", show cxxIntSize,"\n"] tell ["#include \n"] --In future, these declarations could be moved to a header file: