ewsdr/DMRDecoder.pas

unit DMRDecoder;

{
  DMR 4FSK receive front-end.

  Input is 48 kHz discriminator audio from the WDSP FM demodulator. The DSP
  callback only copies complete blocks into a bounded ring; symbol timing and
  sync detection run in TDMRDecoderThread and can never stall the WDSP thread.

  This first layer deliberately stops at burst sync. The following layer will
  pass aligned dibits to the trimmed dsd-fme DMR/FEC/AMBE core.
}

{$IFDEF FPC}
  {$MODE Delphi}
{$ENDIF}

interface

uses
  Classes, SysUtils, SyncObjs, Math, DMRBindings;

const
  DMR_INPUT_RATE       = 48000;
  DMR_SYMBOL_RATE      = 4800;
  DMR_SAMPLES_PER_SYM  = DMR_INPUT_RATE div DMR_SYMBOL_RATE;
  DMR_RING_SIZE        = 65536; // >1.3 s at 48 kHz, power of two

type
  TDMRSyncKind = (
    dskNone,
    dskBSData, dskBSVoice,
    dskMSData, dskMSVoice,
    dskDirectTS1Data, dskDirectTS1Voice,
    dskDirectTS2Data, dskDirectTS2Voice
  );

  TDMRStatus = record
    Enabled: Boolean;
    Synced: Boolean;
    SyncKind: TDMRSyncKind;
    Inverted: Boolean;
    SyncCount: QWord;
    DroppedSamples: QWord;
    SignalRMS: Single;
    LastSyncAgeMs: QWord;
    VocoderAvailable: Boolean;
  end;

  TDMRDecoder = class;

  TDMRDecoderThread = class(TThread)
  private
    FOwner: TDMRDecoder;
  protected
    procedure Execute; override;
  public
    constructor Create(AOwner: TDMRDecoder);
  end;

  TDMRDecoder = class
  private
    FEnabled: Boolean;
    FRingLock: TCriticalSection;
    FDSPLock: TCriticalSection;
    FStatusLock: TCriticalSection;
    FWake: PRTLEvent;
    FThread: TDMRDecoderThread;
    FMbe: Pointer;
    FRing: array[0..DMR_RING_SIZE - 1] of Single;
    FReadPos, FWritePos: Integer;
    FDropped: QWord;

    FSampleWindow: array[0..DMR_SAMPLES_PER_SYM - 1] of Double;
    FWindowPos, FWindowCount: Integer;
    FWindowSum: Double;
    FSampleNo: QWord;
    FSyncShift: array[0..DMR_SAMPLES_PER_SYM - 1] of LongWord;
    FRMSSq: Double;

    FSyncKind: TDMRSyncKind;
    FInputInverted: Boolean;
    FInverted: Boolean;
    FSyncCount: QWord;
    FLastSyncTick: QWord;

    function PopSamples(var Buf: array of Single): Integer;
    procedure ProcessSample(S: Single);
    procedure ProcessSymbol(Phase: Integer; Symbol: Double);
    procedure NoteSync(Kind: TDMRSyncKind; Inverted: Boolean);
    procedure ResetDSP;
  public
    constructor Create;
    destructor Destroy; override;

    procedure SetEnabled(On_: Boolean);
    procedure SetInverted(On_: Boolean);
    procedure FeedAudio(const Left, Right: array of Single; Count: Integer);
    procedure GetStatus(out S: TDMRStatus);

    class function SyncKindName(Kind: TDMRSyncKind): string; static;
    property Enabled: Boolean read FEnabled;
  end;

implementation

const
  DMR_SYNC_MASK = LongWord($00FFFFFF);
  DMR_SYNC_HOLD_MS = 500;

  // One bit per DSD-FME sync character: '1'=0, '3'=1. These are the eight
  // ETSI DMR 48-bit sync patterns after collapsing each dibit to its sign.
  SYNC_TEXT: array[0..7] of string = (
    '313333111331131131331131', // BS data
    '131111333113313313113313', // BS voice
    '311131133313133331131113', // MS data
    '133313311131311113313331', // MS voice
    '331333313111313133311111', // direct TS1 data
    '113111131333131311133333', // direct TS1 voice
    '311311111333113333133311', // direct TS2 data
    '133133333111331111311133'  // direct TS2 voice
  );

  SYNC_KIND: array[0..7] of TDMRSyncKind = (
    dskBSData, dskBSVoice, dskMSData, dskMSVoice,
    dskDirectTS1Data, dskDirectTS1Voice,
    dskDirectTS2Data, dskDirectTS2Voice
  );

