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, DMRProtocol;

const
  DMR_INPUT_RATE       = 48000;
  DMR_SYMBOL_RATE      = 4800;
  DMR_SAMPLES_PER_SYM  = DMR_INPUT_RATE div DMR_SYMBOL_RATE;
  DMR_INTEGRATOR_SAMPLES = 8;
  DMR_RING_SIZE        = 65536; // >1.3 s at 48 kHz, power of two
  DMR_BURST_DIBITS     = 144;
  DMR_SYNC_END_DIBIT   = 89;    // sync occupies burst dibits 66..89
  DMR_VOICE_FRAME_SAMPLES = DMR_PCM_SAMPLES; // 20 ms at 8 kHz

type
  TDMRAudioEvent = procedure(const PCM: array of Single; Count: Integer) of object;

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

  TDMRStatus = record
    Enabled: Boolean;
    Synced: Boolean;
    SyncKind: TDMRSyncKind;
    Inverted: Boolean;
    SyncCount: QWord;
    BurstCount: QWord;
    BurstDibits: Integer;
    DroppedSamples: QWord;
    SignalRMS: Single;
    LastSyncAgeMs: QWord;
    VocoderAvailable: Boolean;
    CACHValid: Boolean;
    Slot: Integer;
    LCSS: Integer;
    SlotTypeValid: Boolean;
    ColorCode: Integer;
    DataType: Integer;
    SlotTypeCorrectedBits: Integer;
    LinkControlValid: Boolean;
    LCSlot: Integer;
    LCOpcode: Integer;
    ServiceOptions: Integer;
    TargetID: LongWord;
    SourceID: LongWord;
    SelectedSlot: Integer;
    VoiceFrameCount: QWord;
    VoiceErrorCount: QWord;
  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;
    FBindingsLoaded: Boolean;
    FRing: array[0..DMR_RING_SIZE - 1] of Single;
    FReadPos, FWritePos: Integer;
    FDropped: QWord;

    FSampleWindow: array[0..DMR_INTEGRATOR_SAMPLES - 1] of Double;
    FWindowPos, FWindowCount: Integer;
    FWindowSum: Double;
    FSampleNo: QWord;
    FSyncShift: array[0..DMR_SAMPLES_PER_SYM - 1] of LongWord;
    FOuterLevel: array[0..DMR_SAMPLES_PER_SYM - 1] of Double;
    FDibitHistory: array[0..DMR_SAMPLES_PER_SYM - 1,
                         0..DMR_SYNC_END_DIBIT] of Byte;
    FSymbolHistory: array[0..DMR_SAMPLES_PER_SYM - 1,
                          0..DMR_SYNC_END_DIBIT] of Double;
    FHistoryPos: array[0..DMR_SAMPLES_PER_SYM - 1] of Integer;
    FHistoryCount: array[0..DMR_SAMPLES_PER_SYM - 1] of Integer;
    FMagHistory: array[0..DMR_SAMPLES_PER_SYM - 1, 0..23] of Double;
    FMagPos: array[0..DMR_SAMPLES_PER_SYM - 1] of Integer;
    FMagSum: array[0..DMR_SAMPLES_PER_SYM - 1] of Double;
    FBestSyncQuality: Double;
    FFixedOuterLevel: Double;
    FFixedPositiveOuter: Double;
    FFixedNegativeOuter: Double;
    FFixedCenter: Double;
    FTrackPhase: Integer;
    FCurrentBurst: TDMRDibitBurst;
    FCurrentBurstPos: Integer;
    FLastBurst: TDMRDibitBurst;
    FLastBurstInfo: TDMRBurstInfo;
    FLinkControl: array[0..1] of TDMRLinkControl;
    FLastLCSlot: Integer;
    FColorCodeValid: Boolean;
    FColorCode, FLastDataType, FSlotTypeCorrectedBits: Integer;
    FSelectedSlot: Integer;
    FLastSelectedVoiceTick: QWord;
    FVoiceFrameCount, FVoiceErrorCount: QWord;
    FOnAudio: TDMRAudioEvent;
    FBurstCount: QWord;
    FRMSSq: Double;

    FSyncKind: TDMRSyncKind;
    FInputInverted: Boolean;
    FInverted: Boolean;
    FSyncCount: QWord;
    FLastSyncTick: QWord;
    FLastSyncSample: QWord;
    FPendingSyncSample: array[TDMRSyncKind] of QWord;
    FPendingSyncCount: array[TDMRSyncKind] of Byte;
    FMobileActiveBurst: Boolean;

    function PopSamples(var Buf: array of Single): Integer;
    procedure ProcessSample(S: Single);
    procedure ProcessSymbol(Phase: Integer; Symbol: Double);
    procedure NoteSync(Phase: Integer; Kind: TDMRSyncKind; Inverted: Boolean);
    procedure LoseSync;
    function Digitize(Phase: Integer; Symbol: Double): Byte;
    function SliceSymbol(Symbol, OuterLevel: Double): Byte;
    function SyncPhaseQuality(Phase: Integer): Double;
    procedure CalibrateSyncLevels(Phase: Integer);
    procedure StartBurstTracking(Phase: Integer);
    procedure CompleteBurst;
    procedure DecodeVoiceBurst;
    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);
    function GetLastBurst(var Dibits: array of Byte; out Sequence: QWord): Boolean;

    class function SyncKindName(Kind: TDMRSyncKind): string; static;
    class function LinkControlTargetText(const S: TDMRStatus): string; static;
    property Enabled: Boolean read FEnabled;
    property OnAudio: TDMRAudioEvent read FOnAudio write FOnAudio;
  end;

implementation

const
  DMR_SYNC_MASK = LongWord($00FFFFFF);
  DMR_SYNC_HOLD_MS = 500;
  DMR_SYNC_MAX_ERRORS = 2;
  // mbelib's floating-point API retains the signed 16-bit PCM scale. EWSDR's
  // audio outputs use normalized floating point, where full scale is +/-1.0.
  DMR_PCM_SCALE = 1.0 / 32768.0;
  DMR_PCM_GAIN  = 1.5; // +3.5 dB nominal voice level before user volume
  DMR_SUPERFRAME_SAMPLES = DMR_INPUT_RATE * 360 div 1000;
  DMR_SYNC_CADENCE_TOLERANCE = DMR_SAMPLES_PER_SYM * 3;

  // 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;

function PopCount24(V: LongWord): Integer;
begin
  V := V and DMR_SYNC_MASK;
  Result := 0;
  while V <> 0 do
  begin
    V := V and (V - 1);
    Inc(Result);
  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
    // Pop and process share the DSP lock with ResetDSP. Otherwise a reset can
    // clear the ring after this thread popped an old block but before it was
    // processed, allowing stale symbols to leak into the new mode/session.
    FOwner.FDSPLock.Enter;
    try
      N := FOwner.PopSamples(Buf);
      for i := 0 to N - 1 do
        FOwner.ProcessSample(Buf[i]);
    finally
      FOwner.FDSPLock.Leave;
    end;
    if N = 0 then
    begin
      RTLEventWaitFor(FOwner.FWake, 100);
      Continue;
    end;
  end;
end;

