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

Fixed the C and C++ backends to work with the new channel-end system

Browse Source
This commit is contained in:
Neil Brown 2009-01-20 17:41:25 +00:00
parent 8bae96f34e
commit 492091030d
3 changed files with 94 additions and 49 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

51
backends/GenerateC.hs
View File

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

2
backends/GenerateCBased.hs
View File

@ -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 (),

90
backends/GenerateCPPCSP.hs
View File

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