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

Fixed a couple of small things in the C backend that were causing GCC to spew out lots of warnings

Browse Source
This commit is contained in:
Neil Brown 2009-04-15 12:06:29 +00:00
parent 587554a5a0
commit 5fe8d4ba6a
4 changed files with 36 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
backends/GenerateC.hs
View File

@ -790,10 +790,12 @@ cgenVariableWithAM checkValid v am fct
-> sizes m innerV -> sizes m innerV
-- For mobile arrays, we just need to use the dimensions member: -- For mobile arrays, we just need to use the dimensions member:
(A.Mobile (A.Array {}), _) (A.Mobile (A.Array {}), _)
-> return (do tell ["("] -> return (do tell ["(("]
genType A.Int
tell ["*)("]
cgenVariableWithAM checkValid v A.Original cgenVariableWithAM checkValid v A.Original
(const $ Plain "mt_array_t") (const $ Plain "mt_array_t")
tell [").dimensions"] tell [").dimensions)"]
, Pointer $ Plain intT) , Pointer $ Plain intT)
(A.Array {}, A.Variable _ n) (A.Array {}, A.Variable _ n)
-> do ss <- getCompState >>* csArraySizes -> do ss <- getCompState >>* csArraySizes
@ -991,7 +993,7 @@ cgenFunctionCall m n es
= do A.Function _ _ _ fs _ <- specTypeOfName n = do A.Function _ _ _ fs _ <- specTypeOfName n
genName n genName n
tell ["(wptr,"] tell ["(wptr,"]
call genActuals fs (map A.ActualExpression es) call genActuals genComma fs (map A.ActualExpression es)
tell [","] tell [","]
genMeta m genMeta m
tell [")"] tell [")"]
@ -1537,19 +1539,20 @@ cgenSpecMode A.InlineSpec = tell ["inline "]
prefixComma :: [CGen ()] -> CGen () prefixComma :: [CGen ()] -> CGen ()
prefixComma cs = sequence_ [genComma >> c | c <- cs] prefixComma cs = sequence_ [genComma >> c | c <- cs]
cgenActuals :: [A.Formal] -> [A.Actual] -> CGen () cgenActuals :: CGen () -> [A.Formal] -> [A.Actual] -> CGen ()
cgenActuals fs as cgenActuals inbetween fs as
= do when (length fs /= length as) $ = do when (length fs /= length as) $
dieP m $ "Mismatch in numbers of parameters in backend: " dieP m $ "Mismatch in numbers of parameters in backend: "
++ show (length fs) ++ " expected, but actually: " ++ show (length as) ++ show (length fs) ++ " expected, but actually: " ++ show (length as)
seqComma [call genActual f a | (f, a) <- zip fs as] sequence_ $ intersperse inbetween [call genActual inbetween f a | (f, a) <- zip fs as]
where where
m | null fs && null as = emptyMeta m | null fs && null as = emptyMeta
| null fs = findMeta $ head as | null fs = findMeta $ head as
| otherwise = findMeta $ head fs | otherwise = findMeta $ head fs
cgenActual :: A.Formal -> A.Actual -> CGen () cgenActual :: CGen () -> A.Formal -> A.Actual -> CGen ()
cgenActual f a = seqComma $ realActuals f a id cgenActual inbetween f a
= sequence_ $ intersperse inbetween $ realActuals f a id
-- | Return generators for all the real actuals corresponding to a single -- | Return generators for all the real actuals corresponding to a single
-- actual. -- actual.
@ -1768,7 +1771,7 @@ cgenAssign m (v:vs) (A.IntrinsicFunctionCallList _ n es)
Nothing -> ("occam_" ++ [if c == '.' then '_' else c | c <- n], True) Nothing -> ("occam_" ++ [if c == '.' then '_' else c | c <- n], True)
tell ["=",funcName,"("] tell ["=",funcName,"("]
seqComma $ map (call genExpression) es seqComma $ map (call genExpression) es
mapM (\v -> tell [","] >> call genActual (A.Formal A.Abbrev A.Int (A.Name mapM (\v -> tell [","] >> call genActual genComma (A.Formal A.Abbrev A.Int (A.Name
emptyMeta "dummy_intrinsic_param")) (A.ActualVariable v)) vs emptyMeta "dummy_intrinsic_param")) (A.ActualVariable v)) vs
when giveMeta $ genComma >> genMeta m when giveMeta $ genComma >> genMeta m
tell [");"] tell [");"]
@ -2088,13 +2091,14 @@ cgenProcCall n as
in call genPar A.PlainPar $ A.Only m $ A.ProcCall m n as in call genPar A.PlainPar $ A.Only m $ A.ProcCall m n as
(_, Just ExternalOldStyle) -> (_, Just ExternalOldStyle) ->
do let (c:cs) = A.nameName n do let (c:cs) = A.nameName n
tell ["{int ext_args[] = {"] if null as
then tell ["{int ext_args[] = {};"]
else do tell ["{int ext_args[] = {(int)("]
-- We don't use the formals in csExternals because they won't -- We don't use the formals in csExternals because they won't
-- have had array sizes added: -- have had array sizes added:
(A.Proc _ _ fs _) <- specTypeOfName n (A.Proc _ _ fs _) <- specTypeOfName n
call genActuals fs as call genActuals (tell ["),(int)("]) fs as
tell ["};"] tell [")};"]
case c of case c of
'B' -> tell ["ExternalCallN("] 'B' -> tell ["ExternalCallN("]
'C' -> tell ["BlockingCallN(wptr,"] 'C' -> tell ["BlockingCallN(wptr,"]
@ -2105,7 +2109,7 @@ cgenProcCall n as
_ -> do genName n _ -> do genName n
tell [" (wptr", if null as then "" else ","] tell [" (wptr", if null as then "" else ","]
(A.Proc _ _ fs _) <- specTypeOfName n (A.Proc _ _ fs _) <- specTypeOfName n
call genActuals fs as call genActuals genComma fs as
tell [");\n"] tell [");\n"]
--}}} --}}}
--{{{ intrinsic procs --{{{ intrinsic procs
@ -2121,7 +2125,7 @@ cgenIntrinsicProc m s as = case lookup s intrinsicProcs of
A.Mobile (A.Array _ t) <- astTypeOf mob A.Mobile (A.Array _ t) <- astTypeOf mob
call genBytesIn m t (Left False) call genBytesIn m t (Left False)
tell [","] tell [","]
seqComma [call genActual (A.Formal am t (A.Name emptyMeta n)) a seqComma [call genActual genComma (A.Formal am t (A.Name emptyMeta n)) a
| ((am, t, n), a) <- zip amtns as] | ((am, t, n), a) <- zip amtns as]
tell [");"] tell [");"]
Nothing -> call genMissing $ "intrinsic PROC " ++ s Nothing -> call genMissing $ "intrinsic PROC " ++ s

4
backends/GenerateCBased.hs
View File

@ -108,9 +108,9 @@ data GenOps = GenOps {
-- | Generates code when a variable comes into scope (e.g. allocating memory, initialising variables). -- | Generates code when a variable comes into scope (e.g. allocating memory, initialising variables).
declareInit :: Meta -> A.Type -> A.Variable -> Maybe (CGen ()), declareInit :: Meta -> A.Type -> A.Variable -> Maybe (CGen ()),
-- | Generates an individual parameter to a function\/proc. -- | Generates an individual parameter to a function\/proc.
genActual :: A.Formal -> A.Actual -> CGen (), genActual :: CGen () -> A.Formal -> A.Actual -> CGen (),
-- | Generates the list of actual parameters to a function\/proc. -- | Generates the list of actual parameters to a function\/proc.
genActuals :: [A.Formal] -> [A.Actual] -> CGen (), genActuals :: CGen () -> [A.Formal] -> [A.Actual] -> CGen (),
genAllocMobile :: Meta -> A.Type -> Maybe A.Expression -> CGen(), genAllocMobile :: Meta -> A.Type -> Maybe A.Expression -> CGen(),
genAlt :: Bool -> A.Structured A.Alternative -> CGen (), genAlt :: Bool -> A.Structured A.Alternative -> CGen (),
-- | Generates the given array element expressions as a flattened (one-dimensional) list of literals -- | Generates the given array element expressions as a flattened (one-dimensional) list of literals

11
backends/GenerateCPPCSP.hs
View File

@ -61,7 +61,6 @@ cppgenOps :: GenOps
cppgenOps = cgenOps { cppgenOps = cgenOps {
declareFree = cppdeclareFree, declareFree = cppdeclareFree,
declareInit = cppdeclareInit, declareInit = cppdeclareInit,
genActuals = cppgenActuals,
genAlt = cppgenAlt, genAlt = cppgenAlt,
getCType = cppgetCType, getCType = cppgetCType,
genDirectedVariable = cppgenDirectedVariable, genDirectedVariable = cppgenDirectedVariable,
@ -421,7 +420,7 @@ cppgenPar _ s
genName n genName n
tell ["("] tell ["("]
(A.Proc _ _ fs _) <- specTypeOfName n (A.Proc _ _ fs _) <- specTypeOfName n
call genActuals fs as call genActuals genComma fs as
tell [" ) ); "] tell [" ) ); "]
_ -> error ("trying to run something other than a process in parallel") _ -> error ("trying to run something other than a process in parallel")
@ -489,17 +488,13 @@ cppgenAlt _ s
tell ["}\n"] tell ["}\n"]
-- | In GenerateC this uses prefixComma (because "Process * me" is always the first argument), but here we use infixComma.
cppgenActuals :: [A.Formal] -> [A.Actual] -> CGen ()
cppgenActuals fs as = seqComma [call genActual f a | (f, a) <- zip fs as]
-- | The only change from GenerateC is that passing "me" is not necessary in C++CSP -- | The only change from GenerateC is that passing "me" is not necessary in C++CSP
cppgenProcCall :: A.Name -> [A.Actual] -> CGen () cppgenProcCall :: A.Name -> [A.Actual] -> CGen ()
cppgenProcCall n as cppgenProcCall n as
= do genName n = do genName n
tell ["("] tell ["("]
(A.Proc _ _ fs _) <- specTypeOfName n (A.Proc _ _ fs _) <- specTypeOfName n
call genActuals fs as call genActuals genComma fs as
tell [");"] tell [");"]
-- | Changed because we initialise channels and arrays differently in C++ -- | Changed because we initialise channels and arrays differently in C++
@ -901,7 +896,7 @@ cppgenFunctionCall m n es
= do A.Function _ _ _ fs _ <- specTypeOfName n = do A.Function _ _ _ fs _ <- specTypeOfName n
genName n genName n
tell ["("] tell ["("]
call genActuals fs (map A.ActualExpression es) call genActuals genComma fs (map A.ActualExpression es)
tell [","] tell [","]
genMeta m genMeta m
tell [")"] tell [")"]

18
backends/GenerateCTest.hs
View File

@ -324,23 +324,23 @@ testActuals :: Test
testActuals = TestList testActuals = TestList
[ [
-- C adds a prefix comma (to follow Process* me) but C++ does not: -- C adds a prefix comma (to follow Process* me) but C++ does not:
testBoth "genActuals 0" "@,@" "@,@" $ overActual (tcall genActuals [undefined, undefined] [undefined, undefined]) testBoth "genActuals 0" "@,@" "@,@" $ overActual (tcall genActuals undefined [undefined, undefined] [undefined, undefined])
,testBothSame "genActuals 1" "" $ (tcall genActuals [] []) ,testBothSame "genActuals 1" "" $ (tcall genActuals genComma [] [])
--For expressions, genExpression should be called: --For expressions, genExpression should be called:
,testBothSame "genActual 0" "$" $ over (tcall genActual valFormal $ A.ActualExpression (A.True undefined)) ,testBothSame "genActual 0" "$" $ over (tcall genActual genComma valFormal $ A.ActualExpression (A.True undefined))
,testBothSame "genActual 1" "$" $ over (tcall genActual valFormal $ A.ActualExpression (A.Literal undefined undefined undefined)) ,testBothSame "genActual 1" "$" $ over (tcall genActual genComma valFormal $ A.ActualExpression (A.Literal undefined undefined undefined))
--The abbreviation mode used when generating an actual should come from the --The abbreviation mode used when generating an actual should come from the
--corresponding formal, not from the variable: --corresponding formal, not from the variable:
,testBothSameS "genActual 10" "@" (over (tcall genActual valFormal $ A.ActualVariable (A.Variable undefined foo))) ,testBothSameS "genActual 10" "@" (over (tcall genActual genComma valFormal $ A.ActualVariable (A.Variable undefined foo)))
(defineVariable "foo" A.Int) (defineVariable "foo" A.Int)
,testBothSameS "genActual 11" "&@" (over (tcall genActual refFormal $ A.ActualVariable (A.Variable undefined foo))) ,testBothSameS "genActual 11" "&@" (over (tcall genActual genComma refFormal $ A.ActualVariable (A.Variable undefined foo)))
(defineVariable "foo" A.Int) (defineVariable "foo" A.Int)
,testBothSameS "genActual 12" "@" (over (tcall genActual valFormal $ A.ActualVariable (A.Variable undefined foo))) ,testBothSameS "genActual 12" "@" (over (tcall genActual genComma valFormal $ A.ActualVariable (A.Variable undefined foo)))
(do defineVariable "bar" A.Int (do defineVariable "bar" A.Int
defineIs "foo" A.Int (variable "bar")) defineIs "foo" A.Int (variable "bar"))
,testBothSameS "genActual 13" "&@" (over (tcall genActual refFormal $ A.ActualVariable (A.Variable undefined foo))) ,testBothSameS "genActual 13" "&@" (over (tcall genActual genComma refFormal $ A.ActualVariable (A.Variable undefined foo)))
(do defineVariable "bar" A.Int (do defineVariable "bar" A.Int
defineIs "foo" A.Int (variable "bar")) defineIs "foo" A.Int (variable "bar"))
] ]
@ -350,7 +350,7 @@ testActuals = TestList
refFormal :: A.Formal refFormal :: A.Formal
refFormal = A.Formal A.Abbrev undefined undefined refFormal = A.Formal A.Abbrev undefined undefined
overActual :: Override overActual :: Override
overActual = local (\ops -> ops {genActual = override2 at}) overActual = local (\ops -> ops {genActual = override3 at})
over :: Override over :: Override
over = local (\ops -> ops {genVariable' = override3 at, genExpression = override1 dollar}) over = local (\ops -> ops {genVariable' = override3 at, genExpression = override1 dollar})