summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--compiler/cmm/Cmm.hs7
-rw-r--r--compiler/cmm/CmmBrokenBlock.hs25
-rw-r--r--compiler/cmm/CmmCPS.hs6
-rw-r--r--compiler/cmm/CmmCPSGen.hs14
-rw-r--r--compiler/cmm/CmmLint.hs2
-rw-r--r--compiler/cmm/CmmLive.hs2
-rw-r--r--compiler/cmm/CmmOpt.hs6
-rw-r--r--compiler/cmm/CmmParse.y20
-rw-r--r--compiler/cmm/PprC.hs6
-rw-r--r--compiler/cmm/PprCmm.hs11
-rw-r--r--compiler/codeGen/CgForeignCall.hs13
-rw-r--r--compiler/codeGen/CgHpc.hs1
-rw-r--r--compiler/codeGen/CgPrimOp.hs3
-rw-r--r--compiler/codeGen/CgUtils.hs2
-rw-r--r--compiler/nativeGen/AsmCodeGen.lhs4
-rw-r--r--compiler/nativeGen/MachCodeGen.hs6
16 files changed, 70 insertions, 58 deletions
diff --git a/compiler/cmm/Cmm.hs b/compiler/cmm/Cmm.hs
index 442eb60c7d..cbc60c2d74 100644
--- a/compiler/cmm/Cmm.hs
+++ b/compiler/cmm/Cmm.hs
@@ -12,7 +12,7 @@ module Cmm (
CmmInfo(..), UpdateFrame(..),
CmmInfoTable(..), ClosureTypeInfo(..), ProfilingInfo(..), ClosureTypeTag,
GenBasicBlock(..), CmmBasicBlock, blockId, blockStmts, mapBlockStmts,
- ReturnInfo(..),
+ CmmReturnInfo(..),
CmmStmt(..), CmmActuals, CmmFormal, CmmFormals, CmmHintFormals,
CmmSafety(..),
CmmCallTarget(..),
@@ -141,8 +141,8 @@ data ClosureTypeInfo
[Maybe LocalReg] -- Forced stack parameters
C_SRT
-data ReturnInfo = MayReturn
- | NeverReturns
+data CmmReturnInfo = CmmMayReturn
+ | CmmNeverReturns
-- TODO: These types may need refinement
data ProfilingInfo = ProfilingInfo CmmLit CmmLit -- closure_type, closure_desc
@@ -185,6 +185,7 @@ data CmmStmt
CmmHintFormals -- zero or more results
CmmActuals -- zero or more arguments
CmmSafety -- whether to build a continuation
+ CmmReturnInfo
| CmmBranch BlockId -- branch to another BB in this fn
diff --git a/compiler/cmm/CmmBrokenBlock.hs b/compiler/cmm/CmmBrokenBlock.hs
index cc968f1758..b8ef5f9091 100644
--- a/compiler/cmm/CmmBrokenBlock.hs
+++ b/compiler/cmm/CmmBrokenBlock.hs
@@ -143,6 +143,7 @@ data FinalStmt
-- (redundant with ContinuationEntry)
CmmActuals -- ^ Arguments to call
C_SRT -- ^ SRT for the continuation's info table
+ CmmReturnInfo -- ^ Does the function return?
Bool -- ^ True <=> GC block so ignore stack size
| FinalSwitch -- ^ Same as a 'CmmSwitch'
@@ -258,7 +259,7 @@ breakBlock gc_block_idents uniques (BasicBlock ident stmts) entry =
-- Detect this special case to remain an inverse of
-- 'cmmBlockFromBrokenBlock'
- [CmmCall target results arguments (CmmSafe srt),
+ [CmmCall target results arguments (CmmSafe srt) ret,
CmmBranch next_id] ->
([cont_info], [block])
where
@@ -266,15 +267,15 @@ breakBlock gc_block_idents uniques (BasicBlock ident stmts) entry =
ContFormat results srt
(ident `elem` gc_block_idents))
block = do_call current_id entry accum_stmts exits next_id
- target results arguments srt
+ target results arguments srt ret
-- Break the block on safe calls (the main job of this function)
- (CmmCall target results arguments (CmmSafe srt) : stmts) ->
+ (CmmCall target results arguments (CmmSafe srt) ret : stmts) ->
(cont_info : cont_infos, block : blocks)
where
next_id = BlockId $ head uniques
block = do_call current_id entry accum_stmts exits next_id
- target results arguments srt
+ target results arguments srt ret
cont_info = (next_id, -- Entry convention for the
-- continuation of the call
@@ -287,12 +288,12 @@ breakBlock gc_block_idents uniques (BasicBlock ident stmts) entry =
-- Unsafe calls don't need a continuation
-- but they do need to be expanded
- (CmmCall target results arguments CmmUnsafe : stmts) ->
+ (CmmCall target results arguments CmmUnsafe ret : stmts) ->
breakBlock' remaining_uniques current_id entry exits
(accum_stmts ++
arg_stmts ++
caller_save ++
- [CmmCall target results new_args CmmUnsafe] ++
+ [CmmCall target results new_args CmmUnsafe ret] ++
caller_load)
stmts
where
@@ -309,9 +310,9 @@ breakBlock gc_block_idents uniques (BasicBlock ident stmts) entry =
stmts
do_call current_id entry accum_stmts exits next_id
- target results arguments srt =
+ target results arguments srt ret =
BrokenBlock current_id entry accum_stmts (next_id:exits)
- (FinalCall next_id target results arguments srt
+ (FinalCall next_id target results arguments srt ret
(current_id `elem` gc_block_idents))
cond_branch_target (CmmCondBranch _ target) = [target]
@@ -350,7 +351,7 @@ adaptBlockToFormat :: [(BlockId, ContFormat)]
adaptBlockToFormat formats unique
block@(BrokenBlock ident entry stmts targets
exit@(FinalCall next target formals
- actuals srt is_gc)) =
+ actuals srt ret is_gc)) =
if format_formals == formals &&
format_srt == srt &&
format_is_gc == is_gc
@@ -367,7 +368,7 @@ adaptBlockToFormat formats unique
revised_targets = adaptor_ident : delete next targets
revised_exit = FinalCall
adaptor_ident -- ^ The only part that changed
- target formals actuals srt is_gc
+ target formals actuals srt ret is_gc
adaptor_block = mk_adaptor_block adaptor_ident
(ContinuationEntry (map fst formals) srt is_gc)
@@ -401,8 +402,8 @@ cmmBlockFromBrokenBlock (BrokenBlock ident _ stmts _ exit) =
FinalReturn arguments -> [CmmReturn arguments]
FinalJump target arguments -> [CmmJump target arguments]
FinalSwitch expr targets -> [CmmSwitch expr targets]
- FinalCall branch_target call_target results arguments srt _ ->
- [CmmCall call_target results arguments (CmmSafe srt),
+ FinalCall branch_target call_target results arguments srt ret _ ->
+ [CmmCall call_target results arguments (CmmSafe srt) ret,
CmmBranch branch_target]
-----------------------------------------------------------------------------
diff --git a/compiler/cmm/CmmCPS.hs b/compiler/cmm/CmmCPS.hs
index e68216ac64..534346edb6 100644
--- a/compiler/cmm/CmmCPS.hs
+++ b/compiler/cmm/CmmCPS.hs
@@ -355,8 +355,8 @@ continuationMaxStack formats (Continuation _ label _ False blocks) =
argumentsSize (cmmExprRep . fst) args
final_arg_size (FinalJump _ args) =
argumentsSize (cmmExprRep . fst) args
- final_arg_size (FinalCall next _ _ args _ True) = 0
- final_arg_size (FinalCall next _ _ args _ False) =
+ final_arg_size (FinalCall next _ _ args _ _ True) = 0
+ final_arg_size (FinalCall next _ _ args _ _ False) =
-- We have to account for the stack used when we build a frame
-- for the *next* continuation from *this* continuation
argumentsSize (cmmExprRep . fst) args +
@@ -369,7 +369,7 @@ continuationMaxStack formats (Continuation _ label _ False blocks) =
stmt_arg_size (CmmJump _ args) =
argumentsSize (cmmExprRep . fst) args
- stmt_arg_size (CmmCall _ _ _ (CmmSafe _)) =
+ stmt_arg_size (CmmCall _ _ _ (CmmSafe _) _) =
panic "Safe call in processFormats"
stmt_arg_size (CmmReturn _) =
panic "CmmReturn in processFormats"
diff --git a/compiler/cmm/CmmCPSGen.hs b/compiler/cmm/CmmCPSGen.hs
index 732c962667..fc3c39146f 100644
--- a/compiler/cmm/CmmCPSGen.hs
+++ b/compiler/cmm/CmmCPSGen.hs
@@ -194,7 +194,7 @@ continuationToProc (max_stack, update_frame_size, formats) stack_use uniques
-- A regular Cmm function call
FinalCall next (CmmCallee target CmmCallConv)
- results arguments _ _ ->
+ results arguments _ _ _ ->
pack_continuation curr_format cont_format ++
tail_call (curr_stack - cont_stack)
target arguments
@@ -205,7 +205,7 @@ continuationToProc (max_stack, update_frame_size, formats) stack_use uniques
-- A safe foreign call
FinalCall next (CmmCallee target conv)
- results arguments _ _ ->
+ results arguments _ _ _ ->
target_stmts ++
foreignCall call_uniques' (CmmCallee new_target conv)
results arguments
@@ -215,7 +215,7 @@ continuationToProc (max_stack, update_frame_size, formats) stack_use uniques
-- A safe prim call
FinalCall next (CmmPrim target)
- results arguments _ _ ->
+ results arguments _ _ _ ->
foreignCall call_uniques (CmmPrim target)
results arguments
@@ -229,12 +229,14 @@ foreignCall uniques call results arguments =
[CmmCall (CmmCallee suspendThread CCallConv)
[ (id,PtrHint) ]
[ (CmmReg (CmmGlobal BaseReg), PtrHint) ]
- CmmUnsafe,
- CmmCall call results new_args CmmUnsafe,
+ CmmUnsafe
+ CmmMayReturn,
+ CmmCall call results new_args CmmUnsafe CmmMayReturn,
CmmCall (CmmCallee resumeThread CCallConv)
[ (new_base, PtrHint) ]
[ (CmmReg (CmmLocal id), PtrHint) ]
- CmmUnsafe,
+ CmmUnsafe
+ CmmMayReturn,
-- Assign the result to BaseReg: we
-- might now have a different Capability!
CmmAssign (CmmGlobal BaseReg) (CmmReg (CmmLocal new_base))] ++
diff --git a/compiler/cmm/CmmLint.hs b/compiler/cmm/CmmLint.hs
index d8d6c9bb46..7069457a40 100644
--- a/compiler/cmm/CmmLint.hs
+++ b/compiler/cmm/CmmLint.hs
@@ -122,7 +122,7 @@ lintCmmStmt (CmmStore l r) = do
lintCmmExpr l
lintCmmExpr r
return ()
-lintCmmStmt (CmmCall _target _res args _) = mapM_ (lintCmmExpr.fst) args
+lintCmmStmt (CmmCall _target _res args _ _) = mapM_ (lintCmmExpr.fst) args
lintCmmStmt (CmmCondBranch e _id) = lintCmmExpr e >> checkCond e >> return ()
lintCmmStmt (CmmSwitch e _branches) = do
erep <- lintCmmExpr e
diff --git a/compiler/cmm/CmmLive.hs b/compiler/cmm/CmmLive.hs
index 958ba81821..3d87907a0d 100644
--- a/compiler/cmm/CmmLive.hs
+++ b/compiler/cmm/CmmLive.hs
@@ -170,7 +170,7 @@ cmmStmtLive _ (CmmAssign reg expr) =
(CmmGlobal _) -> id
cmmStmtLive _ (CmmStore expr1 expr2) =
cmmExprLive expr2 . cmmExprLive expr1
-cmmStmtLive _ (CmmCall target results arguments _) =
+cmmStmtLive _ (CmmCall target results arguments _ _) =
target_liveness .
foldr ((.) . cmmExprLive) id (map fst arguments) .
addKilled (mkUniqSet $ cmmHintFormalsToLiveLocals results) where
diff --git a/compiler/cmm/CmmOpt.hs b/compiler/cmm/CmmOpt.hs
index b0ec5a1ad6..9664b9bece 100644
--- a/compiler/cmm/CmmOpt.hs
+++ b/compiler/cmm/CmmOpt.hs
@@ -139,7 +139,7 @@ lookForInline u expr (stmt:stmts)
getStmtUses :: CmmStmt -> UniqFM Int
getStmtUses (CmmAssign _ e) = getExprUses e
getStmtUses (CmmStore e1 e2) = plusUFM_C (+) (getExprUses e1) (getExprUses e2)
-getStmtUses (CmmCall target _ es _)
+getStmtUses (CmmCall target _ es _ _)
= plusUFM_C (+) (uses target) (getExprsUses (map fst es))
where uses (CmmCallee e _) = getExprUses e
uses _ = emptyUFM
@@ -160,8 +160,8 @@ getExprsUses es = foldr (plusUFM_C (+)) emptyUFM (map getExprUses es)
inlineStmt :: Unique -> CmmExpr -> CmmStmt -> CmmStmt
inlineStmt u a (CmmAssign r e) = CmmAssign r (inlineExpr u a e)
inlineStmt u a (CmmStore e1 e2) = CmmStore (inlineExpr u a e1) (inlineExpr u a e2)
-inlineStmt u a (CmmCall target regs es srt)
- = CmmCall (infn target) regs es' srt
+inlineStmt u a (CmmCall target regs es srt ret)
+ = CmmCall (infn target) regs es' srt ret
where infn (CmmCallee fn cconv) = CmmCallee fn cconv
infn (CmmPrim p) = CmmPrim p
es' = [ (inlineExpr u a e, hint) | (e,hint) <- es ]
diff --git a/compiler/cmm/CmmParse.y b/compiler/cmm/CmmParse.y
index bce6f27a70..200ec38090 100644
--- a/compiler/cmm/CmmParse.y
+++ b/compiler/cmm/CmmParse.y
@@ -339,9 +339,9 @@ stmt :: { ExtCode }
| 'if' bool_expr '{' body '}' else
{ ifThenElse $2 $4 $6 }
-opt_never_returns :: { ReturnInfo }
- : { MayReturn }
- | 'never' 'returns' { NeverReturns }
+opt_never_returns :: { CmmReturnInfo }
+ : { CmmMayReturn }
+ | 'never' 'returns' { CmmNeverReturns }
bool_expr :: { ExtFCode BoolExpr }
: bool_op { $1 }
@@ -873,9 +873,9 @@ foreignCall
-> [ExtFCode (CmmExpr,MachHint)]
-> Maybe [GlobalReg]
-> CmmSafety
- -> ReturnInfo
+ -> CmmReturnInfo
-> P ExtCode
-foreignCall conv_string results_code expr_code args_code vols safety _ret
+foreignCall conv_string results_code expr_code args_code vols safety ret
= do convention <- case conv_string of
"C" -> return CCallConv
"C--" -> return CmmCallConv
@@ -887,14 +887,14 @@ foreignCall conv_string results_code expr_code args_code vols safety _ret
--code (stmtC (CmmCall (CmmCallee expr convention) results args safety))
case convention of
-- Temporary hack so at least some functions are CmmSafe
- CmmCallConv -> code (stmtC (CmmCall (CmmCallee expr convention) results args safety))
+ CmmCallConv -> code (stmtC (CmmCall (CmmCallee expr convention) results args safety ret))
_ -> case safety of
CmmUnsafe ->
code (emitForeignCall' PlayRisky results
- (CmmCallee expr convention) args vols NoC_SRT)
+ (CmmCallee expr convention) args vols NoC_SRT ret)
CmmSafe srt ->
code (emitForeignCall' (PlaySafe unused) results
- (CmmCallee expr convention) args vols NoC_SRT) where
+ (CmmCallee expr convention) args vols NoC_SRT ret) where
unused = panic "not used by emitForeignCall'"
primCall
@@ -913,10 +913,10 @@ primCall results_code name args_code vols safety
case safety of
CmmUnsafe ->
code (emitForeignCall' PlayRisky results
- (CmmPrim p) args vols NoC_SRT)
+ (CmmPrim p) args vols NoC_SRT CmmMayReturn)
CmmSafe srt ->
code (emitForeignCall' (PlaySafe unused) results
- (CmmPrim p) args vols NoC_SRT) where
+ (CmmPrim p) args vols NoC_SRT CmmMayReturn) where
unused = panic "not used by emitForeignCall'"
doStore :: MachRep -> ExtFCode CmmExpr -> ExtFCode CmmExpr -> ExtCode
diff --git a/compiler/cmm/PprC.hs b/compiler/cmm/PprC.hs
index 238fd61248..a07d2b9f53 100644
--- a/compiler/cmm/PprC.hs
+++ b/compiler/cmm/PprC.hs
@@ -199,7 +199,7 @@ pprStmt stmt = case stmt of
where
rep = cmmExprRep src
- CmmCall (CmmCallee fn cconv) results args safety ->
+ CmmCall (CmmCallee fn cconv) results args safety _ret ->
-- Controversial: leave this out for now.
-- pprUndef fn $$
@@ -220,7 +220,7 @@ pprStmt stmt = case stmt of
ptext SLIT("#undef") <+> pprCLabel lbl
pprUndef _ = empty
- CmmCall (CmmPrim op) results args safety ->
+ CmmCall (CmmPrim op) results args safety _ret ->
pprCall ppr_fn CCallConv results args safety
where
ppr_fn = pprCallishMachOp_for_C op
@@ -837,7 +837,7 @@ te_Lit _ = return ()
te_Stmt :: CmmStmt -> TE ()
te_Stmt (CmmAssign r e) = te_Reg r >> te_Expr e
te_Stmt (CmmStore l r) = te_Expr l >> te_Expr r
-te_Stmt (CmmCall _ rs es _) = mapM_ (te_temp.fst) rs >>
+te_Stmt (CmmCall _ rs es _ _) = mapM_ (te_temp.fst) rs >>
mapM_ (te_Expr.fst) es
te_Stmt (CmmCondBranch e _) = te_Expr e
te_Stmt (CmmSwitch e _) = te_Expr e
diff --git a/compiler/cmm/PprCmm.hs b/compiler/cmm/PprCmm.hs
index 2d3fd6a746..72fde55a49 100644
--- a/compiler/cmm/PprCmm.hs
+++ b/compiler/cmm/PprCmm.hs
@@ -212,7 +212,7 @@ pprStmt stmt = case stmt of
-- call "ccall" foo(x, y)[r1, r2];
-- ToDo ppr volatile
- CmmCall (CmmCallee fn cconv) results args safety ->
+ CmmCall (CmmCallee fn cconv) results args safety ret ->
hcat [ if null results
then empty
else parens (commafy $ map ppr results) <>
@@ -220,14 +220,17 @@ pprStmt stmt = case stmt of
ptext SLIT("call"), space,
doubleQuotes(ppr cconv), space,
target fn, parens ( commafy $ map ppr args ),
- brackets (ppr safety), semi ]
+ brackets (ppr safety),
+ case ret of CmmMayReturn -> empty
+ CmmNeverReturns -> ptext SLIT(" never returns"),
+ semi ]
where
target (CmmLit lit) = pprLit lit
target fn' = parens (ppr fn')
- CmmCall (CmmPrim op) results args safety ->
+ CmmCall (CmmPrim op) results args safety ret ->
pprStmt (CmmCall (CmmCallee (CmmLit lbl) CCallConv)
- results args safety)
+ results args safety ret)
where
lbl = CmmLabel (mkForeignLabel (mkFastString (show op)) Nothing False)
diff --git a/compiler/codeGen/CgForeignCall.hs b/compiler/codeGen/CgForeignCall.hs
index dd959943fb..9db66f6a64 100644
--- a/compiler/codeGen/CgForeignCall.hs
+++ b/compiler/codeGen/CgForeignCall.hs
@@ -73,7 +73,7 @@ emitForeignCall results (CCall (CCallSpec target cconv safety)) args live
= do vols <- getVolatileRegs live
srt <- getSRTInfo
emitForeignCall' safety results
- (CmmCallee cmm_target cconv) call_args (Just vols) srt
+ (CmmCallee cmm_target cconv) call_args (Just vols) srt CmmMayReturn
where
(call_args, cmm_target)
= case target of
@@ -104,13 +104,14 @@ emitForeignCall'
-> [(CmmExpr,MachHint)] -- arguments
-> Maybe [GlobalReg] -- live vars, in case we need to save them
-> C_SRT -- the SRT of the calls continuation
+ -> CmmReturnInfo
-> Code
-emitForeignCall' safety results target args vols srt
+emitForeignCall' safety results target args vols srt ret
| not (playSafe safety) = do
temp_args <- load_args_into_temps args
let (caller_save, caller_load) = callerSaveVolatileRegs vols
stmtsC caller_save
- stmtC (CmmCall target results temp_args CmmUnsafe)
+ stmtC (CmmCall target results temp_args CmmUnsafe ret)
stmtsC caller_load
| otherwise = do
@@ -131,12 +132,12 @@ emitForeignCall' safety results target args vols srt
stmtC (CmmCall (CmmCallee suspendThread CCallConv)
[ (id,PtrHint) ]
[ (CmmReg (CmmGlobal BaseReg), PtrHint) ]
- CmmUnsafe)
- stmtC (CmmCall temp_target results temp_args CmmUnsafe)
+ CmmUnsafe ret)
+ stmtC (CmmCall temp_target results temp_args CmmUnsafe ret)
stmtC (CmmCall (CmmCallee resumeThread CCallConv)
[ (new_base, PtrHint) ]
[ (CmmReg (CmmLocal id), PtrHint) ]
- CmmUnsafe)
+ CmmUnsafe ret)
-- Assign the result to BaseReg: we
-- might now have a different Capability!
stmtC (CmmAssign (CmmGlobal BaseReg) (CmmReg (CmmLocal new_base)))
diff --git a/compiler/codeGen/CgHpc.hs b/compiler/codeGen/CgHpc.hs
index e846f0e791..5992684d0e 100644
--- a/compiler/codeGen/CgHpc.hs
+++ b/compiler/codeGen/CgHpc.hs
@@ -76,6 +76,7 @@ initHpc this_mod (HpcInfo tickCount hashNo)
]
(Just [])
NoC_SRT -- No SRT b/c we PlayRisky
+ CmmMayReturn
}
where
mod_alloc = mkFastString "hs_hpc_module"
diff --git a/compiler/codeGen/CgPrimOp.hs b/compiler/codeGen/CgPrimOp.hs
index 049e12a986..5ea50236de 100644
--- a/compiler/codeGen/CgPrimOp.hs
+++ b/compiler/codeGen/CgPrimOp.hs
@@ -121,6 +121,7 @@ emitPrimOp [res] ParOp [arg] live
[(CmmReg (CmmGlobal BaseReg), PtrHint), (arg,PtrHint)]
(Just vols)
NoC_SRT -- No SRT b/c we do PlayRisky
+ CmmMayReturn
where
newspark = CmmLit (CmmLabel (mkRtsCodeLabel SLIT("newSpark")))
@@ -138,6 +139,7 @@ emitPrimOp [] WriteMutVarOp [mutv,var] live
[(CmmReg (CmmGlobal BaseReg), PtrHint), (mutv,PtrHint)]
(Just vols)
NoC_SRT -- No SRT b/c we do PlayRisky
+ CmmMayReturn
-- #define sizzeofByteArrayzh(r,a) \
-- r = (((StgArrWords *)(a))->words * sizeof(W_))
@@ -344,6 +346,7 @@ emitPrimOp [res] op args live
[(a,NoHint) | a<-args] -- ToDo: hints?
(Just vols)
NoC_SRT -- No SRT b/c we do PlayRisky
+ CmmMayReturn
| Just mop <- translateOp op
= let stmt = CmmAssign (CmmLocal res) (CmmMachOp mop args) in
diff --git a/compiler/codeGen/CgUtils.hs b/compiler/codeGen/CgUtils.hs
index 9ebcf90e30..eee5f8dc85 100644
--- a/compiler/codeGen/CgUtils.hs
+++ b/compiler/codeGen/CgUtils.hs
@@ -354,7 +354,7 @@ emitRtsCall' res fun args vols safe = do
then getSRTInfo >>= (return . CmmSafe)
else return CmmUnsafe
stmtsC caller_save
- stmtC (CmmCall target res args safety)
+ stmtC (CmmCall target res args safety CmmMayReturn)
stmtsC caller_load
where
(caller_save, caller_load) = callerSaveVolatileRegs vols
diff --git a/compiler/nativeGen/AsmCodeGen.lhs b/compiler/nativeGen/AsmCodeGen.lhs
index 672ff6906e..3485d61a32 100644
--- a/compiler/nativeGen/AsmCodeGen.lhs
+++ b/compiler/nativeGen/AsmCodeGen.lhs
@@ -517,7 +517,7 @@ cmmStmtConFold stmt
-> do addr' <- cmmExprConFold JumpReference addr
return $ CmmJump addr' regs
- CmmCall target regs args srt
+ CmmCall target regs args srt returns
-> do target' <- case target of
CmmCallee e conv -> do
e' <- cmmExprConFold CallReference e
@@ -526,7 +526,7 @@ cmmStmtConFold stmt
args' <- mapM (\(arg, hint) -> do
arg' <- cmmExprConFold DataReference arg
return (arg', hint)) args
- return $ CmmCall target' regs args' srt
+ return $ CmmCall target' regs args' srt returns
CmmCondBranch test dest
-> do test' <- cmmExprConFold DataReference test
diff --git a/compiler/nativeGen/MachCodeGen.hs b/compiler/nativeGen/MachCodeGen.hs
index e6cb6fc05d..eb3a5cd6a3 100644
--- a/compiler/nativeGen/MachCodeGen.hs
+++ b/compiler/nativeGen/MachCodeGen.hs
@@ -121,7 +121,7 @@ stmtToInstrs stmt = case stmt of
| otherwise -> assignMem_IntCode kind addr src
where kind = cmmExprRep src
- CmmCall target result_regs args _
+ CmmCall target result_regs args _ _
-> genCCall target result_regs args
CmmBranch id -> genBranch id
@@ -3206,13 +3206,13 @@ outOfLineFloatOp mop res args
if localRegRep res == F64
then
- stmtToInstrs (CmmCall target [(res,FloatHint)] args CmmUnsafe)
+ stmtToInstrs (CmmCall target [(res,FloatHint)] args CmmUnsafe CmmMayReturn)
else do
uq <- getUniqueNat
let
tmp = LocalReg uq F64 KindNonPtr
-- in
- code1 <- stmtToInstrs (CmmCall target [(tmp,FloatHint)] args CmmUnsafe)
+ code1 <- stmtToInstrs (CmmCall target [(tmp,FloatHint)] args CmmUnsafe CmmMayReturn)
code2 <- stmtToInstrs (CmmAssign (CmmLocal res) (CmmReg (CmmLocal tmp)))
return (code1 `appOL` code2)
where