Bitmap.hs 4.44 KB
Newer Older
1
{-# LANGUAGE BangPatterns #-}
2

3
--
Simon Marlow's avatar
Simon Marlow committed
4
-- (c) The University of Glasgow 2003-2006
5
--
6 7 8 9 10

-- Functions for constructing bitmaps, which are used in various
-- places in generated code (stack frame liveness masks, function
-- argument liveness masks, SRT bitmaps).

11
module GHC.Data.Bitmap (
12 13 14 15
        Bitmap, mkBitmap,
        intsToBitmap, intsToReverseBitmap,
        mAX_SMALL_BITMAP_SIZE,
        seqBitmap,
16 17
  ) where

18 19
import GhcPrelude

20
import GHC.Runtime.Heap.Layout
Sylvain Henry's avatar
Sylvain Henry committed
21
import GHC.Driver.Session
22
import Util
Simon Marlow's avatar
Simon Marlow committed
23 24

import Data.Bits
25 26 27 28 29 30 31 32 33

{-|
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
34 35
mkBitmap :: DynFlags -> [Bool] -> Bitmap
mkBitmap _ [] = []
36
mkBitmap dflags stuff = chunkToBitmap dflags chunk : mkBitmap dflags rest
37
  where (chunk, rest) = splitAt (wORD_SIZE_IN_BITS dflags) stuff
38

39 40
chunkToBitmap :: DynFlags -> [Bool] -> StgWord
chunkToBitmap dflags chunk =
41 42 43 44
  foldl' (.|.) (toStgWord dflags 0) [ oneAt n | (True,n) <- zip chunk [0..] ]
  where
    oneAt :: Int -> StgWord
    oneAt i = toStgWord dflags 1 `shiftL` i
45 46

-- | Make a bitmap where the slots specified are the /ones/ in the bitmap.
47
-- eg. @[0,1,3], size 4 ==> 0xb@.
48 49
--
-- The list of @Int@s /must/ be already sorted.
Ben Gamari's avatar
Ben Gamari committed
50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65
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 =
66
        (foldl' (.|.) (toStgWord dflags 0) (map (\i->oneAt (i - pos)) these)) :
Ben Gamari's avatar
Ben Gamari committed
67 68 69
          go (pos + word_sz) rest
      where
        (these,rest) = span (< (pos + word_sz)) slots
70 71

-- | Make a bitmap where the slots specified are the /zeros/ in the bitmap.
72
-- eg. @[0,1,3], size 4 ==> 0x4@  (we leave any bits outside the size as zero,
73 74
-- just to make the bitmap easier to read).
--
75
-- The list of @Int@s /must/ be already sorted and duplicate-free.
Ben Gamari's avatar
Ben Gamari committed
76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91
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 =
92
        (foldl' xor (toStgWord dflags init) (map (\i->oneAt (i - pos)) these)) :
Ben Gamari's avatar
Ben Gamari committed
93 94 95 96 97 98 99 100 101 102 103 104 105 106
          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
107
Tables (SRTs) (in @GHC.Cmm.Info.Build.procpointSRT@). In #7450 it was noticed
Ben Gamari's avatar
Ben Gamari committed
108 109 110 111 112 113 114 115 116 117 118
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.

-}
119

120
{- |
121
Magic number, must agree with @BITMAP_BITS_SHIFT@ in InfoTables.h.
122
Some kinds of bitmap pack a size\/bitmap into a single word if
123 124 125 126
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.
-}
127 128 129 130
mAX_SMALL_BITMAP_SIZE :: DynFlags -> Int
mAX_SMALL_BITMAP_SIZE dflags
 | wORD_SIZE dflags == 4 = 27
 | otherwise             = 58
131

132 133 134
seqBitmap :: Bitmap -> a -> a
seqBitmap = seqList