constructor TDMRDecoder.Create;
begin
  inherited Create;
  FRingLock := TCriticalSection.Create;
  FDSPLock := TCriticalSection.Create;
  FStatusLock := TCriticalSection.Create;
  FWake := RTLEventCreate;
  FThread := TDMRDecoderThread.Create(Self);
  FBindingsLoaded := DMRLoad;
  if FBindingsLoaded 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;
  if FBindingsLoaded then
  begin
    DMRUnload;
    FBindingsLoaded := False;
  end;
  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);
    FillChar(FOuterLevel, SizeOf(FOuterLevel), 0);
    FillChar(FDibitHistory, SizeOf(FDibitHistory), 0);
    FillChar(FSymbolHistory, SizeOf(FSymbolHistory), 0);
    FillChar(FHistoryPos, SizeOf(FHistoryPos), 0);
    FillChar(FHistoryCount, SizeOf(FHistoryCount), 0);
    FillChar(FMagHistory, SizeOf(FMagHistory), 0);
    FillChar(FMagPos, SizeOf(FMagPos), 0);
    FillChar(FMagSum, SizeOf(FMagSum), 0);
    FBestSyncQuality := 0;
    FFixedOuterLevel := 0;
    FFixedPositiveOuter := 0;
    FFixedNegativeOuter := 0;
    FFixedCenter := 0;
    FillChar(FCurrentBurst, SizeOf(FCurrentBurst), 0);
    FillChar(FLastBurst, SizeOf(FLastBurst), 0);
    FillChar(FLastBurstInfo, SizeOf(FLastBurstInfo), 0);
    FillChar(FLinkControl, SizeOf(FLinkControl), 0);
    FLastLCSlot := -1;
    FColorCodeValid := False;
    FColorCode := 0;
    FLastDataType := 0;
    FSlotTypeCorrectedBits := 0;
    FSelectedSlot := -1;
    FLastSelectedVoiceTick := 0;
    FVoiceFrameCount := 0;
    FVoiceErrorCount := 0;
    DMRMbeReset(FMbe);
    FTrackPhase := -1;
    FCurrentBurstPos := 0;
    FBurstCount := 0;
    FWindowPos := 0;
    FWindowCount := 0;
    FWindowSum := 0;
    FSampleNo := 0;
    FRMSSq := 0;
    FStatusLock.Enter;
    try
      FSyncKind := dskNone;
      FInverted := False;
      FSyncCount := 0;
      FLastSyncTick := 0;
      FLastSyncSample := 0;
      FillChar(FPendingSyncSample, SizeOf(FPendingSyncSample), 0);
      FillChar(FPendingSyncCount, SizeOf(FPendingSyncCount), 0);
      FMobileActiveBurst := True;
    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_INTEGRATOR_SAMPLES;
  if FWindowCount < DMR_INTEGRATOR_SAMPLES then Inc(FWindowCount);
  Inc(FSampleNo);
  if FWindowCount < DMR_INTEGRATOR_SAMPLES 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_INTEGRATOR_SAMPLES;
  ProcessSymbol(Phase, Sym);
end;

procedure TDMRDecoder.ProcessSymbol(Phase: Integer; Symbol: Double);
var
  i, Distance: Integer;
  Pat: LongWord;
  Dibit: Byte;
  V: Double;
  DeltaSamples, CycleOffset, PendingSample: QWord;
  CandidateAllowed: Boolean;
begin
  V := Symbol;
  if FInputInverted then V := -V;

  // Stop assembling/decoding an endless stream of noise after the carrier
  // vanishes.  Two superframes allow one damaged sync word without losing a
  // valid call, while still closing the decoder in about 720 ms.
  if (FLastSyncSample <> 0) and
     (FSampleNo - FLastSyncSample > 2 * DMR_SUPERFRAME_SAMPLES +
      DMR_SYNC_CADENCE_TOLERANCE) then
    LoseSync;
  Dibit := Digitize(Phase, V);

  // Keep the 90 dibits ending at sync. Once the timing phase is selected this
  // supplies burst positions 0..89 without waiting for another frame.
  FDibitHistory[Phase, FHistoryPos[Phase]] := Dibit;
  FSymbolHistory[Phase, FHistoryPos[Phase]] := V;
  FHistoryPos[Phase] := (FHistoryPos[Phase] + 1) mod (DMR_SYNC_END_DIBIT + 1);
  if FHistoryCount[Phase] < DMR_SYNC_END_DIBIT + 1 then Inc(FHistoryCount[Phase]);

  FMagSum[Phase] := FMagSum[Phase] - FMagHistory[Phase, FMagPos[Phase]] + Abs(V);
  FMagHistory[Phase, FMagPos[Phase]] := Abs(V);
  FMagPos[Phase] := (FMagPos[Phase] + 1) mod 24;

  if FTrackPhase = Phase then
  begin
    if FCurrentBurstPos < DMR_BURST_DIBITS then
    begin
      FCurrentBurst[FCurrentBurstPos] := Dibit;
      Inc(FCurrentBurstPos);
      if FCurrentBurstPos = DMR_BURST_DIBITS then CompleteBurst;
    end;
  end;

  FSyncShift[Phase] := ((FSyncShift[Phase] shl 1) and DMR_SYNC_MASK);
  if V < 0 then FSyncShift[Phase] := FSyncShift[Phase] or 1;

  for i := 0 to High(SYNC_TEXT) do
  begin
    Pat := SyncBits(SYNC_TEXT[i]);
    if FHistoryCount[Phase] >= 24 then
    begin
      Distance := PopCount24(FSyncShift[Phase] xor Pat);
      // Real on-air sync commonly carries one or two sign errors. DSD-FME
      // likewise uses a bounded sync tolerance; requiring an exact 24-symbol
      // match lost almost every superframe in recorded handheld-radio IQ.
      DeltaSamples := FSampleNo - FLastSyncSample;
      CandidateAllowed := (FLastSyncSample = 0) or
        (SYNC_KIND[i] = FSyncKind);
      // MS voice/data sync repeats every 360 ms. Cadence gating rejects
      // chance <=2-bit matches inside AMBE payload while still accepting a
      // superframe after one or more missed sync words.
      if CandidateAllowed and (FLastSyncSample <> 0) and
         (FSyncKind in [dskMSData, dskMSVoice]) and
         (SYNC_KIND[i] = FSyncKind) and (DeltaSamples > 20) then
      begin
        CycleOffset := DeltaSamples mod DMR_SUPERFRAME_SAMPLES;
        CandidateAllowed := (CycleOffset <= 20) or
          (CycleOffset >= DMR_SUPERFRAME_SAMPLES - 20);
      end;
      if (Distance <= DMR_SYNC_MAX_ERRORS) and CandidateAllowed then
      begin
        // Fuzzy 24-symbol matches occur often enough in open-channel noise to
        // make mbelib emit occasional garbage.  Real voice sync repeats every
        // 360 ms, so require three words of the same kind on that cadence
        // before opening burst and vocoder processing.
        if FLastSyncSample = 0 then
        begin
          PendingSample := FPendingSyncSample[SYNC_KIND[i]];
          if PendingSample <> 0 then
          begin
            DeltaSamples := FSampleNo - PendingSample;
            CycleOffset := DeltaSamples mod DMR_SUPERFRAME_SAMPLES;
            if (DeltaSamples >= DMR_SUPERFRAME_SAMPLES -
                 DMR_SYNC_CADENCE_TOLERANCE) and
               ((CycleOffset <= DMR_SYNC_CADENCE_TOLERANCE) or
                (CycleOffset >= DMR_SUPERFRAME_SAMPLES -
                 DMR_SYNC_CADENCE_TOLERANCE)) then
            begin
              Inc(FPendingSyncCount[SYNC_KIND[i]]);
              FPendingSyncSample[SYNC_KIND[i]] := FSampleNo;
              // Three consecutive superframe syncs make accidental capture
              // in random discriminator noise vanishingly unlikely.
              if FPendingSyncCount[SYNC_KIND[i]] >= 3 then
                NoteSync(Phase, SYNC_KIND[i], FInputInverted);
            end
            else if DeltaSamples > DMR_SUPERFRAME_SAMPLES +
                    DMR_SYNC_CADENCE_TOLERANCE then
            begin
              FPendingSyncSample[SYNC_KIND[i]] := FSampleNo;
              FPendingSyncCount[SYNC_KIND[i]] := 1;
            end;
          end;
          if FLastSyncSample = 0 then
          begin
            if PendingSample = 0 then
            begin
              FPendingSyncSample[SYNC_KIND[i]] := FSampleNo;
              FPendingSyncCount[SYNC_KIND[i]] := 1;
            end;
            Exit;
          end;
        end
        else
          NoteSync(Phase, SYNC_KIND[i], FInputInverted);
        Exit;
      end;
    end;
  end;
end;

procedure TDMRDecoder.LoseSync;
begin
  FStatusLock.Enter;
  try
    FSyncKind := dskNone;
    FInverted := False;
    FLastSyncTick := 0;
    FLastSyncSample := 0;
    FillChar(FPendingSyncSample, SizeOf(FPendingSyncSample), 0);
    FillChar(FPendingSyncCount, SizeOf(FPendingSyncCount), 0);
  finally
    FStatusLock.Leave;
  end;
  FTrackPhase := -1;
  FCurrentBurstPos := 0;
  FFixedOuterLevel := 0;
  FFixedPositiveOuter := 0;
  FFixedNegativeOuter := 0;
  FFixedCenter := 0;
  FMobileActiveBurst := True;
  // LC belongs to a call/slot, not to the tuned frequency forever. Keeping it
  // across carrier loss made a newly acquired call briefly inherit the old
  // target and display the same apparent TG on unrelated transmissions.
  FillChar(FLinkControl, SizeOf(FLinkControl), 0);
  FLastLCSlot := -1;
  FSelectedSlot := -1;
  FLastSelectedVoiceTick := 0;
  FColorCodeValid := False;
  FColorCode := 0;
  FLastDataType := 0;
  FSlotTypeCorrectedBits := 0;
  DMRMbeReset(FMbe);
end;

function TDMRDecoder.Digitize(Phase: Integer; Symbol: Double): Byte;
var
  A: Double;
begin
  if (Phase = FTrackPhase) and (FFixedOuterLevel > 1.0e-9) then
    Exit(SliceSymbol(Symbol - FFixedCenter, FFixedOuterLevel));

  A := Abs(Symbol);
  if FOuterLevel[Phase] <= 1.0e-9 then FOuterLevel[Phase] := A
  else if A > FOuterLevel[Phase] then
    FOuterLevel[Phase] := A
  else
    FOuterLevel[Phase] := FOuterLevel[Phase] + 0.001 * (A - FOuterLevel[Phase]);
  Result := SliceSymbol(Symbol, FOuterLevel[Phase]);
end;

function TDMRDecoder.SliceSymbol(Symbol, OuterLevel: Double): Byte;
var
  A, Threshold: Double;
begin
  A := Abs(Symbol);
  Threshold := 0.645 * OuterLevel;
  if Symbol >= 0 then
  begin
    if A >= Threshold then Result := 1 else Result := 0; // +3 / +1
  end
  else
  begin
    if A >= Threshold then Result := 3 else Result := 2; // -3 / -1
  end;
end;

function TDMRDecoder.SyncPhaseQuality(Phase: Integer): Double;
var
  i, P, PositiveCount, NegativeCount: Integer;
  V, PositiveMean, NegativeMean, ErrorSum, Scale: Double;
