CCSDS TM Transfer Frames (CCSDS 132.0-B-3)
refactor: merge wire codecs into core protocol libraries
Move Wire-based codecs from separate wire/ sublibraries into the core
libraries as Packed/Packed_header submodules. This eliminates the
clcw-wire, space-packet.wire, and tm-wire packages while keeping the
same functionality accessible via Clcw.Packed, Space_packet.Packed_header,
and Tm.Packed_header.
+143
-248
+6
-5
bench/bench_tm.ml
+6
-5
bench/bench_tm.ml
···
38
38
match Tm.decode_header s with Ok h -> h | Error _ -> assert false)
39
39
test_headers_str
40
40
41
-
let test_wire_headers = Array.map (fun b -> Tm_wire.decode_exn b 0) test_headers
41
+
let test_wire_headers =
42
+
Array.map (fun b -> Tm.Packed_header.decode_exn b 0) test_headers
42
43
43
44
(** {1 Original Tm (string-based)} *)
44
45
···
67
68
68
69
let wire_decode () =
69
70
for i = 0 to Array.length test_headers - 1 do
70
-
let _ = Tm_wire.decode_exn test_headers.(i) 0 in
71
+
let _ = Tm.Packed_header.decode_exn test_headers.(i) 0 in
71
72
()
72
73
done
73
74
74
75
let wire_encode () =
75
76
for i = 0 to Array.length test_wire_headers - 1 do
76
77
let buf = Bytes.create 6 in
77
-
Tm_wire.encode test_wire_headers.(i) buf 0;
78
+
Tm.Packed_header.encode test_wire_headers.(i) buf 0;
78
79
let _ = buf in
79
80
()
80
81
done
81
82
82
83
let wire_roundtrip () =
83
84
for i = 0 to Array.length test_headers - 1 do
84
-
let t = Tm_wire.decode_exn test_headers.(i) 0 in
85
+
let t = Tm.Packed_header.decode_exn test_headers.(i) 0 in
85
86
let buf = Bytes.create 6 in
86
-
Tm_wire.encode t buf 0;
87
+
Tm.Packed_header.encode t buf 0;
87
88
let _ = buf in
88
89
()
89
90
done
+1
-1
bench/dune
+1
-1
bench/dune
+1
-12
dune-project
+1
-12
dune-project
···
20
20
Field (FECF/CRC-16), and CLCW (Command Link Control Word) for COP-1.")
21
21
(depends
22
22
(ocaml (>= 4.14))
23
+
(wire (>= 0.1))
23
24
(alcotest :with-test)
24
25
(crowbar :with-test)))
25
-
26
-
(package
27
-
(name tm-wire)
28
-
(synopsis "Wire codec for CCSDS TM Transfer Frame headers")
29
-
(description
30
-
"Wire-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
-
(wire (>= 0.1))))
+2
-1
lib/dune
+2
-1
lib/dune
+83
lib/tm.ml
+83
lib/tm.ml
···
417
417
frame.ocf
418
418
(Format.pp_print_option (fun ppf v -> Format.fprintf ppf "0x%04X" v))
419
419
frame.fecf
420
+
421
+
(* {1 Packed Header Wire Representation} *)
422
+
423
+
type packed_header = { w0 : int; w1 : int; w2 : int }
424
+
425
+
module Packed_header = struct
426
+
type t = packed_header = { w0 : int; w1 : int; w2 : int }
427
+
428
+
let equal a b = a.w0 = b.w0 && a.w1 = b.w1 && a.w2 = b.w2
429
+
430
+
(* Field Accessors *)
431
+
let version t = (t.w0 lsr 14) land 0x3
432
+
let scid t = (t.w0 lsr 4) land 0x3FF
433
+
let vcid t = (t.w0 lsr 1) land 0x7
434
+
let ocf_flag t = t.w0 land 0x1 = 1
435
+
let mcfc t = (t.w1 lsr 8) land 0xFF
436
+
let vcfc t = t.w1 land 0xFF
437
+
let sec_hdr t = (t.w2 lsr 15) land 0x1 = 1
438
+
let sync_flag t = (t.w2 lsr 14) land 0x1 = 1
439
+
let pkt_order t = (t.w2 lsr 13) land 0x1 = 1
440
+
let seg_len_id t = (t.w2 lsr 11) land 0x3
441
+
let first_hdr_ptr t = t.w2 land 0x7FF
442
+
443
+
(* Wire Codec *)
444
+
let codec =
445
+
let open Wire.Codec in
446
+
record "TmHeader" (fun w0 w1 w2 -> { w0; w1; w2 })
447
+
|+ field "w0" Wire.uint16be (fun t -> t.w0)
448
+
|+ field "w1" Wire.uint16be (fun t -> t.w1)
449
+
|+ field "w2" Wire.uint16be (fun t -> t.w2)
450
+
|> seal
451
+
452
+
let struct_ = Wire.Codec.to_struct codec
453
+
454
+
let module_ =
455
+
Wire.module_ ~doc:"CCSDS TM Transfer Frame Primary Header (132.0-B-3)"
456
+
"TmHeader"
457
+
[ Wire.typedef ~entrypoint:true struct_ ]
458
+
459
+
(* Parse/Encode *)
460
+
let decode_exn = Wire.Codec.decode codec
461
+
let encode = Wire.Codec.encode codec
462
+
end
463
+
464
+
let to_packed_header (h : header) : packed_header =
465
+
let w0 =
466
+
((h.version land 0x3) lsl 14)
467
+
lor ((scid_to_int h.scid land 0x3FF) lsl 4)
468
+
lor ((vcid_to_int h.vcid land 0x7) lsl 1)
469
+
lor if h.ocf_flag then 1 else 0
470
+
in
471
+
let w1 = ((h.mcfc land 0xFF) lsl 8) lor (h.vcfc land 0xFF) in
472
+
let w2 =
473
+
((if h.sec_hdr then 1 else 0) lsl 15)
474
+
lor ((if h.sync_flag then 1 else 0) lsl 14)
475
+
lor ((if h.pkt_order then 1 else 0) lsl 13)
476
+
lor ((h.seg_len_id land 0x3) lsl 11)
477
+
lor (h.first_hdr_ptr land 0x7FF)
478
+
in
479
+
{ w0; w1; w2 }
480
+
481
+
let of_packed_header (t : packed_header) :
482
+
(header, [ `Invalid_scid | `Invalid_vcid ]) result =
483
+
match scid (Packed_header.scid t) with
484
+
| None -> Error `Invalid_scid
485
+
| Some scid_val -> (
486
+
match vcid (Packed_header.vcid t) with
487
+
| None -> Error `Invalid_vcid
488
+
| Some vcid_val ->
489
+
Ok
490
+
{
491
+
version = Packed_header.version t;
492
+
scid = scid_val;
493
+
vcid = vcid_val;
494
+
ocf_flag = Packed_header.ocf_flag t;
495
+
mcfc = Packed_header.mcfc t;
496
+
vcfc = Packed_header.vcfc t;
497
+
sec_hdr = Packed_header.sec_hdr t;
498
+
sync_flag = Packed_header.sync_flag t;
499
+
pkt_order = Packed_header.pkt_order t;
500
+
seg_len_id = Packed_header.seg_len_id t;
501
+
first_hdr_ptr = Packed_header.first_hdr_ptr t;
502
+
})
+49
lib/tm.mli
+49
lib/tm.mli
···
257
257
val pp_header : Format.formatter -> header -> unit
258
258
val pp_clcw : Format.formatter -> clcw -> unit
259
259
val pp : Format.formatter -> t -> unit
260
+
261
+
(** {1 Packed Header Wire Representation} *)
262
+
263
+
type packed_header = {
264
+
w0 : int; (** Word 0: version(2), scid(10), vcid(3), ocf_flag(1) *)
265
+
w1 : int; (** Word 1: mcfc(8), vcfc(8) *)
266
+
w2 : int;
267
+
(** Word 2: sec_hdr(1), sync(1), pkt_order(1), seg_len(2), fhp(11) *)
268
+
}
269
+
(** Raw TM header stored as three 16-bit big-endian values (6 bytes total). *)
270
+
271
+
val to_packed_header : header -> packed_header
272
+
(** [to_packed_header h] converts a TM header to its packed representation. *)
273
+
274
+
val of_packed_header :
275
+
packed_header -> (header, [ `Invalid_scid | `Invalid_vcid ]) result
276
+
(** [of_packed_header t] converts a packed header back to a structured header.
277
+
*)
278
+
279
+
module Packed_header : sig
280
+
type t = packed_header = { w0 : int; w1 : int; w2 : int }
281
+
282
+
val equal : t -> t -> bool
283
+
284
+
(** {1 Field Accessors} *)
285
+
286
+
val version : t -> int
287
+
val scid : t -> int
288
+
val vcid : t -> int
289
+
val ocf_flag : t -> bool
290
+
val mcfc : t -> int
291
+
val vcfc : t -> int
292
+
val sec_hdr : t -> bool
293
+
val sync_flag : t -> bool
294
+
val pkt_order : t -> bool
295
+
val seg_len_id : t -> int
296
+
val first_hdr_ptr : t -> int
297
+
298
+
(** {1 Wire Codec} *)
299
+
300
+
val codec : t Wire.Codec.t
301
+
val struct_ : Wire.struct_
302
+
val module_ : Wire.module_
303
+
304
+
(** {1 Parse/Encode} *)
305
+
306
+
val decode_exn : bytes -> int -> t
307
+
val encode : t -> bytes -> int -> unit
308
+
end
-4
lib/wire/dune
-4
lib/wire/dune
-108
lib/wire/tm_wire.ml
-108
lib/wire/tm_wire.ml
···
1
-
(** TM Transfer Frame Header using Wire 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 Wire
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 Wire 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
-
Wire.module_ ~doc:"CCSDS TM Transfer Frame Primary Header (132.0-B-3)"
61
-
"TmHeader"
62
-
[ Wire.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/wire/tm_wire.mli
-84
lib/wire/tm_wire.mli
···
1
-
(** TM Transfer Frame Header using Wire schemas.
2
-
3
-
This module provides a Wire-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 Wire Codec} *)
59
-
60
-
val codec : t Wire.Codec.t
61
-
(** Record codec for parsing/encoding. *)
62
-
63
-
val struct_ : Wire.struct_
64
-
(** Wire struct definition. *)
65
-
66
-
val module_ : Wire.module_
67
-
(** Wire 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
-
{!Wire.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-wire.opam
-33
tm-wire.opam
···
1
-
# This file is generated by dune, edit dune-project instead
2
-
opam-version: "2.0"
3
-
synopsis: "Wire codec for CCSDS TM Transfer Frame headers"
4
-
description:
5
-
"Wire-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
-
"wire" {>= "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)"]