Files
ewsdr/DMRProtocol.pas
T

636 lines
19 KiB
ObjectPascal

{
Copyright (C)
2026 - Uladzimir Karpenka, EW8BAK
This program is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public License
as published by the Free Software Foundation; either version 2
of the License, or (at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
}
unit DMRProtocol;
{
Small, allocation-free DMR burst protocol layer.
The CACH/AMBE interleavers and Hamming/Golay matrices are derived from
dsd-fme (src/dmr_bs.c, src/fec.c and include/dmr_const.h).
Copyright (C) 2010 DSD Author
Permission to use, copy, modify, and/or distribute this software for any
purpose with or without fee is hereby granted, provided that the above
copyright notice and this permission notice appear in all copies.
THE SOFTWARE IS PROVIDED "AS IS" AND ISC DISCLAIMS ALL WARRANTIES WITH
REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY
AND FITNESS. IN NO EVENT SHALL ISC BE LIABLE FOR ANY SPECIAL, DIRECT,
INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM
LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE
OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR
PERFORMANCE OF THIS SOFTWARE.
}
{$IFDEF FPC}
{$MODE Delphi}
{$ENDIF}
interface
uses
SysUtils;
const
DMR_PROTOCOL_BURST_DIBITS = 144;
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;
TDMRAMBEFrame = array[0..95] of Byte;
TDMRAMBEFrames = array[0..2] of TDMRAMBEFrame;
TDMRCACH = record
Valid: Boolean;
CorrectedBits: Integer;
AccessType: Boolean;
Slot: Integer;
LCSS: Integer;
end;
TDMRSlotType = record
Valid: Boolean;
CorrectedBits: Integer;
ColorCode: Integer;
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);
procedure DMRExtractAMBEFrames(const Burst: TDMRDibitBurst;
out Frames: TDMRAMBEFrames);
procedure DMRInsertAMBEFrames(const Frames: TDMRAMBEFrames;
var Burst: TDMRDibitBurst);
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;
implementation
const
CACH_INTERLEAVE: array[0..23] of Byte = (
0, 7, 8, 9, 1, 10,
11, 12, 2, 13, 14, 15,
3, 16, 4, 17, 18, 19,
5, 20, 21, 22, 6, 23
);
HAMMING_7_4_G: array[0..3, 0..6] of Byte = (
(1, 0, 0, 0, 1, 0, 1),
(0, 1, 0, 0, 1, 1, 1),
(0, 0, 1, 0, 1, 1, 0),
(0, 0, 0, 1, 0, 1, 1)
);
GOLAY_20_8_G: array[0..7, 0..19] of Byte = (
(1,0,0,0,0,0,0,0, 0,0,1,1,1,1,0,1,1,0,1,0),
(0,1,0,0,0,0,0,0, 1,1,0,1,1,0,0,1,1,0,0,1),
(0,0,1,0,0,0,0,0, 0,1,1,0,1,1,0,0,1,1,0,1),
(0,0,0,1,0,0,0,0, 0,0,1,1,0,1,1,0,0,1,1,1),
(0,0,0,0,1,0,0,0, 1,1,0,1,1,1,0,0,0,1,1,0),
(0,0,0,0,0,1,0,0, 1,0,1,0,1,0,0,1,0,1,1,1),
(0,0,0,0,0,0,1,0, 1,0,0,1,0,0,1,1,1,1,1,0),
(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);
AMBE_W: array[0..35] of Byte = (
0,1,0,1,0,1, 0,1,0,1,0,1, 0,1,0,1,0,1,
0,1,0,1,0,2, 0,2,0,2,0,2, 0,2,0,2,0,2);
AMBE_X: array[0..35] of Byte = (
23,10,22,9,21,8, 20,7,19,6,18,5, 17,4,16,3,15,2,
14,1,13,0,12,10, 11,9,10,8,9,7, 8,6,7,5,6,4);
AMBE_Y: array[0..35] of Byte = (
0,2,0,2,0,2, 0,2,0,3,0,3, 1,3,1,3,1,3,
1,3,1,3,1,3, 1,3,1,3,1,3, 1,3,1,3,1,3);
AMBE_Z: array[0..35] of Byte = (
5,3,4,2,3,1, 2,0,1,13,0,12, 22,11,21,10,20,9,
19,8,18,7,17,6, 16,5,15,4,14,3, 13,2,12,1,11,0);
function DMRHamming74Encode(Value: Byte): TDMRBit7;
var
i, j: Integer;
begin
FillChar(Result, SizeOf(Result), 0);
for i := 0 to 3 do
if ((Value shr (3 - i)) and 1) <> 0 then
for j := 0 to 6 do Result[j] := Result[j] xor HAMMING_7_4_G[i, j];
end;
function DMRGolay208Encode(Value: Byte): TDMRBit20;
var
i, j: Integer;
begin
FillChar(Result, SizeOf(Result), 0);
for i := 0 to 7 do
if ((Value shr (7 - i)) and 1) <> 0 then
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 AMBEDibitIndex(FrameIndex, DibitIndex: Integer): Integer;
begin
case FrameIndex of
0: Result := 12 + DibitIndex;
1: if DibitIndex < 18 then Result := 48 + DibitIndex
else Result := 90 + DibitIndex - 18;
else
Result := 108 + DibitIndex;
end;
end;
procedure DMRExtractAMBEFrames(const Burst: TDMRDibitBurst;
out Frames: TDMRAMBEFrames);
var
FrameIndex, i, DibitIndex: Integer;
Dibit: Byte;
begin
FillChar(Frames, SizeOf(Frames), 0);
for FrameIndex := 0 to 2 do
for i := 0 to 35 do
begin
DibitIndex := AMBEDibitIndex(FrameIndex, i);
Dibit := Burst[DibitIndex];
Frames[FrameIndex][AMBE_W[i] * 24 + AMBE_X[i]] := (Dibit shr 1) and 1;
Frames[FrameIndex][AMBE_Y[i] * 24 + AMBE_Z[i]] := Dibit and 1;
end;
end;
procedure DMRInsertAMBEFrames(const Frames: TDMRAMBEFrames;
var Burst: TDMRDibitBurst);
var
FrameIndex, i, DibitIndex: Integer;
begin
for FrameIndex := 0 to 2 do
for i := 0 to 35 do
begin
DibitIndex := AMBEDibitIndex(FrameIndex, i);
Burst[DibitIndex] :=
((Frames[FrameIndex][AMBE_W[i] * 24 + AMBE_X[i]] and 1) shl 1) or
(Frames[FrameIndex][AMBE_Y[i] * 24 + AMBE_Z[i]] and 1);
end;
end;
function DecodeHamming74(const Received: TDMRBit7; out Value: Byte;
out Corrected: Integer): Boolean;
var
Candidate: TDMRBit7;
V, i, Distance, BestDistance: Integer;
begin
Value := 0;
BestDistance := 8;
for V := 0 to 15 do
begin
Candidate := DMRHamming74Encode(V);
Distance := 0;
for i := 0 to 6 do Inc(Distance, Candidate[i] xor (Received[i] and 1));
if Distance < BestDistance then
begin
BestDistance := Distance;
Value := V;
end;
end;
Corrected := BestDistance;
Result := BestDistance <= 1;
end;
function DecodeGolay208(const Received: TDMRBit20; out Value: Byte;
out Corrected: Integer): Boolean;
var
Candidate: TDMRBit20;
V, i, Distance, BestDistance: Integer;
begin
Value := 0;
BestDistance := 21;
for V := 0 to 255 do
begin
Candidate := DMRGolay208Encode(V);
Distance := 0;
for i := 0 to 19 do Inc(Distance, Candidate[i] xor (Received[i] and 1));
if Distance < BestDistance then
begin
BestDistance := Distance;
Value := V;
if Distance = 0 then Break;
end;
end;
Corrected := BestDistance;
Result := BestDistance <= 2;
end;
function DMRDecodeCACH(const Burst: TDMRDibitBurst; out CACH: TDMRCACH): Boolean;
var
Deinterleaved: array[0..23] of Byte;
TACT: TDMRBit7;
Value: Byte;
i: Integer;
begin
FillChar(CACH, SizeOf(CACH), 0);
FillChar(Deinterleaved, SizeOf(Deinterleaved), 0);
for i := 0 to 11 do
begin
Deinterleaved[CACH_INTERLEAVE[2 * i]] := (Burst[i] shr 1) and 1;
Deinterleaved[CACH_INTERLEAVE[2 * i + 1]] := Burst[i] and 1;
end;
for i := 0 to 6 do TACT[i] := Deinterleaved[i];
CACH.Valid := DecodeHamming74(TACT, Value, CACH.CorrectedBits);
if CACH.Valid then
begin
CACH.AccessType := (Value and 8) <> 0;
CACH.Slot := (Value shr 2) and 1;
CACH.LCSS := Value and 3;
end;
Result := CACH.Valid;
end;
function DMRDecodeSlotType(const Burst: TDMRDibitBurst;
out SlotType: TDMRSlotType): Boolean;
var
Bits: TDMRBit20;
Value: Byte;
i, k: Integer;
begin
FillChar(SlotType, SizeOf(SlotType), 0);
k := 0;
for i := 61 to 65 do
begin
Bits[k] := (Burst[i] shr 1) and 1; Inc(k);
Bits[k] := Burst[i] and 1; Inc(k);
end;
for i := 90 to 94 do
begin
Bits[k] := (Burst[i] shr 1) and 1; Inc(k);
Bits[k] := Burst[i] and 1; Inc(k);
end;
SlotType.Valid := DecodeGolay208(Bits, Value, SlotType.CorrectedBits);
if SlotType.Valid then
begin
SlotType.ColorCode := (Value shr 4) and $0F;
SlotType.DataType := Value and $0F;
end;
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;
begin
case DataType of
0: Result := 'PI header';
1: Result := 'voice LC';
2: Result := 'terminator LC';
3: Result := 'CSBK';
4: Result := 'MBC header';
5: Result := 'MBC continuation';
6: Result := 'data header';
7: Result := 'rate 1/2 data';
8: Result := 'rate 3/4 data';
9: Result := 'idle';
10: Result := 'rate 1 data';
11: Result := 'unified single block';
else
Result := 'reserved ' + IntToStr(DataType);
end;
end;
end.