diff options
Diffstat (limited to 'compiler/codeGen')
| -rw-r--r-- | compiler/codeGen/CgClosure.lhs | 4 | ||||
| -rw-r--r-- | compiler/codeGen/CgForeignCall.hs | 8 | ||||
| -rw-r--r-- | compiler/codeGen/CgProf.hs | 3 | ||||
| -rw-r--r-- | compiler/codeGen/CgUtils.hs | 27 |
4 files changed, 18 insertions, 24 deletions
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 |