Skip to content
GitLab
Commit bb66ce57 authored by nr@eecs.harvard.edu's avatar nr@eecs.harvard.edu
Browse files

put CmmReturnInfo into a CmmCall (and related types)

parent fdd372f9
Hide whitespace changes
Inline Side-by-side
compiler/cmm/Cmm.hs
View file @ bb66ce57
......@@ -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
......
compiler/cmm/CmmBrokenBlock.hs
View file @ bb66ce57
......@@ -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]
-----------------------------------------------------------------------------
......
compiler/cmm/CmmCPS.hs
View file @ bb66ce57
......@@ -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"
......
compiler/cmm/CmmCPSGen.hs
View file @ bb66ce57
......@@ -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))] ++
......
compiler/cmm/CmmLint.hs
View file @ bb66ce57
......@@ -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
......
compiler/cmm/CmmLive.hs
View file @ bb66ce57
......@@ -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
......
compiler/cmm/CmmOpt.hs
View file @ bb66ce57
......@@ -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 ]
......
compiler/cmm/CmmParse.y
View file @ bb66ce57
......@@ -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
......
compiler/cmm/PprC.hs
View file @ bb66ce57
......@@ -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
......
compiler/cmm/PprCmm.hs
View file @ bb66ce57
......@@ -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)
......
compiler/codeGen/CgForeignCall.hs
View file @ bb66ce57
......@@ -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)))
......
compiler/codeGen/CgHpc.hs
View file @ bb66ce57
......@@ -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"
......
compiler/codeGen/CgPrimOp.hs
View file @ bb66ce57
......@@ -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
......
compiler/codeGen/CgUtils.hs
View file @ bb66ce57
......@@ -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
......
compiler/nativeGen/AsmCodeGen.lhs
View file @ bb66ce57
......@@ -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
......
compiler/nativeGen/MachCodeGen.hs
View file @ bb66ce57
......@@ -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
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment