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

Added code to put static before every identifier that is not being exported, to avoid collisions between occam files

Browse Source
This commit is contained in:
Neil Brown 2009-04-01 19:50:15 +00:00
parent c85dc01842
commit e28bff5a50
3 changed files with 97 additions and 77 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

133
backends/GenerateC.hs
View File

@ -33,6 +33,7 @@ module GenerateC
, genMeta
, genName
, genRightB
, genStatic
, justOnly
, withIf
) where
@ -189,7 +190,7 @@ cgenTopLevel headerName s
sequence_ [tell ["extern void ", mungeExternalName n, "(int*);"]
| (n, fs) <- csExternals cs]
call genStructured s (\m _ -> tell ["\n#error Invalid top-level item: ", show m])
call genStructured TopLevel s (\m _ -> tell ["\n#error Invalid top-level item: ", show m])
when (csHasMain cs) $ do
(tlpName, tlpChans) <- tlpInterface
@ -301,12 +302,12 @@ cgenOverArray m var func
Nothing -> return ()
-- | Generate code for one of the Structured types.
cgenStructured :: Data a => A.Structured a -> (Meta -> a -> CGen b) -> CGen [b]
cgenStructured (A.Spec _ spec s) def = call genSpec spec (call genStructured s def)
cgenStructured (A.ProcThen _ p s) def = call genProcess p >> call genStructured s def
cgenStructured (A.Several _ ss) def
= sequence [call genStructured s def | s <- ss] >>* concat
cgenStructured (A.Only m s) def = def m s >>* singleton
cgenStructured :: Data a => Level -> A.Structured a -> (Meta -> a -> CGen b) -> CGen [b]
cgenStructured lvl (A.Spec _ spec s) def = call genSpec lvl spec (call genStructured lvl s def)
cgenStructured lvl (A.ProcThen _ p s) def = call genProcess p >> call genStructured lvl s def
cgenStructured lvl (A.Several _ ss) def
= sequence [call genStructured lvl s def | s <- ss] >>* concat
cgenStructured _ (A.Only m s) def = def m s >>* singleton
--}}}
@ -411,10 +412,18 @@ cgenBytesIn m t v
--}}}
genStatic :: Level -> A.Name -> CGen ()
genStatic NotTopLevel _ = return ()
genStatic TopLevel n
= do cs <- getCompState
when (A.nameName n `notElem` csOriginalTopLevelProcs cs) $
tell ["static "]
--{{{ declarations
cgenDecl :: A.AbbrevMode -> A.Type -> A.Name -> CGen ()
cgenDecl am t n
= do genCType (A.nameMeta n) t am
cgenDecl :: Level -> A.AbbrevMode -> A.Type -> A.Name -> CGen ()
cgenDecl lvl am t n
= do genStatic lvl n
genCType (A.nameMeta n) t am
tell [" "]
genName n
--}}}
@ -1203,17 +1212,18 @@ abbrevExpression am _ e = call genExpression e
--}}}
--{{{ specifications
cgenSpec :: A.Specification -> CGen b -> CGen b
cgenSpec spec body
= do call introduceSpec spec
cgenSpec :: Level -> A.Specification -> CGen b -> CGen b
cgenSpec lvl spec body
= do call introduceSpec lvl spec
x <- body
call removeSpec spec
return x
-- | Generate a declaration of a new variable.
cgenDeclaration :: A.Type -> A.Name -> Bool -> CGen ()
cgenDeclaration at@(A.Array ds t) n False
= do genType t
cgenDeclaration :: Level -> A.Type -> A.Name -> Bool -> CGen ()
cgenDeclaration lvl at@(A.Array ds t) n False
= do genStatic lvl n
genType t
tell [" "]
case t of
A.Chan _ _ ->
@ -1227,14 +1237,16 @@ cgenDeclaration at@(A.Array ds t) n False
call genArrayStoreName n
call genFlatArraySize ds
tell [";"]
cgenDeclaration (A.Array ds t) n True
= do genType t
cgenDeclaration lvl (A.Array ds t) n True
= do genStatic lvl n
genType t
tell [" "]
call genArrayStoreName n
call genFlatArraySize ds
tell [";"]
cgenDeclaration t n _
= do genType t
cgenDeclaration lvl t n _
= do genStatic lvl n
genType t
tell [" "]
genName n
tell [";"]
@ -1318,26 +1330,27 @@ CHAN OF INT c IS d: Channel *c = d;
[]CHAN OF INT ds IS cs: Channel **ds = cs;
const int *ds_sizes = cs_sizes;
-}
cintroduceSpec :: A.Specification -> CGen ()
cintroduceSpec (A.Specification m n (A.Declaration _ t))
= do call genDeclaration t n False
cintroduceSpec :: Level -> A.Specification -> CGen ()
cintroduceSpec lvl (A.Specification m n (A.Declaration _ t))
= do call genDeclaration lvl t n False
fdeclareInit <- fget declareInit
case fdeclareInit m t (A.Variable m n) of
Just p -> p
Nothing -> return ()
cintroduceSpec (A.Specification _ n (A.Is _ am t (A.ActualVariable v)))
cintroduceSpec lvl (A.Specification _ n (A.Is _ am t (A.ActualVariable v)))
= do let rhs = call genVariable v am
call genDecl am t n
call genDecl lvl am t n
tell ["="]
rhs
tell [";"]
cintroduceSpec (A.Specification _ n (A.Is _ am t (A.ActualExpression e)))
cintroduceSpec lvl (A.Specification _ n (A.Is _ am t (A.ActualExpression e)))
= do let rhs = abbrevExpression am t e
case (am, t, e) of
(A.ValAbbrev, A.Array _ ts, A.Literal _ _ _) ->
-- For "VAL []T a IS [vs]:", we have to use [] rather than * in the
-- declaration, since you can't say "int *foo = {vs};" in C.
do tell ["const "]
do genStatic lvl n
tell ["const "]
genType ts
tell [" "]
genName n
@ -1348,20 +1361,22 @@ cintroduceSpec (A.Specification _ n (A.Is _ am t (A.ActualExpression e)))
-- 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 <- csmLift $ makeNonce "record_literal"
genStatic lvl n
tell ["const "]
genType t
tell [" ", tmp, " = "]
rhs
tell [";\n"]
call genDecl am t n
call genDecl lvl am t n
tell [" = &", tmp, ";\n"]
_ ->
do call genDecl am t n
do call genDecl lvl am t n
tell [" = "]
rhs
tell [";\n"]
cintroduceSpec (A.Specification _ n (A.Is _ _ (A.Array _ c) (A.ActualChannelArray cs)))
= do genType c
cintroduceSpec lvl (A.Specification _ n (A.Is _ _ (A.Array _ c) (A.ActualChannelArray cs)))
= do genStatic lvl n
genType c
case c of
A.Chan _ _ -> tell ["* "]
-- Channel ends don't need an extra indirection; in C++ they are not
@ -1371,14 +1386,14 @@ cintroduceSpec (A.Specification _ n (A.Is _ _ (A.Array _ c) (A.ActualChannelArra
tell ["[]={"]
seqComma (map (\v -> call genVariable v A.Abbrev) cs)
tell ["};"]
cintroduceSpec (A.Specification _ n (A.Is _ _ _ (A.ActualClaim v)))
cintroduceSpec lvl (A.Specification _ n (A.Is _ _ _ (A.ActualClaim v)))
= do t <- astTypeOf n
case t of
A.ChanEnd dir _ _ -> do call genDecl A.Original t n
A.ChanEnd dir _ _ -> do call genDecl lvl A.Original t n
tell ["=(&(((mt_cb_t*)"]
lock dir
tell [")->channels[0]));"]
A.ChanDataType dir _ _ -> do call genDecl A.Original t n
A.ChanDataType dir _ _ -> do call genDecl lvl A.Original t n
tell ["="]
lock dir
tell [";"]
@ -1389,12 +1404,13 @@ cintroduceSpec (A.Specification _ n (A.Is _ _ _ (A.ActualClaim v)))
then "MT_CB_CLIENT"
else "MT_CB_SERVER"
,")"]
cintroduceSpec (A.Specification _ _ (A.DataType _ _)) = return ()
cintroduceSpec (A.Specification _ _ (A.RecordType _ _ _)) = return ()
cintroduceSpec (A.Specification _ _ (A.ChanBundleType {})) = return ()
cintroduceSpec (A.Specification _ n (A.Protocol _ _)) = return ()
cintroduceSpec (A.Specification _ n (A.ProtocolCase _ ts))
= do tell ["typedef enum{"]
cintroduceSpec _ (A.Specification _ _ (A.DataType _ _)) = return ()
cintroduceSpec _ (A.Specification _ _ (A.RecordType _ _ _)) = return ()
cintroduceSpec _ (A.Specification _ _ (A.ChanBundleType {})) = return ()
cintroduceSpec _ (A.Specification _ n (A.Protocol _ _)) = return ()
cintroduceSpec lvl (A.Specification _ n (A.ProtocolCase _ ts))
= do genStatic lvl n
tell ["typedef enum{"]
seqComma [genName tag >> tell ["_"] >> genName n | (tag, _) <- ts]
-- You aren't allowed to have an empty enum.
when (ts == []) $
@ -1402,12 +1418,12 @@ cintroduceSpec (A.Specification _ n (A.ProtocolCase _ ts))
tell ["}"]
genName n
tell [";"]
cintroduceSpec (A.Specification _ n st@(A.Proc _ _ _ _))
= genProcSpec n st False
cintroduceSpec (A.Specification _ n (A.Retypes m am t v))
cintroduceSpec lvl (A.Specification _ n st@(A.Proc _ _ _ _))
= genProcSpec lvl n st False
cintroduceSpec lvl (A.Specification _ n (A.Retypes m am t v))
= do origT <- astTypeOf v
let rhs = call genVariable v A.Abbrev
call genDecl am t n
call genDecl lvl am t n
tell ["="]
-- For scalar types that are VAL abbreviations (e.g. VAL INT64),
-- we need to dereference the pointer that abbrevVariable gives us.
@ -1426,15 +1442,15 @@ cintroduceSpec (A.Specification _ n (A.Retypes m am t v))
rhs
tell [";"]
call genRetypeSizes m t n origT v
cintroduceSpec (A.Specification _ n (A.Rep m rep))
cintroduceSpec _ (A.Specification _ n (A.Rep m rep))
= call genReplicatorStart n rep
--cintroduceSpec (A.Specification _ n (A.RetypesExpr _ am t e))
cintroduceSpec n = call genMissing $ "introduceSpec " ++ show n
cintroduceSpec _ n = call genMissing $ "introduceSpec " ++ show n
cgenRecordTypeSpec :: A.Name -> A.RecordAttr -> [(A.Name, A.Type)] -> CGen ()
cgenRecordTypeSpec n attr fs
= do tell ["typedef struct{"]
sequence_ [call genDeclaration t n True | (n, t) <- fs]
sequence_ [call genDeclaration NotTopLevel t n True | (n, t) <- fs]
tell ["}"]
when (A.packedRecord attr || A.mobileRecord attr) $ tell [" occam_struct_packed "]
genName n
@ -1472,7 +1488,7 @@ cgenRecordTypeSpec n attr fs
cgenForwardDeclaration :: A.Specification -> CGen ()
cgenForwardDeclaration (A.Specification _ n st@(A.Proc _ _ _ _))
= genProcSpec n st True
= genProcSpec TopLevel n st True
cgenForwardDeclaration (A.Specification _ n (A.RecordType _ b fs))
= call genRecordTypeSpec n b fs
cgenForwardDeclaration _ = return ()
@ -1557,13 +1573,14 @@ genProcName n
-- calling convention otherwise. If will not munge the name if the process was
-- one of the original top-level procs, other than to add an occam_ prefix (which
-- avoids name collisions).
genProcSpec :: A.Name -> A.SpecType -> Bool -> CGen ()
genProcSpec n (A.Proc _ (sm, rm) fs p) forwardDecl
genProcSpec :: Level -> A.Name -> A.SpecType -> Bool -> CGen ()
genProcSpec lvl n (A.Proc _ (sm, rm) fs p) forwardDecl
= do cs <- getCompState
let (header, params) = if n `Set.member` csParProcs cs
|| rm == A.Recursive
then (genParHeader, genParParams)
else (genNormalHeader, return ())
genStatic lvl n
header
if forwardDecl
then tell [";\n"]
@ -1797,13 +1814,13 @@ cgenStop m s
--}}}
--{{{ seq
cgenSeq :: A.Structured A.Process -> CGen ()
cgenSeq s = call genStructured s doP >> return ()
cgenSeq s = call genStructured NotTopLevel s doP >> return ()
where
doP _ p = call genProcess p
--}}}
--{{{ if
cgenIf :: Meta -> A.Structured A.Choice -> CGen ()
cgenIf m s | justOnly s = do call genStructured s doCplain
cgenIf m s | justOnly s = do call genStructured NotTopLevel s doCplain
tell ["{"]
call genStop m "no choice matched in IF process"
tell ["}"]
@ -1815,7 +1832,7 @@ cgenIf m s | justOnly s = do call genStructured s doCplain
tell [label, ":;"]
where
genIfBody :: String -> A.Structured A.Choice -> CGen ()
genIfBody label s = call genStructured s doC >> return ()
genIfBody label s = call genStructured NotTopLevel s doC >> return ()
where
doC m (A.Choice m' e p)
= do tell ["if("]
@ -1850,7 +1867,7 @@ cgenCase m e s
where
genCaseBody :: CGen () -> A.Structured A.Option -> CGen Bool
genCaseBody coll (A.Spec _ spec s)
= genCaseBody (call genSpec spec coll) s
= genCaseBody (call genSpec NotTopLevel spec coll) s
genCaseBody coll (A.Only _ (A.Option _ es p))
= do sequence_ [tell ["case "] >> call genExpression e >> tell [":"] | e <- es]
tell ["{"]
@ -1896,7 +1913,7 @@ cgenPar pm s
call genExpression count
tell [");"]
call genStructured s (startP bar wss)
call genStructured NotTopLevel s (startP bar wss)
tell ["LightProcBarrierWait (wptr, &", bar, ");\n"]
@ -1953,7 +1970,7 @@ cgenAlt isPri s
containsTimers (A.Several _ ss) = or $ map containsTimers ss
genAltEnable :: String -> A.Structured A.Alternative -> CGen ()
genAltEnable id s = call genStructured s doA >> return ()
genAltEnable id s = call genStructured NotTopLevel s doA >> return ()
where
doA _ alt
= case alt of
@ -1973,7 +1990,7 @@ cgenAlt isPri s
tell [");\n"]
genAltDisable :: String -> A.Structured A.Alternative -> CGen ()
genAltDisable id s = call genStructured s doA >> return ()
genAltDisable id s = call genStructured NotTopLevel s doA >> return ()
where
doA _ alt
= case alt of
@ -1993,7 +2010,7 @@ cgenAlt isPri s
tell [");\n"]
genAltProcesses :: String -> String -> String -> A.Structured A.Alternative -> CGen ()
genAltProcesses id fired label s = call genStructured s doA >> return ()
genAltProcesses id fired label s = call genStructured NotTopLevel s doA >> return ()
where
doA _ alt
= case alt of

12
backends/GenerateCBased.hs
View File

@ -96,6 +96,8 @@ csmLift = lift . lift
-- | A function that applies a subscript to a variable.
type SubscripterFunction = A.Variable -> A.Variable
data Level = TopLevel | NotTopLevel
--{{{ generator ops
-- | Operations for turning various things into C.
-- These are in a structure so that we can reuse operations in other
@ -132,10 +134,10 @@ data GenOps = GenOps {
genConversion :: Meta -> A.ConversionMode -> A.Type -> A.Expression -> CGen (),
genConversionSymbol :: A.Type -> A.Type -> A.ConversionMode -> CGen (),
getCType :: Meta -> A.Type -> A.AbbrevMode -> CGen CType,
genDecl :: A.AbbrevMode -> A.Type -> A.Name -> CGen (),
genDecl :: Level -> A.AbbrevMode -> A.Type -> A.Name -> CGen (),
-- | 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 (),
genDeclaration :: Level -> A.Type -> A.Name -> Bool -> CGen (),
genDirectedVariable :: Meta -> A.Type -> CGen () -> A.Direction -> CGen (),
genDyadic :: Meta -> A.DyadicOp -> A.Expression -> A.Expression -> CGen (),
genExpression :: A.Expression -> CGen (),
@ -182,11 +184,11 @@ data GenOps = GenOps {
genSeq :: A.Structured A.Process -> CGen (),
genSimpleDyadic :: String -> A.Expression -> A.Expression -> CGen (),
genSimpleMonadic :: String -> A.Expression -> CGen (),
genSpec :: forall b. A.Specification -> CGen b -> CGen b,
genSpec :: forall b. Level -> A.Specification -> CGen b -> CGen b,
genSpecMode :: A.SpecMode -> CGen (),
-- | Generates a STOP process that uses the given Meta tag and message as its printed message.
genStop :: Meta -> String -> CGen (),
genStructured :: forall a b. Data a => A.Structured a -> (Meta -> a -> CGen b) -> CGen [b],
genStructured :: forall a b. Data a => Level -> A.Structured a -> (Meta -> a -> CGen b) -> CGen [b],
genTimerRead :: A.Variable -> A.Variable -> CGen (),
genTimerWait :: A.Expression -> CGen (),
genTopLevel :: String -> A.AST -> CGen (),
@ -200,7 +202,7 @@ data GenOps = GenOps {
-- | Generates a while loop with the given condition and body.
genWhile :: A.Expression -> A.Process -> CGen (),
getScalarType :: A.Type -> Maybe String,
introduceSpec :: A.Specification -> CGen (),
introduceSpec :: Level -> A.Specification -> CGen (),
removeSpec :: A.Specification -> CGen ()
}

29
backends/GenerateCPPCSP.hs
View File

@ -40,7 +40,7 @@ import System.IO
import qualified AST as A
import CompState
import GenerateC (cgenOps, cgenReplicatorLoop, cgetCType, cintroduceSpec,
genDynamicDim, generate, genLeftB, genMeta, genName, genRightB, justOnly, withIf)
genDynamicDim, generate, genLeftB, genMeta, genName, genRightB, genStatic, justOnly, withIf)
import GenerateCBased
import Errors
import Metadata
@ -136,7 +136,7 @@ cppgenTopLevel headerName s
tell ["#include <tock_support_cppcsp.h>\n"]
--In future, these declarations could be moved to a header file:
sequence_ $ map (call genForwardDeclaration) (listify (const True :: A.Specification -> Bool) s)
call genStructured s (\m _ -> tell ["\n#error Invalid top-level item: ",show m])
call genStructured TopLevel s (\m _ -> tell ["\n#error Invalid top-level item: ",show m])
(name, chans) <- tlpInterface
tell ["int main (int argc, char** argv) { csp::Start_CPPCSP();"]
(chanTypeRead, chanTypeWrite, writer, reader) <-
@ -385,7 +385,7 @@ cppgenPar :: A.ParMode -> A.Structured A.Process -> CGen ()
cppgenPar _ s
= do forking <- csmLift $ makeNonce "forking"
tell ["{ csp::ScopedForking ",forking," ; "]
call genStructured s (genPar' forking)
call genStructured NotTopLevel s (genPar' forking)
tell [" }"]
where
genPar' :: String -> Meta -> A.Process -> CGen ()
@ -423,7 +423,7 @@ cppgenAlt _ s
where
--This function is like the enable function in GenerateC, but this one merely builds a list of guards. It does not do anything other than add to the guard list
initAltGuards :: String -> A.Structured A.Alternative -> CGen ()
initAltGuards guardList s = call genStructured s doA >> return ()
initAltGuards guardList s = call genStructured NotTopLevel s doA >> return ()
where
doA _ alt
= case alt of
@ -444,7 +444,7 @@ cppgenAlt _ s
-- This is the same as GenerateC for now -- but it's not really reusable
-- because it's so closely tied to how ALT is implemented in the backend.
genAltProcesses :: String -> String -> String -> A.Structured A.Alternative -> CGen ()
genAltProcesses id fired label s = call genStructured s doA >> return ()
genAltProcesses id fired label s = call genStructured NotTopLevel s doA >> return ()
where
doA _ alt
= case alt of
@ -516,7 +516,7 @@ cppgenFormals nameFunc list = seqComma (map (cppgenFormal nameFunc) list)
--Changed as genFormals
cppgenFormal :: (A.Name -> A.Name) -> A.Formal -> CGen ()
cppgenFormal nameFunc (A.Formal am t n) = call genDecl am t (nameFunc n)
cppgenFormal nameFunc (A.Formal am t n) = call genDecl NotTopLevel am t (nameFunc n)
cppgenForwardDeclaration :: A.Specification -> CGen()
cppgenForwardDeclaration (A.Specification _ n (A.Proc _ (sm, _) fs _))
@ -548,7 +548,7 @@ cppgenForwardDeclaration (A.Specification _ n (A.Proc _ (sm, _) fs _))
--A simple function for generating declarations of class variables
genClassVar :: A.Formal -> CGen()
genClassVar (A.Formal am t n)
= do call genDecl am t n
= do call genDecl NotTopLevel am t n
tell[";"]
--Generates the given list of class variables
@ -572,10 +572,11 @@ cppgenForwardDeclaration (A.Specification _ n (A.RecordType _ b fs))
= call genRecordTypeSpec n b fs
cppgenForwardDeclaration _ = return ()
cppintroduceSpec :: A.Specification -> CGen ()
cppintroduceSpec :: Level -> A.Specification -> CGen ()
--I generate process wrappers for all functions by default:
cppintroduceSpec (A.Specification _ n (A.Proc _ (sm, _) fs p))
cppintroduceSpec lvl (A.Specification _ n (A.Proc _ (sm, _) fs p))
= do --Generate the "process" as a C++ function:
genStatic lvl n
call genSpecMode sm
tell ["void "]
name
@ -603,7 +604,7 @@ cppintroduceSpec (A.Specification _ n (A.Proc _ (sm, _) fs p))
--A helper function for calling the wrapped functions:
genParamList :: [A.Formal] -> CGen()
genParamList fs = seqComma $ map genParam fs
cppintroduceSpec (A.Specification _ n (A.Is _ am t@(A.Array ds c@(A.ChanEnd {}))
cppintroduceSpec lvl (A.Specification _ n (A.Is _ am t@(A.Array ds c@(A.ChanEnd {}))
(A.ActualVariable dirV@(A.DirectedVariable m dir v))))
= do t' <- if A.UnknownDimension `elem` ds
then do dirVT <- astTypeOf dirV
@ -611,7 +612,7 @@ cppintroduceSpec (A.Specification _ n (A.Is _ am t@(A.Array ds c@(A.ChanEnd {}))
A.Array ds' _ -> return $ A.Array ds' c
_ -> diePC m $ formatCode "Expected variable to be an array type, instead: %" dirVT
else return t
call genDeclaration t' n False
call genDeclaration lvl t' n False
tell [";"]
tell ["tockInitChan",if dir == A.DirInput then "in" else "out","Array("]
call genVariable v am
@ -621,7 +622,7 @@ cppintroduceSpec (A.Specification _ n (A.Is _ am t@(A.Array ds c@(A.ChanEnd {}))
genDynamicDim (A.Variable m n) 0
tell [");"]
--For all other cases, use the C implementation:
cppintroduceSpec n = cintroduceSpec n
cppintroduceSpec lvl n = cintroduceSpec lvl n
--}}}
@ -825,7 +826,7 @@ cppgenUnfoldedVariable m var
-- | Changed to throw a nonce-exception class instead of the goto, because C++ doesn't allow gotos to cross class initialisations (such as arrays)
cppgenIf :: Meta -> A.Structured A.Choice -> CGen ()
cppgenIf m s | justOnly s = do call genStructured s doCplain
cppgenIf m s | justOnly s = do call genStructured NotTopLevel s doCplain
tell ["{"]
call genStop m "no choice matched in IF process"
tell ["}"]
@ -837,7 +838,7 @@ cppgenIf m s | justOnly s = do call genStructured s doCplain
tell ["}catch(",ifExc,"){}"]
where
genIfBody :: String -> A.Structured A.Choice -> CGen ()
genIfBody ifExc s = call genStructured s doC >> return ()
genIfBody ifExc s = call genStructured NotTopLevel s doC >> return ()
where
doC m (A.Choice m' e p)
= do tell ["if("]