function SyncBits(const Text: string): LongWord;
var
  i: Integer;
begin
  Result := 0;
  for i := 1 to Length(Text) do
  begin
    Result := (Result shl 1) and DMR_SYNC_MASK;
    if Text[i] = '3' then Result := Result or 1;
  end;
end;

constructor TDMRDecoderThread.Create(AOwner: TDMRDecoder);
begin
  inherited Create(True);
  FreeOnTerminate := False;
  FOwner := AOwner;
end;

procedure TDMRDecoderThread.Execute;
var
  Buf: array[0..2047] of Single;
  N, i: Integer;
begin
  while not Terminated do
  begin
    N := FOwner.PopSamples(Buf);
    if N = 0 then
    begin
      RTLEventWaitFor(FOwner.FWake, 100);
      Continue;
    end;
    FOwner.FDSPLock.Enter;
    try
      for i := 0 to N - 1 do
        FOwner.ProcessSample(Buf[i]);
    finally
      FOwner.FDSPLock.Leave;
    end;
  end;
end;

constructor TDMRDecoder.Create;
begin
  inherited Create;
  FRingLock := TCriticalSection.Create;
  FDSPLock := TCriticalSection.Create;
  FStatusLock := TCriticalSection.Create;
  FWake := RTLEventCreate;
  FThread := TDMRDecoderThread.Create(Self);
  if DMRLoad then FMbe := DMRMbeCreate(3);
  ResetDSP;
  FThread.Start;
end;

destructor TDMRDecoder.Destroy;
begin
  if FThread <> nil then
  begin
    FThread.Terminate;
    RTLEventSetEvent(FWake);
    FThread.WaitFor;
    FreeAndNil(FThread);
  end;
  DMRMbeDestroy(FMbe);
  FMbe := nil;
  DMRUnload;
  RTLEventDestroy(FWake);
  FStatusLock.Free;
  FDSPLock.Free;
  FRingLock.Free;
  inherited Destroy;
end;

procedure TDMRDecoder.ResetDSP;
begin
  FDSPLock.Enter;
  try
    FRingLock.Enter;
    try
      FReadPos := 0;
      FWritePos := 0;
      FDropped := 0;
    finally
      FRingLock.Leave;
    end;
    FillChar(FSampleWindow, SizeOf(FSampleWindow), 0);
    FillChar(FSyncShift, SizeOf(FSyncShift), 0);
    FWindowPos := 0;
    FWindowCount := 0;
    FWindowSum := 0;
    FSampleNo := 0;
    FRMSSq := 0;
    FStatusLock.Enter;
    try
      FSyncKind := dskNone;
      FInverted := False;
      FSyncCount := 0;
      FLastSyncTick := 0;
    finally
      FStatusLock.Leave;
    end;
  finally
    FDSPLock.Leave;
  end;
end;

procedure TDMRDecoder.SetEnabled(On_: Boolean);
begin
  if FEnabled = On_ then Exit;
  FEnabled := On_;
  ResetDSP;
  if On_ then RTLEventSetEvent(FWake);
end;

procedure TDMRDecoder.SetInverted(On_: Boolean);
begin
  if FInputInverted = On_ then Exit;
  FInputInverted := On_;
  if FEnabled then ResetDSP;
end;

procedure TDMRDecoder.FeedAudio(const Left, Right: array of Single;
  Count: Integer);
var
  i, Next: Integer;
  V: Single;
begin
  if not FEnabled or (Count <= 0) then Exit;
  Count := Min(Count, Min(Length(Left), Length(Right)));
  FRingLock.Enter;
  try
    for i := 0 to Count - 1 do
    begin
      Next := (FWritePos + 1) and (DMR_RING_SIZE - 1);
      if Next = FReadPos then
      begin
        Inc(FDropped);
        Continue;
      end;
      V := 0.5 * (Left[i] + Right[i]);
      FRing[FWritePos] := V;
      FWritePos := Next;
    end;
  finally
    FRingLock.Leave;
  end;
  RTLEventSetEvent(FWake);
end;

