diff --git a/compiler/codeGen/StgCmmHeap.hs b/compiler/codeGen/StgCmmHeap.hs index 2a0eaf9da7bdd956551fd921485af3a4688ab1a8..488a0e05bcdfc1448d8f9a8c87bfbe3c78416673 100644 --- a/compiler/codeGen/StgCmmHeap.hs +++ b/compiler/codeGen/StgCmmHeap.hs @@ -99,7 +99,6 @@ allocDynClosureCmm mb_id info_tbl lf_info use_cc _blame_cc amodes_w_offsets = do -- SAY WHAT WE ARE ABOUT TO DO let rep = cit_rep info_tbl tickyDynAlloc mb_id rep lf_info - profDynAlloc rep use_cc let info_ptr = CmmLit (CmmLabel (cit_lbl info_tbl)) allocHeapClosure rep info_ptr use_cc amodes_w_offsets @@ -112,6 +111,8 @@ allocHeapClosure -> [(CmmExpr,ByteOff)] -- ^ payload -> FCode CmmExpr -- ^ returns the address of the object allocHeapClosure rep info_ptr use_cc payload = do + profDynAlloc rep use_cc + virt_hp <- getVirtHp -- Find the offset of the info-ptr word @@ -122,7 +123,7 @@ allocHeapClosure rep info_ptr use_cc payload = do -- ie 1 *before* the info-ptr word of new object. base <- getHpRelOffset info_offset - emitComment $ mkFastString "allocDynClosure" + emitComment $ mkFastString "allocHeapClosure" emitSetDynHdr base info_ptr use_cc -- Fill in the fields diff --git a/compiler/codeGen/StgCmmPrim.hs b/compiler/codeGen/StgCmmPrim.hs index a4327c4064cda06467b218c3b32563b8542822fe..22f6ec103dddf32a84663d2a707fb2b016cace44 100644 --- a/compiler/codeGen/StgCmmPrim.hs +++ b/compiler/codeGen/StgCmmPrim.hs @@ -1535,14 +1535,14 @@ doNewArrayOp res_r n init = do dflags <- getDynFlags let info_ptr = mkLblExpr mkMAP_DIRTY_infoLabel + rep = arrPtrsRep dflags (fromIntegral n) - -- ToDo: this probably isn't right (card size?) tickyAllocPrim (mkIntExpr dflags (arrPtrsHdrSize dflags)) - (mkIntExpr dflags (fromInteger n * wORD_SIZE dflags)) + (mkIntExpr dflags (wordsToBytes dflags (heapClosureSizeW dflags rep))) (zeroExpr dflags) - let rep = arrPtrsRep dflags (fromIntegral n) - hdr_size = fixedHdrSize dflags * wORD_SIZE dflags + let hdr_size = wordsToBytes dflags (fixedHdrSize dflags) + base <- allocHeapClosure rep info_ptr curCCS [ (mkIntExpr dflags (fromInteger n), hdr_size + oFFSET_StgMutArrPtrs_ptrs dflags) @@ -1563,7 +1563,8 @@ doNewArrayOp res_r n init = do , mkBranch for ] emit =<< mkCmmIfThen (cmmULtWord dflags (CmmReg (CmmLocal p)) - (cmmOffsetW dflags (CmmReg arr) (fromInteger n))) + (cmmOffsetW dflags (CmmReg arr) + (arrPtrsHdrSizeW dflags + fromInteger n))) (catAGraphs loopBody) emit $ mkAssign (CmmLocal res_r) (CmmReg arr) diff --git a/compiler/codeGen/StgCmmTicky.hs b/compiler/codeGen/StgCmmTicky.hs index 50112f1ef8058239e945e6e8ac875aea3b0448c8..b1218201a678231e74fa19a47fbf94fb2a659892 100644 --- a/compiler/codeGen/StgCmmTicky.hs +++ b/compiler/codeGen/StgCmmTicky.hs @@ -485,7 +485,9 @@ tickyAllocHeap genuine hp -- the units are bytes -tickyAllocPrim :: CmmExpr -> CmmExpr -> CmmExpr -> FCode () +tickyAllocPrim :: CmmExpr -- ^ size of the full header, in bytes + -> CmmExpr -- ^ size of the payload, in bytes + -> CmmExpr -> FCode () tickyAllocPrim _hdr _goods _slop = ifTicky $ do bumpTickyCounter (fsLit "ALLOC_PRIM_ctr") bumpTickyCounterByE (fsLit "ALLOC_PRIM_adm") _hdr