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_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; 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; 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; 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; FTrackPhase: Integer; FCurrentBurst: TDMRDibitBurst; FCurrentBurstPos: Integer; FLastBurst: TDMRDibitBurst; FLastBurstInfo: TDMRBurstInfo; FLastLinkControl: TDMRLinkControl; FLastLCSlot: Integer; FColorCodeValid: Boolean; FColorCode, FLastDataType, FSlotTypeCorrectedBits: Integer; FSelectedSlot: Integer; FVoiceFrameCount, FVoiceErrorCount: QWord; FOnAudio: TDMRAudioEvent; FBurstCount: QWord; 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(Phase: Integer; Kind: TDMRSyncKind; Inverted: Boolean); function Digitize(Phase: Integer; Symbol: Double): Byte; 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; 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; // 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 // 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); 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); FillChar(FOuterLevel, SizeOf(FOuterLevel), 0); FillChar(FDibitHistory, SizeOf(FDibitHistory), 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; 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; FSelectedSlot := -1; 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; 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; Dibit: Byte; V: Double; begin V := Symbol; if FInputInverted then V := -V; 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; 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 FSyncShift[Phase] = Pat then begin NoteSync(Phase, SYNC_KIND[i], FInputInverted); Exit; end; end; end; function TDMRDecoder.Digitize(Phase: Integer; Symbol: Double): Byte; var A, Threshold: Double; begin 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]); Threshold := 0.625 * FOuterLevel[Phase]; 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; 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 FCurrentBurst[i] := FDibitHistory[Phase, P]; 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 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; if FSelectedSlot < 0 then FSelectedSlot := FLastLCSlot; end; DecodeVoiceBurst; Inc(FBurstCount); FCurrentBurstPos := 0; end; procedure TDMRDecoder.DecodeVoiceBurst; var Frames: TDMRAMBEFrames; PCM: array[0..DMR_PCM_SAMPLES - 1] of Single; MbeResult: TDMRMbeResult; Slot, FrameIndex, RC: Integer; 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; 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 FSelectedSlot < 0 then FSelectedSlot := Slot; if Slot <> FSelectedSlot 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); 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 with the largest 24-symbol eye opening, // not merely the first phase that happened to match the sign pattern. if (FLastSyncTick <> 0) and (NowTick - FLastSyncTick < 5) then begin if FMagSum[Phase] > FBestSyncQuality then begin FBestSyncQuality := FMagSum[Phase]; FSyncKind := Kind; FInverted := Inverted; StartBurstTracking(Phase); end; Exit; end; FSyncKind := Kind; FInverted := Inverted; Inc(FSyncCount); FLastSyncTick := NowTick; FBestSyncQuality := FMagSum[Phase]; StartBurstTracking(Phase); 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; 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; S.LinkControlValid := FLastLinkControl.Decoded; S.LCSlot := FLastLCSlot; S.LCOpcode := FLastLinkControl.Opcode; S.ServiceOptions := FLastLinkControl.ServiceOptions; S.TargetID := FLastLinkControl.TargetID; S.SourceID := FLastLinkControl.SourceID; 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; end.