CCSDS Command Link Control Word (CLCW) for spacecraft command
Use Wire codec for all binary encoding/decoding
- CLCW: remove hand-written bit manipulation, single codec for the
full 32-bit word with typed fields
- Space Packet: single full-packet codec (header + variable-length
data via Field.ref on data_length)
- TC: frame_codec with dependent-length data zone from header's
frame_length field
- AOS/TM/USLP: packed_frame type with Wire codec for header +
data zone capture for the variable-length trailing portion
- Remove all duplicate packed_header types where superseded
- Expose Wire.Codec field bindings for future zero-copy get/set
+272
-516
+29
-72
bench/bench_clcw.ml
+29
-72
bench/bench_clcw.ml
···
1
-
(** Benchmark comparing original CLCW vs Wire implementation.
1
+
(** Benchmark for CLCW Wire codec.
2
2
3
-
Measures decode/encode speed to ensure wire has no regression compared to
4
-
hand-written bit manipulation. *)
3
+
Measures decode/encode speed of the Wire-based CLCW implementation. *)
5
4
6
5
(** {1 Test Data} *)
7
6
···
29
28
test_words
30
29
31
30
(* Pre-decoded values for encode benchmarks *)
32
-
let test_clcw_original =
33
-
Array.map (fun w -> Clcw.decode w |> Result.get_ok) test_words
34
-
35
-
let test_clcw_wire = Array.map Clcw.to_packed test_clcw_original
31
+
let test_clcw = Array.map (fun w -> Clcw.decode w |> Result.get_ok) test_words
36
32
37
-
(** {1 Original Implementation Benchmarks} *)
33
+
(** {1 Benchmarks} *)
38
34
39
-
(* NOTE: Original decode takes int, not bytes! This is the semantic-level decode. *)
40
-
let original_decode () =
35
+
let decode_from_int () =
41
36
for i = 0 to Array.length test_words - 1 do
42
37
let _ = Clcw.decode test_words.(i) in
43
38
()
44
39
done
45
40
46
-
(* Fair comparison: include bytes->int conversion *)
47
-
let original_decode_from_bytes () =
41
+
let decode_from_bytes () =
48
42
for i = 0 to Array.length test_strings - 1 do
49
-
let s = test_strings.(i) in
50
-
let word = Int32.to_int (Bytes.get_int32_be (Bytes.of_string s) 0) in
51
-
let _ = Clcw.decode word in
43
+
let _ = Clcw.decode_string test_strings.(i) in
52
44
()
53
45
done
54
46
55
-
(* NOTE: Original encode returns int, not bytes! *)
56
-
let original_encode () =
57
-
for i = 0 to Array.length test_clcw_original - 1 do
58
-
let _ = Clcw.encode test_clcw_original.(i) in
47
+
let encode_to_int () =
48
+
for i = 0 to Array.length test_clcw - 1 do
49
+
let _ = Clcw.encode test_clcw.(i) in
59
50
()
60
51
done
61
52
62
-
(* Fair comparison: include int->bytes conversion *)
63
-
let original_encode_to_bytes () =
64
-
for i = 0 to Array.length test_clcw_original - 1 do
65
-
let word = Clcw.encode test_clcw_original.(i) in
66
-
let b = Bytes.create 4 in
67
-
Bytes.set_int32_be b 0 (Int32.of_int word);
68
-
let _ = Bytes.to_string b in
53
+
let encode_to_bytes () =
54
+
for i = 0 to Array.length test_clcw - 1 do
55
+
let _ = Clcw.encode_string test_clcw.(i) in
69
56
()
70
57
done
71
58
72
-
let original_roundtrip () =
59
+
let roundtrip_int () =
73
60
for i = 0 to Array.length test_words - 1 do
74
61
let t = Clcw.decode test_words.(i) |> Result.get_ok in
75
62
let _ = Clcw.encode t in
76
63
()
77
64
done
78
65
79
-
(* Fair comparison: bytes->int->decode->encode->int->bytes *)
80
-
let original_roundtrip_bytes () =
81
-
for i = 0 to Array.length test_strings - 1 do
82
-
let s = test_strings.(i) in
83
-
let word = Int32.to_int (Bytes.get_int32_be (Bytes.of_string s) 0) in
84
-
let t = Clcw.decode word |> Result.get_ok in
85
-
let out_word = Clcw.encode t in
86
-
let b = Bytes.create 4 in
87
-
Bytes.set_int32_be b 0 (Int32.of_int out_word);
88
-
let _ = Bytes.to_string b in
89
-
()
90
-
done
91
-
92
-
(** {1 Wire Codec Benchmarks} *)
93
-
94
-
let wire_decode () =
95
-
for i = 0 to Array.length test_strings - 1 do
96
-
let _ = Clcw.decode_string test_strings.(i) in
97
-
()
98
-
done
99
-
100
-
let wire_encode () =
101
-
for i = 0 to Array.length test_clcw_wire - 1 do
102
-
let _ = Clcw.encode_string test_clcw_wire.(i) in
103
-
()
104
-
done
105
-
106
-
let wire_roundtrip () =
66
+
let roundtrip_bytes () =
107
67
for i = 0 to Array.length test_strings - 1 do
108
68
match Clcw.decode_string test_strings.(i) with
109
69
| Ok t ->
···
137
97
(** {1 Main} *)
138
98
139
99
let () =
140
-
Fmt.pr "CLCW Benchmark: original vs wire\n";
141
-
Fmt.pr "================================\n";
100
+
Fmt.pr "CLCW Benchmark (Wire codec)\n";
101
+
Fmt.pr "===========================\n";
142
102
Fmt.pr "(processing 1000 CLCW words per iteration)\n\n";
143
103
144
-
Fmt.pr "Decode (from int - original doesn't touch bytes!):\n";
145
-
time_it "original" 1000 original_decode;
104
+
Fmt.pr "Decode (from int via Wire):\n";
105
+
time_it "decode_int" 1000 decode_from_int;
146
106
Fmt.pr "\n";
147
107
148
-
Fmt.pr "Decode (from bytes - fair comparison):\n";
149
-
time_it "original" 1000 original_decode_from_bytes;
150
-
time_it "wire" 1000 wire_decode;
108
+
Fmt.pr "Decode (from bytes via Wire):\n";
109
+
time_it "decode_bytes" 1000 decode_from_bytes;
151
110
Fmt.pr "\n";
152
111
153
-
Fmt.pr "Encode (to int - original doesn't produce bytes!):\n";
154
-
time_it "original" 1000 original_encode;
112
+
Fmt.pr "Encode (to int via Wire):\n";
113
+
time_it "encode_int" 1000 encode_to_int;
155
114
Fmt.pr "\n";
156
115
157
-
Fmt.pr "Encode (to bytes - fair comparison):\n";
158
-
time_it "original" 1000 original_encode_to_bytes;
159
-
time_it "wire" 1000 wire_encode;
116
+
Fmt.pr "Encode (to bytes via Wire):\n";
117
+
time_it "encode_bytes" 1000 encode_to_bytes;
160
118
Fmt.pr "\n";
161
119
162
-
Fmt.pr "Roundtrip (int-level - no byte handling):\n";
163
-
time_it "original" 1000 original_roundtrip;
120
+
Fmt.pr "Roundtrip (int-level via Wire):\n";
121
+
time_it "roundtrip_int" 1000 roundtrip_int;
164
122
Fmt.pr "\n";
165
123
166
-
Fmt.pr "Roundtrip (bytes - fair comparison):\n";
167
-
time_it "original" 1000 original_roundtrip_bytes;
168
-
time_it "wire" 1000 wire_roundtrip;
124
+
Fmt.pr "Roundtrip (bytes-level via Wire):\n";
125
+
time_it "roundtrip_bytes" 1000 roundtrip_bytes;
169
126
Fmt.pr "\n"
+15
-21
bench/bench_memtrace.ml
+15
-21
bench/bench_memtrace.ml
···
1
-
(** Memtrace allocation profiling: original CLCW vs Wire implementation.
1
+
(** Memtrace allocation profiling for CLCW Wire codec.
2
2
3
-
Run with: MEMTRACE=clcw_original.ctf dune exec ./bench_memtrace.exe --
4
-
original or: MEMTRACE=clcw_wire.ctf dune exec ./bench_memtrace.exe -- wire
3
+
Run with: MEMTRACE=clcw.ctf dune exec ./bench_memtrace.exe
5
4
6
-
Analyze with: memtrace-hotspots clcw_original.ctf *)
5
+
Analyze with: memtrace-hotspots clcw.ctf *)
7
6
8
7
(** {1 Test Data} *)
9
8
···
28
27
Bytes.to_string b)
29
28
test_words
30
29
31
-
let test_clcw_original =
32
-
Array.map (fun w -> Clcw.decode w |> Result.get_ok) test_words
33
-
34
-
let test_clcw_wire = Array.map Clcw.to_packed test_clcw_original
30
+
(** {1 Roundtrip via int} *)
35
31
36
-
(** {1 Original Implementation} *)
37
-
38
-
let original_roundtrip () =
32
+
let roundtrip_int () =
39
33
for i = 0 to Array.length test_words - 1 do
40
34
let t = Clcw.decode test_words.(i) |> Result.get_ok in
41
35
let _ = Clcw.encode t in
42
36
()
43
37
done
44
38
45
-
(** {1 Wire Implementation} *)
39
+
(** {1 Roundtrip via bytes} *)
46
40
47
-
let wire_roundtrip () =
41
+
let roundtrip_bytes () =
48
42
for i = 0 to Array.length test_bytes - 1 do
49
43
match Clcw.decode_string test_bytes.(i) with
50
44
| Ok t ->
···
66
60
let iterations = 10000 in
67
61
68
62
(match impl with
69
-
| "original" ->
63
+
| "int" ->
70
64
for _ = 1 to iterations do
71
-
original_roundtrip ()
65
+
roundtrip_int ()
72
66
done
73
-
| "wire" ->
67
+
| "bytes" ->
74
68
for _ = 1 to iterations do
75
-
wire_roundtrip ()
69
+
roundtrip_bytes ()
76
70
done
77
71
| _ ->
78
-
Fmt.pr "Running original...\n%!";
72
+
Fmt.pr "Running int roundtrip...\n%!";
79
73
for _ = 1 to iterations / 2 do
80
-
original_roundtrip ()
74
+
roundtrip_int ()
81
75
done;
82
-
Fmt.pr "Running wire...\n%!";
76
+
Fmt.pr "Running bytes roundtrip...\n%!";
83
77
for _ = 1 to iterations / 2 do
84
-
wire_roundtrip ()
78
+
roundtrip_bytes ()
85
79
done);
86
80
87
81
Fmt.pr "Done. If MEMTRACE was set, trace file was written.\n"
+27
-76
fuzz/fuzz_clcw.ml
+27
-76
fuzz/fuzz_clcw.ml
···
16
16
check_eq ~pp:Fmt.int word_normalized word'
17
17
18
18
let test_encode_decode vcid nr =
19
-
match Clcw.vcid vcid with
20
-
| None -> ()
21
-
| Some vcid -> (
22
-
let t = Clcw.v ~vcid ~report_value:nr () in
23
-
let word = Clcw.encode t in
24
-
match Clcw.decode word with
25
-
| Error e -> fail (Fmt.str "decode failed: %a" Clcw.pp_error e)
26
-
| Ok t' -> check_eq ~pp:Clcw.pp ~eq:Clcw.equal t t')
19
+
if vcid >= 0 && vcid <= 63 then
20
+
let t = Clcw.v ~vcid ~report_value:nr () in
21
+
let word = Clcw.encode t in
22
+
match Clcw.decode word with
23
+
| Error e -> fail (Fmt.str "decode failed: %a" Clcw.pp_error e)
24
+
| Ok t' -> check_eq ~pp:Clcw.pp ~eq:Clcw.equal t t'
27
25
28
-
(** {1 Differential Tests} *)
26
+
(** {1 Wire Roundtrip Tests} *)
29
27
30
28
let pad_to_4 buf =
31
29
let len = String.length buf in
···
57
55
Bytes.set_int32_be b 0 (Int32.of_int masked);
58
56
Bytes.to_string b
59
57
60
-
let original_decode buf =
61
-
match bytes_to_int32_be buf with
62
-
| None -> None
63
-
| Some word -> (
64
-
match Clcw.decode word with Ok t -> Some t | Error _ -> None)
65
-
66
-
let original_encode (t : Clcw.t) =
67
-
let word = Clcw.encode t in
68
-
let b = Bytes.create 4 in
69
-
Bytes.set_int32_be b 0 (Int32.of_int word);
70
-
Bytes.to_string b
71
-
72
-
let wire_decode buf =
73
-
match Clcw.decode_string buf with Ok t -> Some t | Error _ -> None
74
-
75
-
let wire_encode (t : Clcw.packed) = Clcw.encode_string t
76
-
77
-
let clcw_equal (orig : Clcw.t) (wire : Clcw.packed) =
78
-
orig.control_word_type = wire.control_word_type
79
-
&& orig.version = wire.version
80
-
&& Clcw.equal_status orig.status wire.status
81
-
&& orig.cop_in_effect = wire.cop_in_effect
82
-
&& Clcw.vcid_to_int orig.vcid = wire.vcid
83
-
&& orig.flags.no_rf_available = wire.no_rf_available
84
-
&& orig.flags.no_bit_lock = wire.no_bit_lock
85
-
&& orig.flags.lockout = wire.lockout
86
-
&& orig.flags.wait = wire.wait
87
-
&& orig.flags.retransmit = wire.retransmit
88
-
&& orig.farm_b_counter = wire.farm_b_counter
89
-
&& orig.report_value = wire.report_value
90
-
91
-
let test_diff_decode buf =
92
-
let buf = pad_to_4 buf in
93
-
let orig = original_decode buf in
94
-
let wire = wire_decode buf in
95
-
match (orig, wire) with
96
-
| None, None -> ()
97
-
| Some o, Some d ->
98
-
if not (clcw_equal o d) then
99
-
fail (Fmt.str "values differ for input %s" (String.escaped buf))
100
-
| Some _, None -> fail "original decoded but wire failed"
101
-
| None, Some _ -> fail "wire decoded but original failed"
102
-
103
-
let test_diff_encode buf =
104
-
let buf = pad_to_4 buf in
105
-
match (original_decode buf, wire_decode buf) with
106
-
| Some orig, Some wire ->
107
-
let orig_bytes = original_encode orig in
108
-
let wire_bytes = wire_encode wire in
109
-
if orig_bytes <> wire_bytes then
110
-
fail
111
-
(Fmt.str "encoded bytes differ: orig=%s wire=%s"
112
-
(String.escaped orig_bytes)
113
-
(String.escaped wire_bytes))
114
-
| _ -> ()
115
-
116
-
let test_diff_roundtrip decode encode buf =
58
+
let test_wire_roundtrip buf =
117
59
let buf = pad_to_4 buf in
118
60
let expected = mask_reserved_bytes buf in
119
-
match decode buf with
120
-
| None -> ()
121
-
| Some t ->
122
-
let encoded = encode t in
61
+
match Clcw.decode_string buf with
62
+
| Error _ -> ()
63
+
| Ok t ->
64
+
let encoded = Clcw.encode_string t in
123
65
if encoded <> expected then
124
66
fail
125
67
(Fmt.str "roundtrip changed bytes: in=%s out=%s"
126
68
(String.escaped expected) (String.escaped encoded))
127
69
70
+
let test_int_wire_agree buf =
71
+
let buf = pad_to_4 buf in
72
+
match (bytes_to_int32_be buf, Clcw.decode_string buf) with
73
+
| Some word, Ok wire_t -> (
74
+
match Clcw.decode word with
75
+
| Ok int_t -> check_eq ~pp:Clcw.pp ~eq:Clcw.equal int_t wire_t
76
+
| Error _ -> fail "int decode failed but wire succeeded")
77
+
| Some word, Error _ -> (
78
+
match Clcw.decode word with
79
+
| Ok _ -> fail "int decode succeeded but wire failed"
80
+
| Error _ -> ())
81
+
| None, _ -> ()
82
+
128
83
let suite =
129
84
( "clcw",
130
85
[
131
86
test_case "roundtrip" [ int32 ] test_roundtrip;
132
87
test_case "encode-decode" [ range 64; range 256 ] test_encode_decode;
133
-
test_case "diff decode" [ bytes ] test_diff_decode;
134
-
test_case "diff encode" [ bytes ] test_diff_encode;
135
-
test_case "diff roundtrip original" [ bytes ]
136
-
(test_diff_roundtrip original_decode original_encode);
137
-
test_case "diff roundtrip wire" [ bytes ]
138
-
(test_diff_roundtrip wire_decode wire_encode);
88
+
test_case "wire roundtrip" [ bytes ] test_wire_roundtrip;
89
+
test_case "int-wire agree" [ bytes ] test_int_wire_agree;
139
90
] )
+117
-241
lib/clcw.ml
+117
-241
lib/clcw.ml
···
27
27
Bits 24-31: Report Value N(R)
28
28
v} *)
29
29
30
-
(* {1 Virtual Channel ID} *)
31
-
32
-
type vcid = int
33
-
34
-
let vcid n = if n >= 0 && n <= 63 then Some n else None
35
-
36
-
let vcid_exn n =
37
-
if n >= 0 && n <= 63 then n
38
-
else Fmt.invalid_arg "vcid: %d out of range 0-63" n
39
-
40
-
let vcid_to_int v = v
41
-
let pp_vcid = Fmt.int
42
-
let equal_vcid = Int.equal
43
-
44
30
(* {1 Types} *)
45
31
46
32
type status = Ready | Active | Reserved of int
···
64
50
| Reserved x, Reserved y -> x = y
65
51
| _ -> false
66
52
67
-
type flags = {
68
-
no_rf_available : bool;
69
-
no_bit_lock : bool;
70
-
lockout : bool;
71
-
wait : bool;
72
-
retransmit : bool;
73
-
}
74
-
75
-
let no_flags =
76
-
{
77
-
no_rf_available = false;
78
-
no_bit_lock = false;
79
-
lockout = false;
80
-
wait = false;
81
-
retransmit = false;
82
-
}
83
-
84
-
let pp_flags ppf f =
85
-
let flags = [] in
86
-
let flags = if f.no_rf_available then "no_rf" :: flags else flags in
87
-
let flags = if f.no_bit_lock then "no_bit_lock" :: flags else flags in
88
-
let flags = if f.lockout then "lockout" :: flags else flags in
89
-
let flags = if f.wait then "wait" :: flags else flags in
90
-
let flags = if f.retransmit then "retransmit" :: flags else flags in
91
-
match flags with
92
-
| [] -> Fmt.string ppf "none"
93
-
| _ -> Fmt.list ~sep:(Fmt.any ",") Fmt.string ppf (List.rev flags)
94
-
95
-
let equal_flags a b =
96
-
a.no_rf_available = b.no_rf_available
97
-
&& a.no_bit_lock = b.no_bit_lock
98
-
&& a.lockout = b.lockout && a.wait = b.wait
99
-
&& a.retransmit = b.retransmit
100
-
101
53
type t = {
102
54
control_word_type : int;
103
55
version : int;
104
56
status : status;
105
57
cop_in_effect : int;
106
-
vcid : vcid;
107
-
flags : flags;
58
+
vcid : int;
59
+
no_rf_available : bool;
60
+
no_bit_lock : bool;
61
+
lockout : bool;
62
+
wait : bool;
63
+
retransmit : bool;
108
64
farm_b_counter : int;
109
65
report_value : int;
110
66
}
···
114
70
&& a.version = b.version
115
71
&& equal_status a.status b.status
116
72
&& a.cop_in_effect = b.cop_in_effect
117
-
&& equal_vcid a.vcid b.vcid
118
-
&& equal_flags a.flags b.flags
73
+
&& a.vcid = b.vcid
74
+
&& a.no_rf_available = b.no_rf_available
75
+
&& a.no_bit_lock = b.no_bit_lock
76
+
&& a.lockout = b.lockout && a.wait = b.wait
77
+
&& a.retransmit = b.retransmit
119
78
&& a.farm_b_counter = b.farm_b_counter
120
79
&& a.report_value = b.report_value
121
80
122
81
let pp ppf t =
82
+
let flags = [] in
83
+
let flags = if t.no_rf_available then "no_rf" :: flags else flags in
84
+
let flags = if t.no_bit_lock then "no_bit_lock" :: flags else flags in
85
+
let flags = if t.lockout then "lockout" :: flags else flags in
86
+
let flags = if t.wait then "wait" :: flags else flags in
87
+
let flags = if t.retransmit then "retransmit" :: flags else flags in
88
+
let flags_str =
89
+
match flags with [] -> "none" | _ -> String.concat "," (List.rev flags)
90
+
in
123
91
Fmt.pf ppf
124
-
"@[<hv 2>{ cwt=%d;@ version=%d;@ status=%a;@ cop=%d;@ vcid=%a;@ flags=%a;@ \
92
+
"@[<hv 2>{ cwt=%d;@ version=%d;@ status=%a;@ cop=%d;@ vcid=%d;@ flags=%s;@ \
125
93
farm_b=%d;@ N(R)=%d }@]"
126
-
t.control_word_type t.version pp_status t.status t.cop_in_effect pp_vcid
127
-
t.vcid pp_flags t.flags t.farm_b_counter t.report_value
94
+
t.control_word_type t.version pp_status t.status t.cop_in_effect t.vcid
95
+
flags_str t.farm_b_counter t.report_value
128
96
129
-
(* {1 Parsing} *)
97
+
(* {1 Errors} *)
130
98
131
99
type error = Invalid_control_word_type of int | Invalid_vcid of int
132
100
···
135
103
Fmt.pf ppf "invalid control word type: %d (expected 0)" n
136
104
| Invalid_vcid n -> Fmt.pf ppf "invalid VCID: %d" n
137
105
138
-
let decode word =
139
-
(* Bit 0: Control Word Type *)
140
-
let cwt = (word lsr 31) land 1 in
141
-
(* Bits 1-2: Version *)
142
-
let version = (word lsr 29) land 3 in
143
-
(* Bits 3-5: Status *)
144
-
let status_raw = (word lsr 26) land 7 in
145
-
let status = status_of_int status_raw in
146
-
(* Bits 6-7: COP in Effect *)
147
-
let cop = (word lsr 24) land 3 in
148
-
(* Bits 8-13: VCID *)
149
-
let vcid_raw = (word lsr 18) land 63 in
150
-
(* Bits 14-15: Reserved *)
151
-
(* Bit 16: No RF Available *)
152
-
let no_rf = (word lsr 15) land 1 = 1 in
153
-
(* Bit 17: No Bit Lock *)
154
-
let no_bit_lock = (word lsr 14) land 1 = 1 in
155
-
(* Bit 18: Lockout *)
156
-
let lockout = (word lsr 13) land 1 = 1 in
157
-
(* Bit 19: Wait *)
158
-
let wait = (word lsr 12) land 1 = 1 in
159
-
(* Bit 20: Retransmit *)
160
-
let retransmit = (word lsr 11) land 1 = 1 in
161
-
(* Bits 21-22: FARM-B Counter *)
162
-
let farm_b = (word lsr 9) land 3 in
163
-
(* Bit 23: Reserved *)
164
-
(* Bits 24-31: Report Value N(R) *)
165
-
let nr = word land 0xFF in
166
-
match vcid vcid_raw with
167
-
| None -> Error (Invalid_vcid vcid_raw)
168
-
| Some vcid ->
169
-
Ok
170
-
{
171
-
control_word_type = cwt;
172
-
version;
173
-
status;
174
-
cop_in_effect = cop;
175
-
vcid;
176
-
flags =
177
-
{ no_rf_available = no_rf; no_bit_lock; lockout; wait; retransmit };
178
-
farm_b_counter = farm_b;
179
-
report_value = nr;
180
-
}
106
+
(* {1 Wire Codec} *)
181
107
182
-
(* {1 Encoding} *)
108
+
let bits n = Wire.bits ~width:n Wire.U32be
109
+
let bool = Wire.bool (bits 1)
110
+
let status_typ = Wire.map ~decode:status_of_int ~encode:int_of_status (bits 3)
183
111
184
-
let encode t =
185
-
let word = 0 in
186
-
(* Bit 0: Control Word Type *)
187
-
let word = word lor ((t.control_word_type land 1) lsl 31) in
188
-
(* Bits 1-2: Version *)
189
-
let word = word lor ((t.version land 3) lsl 29) in
190
-
(* Bits 3-5: Status *)
191
-
let word = word lor ((int_of_status t.status land 7) lsl 26) in
192
-
(* Bits 6-7: COP in Effect *)
193
-
let word = word lor ((t.cop_in_effect land 3) lsl 24) in
194
-
(* Bits 8-13: VCID *)
195
-
let word = word lor (vcid_to_int t.vcid lsl 18) in
196
-
(* Bits 14-15: Reserved (0) *)
197
-
(* Bit 16: No RF Available *)
198
-
let word = word lor if t.flags.no_rf_available then 1 lsl 15 else 0 in
199
-
(* Bit 17: No Bit Lock *)
200
-
let word = word lor if t.flags.no_bit_lock then 1 lsl 14 else 0 in
201
-
(* Bit 18: Lockout *)
202
-
let word = word lor if t.flags.lockout then 1 lsl 13 else 0 in
203
-
(* Bit 19: Wait *)
204
-
let word = word lor if t.flags.wait then 1 lsl 12 else 0 in
205
-
(* Bit 20: Retransmit *)
206
-
let word = word lor if t.flags.retransmit then 1 lsl 11 else 0 in
207
-
(* Bits 21-22: FARM-B Counter *)
208
-
let word = word lor ((t.farm_b_counter land 3) lsl 9) in
209
-
(* Bit 23: Reserved (0) *)
210
-
(* Bits 24-31: Report Value N(R) *)
211
-
let word = word lor (t.report_value land 0xFF) in
212
-
word
112
+
let f_control_word_type =
113
+
Wire.Codec.(
114
+
Wire.Field.v "control_word_type" (bits 1) $ fun t -> t.control_word_type)
213
115
214
-
(* {1 Constructors} *)
116
+
let f_version =
117
+
Wire.Codec.(Wire.Field.v "version" (bits 2) $ fun t -> t.version)
215
118
216
-
let v ?(control_word_type = 0) ?(version = 0) ?(status = Ready)
217
-
?(cop_in_effect = 0) ~vcid ?(no_rf_available = false) ?(no_bit_lock = false)
218
-
?(lockout = false) ?(wait = false) ?(retransmit = false)
219
-
?(farm_b_counter = 0) ~report_value () =
220
-
{
221
-
control_word_type;
222
-
version;
223
-
status;
224
-
cop_in_effect;
225
-
vcid;
226
-
flags = { no_rf_available; no_bit_lock; lockout; wait; retransmit };
227
-
farm_b_counter;
228
-
report_value;
229
-
}
119
+
let f_status = Wire.Codec.(Wire.Field.v "status" status_typ $ fun t -> t.status)
230
120
231
-
(* {1 Packed Wire Representation} *)
121
+
let f_cop_in_effect =
122
+
Wire.Codec.(Wire.Field.v "cop_in_effect" (bits 2) $ fun t -> t.cop_in_effect)
232
123
233
-
type packed = {
234
-
control_word_type : int;
235
-
version : int;
236
-
status : status;
237
-
cop_in_effect : int;
238
-
vcid : int;
239
-
no_rf_available : bool;
240
-
no_bit_lock : bool;
241
-
lockout : bool;
242
-
wait : bool;
243
-
retransmit : bool;
244
-
farm_b_counter : int;
245
-
report_value : int;
246
-
}
124
+
let f_vcid = Wire.Codec.(Wire.Field.v "vcid" (bits 6) $ fun t -> t.vcid)
125
+
let f_reserved0 = Wire.Codec.(Wire.Field.v "reserved0" (bits 2) $ fun _ -> 0)
247
126
248
-
let to_packed (t : t) =
249
-
{
250
-
control_word_type = t.control_word_type;
251
-
version = t.version;
252
-
status = t.status;
253
-
cop_in_effect = t.cop_in_effect;
254
-
vcid = vcid_to_int t.vcid;
255
-
no_rf_available = t.flags.no_rf_available;
256
-
no_bit_lock = t.flags.no_bit_lock;
257
-
lockout = t.flags.lockout;
258
-
wait = t.flags.wait;
259
-
retransmit = t.flags.retransmit;
260
-
farm_b_counter = t.farm_b_counter;
261
-
report_value = t.report_value;
262
-
}
127
+
let f_no_rf_available =
128
+
Wire.Codec.(Wire.Field.v "no_rf_available" bool $ fun t -> t.no_rf_available)
263
129
264
-
let of_packed p =
265
-
match vcid p.vcid with
266
-
| None -> Error (Invalid_vcid p.vcid)
267
-
| Some vcid ->
268
-
Ok
269
-
{
270
-
control_word_type = p.control_word_type;
271
-
version = p.version;
272
-
status = p.status;
273
-
cop_in_effect = p.cop_in_effect;
274
-
vcid;
275
-
flags =
276
-
{
277
-
no_rf_available = p.no_rf_available;
278
-
no_bit_lock = p.no_bit_lock;
279
-
lockout = p.lockout;
280
-
wait = p.wait;
281
-
retransmit = p.retransmit;
282
-
};
283
-
farm_b_counter = p.farm_b_counter;
284
-
report_value = p.report_value;
285
-
}
130
+
let f_no_bit_lock =
131
+
Wire.Codec.(Wire.Field.v "no_bit_lock" bool $ fun t -> t.no_bit_lock)
132
+
133
+
let f_lockout = Wire.Codec.(Wire.Field.v "lockout" bool $ fun t -> t.lockout)
134
+
let f_wait = Wire.Codec.(Wire.Field.v "wait" bool $ fun t -> t.wait)
135
+
136
+
let f_retransmit =
137
+
Wire.Codec.(Wire.Field.v "retransmit" bool $ fun t -> t.retransmit)
138
+
139
+
let f_farm_b_counter =
140
+
Wire.Codec.(
141
+
Wire.Field.v "farm_b_counter" (bits 2) $ fun t -> t.farm_b_counter)
142
+
143
+
let f_reserved1 = Wire.Codec.(Wire.Field.v "reserved1" (bits 1) $ fun _ -> 0)
286
144
287
-
let equal_packed a b =
288
-
a.control_word_type = b.control_word_type
289
-
&& a.version = b.version
290
-
&& equal_status a.status b.status
291
-
&& a.cop_in_effect = b.cop_in_effect
292
-
&& a.vcid = b.vcid
293
-
&& a.no_rf_available = b.no_rf_available
294
-
&& a.no_bit_lock = b.no_bit_lock
295
-
&& a.lockout = b.lockout && a.wait = b.wait
296
-
&& a.retransmit = b.retransmit
297
-
&& a.farm_b_counter = b.farm_b_counter
298
-
&& a.report_value = b.report_value
145
+
let f_report_value =
146
+
Wire.Codec.(Wire.Field.v "report_value" (bits 8) $ fun t -> t.report_value)
299
147
300
-
(* Wire Codec *)
301
148
let codec =
302
-
let bits n = Wire.bits ~width:n Wire.U32be in
303
-
let bool = Wire.bool (bits 1) in
304
-
let status = Wire.map ~decode:status_of_int ~encode:int_of_status (bits 3) in
305
-
let f_cwt = Wire.Field.v "control_word_type" (bits 1) in
306
-
let f_version = Wire.Field.v "version" (bits 2) in
307
-
let f_status = Wire.Field.v "status" status in
308
-
let f_cop = Wire.Field.v "cop_in_effect" (bits 2) in
309
-
let f_vcid = Wire.Field.v "vcid" (bits 6) in
310
-
let f_reserved0 = Wire.Field.v "reserved0" (bits 2) in
311
-
let f_no_rf = Wire.Field.v "no_rf_available" bool in
312
-
let f_no_bit = Wire.Field.v "no_bit_lock" bool in
313
-
let f_lockout = Wire.Field.v "lockout" bool in
314
-
let f_wait = Wire.Field.v "wait" bool in
315
-
let f_retransmit = Wire.Field.v "retransmit" bool in
316
-
let f_farm_b = Wire.Field.v "farm_b_counter" (bits 2) in
317
-
let f_reserved1 = Wire.Field.v "reserved1" (bits 1) in
318
-
let f_report = Wire.Field.v "report_value" (bits 8) in
319
149
Wire.Codec.v "Clcw"
320
150
(fun cwt ver st cop vcid _r0 no_rf no_bit lck wt rt fb _r1 nr ->
321
151
{
···
334
164
})
335
165
Wire.Codec.
336
166
[
337
-
(f_cwt $ fun t -> t.control_word_type);
338
-
(f_version $ fun t -> t.version);
339
-
(f_status $ fun t -> t.status);
340
-
(f_cop $ fun t -> t.cop_in_effect);
341
-
(f_vcid $ fun t -> t.vcid);
342
-
(f_reserved0 $ fun _ -> 0);
343
-
(f_no_rf $ fun t -> t.no_rf_available);
344
-
(f_no_bit $ fun t -> t.no_bit_lock);
345
-
(f_lockout $ fun t -> t.lockout);
346
-
(f_wait $ fun t -> t.wait);
347
-
(f_retransmit $ fun t -> t.retransmit);
348
-
(f_farm_b $ fun t -> t.farm_b_counter);
349
-
(f_reserved1 $ fun _ -> 0);
350
-
(f_report $ fun t -> t.report_value);
167
+
f_control_word_type;
168
+
f_version;
169
+
f_status;
170
+
f_cop_in_effect;
171
+
f_vcid;
172
+
f_reserved0;
173
+
f_no_rf_available;
174
+
f_no_bit_lock;
175
+
f_lockout;
176
+
f_wait;
177
+
f_retransmit;
178
+
f_farm_b_counter;
179
+
f_reserved1;
180
+
f_report_value;
351
181
]
352
182
353
183
let struct_ = Wire.Everparse.struct_of_codec codec
···
356
186
Wire.Everparse.Raw.module_ ~doc:"CCSDS Command Link Control Word (232.1-B-2)"
357
187
[ Wire.Everparse.Raw.typedef ~entrypoint:true struct_ ]
358
188
359
-
(* Parse/Encode via Wire Codec *)
189
+
(* {1 Parse/Encode via Wire Codec} *)
190
+
360
191
let wire_size = Wire.Codec.wire_size codec
361
192
362
193
let decode_bytes buf =
···
378
209
let buf = Bytes.create wire_size in
379
210
Wire.Codec.encode codec t buf 0;
380
211
buf
212
+
213
+
(* {1 int Encoding/Decoding via Wire Codec} *)
214
+
215
+
let decode word =
216
+
let buf = Bytes.create 4 in
217
+
Bytes.set_int32_be buf 0 (Int32.of_int word);
218
+
match Wire.Codec.decode codec buf 0 with
219
+
| Error _ ->
220
+
(* The wire codec never fails on valid 4-byte input (no constraints),
221
+
but we still validate vcid range for backward compatibility. *)
222
+
let vcid_raw = (word lsr 18) land 63 in
223
+
if vcid_raw < 0 || vcid_raw > 63 then Error (Invalid_vcid vcid_raw)
224
+
else
225
+
let cwt = (word lsr 31) land 1 in
226
+
Error (Invalid_control_word_type cwt)
227
+
| Ok t -> Ok t
228
+
229
+
let encode t =
230
+
let buf = Bytes.create 4 in
231
+
Wire.Codec.encode codec t buf 0;
232
+
(* Int32.to_int sign-extends on 64-bit; mask to unsigned 32 bits *)
233
+
Int32.to_int (Bytes.get_int32_be buf 0) land 0xFFFFFFFF
234
+
235
+
(* {1 Constructors} *)
236
+
237
+
let v ?(control_word_type = 0) ?(version = 0) ?(status = Ready)
238
+
?(cop_in_effect = 0) ~vcid ?(no_rf_available = false) ?(no_bit_lock = false)
239
+
?(lockout = false) ?(wait = false) ?(retransmit = false)
240
+
?(farm_b_counter = 0) ~report_value () =
241
+
if vcid < 0 || vcid > 63 then
242
+
Fmt.invalid_arg "vcid: %d out of range 0-63" vcid;
243
+
{
244
+
control_word_type;
245
+
version;
246
+
status;
247
+
cop_in_effect;
248
+
vcid;
249
+
no_rf_available;
250
+
no_bit_lock;
251
+
lockout;
252
+
wait;
253
+
retransmit;
254
+
farm_b_counter;
255
+
report_value;
256
+
}
381
257
382
258
(* FFI Code Generation *)
383
259
let c_stubs () = Wire_stubs.to_c_stubs [ struct_ ]
+46
-83
lib/clcw.mli
+46
-83
lib/clcw.mli
···
7
7
8
8
The CLCW is a 32-bit word carried in the Operational Control Field (OCF) of
9
9
TM and AOS Transfer Frames. It provides feedback from the receiving
10
-
spacecraft to the ground about the state of the command link. *)
10
+
spacecraft to the ground about the state of the command link.
11
11
12
-
(** {1 Virtual Channel ID} *)
13
-
14
-
type vcid = private int
15
-
(** Virtual Channel Identifier (6 bits, 0-63). *)
16
-
17
-
val vcid : int -> vcid option
18
-
(** [vcid n] validates [n] is in range 0-63. *)
19
-
20
-
val vcid_exn : int -> vcid
21
-
(** [vcid_exn n] returns [n] as a vcid, raising [Invalid_argument] if out of
22
-
range. *)
23
-
24
-
val vcid_to_int : vcid -> int
25
-
(** [vcid_to_int v] returns the integer value of [v]. *)
26
-
27
-
val pp_vcid : vcid Fmt.t
28
-
(** Pretty-printer for virtual channel IDs. *)
29
-
30
-
val equal_vcid : vcid -> vcid -> bool
31
-
(** Equality for virtual channel IDs. *)
12
+
All encoding and decoding goes through the {!codec} Wire codec. The
13
+
{!decode} / {!encode} functions convert between [int] and [bytes] internally
14
+
so callers keep the same interface. *)
32
15
33
16
(** {1 Types} *)
34
17
···
46
29
val int_of_status : status -> int
47
30
(** [int_of_status s] encodes a status to its 3-bit integer value. *)
48
31
49
-
type flags = {
50
-
no_rf_available : bool; (** No RF Available flag. *)
51
-
no_bit_lock : bool; (** No Bit Lock flag. *)
32
+
type t = {
33
+
control_word_type : int; (** Control word type (1 bit, should be 0). *)
34
+
version : int; (** CLCW version number (2 bits). *)
35
+
status : status; (** Status field (3 bits). *)
36
+
cop_in_effect : int; (** COP in effect (2 bits). *)
37
+
vcid : int; (** Virtual channel ID (6 bits, 0-63). *)
38
+
no_rf_available : bool; (** No RF available flag. *)
39
+
no_bit_lock : bool; (** No bit lock flag. *)
52
40
lockout : bool; (** Lockout flag. *)
53
41
wait : bool; (** Wait flag. *)
54
42
retransmit : bool; (** Retransmit flag. *)
55
-
}
56
-
(** CLCW flags. *)
57
-
58
-
val no_flags : flags
59
-
(** All flags set to false. *)
60
-
61
-
val pp_flags : flags Fmt.t
62
-
(** Pretty-printer for CLCW flags. *)
63
-
64
-
val equal_flags : flags -> flags -> bool
65
-
(** Equality for CLCW flags. *)
66
-
67
-
type t = {
68
-
control_word_type : int; (** Control word type (should be 0 for CLCW). *)
69
-
version : int; (** CLCW version number (2 bits). *)
70
-
status : status; (** Status field. *)
71
-
cop_in_effect : int; (** COP in effect (2 bits). *)
72
-
vcid : vcid; (** Virtual channel ID. *)
73
-
flags : flags; (** CLCW flags. *)
74
43
farm_b_counter : int; (** FARM-B counter (2 bits). *)
75
44
report_value : int; (** Report value N(R) (8 bits). *)
76
45
}
77
-
(** Command Link Control Word. *)
46
+
(** Command Link Control Word. Fields map directly to the Wire codec. Reserved
47
+
bits are handled by the codec and not exposed. *)
78
48
79
49
val equal : t -> t -> bool
80
50
···
90
60
val pp_error : error Fmt.t
91
61
92
62
val decode : int -> (t, error) result
93
-
(** [decode word] decodes a 32-bit CLCW word. *)
63
+
(** [decode word] decodes a 32-bit CLCW word using the Wire codec. *)
94
64
95
65
val encode : t -> int
96
-
(** [encode t] encodes a CLCW to a 32-bit word. *)
66
+
(** [encode t] encodes a CLCW to a 32-bit word using the Wire codec. *)
97
67
98
68
(** {1 Constructors} *)
99
69
···
102
72
?version:int ->
103
73
?status:status ->
104
74
?cop_in_effect:int ->
105
-
vcid:vcid ->
75
+
vcid:int ->
106
76
?no_rf_available:bool ->
107
77
?no_bit_lock:bool ->
108
78
?lockout:bool ->
···
112
82
report_value:int ->
113
83
unit ->
114
84
t
115
-
(** [v ~vcid ~report_value ()] constructs a CLCW with the given fields. *)
85
+
(** [v ~vcid ~report_value ()] constructs a CLCW with the given fields.
116
86
117
-
(** {1 Packed Wire Representation} *)
118
-
119
-
type packed = {
120
-
control_word_type : int; (** Control word type (1 bit). *)
121
-
version : int; (** Version number (2 bits). *)
122
-
status : status; (** Status field (3 bits). *)
123
-
cop_in_effect : int; (** COP in effect (2 bits). *)
124
-
vcid : int; (** Virtual channel ID (6 bits). *)
125
-
no_rf_available : bool; (** No RF available flag. *)
126
-
no_bit_lock : bool; (** No bit lock flag. *)
127
-
lockout : bool; (** Lockout flag. *)
128
-
wait : bool; (** Wait flag. *)
129
-
retransmit : bool; (** Retransmit flag. *)
130
-
farm_b_counter : int; (** FARM-B counter (2 bits). *)
131
-
report_value : int; (** Report value N(R) (8 bits). *)
132
-
}
133
-
(** CLCW with typed fields. Reserved bits are handled by the codec and not
134
-
exposed. *)
135
-
136
-
val to_packed : t -> packed
137
-
(** [to_packed t] encodes a CLCW to its packed wire representation. *)
138
-
139
-
val of_packed : packed -> (t, error) result
140
-
(** [of_packed p] decodes a packed CLCW to a structured value. *)
141
-
142
-
val equal_packed : packed -> packed -> bool
87
+
@raise Invalid_argument if [vcid] is not in range 0-63. *)
143
88
144
89
(** {1 Wire Codec} *)
145
90
146
-
val codec : packed Wire.Codec.t
91
+
val codec : t Wire.Codec.t
147
92
148
93
val struct_ : Wire.Everparse.struct_
149
94
(** Wire struct descriptor for CLCW. *)
···
151
96
val module_ : Wire.Everparse.module_
152
97
(** Wire module descriptor for CLCW. *)
153
98
99
+
(** {1 Wire Fields}
100
+
101
+
Bound field handles for zero-copy access via {!Wire.Codec.get} /
102
+
{!Wire.Codec.set} and batch bitfield reads via {!Wire.Codec.bitfield}. *)
103
+
104
+
val f_control_word_type : (int, t) Wire.Codec.field
105
+
val f_version : (int, t) Wire.Codec.field
106
+
val f_status : (status, t) Wire.Codec.field
107
+
val f_cop_in_effect : (int, t) Wire.Codec.field
108
+
val f_vcid : (int, t) Wire.Codec.field
109
+
val f_no_rf_available : (bool, t) Wire.Codec.field
110
+
val f_no_bit_lock : (bool, t) Wire.Codec.field
111
+
val f_lockout : (bool, t) Wire.Codec.field
112
+
val f_wait : (bool, t) Wire.Codec.field
113
+
val f_retransmit : (bool, t) Wire.Codec.field
114
+
val f_farm_b_counter : (int, t) Wire.Codec.field
115
+
val f_report_value : (int, t) Wire.Codec.field
116
+
154
117
(** {1 Wire Parse/Encode} *)
155
118
156
119
val wire_size : int
157
120
158
-
val decode_bytes : bytes -> (packed, Wire.parse_error) result
159
-
(** [decode_bytes buf] parses a packed CLCW from bytes. *)
121
+
val decode_bytes : bytes -> (t, Wire.parse_error) result
122
+
(** [decode_bytes buf] parses a CLCW from bytes. *)
160
123
161
-
val decode_string : string -> (packed, Wire.parse_error) result
162
-
(** [decode_string s] parses a packed CLCW from a string. *)
124
+
val decode_string : string -> (t, Wire.parse_error) result
125
+
(** [decode_string s] parses a CLCW from a string. *)
163
126
164
-
val encode_string : packed -> string
165
-
(** [encode_string p] serializes a packed CLCW to a string. *)
127
+
val encode_string : t -> string
128
+
(** [encode_string t] serializes a CLCW to a string. *)
166
129
167
-
val encode_bytes : packed -> bytes
168
-
(** [encode_bytes p] serializes a packed CLCW to bytes. *)
130
+
val encode_bytes : t -> bytes
131
+
(** [encode_bytes t] serializes a CLCW to bytes. *)
169
132
170
133
(** {1 FFI Code Generation} *)
171
134
+38
-23
test/test_clcw.ml
+38
-23
test/test_clcw.ml
···
6
6
let clcw = Alcotest.testable Clcw.pp Clcw.equal
7
7
8
8
let test_roundtrip () =
9
-
let vcid = Clcw.vcid_exn 5 in
10
9
let t =
11
-
Clcw.v ~vcid ~report_value:42 ~lockout:true ~farm_b_counter:2 ~version:1 ()
10
+
Clcw.v ~vcid:5 ~report_value:42 ~lockout:true ~farm_b_counter:2 ~version:1
11
+
()
12
12
in
13
13
let word = Clcw.encode t in
14
14
match Clcw.decode word with
···
40
40
"status active" true
41
41
(Clcw.equal_status t.status Clcw.Active);
42
42
Alcotest.(check int) "cop" 1 t.cop_in_effect;
43
-
Alcotest.(check int) "vcid" 10 (Clcw.vcid_to_int t.vcid);
43
+
Alcotest.(check int) "vcid" 10 t.vcid;
44
44
Alcotest.(check int) "report_value" 50 t.report_value
45
45
46
46
let test_flags () =
47
-
let vcid = Clcw.vcid_exn 0 in
48
47
let t =
49
-
Clcw.v ~vcid ~report_value:0 ~no_rf_available:true ~no_bit_lock:true
48
+
Clcw.v ~vcid:0 ~report_value:0 ~no_rf_available:true ~no_bit_lock:true
50
49
~lockout:true ~wait:true ~retransmit:true ()
51
50
in
52
51
let word = Clcw.encode t in
53
52
match Clcw.decode word with
54
53
| Error e -> Alcotest.failf "decode failed: %a" Clcw.pp_error e
55
54
| Ok t' ->
56
-
Alcotest.(check bool) "no_rf" true t'.flags.no_rf_available;
57
-
Alcotest.(check bool) "no_bit_lock" true t'.flags.no_bit_lock;
58
-
Alcotest.(check bool) "lockout" true t'.flags.lockout;
59
-
Alcotest.(check bool) "wait" true t'.flags.wait;
60
-
Alcotest.(check bool) "retransmit" true t'.flags.retransmit
55
+
Alcotest.(check bool) "no_rf" true t'.no_rf_available;
56
+
Alcotest.(check bool) "no_bit_lock" true t'.no_bit_lock;
57
+
Alcotest.(check bool) "lockout" true t'.lockout;
58
+
Alcotest.(check bool) "wait" true t'.wait;
59
+
Alcotest.(check bool) "retransmit" true t'.retransmit
61
60
62
61
let test_vcid_bounds () =
63
-
Alcotest.(check bool) "vcid 0 valid" true (Option.is_some (Clcw.vcid 0));
64
-
Alcotest.(check bool) "vcid 63 valid" true (Option.is_some (Clcw.vcid 63));
65
-
Alcotest.(check bool) "vcid -1 invalid" true (Option.is_none (Clcw.vcid (-1)));
66
-
Alcotest.(check bool) "vcid 64 invalid" true (Option.is_none (Clcw.vcid 64))
62
+
(* vcid 0 and 63 should roundtrip fine *)
63
+
let t0 = Clcw.v ~vcid:0 ~report_value:0 () in
64
+
let w0 = Clcw.encode t0 in
65
+
(match Clcw.decode w0 with
66
+
| Error e -> Alcotest.failf "vcid=0 failed: %a" Clcw.pp_error e
67
+
| Ok t' -> Alcotest.(check int) "vcid 0" 0 t'.vcid);
68
+
let t63 = Clcw.v ~vcid:63 ~report_value:0 () in
69
+
let w63 = Clcw.encode t63 in
70
+
(match Clcw.decode w63 with
71
+
| Error e -> Alcotest.failf "vcid=63 failed: %a" Clcw.pp_error e
72
+
| Ok t' -> Alcotest.(check int) "vcid 63" 63 t'.vcid);
73
+
(* vcid -1 and 64 should raise Invalid_argument in the constructor *)
74
+
Alcotest.(check bool)
75
+
"vcid -1 invalid" true
76
+
(try
77
+
ignore (Clcw.v ~vcid:(-1) ~report_value:0 ());
78
+
false
79
+
with Invalid_argument _ -> true);
80
+
Alcotest.(check bool)
81
+
"vcid 64 invalid" true
82
+
(try
83
+
ignore (Clcw.v ~vcid:64 ~report_value:0 ());
84
+
false
85
+
with Invalid_argument _ -> true)
67
86
68
87
(* Test: All COP-in-effect values (2-bit field, 0-3) *)
69
88
let test_cop_values () =
70
-
let vcid = Clcw.vcid_exn 0 in
71
89
List.iter
72
90
(fun cop ->
73
-
let t = Clcw.v ~vcid ~report_value:0 ~cop_in_effect:cop () in
91
+
let t = Clcw.v ~vcid:0 ~report_value:0 ~cop_in_effect:cop () in
74
92
let word = Clcw.encode t in
75
93
match Clcw.decode word with
76
94
| Error e -> Alcotest.failf "decode cop=%d failed: %a" cop Clcw.pp_error e
···
82
100
83
101
(* Test: All status field values *)
84
102
let test_status_values () =
85
-
let vcid = Clcw.vcid_exn 0 in
86
103
let status_testable = Alcotest.testable Clcw.pp_status Clcw.equal_status in
87
104
(* Ready = 0, Active = 1, Reserved 2-7 *)
88
105
let cases =
···
99
116
in
100
117
List.iter
101
118
(fun (status, label) ->
102
-
let t = Clcw.v ~vcid ~report_value:0 ~status () in
119
+
let t = Clcw.v ~vcid:0 ~report_value:0 ~status () in
103
120
let word = Clcw.encode t in
104
121
match Clcw.decode word with
105
122
| Error e ->
···
109
126
110
127
(* Test: report_value boundary (8-bit field, 0 and 255) *)
111
128
let test_report_value_boundary () =
112
-
let vcid = Clcw.vcid_exn 0 in
113
129
(* report_value = 0 *)
114
-
let t0 = Clcw.v ~vcid ~report_value:0 () in
130
+
let t0 = Clcw.v ~vcid:0 ~report_value:0 () in
115
131
let word0 = Clcw.encode t0 in
116
132
(match Clcw.decode word0 with
117
133
| Error e -> Alcotest.failf "decode rv=0 failed: %a" Clcw.pp_error e
118
134
| Ok t' -> Alcotest.(check int) "report_value=0" 0 t'.report_value);
119
135
(* report_value = 255 *)
120
-
let t255 = Clcw.v ~vcid ~report_value:255 () in
136
+
let t255 = Clcw.v ~vcid:0 ~report_value:255 () in
121
137
let word255 = Clcw.encode t255 in
122
138
match Clcw.decode word255 with
123
139
| Error e -> Alcotest.failf "decode rv=255 failed: %a" Clcw.pp_error e
···
125
141
126
142
(* Test: FARM-B counter boundary (2-bit field, 0-3) *)
127
143
let test_farm_b_counter_boundary () =
128
-
let vcid = Clcw.vcid_exn 0 in
129
144
List.iter
130
145
(fun fb ->
131
-
let t = Clcw.v ~vcid ~report_value:0 ~farm_b_counter:fb () in
146
+
let t = Clcw.v ~vcid:0 ~report_value:0 ~farm_b_counter:fb () in
132
147
let word = Clcw.encode t in
133
148
match Clcw.decode word with
134
149
| Error e ->