feat(dmr): decode full link control

DMRDecoder.pas

@@ -56,6 +56,12 @@ type
     ColorCode: Integer;
     DataType: Integer;
     SlotTypeCorrectedBits: Integer;
+    LinkControlValid: Boolean;
+    LCSlot: Integer;
+    LCOpcode: Integer;
+    ServiceOptions: Integer;
+    TargetID: LongWord;
+    SourceID: LongWord;
   end;
 
   TDMRDecoder = class;
@@ -101,6 +107,10 @@ type
     FCurrentBurstPos: Integer;
     FLastBurst: TDMRDibitBurst;
     FLastBurstInfo: TDMRBurstInfo;
+    FLastLinkControl: TDMRLinkControl;
+    FLastLCSlot: Integer;
+    FColorCodeValid: Boolean;
+    FColorCode, FLastDataType, FSlotTypeCorrectedBits: Integer;
     FBurstCount: QWord;
     FRMSSq: Double;
 
@@ -259,6 +269,12 @@ begin
     FillChar(FCurrentBurst, SizeOf(FCurrentBurst), 0);
     FillChar(FLastBurst, SizeOf(FLastBurst), 0);
     FillChar(FLastBurstInfo, SizeOf(FLastBurstInfo), 0);
+    FillChar(FLastLinkControl, SizeOf(FLastLinkControl), 0);
+    FLastLCSlot := -1;
+    FColorCodeValid := False;
+    FColorCode := 0;
+    FLastDataType := 0;
+    FSlotTypeCorrectedBits := 0;
     FTrackPhase := -1;
     FCurrentBurstPos := 0;
     FBurstCount := 0;
@@ -445,6 +461,26 @@ procedure TDMRDecoder.CompleteBurst;
 begin
   Move(FCurrentBurst[0], FLastBurst[0], SizeOf(FLastBurst));
   DMRParseBurst(FLastBurst, FLastBurstInfo);
+  if FLastBurstInfo.SlotType.Valid and
+     (FSyncKind in [dskBSData, dskMSData, dskDirectTS1Data,
+      dskDirectTS2Data]) then
+  begin
+    FColorCodeValid := True;
+    FColorCode := FLastBurstInfo.SlotType.ColorCode;
+    FLastDataType := FLastBurstInfo.SlotType.DataType;
+    FSlotTypeCorrectedBits := FLastBurstInfo.SlotType.CorrectedBits;
+  end;
+  if FLastBurstInfo.LinkControl.Decoded then
+  begin
+    FLastLinkControl := FLastBurstInfo.LinkControl;
+    if (FSyncKind in [dskBSData, dskBSVoice]) and
+       FLastBurstInfo.CACH.Valid then
+      FLastLCSlot := FLastBurstInfo.CACH.Slot
+    else if FSyncKind in [dskDirectTS2Data, dskDirectTS2Voice] then
+      FLastLCSlot := 1
+    else
+      FLastLCSlot := 0;
+  end;
   Inc(FBurstCount);
   FCurrentBurstPos := 0;
 end;
@@ -513,12 +549,16 @@ begin
       S.LCSS := FLastBurstInfo.CACH.LCSS;
       // Voice sync replaces the centre Slot Type field. Do not expose a
       // chance Golay match from AMBE bits as a real colour/data type.
-      S.SlotTypeValid := FLastBurstInfo.SlotType.Valid and
+      S.SlotTypeValid := FColorCodeValid;
-                         (FSyncKind in [dskBSData, dskMSData,
+      S.ColorCode := FColorCode;
-                          dskDirectTS1Data, dskDirectTS2Data]);
+      S.DataType := FLastDataType;
-      S.ColorCode := FLastBurstInfo.SlotType.ColorCode;
+      S.SlotTypeCorrectedBits := FSlotTypeCorrectedBits;
-      S.DataType := FLastBurstInfo.SlotType.DataType;
+      S.LinkControlValid := FLastLinkControl.Decoded;
-      S.SlotTypeCorrectedBits := FLastBurstInfo.SlotType.CorrectedBits;
+      S.LCSlot := FLastLCSlot;
+      S.LCOpcode := FLastLinkControl.Opcode;
+      S.ServiceOptions := FLastLinkControl.ServiceOptions;
+      S.TargetID := FLastLinkControl.TargetID;
+      S.SourceID := FLastLinkControl.SourceID;
     finally
       FStatusLock.Leave;
     end;

