Skip to content

Commit

Permalink
Another check point
Browse files Browse the repository at this point in the history
  • Loading branch information
@tibbe
tibbe committed Mar 7, 2014
1 parent 28b1972 commit 90c542d
Showing 1 changed file with 148 additions and 82 deletions.
230 changes: 148 additions & 82 deletions compiler/codeGen/StgCmmPrim.hs
View file
Expand Up @@ -240,6 +240,11 @@ emitPrimOp dflags [] WriteMutVarOp [mutv,var]
(CmmLit (CmmLabel mkDirty_MUT_VAR_Label))
[(CmmReg (CmmGlobal BaseReg), AddrHint), (mutv,AddrHint)]

-- Inline if size is small and statically know, otherwise fall through
-- to general (i.e. out-of-line) case.
emitPrimOp dflags [res] NewArrayOp [(CmmLit (CmmInt n _))]
| n <= inlineAllocLimit dflags = doNewArrayOp dflags res n

-- #define sizzeofByteArrayzh(r,a) \
-- r = ((StgArrWords *)(a))->bytes
emitPrimOp dflags [res] SizeofByteArrayOp [arg]
Expand Down Expand Up @@ -1495,6 +1500,143 @@ doSetByteArrayOp ba off len c
p <- assignTempE $ cmmOffsetExpr dflags (cmmOffsetB dflags ba (arrWordsHdrSize dflags)) off
emitMemsetCall p c len (mkIntExpr dflags 1)

-- ----------------------------------------------------------------------------
-- Allocating arrays

doNewArrayOp :: DynFlags -> CmmFormal -> Integer -> FCode ()
doNewArrayOp dflags res_r n = do
tickyAllocPrim (mkIntExpr dflags (arrPtrsHdrSize dflags))
(cmmMulWord dflags (mkIntExpr dflags (fromInteger n)) (wordSize dflags))
(zeroExpr dflags)

-- If the allocation is of small, statically-known size, we reuse
-- the existing heap check to allocate inline.
virt_hp <- getVirtHp

let card_bytes = cardRoundUp dflags (fromIntegral n)
size = fromIntegral n + bytesToWordsRoundUp dflags card_bytes
words = arrPtrsHdrSizeWords dflags + size

-- FIND THE OFFSET OF THE INFO-PTR WORD
let info_offset = virt_hp + 1
-- info_offset is the VirtualHpOffset of the first
-- word of the new object
-- Remember, virtHp points to last allocated word,
-- ie 1 *before* the info-ptr word of new object.

info_ptr = mkLblExpr mkMAP_DIRTY_infoLabel

base <- getHpRelOffset info_offset
hpStoreArrayHdr base (mkIntExpr dflags (fromInteger n))
(mkIntExpr dflags size)
info_ptr

setVirtHp (virt_hp + fromIntegral words) -- check n < big

arr_r <- newTemp (bWord dflags)
emit $ mkAssign (CmmLocal arr_r) base
let arr = CmmLocal arr_r

dst_p <- assignTempE $ cmmOffsetB dflags (CmmReg arr)
(arrPtrsHdrSize dflags)

-- Initialise all elements of the the array
-- TODO: Continue here

-- Initialise the mark bits with 0
emitMemsetCall (cmmOffsetExprW dflags dst_p (mkIntExpr dflags (fromInteger n)))
(mkIntExpr dflags 1)
(mkIntExpr dflags card_bytes)
(mkIntExpr dflags (wORD_SIZE dflags))
emit $ mkAssign (CmmLocal res_r) (CmmReg arr)

-- | The inline allocation limit is 128 bytes, expressed in words.
inlineAllocLimit :: DynFlags -> Integer
inlineAllocLimit dflags = toInteger (128 `quot` wORD_SIZE dflags)

-- | Takes an info table label, a register to return the newly
-- allocated array in, the size of the array. Allocates a new array
-- and initializes it using the provided function.
emitNewArrayWith :: (CmmExpr -> CmmReg -> CmmExpr -> FCode ())
-> CLabel -> CmmFormal -> CmmExpr -> FCode ()
emitNewArrayWith init info_p res_r n = do
dflags <- getDynFlags

tickyAllocPrim (mkIntExpr dflags (arrPtrsHdrSize dflags))
(cmmMulWord dflags n (wordSize dflags))
(zeroExpr dflags)

