CCSDS TM Transfer Frames (CCSDS 132.0-B-3)
feat(ccsds): add Wire.Codec to TC, AOS, USLP; extend TM and migrate CLCW
Add packed_header types and Wire.Codec definitions to TC, AOS, and USLP
protocols, enabling EverParse 3D output and C FFI stub generation. Extend
TM's existing Wire.Codec with wire helpers and FFI stubs, and migrate its
duplicate CLCW implementation to use the shared Clcw library.
+123
-147
+1
-1
lib/dune
+1
-1
lib/dune
+44
-110
lib/tm.ml
+44
-110
lib/tm.ml
···
47
47
first_hdr_ptr : int;
48
48
}
49
49
50
-
(* CLCW types *)
51
-
type clcw_status = Ready | Active | Reserved of int
50
+
(* CLCW types — delegated to Clcw library *)
51
+
type clcw_status = Clcw.status = Ready | Active | Reserved of int
52
+
type clcw_flags = Clcw.flags
53
+
type clcw = Clcw.t
52
54
53
-
type clcw_flags = {
54
-
no_rf_available : bool;
55
-
no_bit_lock : bool;
56
-
lockout : bool;
57
-
wait : bool;
58
-
retransmit : bool;
59
-
}
60
-
61
-
let clcw_no_flags =
62
-
{
63
-
no_rf_available = false;
64
-
no_bit_lock = false;
65
-
lockout = false;
66
-
wait = false;
67
-
retransmit = false;
68
-
}
69
-
70
-
type clcw = {
71
-
control_word_type : int;
72
-
clcw_version : int;
73
-
status : clcw_status;
74
-
cop_in_effect : int;
75
-
clcw_vcid : vcid;
76
-
flags : clcw_flags;
77
-
farm_b_counter : int;
78
-
report_value : int;
79
-
}
55
+
let clcw_no_flags = Clcw.no_flags
80
56
81
57
(* TM Frame *)
82
58
type t = {
···
191
167
}
192
168
193
169
(* Header encoding *)
194
-
let encode_header hdr =
170
+
let encode_header (hdr : header) =
195
171
let buf = Bytes.create 6 in
196
172
let w0 =
197
173
hdr.version land (0x3 lsl 14)
···
284
260
end;
285
261
Bytes.to_string buf
286
262
287
-
(* CLCW decoding *)
288
-
let decode_clcw word =
289
-
let control_word_type = (word lsr 31) land 0x1 in
290
-
let clcw_version = (word lsr 29) land 0x3 in
291
-
let status_val = (word lsr 26) land 0x7 in
292
-
let status =
293
-
match status_val with 0 -> Ready | 1 -> Active | n -> Reserved n
294
-
in
295
-
let cop_in_effect = (word lsr 24) land 0x3 in
296
-
let vcid_val = (word lsr 18) land 0x3F in
297
-
(* 6 bits in CLCW *)
298
-
let vcid_tm = vcid_val land 0x7 in
299
-
(* Use lower 3 bits for TM VCID *)
300
-
let no_rf_available = (word lsr 15) land 0x1 = 1 in
301
-
let no_bit_lock = (word lsr 14) land 0x1 = 1 in
302
-
let lockout = (word lsr 13) land 0x1 = 1 in
303
-
let wait = (word lsr 12) land 0x1 = 1 in
304
-
let retransmit = (word lsr 11) land 0x1 = 1 in
305
-
let farm_b_counter = (word lsr 9) land 0x3 in
306
-
let report_value = word land 0xFF in
307
-
Ok
308
-
{
309
-
control_word_type;
310
-
clcw_version;
311
-
status;
312
-
cop_in_effect;
313
-
clcw_vcid = vcid_tm;
314
-
flags = { no_rf_available; no_bit_lock; lockout; wait; retransmit };
315
-
farm_b_counter;
316
-
report_value;
317
-
}
318
-
319
-
(* CLCW encoding *)
320
-
let encode_clcw clcw =
321
-
let status_val =
322
-
match clcw.status with Ready -> 0 | Active -> 1 | Reserved n -> n land 0x7
323
-
in
324
-
clcw.control_word_type land (0x1 lsl 31)
325
-
lor ((clcw.clcw_version land 0x3) lsl 29)
326
-
lor ((status_val land 0x7) lsl 26)
327
-
lor ((clcw.cop_in_effect land 0x3) lsl 24)
328
-
lor ((clcw.clcw_vcid land 0x3F) lsl 18)
329
-
lor ((if clcw.flags.no_rf_available then 1 else 0) lsl 15)
330
-
lor ((if clcw.flags.no_bit_lock then 1 else 0) lsl 14)
331
-
lor ((if clcw.flags.lockout then 1 else 0) lsl 13)
332
-
lor ((if clcw.flags.wait then 1 else 0) lsl 12)
333
-
lor ((if clcw.flags.retransmit then 1 else 0) lsl 11)
334
-
lor ((clcw.farm_b_counter land 0x3) lsl 9)
335
-
lor (clcw.report_value land 0xFF)
263
+
(* CLCW decoding/encoding — delegated to Clcw library *)
264
+
let decode_clcw word = Clcw.decode word
265
+
let encode_clcw clcw = Clcw.encode clcw
336
266
337
267
let get_clcw frame =
338
-
match frame.ocf with
339
-
| None -> Error `No_ocf
340
-
| Some word -> (
341
-
match decode_clcw word with
342
-
| Ok clcw -> Ok clcw
343
-
| Error (`Invalid_vcid v) -> Error (`Invalid_vcid v))
268
+
match frame.ocf with None -> None | Some word -> Some (Clcw.decode word)
344
269
345
270
(* Constructors *)
346
271
let make_header ?(version = 0) ?(ocf_flag = true) ?(sec_hdr = false)
···
373
298
?(cop_in_effect = 1) ?(no_rf_available = false) ?(no_bit_lock = false)
374
299
?(lockout = false) ?(wait = false) ?(retransmit = false)
375
300
?(farm_b_counter = 0) ~vcid ~report_value () =
376
-
{
377
-
control_word_type;
378
-
clcw_version = version;
379
-
status;
380
-
cop_in_effect;
381
-
clcw_vcid = vcid;
382
-
flags = { no_rf_available; no_bit_lock; lockout; wait; retransmit };
383
-
farm_b_counter;
384
-
report_value;
385
-
}
301
+
Clcw.v ~control_word_type ~version ~status ~cop_in_effect
302
+
~vcid:(Clcw.vcid_exn (vcid_to_int vcid))
303
+
~no_rf_available ~no_bit_lock ~lockout ~wait ~retransmit ~farm_b_counter
304
+
~report_value ()
386
305
387
306
(* Pretty-printing *)
388
-
let pp_header ppf hdr =
307
+
let pp_header ppf (hdr : header) =
389
308
Format.fprintf ppf
390
309
"@[<v>TM Header:@,\
391
310
\ version=%d scid=%d vcid=%d@,\
···
395
314
hdr.version hdr.scid hdr.vcid hdr.ocf_flag hdr.mcfc hdr.vcfc hdr.sec_hdr
396
315
hdr.sync_flag hdr.pkt_order hdr.seg_len_id hdr.first_hdr_ptr
397
316
398
-
let pp_clcw_status ppf = function
399
-
| Ready -> Format.fprintf ppf "Ready"
400
-
| Active -> Format.fprintf ppf "Active"
401
-
| Reserved n -> Format.fprintf ppf "Reserved(%d)" n
402
-
403
-
let pp_clcw ppf clcw =
404
-
Format.fprintf ppf
405
-
"@[<v>CLCW:@,\
406
-
\ type=%d version=%d status=%a@,\
407
-
\ cop=%d vcid=%d report=%d@,\
408
-
\ lockout=%b wait=%b retransmit=%b@]"
409
-
clcw.control_word_type clcw.clcw_version pp_clcw_status clcw.status
410
-
clcw.cop_in_effect clcw.clcw_vcid clcw.report_value clcw.flags.lockout
411
-
clcw.flags.wait clcw.flags.retransmit
317
+
let pp_clcw_status = Clcw.pp_status
318
+
let pp_clcw = Clcw.pp
412
319
413
320
let pp ppf frame =
414
321
Format.fprintf ppf "@[<v>%a@,data=%d bytes@,ocf=%a@,fecf=%a@]" pp_header
···
535
442
seg_len_id = t.seg_len_id;
536
443
first_hdr_ptr = t.first_hdr_ptr;
537
444
})
445
+
446
+
(* Wire helpers *)
447
+
let wire_size = Wire.Codec.wire_size codec
448
+
449
+
let decode_bytes buf =
450
+
if Bytes.length buf < wire_size then
451
+
Error (Wire.Unexpected_eof { expected = wire_size; got = Bytes.length buf })
452
+
else Ok (Wire.Codec.decode codec buf 0)
453
+
454
+
let decode_string s =
455
+
if String.length s < wire_size then
456
+
Error (Wire.Unexpected_eof { expected = wire_size; got = String.length s })
457
+
else Ok (Wire.Codec.decode codec (Bytes.of_string s) 0)
458
+
459
+
let encode_string t =
460
+
let buf = Bytes.create wire_size in
461
+
Wire.Codec.encode codec t buf 0;
462
+
Bytes.unsafe_to_string buf
463
+
464
+
let encode_bytes t =
465
+
let buf = Bytes.create wire_size in
466
+
Wire.Codec.encode codec t buf 0;
467
+
buf
468
+
469
+
(* FFI Code Generation *)
470
+
let c_stubs () = Wire.to_c_stubs [ struct_ ]
471
+
let ml_stubs () = Wire.to_ml_stubs [ struct_ ]
+23
-26
lib/tm.mli
+23
-26
lib/tm.mli
···
95
95
(** {1 CLCW - Command Link Control Word}
96
96
97
97
The CLCW is carried in the OCF field and provides feedback about the command
98
-
link state (COP-1 protocol). *)
98
+
link state (COP-1 protocol). Uses the {{!Clcw}Clcw} library. *)
99
99
100
-
type clcw_status =
101
-
| Ready (** COP-1 ready to receive *)
102
-
| Active (** COP-1 actively processing *)
103
-
| Reserved of int (** Reserved status value *)
100
+
type clcw_status = Clcw.status =
101
+
| Ready
102
+
| Active
103
+
| Reserved of int (** COP-1 status (3 bits). *)
104
104
105
-
type clcw_flags = {
106
-
no_rf_available : bool; (** No RF link available *)
107
-
no_bit_lock : bool; (** No bit lock on uplink *)
108
-
lockout : bool; (** FARM-1 in lockout state *)
109
-
wait : bool; (** FARM-1 in wait state *)
110
-
retransmit : bool; (** Retransmission requested *)
111
-
}
105
+
type clcw_flags = Clcw.flags
106
+
(** CLCW flags. *)
112
107
113
-
type clcw = {
114
-
control_word_type : int; (** Control word type (1 bit, 0 for CLCW) *)
115
-
clcw_version : int; (** CLCW version (2 bits) *)
116
-
status : clcw_status; (** COP-1 status (3 bits) *)
117
-
cop_in_effect : int; (** COP in effect (2 bits) *)
118
-
clcw_vcid : vcid; (** Virtual channel ID *)
119
-
flags : clcw_flags; (** Status flags *)
120
-
farm_b_counter : int; (** FARM-B counter (2 bits) *)
121
-
report_value : int; (** Report value / N(R) (8 bits) *)
122
-
}
108
+
type clcw = Clcw.t
123
109
(** Command Link Control Word (32 bits). *)
124
110
125
111
val clcw_no_flags : clcw_flags
···
189
175
190
176
(** {1 CLCW Operations} *)
191
177
192
-
val decode_clcw : int -> (clcw, [ `Invalid_vcid of int ]) result
178
+
val decode_clcw : int -> (Clcw.t, Clcw.error) result
193
179
(** [decode_clcw word] decodes a 32-bit CLCW from the OCF field. *)
194
180
195
-
val encode_clcw : clcw -> int
181
+
val encode_clcw : Clcw.t -> int
196
182
(** [encode_clcw clcw] encodes a CLCW to a 32-bit word. *)
197
183
198
-
val get_clcw : t -> (clcw, [ `No_ocf | `Invalid_vcid of int ]) result
199
-
(** [get_clcw frame] extracts and decodes the CLCW from the frame's OCF. *)
184
+
val get_clcw : t -> (Clcw.t, Clcw.error) result option
185
+
(** [get_clcw frame] extracts and decodes the CLCW from the frame's OCF if
186
+
present. Returns [None] if no OCF. *)
200
187
201
188
(** {1 Constructors} *)
202
189
···
293
280
294
281
(** {1 Wire Parse/Encode} *)
295
282
283
+
val wire_size : int
296
284
val decode_packed_header : bytes -> int -> packed_header
297
285
val encode_packed_header : packed_header -> bytes -> int -> unit
286
+
val decode_bytes : bytes -> (packed_header, Wire.parse_error) result
287
+
val decode_string : string -> (packed_header, Wire.parse_error) result
288
+
val encode_string : packed_header -> string
289
+
val encode_bytes : packed_header -> bytes
290
+
291
+
(** {1 FFI Code Generation} *)
292
+
293
+
val c_stubs : unit -> string
294
+
val ml_stubs : unit -> string
+1
-1
test/dune
+1
-1
test/dune
+54
-9
test/test_tm.ml
+54
-9
test/test_tm.ml
···
16
16
&& a.seg_len_id = b.seg_len_id
17
17
&& a.first_hdr_ptr = b.first_hdr_ptr)
18
18
19
-
let clcw_testable =
20
-
Alcotest.testable Tm.pp_clcw (fun a b ->
21
-
a.Tm.control_word_type = b.Tm.control_word_type
22
-
&& a.clcw_version = b.clcw_version
23
-
&& a.cop_in_effect = b.cop_in_effect
24
-
&& Tm.vcid_to_int a.clcw_vcid = Tm.vcid_to_int b.clcw_vcid
25
-
&& a.farm_b_counter = b.farm_b_counter
26
-
&& a.report_value = b.report_value)
19
+
let clcw_testable = Alcotest.testable Clcw.pp Clcw.equal
27
20
28
21
(* Test: SCID validation *)
29
22
let test_scid_valid () =
···
60
53
in
61
54
let encoded = Tm.encode_clcw clcw in
62
55
match Tm.decode_clcw encoded with
63
-
| Error _ -> Alcotest.fail "decode failed"
56
+
| Error e -> Alcotest.failf "decode failed: %a" Clcw.pp_error e
64
57
| Ok decoded -> Alcotest.check clcw_testable "roundtrip" clcw decoded
65
58
66
59
(* Test: Full frame roundtrip *)
···
136
129
| Error (Truncated _) -> ()
137
130
| _ -> Alcotest.fail "should reject oversized frame_len"
138
131
132
+
(* Wire codec tests *)
133
+
134
+
let packed_header_testable =
135
+
Alcotest.testable
136
+
(fun ppf h ->
137
+
Format.fprintf ppf
138
+
"{ver=%d scid=%d vcid=%d ocf=%b mcfc=%d vcfc=%d sec=%b sync=%b pkt=%b \
139
+
seg=%d fhp=%d}"
140
+
h.Tm.version h.scid h.vcid h.ocf_flag h.mcfc h.vcfc h.sec_hdr
141
+
h.sync_flag h.pkt_order h.seg_len_id h.first_hdr_ptr)
142
+
Tm.equal_packed_header
143
+
144
+
let test_wire_roundtrip () =
145
+
let packed =
146
+
{
147
+
Tm.version = 0;
148
+
scid = 123;
149
+
vcid = 5;
150
+
ocf_flag = true;
151
+
mcfc = 42;
152
+
vcfc = 99;
153
+
sec_hdr = false;
154
+
sync_flag = false;
155
+
pkt_order = false;
156
+
seg_len_id = 3;
157
+
first_hdr_ptr = 0x100;
158
+
}
159
+
in
160
+
let buf = Tm.encode_string packed in
161
+
Alcotest.(check int) "wire_size" 6 Tm.wire_size;
162
+
Alcotest.(check int) "encoded length" 6 (String.length buf);
163
+
match Tm.decode_string buf with
164
+
| Error e -> Alcotest.failf "decode failed: %a" Wire.pp_parse_error e
165
+
| Ok decoded ->
166
+
Alcotest.check packed_header_testable "wire roundtrip" packed decoded
167
+
168
+
let test_wire_vs_manual () =
169
+
let scid = Tm.scid_exn 123 in
170
+
let vcid = Tm.vcid_exn 5 in
171
+
let hdr =
172
+
Tm.make_header ~scid ~vcid ~mcfc:42 ~vcfc:99 ~first_hdr_ptr:0x100 ()
173
+
in
174
+
let manual = Tm.encode_header hdr in
175
+
let packed = Tm.to_packed_header hdr in
176
+
let wire = Tm.encode_string packed in
177
+
Alcotest.(check string) "wire=manual" manual wire
178
+
139
179
let suite =
140
180
[
141
181
( "validation",
···
158
198
Alcotest.test_case "invalid_version" `Quick test_invalid_version;
159
199
Alcotest.test_case "fecf_mismatch" `Quick test_fecf_mismatch;
160
200
Alcotest.test_case "oversized_frame_len" `Quick test_oversized_frame_len;
201
+
] );
202
+
( "wire",
203
+
[
204
+
Alcotest.test_case "wire_roundtrip" `Quick test_wire_roundtrip;
205
+
Alcotest.test_case "wire_vs_manual" `Quick test_wire_vs_manual;
161
206
] );
162
207
]