Skip to content
Snippets Groups Projects
Commit c1d74ab9 authored by tibbe's avatar tibbe
Browse files

Fix incorrect loop condition in inline array allocation

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