summaryrefslogtreecommitdiff
path: root/compiler/GHC/Data/Bitmap.hs
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/GHC/Data/Bitmap.hs')
-rw-r--r--compiler/GHC/Data/Bitmap.hs134
1 files changed, 134 insertions, 0 deletions
diff --git a/compiler/GHC/Data/Bitmap.hs b/compiler/GHC/Data/Bitmap.hs
new file mode 100644
index 0000000000..a8eba5e2e8
--- /dev/null
+++ b/compiler/GHC/Data/Bitmap.hs
@@ -0,0 +1,134 @@
+{-# LANGUAGE BangPatterns #-}
+
+--
+-- (c) The University of Glasgow 2003-2006
+--
+
+-- Functions for constructing bitmaps, which are used in various
+-- places in generated code (stack frame liveness masks, function
+-- argument liveness masks, SRT bitmaps).
+
+module GHC.Data.Bitmap (
+ Bitmap, mkBitmap,
+ intsToBitmap, intsToReverseBitmap,
+ mAX_SMALL_BITMAP_SIZE,
+ seqBitmap,
+ ) where
+
+import GhcPrelude
+
+import GHC.Runtime.Layout
+import DynFlags
+import Util
+
+import Data.Bits
+
+{-|
+A bitmap represented by a sequence of 'StgWord's on the /target/
+architecture. These are used for bitmaps in info tables and other
+generated code which need to be emitted as sequences of StgWords.
+-}
+type Bitmap = [StgWord]
+
+-- | Make a bitmap from a sequence of bits
+mkBitmap :: DynFlags -> [Bool] -> Bitmap
+mkBitmap _ [] = []
+mkBitmap dflags stuff = chunkToBitmap dflags chunk : mkBitmap dflags rest
+ where (chunk, rest) = splitAt (wORD_SIZE_IN_BITS dflags) stuff
+
+chunkToBitmap :: DynFlags -> [Bool] -> StgWord
+chunkToBitmap dflags chunk =
+ foldl' (.|.) (toStgWord dflags 0) [ oneAt n | (True,n) <- zip chunk [0..] ]
+ where
+ oneAt :: Int -> StgWord
+ oneAt i = toStgWord dflags 1 `shiftL` i
+
+-- | Make a bitmap where the slots specified are the /ones/ in the bitmap.
+-- eg. @[0,1,3], size 4 ==> 0xb@.
+--
+-- The list of @Int@s /must/ be already sorted.
+intsToBitmap :: DynFlags
+ -> Int -- ^ size in bits
+ -> [Int] -- ^ sorted indices of ones
+ -> Bitmap
+intsToBitmap dflags size = go 0
+ where
+ word_sz = wORD_SIZE_IN_BITS dflags
+ oneAt :: Int -> StgWord
+ oneAt i = toStgWord dflags 1 `shiftL` i
+
+ -- It is important that we maintain strictness here.
+ -- See Note [Strictness when building Bitmaps].
+ go :: Int -> [Int] -> Bitmap
+ go !pos slots
+ | size <= pos = []
+ | otherwise =
+ (foldl' (.|.) (toStgWord dflags 0) (map (\i->oneAt (i - pos)) these)) :
+ go (pos + word_sz) rest
+ where
+ (these,rest) = span (< (pos + word_sz)) slots
+
+-- | Make a bitmap where the slots specified are the /zeros/ in the bitmap.
+-- eg. @[0,1,3], size 4 ==> 0x4@ (we leave any bits outside the size as zero,
+-- just to make the bitmap easier to read).
+--
+-- The list of @Int@s /must/ be already sorted and duplicate-free.
+intsToReverseBitmap :: DynFlags
+ -> Int -- ^ size in bits
+ -> [Int] -- ^ sorted indices of zeros free of duplicates
+ -> Bitmap
+intsToReverseBitmap dflags size = go 0
+ where
+ word_sz = wORD_SIZE_IN_BITS dflags
+ oneAt :: Int -> StgWord
+ oneAt i = toStgWord dflags 1 `shiftL` i
+
+ -- It is important that we maintain strictness here.
+ -- See Note [Strictness when building Bitmaps].
+ go :: Int -> [Int] -> Bitmap
+ go !pos slots
+ | size <= pos = []
+ | otherwise =
+ (foldl' xor (toStgWord dflags init) (map (\i->oneAt (i - pos)) these)) :
+ go (pos + word_sz) rest
+ where
+ (these,rest) = span (< (pos + word_sz)) slots
+ remain = size - pos
+ init
+ | remain >= word_sz = -1
+ | otherwise = (1 `shiftL` remain) - 1
+
+{-
+
+Note [Strictness when building Bitmaps]
+========================================
+
+One of the places where @Bitmap@ is used is in in building Static Reference
+Tables (SRTs) (in @GHC.Cmm.Info.Build.procpointSRT@). In #7450 it was noticed
+that some test cases (particularly those whose C-- have large numbers of CAFs)
+produced large quantities of allocations from this function.
+
+The source traced back to 'intsToBitmap', which was lazily subtracting the word
+size from the elements of the tail of the @slots@ list and recursively invoking
+itself with the result. This resulted in large numbers of subtraction thunks
+being built up. Here we take care to avoid passing new thunks to the recursive
+call. Instead we pass the unmodified tail along with an explicit position
+accumulator, which get subtracted in the fold when we compute the Word.
+
+-}
+
+{- |
+Magic number, must agree with @BITMAP_BITS_SHIFT@ in InfoTables.h.
+Some kinds of bitmap pack a size\/bitmap into a single word if
+possible, or fall back to an external pointer when the bitmap is too
+large. This value represents the largest size of bitmap that can be
+packed into a single word.
+-}
+mAX_SMALL_BITMAP_SIZE :: DynFlags -> Int
+mAX_SMALL_BITMAP_SIZE dflags
+ | wORD_SIZE dflags == 4 = 27
+ | otherwise = 58
+
+seqBitmap :: Bitmap -> a -> a
+seqBitmap = seqList
+