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:
Adam Sampson 2008-03-14 22:01:59 +00:00
parent 9c2a6b6656
commit 4a68dda2b5
2 changed files with 56 additions and 57 deletions

View File

@ -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 ()
tell [" "] genParHeader
n = do -- These can't be inlined, since they're only used as function
tell [" = ProcGetParam (wptr, " ++ show num ++ ", "] -- pointers.
t tell ["void "]
tell [");\n"] genName n
tell [" (Workspace wptr)"]
genParParams :: CGen ()
genParParams
= sequence_ [do t
tell [" "]
n
tell [" = ProcGetParam (wptr, " ++ show num ++ ", "]
t
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

View File

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