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.

backends/BackendPasses.hs

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

backends/GenerateC.hs

@@ -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.Several _ ss) def
-cgenStructured (A.Only m s) def = def m s
+  = 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.Formal -> A.Actual -> (CType -> CType) -> [CGen ()]
-realActuals _ (A.ActualExpression e)
+realActuals _ (A.ActualExpression e) _
     = [call genExpression e]
-realActuals (A.Formal am _ _) (A.ActualVariable v)
+realActuals (A.Formal am _ _) (A.ActualVariable v) fct
-    = [call genVariable v am]
+    = [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

backends/GenerateCBased.hs

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

backends/GenerateCPPCSP.hs

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