summaryrefslogtreecommitdiff
path: root/compiler
diff options
context:
space:
mode:
authorJohan Tibell <johan.tibell@gmail.com>2014-03-12 07:20:19 +0100
committerJohan Tibell <johan.tibell@gmail.com>2014-03-14 00:01:28 +0100
commit210ccabc9489bfbf814939e8b45646c8d0c7ce5f (patch)
tree3ce5e2af9f13639fc1b0c202ec7f9ee80fe7bee8 /compiler
parentcbdd83288bc3d3d2f07eadf800e9f2b27916c168 (diff)
downloadhaskell-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.hs5
-rw-r--r--compiler/cmm/SMRep.lhs24
-rw-r--r--compiler/codeGen/StgCmmPrim.hs49
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
View Lorry Controller Status