DMRProtocol.pas

@@ -24,6 +24,7 @@ type
   TDMRDibitBurst = array[0..DMR_PROTOCOL_BURST_DIBITS - 1] of Byte;
   TDMRBit7 = array[0..6] of Byte;
   TDMRBit20 = array[0..19] of Byte;
+  TDMRBit96 = array[0..95] of Byte;
 
   TDMRCACH = record
     Valid: Boolean;
@@ -40,16 +41,38 @@ type
     DataType: Integer;
   end;
 
+  TDMRLinkControl = record
+    Decoded: Boolean;
+    CRCValid: Boolean;
+    RSCorrectedBytes: Integer;
+    ProtectedFlag: Boolean;
+    Reserved: Boolean;
+    Opcode: Integer;
+    FeatureSetID: Integer;
+    ServiceOptions: Integer;
+    TargetID: LongWord;
+    SourceID: LongWord;
+  end;
+
   TDMRBurstInfo = record
     CACH: TDMRCACH;
     SlotType: TDMRSlotType;
+    BPTCValid: Boolean;
+    BPTCIrrecoverableErrors: Integer;
+    Payload96: TDMRBit96;
+    LinkControl: TDMRLinkControl;
   end;
 
 function DMRHamming74Encode(Value: Byte): TDMRBit7;
 function DMRGolay208Encode(Value: Byte): TDMRBit20;
+procedure DMRBPTC19696Encode(const Payload: TDMRBit96;
+  out Burst: TDMRDibitBurst);
+procedure DMRFullLCSetParity(var Payload: TDMRBit96; DataType: Integer);
 function DMRDecodeCACH(const Burst: TDMRDibitBurst; out CACH: TDMRCACH): Boolean;
 function DMRDecodeSlotType(const Burst: TDMRDibitBurst;
   out SlotType: TDMRSlotType): Boolean;
+function DMRDecodeBPTC19696(const Burst: TDMRDibitBurst;
+  out Payload: TDMRBit96; out IrrecoverableErrors: Integer): Boolean;
 procedure DMRParseBurst(const Burst: TDMRDibitBurst; out Info: TDMRBurstInfo);
 function DMRDataTypeName(DataType: Integer): string;
 
@@ -81,6 +104,12 @@ const
     (0,0,0,0,0,0,0,1, 1,0,0,0,1,1,1,0,1,0,1,1)
   );
 
+  // Syndrome values for bit positions of the systematic Hamming codewords.
+  HAMMING_13_9_SYNDROME: array[0..12] of Byte =
+    (15,14,7,10,5,11,12,6,3, 8,4,2,1);
+  HAMMING_15_11_SYNDROME: array[0..14] of Byte =
+    (9,13,15,14,7,10,5,11,12,6,3, 8,4,2,1);
+
 function DMRHamming74Encode(Value: Byte): TDMRBit7;
 var
   i, j: Integer;
@@ -101,6 +130,79 @@ begin
       for j := 0 to 19 do Result[j] := Result[j] xor GOLAY_20_8_G[i, j];
 end;
 
