Bitmap: Use foldl' instead of foldr
[ghc.git] / compiler / cmm / Bitmap.hs
1 {-# LANGUAGE CPP, 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 Bitmap (
12 Bitmap, mkBitmap,
13 intsToBitmap, intsToReverseBitmap,
14 mAX_SMALL_BITMAP_SIZE,
15 seqBitmap,
16 ) where
17
18 #include "HsVersions.h"
19 #include "../includes/MachDeps.h"
20
21 import SMRep
22 import DynFlags
23 import Util
24
25 import Data.Foldable (foldl')
26 import Data.Bits
27
28 {-|
29 A bitmap represented by a sequence of 'StgWord's on the /target/
30 architecture. These are used for bitmaps in info tables and other
31 generated code which need to be emitted as sequences of StgWords.
32 -}
33 type Bitmap = [StgWord]
34
35 -- | Make a bitmap from a sequence of bits
36 mkBitmap :: DynFlags -> [Bool] -> Bitmap
37 mkBitmap _ [] = []
38 mkBitmap dflags stuff = chunkToBitmap dflags chunk : mkBitmap dflags rest
39 where (chunk, rest) = splitAt (wORD_SIZE_IN_BITS dflags) stuff
40
41 chunkToBitmap :: DynFlags -> [Bool] -> StgWord
42 chunkToBitmap dflags chunk =
43 foldl' (.|.) (toStgWord dflags 0) [ oneAt n | (True,n) <- zip chunk [0..] ]
44 where
45 oneAt :: Int -> StgWord
46 oneAt i = toStgWord dflags 1 `shiftL` i
47
48 -- | Make a bitmap where the slots specified are the /ones/ in the bitmap.
49 -- eg. @[0,1,3], size 4 ==> 0xb@.
50 --
51 -- The list of @Int@s /must/ be already sorted.
52 intsToBitmap :: DynFlags
53 -> Int -- ^ size in bits
54 -> [Int] -- ^ sorted indices of ones
55 -> Bitmap
56 intsToBitmap dflags size = go 0
57 where
58 word_sz = wORD_SIZE_IN_BITS dflags
59 oneAt :: Int -> StgWord
60 oneAt i = toStgWord dflags 1 `shiftL` i
61
62 -- It is important that we maintain strictness here.
63 -- See Note [Strictness when building Bitmaps].
64 go :: Int -> [Int] -> Bitmap
65 go !pos slots
66 | size <= pos = []
67 | otherwise =
68 (foldl' (.|.) (toStgWord dflags 0) (map (\i->oneAt (i - pos)) these)) :
69 go (pos + word_sz) rest
70 where
71 (these,rest) = span (< (pos + word_sz)) slots
72
73 -- | Make a bitmap where the slots specified are the /zeros/ in the bitmap.
74 -- eg. @[0,1,3], size 4 ==> 0x4@ (we leave any bits outside the size as zero,
75 -- just to make the bitmap easier to read).
76 --
77 -- The list of @Int@s /must/ be already sorted and duplicate-free.
78 intsToReverseBitmap :: DynFlags
79 -> Int -- ^ size in bits
80 -> [Int] -- ^ sorted indices of zeros free of duplicates
81 -> Bitmap
82 intsToReverseBitmap dflags size = go 0
83 where
84 word_sz = wORD_SIZE_IN_BITS dflags
85 oneAt :: Int -> StgWord
86 oneAt i = toStgWord dflags 1 `shiftL` i
87
88 -- It is important that we maintain strictness here.
89 -- See Note [Strictness when building Bitmaps].
90 go :: Int -> [Int] -> Bitmap
91 go !pos slots
92 | size <= pos = []
93 | otherwise =
94 (foldl' xor (toStgWord dflags init) (map (\i->oneAt (i - pos)) these)) :
95 go (pos + word_sz) rest
96 where
97 (these,rest) = span (< (pos + word_sz)) slots
98 remain = size - pos
99 init
100 | remain >= word_sz = -1
101 | otherwise = (1 `shiftL` remain) - 1
102
103 {-
104
105 Note [Strictness when building Bitmaps]
106 ========================================
107
108 One of the places where @Bitmap@ is used is in in building Static Reference
109 Tables (SRTs) (in @CmmBuildInfoTables.procpointSRT@). In #7450 it was noticed
110 that some test cases (particularly those whose C-- have large numbers of CAFs)
111 produced large quantities of allocations from this function.
112
113 The source traced back to 'intsToBitmap', which was lazily subtracting the word
114 size from the elements of the tail of the @slots@ list and recursively invoking
115 itself with the result. This resulted in large numbers of subtraction thunks
116 being built up. Here we take care to avoid passing new thunks to the recursive
117 call. Instead we pass the unmodified tail along with an explicit position
118 accumulator, which get subtracted in the fold when we compute the Word.
119
120 -}
121
122 {- |
123 Magic number, must agree with @BITMAP_BITS_SHIFT@ in InfoTables.h.
124 Some kinds of bitmap pack a size\/bitmap into a single word if
125 possible, or fall back to an external pointer when the bitmap is too
126 large. This value represents the largest size of bitmap that can be
127 packed into a single word.
128 -}
129 mAX_SMALL_BITMAP_SIZE :: DynFlags -> Int
130 mAX_SMALL_BITMAP_SIZE dflags
131 | wORD_SIZE dflags == 4 = 27
132 | otherwise = 58
133
134 seqBitmap :: Bitmap -> a -> a
135 seqBitmap = seqList
136