{-# 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 Bitmap (
        Bitmap, mkBitmap,
        intsToBitmap, intsToReverseBitmap,
        mAX_SMALL_BITMAP_SIZE,
        seqBitmap,
  ) where

import GhcPrelude

import SMRep
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 :: DynFlags -> [Bool] -> Bitmap
mkBitmap _ [] = []
mkBitmap dflags :: DynFlags
dflags stuff :: [Bool]
stuff = DynFlags -> [Bool] -> StgWord
chunkToBitmap DynFlags
dflags [Bool]
chunk StgWord -> Bitmap -> Bitmap
forall a. a -> [a] -> [a]
: DynFlags -> [Bool] -> Bitmap
mkBitmap DynFlags
dflags [Bool]
rest
  where (chunk :: [Bool]
chunk, rest :: [Bool]
rest) = Int -> [Bool] -> ([Bool], [Bool])
forall a. Int -> [a] -> ([a], [a])
splitAt (DynFlags -> Int
wORD_SIZE_IN_BITS DynFlags
dflags) [Bool]
stuff

chunkToBitmap :: DynFlags -> [Bool] -> StgWord
chunkToBitmap :: DynFlags -> [Bool] -> StgWord
chunkToBitmap dflags :: DynFlags
dflags chunk :: [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
(.|.) (DynFlags -> Integer -> StgWord
toStgWord DynFlags
dflags 0) [ Int -> StgWord
oneAt Int
n | (True,n :: Int
n) <- [Bool] -> [Int] -> [(Bool, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Bool]
chunk [0..] ]
  where
    oneAt :: Int -> StgWord
    oneAt :: Int -> StgWord
oneAt i :: Int
i = DynFlags -> Integer -> StgWord
toStgWord DynFlags
dflags 1 StgWord -> Int -> StgWord
forall a. Bits a => a -> Int -> a
`shiftL` Int
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 :: DynFlags -> Int -> [Int] -> Bitmap
intsToBitmap dflags :: DynFlags
dflags size :: Int
size = Int -> [Int] -> Bitmap
go 0
  where
    word_sz :: Int
word_sz = DynFlags -> Int
wORD_SIZE_IN_BITS DynFlags
dflags
    oneAt :: Int -> StgWord
    oneAt :: Int -> StgWord
oneAt i :: Int
i = DynFlags -> Integer -> StgWord
toStgWord DynFlags
dflags 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 slots :: [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
(.|.) (DynFlags -> Integer -> StgWord
toStgWord DynFlags
dflags 0) ((Int -> StgWord) -> [Int] -> Bitmap
forall a b. (a -> b) -> [a] -> [b]
map (\i :: 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
        (these :: [Int]
these,rest :: [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

-- | 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 :: DynFlags -> Int -> [Int] -> Bitmap
intsToReverseBitmap dflags :: DynFlags
dflags size :: Int
size = Int -> [Int] -> Bitmap
go 0
  where
    word_sz :: Int
word_sz = DynFlags -> Int
wORD_SIZE_IN_BITS DynFlags
dflags
    oneAt :: Int -> StgWord
    oneAt :: Int -> StgWord
oneAt i :: Int
i = DynFlags -> Integer -> StgWord
toStgWord DynFlags
dflags 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 slots :: [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 (DynFlags -> Integer -> StgWord
toStgWord DynFlags
dflags Integer
init) ((Int -> StgWord) -> [Int] -> Bitmap
forall a b. (a -> b) -> [a] -> [b]
map (\i :: 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
        (these :: [Int]
these,rest :: [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 = -1
          | Bool
otherwise         = (1 Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` Int
remain) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- 1

{-

Note [Strictness when building Bitmaps]
========================================

One of the places where @Bitmap@ is used is in in building Static Reference
Tables (SRTs) (in @CmmBuildInfoTables.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 :: DynFlags -> Int
mAX_SMALL_BITMAP_SIZE dflags :: DynFlags
dflags
 | DynFlags -> Int
wORD_SIZE DynFlags
dflags Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 4 = 27
 | Bool
otherwise             = 58

seqBitmap :: Bitmap -> a -> a
seqBitmap :: Bitmap -> a -> a
seqBitmap = Bitmap -> a -> a
forall a b. [a] -> b -> b
seqList