From 90c542dbf5e5477dfed1642e7cc39d43df7be34f Mon Sep 17 00:00:00 2001 From: Johan Tibell Date: Fri, 7 Mar 2014 09:10:31 +0100 Subject: [PATCH] Another check point --- compiler/codeGen/StgCmmPrim.hs | 230 +++++++++++++++++++++------------ 1 file changed, 148 insertions(+), 82 deletions(-) diff --git a/compiler/codeGen/StgCmmPrim.hs b/compiler/codeGen/StgCmmPrim.hs index 30887e4fd0b..706012e9408 100644 --- a/compiler/codeGen/StgCmmPrim.hs +++ b/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] @@ -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 @@ -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 ()