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
type 'a t = { fans : int64 array; mask : int; shift : int }
let equal t t' =
let rec loop i =
if i >= Array.length t.fans then true
else if Int64.equal t.fans.(i) t'.fans.(i) then loop (i + 1)
else false
in
t.mask = t'.mask
&& t.shift = t'.shift
&& Array.length t.fans = Array.length t'.fans
&& loop 0
let log2 a = log a /. log 2.
let v ~hash_size ~entry_size n =
let entry_sizef = float_of_int entry_size in
let entries_per_page = 4096. /. entry_sizef in
let raw_nb_fans = float_of_int n /. entries_per_page in
let size = max 0 (int_of_float (ceil (log2 raw_nb_fans))) in
let nb_fans = 1 lsl size in
let shift = hash_size - size in
{ fans = Array.make nb_fans 0L; mask = (nb_fans - 1) lsl shift; shift }
let nb_fans t = Array.length t.fans
let fan t h = (h land t.mask) lsr t.shift
let search t h =
let fan = fan t h in
let low = if fan = 0 then 0L else t.fans.(fan - 1) in
(low, t.fans.(fan))
let update t hash off =
let fan = fan t hash in
t.fans.(fan) <- off
let finalize t =
let rec loop curr i =
if i = Array.length t.fans then ()
else (
if t.fans.(i) = 0L then t.fans.(i) <- curr;
loop t.fans.(i) (i + 1))
in
loop 0L 0;
(t :> [ `Read ] t)
external set_64 : Bytes.t -> int -> int64 -> unit = "%caml_string_set64u"
external get_64 : string -> int -> int64 = "%caml_string_get64"
external swap64 : int64 -> int64 = "%bswap_int64"
let encode_int64 i =
let set_uint64 s off v =
if not Sys.big_endian then set_64 s off (swap64 v) else set_64 s off v
in
let b = Bytes.create 8 in
set_uint64 b 0 i;
Bytes.to_string b
let decode_int64 buf =
let get_uint64 s off =
if not Sys.big_endian then swap64 (get_64 s off) else get_64 s off
in
get_uint64 buf 0
let exported_size t = Array.length t.fans * 8
let export t =
let encoded_size = exported_size t in
let buf = Buffer.create encoded_size in
let rec loop i =
if i >= Array.length t.fans then ()
else (
Buffer.add_string buf (encode_int64 t.fans.(i));
loop (i + 1))
in
loop 0;
Buffer.contents buf
let import ~hash_size buf =
let nb_fans = String.length buf / 8 in
let fans =
Array.init nb_fans (fun i ->
let sub = String.sub buf (i * 8) 8 in
decode_int64 sub)
in
let size = int_of_float (log2 (float_of_int nb_fans)) in
let shift = hash_size - size in
let mask = (nb_fans - 1) lsl shift in
{ fans; mask; shift }