begin
  PositiveMean := 0;
  NegativeMean := 0;
  PositiveCount := 0;
  NegativeCount := 0;
  P := (FHistoryPos[Phase] + DMR_SYNC_END_DIBIT + 1 - 24) mod
       (DMR_SYNC_END_DIBIT + 1);
  for i := 0 to 23 do
  begin
    V := FSymbolHistory[Phase, P];
    if V >= 0 then
    begin
      PositiveMean := PositiveMean + V;
      Inc(PositiveCount);
    end
    else
    begin
      NegativeMean := NegativeMean - V;
      Inc(NegativeCount);
    end;
    P := (P + 1) mod (DMR_SYNC_END_DIBIT + 1);
  end;
  if (PositiveCount = 0) or (NegativeCount = 0) then Exit(-1.0e300);
  PositiveMean := PositiveMean / PositiveCount;
  NegativeMean := NegativeMean / NegativeCount;
  ErrorSum := 0;
  P := (FHistoryPos[Phase] + DMR_SYNC_END_DIBIT + 1 - 24) mod
       (DMR_SYNC_END_DIBIT + 1);
  for i := 0 to 23 do
  begin
    V := FSymbolHistory[Phase, P];
    if V >= 0 then ErrorSum := ErrorSum + Sqr(V - PositiveMean)
    else ErrorSum := ErrorSum + Sqr((-V) - NegativeMean);
    P := (P + 1) mod (DMR_SYNC_END_DIBIT + 1);
  end;
  Scale := Sqr(0.5 * (PositiveMean + NegativeMean));
  if Scale <= 1.0e-18 then Exit(-1.0e300);
  // Higher is better: zero denotes perfectly compact outer-level clusters.
  Result := -ErrorSum / (24.0 * Scale);
end;

procedure TDMRDecoder.CalibrateSyncLevels(Phase: Integer);
var
  i, P, PositiveCount, NegativeCount: Integer;
  V, PositiveSum, NegativeSum: Double;
begin
  PositiveSum := 0;
  NegativeSum := 0;
  PositiveCount := 0;
  NegativeCount := 0;
  P := (FHistoryPos[Phase] + DMR_SYNC_END_DIBIT + 1 - 24) mod
       (DMR_SYNC_END_DIBIT + 1);
  for i := 0 to 23 do
  begin
    V := FSymbolHistory[Phase, P];
    if V >= 0 then
    begin
      PositiveSum := PositiveSum + V;
      Inc(PositiveCount);
    end
    else
    begin
      NegativeSum := NegativeSum - V;
      Inc(NegativeCount);
    end;
    P := (P + 1) mod (DMR_SYNC_END_DIBIT + 1);
  end;
  if PositiveCount > 0 then FFixedPositiveOuter := PositiveSum / PositiveCount;
  if NegativeCount > 0 then FFixedNegativeOuter := NegativeSum / NegativeCount;
  FFixedCenter := 0.5 * (FFixedPositiveOuter - FFixedNegativeOuter);
  FFixedOuterLevel := 0.5 * (FFixedPositiveOuter + FFixedNegativeOuter);
  FOuterLevel[Phase] := FFixedOuterLevel;
end;

procedure TDMRDecoder.StartBurstTracking(Phase: Integer);
var
  i, P: Integer;
begin
  if FHistoryCount[Phase] < DMR_SYNC_END_DIBIT + 1 then Exit;
  FTrackPhase := Phase;
  P := FHistoryPos[Phase]; // oldest item; ring is exactly 90 dibits full
  for i := 0 to DMR_SYNC_END_DIBIT do
  begin
    // All 24 DMR sync dibits are known outer levels.  Once they calibrate the
    // eye, re-slice the already buffered pre-sync payload with the same level.
    FCurrentBurst[i] := SliceSymbol(FSymbolHistory[Phase, P] - FFixedCenter,
                                    FFixedOuterLevel);
    P := (P + 1) mod (DMR_SYNC_END_DIBIT + 1);
  end;
  FCurrentBurstPos := DMR_SYNC_END_DIBIT + 1;
end;

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
    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;
    FLinkControl[FLastLCSlot] := FLastBurstInfo.LinkControl;
    if FSelectedSlot < 0 then
    begin
      FSelectedSlot := FLastLCSlot;
      FLastSelectedVoiceTick := GetTickCount64;
    end;
  end;
  DecodeVoiceBurst;
  if FSyncKind in [dskMSData, dskMSVoice] then
    FMobileActiveBurst := not FMobileActiveBurst;
  Inc(FBurstCount);
  FCurrentBurstPos := 0;
