{-# 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, intsToReverseBitmap, mAX_SMALL_BITMAP_SIZE, ) where import GHC.Prelude import GHC.Platform import GHC.Runtime.Heap.Layout {-| 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 :: Platform -> [Bool] -> Bitmap mkBitmap :: Platform -> [Bool] -> Bitmap mkBitmap Platform _ [] = [] mkBitmap Platform platform [Bool] stuff = Platform -> [Bool] -> StgWord chunkToBitmap Platform platform [Bool] chunk StgWord -> Bitmap -> Bitmap forall a. a -> [a] -> [a] : Platform -> [Bool] -> Bitmap mkBitmap Platform platform [Bool] rest where ([Bool] chunk, [Bool] rest) = Int -> [Bool] -> ([Bool], [Bool]) forall a. Int -> [a] -> ([a], [a]) splitAt (Platform -> Int platformWordSizeInBits Platform platform) [Bool] stuff chunkToBitmap :: Platform -> [Bool] -> StgWord chunkToBitmap :: Platform -> [Bool] -> StgWord chunkToBitmap Platform platform [Bool] chunk = (StgWord -> StgWord -> StgWord) -> StgWord -> Bitmap -> StgWord forall b a. (b -> a -> b) -> b -> [a] -> b forall (t :: * -> *) b a. Foldable t => (b -> a -> b) -> b -> t a -> b foldl' StgWord -> StgWord -> StgWord forall a. Bits a => a -> a -> a (.|.) (Platform -> Integer -> StgWord toStgWord Platform platform Integer 0) [ Int -> StgWord oneAt Int n | (Bool True,Int n) <- [Bool] -> [Int] -> [(Bool, Int)] forall a b. [a] -> [b] -> [(a, b)] zip [Bool] chunk [Int 0..] ] where oneAt :: Int -> StgWord oneAt :: Int -> StgWord oneAt Int i = Platform -> Integer -> StgWord toStgWord Platform platform Integer 1 StgWord -> Int -> StgWord forall a. Bits a => a -> Int -> a `shiftL` Int i -- | 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 :: Platform -> Int -- ^ size in bits -> [Int] -- ^ sorted indices of zeros free of duplicates -> Bitmap intsToReverseBitmap :: Platform -> Int -> [Int] -> Bitmap intsToReverseBitmap Platform platform Int size = Int -> [Int] -> Bitmap go Int 0 where word_sz :: Int word_sz = Platform -> Int platformWordSizeInBits Platform platform oneAt :: Int -> StgWord oneAt :: Int -> StgWord oneAt Int i = Platform -> Integer -> StgWord toStgWord Platform platform Integer 1 StgWord -> Int -> StgWord forall a. Bits a => a -> Int -> a `shiftL` Int i -- It is important that we maintain strictness here. -- See Note [Strictness when building Bitmaps]. go :: Int -> [Int] -> Bitmap go :: Int -> [Int] -> Bitmap go !Int pos [Int] slots | Int size Int -> Int -> Bool forall a. Ord a => a -> a -> Bool <= Int pos = [] | Bool otherwise = ((StgWord -> StgWord -> StgWord) -> StgWord -> Bitmap -> StgWord forall b a. (b -> a -> b) -> b -> [a] -> b forall (t :: * -> *) b a. Foldable t => (b -> a -> b) -> b -> t a -> b foldl' StgWord -> StgWord -> StgWord forall a. Bits a => a -> a -> a xor (Platform -> Integer -> StgWord toStgWord Platform platform Integer init) ((Int -> StgWord) -> [Int] -> Bitmap forall a b. (a -> b) -> [a] -> [b] map (\Int i->Int -> StgWord oneAt (Int i Int -> Int -> Int forall a. Num a => a -> a -> a - Int pos)) [Int] these)) StgWord -> Bitmap -> Bitmap forall a. a -> [a] -> [a] : Int -> [Int] -> Bitmap go (Int pos Int -> Int -> Int forall a. Num a => a -> a -> a + Int word_sz) [Int] rest where ([Int] these,[Int] rest) = (Int -> Bool) -> [Int] -> ([Int], [Int]) forall a. (a -> Bool) -> [a] -> ([a], [a]) span (Int -> Int -> Bool forall a. Ord a => a -> a -> Bool < (Int pos Int -> Int -> Int forall a. Num a => a -> a -> a + Int word_sz)) [Int] slots remain :: Int remain = Int size Int -> Int -> Int forall a. Num a => a -> a -> a - Int pos init :: Integer init | Int remain Int -> Int -> Bool forall a. Ord a => a -> a -> Bool >= Int word_sz = -Integer 1 | Bool otherwise = (Integer 1 Integer -> Int -> Integer forall a. Bits a => a -> Int -> a `shiftL` Int remain) Integer -> Integer -> Integer forall a. Num a => a -> a -> a - Integer 1 {- Note [Strictness when building Bitmaps] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ One of the places where @Bitmap@ is used is 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 :: Platform -> Int mAX_SMALL_BITMAP_SIZE :: Platform -> Int mAX_SMALL_BITMAP_SIZE Platform platform = case Platform -> PlatformWordSize platformWordSize Platform platform of PlatformWordSize PW4 -> Int 27 -- On 32-bit: 5 bits for size, 27 bits for bitmap PlatformWordSize PW8 -> Int 58 -- On 64-bit: 6 bits for size, 58 bits for bitmap