From 492091030da7af497638d9c1a4fbb40c56042494 Mon Sep 17 00:00:00 2001 From: Neil Brown Date: Tue, 20 Jan 2009 17:41:25 +0000 Subject: [PATCH] Fixed the C and C++ backends to work with the new channel-end system --- backends/GenerateC.hs | 51 +++++++++++++-------- backends/GenerateCBased.hs | 2 +- backends/GenerateCPPCSP.hs | 90 ++++++++++++++++++++++++++------------ 3 files changed, 94 insertions(+), 49 deletions(-) diff --git a/backends/GenerateC.hs b/backends/GenerateC.hs index dc51f22..4e0c2b9 100644 --- a/backends/GenerateC.hs +++ b/backends/GenerateC.hs @@ -223,7 +223,7 @@ cgenTopLevel s where -- | Allocate a TLP channel handler process, and return the function that -- implements it. - genTLPHandler :: (A.Direction, TLPChannel) -> String -> String -> String -> CGen String + genTLPHandler :: (Maybe A.Direction, TLPChannel) -> String -> String -> String -> CGen String genTLPHandler (_, tc) c kc ws = do tell [" Workspace ", ws, " = ProcAlloc (wptr, 3, 1024);\n\ \ ProcParam (wptr, ", ws, ", 0, &", c, ");\n\ @@ -335,7 +335,9 @@ cgenType :: A.Type -> CGen () cgenType (A.Array _ t) = do call genType t case t of - A.Chan A.DirUnknown _ _ -> tell ["*"] + A.Chan _ _ -> tell ["*"] + -- Channel ends don't need an extra indirection; in C++ they are not + -- pointers, and in C they are already pointers _ -> return () tell ["*"] cgenType (A.Record n) = genName n @@ -344,8 +346,8 @@ cgenType (A.Mobile t) = call genType t >> tell ["*"] -- UserProtocol -- not used -- Channels are of type "Channel", but channel-ends are of type "Channel*" -cgenType (A.Chan A.DirUnknown _ t) = tell ["Channel"] -cgenType (A.Chan _ _ t) = tell ["Channel*"] +cgenType (A.Chan _ t) = tell ["Channel"] +cgenType (A.ChanEnd _ _ t) = tell ["Channel*"] -- Counted -- not used -- Any -- not used --cgenType (A.Port t) = @@ -394,6 +396,10 @@ cgenBytesIn m t v = do tell ["sizeof("] call genType t tell [")"] + genBytesIn' t@(A.ChanEnd {}) + = do tell ["sizeof("] + call genType t + tell [")"] genBytesIn' (A.Mobile _) = tell ["sizeof(void*)"] genBytesIn' (A.List _) @@ -428,8 +434,8 @@ cgenDeclType am t call genType t case t of A.Array _ _ -> return () - A.Chan A.DirInput _ _ -> return () - A.Chan A.DirOutput _ _ -> return () + A.ChanEnd A.DirInput _ _ -> return () + A.ChanEnd A.DirOutput _ _ -> return () A.Record _ -> tell ["*const"] _ -> when (am == A.Abbrev) $ tell ["*const"] @@ -741,6 +747,7 @@ cgenVariable' checkValid v (am,t) <- case (amN,mt) of -- Channel arrays are special, because they are arrays of abbreviations: (_, Just t'@(A.Chan {})) -> return (A.Abbrev, t') + (_, Just t'@(A.ChanEnd {})) -> return (A.Abbrev, t') -- If we are dealing with an array element, treat it as if it had the original abbreviation mode, -- regardless of the abbreviation mode of the array: (_, Just t') -> return (A.Original, t') @@ -754,7 +761,7 @@ cgenVariable' checkValid v -- no need to change the indirection: (_, _, True) -> ind -- Undirected channels will already have been handled, so this is for directed: - (A.Abbrev, A.Chan {}, _) -> ind + (A.Abbrev, A.ChanEnd {}, _) -> ind -- Abbreviations of arrays are pointers, just like arrays, so no -- need for a * operator: (A.Abbrev, A.Array {}, _) -> ind @@ -767,9 +774,10 @@ cgenVariable' checkValid v A.Array {} -> inner ind v mt A.Record {} -> inner ind v mt _ -> inner (ind+1) v mt - inner ind (A.DirectedVariable _ dir v) mt - = do (cg,n) <- (inner ind v mt) - return (call genDirectedVariable (addPrefix cg n) dir, 0) + inner ind (A.DirectedVariable m dir v) mt + = do (cg,n) <- (inner ind v mt) + t <- astTypeOf v + return (call genDirectedVariable m t (addPrefix cg n) dir, 0) inner ind sv@(A.SubscriptedVariable m (A.Subscript _ subCheck _) v) mt = do (es, v, t') <- collectSubs sv t <- if checkValid @@ -829,11 +837,11 @@ cgenVariable' checkValid v -- abbreviated as a pointer. indirectedType :: A.Type -> Bool indirectedType (A.Record {}) = True -indirectedType (A.Chan A.DirUnknown _ _) = True +indirectedType (A.Chan _ _) = True indirectedType _ = False -cgenDirectedVariable :: CGen () -> A.Direction -> CGen () -cgenDirectedVariable var _ = var +cgenDirectedVariable :: Meta -> A.Type -> CGen () -> A.Direction -> CGen () +cgenDirectedVariable _ _ var _ = var cgenArraySubscript :: A.SubscriptCheck -> A.Variable -> [(Meta, CGen ())] -> CGen () cgenArraySubscript check v es @@ -1139,12 +1147,14 @@ cgenVariableAM v am (True, _) -> return () (False, A.Array {}) -> return () (False, A.Chan {}) -> return () + (False, A.ChanEnd {}) -> return () _ -> tell ["&"] call genVariable v -- | Generate the size part of a RETYPES\/RESHAPES abbrevation of a variable. cgenRetypeSizes :: Meta -> A.Type -> A.Name -> A.Type -> A.Variable -> CGen () cgenRetypeSizes _ (A.Chan {}) _ (A.Chan {}) _ = return () +cgenRetypeSizes _ (A.ChanEnd {}) _ (A.ChanEnd {}) _ = return () cgenRetypeSizes m destT destN srcT srcV = let size = do tell ["occam_check_retype("] call genBytesIn m srcT (Right srcV) @@ -1188,7 +1198,7 @@ cgenDeclaration at@(A.Array ds t) n False = do call genType t tell [" "] case t of - A.Chan A.DirUnknown _ _ -> + A.Chan _ _ -> do genName n tell ["_storage"] call genFlatArraySize ds @@ -1223,13 +1233,13 @@ cgenFlatArraySize ds -- | Initialise an item being declared. cdeclareInit :: Meta -> A.Type -> A.Variable -> Maybe (CGen ()) -cdeclareInit _ (A.Chan A.DirUnknown _ _) var +cdeclareInit _ (A.Chan _ _) var = Just $ do tell ["ChanInit(wptr,"] call genVariableUnchecked var tell [");"] cdeclareInit m t@(A.Array ds t') var = Just $ do case t' of - A.Chan A.DirUnknown _ _ -> + A.Chan _ _ -> do tell ["tock_init_chan_array("] call genVariableUnchecked var tell ["_storage,"] @@ -1345,6 +1355,7 @@ cintroduceSpec (A.Specification _ n (A.Retypes m am t v)) let deref = case (am, t) of (_, A.Array _ _) -> False (_, A.Chan {}) -> False + (_, A.ChanEnd {}) -> False (_, A.Record {}) -> False (A.ValAbbrev, _) -> True _ -> False @@ -1517,8 +1528,8 @@ cgenAssign m [v] (A.ExpressionList _ [e]) Just _ -> doAssign v e Nothing -> case t of -- Assignment of channel-ends, but not channels, is possible (at least in Rain): - A.Chan A.DirInput _ _ -> doAssign v e - A.Chan A.DirOutput _ _ -> doAssign v e + A.ChanEnd A.DirInput _ _ -> doAssign v e + A.ChanEnd A.DirOutput _ _ -> doAssign v e A.List _ -> call genListAssign v e A.Mobile (A.List _) -> call genListAssign v e _ -> call genMissingC $ formatCode "assignment of type %" t @@ -1563,7 +1574,9 @@ cgenOutput c ois = sequence_ $ map (call genOutputItem c) ois cgenOutputCase :: A.Variable -> A.Name -> [A.OutputItem] -> CGen () cgenOutputCase c tag ois = do t <- astTypeOf c - let proto = case t of A.Chan _ _ (A.UserProtocol n) -> n + let proto = case t of + A.Chan _ (A.UserProtocol n) -> n + A.ChanEnd _ _ (A.UserProtocol n) -> n tell ["ChanOutInt(wptr,"] call genVariable c tell [","] diff --git a/backends/GenerateCBased.hs b/backends/GenerateCBased.hs index 23c4bf5..e0b1bd9 100644 --- a/backends/GenerateCBased.hs +++ b/backends/GenerateCBased.hs @@ -119,7 +119,7 @@ data GenOps = GenOps { -- | Generates a declaration of a variable of the specified type and name. -- The Bool indicates whether the declaration is inside a record (True) or not (False). genDeclaration :: A.Type -> A.Name -> Bool -> CGen (), - genDirectedVariable :: CGen () -> A.Direction -> CGen (), + genDirectedVariable :: Meta -> A.Type -> CGen () -> A.Direction -> CGen (), genDyadic :: Meta -> A.DyadicOp -> A.Expression -> A.Expression -> CGen (), genExpression :: A.Expression -> CGen (), genFlatArraySize :: [A.Dimension] -> CGen (), diff --git a/backends/GenerateCPPCSP.hs b/backends/GenerateCPPCSP.hs index a9c2f38..d886875 100644 --- a/backends/GenerateCPPCSP.hs +++ b/backends/GenerateCPPCSP.hs @@ -42,6 +42,7 @@ import CompState import GenerateC (cgenOps, cgenReplicatorLoop, cgenType, cintroduceSpec, cremoveSpec, generate, genComma, genLeftB, genMeta, genName, genRightB, justOnly, seqComma, withIf) import GenerateCBased +import Errors import Metadata import Pass import qualified Properties as Prop @@ -106,8 +107,10 @@ chansToAny = cppOnlyPass "Transform channels to ANY" _ -> return x where chansToAny' :: A.Type -> PassM A.Type - chansToAny' c@(A.Chan _ _ (A.UserProtocol {})) = return c - chansToAny' (A.Chan a b _) = return $ A.Chan a b A.Any + chansToAny' c@(A.Chan _ (A.UserProtocol {})) = return c + chansToAny' (A.Chan b _) = return $ A.Chan b A.Any + chansToAny' c@(A.ChanEnd _ _ (A.UserProtocol {})) = return c + chansToAny' (A.ChanEnd a b _) = return $ A.ChanEnd a b A.Any chansToAny' t = return t chansToAnyM :: Data t => t -> PassM t @@ -159,11 +162,11 @@ cppgenTopLevel s tell [")) (new LethalProcess()) ) );", "csp::End_CPPCSP(); return 0;}\n"] where - tlpChannel :: (A.Direction,TLPChannel) -> CGen() + tlpChannel :: (Maybe A.Direction,TLPChannel) -> CGen() tlpChannel (dir,c) = case dir of - A.DirUnknown -> tell ["&", chanName] - A.DirInput -> tell [chanName, ".reader() "] - A.DirOutput -> tell [chanName, ".writer() "] + Nothing -> tell ["&", chanName] + Just A.DirInput -> tell [chanName, ".reader() "] + Just A.DirOutput -> tell [chanName, ".writer() "] where chanName = case c of TLPIn -> "in" @@ -189,9 +192,10 @@ genCPPCSPChannelInput :: A.Variable -> CGen() genCPPCSPChannelInput var = do t <- astTypeOf var case t of - (A.Chan A.DirInput _ _) -> call genVariable var - (A.Chan A.DirUnknown _ _) -> do call genVariable var - tell ["->reader()"] + (A.ChanEnd A.DirInput _ _) -> call genVariable var + -- TODO remove the following line, eventually + (A.Chan _ _) -> do call genVariable var + tell ["->reader()"] _ -> call genMissing $ "genCPPCSPChannelInput used on something which does not support input: " ++ show var -- | Generates code from a channel 'A.Variable' that will be of type Chanout\<\> @@ -199,9 +203,10 @@ genCPPCSPChannelOutput :: A.Variable -> CGen() genCPPCSPChannelOutput var = do t <- astTypeOf var case t of - (A.Chan A.DirOutput _ _) -> call genVariable var - (A.Chan A.DirUnknown _ _) -> do call genVariable var - tell ["->writer()"] + (A.ChanEnd A.DirOutput _ _) -> call genVariable var + -- TODO remove the following line, eventually + (A.Chan _ _) -> do call genVariable var + tell ["->writer()"] _ -> call genMissing $ "genCPPCSPChannelOutput used on something which does not support output: " ++ show var cppgenPoison :: Meta -> A.Variable -> CGen () @@ -336,9 +341,12 @@ cppgenOutputItem chan item tell ["));"] byteArrayChan :: A.Type -> Bool -byteArrayChan (A.Chan _ _ (A.UserProtocol _)) = True -byteArrayChan (A.Chan _ _ A.Any) = True -byteArrayChan (A.Chan _ _ (A.Counted _ _)) = True +byteArrayChan (A.Chan _ (A.UserProtocol _)) = True +byteArrayChan (A.Chan _ A.Any) = True +byteArrayChan (A.Chan _ (A.Counted _ _)) = True +byteArrayChan (A.ChanEnd _ _ (A.UserProtocol _)) = True +byteArrayChan (A.ChanEnd _ _ A.Any) = True +byteArrayChan (A.ChanEnd _ _ (A.Counted _ _)) = True byteArrayChan _ = False genPoint :: A.Variable -> CGen() @@ -363,7 +371,9 @@ infixComma [] = return () cppgenOutputCase :: A.Variable -> A.Name -> [A.OutputItem] -> CGen () cppgenOutputCase c tag ois = do t <- astTypeOf c - let proto = case t of A.Chan _ _ (A.UserProtocol n) -> n + let proto = case t of + A.Chan _ (A.UserProtocol n) -> n + A.ChanEnd _ _ (A.UserProtocol n) -> n tell ["tockSendInt("] genCPPCSPChannelOutput c tell [","] @@ -476,7 +486,7 @@ cppgenProcCall n as cppdeclareInit :: Meta -> A.Type -> A.Variable -> Maybe (CGen ()) cppdeclareInit m t@(A.Array ds t') var = Just $ do case t' of - A.Chan A.DirUnknown _ _ -> + A.Chan _ _ -> do tell ["tockInitChanArray("] call genVariableUnchecked var tell ["_storage,"] @@ -609,7 +619,18 @@ cppintroduceSpec (A.Specification _ n (A.Proc _ sm fs p)) --A helper function for calling the wrapped functions: genParamList :: [A.Formal] -> CGen() genParamList fs = infixComma $ map genParam fs - +cppintroduceSpec (A.Specification _ n (A.Is _ am t@(A.Array _ (A.ChanEnd {})) (A.DirectedVariable + m dir v))) + = do call genDecl am t n + tell [";"] + tell ["tockInitChan",if dir == A.DirInput then "in" else "out","Array("] + call genVariableAM v am + tell [","] + genName n + tell [","] + call genVariableAM v am + call genSizeSuffix "0" + tell [");"] --For all other cases, use the C implementation: cppintroduceSpec n = cintroduceSpec n @@ -645,20 +666,26 @@ cppgenType :: A.Type -> CGen () cppgenType arr@(A.Array _ _) = cgenType arr cppgenType (A.Record n) = genName n -cppgenType (A.Chan dir attr t) - = do let chanType = case dir of - A.DirInput -> "csp::Chanin" - A.DirOutput -> "csp::Chanout" - A.DirUnknown -> +cppgenType t | isChan t + = do let (chanType, innerT) = case t of + A.ChanEnd A.DirInput _ innerT -> ("csp::Chanin", innerT) + A.ChanEnd A.DirOutput _ innerT -> ("csp::Chanout", innerT) + A.Chan attr innerT -> ( case (A.caWritingShared attr,A.caReadingShared attr) of (False,False) -> "csp::One2OneChannel" (False,True) -> "csp::One2AnyChannel" (True,False) -> "csp::Any2OneChannel" (True,True) -> "csp::Any2AnyChannel" + , innerT) tell [chanType,"<"] - cppTypeInsideChannel t + cppTypeInsideChannel innerT tell [">/**/"] where + isChan :: A.Type -> Bool + isChan (A.Chan _ _) = True + isChan (A.ChanEnd _ _ _) = True + isChan _ = False + cppTypeInsideChannel :: A.Type -> CGen () cppTypeInsideChannel A.Any = tell ["tockSendableArrayOfBytes"] cppTypeInsideChannel (A.Counted _ _) = tell ["tockSendableArrayOfBytes"] @@ -789,11 +816,16 @@ cppgenIf m s | justOnly s = do call genStructured s doCplain --}}} -- | Changed because C++CSP has channel-ends as concepts (whereas CCSP does not) -cppgenDirectedVariable :: CGen () -> A.Direction -> CGen () -cppgenDirectedVariable v A.DirInput = tell ["(("] >> v >> tell [")->reader())"] -cppgenDirectedVariable v A.DirOutput = tell ["(("] >> v >> tell [")->writer())"] -cppgenDirectedVariable v dir = call genMissing $ "Cannot direct variable to direction: " ++ show dir - +cppgenDirectedVariable :: Meta -> A.Type -> CGen () -> A.Direction -> CGen () +cppgenDirectedVariable m t v dir + = case t of + A.ChanEnd {} -> v + A.Chan {} -> tell ["(("] >> v >> tell [")->",if dir == A.DirInput + then "reader" else "writer","())"] + A.Array _ (A.ChanEnd {}) -> v + A.Array _ (A.Chan {}) -> dieP m "Should have pulled up directed arrays" + _ -> dieP m "Attempted to direct unknown type" + cppgenAllocMobile :: Meta -> A.Type -> Maybe A.Expression -> CGen () cppgenAllocMobile m (A.Mobile t) me = do tell ["new "]