summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-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
-rw-r--r--compiler/codeGen/CgClosure.lhs4
-rw-r--r--compiler/codeGen/CgForeignCall.hs8
-rw-r--r--compiler/codeGen/CgProf.hs3
-rw-r--r--compiler/codeGen/CgUtils.hs27
-rw-r--r--compiler/llvmGen/LlvmCodeGen/CodeGen.hs2
-rw-r--r--compiler/nativeGen/AsmCodeGen.lhs4
-rw-r--r--compiler/nativeGen/PPC/CodeGen.hs2
-rw-r--r--compiler/nativeGen/SPARC/CodeGen.hs2
-rw-r--r--compiler/nativeGen/X86/CodeGen.hs4
16 files changed, 45 insertions, 54 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
diff --git a/compiler/codeGen/CgClosure.lhs b/compiler/codeGen/CgClosure.lhs
index 85d629dbaf..243d59f5db 100644
--- a/compiler/codeGen/CgClosure.lhs
+++ b/compiler/codeGen/CgClosure.lhs
@@ -482,7 +482,7 @@ emitBlackHoleCode is_single_entry = do
stmtsC [
CmmStore (cmmOffsetW (CmmReg nodeReg) fixedHdrSize)
(CmmReg (CmmGlobal CurrentTSO)),
- CmmCall (CmmPrim MO_WriteBarrier) [] [] CmmUnsafe CmmMayReturn,
+ CmmCall (CmmPrim MO_WriteBarrier) [] [] CmmMayReturn,
CmmStore (CmmReg nodeReg) (CmmReg (CmmGlobal EagerBlackholeInfo))
]
\end{code}
@@ -580,7 +580,7 @@ link_caf cl_info _is_upd = do
[ CmmHinted (CmmReg (CmmGlobal BaseReg)) AddrHint,
CmmHinted (CmmReg nodeReg) AddrHint,
CmmHinted hp_rel AddrHint ]
- (Just [node]) False
+ (Just [node])
-- node is live, so save it.
-- see Note [atomic CAF entry] in rts/sm/Storage.c
diff --git a/compiler/codeGen/CgForeignCall.hs b/compiler/codeGen/CgForeignCall.hs
index d96e9f8cfc..7d67132fcf 100644
--- a/compiler/codeGen/CgForeignCall.hs
+++ b/compiler/codeGen/CgForeignCall.hs
@@ -127,7 +127,7 @@ emitForeignCall' safety results target args vols _srt ret
let (caller_save, caller_load) = callerSaveVolatileRegs vols
let caller_load' = if ret == CmmNeverReturns then [] else caller_load
stmtsC caller_save
- stmtC (CmmCall target results temp_args CmmUnsafe ret)
+ stmtC (CmmCall target results temp_args ret)
stmtsC caller_load'
| otherwise = do
@@ -149,12 +149,12 @@ emitForeignCall' safety results target args vols _srt ret
[ CmmHinted id AddrHint ]
[ CmmHinted (CmmReg (CmmGlobal BaseReg)) AddrHint
, CmmHinted (CmmLit (CmmInt (fromIntegral (fromEnum (playInterruptible safety))) wordWidth)) NoHint]
- CmmUnsafe ret)
- stmtC (CmmCall temp_target results temp_args CmmUnsafe ret)
+ ret)
+ stmtC (CmmCall temp_target results temp_args ret)
stmtC (CmmCall (CmmCallee resumeThread CCallConv)
[ CmmHinted new_base AddrHint ]
[ CmmHinted (CmmReg (CmmLocal id)) AddrHint ]
- CmmUnsafe ret)
+ 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/CgProf.hs b/compiler/codeGen/CgProf.hs
index c961e24147..13667c399a 100644
--- a/compiler/codeGen/CgProf.hs
+++ b/compiler/codeGen/CgProf.hs
@@ -142,7 +142,7 @@ enterCostCentreFun ccs closure =
ifProfiling $ do
if isCurrentCCS ccs
then emitRtsCall rtsPackageId (fsLit "enterFunCCS")
- [CmmHinted (costCentreFrom closure) AddrHint] False
+ [CmmHinted (costCentreFrom closure) AddrHint]
else return () -- top-level function, nothing to do
ifProfiling :: Code -> Code
@@ -234,7 +234,6 @@ pushCostCentre result ccs cc
rtsPackageId
(fsLit "pushCostCentre") [CmmHinted ccs AddrHint,
CmmHinted (CmmLit (mkCCostCentre cc)) AddrHint]
- False
bumpSccCount :: CmmExpr -> CmmStmt
bumpSccCount ccs
diff --git a/compiler/codeGen/CgUtils.hs b/compiler/codeGen/CgUtils.hs
index a0a5ac2554..85957e81b9 100644
--- a/compiler/codeGen/CgUtils.hs
+++ b/compiler/codeGen/CgUtils.hs
@@ -233,23 +233,22 @@ emitRtsCall
:: PackageId -- ^ package the function is in
-> FastString -- ^ name of function
-> [CmmHinted CmmExpr] -- ^ function args
- -> Bool -- ^ whether this is a safe call
-> Code -- ^ cmm code
-emitRtsCall pkg fun args safe = emitRtsCallGen [] pkg fun args Nothing safe
+emitRtsCall pkg fun args = emitRtsCallGen [] pkg fun args Nothing
-- The 'Nothing' says "save all global registers"
-emitRtsCallWithVols :: PackageId -> FastString -> [CmmHinted CmmExpr] -> [GlobalReg] -> Bool -> Code
-emitRtsCallWithVols pkg fun args vols safe
- = emitRtsCallGen [] pkg fun args (Just vols) safe
+emitRtsCallWithVols :: PackageId -> FastString -> [CmmHinted CmmExpr] -> [GlobalReg] -> Code
+emitRtsCallWithVols pkg fun args vols
+ = emitRtsCallGen [] pkg fun args (Just vols)
emitRtsCallWithResult
:: LocalReg -> ForeignHint
-> PackageId -> FastString
- -> [CmmHinted CmmExpr] -> Bool -> Code
+ -> [CmmHinted CmmExpr] -> Code
-emitRtsCallWithResult res hint pkg fun args safe
- = emitRtsCallGen [CmmHinted res hint] pkg fun args Nothing safe
+emitRtsCallWithResult res hint pkg fun args
+ = emitRtsCallGen [CmmHinted res hint] pkg fun args Nothing
-- Make a call to an RTS C procedure
emitRtsCallGen
@@ -258,14 +257,10 @@ emitRtsCallGen
-> FastString
-> [CmmHinted CmmExpr]
-> Maybe [GlobalReg]
- -> Bool -- True <=> CmmSafe call
-> Code
-emitRtsCallGen res pkg fun args vols safe = do
- safety <- if safe
- then getSRTInfo >>= (return . CmmSafe)
- else return CmmUnsafe
+emitRtsCallGen res pkg fun args vols = do
stmtsC caller_save
- stmtC (CmmCall target res args safety CmmMayReturn)
+ stmtC (CmmCall target res args CmmMayReturn)
stmtsC caller_load
where
(caller_save, caller_load) = callerSaveVolatileRegs vols
@@ -1009,13 +1004,13 @@ fixStgRegStmt stmt
CmmStore addr src -> CmmStore (fixStgRegExpr addr) (fixStgRegExpr src)
- CmmCall target regs args srt returns ->
+ CmmCall target regs args returns ->
let target' = case target of
CmmCallee e conv -> CmmCallee (fixStgRegExpr e) conv
other -> other
args' = map (\(CmmHinted arg hint) ->
(CmmHinted (fixStgRegExpr arg) hint)) args
- in CmmCall target' regs args' srt returns
+ in CmmCall target' regs args' returns
CmmCondBranch test dest -> CmmCondBranch (fixStgRegExpr test) dest
diff --git a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs
index b039d39960..1ea5d0c038 100644
--- a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs
+++ b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs
@@ -125,7 +125,7 @@ stmtToInstrs env stmt = case stmt of
CmmSwitch arg ids -> genSwitch env arg ids
-- Foreign Call
- CmmCall target res args _ ret
+ CmmCall target res args ret
-> genCall env target res args ret
-- Tail call
diff --git a/compiler/nativeGen/AsmCodeGen.lhs b/compiler/nativeGen/AsmCodeGen.lhs
index 7ffda3d8f6..0d8aab146b 100644
--- a/compiler/nativeGen/AsmCodeGen.lhs
+++ b/compiler/nativeGen/AsmCodeGen.lhs
@@ -879,7 +879,7 @@ cmmStmtConFold stmt
-> do addr' <- cmmExprConFold JumpReference addr
return $ CmmJump addr' regs
- CmmCall target regs args srt returns
+ CmmCall target regs args returns
-> do target' <- case target of
CmmCallee e conv -> do
e' <- cmmExprConFold CallReference e
@@ -888,7 +888,7 @@ cmmStmtConFold stmt
args' <- mapM (\(CmmHinted arg hint) -> do
arg' <- cmmExprConFold DataReference arg
return (CmmHinted arg' hint)) args
- return $ CmmCall target' regs args' srt returns
+ return $ CmmCall target' regs args' returns
CmmCondBranch test dest
-> do test' <- cmmExprConFold DataReference test
diff --git a/compiler/nativeGen/PPC/CodeGen.hs b/compiler/nativeGen/PPC/CodeGen.hs
index 8c80ec40c1..a043af01f8 100644
--- a/compiler/nativeGen/PPC/CodeGen.hs
+++ b/compiler/nativeGen/PPC/CodeGen.hs
@@ -135,7 +135,7 @@ stmtToInstrs stmt = do
where ty = cmmExprType src
size = cmmTypeSize ty
- CmmCall target result_regs args _ _
+ CmmCall target result_regs args _
-> genCCall target result_regs args
CmmBranch id -> genBranch id
diff --git a/compiler/nativeGen/SPARC/CodeGen.hs b/compiler/nativeGen/SPARC/CodeGen.hs
index 91a850d5fc..663b95b236 100644
--- a/compiler/nativeGen/SPARC/CodeGen.hs
+++ b/compiler/nativeGen/SPARC/CodeGen.hs
@@ -135,7 +135,7 @@ stmtToInstrs stmt = case stmt of
where ty = cmmExprType src
size = cmmTypeSize ty
- CmmCall target result_regs args _ _
+ CmmCall target result_regs args _
-> genCCall target result_regs args
CmmBranch id -> genBranch id
diff --git a/compiler/nativeGen/X86/CodeGen.hs b/compiler/nativeGen/X86/CodeGen.hs
index 97baeec1ab..5f0f716281 100644
--- a/compiler/nativeGen/X86/CodeGen.hs
+++ b/compiler/nativeGen/X86/CodeGen.hs
@@ -160,7 +160,7 @@ stmtToInstrs stmt = do
where ty = cmmExprType src
size = cmmTypeSize ty
- CmmCall target result_regs args _ _
+ CmmCall target result_regs args _
-> genCCall is32Bit target result_regs args
CmmBranch id -> genBranch id
@@ -1996,7 +1996,7 @@ outOfLineCmmOp mop res args
targetExpr <- cmmMakeDynamicReference dflags addImportNat CallReference lbl
let target = CmmCallee targetExpr CCallConv
- stmtToInstrs (CmmCall target (catMaybes [res]) args' CmmUnsafe CmmMayReturn)
+ stmtToInstrs (CmmCall target (catMaybes [res]) args' CmmMayReturn)
where
-- Assume we can call these functions directly, and that they're not in a dynamic library.
-- TODO: Why is this ok? Under linux this code will be in libm.so
View Lorry Controller Status