Commit 90329b6c authored by tibbe's avatar tibbe

Add SmallArray# and SmallMutableArray# types

These array types are smaller than Array# and MutableArray# and are
faster when the array size is small, as they don't have the overhead
of a card table. Having no card table reduces the closure size with 2
words in the typical small array case and leads to less work when
updating or GC:ing the array.

Reduces both the runtime and memory allocation by 8.8% on my insert
benchmark for the HashMap type in the unordered-containers package,
which makes use of lots of small arrays. With tuned GC settings
(i.e. `+RTS -A6M`) the runtime reduction is 15%.

Fixes #8923.
parent 4c8edfd2
......@@ -56,6 +56,9 @@ module CLabel (
mkMAP_FROZEN_infoLabel,
mkMAP_FROZEN0_infoLabel,
mkMAP_DIRTY_infoLabel,
mkSMAP_FROZEN_infoLabel,
mkSMAP_FROZEN0_infoLabel,
mkSMAP_DIRTY_infoLabel,
mkEMPTY_MVAR_infoLabel,
mkArrWords_infoLabel,
......@@ -405,7 +408,8 @@ mkDirty_MUT_VAR_Label, mkSplitMarkerLabel, mkUpdInfoLabel,
mkMAP_FROZEN_infoLabel, mkMAP_FROZEN0_infoLabel, mkMAP_DIRTY_infoLabel,
mkEMPTY_MVAR_infoLabel, mkTopTickyCtrLabel,
mkCAFBlackHoleInfoTableLabel, mkCAFBlackHoleEntryLabel,
mkArrWords_infoLabel :: CLabel
mkArrWords_infoLabel, mkSMAP_FROZEN_infoLabel, mkSMAP_FROZEN0_infoLabel,
mkSMAP_DIRTY_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
......@@ -420,6 +424,9 @@ mkTopTickyCtrLabel = CmmLabel rtsPackageId (fsLit "top_ct")
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
mkSMAP_FROZEN_infoLabel = CmmLabel rtsPackageId (fsLit "stg_SMALL_MUT_ARR_PTRS_FROZEN") CmmInfo
mkSMAP_FROZEN0_infoLabel = CmmLabel rtsPackageId (fsLit "stg_SMALL_MUT_ARR_PTRS_FROZEN0") CmmInfo
mkSMAP_DIRTY_infoLabel = CmmLabel rtsPackageId (fsLit "stg_SMALL_MUT_ARR_PTRS_DIRTY") CmmInfo
-----
mkCmmInfoLabel, mkCmmEntryLabel, mkCmmRetInfoLabel, mkCmmRetLabel,
......
......@@ -1334,7 +1334,7 @@ forkLabelledCode p = do
initEnv :: DynFlags -> Env
initEnv dflags = listToUFM [
( fsLit "SIZEOF_StgHeader",
VarN (CmmLit (CmmInt (fromIntegral (fixedHdrSize dflags * wORD_SIZE dflags)) (wordWidth dflags)) )),
VarN (CmmLit (CmmInt (fromIntegral (fixedHdrSize dflags)) (wordWidth dflags)) )),
( fsLit "SIZEOF_StgInfoTable",
VarN (CmmLit (CmmInt (fromIntegral (stdInfoTableSizeB dflags)) (wordWidth dflags)) ))
]
......
......@@ -26,7 +26,7 @@ module SMRep (
-- ** Construction
mkHeapRep, blackHoleRep, indStaticRep, mkStackRep, mkRTSRep, arrPtrsRep,
arrWordsRep,
smallArrPtrsRep, arrWordsRep,
-- ** Predicates
isStaticRep, isConRep, isThunkRep, isFunRep, isStaticNoCafCon,
......@@ -34,8 +34,10 @@ module SMRep (
-- ** Size-related things
heapClosureSizeW,
fixedHdrSize, arrWordsHdrSize, arrWordsHdrSizeW, arrPtrsHdrSize,
fixedHdrSizeW, arrWordsHdrSize, arrWordsHdrSizeW, arrPtrsHdrSize,
arrPtrsHdrSizeW, profHdrSize, thunkHdrSize, nonHdrSize, nonHdrSizeW,
smallArrPtrsHdrSize, smallArrPtrsHdrSizeW, hdrSize, hdrSizeW,
fixedHdrSize,
-- ** RTS closure types
rtsClosureType, rET_SMALL, rET_BIG,
......@@ -158,6 +160,9 @@ data SMRep
!WordOff -- # ptr words
!WordOff -- # card table words
| SmallArrayPtrsRep
!WordOff -- # ptr words
| ArrayWordsRep
!WordOff -- # bytes expressed in words, rounded up
......@@ -245,6 +250,9 @@ indStaticRep = HeapRep True 1 0 IndStatic
arrPtrsRep :: DynFlags -> WordOff -> SMRep
arrPtrsRep dflags elems = ArrayPtrsRep elems (cardTableSizeW dflags elems)
smallArrPtrsRep :: WordOff -> SMRep
smallArrPtrsRep elems = SmallArrayPtrsRep elems
arrWordsRep :: DynFlags -> ByteOff -> SMRep
arrWordsRep dflags bytes = ArrayWordsRep (bytesToWordsRoundUp dflags bytes)
......@@ -286,9 +294,12 @@ isStaticNoCafCon _ = False
-----------------------------------------------------------------------------
-- Size-related things
fixedHdrSize :: DynFlags -> ByteOff
fixedHdrSize dflags = wordsToBytes dflags (fixedHdrSizeW dflags)
-- | Size of a closure header (StgHeader in includes/rts/storage/Closures.h)
fixedHdrSize :: DynFlags -> WordOff
fixedHdrSize dflags = sTD_HDR_SIZE dflags + profHdrSize dflags
fixedHdrSizeW :: DynFlags -> WordOff
fixedHdrSizeW dflags = sTD_HDR_SIZE dflags + profHdrSize dflags
-- | Size of the profiling part of a closure header
-- (StgProfHeader in includes/rts/storage/Closures.h)
......@@ -300,38 +311,58 @@ profHdrSize dflags
-- | The garbage collector requires that every closure is at least as
-- big as this.
minClosureSize :: DynFlags -> WordOff
minClosureSize dflags = fixedHdrSize dflags + mIN_PAYLOAD_SIZE dflags
minClosureSize dflags = fixedHdrSizeW dflags + mIN_PAYLOAD_SIZE dflags
arrWordsHdrSize :: DynFlags -> ByteOff
arrWordsHdrSize dflags
= fixedHdrSize dflags * wORD_SIZE dflags + sIZEOF_StgArrWords_NoHdr dflags
= fixedHdrSize dflags + sIZEOF_StgArrWords_NoHdr dflags
arrWordsHdrSizeW :: DynFlags -> WordOff
arrWordsHdrSizeW dflags =
fixedHdrSize dflags +
fixedHdrSizeW dflags +
(sIZEOF_StgArrWords_NoHdr dflags `quot` wORD_SIZE dflags)
arrPtrsHdrSize :: DynFlags -> ByteOff
arrPtrsHdrSize dflags
= fixedHdrSize dflags * wORD_SIZE dflags + sIZEOF_StgMutArrPtrs_NoHdr dflags
= fixedHdrSize dflags + sIZEOF_StgMutArrPtrs_NoHdr dflags
arrPtrsHdrSizeW :: DynFlags -> WordOff
arrPtrsHdrSizeW dflags =
fixedHdrSize dflags +
fixedHdrSizeW dflags +
(sIZEOF_StgMutArrPtrs_NoHdr dflags `quot` wORD_SIZE dflags)
smallArrPtrsHdrSize :: DynFlags -> ByteOff
smallArrPtrsHdrSize dflags
= fixedHdrSize dflags + sIZEOF_StgSmallMutArrPtrs_NoHdr dflags
smallArrPtrsHdrSizeW :: DynFlags -> WordOff
smallArrPtrsHdrSizeW dflags =
fixedHdrSizeW dflags +
(sIZEOF_StgSmallMutArrPtrs_NoHdr dflags `quot` wORD_SIZE dflags)
-- Thunks have an extra header word on SMP, so the update doesn't
-- splat the payload.
thunkHdrSize :: DynFlags -> WordOff
thunkHdrSize dflags = fixedHdrSize dflags + smp_hdr
thunkHdrSize dflags = fixedHdrSizeW dflags + smp_hdr
where smp_hdr = sIZEOF_StgSMPThunkHeader dflags `quot` wORD_SIZE dflags
hdrSize :: DynFlags -> SMRep -> ByteOff
hdrSize dflags rep = wordsToBytes dflags (hdrSizeW dflags rep)
hdrSizeW :: DynFlags -> SMRep -> WordOff
hdrSizeW dflags (HeapRep _ _ _ ty) = closureTypeHdrSize dflags ty
hdrSizeW dflags (ArrayPtrsRep _ _) = arrPtrsHdrSizeW dflags
hdrSizeW dflags (SmallArrayPtrsRep _) = smallArrPtrsHdrSizeW dflags
hdrSizeW dflags (ArrayWordsRep _) = arrWordsHdrSizeW dflags
hdrSizeW _ _ = panic "SMRep.hdrSizeW"
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 (SmallArrayPtrsRep elems) = elems
nonHdrSizeW (ArrayWordsRep words) = words
nonHdrSizeW (StackRep bs) = length bs
nonHdrSizeW (RTSRep _ rep) = nonHdrSizeW rep
......@@ -342,6 +373,8 @@ heapClosureSizeW dflags (HeapRep _ p np ty)
= closureTypeHdrSize dflags ty + p + np
heapClosureSizeW dflags (ArrayPtrsRep elems ct)
= arrPtrsHdrSizeW dflags + elems + ct
heapClosureSizeW dflags (SmallArrayPtrsRep elems)
= smallArrPtrsHdrSizeW dflags + elems
heapClosureSizeW dflags (ArrayWordsRep words)
= arrWordsHdrSizeW dflags + words
heapClosureSizeW _ _ = panic "SMRep.heapClosureSize"
......@@ -352,7 +385,7 @@ closureTypeHdrSize dflags ty = case ty of
ThunkSelector{} -> thunkHdrSize dflags
BlackHole{} -> thunkHdrSize dflags
IndStatic{} -> thunkHdrSize dflags
_ -> fixedHdrSize dflags
_ -> fixedHdrSizeW dflags
-- All thunks use thunkHdrSize, even if they are non-updatable.
-- this is because we don't have separate closure types for
-- updatable vs. non-updatable thunks, so the GC can't tell the
......@@ -472,6 +505,8 @@ instance Outputable SMRep where
ppr (ArrayPtrsRep size _) = ptext (sLit "ArrayPtrsRep") <+> ppr size
ppr (SmallArrayPtrsRep size) = ptext (sLit "SmallArrayPtrsRep") <+> ppr size
ppr (ArrayWordsRep words) = ptext (sLit "ArrayWordsRep") <+> ppr words
ppr (StackRep bs) = ptext (sLit "StackRep") <+> ppr bs
......
......@@ -287,7 +287,7 @@ mkRhsClosure dflags bndr _cc _bi
maybe_offset = assocMaybe params_w_offsets (NonVoid selectee)
Just the_offset = maybe_offset
offset_into_int = bytesToWordsRoundUp dflags the_offset
- fixedHdrSize dflags
- fixedHdrSizeW dflags
---------- Note [Ap thunks] ------------------
mkRhsClosure dflags bndr _cc _bi
......@@ -621,7 +621,7 @@ emitBlackHoleCode node = do
-- work with profiling.
when eager_blackholing $ do
emitStore (cmmOffsetW dflags node (fixedHdrSize dflags))
emitStore (cmmOffsetW dflags node (fixedHdrSizeW dflags))
(CmmReg (CmmGlobal CurrentTSO))
emitPrimCall [] MO_WriteBarrier []
emitStore node (CmmReg (CmmGlobal EagerBlackholeInfo))
......@@ -673,7 +673,7 @@ pushUpdateFrame lbl updatee body
updfr <- getUpdFrameOff
dflags <- getDynFlags
let
hdr = fixedHdrSize dflags * wORD_SIZE dflags
hdr = fixedHdrSize dflags
frame = updfr + hdr + sIZEOF_StgUpdateFrame_NoHdr dflags
--
emitUpdateFrame dflags (CmmStackSlot Old frame) lbl updatee
......@@ -682,7 +682,7 @@ pushUpdateFrame lbl updatee body
emitUpdateFrame :: DynFlags -> CmmExpr -> CLabel -> CmmExpr -> FCode ()
emitUpdateFrame dflags frame lbl updatee = do
let
hdr = fixedHdrSize dflags * wORD_SIZE dflags
hdr = fixedHdrSize dflags
off_updatee = hdr + oFFSET_StgUpdateFrame_updatee dflags
--
emitStore frame (mkLblExpr lbl)
......
......@@ -190,7 +190,7 @@ buildDynCon' dflags platform binder _ _cc con [arg]
, val >= fromIntegral (mIN_INTLIKE dflags) -- ...ditto...
= do { let intlike_lbl = mkCmmClosureLabel rtsPackageId (fsLit "stg_INTLIKE")
val_int = fromIntegral val :: Int
offsetW = (val_int - mIN_INTLIKE dflags) * (fixedHdrSize dflags + 1)
offsetW = (val_int - mIN_INTLIKE dflags) * (fixedHdrSizeW dflags + 1)
-- INTLIKE closures consist of a header and one word payload
intlike_amode = cmmLabelOffW dflags intlike_lbl offsetW
; return ( litIdInfo dflags binder (mkConLFInfo con) intlike_amode
......@@ -204,7 +204,7 @@ buildDynCon' dflags platform binder _ _cc con [arg]
, val_int <= mAX_CHARLIKE dflags
, val_int >= mIN_CHARLIKE dflags
= do { let charlike_lbl = mkCmmClosureLabel rtsPackageId (fsLit "stg_CHARLIKE")
offsetW = (val_int - mIN_CHARLIKE dflags) * (fixedHdrSize dflags + 1)
offsetW = (val_int - mIN_CHARLIKE dflags) * (fixedHdrSizeW dflags + 1)
-- CHARLIKE closures consist of a header and one word payload
charlike_amode = cmmLabelOffW dflags charlike_lbl offsetW
; return ( litIdInfo dflags binder (mkConLFInfo con) charlike_amode
......
......@@ -358,7 +358,7 @@ stack_SP dflags = closureField dflags (oFFSET_StgStack_sp dflags)
closureField :: DynFlags -> ByteOff -> ByteOff
closureField dflags off = off + fixedHdrSize dflags * wORD_SIZE dflags
closureField dflags off = off + fixedHdrSize dflags
stgSp, stgHp, stgCurrentTSO, stgCurrentNursery :: CmmExpr
stgSp = CmmReg sp
......@@ -405,6 +405,9 @@ add_shim dflags arg_ty expr
| tycon == arrayPrimTyCon || tycon == mutableArrayPrimTyCon
= cmmOffsetB dflags expr (arrPtrsHdrSize dflags)
| tycon == smallArrayPrimTyCon || tycon == smallMutableArrayPrimTyCon
= cmmOffsetB dflags expr (smallArrPtrsHdrSize dflags)
| tycon == byteArrayPrimTyCon || tycon == mutableByteArrayPrimTyCon
= cmmOffsetB dflags expr (arrWordsHdrSize dflags)
......
......@@ -404,7 +404,7 @@ mkVirtHeapOffsets dflags is_thunk things
)
where
hdr_words | is_thunk = thunkHdrSize dflags
| otherwise = fixedHdrSize dflags
| otherwise = fixedHdrSizeW dflags
hdr_bytes = wordsToBytes dflags hdr_words
non_void_things = filterOut (isVoidRep . fst) things
......
This diff is collapsed.
......@@ -933,6 +933,11 @@ generateCCall d0 s p (CCallSpec target cconv safety) fn args_r_to_l
code <- parg_ArrayishRep (fromIntegral (arrPtrsHdrSize dflags)) d p a
return ((code,AddrRep):rest)
| t == smallArrayPrimTyCon || t == smallMutableArrayPrimTyCon
-> do rest <- pargs (d + fromIntegral addr_sizeW) az
code <- parg_ArrayishRep (fromIntegral (smallArrPtrsHdrSize dflags)) d p a
return ((code,AddrRep):rest)
| t == byteArrayPrimTyCon || t == mutableByteArrayPrimTyCon
-> do rest <- pargs (d + fromIntegral addr_sizeW) az
code <- parg_ArrayishRep (fromIntegral (arrWordsHdrSize dflags)) d p a
......
......@@ -513,8 +513,10 @@ repPrim t = rep where
| t == threadIdPrimTyCon = text "<ThreadId>"
| t == weakPrimTyCon = text "<Weak>"
| t == arrayPrimTyCon = text "<array>"
| t == smallArrayPrimTyCon = text "<smallArray>"
| t == byteArrayPrimTyCon = text "<bytearray>"
| t == mutableArrayPrimTyCon = text "<mutableArray>"
| t == smallMutableArrayPrimTyCon = text "<smallMutableArray>"
| t == mutableByteArrayPrimTyCon = text "<mutableByteArray>"
| t == mutVarPrimTyCon = text "<mutVar>"
| t == mVarPrimTyCon = text "<mVar>"
......
......@@ -1304,7 +1304,8 @@ addrPrimTyConKey, arrayPrimTyConKey, arrayArrayPrimTyConKey, boolTyConKey, byteA
mutableArrayPrimTyConKey, mutableArrayArrayPrimTyConKey, mutableByteArrayPrimTyConKey,
orderingTyConKey, mVarPrimTyConKey, ratioTyConKey, rationalTyConKey,
realWorldTyConKey, stablePtrPrimTyConKey, stablePtrTyConKey,
anyTyConKey, eqTyConKey :: Unique
anyTyConKey, eqTyConKey, smallArrayPrimTyConKey,
smallMutableArrayPrimTyConKey :: Unique
addrPrimTyConKey = mkPreludeTyConUnique 1
arrayPrimTyConKey = mkPreludeTyConUnique 3
boolTyConKey = mkPreludeTyConUnique 4
......@@ -1494,6 +1495,9 @@ proxyPrimTyConKey = mkPreludeTyConUnique 176
specTyConKey :: Unique
specTyConKey = mkPreludeTyConUnique 177
smallArrayPrimTyConKey = mkPreludeTyConUnique 178
smallMutableArrayPrimTyConKey = mkPreludeTyConUnique 179
---------------- Template Haskell -------------------
-- USES TyConUniques 200-299
-----------------------------------------------------
......
......@@ -54,9 +54,11 @@ module TysPrim(
arrayPrimTyCon, mkArrayPrimTy,
byteArrayPrimTyCon, byteArrayPrimTy,
arrayArrayPrimTyCon, mkArrayArrayPrimTy,
smallArrayPrimTyCon, mkSmallArrayPrimTy,
mutableArrayPrimTyCon, mkMutableArrayPrimTy,
mutableByteArrayPrimTyCon, mkMutableByteArrayPrimTy,
mutableArrayArrayPrimTyCon, mkMutableArrayArrayPrimTy,
smallMutableArrayPrimTyCon, mkSmallMutableArrayPrimTy,
mutVarPrimTyCon, mkMutVarPrimTy,
mVarPrimTyCon, mkMVarPrimTy,
......@@ -111,6 +113,7 @@ primTyCons
, arrayPrimTyCon
, byteArrayPrimTyCon
, arrayArrayPrimTyCon
, smallArrayPrimTyCon
, charPrimTyCon
, doublePrimTyCon
, floatPrimTyCon
......@@ -122,6 +125,7 @@ primTyCons
, mutableArrayPrimTyCon
, mutableByteArrayPrimTyCon
, mutableArrayArrayPrimTyCon
, smallMutableArrayPrimTyCon
, mVarPrimTyCon
, tVarPrimTyCon
, mutVarPrimTyCon
......@@ -156,7 +160,7 @@ mkPrimTc fs unique tycon
(ATyCon tycon) -- Relevant TyCon
UserSyntax -- None are built-in syntax
charPrimTyConName, intPrimTyConName, int32PrimTyConName, int64PrimTyConName, wordPrimTyConName, word32PrimTyConName, word64PrimTyConName, addrPrimTyConName, floatPrimTyConName, doublePrimTyConName, statePrimTyConName, proxyPrimTyConName, realWorldTyConName, arrayPrimTyConName, arrayArrayPrimTyConName, byteArrayPrimTyConName, mutableArrayPrimTyConName, mutableByteArrayPrimTyConName, mutableArrayArrayPrimTyConName, mutVarPrimTyConName, mVarPrimTyConName, tVarPrimTyConName, stablePtrPrimTyConName, stableNamePrimTyConName, bcoPrimTyConName, weakPrimTyConName, threadIdPrimTyConName, eqPrimTyConName, eqReprPrimTyConName, voidPrimTyConName :: Name
charPrimTyConName, intPrimTyConName, int32PrimTyConName, int64PrimTyConName, wordPrimTyConName, word32PrimTyConName, word64PrimTyConName, addrPrimTyConName, floatPrimTyConName, doublePrimTyConName, statePrimTyConName, proxyPrimTyConName, realWorldTyConName, arrayPrimTyConName, arrayArrayPrimTyConName, smallArrayPrimTyConName, byteArrayPrimTyConName, mutableArrayPrimTyConName, mutableByteArrayPrimTyConName, mutableArrayArrayPrimTyConName, smallMutableArrayPrimTyConName, mutVarPrimTyConName, mVarPrimTyConName, tVarPrimTyConName, stablePtrPrimTyConName, stableNamePrimTyConName, bcoPrimTyConName, weakPrimTyConName, threadIdPrimTyConName, eqPrimTyConName, eqReprPrimTyConName, voidPrimTyConName :: Name
charPrimTyConName = mkPrimTc (fsLit "Char#") charPrimTyConKey charPrimTyCon
intPrimTyConName = mkPrimTc (fsLit "Int#") intPrimTyConKey intPrimTyCon
int32PrimTyConName = mkPrimTc (fsLit "Int32#") int32PrimTyConKey int32PrimTyCon
......@@ -176,9 +180,11 @@ realWorldTyConName = mkPrimTc (fsLit "RealWorld") realWorldTyConKey r
arrayPrimTyConName = mkPrimTc (fsLit "Array#") arrayPrimTyConKey arrayPrimTyCon
byteArrayPrimTyConName = mkPrimTc (fsLit "ByteArray#") byteArrayPrimTyConKey byteArrayPrimTyCon
arrayArrayPrimTyConName = mkPrimTc (fsLit "ArrayArray#") arrayArrayPrimTyConKey arrayArrayPrimTyCon
smallArrayPrimTyConName = mkPrimTc (fsLit "SmallArray#") smallArrayPrimTyConKey smallArrayPrimTyCon
mutableArrayPrimTyConName = mkPrimTc (fsLit "MutableArray#") mutableArrayPrimTyConKey mutableArrayPrimTyCon
mutableByteArrayPrimTyConName = mkPrimTc (fsLit "MutableByteArray#") mutableByteArrayPrimTyConKey mutableByteArrayPrimTyCon
mutableArrayArrayPrimTyConName= mkPrimTc (fsLit "MutableArrayArray#") mutableArrayArrayPrimTyConKey mutableArrayArrayPrimTyCon
smallMutableArrayPrimTyConName= mkPrimTc (fsLit "SmallMutableArray#") smallMutableArrayPrimTyConKey smallMutableArrayPrimTyCon
mutVarPrimTyConName = mkPrimTc (fsLit "MutVar#") mutVarPrimTyConKey mutVarPrimTyCon
mVarPrimTyConName = mkPrimTc (fsLit "MVar#") mVarPrimTyConKey mVarPrimTyCon
tVarPrimTyConName = mkPrimTc (fsLit "TVar#") tVarPrimTyConKey tVarPrimTyCon
......@@ -538,13 +544,16 @@ defined in \tr{TysWiredIn.lhs}, not here.
\begin{code}
arrayPrimTyCon, mutableArrayPrimTyCon, mutableByteArrayPrimTyCon,
byteArrayPrimTyCon, arrayArrayPrimTyCon, mutableArrayArrayPrimTyCon :: TyCon
byteArrayPrimTyCon, arrayArrayPrimTyCon, mutableArrayArrayPrimTyCon,
smallArrayPrimTyCon, smallMutableArrayPrimTyCon :: TyCon
arrayPrimTyCon = pcPrimTyCon arrayPrimTyConName [Representational] PtrRep
mutableArrayPrimTyCon = pcPrimTyCon mutableArrayPrimTyConName [Nominal, Representational] PtrRep
mutableByteArrayPrimTyCon = pcPrimTyCon mutableByteArrayPrimTyConName [Nominal] PtrRep
byteArrayPrimTyCon = pcPrimTyCon0 byteArrayPrimTyConName PtrRep
arrayArrayPrimTyCon = pcPrimTyCon0 arrayArrayPrimTyConName PtrRep
mutableArrayArrayPrimTyCon = pcPrimTyCon mutableArrayArrayPrimTyConName [Nominal] PtrRep
smallArrayPrimTyCon = pcPrimTyCon smallArrayPrimTyConName [Representational] PtrRep
smallMutableArrayPrimTyCon = pcPrimTyCon smallMutableArrayPrimTyConName [Nominal, Representational] PtrRep
mkArrayPrimTy :: Type -> Type
mkArrayPrimTy elt = TyConApp arrayPrimTyCon [elt]
......@@ -552,12 +561,16 @@ byteArrayPrimTy :: Type
byteArrayPrimTy = mkTyConTy byteArrayPrimTyCon
mkArrayArrayPrimTy :: Type
mkArrayArrayPrimTy = mkTyConTy arrayArrayPrimTyCon
mkSmallArrayPrimTy :: Type -> Type
mkSmallArrayPrimTy elt = TyConApp smallArrayPrimTyCon [elt]
mkMutableArrayPrimTy :: Type -> Type -> Type
mkMutableArrayPrimTy s elt = TyConApp mutableArrayPrimTyCon [s, elt]
mkMutableByteArrayPrimTy :: Type -> Type
mkMutableByteArrayPrimTy s = TyConApp mutableByteArrayPrimTyCon [s]
mkMutableArrayArrayPrimTy :: Type -> Type
mkMutableArrayArrayPrimTy s = TyConApp mutableArrayArrayPrimTyCon [s]
mkSmallMutableArrayPrimTy :: Type -> Type -> Type
mkSmallMutableArrayPrimTy s elt = TyConApp smallMutableArrayPrimTyCon [s, elt]
\end{code}
%************************************************************************
......
......@@ -796,7 +796,7 @@ primop CloneArrayOp "cloneArray#" GenPrimOp
with
out_of_line = True
has_side_effects = True
code_size = { primOpCodeSizeForeignCall + 4 }
can_fail = True
primop CloneMutableArrayOp "cloneMutableArray#" GenPrimOp
MutableArray# s a -> Int# -> Int# -> State# s -> (# State# s, MutableArray# s a #)
......@@ -807,7 +807,7 @@ primop CloneMutableArrayOp "cloneMutableArray#" GenPrimOp
with
out_of_line = True
has_side_effects = True
code_size = { primOpCodeSizeForeignCall + 4 }
can_fail = True
primop FreezeArrayOp "freezeArray#" GenPrimOp
MutableArray# s a -> Int# -> Int# -> State# s -> (# State# s, Array# a #)
......@@ -818,7 +818,7 @@ primop FreezeArrayOp "freezeArray#" GenPrimOp
with
out_of_line = True
has_side_effects = True
code_size = { primOpCodeSizeForeignCall + 4 }
can_fail = True
primop ThawArrayOp "thawArray#" GenPrimOp
Array# a -> Int# -> Int# -> State# s -> (# State# s, MutableArray# s a #)
......@@ -829,7 +829,7 @@ primop ThawArrayOp "thawArray#" GenPrimOp
with
out_of_line = True
has_side_effects = True
code_size = { primOpCodeSizeForeignCall + 4 }
can_fail = True
primop CasArrayOp "casArray#" GenPrimOp
MutableArray# s a -> Int# -> a -> a -> State# s -> (# State# s, Int#, a #)
......@@ -839,6 +839,154 @@ primop CasArrayOp "casArray#" GenPrimOp
has_side_effects = True
------------------------------------------------------------------------
section "Small Arrays"
{Operations on {\tt SmallArray\#}. A {\tt SmallArray\#} works
just like an {\tt Array\#}, except that its implementation is
optimized for small arrays (i.e. no more than 128 elements.)}
------------------------------------------------------------------------
primtype SmallArray# a
primtype SmallMutableArray# s a
primop NewSmallArrayOp "newSmallArray#" GenPrimOp
Int# -> a -> State# s -> (# State# s, SmallMutableArray# s a #)
{Create a new mutable array with the specified number of elements,
in the specified state thread,
with each element containing the specified initial value.}
with
out_of_line = True
has_side_effects = True
primop SameSmallMutableArrayOp "sameSmallMutableArray#" GenPrimOp
SmallMutableArray# s a -> SmallMutableArray# s a -> Int#
primop ReadSmallArrayOp "readSmallArray#" GenPrimOp
SmallMutableArray# s a -> Int# -> State# s -> (# State# s, a #)
{Read from specified index of mutable array. Result is not yet evaluated.}
with
has_side_effects = True
can_fail = True
primop WriteSmallArrayOp "writeSmallArray#" GenPrimOp
SmallMutableArray# s a -> Int# -> a -> State# s -> State# s
{Write to specified index of mutable array.}
with
has_side_effects = True
can_fail = True
primop SizeofSmallArrayOp "sizeofSmallArray#" GenPrimOp
SmallArray# a -> Int#
{Return the number of elements in the array.}
primop SizeofSmallMutableArrayOp "sizeofSmallMutableArray#" GenPrimOp
SmallMutableArray# s a -> Int#
{Return the number of elements in the array.}
primop IndexSmallArrayOp "indexSmallArray#" GenPrimOp
SmallArray# a -> Int# -> (# a #)
{Read from specified index of immutable array. Result is packaged into
an unboxed singleton; the result itself is not yet evaluated.}
with
can_fail = True
primop UnsafeFreezeSmallArrayOp "unsafeFreezeSmallArray#" GenPrimOp
SmallMutableArray# s a -> State# s -> (# State# s, SmallArray# a #)
{Make a mutable array immutable, without copying.}
with
has_side_effects = True
primop UnsafeThawSmallArrayOp "unsafeThawSmallArray#" GenPrimOp
SmallArray# a -> State# s -> (# State# s, SmallMutableArray# s a #)
{Make an immutable array mutable, without copying.}
with
out_of_line = True
has_side_effects = True
-- The code_size is only correct for the case when the copy family of
-- primops aren't inlined. It would be nice to keep track of both.
primop CopySmallArrayOp "copySmallArray#" GenPrimOp
SmallArray# a -> Int# -> SmallMutableArray# s a -> Int# -> Int# -> State# s -> State# s
{Given a source array, an offset into the source array, a
destination array, an offset into the destination array, and a
number of elements to copy, copy the elements from the source array
to the destination array. Both arrays must fully contain the
specified ranges, but this is not checked. The two arrays must not
be the same array in different states, but this is not checked
either.}
with
out_of_line = True
has_side_effects = True
can_fail = True
primop CopySmallMutableArrayOp "copySmallMutableArray#" GenPrimOp
SmallMutableArray# s a -> Int# -> SmallMutableArray# s a -> Int# -> Int# -> State# s -> State# s
{Given a source array, an offset into the source array, a
destination array, an offset into the destination array, and a
number of elements to copy, copy the elements from the source array
to the destination array. The source and destination arrays can
refer to the same array. Both arrays must fully contain the
specified ranges, but this is not checked.}
with
out_of_line = True
has_side_effects = True
can_fail = True
primop CloneSmallArrayOp "cloneSmallArray#" GenPrimOp
SmallArray# a -> Int# -> Int# -> SmallArray# a
{Given a source array, an offset into the source array, and a number
of elements to copy, create a new array with the elements from the
source array. The provided array must fully contain the specified
range, but this is not checked.}
with
out_of_line = True
has_side_effects = True
can_fail = True
primop CloneSmallMutableArrayOp "cloneSmallMutableArray#" GenPrimOp
SmallMutableArray# s a -> Int# -> Int# -> State# s -> (# State# s, SmallMutableArray# s a #)
{Given a source array, an offset into the source array, and a number
of elements to copy, create a new array with the elements from the
source array. The provided array must fully contain the specified
range, but this is not checked.}
with
out_of_line = True
has_side_effects = True
can_fail = True
primop FreezeSmallArrayOp "freezeSmallArray#" GenPrimOp
SmallMutableArray# s a -> Int# -> Int# -> State# s -> (# State# s, SmallArray# a #)
{Given a source array, an offset into the source array, and a number
of elements to copy, create a new array with the elements from the
source array. The provided array must fully contain the specified
range, but this is not checked.}
with
out_of_line = True
has_side_effects = True
can_fail = True
primop ThawSmallArrayOp "thawSmallArray#" GenPrimOp
SmallArray# a -> Int# -> Int# -> State# s -> (# State# s, SmallMutableArray# s a #)
{Given a source array, an offset into the source array, and a number
of elements to copy, create a new array with the elements from the
source array. The provided array must fully contain the specified
range, but this is not checked.}
with
out_of_line = True
has_side_effects = True
can_fail = True
primop CasSmallArrayOp "casSmallArray#" GenPrimOp
SmallMutableArray# s a -> Int# -> a -> a -> State# s -> (# State# s, Int#, a #)
{Unsafe, machine-level atomic compare and swap on an element within an array.}
with
out_of_line = True
has_side_effects = True
------------------------------------------------------------------------
section "Byte Arrays"
{Operations on {\tt ByteArray\#}. A {\tt ByteArray\#} is a just a region of
......
......@@ -806,6 +806,10 @@
__gen = TO_W_(bdescr_gen_no(__bd)); \
if (__gen > 0) { recordMutableCap(__p, __gen); }
/* -----------------------------------------------------------------------------
Arrays
-------------------------------------------------------------------------- */
/* Complete function body for the clone family of (mutable) array ops.
Defined as a macro to avoid function call overhead or code
duplication. */
......@@ -890,4 +894,33 @@
__cards = __end_card - __start_card + 1; \
prim %memset((dst_cards_p) + __start_card, 1, __cards, 1);
/* Complete function body for the clone family of small (mutable)
array ops. Defined as a macro to avoid function call overhead or
code duplication. */
#define cloneSmallArray(info, src, offset, n) \
W_ words, size; \
gcptr dst, dst_p, src_p; \
\
again: MAYBE_GC(again); \
\
words = BYTES_TO_WDS(SIZEOF_StgSmallMutArrPtrs) + n; \
("ptr" dst) = ccall allocate(MyCapability() "ptr", words); \
TICK_ALLOC_PRIM(SIZEOF_StgSmallMutArrPtrs, WDS(n), 0); \
\
SET_HDR(dst, info, CCCS); \
StgSmallMutArrPtrs_ptrs(dst) = n; \
\
dst_p = dst + SIZEOF_StgSmallMutArrPtrs; \
src_p = src + SIZEOF_StgSmallMutArrPtrs + WDS(offset); \
while: \
if (n != 0) { \
n = n - 1; \
W_[dst_p] = W_[src_p]; \
dst_p = dst_p + WDS(1); \
src_p = src_p + WDS(1); \
goto while; \
} \
\
return (dst);
#endif /* CMM_H */
......@@ -326,6 +326,10 @@ EXTERN_INLINE StgOffset mut_arr_ptrs_sizeW( StgMutArrPtrs* x );
EXTERN_INLINE StgOffset mut_arr_ptrs_sizeW( StgMutArrPtrs* x )
{ return sizeofW(StgMutArrPtrs) + x->size; }
EXTERN_INLINE StgOffset small_mut_arr_ptrs_sizeW( StgSmallMutArrPtrs* x );
EXTERN_INLINE StgOffset small_mut_arr_ptrs_sizeW( StgSmallMutArrPtrs* x )
{ return sizeofW(StgSmallMutArrPtrs) + x->ptrs; }
EXTERN_INLINE StgWord stack_sizeW ( StgStack *stack );
EXTERN_INLINE StgWord stack_sizeW ( StgStack *stack )
{ return sizeofW(StgStack) + stack->stack_size; }
......@@ -378,6 +382,11 @@ closure_sizeW_ (StgClosure *p, StgInfoTable *info)
case MUT_ARR_PTRS_FROZEN:
case MUT_ARR_PTRS_FROZEN0:
return mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
case SMALL_MUT_ARR_PTRS_CLEAN:
case SMALL_MUT_ARR_PTRS_DIRTY:
case SMALL_MUT_ARR_PTRS_FROZEN:
case SMALL_MUT_ARR_PTRS_FROZEN0:
return small_mut_arr_ptrs_sizeW((StgSmallMutArrPtrs*)p);
case TSO:
return sizeofW(StgTSO);
case STACK:
......
......@@ -79,6 +79,10 @@
#define CATCH_RETRY_FRAME 58
#define CATCH_STM_FRAME 59
#define WHITEHOLE 60
#define N_CLOSURE_TYPES 61
#define SMALL_MUT_ARR_PTRS_CLEAN 61
#define SMALL_MUT_ARR_PTRS_DIRTY 62
#define SMALL_MUT_ARR_PTRS_FROZEN0 63
#define SMALL_MUT_ARR_PTRS_FROZEN 64
#define N_CLOSURE_TYPES 65
#endif /* RTS_STORAGE_CLOSURETYPES_H */
......@@ -156,6 +156,12 @@ typedef struct {
// see also: StgMutArrPtrs macros in ClosureMacros.h
} StgMutArrPtrs;
typedef struct {
StgHeader header;
StgWord ptrs;
StgClosure *payload[FLEXIBLE_ARRAY];
} StgSmallMutArrPtrs;
typedef struct {
StgHeader header;
StgClosure *var;
......
......@@ -112,6 +112,10 @@ RTS_ENTRY(stg_MUT_ARR_PTRS_CLEAN);
RTS_ENTRY(stg_MUT_ARR_PTRS_DIRTY);
RTS_ENTRY(stg_MUT_ARR_PTRS_FROZEN);
RTS_ENTRY(stg_MUT_ARR_PTRS_FROZEN0);
RTS_ENTRY(stg_SMALL_MUT_ARR_PTRS_CLEAN);
RTS_ENTRY(stg_SMALL_MUT_ARR_PTRS_DIRTY);
RTS_ENTRY(stg_SMALL_MUT_ARR_PTRS_FROZEN);
RTS_ENTRY(stg_SMALL_MUT_ARR_PTRS_FROZEN0);
RTS_ENTRY(stg_MUT_VAR_CLEAN);
RTS_ENTRY(stg_MUT_VAR_DIRTY);
RTS_ENTRY(stg_END_TSO_QUEUE);
......@@ -352,6 +356,16 @@ RTS_FUN_DECL(stg_cloneMutableArrayzh);
RTS_FUN_DECL(stg_freezzeArrayzh);
RTS_FUN_DECL(stg_thawArrayzh);
RTS_FUN_DECL(stg_newSmallArrayzh);
RTS_FUN_DECL(stg_unsafeThawSmallArrayzh);
RTS_FUN_DECL(stg_cloneSmallArrayzh);
RTS_FUN_DECL(stg_cloneSmallMutableArrayzh);
RTS_FUN_DECL(stg_freezzeSmallArrayzh);
RTS_FUN_DECL(stg_thawSmallArrayzh);
RTS_FUN_DECL(stg_copySmallArrayzh);
RTS_FUN_DECL(stg_copySmallMutableArrayzh);
RTS_FUN_DECL(stg_casSmallArrayzh);
RTS_FUN_DECL(stg_newMutVarzh);
RTS_FUN_DECL(stg_atomicModifyMutVarzh);
RTS_FUN_DECL(stg_casMutVarzh);
......
......@@ -198,6 +198,14 @@ static void searchHeapBlocks (HashTable *addrs, bdescr *bd)
prim = rtsTrue;
size = mut_arr_ptrs_sizeW((StgMutArrPtrs *)p);
break;
case SMALL_MUT_ARR_PTRS_CLEAN:
case SMALL_MUT_ARR_PTRS_DIRTY:
case SMALL_MUT_ARR_PTRS_FROZEN:
case SMALL_MUT_ARR_PTRS_FROZEN0:
prim = rtsTrue;
size = small_mut_arr_ptrs_sizeW((StgSmallMutArrPtrs *)p);
break;
case TSO:
prim = rtsTrue;
......
......@@ -81,9 +81,13 @@ StgWord16 closure_flags[] = {
[ATOMICALLY_FRAME] = ( _BTM ),
[CATCH_RETRY_FRAME] = ( _BTM ),
[CATCH_STM_FRAME] = ( _BTM ),
[WHITEHOLE] = ( 0 )
[WHITEHOLE] = ( 0 ),
[SMALL_MUT_ARR_PTRS_CLEAN] = (_HNF| _NS| _MUT|_UPT ),
[SMALL_MUT_ARR_PTRS_DIRTY] = (_HNF| _NS| _MUT|_UPT ),
[SMALL_MUT_ARR_PTRS_FROZEN0] = (_HNF| _NS| _MUT|_UPT ),
[SMALL_MUT_ARR_PTRS_FROZEN] = (_HNF| _NS| _UPT )
};
#if N_CLOSURE_TYPES != 61