gazagnaire.org
OCaml wire format DSL with EverParse 3D output for verified parsers
1(** Micro-benchmark to identify Codec decode allocation sources. *)
2
3open Wire
4
5type r3 = { a : int; b : int; c : int }
6
7let codec3 =
8 let open Codec in
9 record "R3" (fun a b c -> { a; b; c })
10 |+ field "a" uint16be (fun t -> t.a)
11 |+ field "b" uint16be (fun t -> t.b)
12 |+ field "c" uint16be (fun t -> t.c)
13 |> seal
14
15type r1 = { x : int }
16
17let codec1 =
18 let open Codec in
19 record "R1" (fun x -> { x }) |+ field "x" uint16be (fun t -> t.x) |> seal
20
21type r7 = {
22 f1 : int;
23 f2 : int;
24 f3 : int;
25 f4 : int;
26 f5 : int;
27 f6 : int;
28 f7 : int;
29}
30
31let codec7 =
32 let open Codec in
33 record "R7" (fun f1 f2 f3 f4 f5 f6 f7 -> { f1; f2; f3; f4; f5; f6; f7 })
34 |+ field "f1" uint16be (fun t -> t.f1)
35 |+ field "f2" uint16be (fun t -> t.f2)
36 |+ field "f3" uint16be (fun t -> t.f3)
37 |+ field "f4" uint16be (fun t -> t.f4)
38 |+ field "f5" uint16be (fun t -> t.f5)
39 |+ field "f6" uint16be (fun t -> t.f6)
40 |+ field "f7" uint16be (fun t -> t.f7)
41 |> seal
42
43type r8 = {
44 g1 : int;
45 g2 : int;
46 g3 : int;
47 g4 : int;
48 g5 : int;
49 g6 : int;
50 g7 : int;
51 g8 : int;
52}
53
54let codec8 =
55 let open Codec in
56 record "R8" (fun g1 g2 g3 g4 g5 g6 g7 g8 ->
57 { g1; g2; g3; g4; g5; g6; g7; g8 })
58 |+ field "g1" uint16be (fun t -> t.g1)
59 |+ field "g2" uint16be (fun t -> t.g2)
60 |+ field "g3" uint16be (fun t -> t.g3)
61 |+ field "g4" uint16be (fun t -> t.g4)
62 |+ field "g5" uint16be (fun t -> t.g5)
63 |+ field "g6" uint16be (fun t -> t.g6)
64 |+ field "g7" uint16be (fun t -> t.g7)
65 |+ field "g8" uint16be (fun t -> t.g8)
66 |> seal
67
68let buf6 = Bytes.create 6
69let buf2 = Bytes.create 2
70let buf14 = Bytes.create 14
71let buf16 = Bytes.create 16
72
73let measure name n f =
74 Gc.full_major ();
75 let before = (Gc.quick_stat ()).minor_words in
76 for _ = 1 to n do
77 f ()
78 done;
79 let after = (Gc.quick_stat ()).minor_words in
80 let per_call = (after -. before) /. float_of_int n in
81 Fmt.pr " %-30s %6.1f words/call\n" name per_call
82
83let () =
84 let n = 1_000_000 in
85 Fmt.pr "Codec decode allocation breakdown (%d calls)\n\n" n;
86
87 Fmt.pr "Measurement baseline:\n";
88 measure "noop" n (fun () -> ());
89 measure "Bytes.length" n (fun () ->
90 let _ = Bytes.length buf6 in
91 ());
92
93 Fmt.pr "\n1-field record (no intermediate closures):\n";
94 measure "Codec.decode codec1" n (fun () ->
95 let _ = Codec.decode codec1 buf2 0 in
96 ());
97
98 Fmt.pr "\n3-field record (2 intermediate closures):\n";
99 measure "Codec.decode codec3" n (fun () ->
100 let _ = Codec.decode codec3 buf6 0 in
101 ());
102
103 Fmt.pr "\nBaseline (hand-written, same record):\n";
104 measure "hand-written decode" n (fun () ->
105 let a = Bytes.get_uint16_be buf6 0 in
106 let b = Bytes.get_uint16_be buf6 2 in
107 let c = Bytes.get_uint16_be buf6 4 in
108 let _ = { a; b; c } in
109 ());
110
111 Fmt.pr "\n7-field record (chunked fallback, 1 PA):\n";
112 measure "Codec.decode codec7" n (fun () ->
113 let _ = Codec.decode codec7 buf14 0 in
114 ());
115 measure "hand-written 7-field" n (fun () ->
116 let f1 = Bytes.get_uint16_be buf14 0 in
117 let f2 = Bytes.get_uint16_be buf14 2 in
118 let f3 = Bytes.get_uint16_be buf14 4 in
119 let f4 = Bytes.get_uint16_be buf14 6 in
120 let f5 = Bytes.get_uint16_be buf14 8 in
121 let f6 = Bytes.get_uint16_be buf14 10 in
122 let f7 = Bytes.get_uint16_be buf14 12 in
123 let _ = { f1; f2; f3; f4; f5; f6; f7 } in
124 ());
125
126 Fmt.pr "\n8-field record (chunked fallback, 1 PA):\n";
127 measure "Codec.decode codec8" n (fun () ->
128 let _ = Codec.decode codec8 buf16 0 in
129 ());
130 measure "hand-written 8-field" n (fun () ->
131 let g1 = Bytes.get_uint16_be buf16 0 in
132 let g2 = Bytes.get_uint16_be buf16 2 in
133 let g3 = Bytes.get_uint16_be buf16 4 in
134 let g4 = Bytes.get_uint16_be buf16 6 in
135 let g5 = Bytes.get_uint16_be buf16 8 in
136 let g6 = Bytes.get_uint16_be buf16 10 in
137 let g7 = Bytes.get_uint16_be buf16 12 in
138 let g8 = Bytes.get_uint16_be buf16 14 in
139 let _ = { g1; g2; g3; g4; g5; g6; g7; g8 } in
140 ());
141
142 Fmt.pr "\nEncode:\n";
143 let v = { a = 1; b = 2; c = 3 } in
144 measure "Codec.encode codec3" n (fun () -> Codec.encode codec3 v buf6 0);
145 measure "hand-written encode" n (fun () ->
146 Bytes.set_uint16_be buf6 0 v.a;
147 Bytes.set_uint16_be buf6 2 v.b;
148 Bytes.set_uint16_be buf6 4 v.c);
149 measure "Codec.encode codec3 + create" n (fun () ->
150 let b = Bytes.create 6 in
151 Codec.encode codec3 v b 0;
152 let _ = b in
153 ());
154
155 Fmt.pr "\nInt32 boxing (CLCW-like):\n";
156 let buf4 = Bytes.create 4 in
157 measure "Bytes.get_int32_be" n (fun () ->
158 let _ = Bytes.get_int32_be buf4 0 in
159 ());
160 measure "byte-by-byte Int32" n (fun () ->
161 let b0 = Bytes.get_uint8 buf4 0 in
162 let b1 = Bytes.get_uint8 buf4 1 in
163 let b2 = Bytes.get_uint8 buf4 2 in
164 let b3 = Bytes.get_uint8 buf4 3 in
165 let _ =
166 Int32.of_int ((b0 lsl 24) lor (b1 lsl 16) lor (b2 lsl 8) lor b3)
167 in
168 ());
169
170 Fmt.pr "\nUInt32 (unboxed on 64-bit):\n";
171 measure "Wire.UInt32.get_be" n (fun () ->
172 let _ = Wire.UInt32.get_be buf4 0 in
173 ());
174 measure "byte-by-byte int" n (fun () ->
175 let b0 = Bytes.get_uint8 buf4 0 in
176 let b1 = Bytes.get_uint8 buf4 1 in
177 let b2 = Bytes.get_uint8 buf4 2 in
178 let b3 = Bytes.get_uint8 buf4 3 in
179 let _ = (b0 lsl 24) lor (b1 lsl 16) lor (b2 lsl 8) lor b3 in
180 ());
181
182 Fmt.pr "\nUInt63 (unboxed on 64-bit):\n";
183 let buf8 = Bytes.create 8 in
184 measure "Bytes.get_int64_be (boxed)" n (fun () ->
185 let _ = Bytes.get_int64_be buf8 0 in
186 ());
187 measure "Wire.UInt63.get_be" n (fun () ->
188 let _ = Wire.UInt63.get_be buf8 0 in
189 ())