-- Allocate array
(arr, card_bytes, words) <- emitNewUninitializedArray dflags info_p n

dst_p <- assignTempE $ cmmOffsetB dflags (CmmReg arr)
(arrPtrsHdrSize dflags)

-- Initialise all elements of the the array
init dst_p arr words

-- Initialise the mark bits with 0
emitMemsetCall (cmmOffsetExprW dflags dst_p n)
(mkIntExpr dflags 1)
card_bytes
(mkIntExpr dflags (wORD_SIZE dflags))
emit $ mkAssign (CmmLocal res_r) (CmmReg arr)

-- | Takes an info table label and the size of the array. Allocates a
-- new array and returns the temp register it resides in, the
-- number of bytes in the card table, and the number of words used to
-- store the whole closure.
emitNewUninitializedArray :: DynFlags
-> CLabel -- ^ Array info table label
-> CmmExpr -- ^ Size
-> FCode (CmmReg, CmmExpr, CmmExpr)
emitNewUninitializedArray dflags info_p (CmmLit (CmmInt n _))
| n <= inlineAllocLimit dflags = do
-- If the allocation is of small, statically-known size, we reuse
-- the existing heap check to allocate inline.
virt_hp <- getVirtHp

let card_bytes = cardRoundUp dflags (fromIntegral n)
size = fromIntegral n + bytesToWordsRoundUp dflags card_bytes
words = arrPtrsHdrSizeWords dflags + size

-- FIND THE OFFSET OF THE INFO-PTR WORD
let info_offset = virt_hp + 1
-- info_offset is the VirtualHpOffset of the first
-- word of the new object
-- Remember, virtHp points to last allocated word,
-- ie 1 *before* the info-ptr word of new object.

info_ptr = mkLblExpr info_p

base <- getHpRelOffset info_offset
hpStoreArrayHdr base (mkIntExpr dflags (fromInteger n))
(mkIntExpr dflags size)
info_ptr

setVirtHp (virt_hp + fromIntegral words) -- check n < big

arr_r <- newTemp (bWord dflags)
emit $ mkAssign (CmmLocal arr_r) base
return (CmmLocal arr_r, mkIntExpr dflags card_bytes,
mkIntExpr dflags words)
emitNewUninitializedArray dflags info_p n = do
-- TODO: Consider doing this case out-of-line.
card_bytes <- assignTempE $ cardRoundUpCmm dflags n
size <- assignTempE $ cmmAddWord dflags n
(bytesToWordsRoundUpCmm dflags card_bytes)
words <- assignTempE $ cmmAddWord dflags (arrPtrsHdrSizeW dflags) size
arr_r <- newTemp (bWord dflags)
emitAllocateCall arr_r (myCapability dflags) words
let info_ptr = mkLblExpr info_p
hpStoreArrayHdr
(CmmReg $ CmmLocal arr_r) n size info_ptr
return (CmmLocal arr_r, card_bytes, words)

myCapability :: DynFlags -> CmmExpr
myCapability dflags = cmmSubWord dflags (CmmReg baseReg)
(mkIntExpr dflags (oFFSET_Capability_r dflags))

-- ----------------------------------------------------------------------------
-- Copying pointer arrays

Expand Down Expand Up @@ -1575,12 +1717,14 @@ emitCopyArray copy src0 src_off0 dst0 dst_off0 n0 = do

emitSetCards dst_off dst_cards_p n

-- TODO: Figure out if this branch is really neccesary.
emit =<< mkCmmIfThen (cmmNeWord dflags n (mkIntExpr dflags 0)) nonzero

-- | Takes an info table label, a register to return the newly
-- allocated array in, a source array, an offset in the source array,
-- and the number of elements to copy. Allocates a new array and
-- initializes it from the source array.
emitCloneArray :: CLabel -> CmmFormal -> CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
emitCloneArray info_p res_r src0 src_off0 n0 = do
dflags <- getDynFlags

Expand All @@ -1589,7 +1733,7 @@ emitCloneArray info_p res_r src0 src_off0 n0 = do
src_off <- assignTempE src_off0
n <- assignTempE n0

let init dst_p = do
let init dst_p _ _ = do
src_p <- assignTempE $ cmmOffsetExprW dflags
(cmmOffsetB dflags src (arrPtrsHdrSize dflags))
src_off
Expand All @@ -1599,89 +1743,11 @@ emitCloneArray info_p res_r src0 src_off0 n0 = do