+procedure EncodeHamming(var Codeword: array of Byte; DataBits: Integer;
+  const Syndromes: array of Byte);
+var
+  i, Syndrome: Integer;
+begin
+  Syndrome := 0;
+  for i := 0 to DataBits - 1 do
+    if (Codeword[i] and 1) <> 0 then Syndrome := Syndrome xor Syndromes[i];
+  // The final four systematic parity positions have syndromes 8,4,2,1.
+  for i := 0 to 3 do Codeword[DataBits + i] := (Syndrome shr (3 - i)) and 1;
+end;
+
+function CorrectHamming(var Codeword: array of Byte;
+  const Syndromes: array of Byte): Boolean;
+var
+  i, Syndrome, Position: Integer;
+begin
+  Syndrome := 0;
+  for i := 0 to High(Codeword) do
+    if (Codeword[i] and 1) <> 0 then Syndrome := Syndrome xor Syndromes[i];
+  if Syndrome = 0 then Exit(True);
+  Position := -1;
+  for i := 0 to High(Codeword) do
+    if Syndromes[i] = Syndrome then begin Position := i; Break; end;
+  Result := Position >= 0;
+  if Result then Codeword[Position] := Codeword[Position] xor 1;
+end;
+
+procedure DMRBPTC19696Encode(const Payload: TDMRBit96;
+  out Burst: TDMRDibitBurst);
+var
+  Matrix: array[0..12, 0..14] of Byte;
+  Deinterleaved, Air: array[0..195] of Byte;
+  Row: array[0..14] of Byte;
+  Column: array[0..12] of Byte;
+  i, j, k: Integer;
+begin
+  FillChar(Burst, SizeOf(Burst), 0);
+  FillChar(Matrix, SizeOf(Matrix), 0);
+  k := 0;
+  for j := 3 to 10 do begin Matrix[0, j] := Payload[k] and 1; Inc(k); end;
+  for i := 1 to 8 do
+    for j := 0 to 10 do begin Matrix[i, j] := Payload[k] and 1; Inc(k); end;
+
+  for i := 0 to 8 do
+  begin
+    for j := 0 to 14 do Row[j] := Matrix[i, j];
+    EncodeHamming(Row, 11, HAMMING_15_11_SYNDROME);
+    for j := 0 to 14 do Matrix[i, j] := Row[j];
+  end;
+  for j := 0 to 14 do
+  begin
+    for i := 0 to 12 do Column[i] := Matrix[i, j];
+    EncodeHamming(Column, 9, HAMMING_13_9_SYNDROME);
+    for i := 0 to 12 do Matrix[i, j] := Column[i];
+  end;
+
+  Deinterleaved[0] := 0; // R(3)
+  k := 1;
+  for i := 0 to 12 do
+    for j := 0 to 14 do begin Deinterleaved[k] := Matrix[i, j]; Inc(k); end;
+  for i := 0 to 195 do Air[i] := Deinterleaved[(i * 13) mod 196];
+  k := 0;
+  for i := 12 to 60 do
+  begin
+    Burst[i] := (Air[k] shl 1) or Air[k + 1]; Inc(k, 2);
+  end;
+  for i := 95 to 143 do
+  begin
+    Burst[i] := (Air[k] shl 1) or Air[k + 1]; Inc(k, 2);
+  end;
+end;
+
 function DecodeHamming74(const Received: TDMRBit7; out Value: Byte;
   out Corrected: Integer): Boolean;
 var
@@ -201,11 +303,220 @@ begin
   Result := SlotType.Valid;
 end;
 
