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
|
let iter_factor =
let factor b = if b then 10 else 1 in
factor (64 <= Sys.word_size)
* factor (Sys.backend_type = Native)
* factor (1 < Domain.recommended_domain_count ())
let rec alloc ?(batch = 1000) counter =
let n = Atomic.get counter in
if n = 0 then 0
else
let batch = Int_ext.min n batch in
if Atomic.compare_and_set counter n (n - batch) then batch
else alloc ~batch counter
let cross xs ys =
xs |> List.concat_map @@ fun x -> ys |> List.map @@ fun y -> (x, y)
module Bits = struct
type t = { mutable bytes : Bytes.t; mutable length : int }
let create () = { bytes = Bytes.create 1; length = 0 }
let push t bool =
let capacity = Bytes.length t.bytes lsl 3 in
if t.length == capacity then
t.bytes <- Bytes.extend t.bytes 0 (capacity lsr 3);
let byte_i = t.length lsr 3 in
let mask = 1 lsl (t.length land 7) in
t.length <- t.length + 1;
let byte = Char.code (Bytes.unsafe_get t.bytes byte_i) in
let byte = if bool then byte lor mask else byte land lnot mask in
Bytes.unsafe_set t.bytes byte_i (Char.chr byte)
let length t = t.length
let iter fn t =
let i = ref 0 in
let n = t.length in
while !i < n do
let ix = !i in
i := !i + 8;
let byte = Char.code (Bytes.unsafe_get t.bytes (ix lsr 3)) in
let n = n - ix in
fn (0 <> byte land 1);
if 1 < n then fn (0 <> byte land 2);
if 2 < n then fn (0 <> byte land 4);
if 3 < n then fn (0 <> byte land 8);
if 4 < n then fn (0 <> byte land 16);
if 5 < n then fn (0 <> byte land 32);
if 6 < n then fn (0 <> byte land 64);
if 7 < n then fn (0 <> byte land 128)
done
end
let generate_push_and_pop_sequence ?(state = Random.State.make_self_init ())
n_msgs =
let bits = Bits.create () in
let rec loop length n_push n_pop =
if 0 < n_push || 0 < n_pop then begin
let push = Random.State.bool state && 0 < n_push in
Bits.push bits push;
loop
(if push then length + 1 else if 0 < length then length - 1 else length)
(n_push - Bool.to_int push)
(n_pop - Bool.to_int ((not push) && 0 < length))
end
else length
in
let length = loop 0 n_msgs n_msgs in
assert (length = 0);
bits
|
