diff options
author | Johan Tibell <johan.tibell@gmail.com> | 2014-03-12 07:20:19 +0100 |
---|---|---|
committer | Johan Tibell <johan.tibell@gmail.com> | 2014-03-14 00:01:28 +0100 |
commit | 210ccabc9489bfbf814939e8b45646c8d0c7ce5f (patch) | |
tree | 3ce5e2af9f13639fc1b0c202ec7f9ee80fe7bee8 /compiler | |
parent | cbdd83288bc3d3d2f07eadf800e9f2b27916c168 (diff) | |
download | haskell-210ccabc9489bfbf814939e8b45646c8d0c7ce5f.tar.gz |
codeGen: allocate small byte arrays of statically known size inline
This results in a 57% runtime decrease when allocating an array of 128
bytes on a 64-bit machine.
Fixes #8876.
Diffstat (limited to 'compiler')
-rw-r--r-- | compiler/cmm/CLabel.hs | 5 | ||||
-rw-r--r-- | compiler/cmm/SMRep.lhs | 24 | ||||
-rw-r--r-- | compiler/codeGen/StgCmmPrim.hs | 49 |
3 files changed, 65 insertions, 13 deletions
diff --git a/compiler/cmm/CLabel.hs b/compiler/cmm/CLabel.hs index 1b86f3d6b4..022792f1f4 100644 --- a/compiler/cmm/CLabel.hs +++ b/compiler/cmm/CLabel.hs @@ -56,6 +56,7 @@ module CLabel ( mkMAP_FROZEN_infoLabel, mkMAP_DIRTY_infoLabel, mkEMPTY_MVAR_infoLabel, + mkArrWords_infoLabel, mkTopTickyCtrLabel, mkCAFBlackHoleInfoTableLabel, @@ -402,7 +403,8 @@ mkDirty_MUT_VAR_Label, mkSplitMarkerLabel, mkUpdInfoLabel, mkBHUpdInfoLabel, mkIndStaticInfoLabel, mkMainCapabilityLabel, mkMAP_FROZEN_infoLabel, mkMAP_DIRTY_infoLabel, mkEMPTY_MVAR_infoLabel, mkTopTickyCtrLabel, - mkCAFBlackHoleInfoTableLabel, mkCAFBlackHoleEntryLabel :: CLabel + mkCAFBlackHoleInfoTableLabel, mkCAFBlackHoleEntryLabel, + mkArrWords_infoLabel :: CLabel mkDirty_MUT_VAR_Label = mkForeignLabel (fsLit "dirty_MUT_VAR") Nothing ForeignLabelInExternalPackage IsFunction mkSplitMarkerLabel = CmmLabel rtsPackageId (fsLit "__stg_split_marker") CmmCode mkUpdInfoLabel = CmmLabel rtsPackageId (fsLit "stg_upd_frame") CmmInfo @@ -415,6 +417,7 @@ mkEMPTY_MVAR_infoLabel = CmmLabel rtsPackageId (fsLit "stg_EMPTY_MVAR") mkTopTickyCtrLabel = CmmLabel rtsPackageId (fsLit "top_ct") CmmData mkCAFBlackHoleInfoTableLabel = CmmLabel rtsPackageId (fsLit "stg_CAF_BLACKHOLE") CmmInfo mkCAFBlackHoleEntryLabel = CmmLabel rtsPackageId (fsLit "stg_CAF_BLACKHOLE") CmmEntry +mkArrWords_infoLabel = CmmLabel rtsPackageId (fsLit "stg_ARR_WORDS") CmmInfo ----- mkCmmInfoLabel, mkCmmEntryLabel, mkCmmRetInfoLabel, mkCmmRetLabel, diff --git a/compiler/cmm/SMRep.lhs b/compiler/cmm/SMRep.lhs index 7fb0a2b4f5..a5a8c903c6 100644 --- a/compiler/cmm/SMRep.lhs +++ b/compiler/cmm/SMRep.lhs @@ -26,6 +26,7 @@ module SMRep ( -- ** Construction mkHeapRep, blackHoleRep, indStaticRep, mkStackRep, mkRTSRep, arrPtrsRep, + arrWordsRep, -- ** Predicates isStaticRep, isConRep, isThunkRep, isFunRep, isStaticNoCafCon, @@ -33,8 +34,8 @@ module SMRep ( -- ** Size-related things heapClosureSizeW, - fixedHdrSize, arrWordsHdrSize, arrPtrsHdrSize, arrPtrsHdrSizeW, - profHdrSize, thunkHdrSize, nonHdrSizeW, + fixedHdrSize, arrWordsHdrSize, arrWordsHdrSizeW, arrPtrsHdrSize, + arrPtrsHdrSizeW, profHdrSize, thunkHdrSize, nonHdrSize, nonHdrSizeW, -- ** RTS closure types rtsClosureType, rET_SMALL, rET_BIG, @@ -157,6 +158,9 @@ data SMRep !WordOff -- # ptr words !WordOff -- # card table words + | ArrayWordsRep + !WordOff -- # bytes expressed in words, rounded up + | StackRep -- Stack frame (RET_SMALL or RET_BIG) Liveness @@ -241,6 +245,9 @@ indStaticRep = HeapRep True 1 0 IndStatic arrPtrsRep :: DynFlags -> WordOff -> SMRep arrPtrsRep dflags elems = ArrayPtrsRep elems (cardTableSizeW dflags elems) +arrWordsRep :: DynFlags -> ByteOff -> SMRep +arrWordsRep dflags bytes = ArrayWordsRep (bytesToWordsRoundUp dflags bytes) + ----------------------------------------------------------------------------- -- Predicates @@ -299,6 +306,11 @@ arrWordsHdrSize :: DynFlags -> ByteOff arrWordsHdrSize dflags = fixedHdrSize dflags * wORD_SIZE dflags + sIZEOF_StgArrWords_NoHdr dflags +arrWordsHdrSizeW :: DynFlags -> WordOff +arrWordsHdrSizeW dflags = + fixedHdrSize dflags + + (sIZEOF_StgArrWords_NoHdr dflags `quot` wORD_SIZE dflags) + arrPtrsHdrSize :: DynFlags -> ByteOff arrPtrsHdrSize dflags = fixedHdrSize dflags * wORD_SIZE dflags + sIZEOF_StgMutArrPtrs_NoHdr dflags @@ -314,18 +326,24 @@ thunkHdrSize :: DynFlags -> WordOff thunkHdrSize dflags = fixedHdrSize dflags + smp_hdr where smp_hdr = sIZEOF_StgSMPThunkHeader dflags `quot` wORD_SIZE dflags +nonHdrSize :: DynFlags -> SMRep -> ByteOff +nonHdrSize dflags rep = wordsToBytes dflags (nonHdrSizeW rep) nonHdrSizeW :: SMRep -> WordOff nonHdrSizeW (HeapRep _ p np _) = p + np nonHdrSizeW (ArrayPtrsRep elems ct) = elems + ct +nonHdrSizeW (ArrayWordsRep words) = words nonHdrSizeW (StackRep bs) = length bs nonHdrSizeW (RTSRep _ rep) = nonHdrSizeW rep +-- | The total size of the closure, in words. heapClosureSizeW :: DynFlags -> SMRep -> WordOff heapClosureSizeW dflags (HeapRep _ p np ty) = closureTypeHdrSize dflags ty + p + np heapClosureSizeW dflags (ArrayPtrsRep elems ct) = arrPtrsHdrSizeW dflags + elems + ct +heapClosureSizeW dflags (ArrayWordsRep words) + = arrWordsHdrSizeW dflags + words heapClosureSizeW _ _ = panic "SMRep.heapClosureSize" closureTypeHdrSize :: DynFlags -> ClosureTypeInfo -> WordOff @@ -454,6 +472,8 @@ instance Outputable SMRep where ppr (ArrayPtrsRep size _) = ptext (sLit "ArrayPtrsRep") <+> ppr size + ppr (ArrayWordsRep words) = ptext (sLit "ArrayWordsRep") <+> ppr words + ppr (StackRep bs) = ptext (sLit "StackRep") <+> ppr bs ppr (RTSRep ty rep) = ptext (sLit "tag:") <> ppr ty <+> ppr rep diff --git a/compiler/codeGen/StgCmmPrim.hs b/compiler/codeGen/StgCmmPrim.hs index 22f6ec103d..28d50c1094 100644 --- a/compiler/codeGen/StgCmmPrim.hs +++ b/compiler/codeGen/StgCmmPrim.hs @@ -132,9 +132,12 @@ shouldInlinePrimOp :: DynFlags -> PrimOp -- ^ The primop -> [CmmExpr] -- ^ The primop arguments -> Maybe ([LocalReg] -> FCode ()) +shouldInlinePrimOp _ NewByteArrayOp_Char [(CmmLit (CmmInt n _))] + | fromInteger n <= maxInlineAllocThreshold = + Just $ \ [res] -> doNewByteArrayOp res (fromInteger n) shouldInlinePrimOp dflags NewArrayOp [(CmmLit (CmmInt n _)), init] - | n <= maxInlineAllocThreshold dflags = - Just $ \ [res] -> doNewArrayOp res n init + | wordsToBytes dflags (fromInteger n) <= maxInlineAllocThreshold = + Just $ \ [res] -> doNewArrayOp res (fromInteger n) init shouldInlinePrimOp dflags primop args | primOpOutOfLine primop = Nothing | otherwise = Just $ \ regs -> emitPrimOp dflags regs primop args @@ -1437,6 +1440,32 @@ mkBasicPrefetch locality off res base idx _ -> panic "StgCmmPrim: mkBasicPrefetch" -- ---------------------------------------------------------------------------- +-- Allocating byte arrays + +-- | Takes a register to return the newly allocated array in and the +-- size of the new array in bytes. Allocates a new +-- 'MutableByteArray#'. +doNewByteArrayOp :: CmmFormal -> ByteOff -> FCode () +doNewByteArrayOp res_r n = do + dflags <- getDynFlags + + let info_ptr = mkLblExpr mkArrWords_infoLabel + rep = arrWordsRep dflags n + + tickyAllocPrim (mkIntExpr dflags (arrWordsHdrSize dflags)) + (mkIntExpr dflags (nonHdrSize dflags rep)) + (zeroExpr dflags) + + let hdr_size = wordsToBytes dflags (fixedHdrSize dflags) + + base <- allocHeapClosure rep info_ptr curCCS + [ (mkIntExpr dflags n, + hdr_size + oFFSET_StgArrWords_bytes dflags) + ] + + emit $ mkAssign (CmmLocal res_r) base + +-- ---------------------------------------------------------------------------- -- Copying byte arrays -- | Takes a source 'ByteArray#', an offset in the source array, a @@ -1530,21 +1559,21 @@ doSetByteArrayOp ba off len c -- | Takes a register to return the newly allocated array in, the size -- of the new array, and an initial value for the elements. Allocates -- a new 'MutableArray#'. -doNewArrayOp :: CmmFormal -> Integer -> CmmExpr -> FCode () +doNewArrayOp :: CmmFormal -> WordOff -> CmmExpr -> FCode () doNewArrayOp res_r n init = do dflags <- getDynFlags let info_ptr = mkLblExpr mkMAP_DIRTY_infoLabel - rep = arrPtrsRep dflags (fromIntegral n) + rep = arrPtrsRep dflags n tickyAllocPrim (mkIntExpr dflags (arrPtrsHdrSize dflags)) - (mkIntExpr dflags (wordsToBytes dflags (heapClosureSizeW dflags rep))) + (mkIntExpr dflags (nonHdrSize dflags rep)) (zeroExpr dflags) let hdr_size = wordsToBytes dflags (fixedHdrSize dflags) base <- allocHeapClosure rep info_ptr curCCS - [ (mkIntExpr dflags (fromInteger n), + [ (mkIntExpr dflags n, hdr_size + oFFSET_StgMutArrPtrs_ptrs dflags) , (mkIntExpr dflags (nonHdrSizeW rep), hdr_size + oFFSET_StgMutArrPtrs_size dflags) @@ -1564,14 +1593,14 @@ doNewArrayOp res_r n init = do emit =<< mkCmmIfThen (cmmULtWord dflags (CmmReg (CmmLocal p)) (cmmOffsetW dflags (CmmReg arr) - (arrPtrsHdrSizeW dflags + fromInteger n))) + (arrPtrsHdrSizeW dflags + n))) (catAGraphs loopBody) emit $ mkAssign (CmmLocal res_r) (CmmReg arr) --- | The inline allocation limit is 128 bytes, expressed in words. -maxInlineAllocThreshold :: DynFlags -> Integer -maxInlineAllocThreshold dflags = toInteger (128 `quot` wORD_SIZE dflags) +-- | The inline allocation limit is 128 bytes. +maxInlineAllocThreshold :: ByteOff +maxInlineAllocThreshold = 128 -- ---------------------------------------------------------------------------- -- Copying pointer arrays |