Finished off the support for external C functions
This commit is contained in:
parent
95d7144c7b
commit
eb99480484
|
@ -182,6 +182,10 @@ cgenTopLevel s
|
||||||
genName tlpName
|
genName tlpName
|
||||||
tell ["_stack_size;\n"]
|
tell ["_stack_size;\n"]
|
||||||
|
|
||||||
|
-- Forward declarations of externals:
|
||||||
|
sequence_ [tell ["extern void ", mungeExternalName n, "(int*);"]
|
||||||
|
| (n, fs) <- csExternals cs]
|
||||||
|
|
||||||
call genStructured s (\m _ -> tell ["\n#error Invalid top-level item: ", show m])
|
call genStructured s (\m _ -> tell ["\n#error Invalid top-level item: ", show m])
|
||||||
|
|
||||||
tell ["void tock_main (Workspace wptr) {\n"]
|
tell ["void tock_main (Workspace wptr) {\n"]
|
||||||
|
@ -227,6 +231,8 @@ cgenTopLevel s
|
||||||
\ return 0;\n\
|
\ return 0;\n\
|
||||||
\}\n"]
|
\}\n"]
|
||||||
where
|
where
|
||||||
|
mungeExternalName (_:cs) = [if c == '.' then '_' else c | c <- cs]
|
||||||
|
|
||||||
-- | Allocate a TLP channel handler process, and return the function that
|
-- | Allocate a TLP channel handler process, and return the function that
|
||||||
-- implements it.
|
-- implements it.
|
||||||
genTLPHandler :: (Maybe A.Direction, TLPChannel) -> String -> String -> String -> CGen String
|
genTLPHandler :: (Maybe A.Direction, TLPChannel) -> String -> String -> String -> CGen String
|
||||||
|
@ -2026,13 +2032,22 @@ withIf cond body
|
||||||
cgenProcCall :: A.Name -> [A.Actual] -> CGen ()
|
cgenProcCall :: A.Name -> [A.Actual] -> CGen ()
|
||||||
cgenProcCall n as
|
cgenProcCall n as
|
||||||
= do A.Proc _ (_, rm) _ _ <- specTypeOfName n
|
= do A.Proc _ (_, rm) _ _ <- specTypeOfName n
|
||||||
case rm of
|
externalProcs <- getCompState >>* csExternals
|
||||||
|
let ext = lookup (A.nameName n) externalProcs
|
||||||
|
case (rm, ext) of
|
||||||
-- This is rather inefficient, because if a recursive PROC is called
|
-- This is rather inefficient, because if a recursive PROC is called
|
||||||
-- anywhere (from other processes as well as from itself), it will
|
-- anywhere (from other processes as well as from itself), it will
|
||||||
-- be done in a PAR.
|
-- be done in a PAR.
|
||||||
A.Recursive ->
|
(A.Recursive, _) ->
|
||||||
let m = A.nameMeta n
|
let m = A.nameMeta n
|
||||||
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 fs) ->
|
||||||
|
do tell ["{int args_plus_blank[] = {0"]
|
||||||
|
call genActuals fs as
|
||||||
|
tell ["};"]
|
||||||
|
let (_:cs) = A.nameName n
|
||||||
|
tell [[if c == '.' then '_' else c | c <- cs]]
|
||||||
|
tell ["(args_plus_blank + 1);}"]
|
||||||
_ -> do genName n
|
_ -> do genName n
|
||||||
tell [" (wptr"]
|
tell [" (wptr"]
|
||||||
(A.Proc _ _ fs _) <- specTypeOfName n
|
(A.Proc _ _ fs _) <- specTypeOfName n
|
||||||
|
|
|
@ -121,6 +121,7 @@ data CompState = CompState {
|
||||||
csUnscopedNames :: Map String String,
|
csUnscopedNames :: Map String String,
|
||||||
csNameCounter :: Int,
|
csNameCounter :: Int,
|
||||||
csNameAttr :: Map String (Set.Set NameAttr),
|
csNameAttr :: Map String (Set.Set NameAttr),
|
||||||
|
csExternals :: [(String, [A.Formal])],
|
||||||
|
|
||||||
-- Set by passes
|
-- Set by passes
|
||||||
csTypeContext :: [Maybe A.Type],
|
csTypeContext :: [Maybe A.Type],
|
||||||
|
@ -165,6 +166,7 @@ emptyState = CompState {
|
||||||
csUnscopedNames = Map.empty,
|
csUnscopedNames = Map.empty,
|
||||||
csNameCounter = 0,
|
csNameCounter = 0,
|
||||||
csNameAttr = Map.empty,
|
csNameAttr = Map.empty,
|
||||||
|
csExternals = [],
|
||||||
|
|
||||||
csTypeContext = [],
|
csTypeContext = [],
|
||||||
csNonceCounter = 0,
|
csNonceCounter = 0,
|
||||||
|
|
|
@ -1383,6 +1383,7 @@ pragma = do Pragma p <- genToken isPragma
|
||||||
modify $ \st -> st
|
modify $ \st -> st
|
||||||
{ csNames = Map.insert on nd (csNames st)
|
{ csNames = Map.insert on nd (csNames st)
|
||||||
, csLocalNames = (on, (n, ProcName)) : csLocalNames st
|
, csLocalNames = (on, (n, ProcName)) : csLocalNames st
|
||||||
|
, csExternals = (on, fs) : csExternals st
|
||||||
}
|
}
|
||||||
_ -> warnP m WarnUnknownPreprocessorDirective $
|
_ -> warnP m WarnUnknownPreprocessorDirective $
|
||||||
"Unknown PRAGMA: " ++ p
|
"Unknown PRAGMA: " ++ p
|
||||||
|
|
Loading…
Reference in New Issue
Block a user