anil.recoil.org
Pure OCaml implementation of the Brotli compression algorithm
1(* Variable-width bit writing with little-endian semantics for Brotli *)
2
3type t = {
4 dst : bytes;
5 dst_len : int;
6 mutable byte_pos : int;
7 mutable bit_pos : int; (* 0-7: bits already written to current byte *)
8 mutable current_byte : int; (* Accumulated bits for current byte *)
9}
10
11exception Buffer_overflow
12
13let create ~dst ~pos ~len =
14 { dst; dst_len = pos + len; byte_pos = pos; bit_pos = 0; current_byte = 0 }
15
16let position t =
17 t.byte_pos * 8 + t.bit_pos
18
19let bytes_written t =
20 if t.bit_pos = 0 then
21 t.byte_pos
22 else
23 t.byte_pos + 1
24
25(* Flush accumulated bits to output, return number of bytes written *)
26let flush t =
27 if t.bit_pos > 0 then begin
28 if t.byte_pos >= t.dst_len then raise Buffer_overflow;
29 Bytes.unsafe_set t.dst t.byte_pos (Char.chr t.current_byte);
30 t.byte_pos <- t.byte_pos + 1;
31 t.bit_pos <- 0;
32 t.current_byte <- 0
33 end;
34 t.byte_pos
35
36(* Write n bits (1-24) *)
37let write_bits t n_bits value =
38 if n_bits <= 0 then ()
39 else begin
40 (* Add bits to current accumulator *)
41 t.current_byte <- t.current_byte lor ((value land ((1 lsl n_bits) - 1)) lsl t.bit_pos);
42 t.bit_pos <- t.bit_pos + n_bits;
43
44 (* Flush complete bytes *)
45 while t.bit_pos >= 8 do
46 if t.byte_pos >= t.dst_len then raise Buffer_overflow;
47 Bytes.unsafe_set t.dst t.byte_pos (Char.chr (t.current_byte land 0xFF));
48 t.byte_pos <- t.byte_pos + 1;
49 t.current_byte <- t.current_byte lsr 8;
50 t.bit_pos <- t.bit_pos - 8
51 done
52 end
53
54(* Write a single bit *)
55let[@inline] write_bit t value =
56 write_bits t 1 value
57
58(* Align to next byte boundary by padding with zeros *)
59let align_to_byte t =
60 if t.bit_pos > 0 then begin
61 if t.byte_pos >= t.dst_len then raise Buffer_overflow;
62 Bytes.unsafe_set t.dst t.byte_pos (Char.chr t.current_byte);
63 t.byte_pos <- t.byte_pos + 1;
64 t.bit_pos <- 0;
65 t.current_byte <- 0
66 end
67
68(* Copy raw bytes to output, first aligning to byte boundary *)
69let copy_bytes t ~src ~src_pos ~len =
70 align_to_byte t;
71 if len > 0 then begin
72 if t.byte_pos + len > t.dst_len then raise Buffer_overflow;
73 Bytes.blit src src_pos t.dst t.byte_pos len;
74 t.byte_pos <- t.byte_pos + len
75 end
76
77(* Write a byte directly (for uncompressed blocks) *)
78let write_byte t value =
79 write_bits t 8 value
80
81(* Write a 16-bit little-endian value *)
82let write_u16 t value =
83 write_bits t 16 value
84
85(* Write a 32-bit little-endian value (in two parts to avoid overflow) *)
86let write_u32 t value =
87 write_bits t 16 (value land 0xFFFF);
88 write_bits t 16 ((value lsr 16) land 0xFFFF)