diff options
Diffstat (limited to 'compiler/codeGen')
| -rw-r--r-- | compiler/codeGen/CgCallConv.hs | 1 | ||||
| -rw-r--r-- | compiler/codeGen/CgClosure.lhs | 26 | ||||
| -rw-r--r-- | compiler/codeGen/CgMonad.lhs | 1 | ||||
| -rw-r--r-- | compiler/codeGen/CgStackery.lhs | 28 |
4 files changed, 42 insertions, 14 deletions
diff --git a/compiler/codeGen/CgCallConv.hs b/compiler/codeGen/CgCallConv.hs index 8a1ae8be0c..b8294ea326 100644 --- a/compiler/codeGen/CgCallConv.hs +++ b/compiler/codeGen/CgCallConv.hs @@ -284,7 +284,6 @@ getSequelAmode OnStack -> do { sp_rel <- getSpRelOffset virt_sp ; returnFC (CmmLoad sp_rel bWord) } - UpdateCode -> returnFC (CmmLit (CmmLabel mkUpdInfoLabel)) CaseAlts lbl _ _ -> returnFC (CmmLit (CmmLabel lbl)) } diff --git a/compiler/codeGen/CgClosure.lhs b/compiler/codeGen/CgClosure.lhs index f0fe3d17b2..60ba7f8652 100644 --- a/compiler/codeGen/CgClosure.lhs +++ b/compiler/codeGen/CgClosure.lhs @@ -474,7 +474,12 @@ emitBlackHoleCode is_single_entry = do then do tickyBlackHole (not is_single_entry) let bh_info = CmmReg (CmmGlobal EagerBlackholeInfo) - stmtC (CmmStore (CmmReg nodeReg) bh_info) + stmtsC [ + CmmStore (cmmOffsetW (CmmReg nodeReg) fixedHdrSize) + (CmmReg (CmmGlobal CurrentTSO)), + CmmCall (CmmPrim MO_WriteBarrier) [] [] CmmUnsafe CmmMayReturn, + CmmStore (CmmReg nodeReg) bh_info + ] else nopC \end{code} @@ -489,17 +494,23 @@ setupUpdate closure_info code = code | not (isStaticClosure closure_info) - = if closureUpdReqd closure_info - then do { tickyPushUpdateFrame; pushUpdateFrame (CmmReg nodeReg) code } - else do { tickyUpdateFrameOmitted; code } - + = do + if not (closureUpdReqd closure_info) + then do tickyUpdateFrameOmitted; code + else do + tickyPushUpdateFrame + dflags <- getDynFlags + if not opt_SccProfilingOn && dopt Opt_EagerBlackHoling dflags + then pushBHUpdateFrame (CmmReg nodeReg) code + else pushUpdateFrame (CmmReg nodeReg) code + | otherwise -- A static closure = do { tickyUpdateBhCaf closure_info ; if closureUpdReqd closure_info then do -- Blackhole the (updatable) CAF: { upd_closure <- link_caf closure_info True - ; pushUpdateFrame upd_closure code } + ; pushBHUpdateFrame upd_closure code } else do { -- krc: removed some ticky-related code here. ; tickyUpdateFrameOmitted @@ -553,7 +564,8 @@ link_caf cl_info _is_upd = do { -- Alloc black hole specifying CC_HDR(Node) as the cost centre ; let use_cc = costCentreFrom (CmmReg nodeReg) blame_cc = use_cc - ; hp_offset <- allocDynClosure bh_cl_info use_cc blame_cc [] + tso = CmmReg (CmmGlobal CurrentTSO) + ; hp_offset <- allocDynClosure bh_cl_info use_cc blame_cc [(tso,fixedHdrSize)] ; hp_rel <- getHpRelOffset hp_offset -- Call the RTS function newCAF to add the CAF to the CafList diff --git a/compiler/codeGen/CgMonad.lhs b/compiler/codeGen/CgMonad.lhs index 83d2b72747..e5bca2aab1 100644 --- a/compiler/codeGen/CgMonad.lhs +++ b/compiler/codeGen/CgMonad.lhs @@ -169,7 +169,6 @@ block. \begin{code} data Sequel = OnStack -- Continuation is on the stack - | UpdateCode -- Continuation is update | CaseAlts CLabel -- Jump to this; if the continuation is for a vectored diff --git a/compiler/codeGen/CgStackery.lhs b/compiler/codeGen/CgStackery.lhs index 6683de4c8b..532127a147 100644 --- a/compiler/codeGen/CgStackery.lhs +++ b/compiler/codeGen/CgStackery.lhs @@ -17,7 +17,7 @@ module CgStackery ( setStackFrame, getStackFrame, mkVirtStkOffsets, mkStkAmodes, freeStackSlots, - pushUpdateFrame, emitPushUpdateFrame, + pushUpdateFrame, pushBHUpdateFrame, emitPushUpdateFrame, ) where #include "HsVersions.h" @@ -265,6 +265,14 @@ to reflect the frame pushed. \begin{code} pushUpdateFrame :: CmmExpr -> Code -> Code pushUpdateFrame updatee code + = pushSpecUpdateFrame mkUpdInfoLabel updatee code + +pushBHUpdateFrame :: CmmExpr -> Code -> Code +pushBHUpdateFrame updatee code + = pushSpecUpdateFrame mkBHUpdInfoLabel updatee code + +pushSpecUpdateFrame :: CLabel -> CmmExpr -> Code -> Code +pushSpecUpdateFrame lbl updatee code = do { when debugIsOn $ do { EndOfBlockInfo _ sequel <- getEndOfBlockInfo ; @@ -277,15 +285,25 @@ pushUpdateFrame updatee code -- The location of the lowest-address -- word of the update frame itself - ; setEndOfBlockInfo (EndOfBlockInfo vsp UpdateCode) $ - do { emitPushUpdateFrame frame_addr updatee + -- NB. we used to set the Sequel to 'UpdateCode' so + -- that we could jump directly to the update code if + -- we know that the next frame on the stack is an + -- update frame. However, the RTS can sometimes + -- change an update frame into something else (see + -- e.g. Note [upd-black-hole] in rts/sm/Scav.c), so we + -- no longer make this assumption. + ; setEndOfBlockInfo (EndOfBlockInfo vsp OnStack) $ + do { emitSpecPushUpdateFrame lbl frame_addr updatee ; code } } emitPushUpdateFrame :: CmmExpr -> CmmExpr -> Code -emitPushUpdateFrame frame_addr updatee = do +emitPushUpdateFrame = emitSpecPushUpdateFrame mkUpdInfoLabel + +emitSpecPushUpdateFrame :: CLabel -> CmmExpr -> CmmExpr -> Code +emitSpecPushUpdateFrame lbl frame_addr updatee = do stmtsC [ -- Set the info word - CmmStore frame_addr (mkLblExpr mkUpdInfoLabel) + CmmStore frame_addr (mkLblExpr lbl) , -- And the updatee CmmStore (cmmOffsetB frame_addr off_updatee) updatee ] initUpdFrameProf frame_addr |