summaryrefslogtreecommitdiff
path: root/compiler/cmm
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/cmm')
-rw-r--r--compiler/cmm/CmmCvt.hs2
-rw-r--r--compiler/cmm/CmmLint.hs2
-rw-r--r--compiler/cmm/CmmOpt.hs6
-rw-r--r--compiler/cmm/CmmParse.y3
-rw-r--r--compiler/cmm/OldCmm.hs3
-rw-r--r--compiler/cmm/OldPprCmm.hs7
-rw-r--r--compiler/cmm/PprC.hs20
7 files changed, 20 insertions, 23 deletions
diff --git a/compiler/cmm/CmmCvt.hs b/compiler/cmm/CmmCvt.hs
index c8a1d85597..c82f517849 100644
--- a/compiler/cmm/CmmCvt.hs
+++ b/compiler/cmm/CmmCvt.hs
@@ -91,7 +91,7 @@ ofZgraph g = Old.ListGraph $ mapMaybe convert_block $ postorderDfs g
Old.CmmCall (cmm_target target)
(add_hints (get_conv target) Results ress)
(add_hints (get_conv target) Arguments args)
- Old.CmmUnsafe Old.CmmMayReturn
+ Old.CmmMayReturn
last :: CmmNode O C -> () -> [Old.CmmStmt]
last node _ = stmts
diff --git a/compiler/cmm/CmmLint.hs b/compiler/cmm/CmmLint.hs
index e03da8ccd7..ee53c1b6c7 100644
--- a/compiler/cmm/CmmLint.hs
+++ b/compiler/cmm/CmmLint.hs
@@ -133,7 +133,7 @@ lintCmmStmt platform labels = lint
_ <- lintCmmExpr platform l
_ <- lintCmmExpr platform r
return ()
- lint (CmmCall target _res args _ _) =
+ lint (CmmCall target _res args _) =
lintTarget platform target >> mapM_ (lintCmmExpr platform . hintlessCmm) args
lint (CmmCondBranch e id) = checkTarget id >> lintCmmExpr platform e >> checkCond platform e
lint (CmmSwitch e branches) = do
diff --git a/compiler/cmm/CmmOpt.hs b/compiler/cmm/CmmOpt.hs
index 1005448894..007b7a715e 100644
--- a/compiler/cmm/CmmOpt.hs
+++ b/compiler/cmm/CmmOpt.hs
@@ -59,7 +59,7 @@ cmmEliminateDeadBlocks blocks@(BasicBlock base_id _:_) =
stmt m (CmmComment _) = m
stmt m (CmmAssign _ e) = expr m e
stmt m (CmmStore e1 e2) = expr (expr m e1) e2
- stmt m (CmmCall c _ as _ _) = f (actuals m as) c
+ stmt m (CmmCall c _ as _) = f (actuals m as) c
where f m (CmmCallee e _) = expr m e
f m (CmmPrim _) = m
stmt m (CmmBranch b) = b:m
@@ -266,8 +266,8 @@ lookForInline' u expr regset (stmt : rest)
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 ret)
- = CmmCall (infn target) regs es' srt ret
+inlineStmt u a (CmmCall target regs es ret)
+ = CmmCall (infn target) regs es' ret
where infn (CmmCallee fn cconv) = CmmCallee (inlineExpr u a fn) cconv
infn (CmmPrim p) = CmmPrim p
es' = [ (CmmHinted (inlineExpr u a e) hint) | (CmmHinted e hint) <- es ]
diff --git a/compiler/cmm/CmmParse.y b/compiler/cmm/CmmParse.y
index bdb2c4c918..0a50f60b2c 100644
--- a/compiler/cmm/CmmParse.y
+++ b/compiler/cmm/CmmParse.y
@@ -867,10 +867,9 @@ foreignCall conv_string results_code expr_code args_code vols safety ret
results <- sequence results_code
expr <- expr_code
args <- sequence args_code
- --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 ret))
+ CmmCallConv -> code (stmtC (CmmCall (CmmCallee expr convention) results args ret))
_ ->
let expr' = adjCallTarget convention expr args in
case safety of
diff --git a/compiler/cmm/OldCmm.hs b/compiler/cmm/OldCmm.hs
index 3703de4e32..a8a9d5dde0 100644
--- a/compiler/cmm/OldCmm.hs
+++ b/compiler/cmm/OldCmm.hs
@@ -154,7 +154,6 @@ data CmmStmt -- Old-style
CmmCallTarget
[HintedCmmFormal] -- zero or more results
[HintedCmmActual] -- zero or more arguments
- CmmSafety -- whether to build a continuation
CmmReturnInfo
-- Some care is necessary when handling the arguments of these, see
-- [Register parameter passing] and the hack in cmm/CmmOpt.hs
@@ -192,7 +191,7 @@ instance UserOfLocalRegs CmmStmt where
stmt (CmmComment {}) = id
stmt (CmmAssign _ e) = gen e
stmt (CmmStore e1 e2) = gen e1 . gen e2
- stmt (CmmCall target _ es _ _) = gen target . gen es
+ stmt (CmmCall target _ es _) = gen target . gen es
stmt (CmmBranch _) = id
stmt (CmmCondBranch e _) = gen e
stmt (CmmSwitch e _) = gen e
diff --git a/compiler/cmm/OldPprCmm.hs b/compiler/cmm/OldPprCmm.hs
index d2f03f78b7..07dfbf63bf 100644
--- a/compiler/cmm/OldPprCmm.hs
+++ b/compiler/cmm/OldPprCmm.hs
@@ -122,11 +122,10 @@ pprStmt platform stmt = case stmt of
-- call "ccall" foo(x, y)[r1, r2];
-- ToDo ppr volatile
- CmmCall (CmmCallee fn cconv) results args safety ret ->
+ CmmCall (CmmCallee fn cconv) results args ret ->
sep [ pp_lhs <+> pp_conv
, nest 2 (pprExpr9 platform fn <>
parens (commafy (map ppr_ar args)))
- <> brackets (pprPlatform platform safety)
, case ret of CmmMayReturn -> empty
CmmNeverReturns -> ptext $ sLit (" never returns")
] <> semi
@@ -142,9 +141,9 @@ pprStmt platform stmt = case stmt of
_ -> ptext (sLit("foreign")) <+> doubleQuotes (ppr cconv)
-- Call a CallishMachOp, like sin or cos that might be implemented as a library call.
- CmmCall (CmmPrim op) results args safety ret ->
+ CmmCall (CmmPrim op) results args ret ->
pprStmt platform (CmmCall (CmmCallee (CmmLit lbl) CCallConv)
- results args safety ret)
+ results args ret)
where
-- HACK: A CallishMachOp doesn't really correspond to a ForeignLabel, but we
-- use one to get the label printed.
diff --git a/compiler/cmm/PprC.hs b/compiler/cmm/PprC.hs
index 4f8a061bdd..270ce12670 100644
--- a/compiler/cmm/PprC.hs
+++ b/compiler/cmm/PprC.hs
@@ -193,7 +193,7 @@ pprStmt platform stmt = case stmt of
where
rep = cmmExprType src
- CmmCall (CmmCallee fn cconv) results args safety ret ->
+ CmmCall (CmmCallee fn cconv) results args ret ->
maybe_proto $$
fnCall
where
@@ -215,7 +215,7 @@ pprStmt platform stmt = case stmt of
case fn of
CmmLit (CmmLabel lbl)
| StdCallConv <- cconv ->
- let myCall = pprCall platform (pprCLabel platform lbl) cconv results args safety
+ let myCall = pprCall platform (pprCLabel platform lbl) cconv results args
in (real_fun_proto lbl, myCall)
-- stdcall functions must be declared with
-- a function type, otherwise the C compiler
@@ -223,22 +223,22 @@ pprStmt platform stmt = case stmt of
-- can't add the @n suffix ourselves, because
-- it isn't valid C.
| CmmNeverReturns <- ret ->
- let myCall = pprCall platform (pprCLabel platform lbl) cconv results args safety
+ let myCall = pprCall platform (pprCLabel platform lbl) cconv results args
in (real_fun_proto lbl, myCall)
| not (isMathFun lbl) ->
let myCall = braces (
pprCFunType (char '*' <> text "ghcFunPtr") cconv results args <> semi
$$ text "ghcFunPtr" <+> equals <+> cast_fn <> semi
- $$ pprCall platform (text "ghcFunPtr") cconv results args safety <> semi
+ $$ pprCall platform (text "ghcFunPtr") cconv results args <> semi
)
in (fun_proto lbl, myCall)
_ ->
(empty {- no proto -},
- pprCall platform cast_fn cconv results args safety <> semi)
+ pprCall platform cast_fn cconv results args <> semi)
-- for a dynamic call, no declaration is necessary.
- CmmCall (CmmPrim op) results args safety _ret ->
- pprCall platform ppr_fn CCallConv results args' safety
+ CmmCall (CmmPrim op) results args _ret ->
+ pprCall platform ppr_fn CCallConv results args'
where
ppr_fn = pprCallishMachOp_for_C op
-- The mem primops carry an extra alignment arg, must drop it.
@@ -812,10 +812,10 @@ pprLocalReg (LocalReg uniq _) = char '_' <> ppr uniq
-- Foreign Calls
pprCall :: Platform -> SDoc -> CCallConv
- -> [HintedCmmFormal] -> [HintedCmmActual] -> CmmSafety
+ -> [HintedCmmFormal] -> [HintedCmmActual]
-> SDoc
-pprCall platform ppr_fn cconv results args _
+pprCall platform ppr_fn cconv results args
| not (is_cishCC cconv)
= panic $ "pprCall: unknown calling convention"
@@ -926,7 +926,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.hintlessCmm) rs >>
+te_Stmt (CmmCall _ rs es _) = mapM_ (te_temp.hintlessCmm) rs >>
mapM_ (te_Expr.hintlessCmm) es
te_Stmt (CmmCondBranch e _) = te_Expr e
te_Stmt (CmmSwitch e _) = te_Expr e