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