emitNewArrayWith init info_p res_r n

-- | Takes an info table label and the size of the array. Allocates a
-- new array and returns the temp register it resides in, the number
-- of bytes in the card table, the size of the the closure excluding
-- the header (?), and the number of words taken by the whole closure.
emitNewUninitializedArray :: CLabel
-> CmmExpr
-> FCode (CmmReg, CmmExpr, CmmExpr, CmmExpr)
emitNewUninitializedArray info_p (CmmLit (CmmInt n _)) | n <= inlineAllocLimit = do
dflags <- getDynFlags
virt_hp <- getVirtHp

let card_bytes = cardRoundUp dflags (fromIntegral n)
size = fromIntegral n + bytesToWordsRoundUp dflags card_bytes
words = arrPtrsHdrSizeWords dflags + size

-- FIND THE OFFSET OF THE INFO-PTR WORD
let info_offset = virt_hp + 1
-- info_offset is the VirtualHpOffset of the first
-- word of the new object
-- Remember, virtHp points to last allocated word,
-- ie 1 *before* the info-ptr word of new object.

info_ptr = mkLblExpr info_p

base <- getHpRelOffset info_offset
hpStoreArrayHdr base (mkIntExpr dflags (fromInteger n))
(mkIntExpr dflags size)
info_ptr

setVirtHp (virt_hp + fromIntegral words) -- check n < big

arr_r <- newTemp (bWord dflags)
emit $ mkAssign (CmmLocal arr_r) base
return (CmmLocal arr_r, mkIntExpr dflags card_bytes,
mkIntExpr dflags size, mkIntExpr dflags words)
where
inlineAllocLimit = 16 -- words
emitNewUninitializedArray info_p n = do
dflags <- getDynFlags
card_bytes <- assignTempE $ cardRoundUpCmm dflags n
size <- assignTempE $ cmmAddWord dflags n
(bytesToWordsRoundUpCmm dflags card_bytes)
words <- assignTempE $ cmmAddWord dflags (arrPtrsHdrSizeW dflags) size
arr_r <- newTemp (bWord dflags)
emitAllocateCall arr_r (myCapability dflags) words
let info_ptr = mkLblExpr info_p
hpStoreArrayHdr
(CmmReg $ CmmLocal arr_r) n size info_ptr
return (CmmLocal arr_r, card_bytes, size, words)

-- | Takes an info table label, a register to return the newly
-- allocated array in, the size of the array. Allocates a new array
-- and initializes it using the provided function.
emitNewArrayWith :: (CmmExpr -> FCode ()) -> CLabel -> CmmFormal -> CmmExpr -> FCode ()
emitNewArrayWith init info_p res_r n = do
dflags <- getDynFlags

tickyAllocPrim (mkIntExpr dflags (arrPtrsHdrSize dflags))
(cmmMulWord dflags n (wordSize dflags))
(zeroExpr dflags)

-- Allocate array
(arr, card_bytes, size, words) <- emitNewUninitializedArray info_p n

dst_p <- assignTempE $ cmmOffsetB dflags (CmmReg arr)
(arrPtrsHdrSize dflags)

-- Initialise all elements of the the array
init dst_p

-- Initialise the mark bits with 0
emitMemsetCall (cmmOffsetExprW dflags dst_p n)
(mkIntExpr dflags 1)
card_bytes
(mkIntExpr dflags (wORD_SIZE dflags))
emit $ mkAssign (CmmLocal res_r) (CmmReg arr)

myCapability :: DynFlags -> CmmExpr
myCapability dflags = cmmSubWord dflags (CmmReg baseReg)
(mkIntExpr dflags (oFFSET_Capability_r dflags))

arrPtrsHdrSizeWords :: DynFlags -> WordOff
arrPtrsHdrSizeWords dflags = fixedHdrSize dflags +
(sIZEOF_StgMutArrPtrs_NoHdr dflags `div` wORD_SIZE dflags)

arrPtrsHdrSizeW :: DynFlags -> CmmExpr
arrPtrsHdrSizeW dflags = mkIntExpr dflags (arrPtrsHdrSizeWords dflags)

hpStoreArrayHdr :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
Expand Down

0 comments on commit 90c542d

Please sign in to comment.