Clean up the generation of wrapper Procs for Pars.
Procs that are in csParProcs are now generated with the correct calling convention directly, rather than having a second wrapper function generated around them.
This commit is contained in:
parent
9c2a6b6656
commit
4a68dda2b5
|
@ -82,8 +82,6 @@ cgenOps = GenOps {
|
||||||
genDyadic = cgenDyadic,
|
genDyadic = cgenDyadic,
|
||||||
genExpression = cgenExpression,
|
genExpression = cgenExpression,
|
||||||
genFlatArraySize = cgenFlatArraySize,
|
genFlatArraySize = cgenFlatArraySize,
|
||||||
genFormal = cgenFormal,
|
|
||||||
genFormals = cgenFormals,
|
|
||||||
genForwardDeclaration = cgenForwardDeclaration,
|
genForwardDeclaration = cgenForwardDeclaration,
|
||||||
genFuncDyadic = cgenFuncDyadic,
|
genFuncDyadic = cgenFuncDyadic,
|
||||||
genFuncMonadic = cgenFuncMonadic,
|
genFuncMonadic = cgenFuncMonadic,
|
||||||
|
@ -151,8 +149,7 @@ cgenTopLevel s
|
||||||
sequence_ $ map (call genForwardDeclaration)
|
sequence_ $ map (call genForwardDeclaration)
|
||||||
(listify (const True :: A.Specification -> Bool) s)
|
(listify (const True :: A.Specification -> Bool) s)
|
||||||
|
|
||||||
sequence_ [do tell ["extern int ", nameString n, "_wrapper_stack_size;\n"]
|
sequence_ [tell ["extern int ", nameString n, "_stack_size;\n"]
|
||||||
cgenProcWrapper n
|
|
||||||
| n <- Set.toList $ csParProcs cs]
|
| n <- Set.toList $ csParProcs cs]
|
||||||
tell ["extern int "]
|
tell ["extern int "]
|
||||||
genName tlpName
|
genName tlpName
|
||||||
|
@ -1252,15 +1249,8 @@ cintroduceSpec (A.Specification _ n (A.ProtocolCase _ ts))
|
||||||
tell ["}"]
|
tell ["}"]
|
||||||
genName n
|
genName n
|
||||||
tell [";"]
|
tell [";"]
|
||||||
cintroduceSpec (A.Specification _ n (A.Proc _ sm fs p))
|
cintroduceSpec (A.Specification _ n st@(A.Proc _ _ _ _))
|
||||||
= do call genSpecMode sm
|
= genProcSpec n st False
|
||||||
tell ["void "]
|
|
||||||
genName n
|
|
||||||
tell [" (Workspace wptr"]
|
|
||||||
call genFormals fs
|
|
||||||
tell [") {\n"]
|
|
||||||
call genProcess p
|
|
||||||
tell ["}\n"]
|
|
||||||
cintroduceSpec (A.Specification _ n (A.Retypes m am t v))
|
cintroduceSpec (A.Specification _ n (A.Retypes m am t v))
|
||||||
= do origT <- typeOfVariable v
|
= do origT <- typeOfVariable v
|
||||||
let rhs = call genVariableAM v A.Abbrev
|
let rhs = call genVariableAM v A.Abbrev
|
||||||
|
@ -1295,13 +1285,8 @@ cgenRecordTypeSpec n b fs
|
||||||
tell [";"]
|
tell [";"]
|
||||||
|
|
||||||
cgenForwardDeclaration :: A.Specification -> CGen ()
|
cgenForwardDeclaration :: A.Specification -> CGen ()
|
||||||
cgenForwardDeclaration (A.Specification _ n (A.Proc _ sm fs _))
|
cgenForwardDeclaration (A.Specification _ n st@(A.Proc _ _ _ _))
|
||||||
= do call genSpecMode sm
|
= genProcSpec n st True
|
||||||
tell ["void "]
|
|
||||||
genName n
|
|
||||||
tell [" (Workspace wptr"]
|
|
||||||
call genFormals fs
|
|
||||||
tell [");"]
|
|
||||||
cgenForwardDeclaration (A.Specification _ n (A.RecordType _ b fs))
|
cgenForwardDeclaration (A.Specification _ n (A.RecordType _ b fs))
|
||||||
= call genRecordTypeSpec n b fs
|
= call genRecordTypeSpec n b fs
|
||||||
cgenForwardDeclaration _ = return ()
|
cgenForwardDeclaration _ = return ()
|
||||||
|
@ -1321,7 +1306,7 @@ cgenSpecMode A.PlainSpec = return ()
|
||||||
cgenSpecMode A.InlineSpec = tell ["inline "]
|
cgenSpecMode A.InlineSpec = tell ["inline "]
|
||||||
--}}}
|
--}}}
|
||||||
|
|
||||||
--{{{ actuals/formals
|
--{{{ formals, actuals, and calling conventions
|
||||||
prefixComma :: [CGen ()] -> CGen ()
|
prefixComma :: [CGen ()] -> CGen ()
|
||||||
prefixComma cs = sequence_ [genComma >> c | c <- cs]
|
prefixComma cs = sequence_ [genComma >> c | c <- cs]
|
||||||
|
|
||||||
|
@ -1331,12 +1316,6 @@ cgenActuals as = prefixComma (map (call genActual) as)
|
||||||
cgenActual :: A.Actual -> CGen ()
|
cgenActual :: A.Actual -> CGen ()
|
||||||
cgenActual actual = seqComma $ realActuals actual
|
cgenActual actual = seqComma $ realActuals actual
|
||||||
|
|
||||||
cgenFormals :: [A.Formal] -> CGen ()
|
|
||||||
cgenFormals fs = prefixComma (map (call genFormal) fs)
|
|
||||||
|
|
||||||
cgenFormal :: A.Formal -> CGen ()
|
|
||||||
cgenFormal f = seqComma [t >> tell [" "] >> n | (t, n) <- realFormals f]
|
|
||||||
|
|
||||||
-- | Return generators for all the real actuals corresponding to a single
|
-- | Return generators for all the real actuals corresponding to a single
|
||||||
-- actual.
|
-- actual.
|
||||||
realActuals :: A.Actual -> [CGen ()]
|
realActuals :: A.Actual -> [CGen ()]
|
||||||
|
@ -1351,33 +1330,55 @@ realFormals :: A.Formal -> [(CGen (), CGen ())]
|
||||||
realFormals (A.Formal am t n)
|
realFormals (A.Formal am t n)
|
||||||
= [(call genDeclType am t, genName n)]
|
= [(call genDeclType am t, genName n)]
|
||||||
|
|
||||||
-- | Generate a wrapper function for a PAR subprocess.
|
-- | Generate a Proc specification, which maps to a C function.
|
||||||
cgenProcWrapper :: A.Name -> CGen ()
|
-- This will use ProcGetParam if the Proc is in csParProcs, or the normal C
|
||||||
cgenProcWrapper n
|
-- calling convention otherwise.
|
||||||
= do st <- specTypeOfName n
|
genProcSpec :: A.Name -> A.SpecType -> Bool -> CGen ()
|
||||||
let fs = case st of A.Proc _ _ fs _ -> fs
|
genProcSpec n (A.Proc _ sm fs p) forwardDecl
|
||||||
let rfs = concatMap realFormals fs
|
= do cs <- getCompState
|
||||||
|
let (header, params) = if n `Set.member` csParProcs cs
|
||||||
tell ["static void "]
|
then (genParHeader, genParParams)
|
||||||
genName n
|
else (genNormalHeader, return ())
|
||||||
tell ["_wrapper (Workspace wptr) {\n"]
|
header
|
||||||
|
if forwardDecl
|
||||||
sequence_ [unpackParam num rf | (num, rf) <- zip [0..] rfs]
|
then tell [";\n"]
|
||||||
genName n
|
else do tell ["{\n"]
|
||||||
tell [" (wptr"]
|
params
|
||||||
prefixComma [n | (_, n) <- rfs]
|
call genProcess p
|
||||||
tell [");\n"]
|
|
||||||
|
|
||||||
tell ["}\n"]
|
tell ["}\n"]
|
||||||
where
|
where
|
||||||
unpackParam :: Int -> (CGen (), CGen ()) -> CGen ()
|
rfs = concatMap realFormals fs
|
||||||
unpackParam num (t, n)
|
|
||||||
= do t
|
genParHeader :: CGen ()
|
||||||
|
genParHeader
|
||||||
|
= do -- These can't be inlined, since they're only used as function
|
||||||
|
-- pointers.
|
||||||
|
tell ["void "]
|
||||||
|
genName n
|
||||||
|
tell [" (Workspace wptr)"]
|
||||||
|
|
||||||
|
genParParams :: CGen ()
|
||||||
|
genParParams
|
||||||
|
= sequence_ [do t
|
||||||
tell [" "]
|
tell [" "]
|
||||||
n
|
n
|
||||||
tell [" = ProcGetParam (wptr, " ++ show num ++ ", "]
|
tell [" = ProcGetParam (wptr, " ++ show num ++ ", "]
|
||||||
t
|
t
|
||||||
tell [");\n"]
|
tell [");\n"]
|
||||||
|
| (num, (t, n)) <- zip [(0 :: Int) ..] rfs]
|
||||||
|
|
||||||
|
genNormalHeader :: CGen ()
|
||||||
|
genNormalHeader
|
||||||
|
= do call genSpecMode sm
|
||||||
|
tell ["void "]
|
||||||
|
genName n
|
||||||
|
tell [" (Workspace wptr"]
|
||||||
|
sequence_ [do tell [", "]
|
||||||
|
t
|
||||||
|
tell [" "]
|
||||||
|
n
|
||||||
|
| (t, n) <- rfs]
|
||||||
|
tell [")"]
|
||||||
|
|
||||||
-- | Generate a ProcAlloc for a PAR subprocess, returning a nonce for the
|
-- | Generate a ProcAlloc for a PAR subprocess, returning a nonce for the
|
||||||
-- workspace pointer and the name of the function to call.
|
-- workspace pointer and the name of the function to call.
|
||||||
|
@ -1388,14 +1389,14 @@ cgenProcAlloc n as
|
||||||
ws <- csmLift $ makeNonce "workspace"
|
ws <- csmLift $ makeNonce "workspace"
|
||||||
tell ["Workspace ", ws, " = ProcAlloc (wptr, ", show $ length ras, ", "]
|
tell ["Workspace ", ws, " = ProcAlloc (wptr, ", show $ length ras, ", "]
|
||||||
genName n
|
genName n
|
||||||
tell ["_wrapper_stack_size);\n"]
|
tell ["_stack_size);\n"]
|
||||||
|
|
||||||
sequence_ [do tell ["ProcParam (wptr, ", ws, ", ", show num, ", "]
|
sequence_ [do tell ["ProcParam (wptr, ", ws, ", ", show num, ", "]
|
||||||
ra
|
ra
|
||||||
tell [");\n"]
|
tell [");\n"]
|
||||||
| (num, ra) <- zip [(0 :: Int)..] ras]
|
| (num, ra) <- zip [(0 :: Int)..] ras]
|
||||||
|
|
||||||
return (ws, genName n >> tell ["_wrapper"])
|
return (ws, genName n)
|
||||||
--}}}
|
--}}}
|
||||||
|
|
||||||
--{{{ processes
|
--{{{ processes
|
||||||
|
|
|
@ -121,8 +121,6 @@ data GenOps = GenOps {
|
||||||
genDyadic :: Meta -> A.DyadicOp -> A.Expression -> A.Expression -> CGen (),
|
genDyadic :: Meta -> A.DyadicOp -> A.Expression -> A.Expression -> CGen (),
|
||||||
genExpression :: A.Expression -> CGen (),
|
genExpression :: A.Expression -> CGen (),
|
||||||
genFlatArraySize :: [A.Dimension] -> CGen (),
|
genFlatArraySize :: [A.Dimension] -> CGen (),
|
||||||
genFormal :: A.Formal -> CGen (),
|
|
||||||
genFormals :: [A.Formal] -> CGen (),
|
|
||||||
genForwardDeclaration :: A.Specification -> CGen(),
|
genForwardDeclaration :: A.Specification -> CGen(),
|
||||||
genFuncDyadic :: Meta -> String -> A.Expression -> A.Expression -> CGen (),
|
genFuncDyadic :: Meta -> String -> A.Expression -> A.Expression -> CGen (),
|
||||||
genFuncMonadic :: Meta -> String -> A.Expression -> CGen (),
|
genFuncMonadic :: Meta -> String -> A.Expression -> CGen (),
|
||||||
|
|
Loading…
Reference in New Issue
Block a user