+function DMRDecodeBPTC19696(const Burst: TDMRDibitBurst;
+  out Payload: TDMRBit96; out IrrecoverableErrors: Integer): Boolean;
+var
+  Air, Deinterleaved: array[0..195] of Byte;
+  Matrix: array[0..12, 0..14] of Byte;
+  Row: array[0..14] of Byte;
+  Column: array[0..12] of Byte;
+  i, j, k, Pass: Integer;
+begin
+  FillChar(Payload, SizeOf(Payload), 0);
+  k := 0;
+  for i := 12 to 60 do
+  begin
+    Air[k] := (Burst[i] shr 1) and 1; Inc(k);
+    Air[k] := Burst[i] and 1; Inc(k);
+  end;
+  for i := 95 to 143 do
+  begin
+    Air[k] := (Burst[i] shr 1) and 1; Inc(k);
+    Air[k] := Burst[i] and 1; Inc(k);
+  end;
+  for i := 0 to 195 do Deinterleaved[(i * 13) mod 196] := Air[i];
+  k := 1; // discard R(3)
+  for i := 0 to 12 do
+    for j := 0 to 14 do begin Matrix[i, j] := Deinterleaved[k]; Inc(k); end;
+
+  IrrecoverableErrors := 0;
+  // Alternating row/column passes allow a correction in one dimension to
+  // make a previously ambiguous syndrome correctable in the other.
+  for Pass := 0 to 1 do
+  begin
+    if Pass = 1 then IrrecoverableErrors := 0;
+    for i := 0 to 8 do
+    begin
+      for j := 0 to 14 do Row[j] := Matrix[i, j];
+      if not CorrectHamming(Row, HAMMING_15_11_SYNDROME) then
+        Inc(IrrecoverableErrors);
+      for j := 0 to 10 do Matrix[i, j] := Row[j];
+    end;
+    for j := 0 to 14 do
+    begin
+      for i := 0 to 12 do Column[i] := Matrix[i, j];
+      if not CorrectHamming(Column, HAMMING_13_9_SYNDROME) then
+        Inc(IrrecoverableErrors);
+      for i := 0 to 8 do Matrix[i, j] := Column[i];
+    end;
+  end;
+
+  k := 0;
+  for j := 3 to 10 do begin Payload[k] := Matrix[0, j]; Inc(k); end;
+  for i := 1 to 8 do
+    for j := 0 to 10 do begin Payload[k] := Matrix[i, j]; Inc(k); end;
+  Result := IrrecoverableErrors = 0;
+end;
+
+function BitsToUInt(const Bits: TDMRBit96; Start, Count: Integer): LongWord;
+var
+  i: Integer;
+begin
+  Result := 0;
+  for i := 0 to Count - 1 do Result := (Result shl 1) or (Bits[Start + i] and 1);
+end;
+
+function GFMul(A, B: Byte): Byte;
+var
+  Carry: Boolean;
+  P: Byte;
+  i: Integer;
+begin
+  P := 0;
+  for i := 0 to 7 do
+  begin
+    if (B and 1) <> 0 then P := P xor A;
+    Carry := (A and $80) <> 0;
+    A := A shl 1;
+    if Carry then A := A xor $1D; // GF(256), primitive polynomial x^8+x^4+x^3+x^2+1
+    B := B shr 1;
+  end;
+  Result := P;
+end;
+
+procedure BytesToBits(const Bytes: array of Byte; var Bits: TDMRBit96);
+var
+  i, j: Integer;
+begin
+  for i := 0 to 11 do
+    for j := 0 to 7 do Bits[i * 8 + j] := (Bytes[i] shr (7 - j)) and 1;
+end;
+
+procedure BitsToBytes(const Bits: TDMRBit96; var Bytes: array of Byte);
+var
+  i, j: Integer;
+begin
+  for i := 0 to 11 do
+  begin
+    Bytes[i] := 0;
+    for j := 0 to 7 do Bytes[i] := (Bytes[i] shl 1) or (Bits[i * 8 + j] and 1);
+  end;
+end;
+
+procedure RS129Syndrome(const Codeword: array of Byte; out S0, S1, S2: Byte);
+var
+  i: Integer;
+begin
+  S0 := 0; S1 := 0; S2 := 0;
+  for i := 0 to 11 do
+  begin
+    S0 := Codeword[i] xor GFMul(2, S0);
+    S1 := Codeword[i] xor GFMul(4, S1);
+    S2 := Codeword[i] xor GFMul(8, S2);
+  end;
+end;
+
+function FullLCMask(DataType: Integer): LongWord;
+begin
+  if DataType = 1 then Result := $969696
+  else if DataType = 2 then Result := $999999
+  else Result := 0;
+end;
+
+procedure DMRFullLCSetParity(var Payload: TDMRBit96; DataType: Integer);
+var
+  Bytes: array[0..11] of Byte;
+  Feedback: Byte;
+  Mask: LongWord;
+  i: Integer;
+begin
+  BitsToBytes(Payload, Bytes);
+  Bytes[9] := 0; Bytes[10] := 0; Bytes[11] := 0;
+  for i := 0 to 8 do
+  begin
+    Feedback := Bytes[i] xor Bytes[9];
+    Bytes[9] := Bytes[10] xor GFMul($0E, Feedback);
+    Bytes[10] := Bytes[11] xor GFMul($38, Feedback);
+    Bytes[11] := GFMul($40, Feedback);
+  end;
+  Mask := FullLCMask(DataType);
+  Bytes[9] := Bytes[9] xor Byte(Mask shr 16);
+  Bytes[10] := Bytes[10] xor Byte(Mask shr 8);
+  Bytes[11] := Bytes[11] xor Byte(Mask);
+  BytesToBits(Bytes, Payload);
+end;
+
+function ValidateAndCorrectFullLC(var Payload: TDMRBit96; DataType: Integer;
+  out CorrectedBytes: Integer): Boolean;
+var
+  Bytes: array[0..11] of Byte;
+  S0, S1, S2: Byte;
+  Mask: LongWord;
+  Position, Delta: Integer;
+begin
+  CorrectedBytes := 0;
+  BitsToBytes(Payload, Bytes);
+  Mask := FullLCMask(DataType);
+  Bytes[9] := Bytes[9] xor Byte(Mask shr 16);
+  Bytes[10] := Bytes[10] xor Byte(Mask shr 8);
+  Bytes[11] := Bytes[11] xor Byte(Mask);
+  RS129Syndrome(Bytes, S0, S1, S2);
+  if (S0 <> 0) or (S1 <> 0) or (S2 <> 0) then
+  begin
+    // RS(12,9) has three check symbols and corrects one complete byte. Full
+    // Berlekamp-Massey machinery is unnecessary at this block size: search
+    // the 12*255 possible one-symbol corrections and require zero syndrome.
+    for Position := 0 to 11 do
+    begin
+      for Delta := 1 to 255 do
+      begin
+        Bytes[Position] := Bytes[Position] xor Byte(Delta);
+        RS129Syndrome(Bytes, S0, S1, S2);
+        if (S0 = 0) and (S1 = 0) and (S2 = 0) then
+        begin
+          CorrectedBytes := 1;
+          Break;
+        end;
+        Bytes[Position] := Bytes[Position] xor Byte(Delta);
+      end;
+      if CorrectedBytes <> 0 then Break;
+    end;
+    if CorrectedBytes = 0 then Exit(False);
+  end;
+  // Payload data may itself have been the corrected RS symbol.
+  Bytes[9] := Bytes[9] xor Byte(Mask shr 16);
+  Bytes[10] := Bytes[10] xor Byte(Mask shr 8);
+  Bytes[11] := Bytes[11] xor Byte(Mask);
+  BytesToBits(Bytes, Payload);
+  Result := True;
+end;
+
 procedure DMRParseBurst(const Burst: TDMRDibitBurst; out Info: TDMRBurstInfo);
 begin
   FillChar(Info, SizeOf(Info), 0);
   DMRDecodeCACH(Burst, Info.CACH);
   DMRDecodeSlotType(Burst, Info.SlotType);