end;

procedure TDMRDecoder.DecodeVoiceBurst;
var
  Frames: TDMRAMBEFrames;
  PCM: array[0..DMR_PCM_SAMPLES - 1] of Single;
  MbeResult: TDMRMbeResult;
  Slot, FrameIndex, SampleIndex, RC: Integer;
  NowTick: QWord;
begin
  if (FMbe = nil) or (FLastSyncTick = 0) or
     (GetTickCount64 - FLastSyncTick > DMR_SYNC_HOLD_MS) then Exit;
  if not (FSyncKind in [dskBSVoice, dskMSVoice, dskDirectTS1Voice,
          dskDirectTS2Voice]) then Exit;
  // Mobile simplex occupies one 30 ms half-slot and leaves the alternating
  // half-slot idle. A 144-dibit continuous assembler sees both; only every
  // other record contains the three AMBE frames.
  if (FSyncKind = dskMSVoice) and not FMobileActiveBurst then Exit;

  if FSyncKind in [dskBSVoice] then
  begin
    if not FLastBurstInfo.CACH.Valid then Exit;
    Slot := FLastBurstInfo.CACH.Slot;
  end
  else if FSyncKind = dskDirectTS2Voice then Slot := 1
  else Slot := 0;
  if FSyncKind = dskMSVoice then FSelectedSlot := 0;
  NowTick := GetTickCount64;
  if (FSelectedSlot < 0) or
     ((Slot <> FSelectedSlot) and (FLastSelectedVoiceTick <> 0) and
      (NowTick - FLastSelectedVoiceTick > 1000)) then
  begin
    FSelectedSlot := Slot;
    DMRMbeReset(FMbe);
  end;
  if Slot <> FSelectedSlot then Exit;
  FLastSelectedVoiceTick := NowTick;
  // Service Options bit 6 denotes privacy/encryption. mbelib cannot decrypt
  // it, so suppress the characteristic digital noise while retaining IDs.
  if FLinkControl[Slot].Decoded and
     ((FLinkControl[Slot].ServiceOptions and $40) <> 0) then Exit;

  DMRExtractAMBEFrames(FLastBurst, Frames);
  for FrameIndex := 0 to 2 do
  begin
    FillChar(MbeResult, SizeOf(MbeResult), 0);
    RC := DMRMbeDecode(FMbe, @Frames[FrameIndex][0], @PCM[0], @MbeResult);
    if RC <> 0 then
    begin
      Inc(FVoiceErrorCount);
      Continue;
    end;
    Inc(FVoiceFrameCount);
    if MbeResult.ErrorsTotal > 0 then Inc(FVoiceErrorCount, MbeResult.ErrorsTotal);
    for SampleIndex := 0 to High(PCM) do
    begin
      PCM[SampleIndex] := PCM[SampleIndex] * DMR_PCM_SCALE * DMR_PCM_GAIN;
      if PCM[SampleIndex] > 1.0 then PCM[SampleIndex] := 1.0
      else if PCM[SampleIndex] < -1.0 then PCM[SampleIndex] := -1.0;
    end;
    if Assigned(FOnAudio) then FOnAudio(PCM, Length(PCM));
  end;
end;

procedure TDMRDecoder.NoteSync(Phase: Integer; Kind: TDMRSyncKind;
  Inverted: Boolean);
var
  NowTick: QWord;
