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

Made makeNonce use the munged meta-tag, to stop wrapper PROCs from different files having name clashes at link-time

Browse Source
This commit is contained in:
Neil Brown 2009-04-02 20:02:11 +00:00
parent b76676eca8
commit dbc1b461a4
6 changed files with 42 additions and 41 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
backends/BackendPasses.hs
View File

@ -140,7 +140,7 @@ transformWaitFor = cOnlyPass "Transform wait for guards into wait until guards"
doWaitFor :: Meta -> A.Alternative -> StateT ([A.Structured A.Process -> A.Structured A.Process], [A.Structured A.Process]) PassM (A.Structured A.Alternative) doWaitFor :: Meta -> A.Alternative -> StateT ([A.Structured A.Process -> A.Structured A.Process], [A.Structured A.Process]) PassM (A.Structured A.Alternative)
doWaitFor m'' a@(A.Alternative m cond tim (A.InputTimerFor m' e) p) doWaitFor m'' a@(A.Alternative m cond tim (A.InputTimerFor m' e) p)
= do (specs, init) <- get = do (specs, init) <- get
id <- lift $ makeNonce "waitFor" id <- lift $ makeNonce m "waitFor"
let n = A.Name m id let n = A.Name m id
let var = A.Variable m n let var = A.Variable m n
put (specs ++ [A.Spec m (A.Specification m n (A.Declaration m A.Time))], put (specs ++ [A.Spec m (A.Specification m n (A.Declaration m A.Time))],
@ -338,7 +338,7 @@ declareSizesArray = occamOnlyPass "Declare array-size arrays"
case (spec, t) of case (spec, t) of
(_, Just (A.Array ds elemT)) -> (_, Just (A.Array ds elemT)) ->
-- nonce_sizes is a suggested name, may not actually be used: -- nonce_sizes is a suggested name, may not actually be used:
do nonce_sizes <- makeNonce (A.nameName n ++ "_sizes") >>* A.Name m do nonce_sizes <- makeNonce m (A.nameName n ++ "_sizes") >>* A.Name m
let varSize = varSizes m nonce_sizes let varSize = varSizes m nonce_sizes
(n_sizes, msizeSpec) <- (n_sizes, msizeSpec) <-
case spec of case spec of
@ -385,7 +385,7 @@ declareSizesArray = occamOnlyPass "Declare array-size arrays"
= case (t, ext) of = case (t, ext) of
-- For externals, we always add extra formals (one per dimension!): -- For externals, we always add extra formals (one per dimension!):
(A.Array ds _, Just ExternalOldStyle) -> (A.Array ds _, Just ExternalOldStyle) ->
do params <- replicateM (length ds) $ makeNonce "ext_size" do params <- replicateM (length ds) $ makeNonce m "ext_size"
let newfs = map (A.Formal A.ValAbbrev A.Int . A.Name m) params let newfs = map (A.Formal A.ValAbbrev A.Int . A.Name m) params
(rest, moreNew) <- transformFormals ext m fs (rest, moreNew) <- transformFormals ext m fs
return (f : newfs ++ rest, newfs ++ moreNew) return (f : newfs ++ rest, newfs ++ moreNew)
@ -395,7 +395,7 @@ declareSizesArray = occamOnlyPass "Declare array-size arrays"
(A.Array ds _, _) (A.Array ds _, _)
| A.UnknownDimension `elem` ds -> | A.UnknownDimension `elem` ds ->
do let sizeType = A.Array [makeDimension m $ length ds] A.Int do let sizeType = A.Array [makeDimension m $ length ds] A.Int
n_sizes <- makeNonce (A.nameName n ++ "_sizes") >>* A.Name m n_sizes <- makeNonce m (A.nameName n ++ "_sizes") >>* A.Name m
addSizes (A.nameName n) n_sizes addSizes (A.nameName n) n_sizes
let newf = A.Formal A.ValAbbrev sizeType n_sizes let newf = A.Formal A.ValAbbrev sizeType n_sizes
(rest, moreNew) <- transformFormals ext m fs (rest, moreNew) <- transformFormals ext m fs

26
backends/GenerateC.hs
View File

@ -202,9 +202,9 @@ cgenTopLevel headerName s
when (csHasMain cs) $ do when (csHasMain cs) $ do
(tlpName, tlpChans) <- tlpInterface (tlpName, tlpChans) <- tlpInterface
chans <- sequence [csmLift $ makeNonce "tlp_channel" | _ <- tlpChans] chans <- sequence [csmLift $ makeNonce emptyMeta "tlp_channel" | _ <- tlpChans]
killChans <- sequence [csmLift $ makeNonce "tlp_channel_kill" | _ <- tlpChans] killChans <- sequence [csmLift $ makeNonce emptyMeta "tlp_channel_kill" | _ <- tlpChans]
workspaces <- sequence [csmLift $ makeNonce "tlp_channel_ws" | _ <- tlpChans] workspaces <- sequence [csmLift $ makeNonce emptyMeta "tlp_channel_ws" | _ <- tlpChans]
tell ["void tock_main (Workspace wptr) {\n"] tell ["void tock_main (Workspace wptr) {\n"]
@ -1167,7 +1167,7 @@ cgenReplicatorLoop index (A.For m base count step)
-- simple loop (without an additional counter), because step may be -- simple loop (without an additional counter), because step may be
-- negative (and that may be determined at run-time. So we will generate the -- negative (and that may be determined at run-time. So we will generate the
-- most general loop, and let the C compiler optimise if possibe: -- most general loop, and let the C compiler optimise if possibe:
= do counter <- csmLift $ makeNonce "replicator_count" = do counter <- csmLift $ makeNonce m "replicator_count"
tell ["int ", counter, "="] tell ["int ", counter, "="]
call genExpression count call genExpression count
tell [","] tell [","]
@ -1351,7 +1351,7 @@ cintroduceSpec lvl (A.Specification _ n (A.Is _ am t (A.ActualVariable v)))
tell ["="] tell ["="]
rhs rhs
tell [";"] tell [";"]
cintroduceSpec lvl (A.Specification _ n (A.Is _ am t (A.ActualExpression e))) cintroduceSpec lvl (A.Specification m n (A.Is _ am t (A.ActualExpression e)))
= do let rhs = abbrevExpression am t e = do let rhs = abbrevExpression am t e
case (am, t, e) of case (am, t, e) of
(A.ValAbbrev, A.Array _ ts, A.Literal _ _ _) -> (A.ValAbbrev, A.Array _ ts, A.Literal _ _ _) ->
@ -1368,7 +1368,7 @@ cintroduceSpec lvl (A.Specification _ n (A.Is _ am t (A.ActualExpression e)))
(A.ValAbbrev, A.Record _, A.Literal _ _ _) -> (A.ValAbbrev, A.Record _, A.Literal _ _ _) ->
-- Record literals are even trickier, because there's no way of -- Record literals are even trickier, because there's no way of
-- directly writing a struct literal in C that you can use -> on. -- directly writing a struct literal in C that you can use -> on.
do tmp <- csmLift $ makeNonce "record_literal" do tmp <- csmLift $ makeNonce m "record_literal"
genStatic lvl n genStatic lvl n
tell ["const "] tell ["const "]
genType t genType t
@ -1638,7 +1638,7 @@ cgenProcAlloc n fs as
return $ zip (repeat s) $ realActuals f a fct return $ zip (repeat s) $ realActuals f a fct
| (f@(A.Formal am t _), a) <- zip fs as] | (f@(A.Formal am t _), a) <- zip fs as]
ws <- csmLift $ makeNonce "workspace" ws <- csmLift $ makeNonce (A.nameMeta n) "workspace"
tell ["Workspace ", ws, " = TockProcAlloc (wptr, ", show $ length ras, ", "] tell ["Workspace ", ws, " = TockProcAlloc (wptr, ", show $ length ras, ", "]
genName n genName n
tell ["_stack_size);\n"] tell ["_stack_size);\n"]
@ -1827,7 +1827,7 @@ cgenIf m s | justOnly s = do call genStructured NotTopLevel s doCplain
call genStop m "no choice matched in IF process" call genStop m "no choice matched in IF process"
tell ["}"] tell ["}"]
| otherwise | otherwise
= do label <- csmLift $ makeNonce "if_end" = do label <- csmLift $ makeNonce m "if_end"
tell ["/*",label,"*/"] tell ["/*",label,"*/"]
genIfBody label s genIfBody label s
call genStop m "no choice matched in IF process" call genStop m "no choice matched in IF process"
@ -1902,10 +1902,10 @@ cgenWhile e p
-- the same as PAR. -- the same as PAR.
cgenPar :: A.ParMode -> A.Structured A.Process -> CGen () cgenPar :: A.ParMode -> A.Structured A.Process -> CGen ()
cgenPar pm s cgenPar pm s
= do bar <- csmLift $ makeNonce "par_barrier" = do bar <- csmLift $ makeNonce emptyMeta "par_barrier"
tell ["LightProcBarrier ", bar, ";"] tell ["LightProcBarrier ", bar, ";"]
let count = countStructured s let count = countStructured s
wss <- csmLift $ makeNonce "wss" wss <- csmLift $ makeNonce emptyMeta "wss"
tell ["Workspace* ",wss,"=(Workspace*)malloc(sizeof(int)*"] tell ["Workspace* ",wss,"=(Workspace*)malloc(sizeof(int)*"]
call genExpression count call genExpression count
tell [");"] tell [");"]
@ -1936,7 +1936,7 @@ cgenPar pm s
--{{{ alt --{{{ alt
cgenAlt :: Bool -> A.Structured A.Alternative -> CGen () cgenAlt :: Bool -> A.Structured A.Alternative -> CGen ()
cgenAlt isPri s cgenAlt isPri s
= do id <- csmLift $ makeNonce "alt_id" = do id <- csmLift $ makeNonce emptyMeta "alt_id"
tell ["int ", id, " = 0;\n"] tell ["int ", id, " = 0;\n"]
let isTimerAlt = containsTimers s let isTimerAlt = containsTimers s
@ -1952,10 +1952,10 @@ cgenAlt isPri s
genAltDisable id s genAltDisable id s
tell ["}\n"] tell ["}\n"]
fired <- csmLift $ makeNonce "alt_fired" fired <- csmLift $ makeNonce emptyMeta "alt_fired"
tell ["int ", fired, " = AltEnd (wptr);\n"] tell ["int ", fired, " = AltEnd (wptr);\n"]
tell [id, " = 0;\n"] tell [id, " = 0;\n"]
label <- csmLift $ makeNonce "alt_end" label <- csmLift $ makeNonce emptyMeta "alt_end"
tell ["{\n"] tell ["{\n"]
genAltProcesses id fired label s genAltProcesses id fired label s
tell ["}\n"] tell ["}\n"]

24
backends/GenerateCPPCSP.hs
View File

@ -276,14 +276,14 @@ Otherwise, it must not have.
-} -}
genCPPCSPTime :: A.Expression -> CGen String genCPPCSPTime :: A.Expression -> CGen String
genCPPCSPTime e genCPPCSPTime e
= do time <- csmLift $ makeNonce "time_exp" = do time <- csmLift $ makeNonce emptyMeta "time_exp"
tell ["unsigned ",time," = (unsigned)"] tell ["unsigned ",time," = (unsigned)"]
call genExpression e call genExpression e
tell [" ; "] tell [" ; "]
curTime <- csmLift $ makeNonce "time_exp" curTime <- csmLift $ makeNonce emptyMeta "time_exp"
curTimeLow <- csmLift $ makeNonce "time_exp" curTimeLow <- csmLift $ makeNonce emptyMeta "time_exp"
curTimeHigh <- csmLift $ makeNonce "time_exp" curTimeHigh <- csmLift $ makeNonce emptyMeta "time_exp"
retTime <- csmLift $ makeNonce "time_exp" retTime <- csmLift $ makeNonce emptyMeta "time_exp"
tell ["double ",curTime," = csp::GetSeconds(csp::CurrentTime());"] tell ["double ",curTime," = csp::GetSeconds(csp::CurrentTime());"]
tell ["unsigned ",curTimeLow," = (unsigned)remainder(1000000.0 * ",curTime,",4294967296.0);"] tell ["unsigned ",curTimeLow," = (unsigned)remainder(1000000.0 * ",curTime,",4294967296.0);"]
tell ["unsigned ",curTimeHigh," = (unsigned)((1000000.0 * ",curTime,") / 4294967296.0);"] tell ["unsigned ",curTimeHigh," = (unsigned)((1000000.0 * ",curTime,") / 4294967296.0);"]
@ -383,7 +383,7 @@ cppgenOutputCase c tag ois
--We use forking instead of Run\/InParallelOneThread, because it is easier to use forking with replication. --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 :: A.ParMode -> A.Structured A.Process -> CGen ()
cppgenPar _ s cppgenPar _ s
= do forking <- csmLift $ makeNonce "forking" = do forking <- csmLift $ makeNonce emptyMeta "forking"
tell ["{ csp::ScopedForking ",forking," ; "] tell ["{ csp::ScopedForking ",forking," ; "]
call genStructured NotTopLevel s (genPar' forking) call genStructured NotTopLevel s (genPar' forking)
tell [" }"] tell [" }"]
@ -405,17 +405,17 @@ cppgenPar _ s
-- | Changed to use C++CSP's Alternative class: -- | Changed to use C++CSP's Alternative class:
cppgenAlt :: Bool -> A.Structured A.Alternative -> CGen () cppgenAlt :: Bool -> A.Structured A.Alternative -> CGen ()
cppgenAlt _ s cppgenAlt _ s
= do guards <- csmLift $ makeNonce "alt_guards" = do guards <- csmLift $ makeNonce emptyMeta "alt_guards"
tell ["std::list< csp::Guard* > ", guards, " ; "] tell ["std::list< csp::Guard* > ", guards, " ; "]
initAltGuards guards s initAltGuards guards s
alt <- csmLift $ makeNonce "alt" alt <- csmLift $ makeNonce emptyMeta "alt"
tell ["csp::Alternative ",alt, " ( ", guards, " ); "] tell ["csp::Alternative ",alt, " ( ", guards, " ); "]
id <- csmLift $ makeNonce "alt_id" id <- csmLift $ makeNonce emptyMeta "alt_id"
tell ["int ", id, " = 0;\n"] tell ["int ", id, " = 0;\n"]
fired <- csmLift $ makeNonce "alt_fired" fired <- csmLift $ makeNonce emptyMeta "alt_fired"
tell ["int ", fired, " = ", alt, " .priSelect();"] tell ["int ", fired, " = ", alt, " .priSelect();"]
label <- csmLift $ makeNonce "alt_end" label <- csmLift $ makeNonce emptyMeta "alt_end"
tell ["{\n"] tell ["{\n"]
genAltProcesses id fired label s genAltProcesses id fired label s
tell ["}\n"] tell ["}\n"]
@ -831,7 +831,7 @@ cppgenIf m s | justOnly s = do call genStructured NotTopLevel s doCplain
call genStop m "no choice matched in IF process" call genStop m "no choice matched in IF process"
tell ["}"] tell ["}"]
| otherwise | otherwise
= do ifExc <- csmLift $ makeNonce "if_exc" = do ifExc <- csmLift $ makeNonce emptyMeta "if_exc"
tell ["class ",ifExc, "{};try{"] tell ["class ",ifExc, "{};try{"]
genIfBody ifExc s genIfBody ifExc s
call genStop m "no choice matched in IF process" call genStop m "no choice matched in IF process"

17
data/CompState.hs
View File

@ -261,12 +261,13 @@ nameSource n = lookupName n >>* A.ndNameSource
-- | Make a name unique by appending a suffix to it. -- | Make a name unique by appending a suffix to it.
makeUniqueName :: CSM m => Meta -> String -> m String makeUniqueName :: CSM m => Meta -> String -> m String
makeUniqueName m s makeUniqueName m s
= let mungedFile = munge $ show m in return $ s ++ "_" ++ mungedFile = let mungedFile = mungeMeta m in return $ s ++ "_" ++ mungedFile
where
munge cs = [if c `elem` (['A'..'Z'] ++ ['a'..'z'] ++ ['0'..'9']) mungeMeta :: Meta -> String
mungeMeta m = [if c `elem` (['A'..'Z'] ++ ['a'..'z'] ++ ['0'..'9'])
then c then c
else '_' else '_'
| c <- cs] | c <- show m]
-- | Find an unscoped name -- or define a new one if it doesn't already exist. -- | Find an unscoped name -- or define a new one if it doesn't already exist.
findUnscopedName :: CSM m => A.Name -> m A.Name findUnscopedName :: CSM m => A.Name -> m A.Name
@ -350,17 +351,17 @@ getTypeContext
--{{{ nonces --{{{ nonces
-- | Generate a throwaway unique name. -- | Generate a throwaway unique name.
makeNonce :: CSM m => String -> m String makeNonce :: CSM m => Meta -> String -> m String
makeNonce s makeNonce m s
= do ps <- get = do ps <- get
let i = csNonceCounter ps let i = csNonceCounter ps
put ps { csNonceCounter = i + 1 } put ps { csNonceCounter = i + 1 }
return $ s ++ "_n" ++ show i return $ s ++ mungeMeta m ++ "_n" ++ show i
-- | Generate and define a nonce specification. -- | Generate and define a nonce specification.
defineNonce :: CSM m => Meta -> String -> A.SpecType -> A.AbbrevMode -> m A.Specification defineNonce :: CSM m => Meta -> String -> A.SpecType -> A.AbbrevMode -> m A.Specification
defineNonce m s st am defineNonce m s st am
= do ns <- makeNonce s = do ns <- makeNonce m s
let n = A.Name m ns let n = A.Name m ns
let nd = A.NameDef { let nd = A.NameDef {
A.ndMeta = m, A.ndMeta = m,

6
frontends/RainPasses.hs
View File

@ -106,7 +106,7 @@ uniquifyAndResolveVars = rainOnlyPass
--Variable declarations and replicators: --Variable declarations and replicators:
uniquifyAndResolveVars' (A.Spec m (A.Specification m' n decl) scope) uniquifyAndResolveVars' (A.Spec m (A.Specification m' n decl) scope)
= do n' <- makeNonce $ A.nameName n = do n' <- makeNonce m $ A.nameName n
defineName (n {A.nameName = n'}) A.NameDef {A.ndMeta = m', A.ndName = n', A.ndOrigName = A.nameName n, defineName (n {A.nameName = n'}) A.NameDef {A.ndMeta = m', A.ndName = n', A.ndOrigName = A.nameName n,
A.ndSpecType = decl, A.ndNameSource = A.NameUser, A.ndSpecType = decl, A.ndNameSource = A.NameUser,
A.ndAbbrevMode = A.Original, A.ndPlacement = A.Unplaced} A.ndAbbrevMode = A.Original, A.ndPlacement = A.Unplaced}
@ -126,7 +126,7 @@ uniquifyAndResolveVars = rainOnlyPass
return ((f':fs'),s'') return ((f':fs'),s'')
doFormals' :: Data t => A.Formal -> t -> PassM (A.Formal,t) doFormals' :: Data t => A.Formal -> t -> PassM (A.Formal,t)
doFormals' (A.Formal am t n) scope doFormals' (A.Formal am t n) scope
= do n' <- makeNonce $ A.nameName n = do n' <- makeNonce (A.nameMeta n) $ A.nameName n
let newName = (n {A.nameName = n'}) let newName = (n {A.nameName = n'})
let m = A.nameMeta n let m = A.nameMeta n
defineName newName A.NameDef {A.ndMeta = m, A.ndName = n', A.ndOrigName = A.nameName n, defineName newName A.NameDef {A.ndMeta = m, A.ndName = n', A.ndOrigName = A.nameName n,
@ -150,7 +150,7 @@ findMain :: Pass
--Therefore this pass doesn't actually need to walk the tree, it just has to look for a process named "main" --Therefore this pass doesn't actually need to walk the tree, it just has to look for a process named "main"
--in the CompState, and pull it out into csMainLocals --in the CompState, and pull it out into csMainLocals
findMain = rainOnlyPass "Find and tag the main function" Prop.agg_namesDone [Prop.mainTagged] findMain = rainOnlyPass "Find and tag the main function" Prop.agg_namesDone [Prop.mainTagged]
( \x -> do newMainName <- makeNonce "main_" ( \x -> do newMainName <- makeNonce emptyMeta "main_"
modify (findMain' newMainName) modify (findMain' newMainName)
applyDepthM (return . (replaceNameName "main" newMainName)) x) applyDepthM (return . (replaceNameName "main" newMainName)) x)
where where

2
transformations/Unnest.hs
View File

@ -133,7 +133,7 @@ removeFreeNames = pass "Convert free names to arguments"
let ams = map makeAbbrevAM origAMs let ams = map makeAbbrevAM origAMs
-- Generate and define new names to replace them with -- Generate and define new names to replace them with
newNamesS <- sequence [makeNonce (A.nameName n) | n <- freeNames] newNamesS <- sequence [makeNonce (A.nameMeta n) (A.nameName n) | n <- freeNames]
let newNames = [on { A.nameName = nn } | (on, nn) <- zip freeNames newNamesS] let newNames = [on { A.nameName = nn } | (on, nn) <- zip freeNames newNamesS]
onds <- mapM (\n -> lookupNameOrError n $ dieP mp $ "Could not find recorded type for free name: " ++ (show $ A.nameName n)) freeNames onds <- mapM (\n -> lookupNameOrError n $ dieP mp $ "Could not find recorded type for free name: " ++ (show $ A.nameName n)) freeNames
sequence_ [defineName nn (ond { A.ndName = A.nameName nn, sequence_ [defineName nn (ond { A.ndName = A.nameName nn,