+  if Info.SlotType.Valid and (Info.SlotType.DataType in [0..7, 9, 11]) then
+  begin
+    Info.BPTCValid := DMRDecodeBPTC19696(Burst, Info.Payload96,
+      Info.BPTCIrrecoverableErrors);
+    if Info.BPTCValid and (Info.SlotType.DataType in [1, 2]) then
+    begin
+      Info.LinkControl.CRCValid := ValidateAndCorrectFullLC(Info.Payload96,
+        Info.SlotType.DataType, Info.LinkControl.RSCorrectedBytes);
+      Info.LinkControl.Decoded := Info.LinkControl.CRCValid;
+      if Info.LinkControl.Decoded then
+      begin
+        Info.LinkControl.ProtectedFlag := Info.Payload96[0] <> 0;
+        Info.LinkControl.Reserved := Info.Payload96[1] <> 0;
+        Info.LinkControl.Opcode := BitsToUInt(Info.Payload96, 2, 6);
+        Info.LinkControl.FeatureSetID := BitsToUInt(Info.Payload96, 8, 8);
+        Info.LinkControl.ServiceOptions := BitsToUInt(Info.Payload96, 16, 8);
+        Info.LinkControl.TargetID := BitsToUInt(Info.Payload96, 24, 24);
+        Info.LinkControl.SourceID := BitsToUInt(Info.Payload96, 48, 24);
+      end;
+    end;
+  end;
 end;
 
 function DMRDataTypeName(DataType: Integer): string;

MainForm.pas

@@ -3597,6 +3597,7 @@ begin
   if S.CACHValid then Details := Format(' TS%d', [S.Slot + 1]);
   if S.SlotTypeValid then
     Details := Details + Format(' CC%d/DT%d', [S.ColorCode, S.DataType]);
+  if S.LinkControlValid then Details := Details + Format(' TG%d', [S.TargetID]);
   Result := Format('DMR %s%s%s #%d',
                    [TDMRDecoder.SyncKindName(S.SyncKind), Details, Inv,
                     S.SyncCount]);

