suzanne.soy/tock-mirror
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Changed the C and C++ backends to write directly to the output file, to save building up the strings in memory

Browse Source
This commit is contained in:
Neil Brown 2008-03-08 14:10:05 +00:00
parent c87581e490
commit ba9ac70d7c
5 changed files with 83 additions and 46 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
Main.hs
View File

@ -272,9 +272,8 @@ compile mode fn outHandle
debugAST ast1
debug "}}}"
output <-
case mode of
ModeParse -> return $ pshow ast1
case mode of
ModeParse -> liftIO $ hPutStr outHandle $ pshow ast1
ModeFlowGraph ->
do procs <- findAllProcesses
let fs :: Data t => t -> PassM String
@ -290,7 +289,7 @@ compile mode fn outHandle
-- graphs is of course identical to graphsTyped, as you can see here:
let (graphsTyped :: [Maybe (FlowGraph' Identity String A.Process)]) = map (transformMaybe fst) graphs
-- TODO: output each process to a separate file, rather than just taking the first:
return $ head $ map makeFlowGraphInstr (catMaybes graphsTyped)
liftIO $ hPutStr outHandle $ head $ map makeFlowGraphInstr (catMaybes graphsTyped)
ModeCompile ->
do progress "Passes:"
@ -301,16 +300,12 @@ compile mode fn outHandle
progress $ "- Backend: " ++ (show $ csBackend optsPS)
let generator
= case csBackend optsPS of
BackendC -> generateC
BackendCPPCSP -> generateCPPCSP
BackendDumpAST -> return . pshow
code <- generator ast2
BackendC -> generateC outHandle
BackendCPPCSP -> generateCPPCSP outHandle
BackendDumpAST -> liftIO . hPutStr outHandle . pshow
generator ast2
debug "}}}"
return code
liftIO $ hPutStr outHandle output
progress "Done"
-- | Analyse an assembly file.

56
backends/GenerateC.hs
View File

@ -24,9 +24,8 @@ import Data.Generics
import Data.List
import Data.Maybe
import qualified Data.Set as Set
import Control.Monad.Reader
import Control.Monad.State
import Control.Monad.Writer
import System.IO
import Text.Printf
import Text.Regex
@ -139,10 +138,7 @@ cgenOps = GenOps {
--}}}
--{{{ top-level
generate :: GenOps -> A.AST -> PassM String
generate ops ast = execWriterT (runReaderT (call genTopLevel ast) ops) >>* concat
generateC :: A.AST -> PassM String
generateC :: Handle -> A.AST -> PassM ()
generateC = generate cgenOps
cgenTLPChannel :: TLPChannel -> CGen ()
@ -153,7 +149,7 @@ cgenTLPChannel TLPError = tell ["err"]
cgenTopLevel :: A.AST -> CGen ()
cgenTopLevel s
= do tell ["#include <tock_support_cif.h>\n"]
cs <- get
cs <- getCompState
(tlpName, chans) <- tlpInterface
sequence_ $ map (call genForwardDeclaration)
@ -219,7 +215,7 @@ genRightB = tell ["}"]
cgenOverArray :: Meta -> A.Variable -> (SubscripterFunction -> Maybe (CGen ())) -> CGen ()
cgenOverArray m var func
= do A.Array ds _ <- typeOfVariable var
specs <- sequence [makeNonceVariable "i" m A.Int A.VariableName A.Original | _ <- ds]
specs <- sequence [csmLift $ makeNonceVariable "i" m A.Int A.VariableName A.Original | _ <- ds]
let indices = [A.Variable m n | A.Specification _ n _ <- specs]
let arg = (\var -> foldl (\v s -> A.SubscriptedVariable m s v) var [A.Subscript m $ A.ExprVariable m i | i <- indices])
@ -997,7 +993,7 @@ cgenReplicatorLoop (A.For m index base count)
general :: CGen ()
general
= do counter <- makeNonce "replicator_count"
= do counter <- csmLift $ makeNonce "replicator_count"
tell ["int ", counter, "="]
call genExpression count
tell [","]
@ -1192,7 +1188,7 @@ cintroduceSpec (A.Specification _ n (A.IsExpr _ am t e))
(A.ValAbbrev, A.Record _, A.Literal _ _ _) ->
-- Record literals are even trickier, because there's no way of
-- directly writing a struct literal in C that you can use -> on.
do tmp <- makeNonce "record_literal"
do tmp <- csmLift $ makeNonce "record_literal"
tell ["const "]
call genType t
tell [" ", tmp, " = "]
@ -1469,7 +1465,7 @@ cgenSeq s = call genStructured s doP
--{{{ if
cgenIf :: Meta -> A.Structured A.Choice -> CGen ()
cgenIf m s
= do label <- makeNonce "if_end"
= do label <- csmLift $ makeNonce "if_end"
tell ["/*",label,"*/"]
genIfBody label s
call genStop m "no choice matched in IF process"
@ -1533,7 +1529,37 @@ cgenWhile e p
-- the same as PAR.
cgenPar :: A.ParMode -> A.Structured A.Process -> CGen ()
cgenPar pm s
= do (count, _, _) <- constantFold $ countStructured s
= do (size, _, _) <- constantFold $ addOne (sizeOfStructured s)
pids <- makeNonce "pids"
pris <- makeNonce "priorities"
index <- makeNonce "i"
when (pm == A.PriPar) $
do tell ["int ", pris, "["]
call genExpression size
tell ["];\n"]
tell ["Process *", pids, "["]
call genExpression size
tell ["];\n"]
tell ["int ", index, " = 0;\n"]
call genStructured s (createP pids pris index)
tell [pids, "[", index, "] = NULL;\n"]
tell ["if(",pids,"[0] != NULL){"] -- CIF seems to deadlock when you give ProcParList a list
-- beginning with NULL (i.e. with no processes)
case pm of
A.PriPar -> tell ["ProcPriParList (", pids, ", ", pris, ");\n"]
_ -> tell ["ProcParList (", pids, ");\n"]
tell ["}"]
tell [index, " = 0;\n"]
call genStructured s (freeP pids index)
where
createP pids pris index _ p
= do when (pm == A.PriPar) $
tell [pris, "[", index, "] = ", index, ";\n"]
tell [pids, "[", index, "++] = "]
genProcAlloc p
tell [";\n"]
freeP pids index _ _
= do tell ["ProcAllocClean (", pids, "[", index, "++]);\n"]
bar <- makeNonce "par_barrier"
tell ["LightProcBarrier ", bar, ";\n"]
@ -1562,15 +1588,15 @@ cgenAlt isPri s
tell ["}\n"]
-- Like occ21, this is always a PRI ALT, so we can use it for both.
tell ["AltWait (wptr);\n"]
id <- makeNonce "alt_id"
id <- csmLift $ makeNonce "alt_id"
tell ["int ", id, " = 0;\n"]
tell ["{\n"]
genAltDisable id s
tell ["}\n"]
fired <- makeNonce "alt_fired"
fired <- csmLift $ makeNonce "alt_fired"
tell ["int ", fired, " = AltEnd (wptr);\n"]
tell [id, " = 0;\n"]
label <- makeNonce "alt_end"
label <- csmLift $ makeNonce "alt_end"
tell ["{\n"]
genAltProcesses id fired label s
tell ["}\n"]

20
backends/GenerateCBased.hs
View File

@ -21,8 +21,10 @@ module GenerateCBased where
import Control.Monad.Error
import Control.Monad.Reader
import Control.Monad.State
import Control.Monad.Writer
import Data.Generics
import System.IO
import qualified AST as A
import CompState
@ -54,14 +56,26 @@ cCppCommonPreReq =
--{{{ monad definition
type CGen' = WriterT [String] PassM
type CGen' = StateT (Either [String] Handle) PassM
type CGen = ReaderT GenOps CGen'
instance Die CGen where
dieReport = throwError
instance CSMR m => CSMR (ReaderT GenOps m) where
instance CSMR CGen' where
getCompState = lift getCompState
instance CSMR CGen where
getCompState = lift getCompState
tell :: [String] -> CGen ()
tell x = do st <- get
case st of
Left prev -> put $ Left (prev ++ x)
Right h -> liftIO $ mapM_ (hPutStr h) x
csmLift :: PassM a -> CGen a
csmLift = lift . lift
--}}}
-- | A function that applies a subscript to a variable.
@ -218,3 +232,5 @@ instance CGenCall (a -> b -> c -> d -> (CGen x, y -> 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)

30
backends/GenerateCPPCSP.hs
View File

@ -31,11 +31,11 @@ For channels of direction 'A.DirInput' or 'A.DirOutput' I actually pass the Chan
module GenerateCPPCSP (cppcspPrereq, cppgenOps, generateCPPCSP, genCPPCSPPasses) where
import Control.Monad.State
import Control.Monad.Writer
import Data.Char
import Data.Generics
import Data.List
import Data.Maybe
import System.IO
import qualified AST as A
import CompState
@ -116,7 +116,7 @@ chansToAny x = do st <- get
--{{{ top-level
-- | Transforms the given AST into a pass that generates C++ code.
generateCPPCSP :: A.AST -> PassM String
generateCPPCSP :: Handle -> A.AST -> PassM ()
generateCPPCSP = generate cppgenOps
cppcspPrereq :: [Property]
@ -133,7 +133,7 @@ cppgenTopLevel s
(name, chans) <- tlpInterface
tell ["int main (int argc, char** argv) { csp::Start_CPPCSP();"]
(chanType,writer) <-
do st <- get
do st <- getCompState
case csFrontend st of
FrontendOccam -> return ("tockSendableArrayOfBytes","StreamWriterByteArray")
_ -> return ("uint8_t","StreamWriter")
@ -246,14 +246,14 @@ Otherwise, it must not have.
-}
genCPPCSPTime :: A.Expression -> CGen String
genCPPCSPTime e
= do time <- makeNonce "time_exp"
= do time <- csmLift $ makeNonce "time_exp"
tell ["unsigned ",time," = (unsigned)"]
call genExpression e
tell [" ; "]
curTime <- makeNonce "time_exp"
curTimeLow <- makeNonce "time_exp"
curTimeHigh <- makeNonce "time_exp"
retTime <- makeNonce "time_exp"
curTime <- csmLift $ makeNonce "time_exp"
curTimeLow <- csmLift $ makeNonce "time_exp"
curTimeHigh <- csmLift $ makeNonce "time_exp"
retTime <- csmLift $ makeNonce "time_exp"
tell ["double ",curTime," = csp::GetSeconds(csp::CurrentTime());"]
tell ["unsigned ",curTimeLow," = (unsigned)remainder(1000000.0 * ",curTime,",4294967296.0);"]
tell ["unsigned ",curTimeHigh," = (unsigned)((1000000.0 * ",curTime,") / 4294967296.0);"]
@ -373,7 +373,7 @@ cppgenOutputCase c tag ois
--We use forking instead of Run\/InParallelOneThread, because it is easier to use forking with replication.
cppgenPar :: A.ParMode -> A.Structured A.Process -> CGen ()
cppgenPar _ s
= do forking <- makeNonce "forking"
= do forking <- csmLift $ makeNonce "forking"
tell ["{ csp::ScopedForking ",forking," ; "]
call genStructured s (genPar' forking)
tell [" }"]
@ -394,17 +394,17 @@ cppgenPar _ s
-- | Changed to use C++CSP's Alternative class:
cppgenAlt :: Bool -> A.Structured A.Alternative -> CGen ()
cppgenAlt _ s
= do guards <- makeNonce "alt_guards"
= do guards <- csmLift $ makeNonce "alt_guards"
tell ["std::list< csp::Guard* > ", guards, " ; "]
initAltGuards guards s
alt <- makeNonce "alt"
alt <- csmLift $ makeNonce "alt"
tell ["csp::Alternative ",alt, " ( ", guards, " ); "]
id <- makeNonce "alt_id"
id <- csmLift $ makeNonce "alt_id"
tell ["int ", id, " = 0;\n"]
fired <- makeNonce "alt_fired"
fired <- csmLift $ makeNonce "alt_fired"
tell ["int ", fired, " = ", alt, " .priSelect();"]
label <- makeNonce "alt_end"
label <- csmLift $ makeNonce "alt_end"
tell ["{\n"]
genAltProcesses id fired label s
tell ["}\n"]
@ -714,7 +714,7 @@ cppgenUnfoldedVariable m var
cppgenIf :: Meta -> A.Structured A.Choice -> CGen ()
cppgenIf m s
= do ifExc <- makeNonce "if_exc"
= do ifExc <- csmLift $ makeNonce "if_exc"
tell ["class ",ifExc, "{};try{"]
genIfBody ifExc s
call genStop m "no choice matched in IF process"

4
backends/GenerateCTest.hs
View File

@ -34,7 +34,7 @@ module GenerateCTest (tests) where
import Control.Monad.Error
import Control.Monad.State
import Control.Monad.Reader
import Control.Monad.Writer
import Control.Monad.Writer hiding (tell)
import Data.Generics
import Data.List (isInfixOf, intersperse)
import Data.Maybe (fromMaybe)
@ -109,7 +109,7 @@ evalCGen :: CGen () -> GenOps -> CompState -> IO (Either Errors.ErrorReport [Str
evalCGen act ops state = evalCGen' (runReaderT act ops) state
evalCGen' :: CGen' () -> CompState -> IO (Either Errors.ErrorReport [String])
evalCGen' act state = runWriterT (evalStateT (runErrorT $ execWriterT act) state) >>* fst
evalCGen' act state = runWriterT (evalStateT (runErrorT $ execStateT act (Left []) >>* (\(Left x) -> x)) state) >>* fst
-- | Checks that running the test for the C and C++ backends produces the right output for each.
testBothS ::