function TDMRDecoder.PopSamples(var Buf: array of Single): Integer;
begin
  Result := 0;
  FRingLock.Enter;
  try
    while (FReadPos <> FWritePos) and (Result < Length(Buf)) do
    begin
      Buf[Result] := FRing[FReadPos];
      FReadPos := (FReadPos + 1) and (DMR_RING_SIZE - 1);
      Inc(Result);
    end;
  finally
    FRingLock.Leave;
  end;
end;

procedure TDMRDecoder.ProcessSample(S: Single);
var
  Phase: Integer;
  Sym: Double;
begin
  FRMSSq := FRMSSq + 0.001 * (S * S - FRMSSq);
  FWindowSum := FWindowSum - FSampleWindow[FWindowPos] + S;
  FSampleWindow[FWindowPos] := S;
  FWindowPos := (FWindowPos + 1) mod DMR_SAMPLES_PER_SYM;
  if FWindowCount < DMR_SAMPLES_PER_SYM then Inc(FWindowCount);
  Inc(FSampleNo);
  if FWindowCount < DMR_SAMPLES_PER_SYM then Exit;

  // Ten interleaved timing hypotheses. Each receives one boxcar-integrated
  // symbol every ten input samples; the correct phase produces exact sync.
  Phase := Integer(FSampleNo mod DMR_SAMPLES_PER_SYM);
  Sym := FWindowSum / DMR_SAMPLES_PER_SYM;
  ProcessSymbol(Phase, Sym);
end;

procedure TDMRDecoder.ProcessSymbol(Phase: Integer; Symbol: Double);
var
  i: Integer;
  Pat: LongWord;
begin
  FSyncShift[Phase] := ((FSyncShift[Phase] shl 1) and DMR_SYNC_MASK);
  if ((Symbol < 0) xor FInputInverted) then
    FSyncShift[Phase] := FSyncShift[Phase] or 1;

  for i := 0 to High(SYNC_TEXT) do
  begin
    Pat := SyncBits(SYNC_TEXT[i]);
    if FSyncShift[Phase] = Pat then
    begin
      NoteSync(SYNC_KIND[i], FInputInverted);
      Exit;
    end;
  end;
end;

procedure TDMRDecoder.NoteSync(Kind: TDMRSyncKind; Inverted: Boolean);
var
  NowTick: QWord;
begin
  NowTick := GetTickCount64;
  FStatusLock.Enter;
  try
    // Adjacent timing hypotheses may recognize the same physical burst.
    if (FLastSyncTick <> 0) and (NowTick - FLastSyncTick < 5) then Exit;
    FSyncKind := Kind;
    FInverted := Inverted;
    Inc(FSyncCount);
    FLastSyncTick := NowTick;
  finally
    FStatusLock.Leave;
  end;
end;

procedure TDMRDecoder.GetStatus(out S: TDMRStatus);
var
  NowTick: QWord;
begin
  FillChar(S, SizeOf(S), 0);
  NowTick := GetTickCount64;
  FDSPLock.Enter;
  try
    FStatusLock.Enter;
    try
      S.Enabled := FEnabled;
      S.SyncKind := FSyncKind;
      S.Inverted := FInverted;
      S.SyncCount := FSyncCount;
      if FLastSyncTick <> 0 then S.LastSyncAgeMs := NowTick - FLastSyncTick
      else S.LastSyncAgeMs := High(QWord);
      S.Synced := FEnabled and (FLastSyncTick <> 0) and
                  (S.LastSyncAgeMs <= DMR_SYNC_HOLD_MS);
      S.SignalRMS := Sqrt(FRMSSq);
      S.VocoderAvailable := FMbe <> nil;
    finally
      FStatusLock.Leave;
    end;
  finally
    FDSPLock.Leave;
  end;
  FRingLock.Enter;
  try
    S.DroppedSamples := FDropped;
  finally
    FRingLock.Leave;
  end;
end;

class function TDMRDecoder.SyncKindName(Kind: TDMRSyncKind): string;
begin
  case Kind of
    dskBSData: Result := 'BS data';
    dskBSVoice: Result := 'BS voice';
    dskMSData: Result := 'MS data';
    dskMSVoice: Result := 'MS voice';
    dskDirectTS1Data: Result := 'direct TS1 data';
    dskDirectTS1Voice: Result := 'direct TS1 voice';
    dskDirectTS2Data: Result := 'direct TS2 data';
    dskDirectTS2Voice: Result := 'direct TS2 voice';
  else
    Result := 'none';
  end;
end;

end.