begin
  NowTick := GetTickCount64;
  FStatusLock.Enter;
  try
    // Adjacent timing hypotheses recognize the same physical burst within one
    // sample period. Keep the phase whose known positive/negative sync levels
    // form the tightest clusters, not merely the first sign-pattern match.
    if (FLastSyncSample <> 0) and
       (FSampleNo - FLastSyncSample <= DMR_SAMPLES_PER_SYM * 2) then
    begin
      if SyncPhaseQuality(Phase) > FBestSyncQuality then
      begin
        FBestSyncQuality := SyncPhaseQuality(Phase);
        FSyncKind := Kind;
        FInverted := Inverted;
        CalibrateSyncLevels(Phase);
        StartBurstTracking(Phase);
      end;
      Exit;
    end;
    FSyncKind := Kind;
    FInverted := Inverted;
    Inc(FSyncCount);
    FLastSyncTick := NowTick;
    FLastSyncSample := FSampleNo;
    FBestSyncQuality := SyncPhaseQuality(Phase);
    CalibrateSyncLevels(Phase);
    if Kind in [dskMSData, dskMSVoice] then FMobileActiveBurst := True;
    StartBurstTracking(Phase);
  finally
    FStatusLock.Leave;
  end;
end;

procedure TDMRDecoder.GetStatus(out S: TDMRStatus);
var
  NowTick: QWord;
  LCStatusSlot: Integer;
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;
      S.BurstCount := FBurstCount;
      S.BurstDibits := FCurrentBurstPos;
      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;
      // CACH exists on base-station bursts. On MS/direct bursts the same
      // positions are payload/guard symbols and can accidentally form a
      // syntactically valid Hamming word.
      S.CACHValid := FLastBurstInfo.CACH.Valid and
                     (FSyncKind in [dskBSData, dskBSVoice]);
      S.Slot := FLastBurstInfo.CACH.Slot;
      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 := FColorCodeValid;
      S.ColorCode := FColorCode;
      S.DataType := FLastDataType;
      S.SlotTypeCorrectedBits := FSlotTypeCorrectedBits;
      LCStatusSlot := FSelectedSlot;
      if (LCStatusSlot < 0) or not FLinkControl[LCStatusSlot].Decoded then
        LCStatusSlot := FLastLCSlot;
      S.LinkControlValid := (LCStatusSlot >= 0) and
                            FLinkControl[LCStatusSlot].Decoded;
      S.LCSlot := LCStatusSlot;
      if S.LinkControlValid then
      begin
        S.LCOpcode := FLinkControl[LCStatusSlot].Opcode;
        S.ServiceOptions := FLinkControl[LCStatusSlot].ServiceOptions;
        S.TargetID := FLinkControl[LCStatusSlot].TargetID;
        S.SourceID := FLinkControl[LCStatusSlot].SourceID;
      end;
      S.SelectedSlot := FSelectedSlot;
      S.VoiceFrameCount := FVoiceFrameCount;
      S.VoiceErrorCount := FVoiceErrorCount;
    finally
      FStatusLock.Leave;
    end;
  finally
    FDSPLock.Leave;
  end;
  FRingLock.Enter;
  try
    S.DroppedSamples := FDropped;
  finally
    FRingLock.Leave;
  end;
end;

function TDMRDecoder.GetLastBurst(var Dibits: array of Byte;
  out Sequence: QWord): Boolean;
var
  N: Integer;
begin
  Sequence := 0;
  FDSPLock.Enter;
  try
    Result := FBurstCount <> 0;
    if not Result then Exit;
    N := Min(Length(Dibits), DMR_BURST_DIBITS);
    if N > 0 then Move(FLastBurst[0], Dibits[0], N * SizeOf(Byte));
    Sequence := FBurstCount;
  finally
    FDSPLock.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;

class function TDMRDecoder.LinkControlTargetText(
  const S: TDMRStatus): string;
begin
  Result := '';
  if not S.LinkControlValid or (S.TargetID = 0) then Exit;
  // ETSI Full Link Control opcode 0 is Group Voice Channel User; opcode 3 is
  // Unit-to-Unit Voice Channel User. Other/vendor opcodes may reuse these 24
  // bits for different data, so do not mislabel them as a talkgroup.
  case S.LCOpcode of
    0: Result := 'TG' + IntToStr(S.TargetID);
    3: Result := 'ID' + IntToStr(S.TargetID);
  end;
end;

end.