Added a pass (and adjusted the backends) to deal with the move-in move-out semantics of mobiles
Also known as communication semantics, I think. The pass adds an extra channel parameter per mobile (perhaps in future this could be a single extra channel?) that is used to send back the mobile value, and hacked the backend so that the communications to receive these mobiles are done in the right place (after the processes have been run, but before waiting on the barrier for them to complete). cgtest83 now compiles, runs and passes without a segfault.
This commit is contained in:
Neil Brown
parent
d12d630de1
commit
12b3c4cd89
|
|
@ -21,6 +21,7 @@ module BackendPasses (addSizesActualParameters, addSizesFormalParameters, declar
|
|||
|
||||
import Control.Monad.State
|
||||
import Data.Generics
|
||||
import Data.List
|
||||
import qualified Data.Map as Map
|
||||
|
||||
import qualified AST as A
|
||||
|
|
@ -47,6 +48,7 @@ backendPasses =
|
|||
, addSizesFormalParameters
|
||||
, addSizesActualParameters
|
||||
, fixMinInt
|
||||
, mobileReturn
|
||||
]
|
||||
|
||||
prereq :: [Property]
|
||||
|
|
@ -410,3 +412,85 @@ simplifySlices = occamOnlyPass "Simplify array slices"
|
|||
return (A.SubscriptedVariable m (A.SubscriptFromFor m' check from (A.Dyadic m A.Subtr limit from)) v)
|
||||
doVariable v = return v
|
||||
|
||||
-- | Finds all processes that have a MOBILE parameter passed in Abbrev mode, and
|
||||
-- add the communication back at the end of the process.
|
||||
mobileReturn :: Pass
|
||||
mobileReturn = cOnlyPass "Add MOBILE returns" [] [] recurse
|
||||
where
|
||||
ops = baseOp `extOpS` doStructured `extOp` doProcess
|
||||
|
||||
descend, recurse :: Data a => Transform a
|
||||
descend = makeDescend ops
|
||||
recurse = makeRecurse ops
|
||||
|
||||
ignoreProc :: A.Name -> PassM Bool
|
||||
ignoreProc n
|
||||
= do nd <- lookupName n
|
||||
return $ "copy_" `isPrefixOf` A.ndOrigName nd -- Bit of a hard-hack
|
||||
|
||||
doProcess :: Transform A.Process
|
||||
doProcess (A.ProcCall m n as)
|
||||
= do sp <- specTypeOfName n
|
||||
fs <- case sp of
|
||||
A.Proc _ _ fs _ -> return fs
|
||||
_ -> dieP m "PROC with unknown spec-type"
|
||||
ig <- ignoreProc n
|
||||
if ig
|
||||
then return $ A.ProcCall m n as
|
||||
else do (surr, as') <- addChansAct m $ zip fs as
|
||||
return $ surr $ A.ProcCall m n as'
|
||||
doProcess p = descend p
|
||||
|
||||
chanT t = A.Chan (A.ChanAttributes False False) t
|
||||
|
||||
addChansAct :: Meta -> [(A.Formal, A.Actual)] -> PassM (A.Process -> A.Process, [A.Actual])
|
||||
addChansAct _ [] = return (id, [])
|
||||
addChansAct m ((A.Formal am t n, a):fas)
|
||||
= do isMobile <- isMobileType t
|
||||
(recF, recAS) <- addChansAct m fas
|
||||
case (am, isMobile) of
|
||||
(A.Abbrev, True)
|
||||
-> do sp@(A.Specification _ c _) <- defineNonce m (A.nameName n)
|
||||
(A.Declaration m $ chanT t) A.Original
|
||||
let av = getV a
|
||||
return (\p -> A.Seq m $ A.Spec m sp $ A.Several m
|
||||
[A.Only m (recF p)
|
||||
,A.Only m $ A.Input m (A.Variable m c) $
|
||||
A.InputSimple m [A.InVariable m av]]
|
||||
, a : A.ActualVariable (A.Variable m c) : recAS)
|
||||
_ -> return (recF, a : recAS)
|
||||
|
||||
getV (A.ActualVariable v) = v
|
||||
getV (A.ActualExpression (A.ExprVariable _ v)) = v
|
||||
|
||||
addChansForm :: Meta -> [A.Formal] -> PassM ([A.Process], [A.Formal])
|
||||
addChansForm _ [] = return ([], [])
|
||||
addChansForm m (f@(A.Formal am t n):fs)
|
||||
= do (ps, fs') <- addChansForm m fs
|
||||
isMobile <- isMobileType t
|
||||
case (am, isMobile) of
|
||||
(A.Abbrev, True)
|
||||
-> do A.Specification _ c _ <- defineNonce m (A.nameName n)
|
||||
(A.Declaration m $ chanT t) A.Abbrev
|
||||
modifyName n $ \nd -> nd {A.ndAbbrevMode = A.Original}
|
||||
return ( ps ++ [A.Output m (A.Variable m c)
|
||||
[A.OutExpression m
|
||||
$ A.ExprVariable m $ A.Variable m n]]
|
||||
, A.Formal A.Original t n : A.Formal A.Abbrev (chanT t) c : fs')
|
||||
_ -> return (ps, f : fs')
|
||||
|
||||
doStructured :: Data a => Transform (A.Structured a)
|
||||
doStructured s@(A.Spec msp (A.Specification m n (A.Proc m' sm fs pr)) scope)
|
||||
= do pr' <- recurse pr
|
||||
-- We do the scope first, so that all the callers are updated before
|
||||
-- we fix our state:
|
||||
scope' <- recurse scope
|
||||
ig <- ignoreProc n
|
||||
if ig
|
||||
then return $ A.Spec msp (A.Specification m n (A.Proc m' sm fs pr')) scope'
|
||||
else do (ps, fs') <- addChansForm m fs
|
||||
let newSpec = A.Proc m' sm fs' (A.Seq m' $ A.Several m' $
|
||||
map (A.Only m') $ pr' : ps)
|
||||
modifyName n (\nd -> nd {A.ndSpecType = newSpec})
|
||||
return $ A.Spec msp (A.Specification m n newSpec) scope'
|
||||
doStructured s = descend s
|
||||
|
|
|
|||
|
|
@ -280,11 +280,12 @@ cgenOverArray m var func
|
|||
Nothing -> return ()
|
||||
|
||||
-- | Generate code for one of the Structured types.
|
||||
cgenStructured :: Data a => A.Structured a -> (Meta -> a -> CGen ()) -> CGen ()
|
||||
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]
|
||||
cgenStructured (A.Only m s) def = def m s
|
||||
cgenStructured (A.Several _ ss) def
|
||||
= sequence [call genStructured s def | s <- ss] >>* concat
|
||||
cgenStructured (A.Only m s) def = def m s >>* singleton
|
||||
|
||||
--}}}
|
||||
|
||||
|
|
@ -630,7 +631,7 @@ cgenVariableWithAM checkValid v am fct
|
|||
t <- astTypeOf v
|
||||
ct <- call getCType m t am >>* fct
|
||||
-- Temporary, for debugging:
|
||||
tell ["/* ", show (snd iv), " , ", show ct, " */"]
|
||||
tell ["/* ", show (snd iv), " , trying to get: ", show ct, " */"]
|
||||
dressUp m iv ct
|
||||
where
|
||||
m = findMeta v
|
||||
|
|
@ -1037,7 +1038,7 @@ cgenInputItem c (A.InVariable m v)
|
|||
do call genClearMobile m v -- TODO insert this via a pass
|
||||
tell ["MTChanIn(wptr,"]
|
||||
genChan c
|
||||
tell [",(void*)"]
|
||||
tell [",(void**)"]
|
||||
rhs
|
||||
tell [");"]
|
||||
_ ->
|
||||
|
|
@ -1079,7 +1080,7 @@ cgenOutputItem innerT c (A.OutExpression m e)
|
|||
do tell ["MTChanOut(wptr,"]
|
||||
genChan c
|
||||
tell [",(void*)"]
|
||||
call genVariable v A.Abbrev
|
||||
call genVariable' v A.Original Pointer
|
||||
tell [");"]
|
||||
(_, _, A.ExprVariable _ v) ->
|
||||
do tell ["ChanOut(wptr,"]
|
||||
|
|
@ -1160,11 +1161,12 @@ abbrevExpression am _ e = call genExpression e
|
|||
--}}}
|
||||
|
||||
--{{{ specifications
|
||||
cgenSpec :: A.Specification -> CGen () -> CGen ()
|
||||
cgenSpec :: A.Specification -> CGen b -> CGen b
|
||||
cgenSpec spec body
|
||||
= do call introduceSpec spec
|
||||
body
|
||||
x <- body
|
||||
call removeSpec spec
|
||||
return x
|
||||
|
||||
-- | Generate a declaration of a new variable.
|
||||
cgenDeclaration :: A.Type -> A.Name -> Bool -> CGen ()
|
||||
|
|
@ -1438,15 +1440,15 @@ cgenActuals :: [A.Formal] -> [A.Actual] -> CGen ()
|
|||
cgenActuals fs as = prefixComma [call genActual f a | (f, a) <- zip fs as]
|
||||
|
||||
cgenActual :: A.Formal -> A.Actual -> CGen ()
|
||||
cgenActual f a = seqComma $ realActuals f a
|
||||
cgenActual f a = seqComma $ realActuals f a id
|
||||
|
||||
-- | Return generators for all the real actuals corresponding to a single
|
||||
-- actual.
|
||||
realActuals :: A.Formal -> A.Actual -> [CGen ()]
|
||||
realActuals _ (A.ActualExpression e)
|
||||
realActuals :: A.Formal -> A.Actual -> (CType -> CType) -> [CGen ()]
|
||||
realActuals _ (A.ActualExpression e) _
|
||||
= [call genExpression e]
|
||||
realActuals (A.Formal am _ _) (A.ActualVariable v)
|
||||
= [call genVariable v am]
|
||||
realActuals (A.Formal am _ _) (A.ActualVariable v) fct
|
||||
= [call genVariable' v am fct]
|
||||
|
||||
-- | Return (type, name) generator pairs for all the real formals corresponding
|
||||
-- to a single formal.
|
||||
|
|
@ -1508,17 +1510,24 @@ genProcSpec n (A.Proc _ (sm, _) fs p) forwardDecl
|
|||
-- workspace pointer and the name of the function to call.
|
||||
cgenProcAlloc :: A.Name -> [A.Formal] -> [A.Actual] -> CGen (String, CGen ())
|
||||
cgenProcAlloc n fs as
|
||||
= do let ras = concat [realActuals f a | (f, a) <- zip fs as]
|
||||
= do ras <- liftM concat $ sequence
|
||||
[do isMobile <- isMobileType t
|
||||
let (s, fct) = case (am, isMobile) of
|
||||
(A.ValAbbrev, _) -> ("ProcParam", id)
|
||||
(_, True) -> ("ProcMTMove", Pointer)
|
||||
_ -> ("ProcParam", id)
|
||||
return $ zip (repeat s) $ realActuals f a fct
|
||||
| (f@(A.Formal am t _), a) <- zip fs as]
|
||||
|
||||
ws <- csmLift $ makeNonce "workspace"
|
||||
tell ["Workspace ", ws, " = ProcAlloc (wptr, ", show $ length ras, ", "]
|
||||
genName n
|
||||
tell ["_stack_size);\n"]
|
||||
|
||||
sequence_ [do tell ["ProcParam (wptr, ", ws, ", ", show num, ", "]
|
||||
sequence_ [do tell [pc, " (wptr, ", ws, ", ", show num, ", "]
|
||||
ra
|
||||
tell [");\n"]
|
||||
| (num, ra) <- zip [(0 :: Int)..] ras]
|
||||
| (num, (pc, ra)) <- zip [(0 :: Int)..] ras]
|
||||
|
||||
return (ws, genName n)
|
||||
--}}}
|
||||
|
|
@ -1663,7 +1672,7 @@ cgenStop m s
|
|||
--}}}
|
||||
--{{{ seq
|
||||
cgenSeq :: A.Structured A.Process -> CGen ()
|
||||
cgenSeq s = call genStructured s doP
|
||||
cgenSeq s = call genStructured s doP >> return ()
|
||||
where
|
||||
doP _ p = call genProcess p
|
||||
--}}}
|
||||
|
|
@ -1681,7 +1690,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
|
||||
genIfBody label s = call genStructured s doC >> return ()
|
||||
where
|
||||
doC m (A.Choice m' e p)
|
||||
= do tell ["if("]
|
||||
|
|
@ -1757,18 +1766,26 @@ cgenPar pm s
|
|||
call genExpression count
|
||||
tell [");\n"]
|
||||
|
||||
call genStructured s (startP bar)
|
||||
after <- call genStructured s (startP bar)
|
||||
mapM_ (call genProcess) after
|
||||
|
||||
tell ["LightProcBarrierWait (wptr, &", bar, ");\n"]
|
||||
|
||||
where
|
||||
startP :: String -> Meta -> A.Process -> CGen ()
|
||||
startP :: String -> Meta -> A.Process -> CGen A.Process
|
||||
startP bar _ (A.ProcCall _ n as)
|
||||
= do (A.Proc _ _ fs _) <- specTypeOfName n
|
||||
(ws, func) <- cgenProcAlloc n fs as
|
||||
tell ["LightProcStart (wptr, &", bar, ", ", ws, ", "]
|
||||
func
|
||||
tell [");\n"]
|
||||
return (A.Skip emptyMeta)
|
||||
-- When we need to receive mobiles back from the processes, we need to perform
|
||||
-- some actions after all the processes have started, but before we wait on
|
||||
-- the barrier, so this hack collects up all such receive operations and returns
|
||||
-- them:
|
||||
startP bar _ (A.Seq m s)
|
||||
= call genStructured s (startP bar) >>* (A.Seq m . A.Several m . map (A.Only m))
|
||||
startP _ _ p = return p
|
||||
--}}}
|
||||
--{{{ alt
|
||||
cgenAlt :: Bool -> A.Structured A.Alternative -> CGen ()
|
||||
|
|
@ -1809,7 +1826,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
|
||||
genAltEnable id s = call genStructured s doA >> return ()
|
||||
where
|
||||
doA _ alt
|
||||
= case alt of
|
||||
|
|
@ -1829,7 +1846,7 @@ cgenAlt isPri s
|
|||
tell [");\n"]
|
||||
|
||||
genAltDisable :: String -> A.Structured A.Alternative -> CGen ()
|
||||
genAltDisable id s = call genStructured s doA
|
||||
genAltDisable id s = call genStructured s doA >> return ()
|
||||
where
|
||||
doA _ alt
|
||||
= case alt of
|
||||
|
|
@ -1849,7 +1866,7 @@ cgenAlt isPri s
|
|||
tell [");\n"]
|
||||
|
||||
genAltProcesses :: String -> String -> String -> A.Structured A.Alternative -> CGen ()
|
||||
genAltProcesses id fired label s = call genStructured s doA
|
||||
genAltProcesses id fired label s = call genStructured s doA >> return ()
|
||||
where
|
||||
doA _ alt
|
||||
= case alt of
|
||||
|
|
|
|||
|
|
@ -167,11 +167,11 @@ data GenOps = GenOps {
|
|||
genSimpleDyadic :: String -> A.Expression -> A.Expression -> CGen (),
|
||||
genSimpleMonadic :: String -> A.Expression -> CGen (),
|
||||
genSizeSuffix :: String -> CGen (),
|
||||
genSpec :: A.Specification -> CGen () -> CGen (),
|
||||
genSpec :: forall b. 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. Data a => A.Structured a -> (Meta -> a -> CGen ()) -> CGen (),
|
||||
genStructured :: forall a b. Data a => A.Structured a -> (Meta -> a -> CGen b) -> CGen [b],
|
||||
genTimerRead :: A.Variable -> A.Variable -> CGen (),
|
||||
genTimerWait :: A.Expression -> CGen (),
|
||||
genTopLevel :: A.AST -> CGen (),
|
||||
|
|
|
|||
|
|
@ -421,7 +421,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
|
||||
initAltGuards guardList s = call genStructured s doA >> return ()
|
||||
where
|
||||
doA _ alt
|
||||
= case alt of
|
||||
|
|
@ -442,7 +442,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
|
||||
genAltProcesses id fired label s = call genStructured s doA >> return ()
|
||||
where
|
||||
doA _ alt
|
||||
= case alt of
|
||||
|
|
@ -776,7 +776,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
|
||||
genIfBody ifExc s = call genStructured s doC >> return ()
|
||||
where
|
||||
doC m (A.Choice m' e p)
|
||||
= do tell ["if("]
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user