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
type cfg = { level: int; q: De.Queue.t; w: De.Lz77.window }
let _unsafe_ctz n =
let t = ref 1 and r = ref 0 in
while n land !t == 0 do
t := !t lsl 1;
incr r
done;
!r
let _unsafe_power_of_two x = x land (x - 1) == 0 && x != 0
let config ?(level = 4) ?(size_of_queue = 0x1000) ?(size_of_window = 0x8000) ()
=
if size_of_queue < 0 then
invalid_arg "Flux_zl.config: invalid negative number for the size of queue";
if not (_unsafe_power_of_two size_of_queue) then
invalid_arg "Flux_zl.config: the size of queue must be a power of two";
if size_of_window < 0 then
invalid_arg "Flux_zl.config: invalid negative number for the size of window";
if not (_unsafe_power_of_two size_of_window) then
invalid_arg "Flux_zl.config: the of size of window must be a power of two";
if _unsafe_ctz size_of_window > 15 then
invalid_arg "Flux_zl.config: too big size of window";
let q = De.Queue.create size_of_queue in
let w = De.Lz77.make_window ~bits:(_unsafe_ctz size_of_window) in
{ level; q; w }
let deflate cfg =
let open Flux in
let flow (Sink k) =
let rec until_await encoder o acc =
assert (not (k.full acc));
match Zl.Def.encode encoder with
| `Await encoder -> `Continue (encoder, o, acc)
| `Flush encoder ->
let len = Bstr.length o - Zl.Def.dst_rem encoder in
let encoder = Zl.Def.dst encoder o 0 (Bstr.length o) in
let str = Bstr.sub_string o ~off:0 ~len in
let acc = k.push acc str in
if k.full acc then `Stop acc else until_await encoder o acc
| `End _ -> assert false
in
let rec until_end encoder o acc =
assert (not (k.full acc));
match Zl.Def.encode encoder with
| `Flush encoder ->
let len = Bstr.length o - Zl.Def.dst_rem encoder in
let encoder = Zl.Def.dst encoder o 0 (Bstr.length o) in
let str = Bstr.sub_string o ~off:0 ~len in
let acc = k.push acc str in
if k.full acc then acc else until_end encoder o acc
| `End encoder ->
let len = Bstr.length o - Zl.Def.dst_rem encoder in
let str = Bstr.sub_string o ~off:0 ~len in
k.push acc str
| `Await _ -> assert false
in
let init () =
let w = cfg.w and q = cfg.q and level = cfg.level in
let encoder = Zl.Def.encoder ~q ~w ~level `Manual `Manual in
let o = Bstr.create 0x7ff in
let encoder = Zl.Def.dst encoder o 0 0x7ff in
let acc = k.init () in
`Continue (encoder, o, acc)
in
let push state bstr =
match (state, Bstr.length bstr) with
| _, 0 | `Stop _, _ -> state
| `Continue (encoder, o, acc), _ ->
let encoder = Zl.Def.src encoder bstr 0 (Bstr.length bstr) in
until_await encoder o acc
in
let full = function `Continue (_, _, acc) | `Stop acc -> k.full acc in
let stop = function
| `Stop acc -> k.stop acc
| `Continue (encoder, o, acc) when not (k.full acc) ->
let encoder = Zl.Def.src encoder Bstr.empty 0 0 in
let acc = until_end encoder o acc in
k.stop acc
| `Continue (_, _, acc) -> k.stop acc
in
Sink { init; push; full; stop }
in
{ flow }
let inflate =
let allocate bits = De.make_window ~bits in
let open Flux in
let flow (Sink k) =
let rec until_await_or_end decoder o acc =
assert (not (k.full acc));
match Zl.Inf.decode decoder with
| `Await decoder -> `Continue (decoder, o, acc)
| `Flush decoder ->
let len = Bstr.length o - Zl.Inf.dst_rem decoder in
let str = Bstr.sub_string o ~off:0 ~len in
let acc = k.push acc str in
let decoder = Zl.Inf.flush decoder in
if k.full acc then `Stop acc else until_await_or_end decoder o acc
| `Malformed _ -> `Stop acc
| `End decoder ->
let len = Bstr.length o - Zl.Inf.dst_rem decoder in
let str = Bstr.sub_string o ~off:0 ~len in
let acc = k.push acc str in
`Stop acc
in
let rec until_end decoder o acc =
assert (not (k.full acc));
match Zl.Inf.decode decoder with
| `Await _ -> acc
| `Flush decoder ->
let len = Bstr.length o - Zl.Inf.dst_rem decoder in
let str = Bstr.sub_string o ~off:0 ~len in
let acc = k.push acc str in
let decoder = Zl.Inf.flush decoder in
if k.full acc then acc else until_end decoder o acc
| `Malformed _ -> acc
| `End decoder ->
let len = Bstr.length o - Zl.Inf.dst_rem decoder in
let str = Bstr.sub_string o ~off:0 ~len in
k.push acc str
in
let init () =
let o = Bstr.create 0x7ff in
let decoder = Zl.Inf.decoder `Manual ~o ~allocate in
let acc = k.init () in
`Continue (decoder, o, acc)
in
let push state bstr =
match (state, Bstr.length bstr) with
| _, 0 | `Stop _, _ -> state
| `Continue (decoder, o, acc), _ ->
let decoder = Zl.Inf.src decoder bstr 0 (Bstr.length bstr) in
until_await_or_end decoder o acc
in
let full = function `Continue (_, _, acc) | `Stop acc -> k.full acc in
let stop = function
| `Stop acc -> k.stop acc
| `Continue (decoder, o, acc) when not (k.full acc) ->
let decoder = Zl.Inf.src decoder Bstr.empty 0 0 in
let acc = until_end decoder o acc in
k.stop acc
| `Continue (_, _, acc) -> k.stop acc
in
Sink { init; push; full; stop }
in
{ flow }