Skip to content

Commit 0b70ef6

Browse files
tmcgilchristtmcgilchrist
committed
Reformat and add doc strings to fxt library
1 parent b8cc0ad commit 0b70ef6

File tree

11 files changed

+204
-121
lines changed

11 files changed

+204
-121
lines changed

‎lib/fxt/dune‎

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,6 @@
11
(library
22
(name fxt)
33
(wrapped false)
4-
(foreign_stubs (language c) (names fxt_stubs)))
4+
(foreign_stubs
5+
(language c)
6+
(names fxt_stubs)))

‎lib/fxt/fxt_buf.ml‎

Lines changed: 18 additions & 24 deletions
Original file line numberDiff line numberDiff line change
@@ -1,19 +1,15 @@
1-
type t = {
2-
buf : Bytes.t;
3-
mutable pos : int;
4-
pos_end : int;
5-
}
1+
type t = { buf : Bytes.t; mutable pos : int; pos_end : int }
62

73
let create n =
8-
let n = (n + 7) land (lnot 7) in
4+
let n = (n + 7) land lnot 7 in
95
{ buf = Bytes.create n; pos = 0; pos_end = n }
106

117
let[@inline] clear t = t.pos <- 0
128
let[@inline] pos t = t.pos
139
let[@inline] available t = t.pos_end - t.pos
1410

1511
external put_raw_64_le : Bytes.t -> int -> int64 -> unit = "%caml_bytes_set64u"
16-
[@@noalloc]
12+
[@@noalloc]
1713

1814
let[@inline always] put_64 t (v : int64) =
1915
let pos = t.pos in
@@ -24,7 +20,7 @@ let put_string_padded t s =
2420
let len = String.length s in
2521
Bytes.blit_string s 0 t.buf t.pos len;
2622
t.pos <- t.pos + len;
27-
let pad = (lnot (len - 1)) land 7 in
23+
let pad = lnot (len - 1) land 7 in
2824
if pad > 0 then begin
2925
Bytes.fill t.buf t.pos pad '\000';
3026
t.pos <- t.pos + pad
@@ -41,20 +37,18 @@ let[@inline] bytes t = t.buf
4137
(* Zero-allocation C stubs for packing FXT headers directly into the
4238
buffer without intermediate Int64 boxing. *)
4339
external put_event_header :
44-
Bytes.t -> int ->
45-
int -> int -> int -> int -> int -> unit
46-
= "fxt_put_event_header_bytecode" "fxt_put_event_header_native" [@@noalloc]
47-
48-
external put_arg_header_i32 :
49-
Bytes.t -> int ->
50-
int -> int -> int -> unit
51-
= "fxt_put_arg_header_i32" [@@noalloc]
52-
53-
external put_arg_header_i64 :
54-
Bytes.t -> int ->
55-
int -> int -> unit
56-
= "fxt_put_arg_header_i64" [@@noalloc]
57-
58-
external int64_div_to_decimal :
59-
Bytes.t -> int -> int64 -> int -> int
40+
Bytes.t -> int -> int -> int -> int -> int -> int -> unit
41+
= "fxt_put_event_header_bytecode" "fxt_put_event_header_native"
42+
[@@noalloc]
43+
44+
external put_arg_header_i32 : Bytes.t -> int -> int -> int -> int -> unit
45+
= "fxt_put_arg_header_i32"
46+
[@@noalloc]
47+
48+
external put_arg_header_i64 : Bytes.t -> int -> int -> int -> unit
49+
= "fxt_put_arg_header_i64"
50+
[@@noalloc]
51+
52+
external int64_div_to_decimal : Bytes.t -> int -> int64 -> int -> int
6053
= "fxt_int64_div_to_decimal"
54+
[@@noalloc]

‎lib/fxt/fxt_buf.mli‎

Lines changed: 72 additions & 17 deletions
Original file line numberDiff line numberDiff line change
@@ -1,33 +1,88 @@
1+
(** Low-level buffer for writing FXT (Fuchsia trace format) binary data.
2+
3+
Provides a fixed-size {!Bytes.t}-backed buffer with zero-allocation
4+
write primitives. Integer writes use compiler intrinsics and C stubs
5+
to avoid {!Int64} boxing. Strings are written with 8-byte alignment
6+
padding as required by the FXT specification.
7+
8+
@see <https://fuchsia.dev/fuchsia-src/reference/tracing/trace-format> *)
9+
10+
(** A write buffer backed by a fixed-size {!Bytes.t}. *)
111
type t
212

313
val create : int -> t
14+
(** [create n] allocates a buffer of [n] bytes (rounded up to 8-byte
15+
alignment). *)
16+
417
val clear : t -> unit
18+
(** [clear t] resets the write position to the beginning. *)
19+
520
val pos : t -> int
21+
(** [pos t] returns the current write position in bytes. *)
22+
623
val available : t -> int
24+
(** [available t] returns the number of bytes remaining. *)
25+
726
val bytes : t -> Bytes.t
27+
(** [bytes t] returns the underlying {!Bytes.t}. Used with C stubs that
28+
write directly at a given offset. *)
29+
830
val put_64 : t -> int64 -> unit
31+
(** [put_64 t v] writes [v] as a little-endian 64-bit integer and advances
32+
the position by 8 bytes. *)
33+
934
val put_string_padded : t -> string -> unit
35+
(** [put_string_padded t s] writes [s] followed by zero-padding to the next
36+
8-byte boundary, as required by FXT string encoding. *)
37+
1038
val advance : t -> int -> unit
39+
(** [advance t n] moves the write position forward by [n] bytes. Used after
40+
C stubs that write directly into {!bytes}. *)
41+
1142
val flush : t -> out_channel -> unit
43+
(** [flush t oc] writes all buffered data to [oc] and resets the position. *)
44+
45+
(** {1 Zero-allocation C stubs}
46+
47+
These externals write packed binary headers directly into a {!Bytes.t}
48+
at a given offset, avoiding intermediate {!Int64} boxing that would
49+
occur with OCaml's [Int64.logor]/[Int64.shift_left] operations. *)
1250

1351
external put_raw_64_le : Bytes.t -> int -> int64 -> unit = "%caml_bytes_set64u"
14-
[@@noalloc]
52+
[@@noalloc]
53+
(** Compiler intrinsic: writes a 64-bit integer in little-endian byte order
54+
at an unaligned offset. Compiles to a single store instruction on x86-64. *)
1555

1656
external put_event_header :
17-
Bytes.t -> int ->
18-
int -> int -> int -> int -> int -> unit
19-
= "fxt_put_event_header_bytecode" "fxt_put_event_header_native" [@@noalloc]
20-
21-
external put_arg_header_i32 :
22-
Bytes.t -> int ->
23-
int -> int -> int -> unit
24-
= "fxt_put_arg_header_i32" [@@noalloc]
25-
26-
external put_arg_header_i64 :
27-
Bytes.t -> int ->
28-
int -> int -> unit
29-
= "fxt_put_arg_header_i64" [@@noalloc]
30-
31-
external int64_div_to_decimal :
32-
Bytes.t -> int -> int64 -> int -> int
57+
Bytes.t -> int -> int -> int -> int -> int -> int -> unit
58+
= "fxt_put_event_header_bytecode" "fxt_put_event_header_native"
59+
[@@noalloc]
60+
(** [put_event_header buf pos size event_ty n_args thread_ref name_ref]
61+
packs and writes a 64-bit FXT event record header. Fields are:
62+
- [size]: total record size in 8-byte words
63+
- [event_ty]: event type (0=instant, 1=counter, 2=duration_begin, 3=duration_end)
64+
- [n_args]: number of arguments (0-15)
65+
- [thread_ref]: thread reference index (0 for inline)
66+
- [name_ref]: string reference for the event name *)
67+
68+
external put_arg_header_i32 : Bytes.t -> int -> int -> int -> int -> unit
69+
= "fxt_put_arg_header_i32"
70+
[@@noalloc]
71+
(** [put_arg_header_i32 buf pos arg_words name_ref value] packs and writes
72+
a 64-bit FXT argument header for a 32-bit integer argument. The [value]
73+
is stored inline in the upper 32 bits of the header word. *)
74+
75+
external put_arg_header_i64 : Bytes.t -> int -> int -> int -> unit
76+
= "fxt_put_arg_header_i64"
77+
[@@noalloc]
78+
(** [put_arg_header_i64 buf pos arg_words name_ref] packs and writes a
79+
64-bit FXT argument header for a 64-bit integer argument. The value
80+
must be written separately as a following word. *)
81+
82+
external int64_div_to_decimal : Bytes.t -> int -> int64 -> int -> int
3383
= "fxt_int64_div_to_decimal"
84+
[@@noalloc]
85+
(** [int64_div_to_decimal buf pos n divisor] divides [n] by [divisor] and
86+
writes the result as decimal ASCII digits into [buf] at [pos]. Returns
87+
the number of bytes written. Used for JSON timestamp formatting
88+
(nanoseconds to microseconds) without {!Int64} boxing. *)

‎lib/fxt/fxt_write.ml‎

Lines changed: 43 additions & 52 deletions
Original file line numberDiff line numberDiff line change
@@ -1,9 +1,6 @@
11
module B = Fxt_buf
22

3-
type thread = {
4-
pid : int64;
5-
tid : int64;
6-
}
3+
type thread = { pid : int64; tid : int64 }
74

85
type strings = {
96
mutable str_next : int;
@@ -17,12 +14,7 @@ type threads = {
1714
thr_index : (int64 * int64, int) Hashtbl.t;
1815
}
1916

20-
type t = {
21-
oc : out_channel;
22-
buf : B.t;
23-
strings : strings;
24-
threads : threads;
25-
}
17+
type t = { oc : out_channel; buf : B.t; strings : strings; threads : threads }
2618

2719
(* Number of 8-byte words for a padded string *)
2820
let[@inline] str_word_len s = (String.length s + 7) asr 3
@@ -34,12 +26,12 @@ type str_ref = Str_ref of int | Str_inline of string
3426
let str_ref_lookup strings s =
3527
match s with
3628
| "" -> Str_ref 0
37-
| _ ->
38-
(match Hashtbl.find_opt strings.str_index s with
39-
| Some i -> Str_ref i
40-
| None ->
41-
if String.length s > 32000 then invalid_arg "FXT: string too long";
42-
Str_inline s)
29+
| _ -> (
30+
match Hashtbl.find_opt strings.str_index s with
31+
| Some i -> Str_ref i
32+
| None ->
33+
if String.length s > 32000 then invalid_arg "FXT: string too long";
34+
Str_inline s)
4335

4436
let[@inline] str_ref_encode = function
4537
| Str_ref x -> x
@@ -57,7 +49,7 @@ let str_ref_add t s =
5749
if s <> "" && not (Hashtbl.mem t.strings.str_index s) then begin
5850
let st = t.strings in
5951
let i = st.str_next in
60-
st.str_next <- if i = 0x7fff then 1 else i + 1;
52+
st.str_next <- (if i = 0x7fff then 1 else i + 1);
6153
Option.iter (Hashtbl.remove st.str_index) st.str_table.(i);
6254
st.str_table.(i) <- Some s;
6355
Hashtbl.replace st.str_index s i;
@@ -67,8 +59,9 @@ let str_ref_add t s =
6759
Int64.(logor (of_int i) (shift_left (of_int (String.length s)) 16))
6860
in
6961
B.put_64 t.buf
70-
Int64.(logor (of_int 2) (logor (shift_left (of_int words) 4)
71-
(shift_left data 16)));
62+
Int64.(
63+
logor (of_int 2)
64+
(logor (shift_left (of_int words) 4) (shift_left data 16)));
7265
B.put_string_padded t.buf s
7366
end
7467

@@ -81,33 +74,28 @@ let thr_ref_lookup threads v =
8174
| Some i -> Thr_ref i
8275
| None -> Thr_inline { pid = v.pid; tid = v.tid }
8376

84-
let[@inline] thr_ref_encode = function
85-
| Thr_ref x -> x
86-
| Thr_inline _ -> 0
87-
88-
let[@inline] thr_ref_size = function
89-
| Thr_ref _ -> 0
90-
| Thr_inline _ -> 2
77+
let[@inline] thr_ref_encode = function Thr_ref x -> x | Thr_inline _ -> 0
78+
let[@inline] thr_ref_size = function Thr_ref _ -> 0 | Thr_inline _ -> 2
9179

9280
let thr_ref_write buf = function
9381
| Thr_ref _ -> ()
9482
| Thr_inline { pid; tid } ->
95-
B.put_64 buf pid;
96-
B.put_64 buf tid
83+
B.put_64 buf pid;
84+
B.put_64 buf tid
9785

9886
let thr_ref_add t v =
9987
let key = (v.pid, v.tid) in
10088
if not (Hashtbl.mem t.threads.thr_index key) then begin
10189
let th = t.threads in
10290
let i = th.thr_next in
103-
th.thr_next <- if i = 0xff then 1 else i + 1;
91+
th.thr_next <- (if i = 0xff then 1 else i + 1);
10492
Option.iter (Hashtbl.remove th.thr_index) th.thr_table.(i);
10593
th.thr_table.(i) <- Some key;
10694
Hashtbl.replace th.thr_index key i;
10795
B.put_64 t.buf
108-
Int64.(logor (of_int 3)
109-
(logor (shift_left (of_int 3) 4)
110-
(shift_left (of_int i) 16)));
96+
Int64.(
97+
logor (of_int 3)
98+
(logor (shift_left (of_int 3) 4) (shift_left (of_int i) 16)));
11199
B.put_64 t.buf v.pid;
112100
B.put_64 t.buf v.tid
113101
end
@@ -118,21 +106,24 @@ let buf_size = 65536
118106
let max_event_bytes = 33000
119107

120108
let ensure_space t =
121-
if B.available t.buf < max_event_bytes then
122-
B.flush t.buf t.oc
109+
if B.available t.buf < max_event_bytes then B.flush t.buf t.oc
123110

124111
let create oc =
125112
let buf = B.create buf_size in
126-
let strings = {
127-
str_next = 1;
128-
str_table = Array.make 0x8000 None;
129-
str_index = Hashtbl.create 200;
130-
} in
131-
let threads = {
132-
thr_next = 1;
133-
thr_table = Array.make 0x100 None;
134-
thr_index = Hashtbl.create 20;
135-
} in
113+
let strings =
114+
{
115+
str_next = 1;
116+
str_table = Array.make 0x8000 None;
117+
str_index = Hashtbl.create 200;
118+
}
119+
in
120+
let threads =
121+
{
122+
thr_next = 1;
123+
thr_table = Array.make 0x100 None;
124+
thr_index = Hashtbl.create 20;
125+
}
126+
in
136127
let t = { oc; buf; strings; threads } in
137128
(* Magic record *)
138129
B.put_64 buf 0x0016547846040010L;
@@ -148,10 +139,10 @@ let close t =
148139
let[@inline] is_i32 (i : int) : bool = Int32.(to_int (of_int i) = i)
149140

150141
(* Write an event header via C stub (zero Int64 boxing), then advance pos *)
151-
let[@inline] write_event_header buf ~words ~event_ty ~n_args ~thread_ref ~name_ref =
142+
let[@inline] write_event_header buf ~words ~event_ty ~n_args ~thread_ref
143+
~name_ref =
152144
let pos = B.pos buf in
153-
B.put_event_header (B.bytes buf) pos
154-
words event_ty n_args thread_ref name_ref;
145+
B.put_event_header (B.bytes buf) pos words event_ty n_args thread_ref name_ref;
155146
B.advance buf 8
156147

157148
(* Emit a span or instant event. Zero-allocation when name and thread are
@@ -176,8 +167,7 @@ let duration_begin t ~thread ~name ~ts =
176167
let duration_end t ~thread ~name ~ts =
177168
emit_event t ~event_ty:3 ~thread ~name ~ts
178169

179-
let instant t ~thread ~name ~ts =
180-
emit_event t ~event_ty:0 ~thread ~name ~ts
170+
let instant t ~thread ~name ~ts = emit_event t ~event_ty:0 ~thread ~name ~ts
181171

182172
(* Counter events include one int argument named "v" and a counter_id word. *)
183173
let counter t ~thread ~name ~ts ~value =
@@ -190,8 +180,8 @@ let counter t ~thread ~name ~ts ~value =
190180
let thread_ref = thr_ref_lookup t.threads thread in
191181
let arg_words = (if is_i32 value then 1 else 2) + str_ref_words v_ref in
192182
let words =
193-
2 + thr_ref_size thread_ref + str_ref_words name_ref
194-
+ arg_words + 1 (* counter_id *)
183+
2 + thr_ref_size thread_ref + str_ref_words name_ref + arg_words
184+
+ 1 (* counter_id *)
195185
in
196186
write_event_header t.buf ~words ~event_ty:1 ~n_args:1
197187
~thread_ref:(thr_ref_encode thread_ref)
@@ -206,7 +196,8 @@ let counter t ~thread ~name ~ts ~value =
206196
B.put_arg_header_i32 (B.bytes t.buf) arg_pos arg_words v_enc value;
207197
B.advance t.buf 8;
208198
str_ref_write t.buf v_ref
209-
end else begin
199+
end
200+
else begin
210201
B.put_arg_header_i64 (B.bytes t.buf) arg_pos arg_words v_enc;
211202
B.advance t.buf 8;
212203
str_ref_write t.buf v_ref;

0 commit comments

Comments
 (0)