Fixed the passing of mobile arrays to old-style external calls
This commit is contained in:
parent
decd2d16df
commit
5a5b91e387
|
@ -458,6 +458,13 @@ declareSizesArray = occamOnlyPass "Declare array-size arrays"
|
||||||
let newfs = map (A.Formal A.ValAbbrev A.Int . A.Name m) params
|
let newfs = map (A.Formal A.ValAbbrev A.Int . A.Name m) params
|
||||||
(rest, moreNew) <- transformFormals ext m fs
|
(rest, moreNew) <- transformFormals ext m fs
|
||||||
return (f : newfs ++ rest, newfs ++ moreNew)
|
return (f : newfs ++ rest, newfs ++ moreNew)
|
||||||
|
-- For externals, we always add extra formals (one per dimension!), even
|
||||||
|
-- for mobile arrays:
|
||||||
|
(A.Mobile (A.Array ds _), Just ExternalOldStyle) ->
|
||||||
|
do params <- replicateM (length ds) $ makeNonce m "ext_size"
|
||||||
|
let newfs = map (A.Formal A.ValAbbrev A.Int . A.Name m) params
|
||||||
|
(rest, moreNew) <- transformFormals ext m fs
|
||||||
|
return (f : newfs ++ rest, newfs ++ moreNew)
|
||||||
|
|
||||||
-- For occam PROCs, only bother adding the extra formal if the dimension
|
-- For occam PROCs, only bother adding the extra formal if the dimension
|
||||||
-- is unknown:
|
-- is unknown:
|
||||||
|
@ -499,6 +506,9 @@ declareSizesArray = occamOnlyPass "Declare array-size arrays"
|
||||||
(A.Array ds _, Just ExternalOldStyle) ->
|
(A.Array ds _, Just ExternalOldStyle) ->
|
||||||
let acts = map (sub $ A.VariableSizes m v) [0 .. (length ds - 1)]
|
let acts = map (sub $ A.VariableSizes m v) [0 .. (length ds - 1)]
|
||||||
in return $ a : acts
|
in return $ a : acts
|
||||||
|
(A.Mobile (A.Array ds _), Just ExternalOldStyle) ->
|
||||||
|
let acts = map (sub $ A.VariableSizes m v) [0 .. (length ds - 1)]
|
||||||
|
in return $ a : acts
|
||||||
-- Note that t is the formal type, not the type of the actual
|
-- Note that t is the formal type, not the type of the actual
|
||||||
(A.Array ds _, _) | A.UnknownDimension `elem` ds ->
|
(A.Array ds _, _) | A.UnknownDimension `elem` ds ->
|
||||||
do sizeV <- sizes v
|
do sizeV <- sizes v
|
||||||
|
|
|
@ -2100,10 +2100,12 @@ cgenProcCall n as
|
||||||
if null as
|
if null as
|
||||||
then tell ["{int ext_args[] = {};"]
|
then tell ["{int ext_args[] = {};"]
|
||||||
else do tell ["{int ext_args[] = {(int)("]
|
else do tell ["{int ext_args[] = {(int)("]
|
||||||
-- We don't use the formals in csExternals because they won't
|
|
||||||
-- have had array sizes added:
|
|
||||||
(A.Proc _ _ fs _) <- specTypeOfName n
|
(A.Proc _ _ fs _) <- specTypeOfName n
|
||||||
call genActuals (tell ["),(int)("]) fs as
|
when (length fs /= length as) $
|
||||||
|
dieP (A.nameMeta n) "Mismatched number of arguments to external call"
|
||||||
|
let inbetween = tell ["),(int)("]
|
||||||
|
sequence_ $ intersperse inbetween $ map
|
||||||
|
(uncurry $ genExternalActual inbetween) $ zip fs as
|
||||||
tell [")};"]
|
tell [")};"]
|
||||||
case c of
|
case c of
|
||||||
'B' -> tell ["ExternalCallN("]
|
'B' -> tell ["ExternalCallN("]
|
||||||
|
@ -2117,6 +2119,23 @@ cgenProcCall n as
|
||||||
(A.Proc _ _ fs _) <- specTypeOfName n
|
(A.Proc _ _ fs _) <- specTypeOfName n
|
||||||
call genActuals genComma fs as
|
call genActuals genComma fs as
|
||||||
tell [");\n"]
|
tell [");\n"]
|
||||||
|
where
|
||||||
|
-- The sizes will be
|
||||||
|
genExternalActual :: CGen () -> A.Formal -> A.Actual -> CGen ()
|
||||||
|
genExternalActual inbetween f@(A.Formal am t n) a
|
||||||
|
= case (t, a) of
|
||||||
|
(A.Mobile arrT@(A.Array {}), A.ActualVariable v) ->
|
||||||
|
-- The extra dimensions parameters have already been added, but KRoC
|
||||||
|
-- passes both the array data and the address of the mobile, so we
|
||||||
|
-- had better do the same:
|
||||||
|
do call genActual inbetween (A.Formal A.Abbrev arrT n)
|
||||||
|
(A.ActualVariable $ A.DerefVariable (findMeta v) v)
|
||||||
|
inbetween
|
||||||
|
call genActual inbetween f a
|
||||||
|
|
||||||
|
_ -> call genActual inbetween f a
|
||||||
|
|
||||||
|
|
||||||
--}}}
|
--}}}
|
||||||
--{{{ intrinsic procs
|
--{{{ intrinsic procs
|
||||||
cgenIntrinsicProc :: Meta -> String -> [A.Actual] -> CGen ()
|
cgenIntrinsicProc :: Meta -> String -> [A.Actual] -> CGen ()
|
||||||
|
|
Loading…
Reference in New Issue
Block a user