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

Fixed external calls so that passing mobile arrays to and from external calls now works

Browse Source
This commit is contained in:
Neil Brown 2009-04-16 18:29:14 +00:00
parent 437c6bd3ef
commit f909c6fd03
1 changed files with 24 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

36
backends/GenerateC.hs
View File

@ -2097,22 +2097,27 @@ 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
if null as afters <- if null as
then tell ["{int ext_args[] = {};"] then tell ["{int ext_args[] = {};"] >> return (return ())
else do tell ["{int ext_args[] = {(int)("] else do tell ["{int ext_args[] = {(int)("]
(A.Proc _ _ fs _) <- specTypeOfName n (A.Proc _ _ fs _) <- specTypeOfName n
when (length fs /= length as) $ when (length fs /= length as) $
dieP (A.nameMeta n) "Mismatched number of arguments to external call" dieP (A.nameMeta n) "Mismatched number of arguments to external call"
let inbetween = tell ["),(int)("] let inbetween = tell ["),(int)("] >> return (return ())
sequence_ $ intersperse inbetween $ map afters <- flip evalStateT 0 $ sequence
(uncurry $ genExternalActual inbetween) $ zip fs as $ intersperse (lift inbetween)
$ map (uncurry $ genExternalActual (inbetween >> return ()))
$ zip fs as
tell [")};"] tell [")};"]
return $ sequence_ afters
case c of case c of
'B' -> tell ["ExternalCallN("] 'B' -> tell ["ExternalCallN("]
'C' -> tell ["BlockingCallN(wptr,"] 'C' -> tell ["BlockingCallN(wptr,"]
_ -> dieP (A.nameMeta n) "Unknown external PROC format" _ -> dieP (A.nameMeta n) "Unknown external PROC format"
tell [ [if c == '.' then '_' else c | c <- cs] tell [ [if c == '.' then '_' else c | c <- cs]
, ",1,ext_args);}"] , ",1,ext_args);"]
afters
tell ["}"]
_ -> do genName n _ -> do genName n
tell [" (wptr", if null as then "" else ","] tell [" (wptr", if null as then "" else ","]
@ -2120,20 +2125,27 @@ cgenProcCall n as
call genActuals genComma fs as call genActuals genComma fs as
tell [");\n"] tell [");\n"]
where where
-- The sizes will be -- This returns any actions that need to take place after the external call
genExternalActual :: CGen () -> A.Formal -> A.Actual -> CGen () genExternalActual :: CGen () -> A.Formal -> A.Actual -> StateT Int CGen (CGen ())
genExternalActual inbetween f@(A.Formal am t n) a genExternalActual inbetween f@(A.Formal am t n) a
= case (t, a) of = case (t, a) of
(A.Mobile arrT@(A.Array {}), A.ActualVariable v) -> (A.Mobile arrT@(A.Array {}), A.ActualVariable v) ->
-- The extra dimensions parameters have already been added, but KRoC -- The extra dimensions parameters have already been added, but KRoC
-- passes both the array data and the address of the mobile, so we -- passes both the array data and the address of the mobile, so we
-- had better do the same: -- had better do the same:
do call genActual inbetween (A.Formal A.Abbrev arrT n) do lift $ call genActual inbetween (A.Formal A.Abbrev arrT n)
(A.ActualVariable $ A.DerefVariable (findMeta v) v) (A.ActualVariable $ A.DerefVariable (findMeta v) v)
inbetween modify (+1)
call genActual inbetween f a lift inbetween
-- We need to pass mobiles as the plain pointers (not abbreviated):
lift $ call genActual inbetween (A.Formal A.Original arrT n) a
_ -> call genActual inbetween f a i <- modify' (+1) -- i is the value before the second modification
return $ do call genVariable' v A.Original
(const $ Pointer $ Plain "mt_array_t")
tell ["=ext_args[", show i, "];"]
_ -> lift (call genActual inbetween f a) >> modify (+1) >> return (return ())
--}}} --}}}