Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Another check point

  • Loading branch information...
commit 90c542dbf5e5477dfed1642e7cc39d43df7be34f 1 parent 28b1972
@tibbe authored
Showing with 148 additions and 82 deletions.
  1. +148 −82 compiler/codeGen/StgCmmPrim.hs
View
230 compiler/codeGen/StgCmmPrim.hs
@@ -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]
@@ -1496,6 +1501,143 @@ doSetByteArrayOp ba off len c
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
-- EZY: This code has an unusually high amount of assignTemp calls, seen
@@ -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
@@ -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
@@ -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 ()
Please sign in to comment.
Something went wrong with that request. Please try again.