Fold testsuite.git into ghc.git (re #8545)
[ghc.git] / compiler / cmm / Bitmap.hs
1 --
2 -- (c) The University of Glasgow 2003-2006
3 --
4
5 -- Functions for constructing bitmaps, which are used in various
6 -- places in generated code (stack frame liveness masks, function
7 -- argument liveness masks, SRT bitmaps).
8
9 module Bitmap (
10 Bitmap, mkBitmap,
11 intsToBitmap, intsToReverseBitmap,
12 mAX_SMALL_BITMAP_SIZE,
13 seqBitmap,
14 ) where
15
16 #include "HsVersions.h"
17 #include "../includes/MachDeps.h"
18
19 import SMRep
20 import DynFlags
21 import Util
22
23 import Data.Bits
24
25 {-|
26 A bitmap represented by a sequence of 'StgWord's on the /target/
27 architecture. These are used for bitmaps in info tables and other
28 generated code which need to be emitted as sequences of StgWords.
29 -}
30 type Bitmap = [StgWord]
31
32 -- | Make a bitmap from a sequence of bits
33 mkBitmap :: DynFlags -> [Bool] -> Bitmap
34 mkBitmap _ [] = []
35 mkBitmap dflags stuff = chunkToBitmap dflags chunk : mkBitmap dflags rest
36 where (chunk, rest) = splitAt (wORD_SIZE_IN_BITS dflags) stuff
37
38 chunkToBitmap :: DynFlags -> [Bool] -> StgWord
39 chunkToBitmap dflags chunk =
40 foldr (.|.) (toStgWord dflags 0) [ toStgWord dflags 1 `shiftL` n | (True,n) <- zip chunk [0..] ]
41
42 -- | Make a bitmap where the slots specified are the /ones/ in the bitmap.
43 -- eg. @[0,1,3], size 4 ==> 0xb@.
44 --
45 -- The list of @Int@s /must/ be already sorted.
46 intsToBitmap :: DynFlags -> Int -> [Int] -> Bitmap
47 intsToBitmap dflags size slots{- must be sorted -}
48 | size <= 0 = []
49 | otherwise =
50 (foldr (.|.) (toStgWord dflags 0) (map (toStgWord dflags 1 `shiftL`) these)) :
51 intsToBitmap dflags (size - wORD_SIZE_IN_BITS dflags)
52 (map (\x -> x - wORD_SIZE_IN_BITS dflags) rest)
53 where (these,rest) = span (< wORD_SIZE_IN_BITS dflags) slots
54
55 -- | Make a bitmap where the slots specified are the /zeros/ in the bitmap.
56 -- eg. @[0,1,3], size 4 ==> 0x4@ (we leave any bits outside the size as zero,
57 -- just to make the bitmap easier to read).
58 --
59 -- The list of @Int@s /must/ be already sorted and duplicate-free.
60 intsToReverseBitmap :: DynFlags -> Int -> [Int] -> Bitmap
61 intsToReverseBitmap dflags size slots{- must be sorted -}
62 | size <= 0 = []
63 | otherwise =
64 (foldr xor (toStgWord dflags init) (map (toStgWord dflags 1 `shiftL`) these)) :
65 intsToReverseBitmap dflags (size - wORD_SIZE_IN_BITS dflags)
66 (map (\x -> x - wORD_SIZE_IN_BITS dflags) rest)
67 where (these,rest) = span (< wORD_SIZE_IN_BITS dflags) slots
68 init
69 | size >= wORD_SIZE_IN_BITS dflags = -1
70 | otherwise = (1 `shiftL` size) - 1
71
72 {- |
73 Magic number, must agree with @BITMAP_BITS_SHIFT@ in InfoTables.h.
74 Some kinds of bitmap pack a size\/bitmap into a single word if
75 possible, or fall back to an external pointer when the bitmap is too
76 large. This value represents the largest size of bitmap that can be
77 packed into a single word.
78 -}
79 mAX_SMALL_BITMAP_SIZE :: DynFlags -> Int
80 mAX_SMALL_BITMAP_SIZE dflags
81 | wORD_SIZE dflags == 4 = 27
82 | otherwise = 58
83
84 seqBitmap :: Bitmap -> a -> a
85 seqBitmap = seqList
86