Added support for the new AlternativeWait guards to the C backend
This was not as straightforward as the C++ backend. CIF has no capability for supporting waiting *for* a specified time as an ALT guard; only waiting until (AFTER, in occam) a specified time. This is further complicated by the fact that when you disable an ALT timer guard in CIF, you have to be able to supply the timeout value that you waited on in the enable sequence. Therefore, I added a pass that transforms all WaitFor guards into WaitUntil guards, by declaring nonce time variables, getting the time, and adding on the delay that we want to wait for; these actions occur just before the ALT. This new pass is in the new BackendPasses module, into which I also moved the identifyParProcs pass. I also wrote tests for my new pass that live in the new BackendPassesTest module.
This commit is contained in:
Neil Brown
parent
47052d5f39
commit
8d95b65f00
|
|
@ -18,6 +18,8 @@ with this program. If not, see <http://www.gnu.org/licenses/>.
|
|||
|
||||
-- | A module containing the 'main' function for the Tock test suite. It currently runs tests from the following modules:
|
||||
--
|
||||
-- * "BackendPassesTest"
|
||||
--
|
||||
-- * "CommonTest"
|
||||
--
|
||||
-- * "PassTest"
|
||||
|
|
@ -35,6 +37,7 @@ import qualified RainTypesTest (tests)
|
|||
import qualified UsageCheckTest (tests)
|
||||
import qualified PassTest (tests)
|
||||
import qualified CommonTest (tests)
|
||||
import qualified BackendPassesTest (tests)
|
||||
import Test.HUnit
|
||||
|
||||
main :: IO ()
|
||||
|
|
@ -46,5 +49,6 @@ main = do runTestTT $ TestList
|
|||
,RainPassesTest.tests
|
||||
,RainTypesTest.tests
|
||||
,UsageCheckTest.tests
|
||||
,BackendPassesTest.tests
|
||||
]
|
||||
return ()
|
||||
|
|
|
|||
70
backends/BackendPasses.hs
Normal file
70
backends/BackendPasses.hs
Normal file
|
|
@ -0,0 +1,70 @@
|
|||
{-
|
||||
Tock: a compiler for parallel languages
|
||||
Copyright (C) 2007 University of Kent
|
||||
|
||||
This program is free software; you can redistribute it and/or modify it
|
||||
under the terms of the GNU General Public License as published by the
|
||||
Free Software Foundation, either version 2 of the License, or (at your
|
||||
option) any later version.
|
||||
|
||||
This program is distributed in the hope that it will be useful, but
|
||||
WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||
General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License along
|
||||
with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
-}
|
||||
|
||||
-- | Passes associated with the backends
|
||||
module BackendPasses where
|
||||
|
||||
import Control.Monad.State
|
||||
import Data.Generics
|
||||
import qualified Data.Set as Set
|
||||
|
||||
import qualified AST as A
|
||||
import CompState
|
||||
import Pass
|
||||
|
||||
-- | Identify processes that we'll need to compute the stack size of.
|
||||
identifyParProcs :: Pass
|
||||
identifyParProcs = everywhereM (mkM doProcess)
|
||||
where
|
||||
doProcess :: A.Process -> PassM A.Process
|
||||
doProcess p@(A.Par _ _ s) = findProcs s >> return p
|
||||
doProcess p = return p
|
||||
|
||||
findProcs :: A.Structured -> PassM ()
|
||||
findProcs (A.Rep _ _ s) = findProcs s
|
||||
findProcs (A.Spec _ _ s) = findProcs s
|
||||
findProcs (A.ProcThen _ _ s) = findProcs s
|
||||
findProcs (A.Several _ ss) = sequence_ $ map findProcs ss
|
||||
findProcs (A.OnlyP _ (A.ProcCall _ n _))
|
||||
= modify (\cs -> cs { csParProcs = Set.insert n (csParProcs cs) })
|
||||
|
||||
transformWaitFor :: Data t => t -> PassM t
|
||||
transformWaitFor = everywhereM (mkM doAlt)
|
||||
where
|
||||
doAlt :: A.Process -> PassM A.Process
|
||||
doAlt a@(A.Alt m pri s)
|
||||
= do (a',(specs,code)) <- runStateT (everywhereM (mkM doWaitFor) a) ([],[])
|
||||
if (null specs && null code)
|
||||
then return a
|
||||
else return $ A.Seq m $ foldr addSpec (A.Several m (code ++ [A.OnlyP m a'])) specs
|
||||
doAlt p = return p
|
||||
|
||||
addSpec :: (A.Structured -> A.Structured) -> A.Structured -> A.Structured
|
||||
addSpec spec inner = spec inner
|
||||
|
||||
doWaitFor :: A.Alternative -> StateT ([A.Structured -> A.Structured], [A.Structured]) PassM A.Alternative
|
||||
doWaitFor a@(A.AlternativeWait m A.WaitFor e p)
|
||||
= do (specs, init) <- get
|
||||
id <- lift $ makeNonce "waitFor"
|
||||
let n = (A.Name m A.VariableName id)
|
||||
let var = A.Variable m n
|
||||
put (specs ++ [A.Spec m (A.Specification m n (A.Declaration m A.Time))],
|
||||
init ++ [A.OnlyP m $ A.GetTime m var, A.OnlyP m $ A.Assign m [var] $ A.ExpressionList m [A.Dyadic m A.Plus (A.ExprVariable m var) e]])
|
||||
return $ A.AlternativeWait m A.WaitUntil (A.ExprVariable m var) p
|
||||
|
||||
doWaitFor a = return a
|
||||
188
backends/BackendPassesTest.hs
Normal file
188
backends/BackendPassesTest.hs
Normal file
|
|
@ -0,0 +1,188 @@
|
|||
{-
|
||||
Tock: a compiler for parallel languages
|
||||
Copyright (C) 2007 University of Kent
|
||||
|
||||
This program is free software; you can redistribute it and/or modify it
|
||||
under the terms of the GNU General Public License as published by the
|
||||
Free Software Foundation, either version 2 of the License, or (at your
|
||||
option) any later version.
|
||||
|
||||
This program is distributed in the hope that it will be useful, but
|
||||
WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||
General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License along
|
||||
with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
-}
|
||||
|
||||
-- #ignore-exports
|
||||
|
||||
module BackendPassesTest (tests) where
|
||||
|
||||
import Test.HUnit hiding (State)
|
||||
import Control.Monad.State as CSM
|
||||
import qualified Data.Map as Map
|
||||
import qualified AST as A
|
||||
import TestUtil
|
||||
import Pattern
|
||||
import TreeUtil
|
||||
import CompState
|
||||
import Control.Monad.Error (runErrorT)
|
||||
import Data.Generics
|
||||
import Utils
|
||||
import Errors
|
||||
import BackendPasses
|
||||
|
||||
skipP :: A.Structured
|
||||
skipP = A.OnlyP m (A.Skip m)
|
||||
|
||||
castAssertADI :: (Typeable b) => Maybe AnyDataItem -> IO b
|
||||
castAssertADI x = case (castADI x) of
|
||||
Just y -> return y
|
||||
Nothing -> dieInternal (Nothing, "Pattern successfully matched but did not find item afterwards")
|
||||
{-
|
||||
testPullUpParDecl0 :: Test
|
||||
testPullUpParDecl0 = TestCase $ testPass "testPullUpParDecl0" orig (pullUpParDeclarations orig) (return ())
|
||||
where
|
||||
orig = A.Par m A.PlainPar (A.Several m [])
|
||||
|
||||
testPullUpParDecl1 :: Test
|
||||
testPullUpParDecl1 = TestCase $ testPass "testPullUpParDecl1" exp (pullUpParDeclarations orig) (return ())
|
||||
where
|
||||
orig = A.Par m A.PlainPar $
|
||||
A.Spec m (A.Specification m (simpleName "x") $ A.Declaration m A.Int) (A.Several m [])
|
||||
exp = A.Seq m $ A.Spec m (A.Specification m (simpleName "x") $ A.Declaration m A.Int) (A.OnlyP m $ A.Par m A.PlainPar $ A.Several m [])
|
||||
|
||||
testPullUpParDecl2 :: Test
|
||||
testPullUpParDecl2 = TestCase $ testPass "testPullUpParDecl2" exp (pullUpParDeclarations orig) (return ())
|
||||
where
|
||||
orig = A.Par m A.PlainPar $
|
||||
A.Spec m (A.Specification m (simpleName "x") $ A.Declaration m A.Int) $
|
||||
A.Spec m (A.Specification m (simpleName "y") $ A.Declaration m A.Byte) $
|
||||
(A.Several m [])
|
||||
exp = A.Seq m $ A.Spec m (A.Specification m (simpleName "x") $ A.Declaration m A.Int)
|
||||
$ A.Spec m (A.Specification m (simpleName "y") $ A.Declaration m A.Byte)
|
||||
(A.OnlyP m $ A.Par m A.PlainPar $ A.Several m [])
|
||||
-}
|
||||
|
||||
-- | Test WaitUntil guard (should be unchanged)
|
||||
testTransformWaitFor0 :: Test
|
||||
testTransformWaitFor0 = TestCase $ testPass "testTransformWaitFor0" orig (transformWaitFor orig) (return ())
|
||||
where
|
||||
orig = A.Alt m True $ A.OnlyA m $ A.AlternativeWait m A.WaitUntil (exprVariable "t") (A.Skip m)
|
||||
|
||||
-- | Test pulling out a single WaitFor:
|
||||
testTransformWaitFor1 :: Test
|
||||
testTransformWaitFor1 = TestCase $ testPass "testTransformWaitFor1" exp (transformWaitFor orig) (return ())
|
||||
where
|
||||
orig = A.Alt m True $ A.OnlyA m $ A.AlternativeWait m A.WaitFor (exprVariable "t") (A.Skip m)
|
||||
exp = tag2 A.Seq DontCare $ tag3 A.Spec DontCare (tag3 A.Specification DontCare varName $ tag2 A.Declaration DontCare A.Time) $
|
||||
tag2 A.Several DontCare
|
||||
[
|
||||
tag2 A.OnlyP DontCare $ tag2 A.GetTime DontCare var
|
||||
,tag2 A.OnlyP DontCare $ tag3 A.Assign DontCare [var] $ tag2 A.ExpressionList DontCare [tag4 A.Dyadic DontCare A.Plus evar (exprVariablePattern "t")]
|
||||
,tag2 A.OnlyP DontCare $ tag3 A.Alt DontCare True $ tag2 A.OnlyA DontCare $ tag4 A.AlternativeWait DontCare A.WaitUntil evar (A.Skip m)
|
||||
]
|
||||
varName = (tag3 A.Name DontCare A.VariableName $ Named "nowt" DontCare)
|
||||
var = tag2 A.Variable DontCare varName
|
||||
evar = tag2 A.ExprVariable DontCare var
|
||||
|
||||
-- | Test pulling out two WaitFors:
|
||||
testTransformWaitFor2 :: Test
|
||||
testTransformWaitFor2 = TestCase $ testPass "testTransformWaitFor2" exp (transformWaitFor orig) (return ())
|
||||
where
|
||||
orig = A.Alt m True $ A.Several m [A.OnlyA m $ A.AlternativeWait m A.WaitFor (exprVariable "t0") (A.Skip m),
|
||||
A.OnlyA m $ A.AlternativeWait m A.WaitFor (exprVariable "t1") (A.Skip m)]
|
||||
exp = tag2 A.Seq DontCare $ tag3 A.Spec DontCare (tag3 A.Specification DontCare varName0 $ tag2 A.Declaration DontCare A.Time) $
|
||||
tag3 A.Spec DontCare (tag3 A.Specification DontCare varName1 $ tag2 A.Declaration DontCare A.Time) $
|
||||
tag2 A.Several DontCare
|
||||
[
|
||||
tag2 A.OnlyP DontCare $ tag2 A.GetTime DontCare var0
|
||||
,tag2 A.OnlyP DontCare $ tag3 A.Assign DontCare [var0] $ tag2 A.ExpressionList DontCare [tag4 A.Dyadic DontCare A.Plus evar0 (exprVariablePattern "t0")]
|
||||
,tag2 A.OnlyP DontCare $ tag2 A.GetTime DontCare var1
|
||||
,tag2 A.OnlyP DontCare $ tag3 A.Assign DontCare [var1] $ tag2 A.ExpressionList DontCare [tag4 A.Dyadic DontCare A.Plus evar1 (exprVariablePattern "t1")]
|
||||
,tag2 A.OnlyP DontCare $ tag3 A.Alt DontCare True $ tag2 A.Several DontCare
|
||||
[tag2 A.OnlyA DontCare $ tag4 A.AlternativeWait DontCare A.WaitUntil evar0 (A.Skip m)
|
||||
,tag2 A.OnlyA DontCare $ tag4 A.AlternativeWait DontCare A.WaitUntil evar1 (A.Skip m)]
|
||||
]
|
||||
varName0 = (tag3 A.Name DontCare A.VariableName $ Named "nowt0" DontCare)
|
||||
var0 = tag2 A.Variable DontCare varName0
|
||||
evar0 = tag2 A.ExprVariable DontCare var0
|
||||
varName1 = (tag3 A.Name DontCare A.VariableName $ Named "nowt1" DontCare)
|
||||
var1 = tag2 A.Variable DontCare varName1
|
||||
evar1 = tag2 A.ExprVariable DontCare var1
|
||||
|
||||
-- | Test pulling out a single WaitFor with an expression:
|
||||
testTransformWaitFor3 :: Test
|
||||
testTransformWaitFor3 = TestCase $ testPass "testTransformWaitFor3" exp (transformWaitFor orig) (return ())
|
||||
where
|
||||
orig = A.Alt m True $ A.OnlyA m $ A.AlternativeWait m A.WaitFor (A.Dyadic m A.Plus (exprVariable "t0") (exprVariable "t1")) (A.Skip m)
|
||||
exp = tag2 A.Seq DontCare $ tag3 A.Spec DontCare (tag3 A.Specification DontCare varName $ tag2 A.Declaration DontCare A.Time) $
|
||||
tag2 A.Several DontCare
|
||||
[
|
||||
tag2 A.OnlyP DontCare $ tag2 A.GetTime DontCare var
|
||||
,tag2 A.OnlyP DontCare $ tag3 A.Assign DontCare [var] $ tag2 A.ExpressionList DontCare [tag4 A.Dyadic DontCare A.Plus evar
|
||||
(A.Dyadic m A.Plus (exprVariable "t0") (exprVariable "t1"))]
|
||||
,tag2 A.OnlyP DontCare $ tag3 A.Alt DontCare True $ tag2 A.OnlyA DontCare $ tag4 A.AlternativeWait DontCare A.WaitUntil evar (A.Skip m)
|
||||
]
|
||||
varName = (tag3 A.Name DontCare A.VariableName $ Named "nowt" DontCare)
|
||||
var = tag2 A.Variable DontCare varName
|
||||
evar = tag2 A.ExprVariable DontCare var
|
||||
|
||||
-- | Test pulling out a single WaitFor with some slight nesting in the ALT:
|
||||
testTransformWaitFor4 :: Test
|
||||
testTransformWaitFor4 = TestCase $ testPass "testTransformWaitFor4" exp (transformWaitFor orig) (return ())
|
||||
where
|
||||
orig = A.Alt m True $ A.Several m [A.OnlyA m $ A.AlternativeWait m A.WaitFor (exprVariable "t") (A.Skip m)]
|
||||
exp = tag2 A.Seq DontCare $ tag3 A.Spec DontCare (tag3 A.Specification DontCare varName $ tag2 A.Declaration DontCare A.Time) $
|
||||
tag2 A.Several DontCare
|
||||
[
|
||||
tag2 A.OnlyP DontCare $ tag2 A.GetTime DontCare var
|
||||
,tag2 A.OnlyP DontCare $ tag3 A.Assign DontCare [var] $ tag2 A.ExpressionList DontCare [tag4 A.Dyadic DontCare A.Plus evar (exprVariablePattern "t")]
|
||||
,tag2 A.OnlyP DontCare $ tag3 A.Alt DontCare True $ tag2 A.Several DontCare
|
||||
[tag2 A.OnlyA DontCare $ tag4 A.AlternativeWait DontCare A.WaitUntil evar (A.Skip m)]
|
||||
]
|
||||
varName = (tag3 A.Name DontCare A.VariableName $ Named "nowt" DontCare)
|
||||
var = tag2 A.Variable DontCare varName
|
||||
evar = tag2 A.ExprVariable DontCare var
|
||||
|
||||
-- | Test pulling out two WaitFors that use the same variable:
|
||||
testTransformWaitFor5 :: Test
|
||||
testTransformWaitFor5 = TestCase $ testPass "testTransformWaitFor5" exp (transformWaitFor orig) (return ())
|
||||
where
|
||||
orig = A.Alt m True $ A.Several m [A.OnlyA m $ A.AlternativeWait m A.WaitFor (exprVariable "t") (A.Skip m),
|
||||
A.OnlyA m $ A.AlternativeWait m A.WaitFor (exprVariable "t") (A.Skip m)]
|
||||
exp = tag2 A.Seq DontCare $ tag3 A.Spec DontCare (tag3 A.Specification DontCare varName0 $ tag2 A.Declaration DontCare A.Time) $
|
||||
tag3 A.Spec DontCare (tag3 A.Specification DontCare varName1 $ tag2 A.Declaration DontCare A.Time) $
|
||||
tag2 A.Several DontCare
|
||||
[
|
||||
tag2 A.OnlyP DontCare $ tag2 A.GetTime DontCare var0
|
||||
,tag2 A.OnlyP DontCare $ tag3 A.Assign DontCare [var0] $ tag2 A.ExpressionList DontCare [tag4 A.Dyadic DontCare A.Plus evar0 (exprVariablePattern "t")]
|
||||
,tag2 A.OnlyP DontCare $ tag2 A.GetTime DontCare var1
|
||||
,tag2 A.OnlyP DontCare $ tag3 A.Assign DontCare [var1] $ tag2 A.ExpressionList DontCare [tag4 A.Dyadic DontCare A.Plus evar1 (exprVariablePattern "t")]
|
||||
,tag2 A.OnlyP DontCare $ tag3 A.Alt DontCare True $ tag2 A.Several DontCare
|
||||
[tag2 A.OnlyA DontCare $ tag4 A.AlternativeWait DontCare A.WaitUntil evar0 (A.Skip m)
|
||||
,tag2 A.OnlyA DontCare $ tag4 A.AlternativeWait DontCare A.WaitUntil evar1 (A.Skip m)]
|
||||
]
|
||||
varName0 = (tag3 A.Name DontCare A.VariableName $ Named "nowt0" DontCare)
|
||||
var0 = tag2 A.Variable DontCare varName0
|
||||
evar0 = tag2 A.ExprVariable DontCare var0
|
||||
varName1 = (tag3 A.Name DontCare A.VariableName $ Named "nowt1" DontCare)
|
||||
var1 = tag2 A.Variable DontCare varName1
|
||||
evar1 = tag2 A.ExprVariable DontCare var1
|
||||
|
||||
|
||||
---Returns the list of tests:
|
||||
tests :: Test
|
||||
tests = TestList
|
||||
[
|
||||
testTransformWaitFor0
|
||||
,testTransformWaitFor1
|
||||
,testTransformWaitFor2
|
||||
,testTransformWaitFor3
|
||||
,testTransformWaitFor4
|
||||
,testTransformWaitFor5
|
||||
]
|
||||
|
||||
|
||||
|
|
@ -31,6 +31,7 @@ import Numeric
|
|||
import Text.Printf
|
||||
|
||||
import qualified AST as A
|
||||
import BackendPasses
|
||||
import CompState
|
||||
import EvalConstants
|
||||
import EvalLiterals
|
||||
|
|
@ -46,23 +47,8 @@ import Utils
|
|||
genCPasses :: [(String, Pass)]
|
||||
genCPasses =
|
||||
[ ("Identify parallel processes", identifyParProcs)
|
||||
,("Transform wait for guards into wait until guards", transformWaitFor)
|
||||
]
|
||||
|
||||
-- | Identify processes that we'll need to compute the stack size of.
|
||||
identifyParProcs :: Pass
|
||||
identifyParProcs = everywhereM (mkM doProcess)
|
||||
where
|
||||
doProcess :: A.Process -> PassM A.Process
|
||||
doProcess p@(A.Par _ _ s) = findProcs s >> return p
|
||||
doProcess p = return p
|
||||
|
||||
findProcs :: A.Structured -> PassM ()
|
||||
findProcs (A.Rep _ _ s) = findProcs s
|
||||
findProcs (A.Spec _ _ s) = findProcs s
|
||||
findProcs (A.ProcThen _ _ s) = findProcs s
|
||||
findProcs (A.Several _ ss) = sequence_ $ map findProcs ss
|
||||
findProcs (A.OnlyP _ (A.ProcCall _ n _))
|
||||
= modify (\cs -> cs { csParProcs = Set.insert n (csParProcs cs) })
|
||||
--}}}
|
||||
|
||||
--{{{ monad definition
|
||||
|
|
@ -1756,6 +1742,11 @@ cgenAlt ops isPri s
|
|||
A.Alternative _ c im _ -> doIn c im
|
||||
A.AlternativeCond _ e c im _ -> withIf ops e $ doIn c im
|
||||
A.AlternativeSkip _ e _ -> withIf ops e $ tell ["AltEnableSkip ();\n"]
|
||||
--transformWaitFor should have removed all A.WaitFor guards (transforming them into A.WaitUntil):
|
||||
A.AlternativeWait _ A.WaitUntil e _ ->
|
||||
do tell ["AltEnableTimer ( "]
|
||||
call genExpression ops e
|
||||
tell [" );\n"]
|
||||
|
||||
doIn c im
|
||||
= do case im of
|
||||
|
|
@ -1777,7 +1768,10 @@ cgenAlt ops isPri s
|
|||
A.Alternative _ c im _ -> doIn c im
|
||||
A.AlternativeCond _ e c im _ -> withIf ops e $ doIn c im
|
||||
A.AlternativeSkip _ e _ -> withIf ops e $ tell ["AltDisableSkip (", id, "++);\n"]
|
||||
|
||||
A.AlternativeWait _ A.WaitUntil e _ ->
|
||||
do tell ["AltDisableTimer (", id, "++, "]
|
||||
call genExpression ops e
|
||||
tell [");\n"]
|
||||
doIn c im
|
||||
= do case im of
|
||||
A.InputTimerRead _ _ -> call genMissing ops "timer read in ALT"
|
||||
|
|
@ -1798,6 +1792,7 @@ cgenAlt ops isPri s
|
|||
A.Alternative _ c im p -> doIn c im p
|
||||
A.AlternativeCond _ e c im p -> withIf ops e $ doIn c im p
|
||||
A.AlternativeSkip _ e p -> withIf ops e $ doCheck (call genProcess ops p)
|
||||
A.AlternativeWait _ _ _ p -> doCheck (call genProcess ops p)
|
||||
|
||||
doIn c im p
|
||||
= do case im of
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user