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
type t = {
buf: Cstruct.buffer;
block_size: int;
freelist: int Queue.t;
}
type chunk = t * int
exception No_space
let init ~block_size buf slots =
let freelist = Queue.create () in
for i = 0 to slots - 1 do
Queue.push (i*block_size) freelist
done;
{ freelist; block_size; buf }
let alloc t =
match Queue.pop t.freelist with
| r -> t, r
| exception Queue.Empty -> raise No_space
let free ({freelist; _}, v) =
Queue.push v freelist
let length ({block_size;_}, _) = block_size
let length_option t = function
| None -> t.block_size
| Some len ->
if len > t.block_size then
invalid_arg (Printf.sprintf "to_cstruct: requested length %d > block size %d" len t.block_size)
else
len
let to_cstruct ?len (t, chunk) =
Cstruct.of_bigarray ~off:chunk ~len:(length_option t len) t.buf
let to_bigstring ?len (t, chunk) =
Bigarray.Array1.sub t.buf chunk (length_option t len)
let to_string ?len (t, chunk) =
Cstruct.to_string (to_cstruct ?len (t, chunk))
let avail {freelist;_} = Queue.length freelist
let to_offset (_,t) = t