blob: da1f8b99c24cf799c8b5a84dca321843885f997e (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
|
(* Imperative bitmaps *)
type t = { mutable nrWords : int;
mutable nrBits : int; (* This is 31 * nrWords *)
mutable bitmap : int array }
(* Enlarge a bitmap to contain at
* least newBits *)
let enlarge b newWords =
let newbitmap =
if newWords > b.nrWords then
let a = Array.create newWords 0 in
Array.blit b.bitmap 0 a 0 b.nrWords;
a
else
b.bitmap in
b.nrWords <- newWords;
b.nrBits <- (newWords lsl 5) - newWords;
b.bitmap <- newbitmap
(* Create a new empty bitmap *)
let make size =
let wrd = (size + 30) / 31 in
{ nrWords = wrd;
nrBits = (wrd lsl 5) - wrd;
bitmap = Array.make wrd 0
}
let size t = t.nrBits
(* Make an initialized array *)
let init size how =
let wrd = (size + 30) / 31 in
let how' w =
let first = (w lsl 5) - w in
let last = min size (first + 31) in
let rec loop i acc =
if i >= last then acc
else
let acc' = acc lsl 1 in
if how i then loop (i + 1) (acc' lor 1)
else loop (i + 1) acc'
in
loop first 0
in
{ nrWords = wrd;
nrBits = (wrd lsl 5) - wrd;
bitmap = Array.init wrd how'
}
let clone b =
{ nrWords = b.nrWords;
nrBits = b.nrBits;
bitmap = Array.copy b.bitmap;
}
let cloneEmpty b =
{ nrWords = b.nrWords;
nrBits = b.nrBits;
bitmap = Array.make b.nrWords 0;
}
let union b1 b2 =
begin
let n = b2.nrWords in
if b1.nrWords < n then enlarge b1 n else ();
let a1 = b1.bitmap in
let a2 = b2.bitmap in
let changed = ref false in
for i=0 to n - 1 do
begin
let t = a1.(i) in
let upd = t lor a2.(i) in
let _ = if upd <> t then changed := true else () in
Array.unsafe_set a1 i upd
end
done;
! changed
end
(* lin += (lout - def) *)
let accLive lin lout def =
begin (* Need to enlarge def to lout *)
let n = lout.nrWords in
if def.nrWords < n then enlarge def n else ();
(* Need to enlarge lin to lout *)
if lin.nrWords < n then enlarge lin n else ();
let changed = ref false in
let alin = lin.bitmap in
let alout = lout.bitmap in
let adef = def.bitmap in
for i=0 to n - 1 do
begin
let old = alin.(i) in
let nw = old lor (alout.(i) land (lnot adef.(i))) in
alin.(i) <- nw;
changed := (old <> nw) || (!changed)
end
done;
!changed
end
(* b1 *= b2 *)
let inters b1 b2 =
begin
let n = min b1.nrWords b2.nrWords in
let a1 = b1.bitmap in
let a2 = b2.bitmap in
for i=0 to n - 1 do
begin
a1.(i) <- a1.(i) land a2.(i)
end
done;
if n < b1.nrWords then
Array.fill a1 n (b1.nrWords - n) 0
else
()
end
let emptyInt b start =
let n = b.nrWords in
let a = b.bitmap in
let rec loop i = i >= n || (a.(i) = 0 && loop (i + 1))
in
loop start
let empty b = emptyInt b 0
(* b1 =? b2 *)
let equal b1 b2 =
begin
let n = min b1.nrWords b2.nrWords in
let a1 = b1.bitmap in
let a2 = b2.bitmap in
let res = ref true in
for i=0 to n - 1 do
begin
if a1.(i) != a2.(i) then res := false else ()
end
done;
if !res then
if b1.nrWords > n then
emptyInt b1 n
else if b2.nrWords > n then
emptyInt b2 n
else
true
else
false
end
let assign b1 b2 =
begin
let n = b2.nrWords in
if b1.nrWords < n then enlarge b1 n else ();
let a1 = b1.bitmap in
let a2 = b2.bitmap in
Array.blit a2 0 a1 0 n
end
(* b1 -= b2 *)
let diff b1 b2 =
begin
let n = min b1.nrWords b2.nrWords in
let a1 = b1.bitmap in
let a2 = b2.bitmap in
for i=0 to n - 1 do
a1.(i) <- a1.(i) land (lnot a2.(i))
done;
if n < b1.nrWords then
Array.fill a1 n (b1.nrWords - n) 0
else
()
end
let get bmp i =
assert (i >= 0);
if i >= bmp.nrBits then enlarge bmp (i / 31 + 1) else ();
let wrd = i / 31 in
let msk = 1 lsl (i + wrd - (wrd lsl 5)) in
bmp.bitmap.(wrd) land msk != 0
let set bmp i tv =
assert(i >= 0);
let wrd = i / 31 in
let msk = 1 lsl (i + wrd - (wrd lsl 5)) in
if i >= bmp.nrBits then enlarge bmp (wrd + 1) else ();
if tv then
bmp.bitmap.(wrd) <- bmp.bitmap.(wrd) lor msk
else
bmp.bitmap.(wrd) <- bmp.bitmap.(wrd) land (lnot msk)
(* Iterate over all elements in a
* bitmap *)
let fold f bmp arg =
let a = bmp.bitmap in
let n = bmp.nrWords in
let rec allWords i bit arg =
if i >= n then
arg
else
let rec allBits msk bit left arg =
if left = 0 then
allWords (i + 1) bit arg
else
allBits ((lsr) msk 1) (bit + 1) (left - 1)
(if (land) msk 1 != 0 then f arg bit else arg)
in
allBits a.(i) bit 31 arg
in
allWords 0 0 arg
let iter f t = fold (fun x y -> f y) t ()
let toList bmp = fold (fun acc i -> i :: acc) bmp []
let card bmp = fold (fun acc _ -> acc + 1) bmp 0
|