tests/dmr_protocol_test.pas

@@ -55,9 +55,28 @@ begin
   end;
 end;
 
+procedure PutUInt(var Bits: TDMRBit96; Start, Count: Integer; Value: LongWord);
+var
+  i: Integer;
+begin
+  for i := 0 to Count - 1 do
+    Bits[Start + i] := (Value shr (Count - 1 - i)) and 1;
+end;
+
+procedure XorPayloadByte(var Bits: TDMRBit96; ByteIndex: Integer; Value: Byte);
+var
+  i: Integer;
+begin
+  for i := 0 to 7 do
+    Bits[ByteIndex * 8 + i] := Bits[ByteIndex * 8 + i] xor
+      ((Value shr (7 - i)) and 1);
+end;
+
 var
   Burst: TDMRDibitBurst;
   Info: TDMRBurstInfo;
+  Payload: TDMRBit96;
+  i: Integer;
 begin
   FillChar(Burst, SizeOf(Burst), 0);
   // TACT: AT=1, slot=1 (TS2), LCSS=2. Slot Type: CC=9, data header=6.
@@ -90,5 +109,51 @@ begin
   DMRParseBurst(Burst, Info);
   Check(not Info.SlotType.Valid, 'uncorrectable Slot Type accepted');
 
-  WriteLn('DMR CACH and Slot Type tests passed');
+  // Full Link Control is carried in a BPTC(196,96) voice LC header.
+  FillChar(Payload, SizeOf(Payload), 0);
+  PutUInt(Payload, 2, 6, 0);       // group voice channel user LC
+  PutUInt(Payload, 8, 8, 0);       // standard feature set
+  PutUInt(Payload, 16, 8, $21);    // service options
+  PutUInt(Payload, 24, 24, 12345); // target/talkgroup
+  PutUInt(Payload, 48, 24, 678901);// source radio
+  DMRFullLCSetParity(Payload, 1);
+  DMRBPTC19696Encode(Payload, Burst);
+  PutCACH(Burst, $04);             // TS2, LCSS=0
+  PutSlotType(Burst, $91);         // CC9, voice LC header
+  DMRParseBurst(Burst, Info);
+  Check(Info.BPTCValid, 'valid BPTC(196,96) rejected');
+  for i := 0 to High(Payload) do
+    Check(Info.Payload96[i] = Payload[i], 'BPTC payload mismatch at bit ' +
+      IntToStr(i));
+  Check(Info.LinkControl.Decoded and (Info.LinkControl.Opcode = 0) and
+        (Info.LinkControl.FeatureSetID = 0) and
+        (Info.LinkControl.ServiceOptions = $21) and
+        (Info.LinkControl.TargetID = 12345) and
+        (Info.LinkControl.SourceID = 678901), 'Full LC fields decoded incorrectly');
+
+  // Product-code row/column correction recovers an isolated air-interface bit.
+  Burst[20] := Burst[20] xor 2;
+  DMRParseBurst(Burst, Info);
+  Check(Info.BPTCValid and Info.LinkControl.Decoded and
+        (Info.LinkControl.TargetID = 12345) and
+        (Info.LinkControl.SourceID = 678901), 'BPTC one-bit correction failed');
+
+  // The outer RS(12,9) code repairs one damaged byte after clean BPTC decode.
+  XorPayloadByte(Payload, 2, $5A);
+  DMRBPTC19696Encode(Payload, Burst);
+  PutCACH(Burst, $04);
+  PutSlotType(Burst, $91);
+  DMRParseBurst(Burst, Info);
+  Check(Info.LinkControl.Decoded and
+        (Info.LinkControl.RSCorrectedBytes = 1) and
+        (Info.LinkControl.ServiceOptions = $21), 'Full LC RS correction failed');
+
+  // Two damaged RS symbols exceed the RS(12,9) correction radius.
+  XorPayloadByte(Payload, 3, $A5);
+  DMRBPTC19696Encode(Payload, Burst);
+  PutSlotType(Burst, $91);
+  DMRParseBurst(Burst, Info);
+  Check(not Info.LinkControl.Decoded, 'invalid Full LC RS checksum accepted');
+
+  WriteLn('DMR CACH, Slot Type, BPTC and Full LC tests passed');
 end.