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 branches found
No related tags found
No related merge requests found
...@@ -99,7 +99,6 @@ allocDynClosureCmm mb_id info_tbl lf_info use_cc _blame_cc amodes_w_offsets = do ...@@ -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 -- SAY WHAT WE ARE ABOUT TO DO
let rep = cit_rep info_tbl let rep = cit_rep info_tbl
tickyDynAlloc mb_id rep lf_info tickyDynAlloc mb_id rep lf_info
profDynAlloc rep use_cc
let info_ptr = CmmLit (CmmLabel (cit_lbl info_tbl)) let info_ptr = CmmLit (CmmLabel (cit_lbl info_tbl))
allocHeapClosure rep info_ptr use_cc amodes_w_offsets allocHeapClosure rep info_ptr use_cc amodes_w_offsets
...@@ -112,6 +111,8 @@ allocHeapClosure ...@@ -112,6 +111,8 @@ allocHeapClosure
-> [(CmmExpr,ByteOff)] -- ^ payload -> [(CmmExpr,ByteOff)] -- ^ payload
-> FCode CmmExpr -- ^ returns the address of the object -> FCode CmmExpr -- ^ returns the address of the object
allocHeapClosure rep info_ptr use_cc payload = do allocHeapClosure rep info_ptr use_cc payload = do
profDynAlloc rep use_cc
virt_hp <- getVirtHp virt_hp <- getVirtHp
-- Find the offset of the info-ptr word -- Find the offset of the info-ptr word
...@@ -122,7 +123,7 @@ allocHeapClosure rep info_ptr use_cc payload = do ...@@ -122,7 +123,7 @@ allocHeapClosure rep info_ptr use_cc payload = do
-- ie 1 *before* the info-ptr word of new object. -- ie 1 *before* the info-ptr word of new object.
base <- getHpRelOffset info_offset base <- getHpRelOffset info_offset
emitComment $ mkFastString "allocDynClosure" emitComment $ mkFastString "allocHeapClosure"
emitSetDynHdr base info_ptr use_cc emitSetDynHdr base info_ptr use_cc
-- Fill in the fields -- Fill in the fields
......
...@@ -1535,14 +1535,14 @@ doNewArrayOp res_r n init = do ...@@ -1535,14 +1535,14 @@ doNewArrayOp res_r n init = do
dflags <- getDynFlags dflags <- getDynFlags
let info_ptr = mkLblExpr mkMAP_DIRTY_infoLabel 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)) tickyAllocPrim (mkIntExpr dflags (arrPtrsHdrSize dflags))
(mkIntExpr dflags (fromInteger n * wORD_SIZE dflags)) (mkIntExpr dflags (wordsToBytes dflags (heapClosureSizeW dflags rep)))
(zeroExpr dflags) (zeroExpr dflags)
let rep = arrPtrsRep dflags (fromIntegral n) let hdr_size = wordsToBytes dflags (fixedHdrSize dflags)
hdr_size = fixedHdrSize dflags * wORD_SIZE dflags
base <- allocHeapClosure rep info_ptr curCCS base <- allocHeapClosure rep info_ptr curCCS
[ (mkIntExpr dflags (fromInteger n), [ (mkIntExpr dflags (fromInteger n),
hdr_size + oFFSET_StgMutArrPtrs_ptrs dflags) hdr_size + oFFSET_StgMutArrPtrs_ptrs dflags)
...@@ -1563,7 +1563,8 @@ doNewArrayOp res_r n init = do ...@@ -1563,7 +1563,8 @@ doNewArrayOp res_r n init = do
, mkBranch for ] , mkBranch for ]
emit =<< mkCmmIfThen emit =<< mkCmmIfThen
(cmmULtWord dflags (CmmReg (CmmLocal p)) (cmmULtWord dflags (CmmReg (CmmLocal p))
(cmmOffsetW dflags (CmmReg arr) (fromInteger n))) (cmmOffsetW dflags (CmmReg arr)
(arrPtrsHdrSizeW dflags + fromInteger n)))
(catAGraphs loopBody) (catAGraphs loopBody)
emit $ mkAssign (CmmLocal res_r) (CmmReg arr) emit $ mkAssign (CmmLocal res_r) (CmmReg arr)
......
...@@ -485,7 +485,9 @@ tickyAllocHeap genuine hp ...@@ -485,7 +485,9 @@ tickyAllocHeap genuine hp
-- the units are bytes -- 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 tickyAllocPrim _hdr _goods _slop = ifTicky $ do
bumpTickyCounter (fsLit "ALLOC_PRIM_ctr") bumpTickyCounter (fsLit "ALLOC_PRIM_ctr")
bumpTickyCounterByE (fsLit "ALLOC_PRIM_adm") _hdr 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