    {-# 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 (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 (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