never executed always true always false
    1 {-# LANGUAGE BangPatterns #-}
    2 
    3 --
    4 -- (c) The University of Glasgow 2003-2006
    5 --
    6 
    7 -- Functions for constructing bitmaps, which are used in various
    8 -- places in generated code (stack frame liveness masks, function
    9 -- argument liveness masks, SRT bitmaps).
   10 
   11 module GHC.Data.Bitmap (
   12         Bitmap, mkBitmap,
   13         intsToReverseBitmap,
   14         mAX_SMALL_BITMAP_SIZE,
   15   ) where
   16 
   17 import GHC.Prelude
   18 
   19 import GHC.Platform
   20 import GHC.Runtime.Heap.Layout
   21 
   22 
   23 {-|
   24 A bitmap represented by a sequence of 'StgWord's on the /target/
   25 architecture.  These are used for bitmaps in info tables and other
   26 generated code which need to be emitted as sequences of StgWords.
   27 -}
   28 type Bitmap = [StgWord]
   29 
   30 -- | Make a bitmap from a sequence of bits
   31 mkBitmap :: Platform -> [Bool] -> Bitmap
   32 mkBitmap _ [] = []
   33 mkBitmap platform stuff = chunkToBitmap platform chunk : mkBitmap platform rest
   34   where (chunk, rest) = splitAt (platformWordSizeInBits platform) stuff
   35 
   36 chunkToBitmap :: Platform -> [Bool] -> StgWord
   37 chunkToBitmap platform chunk =
   38   foldl' (.|.) (toStgWord platform 0) [ oneAt n | (True,n) <- zip chunk [0..] ]
   39   where
   40     oneAt :: Int -> StgWord
   41     oneAt i = toStgWord platform 1 `shiftL` i
   42 
   43 -- | Make a bitmap where the slots specified are the /zeros/ in the bitmap.
   44 -- eg. @[0,1,3], size 4 ==> 0x4@  (we leave any bits outside the size as zero,
   45 -- just to make the bitmap easier to read).
   46 --
   47 -- The list of @Int@s /must/ be already sorted and duplicate-free.
   48 intsToReverseBitmap :: Platform
   49                     -> Int      -- ^ size in bits
   50                     -> [Int]    -- ^ sorted indices of zeros free of duplicates
   51                     -> Bitmap
   52 intsToReverseBitmap platform size = go 0
   53   where
   54     word_sz = platformWordSizeInBits platform
   55     oneAt :: Int -> StgWord
   56     oneAt i = toStgWord platform 1 `shiftL` i
   57 
   58     -- It is important that we maintain strictness here.
   59     -- See Note [Strictness when building Bitmaps].
   60     go :: Int -> [Int] -> Bitmap
   61     go !pos slots
   62       | size <= pos = []
   63       | otherwise =
   64         (foldl' xor (toStgWord platform init) (map (\i->oneAt (i - pos)) these)) :
   65           go (pos + word_sz) rest
   66       where
   67         (these,rest) = span (< (pos + word_sz)) slots
   68         remain = size - pos
   69         init
   70           | remain >= word_sz = -1
   71           | otherwise         = (1 `shiftL` remain) - 1
   72 
   73 {-
   74 
   75 Note [Strictness when building Bitmaps]
   76 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
   77 
   78 One of the places where @Bitmap@ is used is in building Static Reference
   79 Tables (SRTs) (in @GHC.Cmm.Info.Build.procpointSRT@). In #7450 it was noticed
   80 that some test cases (particularly those whose C-- have large numbers of CAFs)
   81 produced large quantities of allocations from this function.
   82 
   83 The source traced back to 'intsToBitmap', which was lazily subtracting the word
   84 size from the elements of the tail of the @slots@ list and recursively invoking
   85 itself with the result. This resulted in large numbers of subtraction thunks
   86 being built up. Here we take care to avoid passing new thunks to the recursive
   87 call. Instead we pass the unmodified tail along with an explicit position
   88 accumulator, which get subtracted in the fold when we compute the Word.
   89 
   90 -}
   91 
   92 {- |
   93 Magic number, must agree with @BITMAP_BITS_SHIFT@ in InfoTables.h.
   94 Some kinds of bitmap pack a size\/bitmap into a single word if
   95 possible, or fall back to an external pointer when the bitmap is too
   96 large.  This value represents the largest size of bitmap that can be
   97 packed into a single word.
   98 -}
   99 mAX_SMALL_BITMAP_SIZE :: Platform -> Int
  100 mAX_SMALL_BITMAP_SIZE platform =
  101     case platformWordSize platform of
  102       PW4 -> 27 -- On 32-bit: 5 bits for size, 27 bits for bitmap
  103       PW8 -> 58 -- On 64-bit: 6 bits for size, 58 bits for bitmap