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 m'' a@(A.Alternative m cond tim (A.InputTimerFor m' e) p)
= do (specs, init) <- get
id <- lift $ makeNonce "waitFor"
id <- lift $ makeNonce m "waitFor"
let n = A.Name m id
let var = A.Variable m n
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
(_, Just (A.Array ds elemT)) ->
-- 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
(n_sizes, msizeSpec) <-
case spec of
@ -385,7 +385,7 @@ declareSizesArray = occamOnlyPass "Declare array-size arrays"
= case (t, ext) of
-- For externals, we always add extra formals (one per dimension!):
(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
(rest, moreNew) <- transformFormals ext m fs
return (f : newfs ++ rest, newfs ++ moreNew)
@ -395,7 +395,7 @@ declareSizesArray = occamOnlyPass "Declare array-size arrays"
(A.Array ds _, _)
| A.UnknownDimension `elem` ds ->
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
let newf = A.Formal A.ValAbbrev sizeType n_sizes
(rest, moreNew) <- transformFormals ext m fs

26
backends/GenerateC.hs
View File

@ -202,9 +202,9 @@ cgenTopLevel headerName s
when (csHasMain cs) $ do
(tlpName, tlpChans) <- tlpInterface
chans <- sequence [csmLift $ makeNonce "tlp_channel" | _ <- tlpChans]
killChans <- sequence [csmLift $ makeNonce "tlp_channel_kill" | _ <- tlpChans]
workspaces <- sequence [csmLift $ makeNonce "tlp_channel_ws" | _ <- tlpChans]
chans <- sequence [csmLift $ makeNonce emptyMeta "tlp_channel" | _ <- tlpChans]
killChans <- sequence [csmLift $ makeNonce emptyMeta "tlp_channel_kill" | _ <- tlpChans]
workspaces <- sequence [csmLift $ makeNonce emptyMeta "tlp_channel_ws" | _ <- tlpChans]
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
-- 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:
= do counter <- csmLift $ makeNonce "replicator_count"
= do counter <- csmLift $ makeNonce m "replicator_count"
tell ["int ", counter, "="]
call genExpression count
tell [","]
@ -1351,7 +1351,7 @@ cintroduceSpec lvl (A.Specification _ n (A.Is _ am t (A.ActualVariable v)))
tell ["="]
rhs
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
case (am, t, e) of
(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 _ _ _) ->
-- 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"
do tmp <- csmLift $ makeNonce m "record_literal"
genStatic lvl n
tell ["const "]
genType t
@ -1638,7 +1638,7 @@ cgenProcAlloc n fs as
return $ zip (repeat s) $ realActuals f a fct
| (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, ", "]
genName 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"
tell ["}"]
| otherwise
= do label <- csmLift $ makeNonce "if_end"
= do label <- csmLift $ makeNonce m "if_end"
tell ["/*",label,"*/"]
genIfBody label s
call genStop m "no choice matched in IF process"
@ -1902,10 +1902,10 @@ cgenWhile e p
-- the same as PAR.
cgenPar :: A.ParMode -> A.Structured A.Process -> CGen ()
cgenPar pm s
= do bar <- csmLift $ makeNonce "par_barrier"
= do bar <- csmLift $ makeNonce emptyMeta "par_barrier"
tell ["LightProcBarrier ", bar, ";"]
let count = countStructured s
wss <- csmLift $ makeNonce "wss"
wss <- csmLift $ makeNonce emptyMeta "wss"
tell ["Workspace* ",wss,"=(Workspace*)malloc(sizeof(int)*"]
call genExpression count
tell [");"]
@ -1936,7 +1936,7 @@ cgenPar pm s
--{{{ alt
cgenAlt :: Bool -> A.Structured A.Alternative -> CGen ()
cgenAlt isPri s
= do id <- csmLift $ makeNonce "alt_id"
= do id <- csmLift $ makeNonce emptyMeta "alt_id"
tell ["int ", id, " = 0;\n"]
let isTimerAlt = containsTimers s
@ -1952,10 +1952,10 @@ cgenAlt isPri s
genAltDisable id s
tell ["}\n"]
fired <- csmLift $ makeNonce "alt_fired"
fired <- csmLift $ makeNonce emptyMeta "alt_fired"
tell ["int ", fired, " = AltEnd (wptr);\n"]
tell [id, " = 0;\n"]
label <- csmLift $ makeNonce "alt_end"
label <- csmLift $ makeNonce emptyMeta "alt_end"
tell ["{\n"]
genAltProcesses id fired label s
tell ["}\n"]

24
backends/GenerateCPPCSP.hs
View File

@ -276,14 +276,14 @@ Otherwise, it must not have.
-}
genCPPCSPTime :: A.Expression -> CGen String
genCPPCSPTime e
= do time <- csmLift $ makeNonce "time_exp"
= do time <- csmLift $ makeNonce emptyMeta "time_exp"
tell ["unsigned ",time," = (unsigned)"]
call genExpression e
tell [" ; "]
curTime <- csmLift $ makeNonce "time_exp"
curTimeLow <- csmLift $ makeNonce "time_exp"
curTimeHigh <- csmLift $ makeNonce "time_exp"
retTime <- csmLift $ makeNonce "time_exp"
curTime <- csmLift $ makeNonce emptyMeta "time_exp"
curTimeLow <- csmLift $ makeNonce emptyMeta "time_exp"
curTimeHigh <- csmLift $ makeNonce emptyMeta "time_exp"
retTime <- csmLift $ makeNonce emptyMeta "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);"]
@ -383,7 +383,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 <- csmLift $ makeNonce "forking"
= do forking <- csmLift $ makeNonce emptyMeta "forking"
tell ["{ csp::ScopedForking ",forking," ; "]
call genStructured NotTopLevel s (genPar' forking)
tell [" }"]
@ -405,17 +405,17 @@ cppgenPar _ s
-- | Changed to use C++CSP's Alternative class:
cppgenAlt :: Bool -> A.Structured A.Alternative -> CGen ()
cppgenAlt _ s
= do guards <- csmLift $ makeNonce "alt_guards"
= do guards <- csmLift $ makeNonce emptyMeta "alt_guards"
tell ["std::list< csp::Guard* > ", guards, " ; "]
initAltGuards guards s
alt <- csmLift $ makeNonce "alt"
alt <- csmLift $ makeNonce emptyMeta "alt"
tell ["csp::Alternative ",alt, " ( ", guards, " ); "]
id <- csmLift $ makeNonce "alt_id"
id <- csmLift $ makeNonce emptyMeta "alt_id"
tell ["int ", id, " = 0;\n"]
fired <- csmLift $ makeNonce "alt_fired"
fired <- csmLift $ makeNonce emptyMeta "alt_fired"
tell ["int ", fired, " = ", alt, " .priSelect();"]
label <- csmLift $ makeNonce "alt_end"
label <- csmLift $ makeNonce emptyMeta "alt_end"
tell ["{\n"]
genAltProcesses id fired label s
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"
tell ["}"]
| otherwise
= do ifExc <- csmLift $ makeNonce "if_exc"
= do ifExc <- csmLift $ makeNonce emptyMeta "if_exc"
tell ["class ",ifExc, "{};try{"]
genIfBody ifExc s
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.
makeUniqueName :: CSM m => Meta -> String -> m String
makeUniqueName m s
= let mungedFile = munge $ show m in return $ s ++ "_" ++ mungedFile
where
munge cs = [if c `elem` (['A'..'Z'] ++ ['a'..'z'] ++ ['0'..'9'])
= let mungedFile = mungeMeta m in return $ s ++ "_" ++ mungedFile
mungeMeta :: Meta -> String
mungeMeta m = [if c `elem` (['A'..'Z'] ++ ['a'..'z'] ++ ['0'..'9'])
then c
else '_'
| c <- cs]
| c <- show m]
-- | Find an unscoped name -- or define a new one if it doesn't already exist.
findUnscopedName :: CSM m => A.Name -> m A.Name
@ -350,17 +351,17 @@ getTypeContext
--{{{ nonces
-- | Generate a throwaway unique name.
makeNonce :: CSM m => String -> m String
makeNonce s
makeNonce :: CSM m => Meta -> String -> m String
makeNonce m s
= do ps <- get
let i = csNonceCounter ps
put ps { csNonceCounter = i + 1 }
return $ s ++ "_n" ++ show i
return $ s ++ mungeMeta m ++ "_n" ++ show i
-- | Generate and define a nonce specification.
defineNonce :: CSM m => Meta -> String -> A.SpecType -> A.AbbrevMode -> m A.Specification
defineNonce m s st am
= do ns <- makeNonce s
= do ns <- makeNonce m s
let n = A.Name m ns
let nd = A.NameDef {
A.ndMeta = m,

6
frontends/RainPasses.hs
View File

@ -106,7 +106,7 @@ uniquifyAndResolveVars = rainOnlyPass
--Variable declarations and replicators:
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,
A.ndSpecType = decl, A.ndNameSource = A.NameUser,
A.ndAbbrevMode = A.Original, A.ndPlacement = A.Unplaced}
@ -126,7 +126,7 @@ uniquifyAndResolveVars = rainOnlyPass
return ((f':fs'),s'')
doFormals' :: Data t => A.Formal -> t -> PassM (A.Formal,t)
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 m = A.nameMeta 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"
--in the CompState, and pull it out into csMainLocals
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)
applyDepthM (return . (replaceNameName "main" newMainName)) x)
where

2
transformations/Unnest.hs
View File

@ -133,7 +133,7 @@ removeFreeNames = pass "Convert free names to arguments"
let ams = map makeAbbrevAM origAMs
-- 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]
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,