diff options
Diffstat (limited to 'compiler/codeGen')
| -rw-r--r-- | compiler/codeGen/StgCmmBind.hs | 23 | ||||
| -rw-r--r-- | compiler/codeGen/StgCmmHeap.hs | 26 |
2 files changed, 33 insertions, 16 deletions
diff --git a/compiler/codeGen/StgCmmBind.hs b/compiler/codeGen/StgCmmBind.hs index 55307216c3..e40c660fdb 100644 --- a/compiler/codeGen/StgCmmBind.hs +++ b/compiler/codeGen/StgCmmBind.hs @@ -578,7 +578,7 @@ setupUpdate closure_info node body ; if closureUpdReqd closure_info then do -- Blackhole the (updatable) CAF: { upd_closure <- link_caf True - ; pushUpdateFrame [CmmReg (CmmLocal upd_closure), + ; pushUpdateFrame [upd_closure, mkLblExpr mkBHUpdInfoLabel] body } else do {tickyUpdateFrameOmitted; body} } @@ -633,8 +633,8 @@ pushUpdateFrame es body -- be closer together, and the compiler wouldn't need to know -- about off_indirectee etc. -link_caf :: Bool -- True <=> updatable, False <=> single-entry - -> FCode LocalReg -- Returns amode for closure to be updated +link_caf :: Bool -- True <=> updatable, False <=> single-entry + -> FCode CmmExpr -- Returns amode for closure to be updated -- To update a CAF we must allocate a black hole, link the CAF onto the -- CAF list, then update the CAF to point to the fresh black hole. -- This function returns the address of the black hole, so it can be @@ -648,19 +648,24 @@ link_caf _is_upd = do blame_cc = use_cc tso = CmmReg (CmmGlobal CurrentTSO) - ; (hp_rel, init) <- allocDynClosureCmm cafBlackHoleInfoTable mkLFBlackHole + ; hp_rel <- allocDynClosureCmm cafBlackHoleInfoTable mkLFBlackHole use_cc blame_cc [(tso,fixedHdrSize dflags)] - ; emit init - - -- Call the RTS function newCAF to add the CAF to the CafList - -- so that the garbage collector can find them + -- small optimisation: we duplicate the hp_rel expression in + -- both the newCAF call and the value returned below. + -- If we instead used allocDynClosureReg which assigns it to a reg, + -- then the reg is live across the newCAF call and gets spilled, + -- which is stupid. Really we should have an optimisation pass to + -- fix this, but we don't yet. --SDM + + -- Call the RTS function newCAF to add the CAF to the CafList + -- so that the garbage collector can find them -- This must be done *before* the info table pointer is overwritten, -- because the old info table ptr is needed for reversion ; ret <- newTemp bWord ; emitRtsCallGen [(ret,NoHint)] rtsPackageId (fsLit "newCAF") [ (CmmReg (CmmGlobal BaseReg), AddrHint), (CmmReg nodeReg, AddrHint), - (CmmReg (CmmLocal hp_rel), AddrHint) ] + (hp_rel, AddrHint) ] (Just [node]) False -- node is live, so save it. diff --git a/compiler/codeGen/StgCmmHeap.hs b/compiler/codeGen/StgCmmHeap.hs index e177b72385..be4497aa5c 100644 --- a/compiler/codeGen/StgCmmHeap.hs +++ b/compiler/codeGen/StgCmmHeap.hs @@ -15,7 +15,8 @@ module StgCmmHeap ( mkVirtHeapOffsets, mkVirtConstrOffsets, mkStaticClosureFields, mkStaticClosure, - allocDynClosure, allocDynClosureCmm, emitSetDynHdr + allocDynClosure, allocDynClosureReg, allocDynClosureCmm, + emitSetDynHdr ) where #include "HsVersions.h" @@ -64,11 +65,16 @@ allocDynClosure -- No void args in here -> FCode (LocalReg, CmmAGraph) -allocDynClosureCmm +allocDynClosureReg :: CmmInfoTable -> LambdaFormInfo -> CmmExpr -> CmmExpr -> [(CmmExpr, VirtualHpOffset)] -> FCode (LocalReg, CmmAGraph) +allocDynClosureCmm + :: CmmInfoTable -> LambdaFormInfo -> CmmExpr -> CmmExpr + -> [(CmmExpr, VirtualHpOffset)] + -> FCode CmmExpr -- returns Hp+n + -- allocDynClosure allocates the thing in the heap, -- and modifies the virtual Hp to account for this. -- The second return value is the graph that sets the value of the @@ -89,10 +95,18 @@ allocDynClosureCmm allocDynClosure info_tbl lf_info use_cc _blame_cc args_w_offsets = do { let (args, offsets) = unzip args_w_offsets ; cmm_args <- mapM getArgAmode args -- No void args - ; allocDynClosureCmm info_tbl lf_info + ; allocDynClosureReg info_tbl lf_info use_cc _blame_cc (zip cmm_args offsets) } +allocDynClosureReg info_tbl lf_info use_cc _blame_cc amodes_w_offsets + = do { hp_rel <- allocDynClosureCmm info_tbl lf_info + use_cc _blame_cc amodes_w_offsets + + -- Note [Return a LocalReg] + ; getCodeR $ assignTemp hp_rel + } + allocDynClosureCmm info_tbl lf_info use_cc _blame_cc amodes_w_offsets = do { virt_hp <- getVirtHp @@ -121,10 +135,8 @@ allocDynClosureCmm info_tbl lf_info use_cc _blame_cc amodes_w_offsets ; dflags <- getDynFlags ; setVirtHp (virt_hp + heapClosureSize dflags rep) - -- Assign to a temporary and return - -- Note [Return a LocalReg] - ; hp_rel <- getHpRelOffset info_offset - ; getCodeR $ assignTemp hp_rel } + ; getHpRelOffset info_offset + } emitSetDynHdr :: CmmExpr -> CmmExpr -> CmmExpr -> FCode () emitSetDynHdr base info_ptr ccs |