Commit c1d74ab9 authored by tibbe's avatar tibbe

Fix incorrect loop condition in inline array allocation

Also make sure allocHeapClosure updates profiling counters with the
memory allocated.
parent b684f27e
......@@ -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
......
......@@ -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)
......
......@@ -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
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment