CCSDS TM Transfer Frames (CCSDS 132.0-B-3)
feat(d3t): replace record codec APIs with GADT-based Codec module
Replace the 4 overlapping record codec APIs (slice-based, record-based,
decode_make, exception-based) with a single compositional Codec module
using Bunzli-style `record |+ field |> seal` combinators.
The Codec uses a GADT snoc-list to track field types through the |+
operator. At seal time, pattern-matching on the GADT applies all
constructor arguments at once (for up to 6 fields), achieving
zero-overhead decode (only the record itself is allocated) and
zero-allocation encode. For >6 fields, a chunked fallback applies
6 fields per step with ceil(n/6)-1 partial applications.
Also adds d3t codec wrappers for CLCW, Space Packet, and TM headers,
with benchmarks comparing against hand-written and original
implementations.
+372
+127
bench/bench_tm.ml
+127
bench/bench_tm.ml
···
1
+
(** Benchmark comparing original Tm header encode/decode vs D3t Codec.
2
+
3
+
Both operate on the same 6-byte TM Transfer Frame primary header. *)
4
+
5
+
(** {1 Test Data} *)
6
+
7
+
(* Pre-generate 1000 TM headers as bytes *)
8
+
let test_headers =
9
+
Array.init 1000 (fun i ->
10
+
let b = Bytes.create 6 in
11
+
(* Word 0: version=0, scid=i%1024, vcid=i%8, ocf_flag=i%2 *)
12
+
let w0 =
13
+
((0 land 0x3) lsl 14)
14
+
lor ((i mod 1024 land 0x3FF) lsl 4)
15
+
lor ((i mod 8 land 0x7) lsl 1)
16
+
lor (i mod 2)
17
+
in
18
+
Bytes.set_uint16_be b 0 w0;
19
+
(* Word 1: mcfc=i%256, vcfc=(i*7)%256 *)
20
+
let w1 = ((i mod 256 land 0xFF) lsl 8) lor (i * 7 mod 256 land 0xFF) in
21
+
Bytes.set_uint16_be b 2 w1;
22
+
(* Word 2: sec_hdr=0, sync=1, pkt_order=0, seg_len=3, fhp=i%2048 *)
23
+
let w2 =
24
+
(0 lsl 15) lor (1 lsl 14) lor (0 lsl 13)
25
+
lor ((3 land 0x3) lsl 11)
26
+
lor (i mod 2048 land 0x7FF)
27
+
in
28
+
Bytes.set_uint16_be b 4 w2;
29
+
b)
30
+
31
+
let test_headers_str =
32
+
Array.map (fun b -> Bytes.unsafe_to_string b) test_headers
33
+
34
+
(* Pre-decoded values *)
35
+
let test_original_headers =
36
+
Array.map
37
+
(fun s ->
38
+
match Tm.decode_header s with Ok h -> h | Error _ -> assert false)
39
+
test_headers_str
40
+
41
+
let test_d3t_headers = Array.map (fun b -> Tm_d3t.decode_exn b 0) test_headers
42
+
43
+
(** {1 Original Tm (string-based)} *)
44
+
45
+
let original_decode () =
46
+
for i = 0 to Array.length test_headers_str - 1 do
47
+
let _ = Tm.decode_header test_headers_str.(i) in
48
+
()
49
+
done
50
+
51
+
let original_encode () =
52
+
for i = 0 to Array.length test_original_headers - 1 do
53
+
let _ = Tm.encode_header test_original_headers.(i) in
54
+
()
55
+
done
56
+
57
+
let original_roundtrip () =
58
+
for i = 0 to Array.length test_headers_str - 1 do
59
+
match Tm.decode_header test_headers_str.(i) with
60
+
| Ok h ->
61
+
let _ = Tm.encode_header h in
62
+
()
63
+
| Error _ -> ()
64
+
done
65
+
66
+
(** {1 D3t Codec (bytes-based)} *)
67
+
68
+
let d3t_decode () =
69
+
for i = 0 to Array.length test_headers - 1 do
70
+
let _ = Tm_d3t.decode_exn test_headers.(i) 0 in
71
+
()
72
+
done
73
+
74
+
let d3t_encode () =
75
+
for i = 0 to Array.length test_d3t_headers - 1 do
76
+
let buf = Bytes.create 6 in
77
+
Tm_d3t.encode test_d3t_headers.(i) buf 0;
78
+
let _ = buf in
79
+
()
80
+
done
81
+
82
+
let d3t_roundtrip () =
83
+
for i = 0 to Array.length test_headers - 1 do
84
+
let t = Tm_d3t.decode_exn test_headers.(i) 0 in
85
+
let buf = Bytes.create 6 in
86
+
Tm_d3t.encode t buf 0;
87
+
let _ = buf in
88
+
()
89
+
done
90
+
91
+
(** {1 Timing} *)
92
+
93
+
let time_it name iterations f =
94
+
for _ = 1 to 10 do
95
+
f ()
96
+
done;
97
+
Gc.full_major ();
98
+
let minor_before = (Gc.quick_stat ()).minor_words in
99
+
let t0 = Unix.gettimeofday () in
100
+
for _ = 1 to iterations do
101
+
f ()
102
+
done;
103
+
let t1 = Unix.gettimeofday () in
104
+
let minor_after = (Gc.quick_stat ()).minor_words in
105
+
let elapsed_ns = (t1 -. t0) *. 1e9 /. float_of_int iterations in
106
+
let words_per_iter =
107
+
(minor_after -. minor_before) /. float_of_int iterations
108
+
in
109
+
Printf.printf " %-20s %8.1f ns/iter %8.1f words/iter\n" name elapsed_ns
110
+
words_per_iter
111
+
112
+
let () =
113
+
Printf.printf "TM Header Benchmark: original vs d3t\n";
114
+
Printf.printf "=====================================\n";
115
+
Printf.printf "(processing 1000 headers per iteration)\n\n";
116
+
117
+
Printf.printf "Original Tm (string-based):\n";
118
+
time_it "decode" 1000 original_decode;
119
+
time_it "encode" 1000 original_encode;
120
+
time_it "roundtrip" 1000 original_roundtrip;
121
+
Printf.printf "\n";
122
+
123
+
Printf.printf "D3t Codec (bytes-based):\n";
124
+
time_it "decode" 1000 d3t_decode;
125
+
time_it "encode" 1000 d3t_encode;
126
+
time_it "roundtrip" 1000 d3t_roundtrip;
127
+
Printf.printf "\n"
+4
bench/dune
+4
bench/dune
+12
dune-project
+12
dune-project
···
22
22
(ocaml (>= 4.14))
23
23
(alcotest :with-test)
24
24
(crowbar :with-test)))
25
+
26
+
(package
27
+
(name tm-d3t)
28
+
(synopsis "D3t codec for CCSDS TM Transfer Frame headers")
29
+
(description
30
+
"D3t-based codec for TM Transfer Frame primary headers. Provides \
31
+
a compositional codec, EverParse 3D schema generation, and conversion \
32
+
to/from the hand-written Tm.header type.")
33
+
(depends
34
+
(ocaml (>= 4.14))
35
+
(tm (= :version))
36
+
(d3t (>= 0.1))))
+108
lib/d3t/tm_d3t.ml
+108
lib/d3t/tm_d3t.ml
···
1
+
(** TM Transfer Frame Header using D3t schemas.
2
+
3
+
The 6-byte primary header is modeled as three uint16be words:
4
+
{v
5
+
Word 0 (bits 0-15):
6
+
Bits 14-15: Version (2 bits)
7
+
Bits 4-13: Spacecraft ID (10 bits)
8
+
Bits 1-3: Virtual Channel ID (3 bits)
9
+
Bit 0: OCF Flag (1 bit)
10
+
11
+
Word 1 (bits 16-31):
12
+
Bits 8-15: Master Channel Frame Count (8 bits)
13
+
Bits 0-7: Virtual Channel Frame Count (8 bits)
14
+
15
+
Word 2 (bits 32-47):
16
+
Bit 15: Secondary Header Flag (1 bit)
17
+
Bit 14: Synchronization Flag (1 bit)
18
+
Bit 13: Packet Order Flag (1 bit)
19
+
Bits 11-12: Segment Length ID (2 bits)
20
+
Bits 0-10: First Header Pointer (11 bits)
21
+
v} *)
22
+
23
+
open D3t
24
+
25
+
(** {1 Types} *)
26
+
27
+
type t = { w0 : int; w1 : int; w2 : int }
28
+
29
+
let equal a b = a.w0 = b.w0 && a.w1 = b.w1 && a.w2 = b.w2
30
+
31
+
(** {1 Field Accessors} *)
32
+
33
+
let version t = (t.w0 lsr 14) land 0x3
34
+
let scid t = (t.w0 lsr 4) land 0x3FF
35
+
let vcid t = (t.w0 lsr 1) land 0x7
36
+
let ocf_flag t = t.w0 land 0x1 = 1
37
+
let mcfc t = (t.w1 lsr 8) land 0xFF
38
+
let vcfc t = t.w1 land 0xFF
39
+
let sec_hdr t = (t.w2 lsr 15) land 0x1 = 1
40
+
let sync_flag t = (t.w2 lsr 14) land 0x1 = 1
41
+
let pkt_order t = (t.w2 lsr 13) land 0x1 = 1
42
+
let seg_len_id t = (t.w2 lsr 11) land 0x3
43
+
let first_hdr_ptr t = t.w2 land 0x7FF
44
+
45
+
(** {1 D3t Codec} *)
46
+
47
+
let codec =
48
+
let open Codec in
49
+
record "TmHeader" (fun w0 w1 w2 -> { w0; w1; w2 })
50
+
|+ field "w0" uint16be (fun t -> t.w0)
51
+
|+ field "w1" uint16be (fun t -> t.w1)
52
+
|+ field "w2" uint16be (fun t -> t.w2)
53
+
|> seal
54
+
55
+
(** {1 3D Schema Generation} *)
56
+
57
+
let struct_ = Codec.to_struct codec
58
+
59
+
let module_ =
60
+
D3t.module_ ~doc:"CCSDS TM Transfer Frame Primary Header (132.0-B-3)"
61
+
"TmHeader"
62
+
[ D3t.typedef ~entrypoint:true struct_ ]
63
+
64
+
(** {1 Parse/Encode} *)
65
+
66
+
let decode_exn = Codec.decode codec
67
+
let encode = Codec.encode codec
68
+
69
+
(** {1 Conversion} *)
70
+
71
+
let of_header (h : Tm.header) : t =
72
+
let w0 =
73
+
((h.version land 0x3) lsl 14)
74
+
lor ((Tm.scid_to_int h.scid land 0x3FF) lsl 4)
75
+
lor ((Tm.vcid_to_int h.vcid land 0x7) lsl 1)
76
+
lor if h.ocf_flag then 1 else 0
77
+
in
78
+
let w1 = ((h.mcfc land 0xFF) lsl 8) lor (h.vcfc land 0xFF) in
79
+
let w2 =
80
+
((if h.sec_hdr then 1 else 0) lsl 15)
81
+
lor ((if h.sync_flag then 1 else 0) lsl 14)
82
+
lor ((if h.pkt_order then 1 else 0) lsl 13)
83
+
lor ((h.seg_len_id land 0x3) lsl 11)
84
+
lor (h.first_hdr_ptr land 0x7FF)
85
+
in
86
+
{ w0; w1; w2 }
87
+
88
+
let to_header (t : t) : (Tm.header, [ `Invalid_scid | `Invalid_vcid ]) result =
89
+
match Tm.scid (scid t) with
90
+
| None -> Error `Invalid_scid
91
+
| Some scid_val -> (
92
+
match Tm.vcid (vcid t) with
93
+
| None -> Error `Invalid_vcid
94
+
| Some vcid_val ->
95
+
Ok
96
+
{
97
+
Tm.version = version t;
98
+
scid = scid_val;
99
+
vcid = vcid_val;
100
+
ocf_flag = ocf_flag t;
101
+
mcfc = mcfc t;
102
+
vcfc = vcfc t;
103
+
sec_hdr = sec_hdr t;
104
+
sync_flag = sync_flag t;
105
+
pkt_order = pkt_order t;
106
+
seg_len_id = seg_len_id t;
107
+
first_hdr_ptr = first_hdr_ptr t;
108
+
})
+84
lib/d3t/tm_d3t.mli
+84
lib/d3t/tm_d3t.mli
···
1
+
(** TM Transfer Frame Header using D3t schemas.
2
+
3
+
This module provides a D3t-based implementation of the CCSDS TM Transfer
4
+
Frame Primary Header (CCSDS 132.0-B-3) for differential testing against the
5
+
hand-written implementation.
6
+
7
+
The 6-byte header is modeled as three uint16be words with bit-field
8
+
accessors for individual fields. *)
9
+
10
+
(** {1 Types} *)
11
+
12
+
type t = {
13
+
w0 : int; (** Word 0: version(2), scid(10), vcid(3), ocf_flag(1) *)
14
+
w1 : int; (** Word 1: mcfc(8), vcfc(8) *)
15
+
w2 : int;
16
+
(** Word 2: sec_hdr(1), sync(1), pkt_order(1), seg_len(2), fhp(11) *)
17
+
}
18
+
(** Raw TM header stored as three 16-bit big-endian values (6 bytes total). *)
19
+
20
+
val equal : t -> t -> bool
21
+
(** Equality test. *)
22
+
23
+
(** {1 Field Accessors} *)
24
+
25
+
val version : t -> int
26
+
(** Transfer frame version (bits 0-1 of word 0). *)
27
+
28
+
val scid : t -> int
29
+
(** Spacecraft ID (bits 2-11 of word 0, 10 bits). *)
30
+
31
+
val vcid : t -> int
32
+
(** Virtual Channel ID (bits 12-14 of word 0, 3 bits). *)
33
+
34
+
val ocf_flag : t -> bool
35
+
(** OCF present flag (bit 15 of word 0). *)
36
+
37
+
val mcfc : t -> int
38
+
(** Master Channel Frame Count (bits 0-7 of word 1, 8 bits). *)
39
+
40
+
val vcfc : t -> int
41
+
(** Virtual Channel Frame Count (bits 8-15 of word 1, 8 bits). *)
42
+
43
+
val sec_hdr : t -> bool
44
+
(** Secondary header flag (bit 0 of word 2). *)
45
+
46
+
val sync_flag : t -> bool
47
+
(** Synchronization flag (bit 1 of word 2). *)
48
+
49
+
val pkt_order : t -> bool
50
+
(** Packet order flag (bit 2 of word 2). *)
51
+
52
+
val seg_len_id : t -> int
53
+
(** Segment length identifier (bits 3-4 of word 2, 2 bits). *)
54
+
55
+
val first_hdr_ptr : t -> int
56
+
(** First header pointer (bits 5-15 of word 2, 11 bits). *)
57
+
58
+
(** {1 D3t Codec} *)
59
+
60
+
val codec : t D3t.Codec.t
61
+
(** Record codec for parsing/encoding. *)
62
+
63
+
val struct_ : D3t.struct_
64
+
(** D3t struct definition. *)
65
+
66
+
val module_ : D3t.module_
67
+
(** D3t module for 3D generation. *)
68
+
69
+
(** {1 Parse/Encode} *)
70
+
71
+
val decode_exn : bytes -> int -> t
72
+
(** [decode_exn buf offset] decodes with bounds checking. Raises
73
+
{!D3t.Parse_error} if buffer too short. *)
74
+
75
+
val encode : t -> bytes -> int -> unit
76
+
(** [encode t buf offset] encodes into [buf] at [offset]. *)
77
+
78
+
(** {1 Conversion} *)
79
+
80
+
val of_header : Tm.header -> t
81
+
(** Convert from original [Tm.header]. *)
82
+
83
+
val to_header : t -> (Tm.header, [ `Invalid_scid | `Invalid_vcid ]) result
84
+
(** Convert to original [Tm.header]. *)
+33
tm-d3t.opam
+33
tm-d3t.opam
···
1
+
# This file is generated by dune, edit dune-project instead
2
+
opam-version: "2.0"
3
+
synopsis: "D3t codec for CCSDS TM Transfer Frame headers"
4
+
description:
5
+
"D3t-based codec for TM Transfer Frame primary headers. Provides a compositional codec, EverParse 3D schema generation, and conversion to/from the hand-written Tm.header type."
6
+
maintainer: ["Thomas Gazagnaire <thomas@gazagnaire.org>"]
7
+
authors: ["Thomas Gazagnaire <thomas@gazagnaire.org>"]
8
+
license: "MIT"
9
+
homepage: "https://tangled.org/gazagnaire.org/ocaml-tm"
10
+
bug-reports: "https://tangled.org/gazagnaire.org/ocaml-tm/issues"
11
+
depends: [
12
+
"dune" {>= "3.21"}
13
+
"ocaml" {>= "4.14"}
14
+
"tm" {= version}
15
+
"d3t" {>= "0.1"}
16
+
"odoc" {with-doc}
17
+
]
18
+
build: [
19
+
["dune" "subst"] {dev}
20
+
[
21
+
"dune"
22
+
"build"
23
+
"-p"
24
+
name
25
+
"-j"
26
+
jobs
27
+
"@install"
28
+
"@runtest" {with-test}
29
+
"@doc" {with-doc}
30
+
]
31
+
]
32
+
dev-repo: "git+https://tangled.org/gazagnaire.org/ocaml-tm"
33
+
x-maintenance-intent: ["(latest)"]