mirror of
https://git.vladimir.cc/vladimir/ewsdr.git
synced 2026-08-25 20:37:33 +00:00
feat(dmr): add diagnostic capture probes
This commit is contained in:
@@ -0,0 +1,342 @@
|
||||
unit DMRDiagnostics;
|
||||
|
||||
{$IFDEF FPC}
|
||||
{$MODE Delphi}
|
||||
{$ENDIF}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, SyncObjs;
|
||||
|
||||
type
|
||||
TDMRDiagnosticCapture = class;
|
||||
|
||||
TDMRDumpWriter = class(TThread)
|
||||
private
|
||||
FOwner: TDMRDiagnosticCapture;
|
||||
protected
|
||||
procedure Execute; override;
|
||||
public
|
||||
constructor Create(AOwner: TDMRDiagnosticCapture);
|
||||
end;
|
||||
|
||||
TDMRDiagnosticCapture = class
|
||||
private
|
||||
FLock: TCriticalSection;
|
||||
FWake: PRTLEvent;
|
||||
FThread: TDMRDumpWriter;
|
||||
FAccepting: Boolean;
|
||||
FDeadline: QWord;
|
||||
FBasePath: string;
|
||||
FIQ, FDemod, FBursts: TBytes;
|
||||
FIQRead, FIQWrite, FDemodRead, FDemodWrite: Integer;
|
||||
FBurstRead, FBurstWrite: Integer;
|
||||
FIQDropped, FDemodDropped, FBurstDropped: QWord;
|
||||
FIQStream, FDemodStream, FBurstStream: TFileStream;
|
||||
function RingWrite(var Ring: TBytes; var ReadPos, WritePos: Integer;
|
||||
Source: Pointer; Count: Integer; var Dropped: QWord): Boolean;
|
||||
function RingRead(var Ring: TBytes; var ReadPos, WritePos: Integer;
|
||||
Dest: Pointer; MaxCount: Integer): Integer;
|
||||
function RingsEmpty: Boolean;
|
||||
procedure WriterExecute;
|
||||
procedure CloseStreams;
|
||||
procedure WriteStats;
|
||||
public
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
function Start(DurationSeconds: Integer; SampleRate: Integer;
|
||||
CenterHz, VfoHz: Double; const Directory: string = ''): string;
|
||||
procedure Stop;
|
||||
procedure FeedIQ24BE(const Data: array of Byte; Count: Integer);
|
||||
procedure FeedDemod(const Left, Right: array of Single; Count: Integer);
|
||||
procedure FeedBurst(const Dibits: array of Byte; Count: Integer);
|
||||
function Active: Boolean;
|
||||
property BasePath: string read FBasePath;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
const
|
||||
IQ_RING_BYTES = 32 * 1024 * 1024;
|
||||
DEMOD_RING_BYTES = 4 * 1024 * 1024;
|
||||
BURST_RING_BYTES = 1024 * 1024;
|
||||
WRITER_BLOCK_BYTES = 256 * 1024;
|
||||
|
||||
constructor TDMRDumpWriter.Create(AOwner: TDMRDiagnosticCapture);
|
||||
begin
|
||||
inherited Create(True);
|
||||
FreeOnTerminate := False;
|
||||
FOwner := AOwner;
|
||||
end;
|
||||
|
||||
procedure TDMRDumpWriter.Execute;
|
||||
begin
|
||||
FOwner.WriterExecute;
|
||||
end;
|
||||
|
||||
constructor TDMRDiagnosticCapture.Create;
|
||||
begin
|
||||
inherited Create;
|
||||
FLock := TCriticalSection.Create;
|
||||
FWake := RTLEventCreate;
|
||||
SetLength(FIQ, IQ_RING_BYTES);
|
||||
SetLength(FDemod, DEMOD_RING_BYTES);
|
||||
SetLength(FBursts, BURST_RING_BYTES);
|
||||
end;
|
||||
|
||||
destructor TDMRDiagnosticCapture.Destroy;
|
||||
begin
|
||||
Stop;
|
||||
SetLength(FIQ, 0);
|
||||
SetLength(FDemod, 0);
|
||||
SetLength(FBursts, 0);
|
||||
RTLEventDestroy(FWake);
|
||||
FLock.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
function TDMRDiagnosticCapture.RingWrite(var Ring: TBytes;
|
||||
var ReadPos, WritePos: Integer; Source: Pointer; Count: Integer;
|
||||
var Dropped: QWord): Boolean;
|
||||
var
|
||||
FreeBytes, First: Integer;
|
||||
begin
|
||||
Result := False;
|
||||
if (Source = nil) or (Count <= 0) or (Length(Ring) = 0) then Exit;
|
||||
if WritePos >= ReadPos then FreeBytes := Length(Ring) - (WritePos - ReadPos) - 1
|
||||
else FreeBytes := ReadPos - WritePos - 1;
|
||||
if Count > FreeBytes then
|
||||
begin
|
||||
Inc(Dropped, Count);
|
||||
Exit;
|
||||
end;
|
||||
First := Count;
|
||||
if First > Length(Ring) - WritePos then First := Length(Ring) - WritePos;
|
||||
Move(Source^, Ring[WritePos], First);
|
||||
if Count > First then
|
||||
Move(PByte(Source)[First], Ring[0], Count - First);
|
||||
WritePos := (WritePos + Count) mod Length(Ring);
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
function TDMRDiagnosticCapture.RingRead(var Ring: TBytes;
|
||||
var ReadPos, WritePos: Integer; Dest: Pointer; MaxCount: Integer): Integer;
|
||||
var
|
||||
Available, First: Integer;
|
||||
begin
|
||||
Result := 0;
|
||||
if (Dest = nil) or (MaxCount <= 0) then Exit;
|
||||
if WritePos >= ReadPos then Available := WritePos - ReadPos
|
||||
else Available := Length(Ring) - ReadPos + WritePos;
|
||||
Result := Available;
|
||||
if Result > MaxCount then Result := MaxCount;
|
||||
First := Result;
|
||||
if First > Length(Ring) - ReadPos then First := Length(Ring) - ReadPos;
|
||||
if First > 0 then Move(Ring[ReadPos], Dest^, First);
|
||||
if Result > First then Move(Ring[0], PByte(Dest)[First], Result - First);
|
||||
ReadPos := (ReadPos + Result) mod Length(Ring);
|
||||
end;
|
||||
|
||||
function TDMRDiagnosticCapture.RingsEmpty: Boolean;
|
||||
begin
|
||||
Result := (FIQRead = FIQWrite) and (FDemodRead = FDemodWrite) and
|
||||
(FBurstRead = FBurstWrite);
|
||||
end;
|
||||
|
||||
procedure TDMRDiagnosticCapture.CloseStreams;
|
||||
begin
|
||||
FreeAndNil(FIQStream);
|
||||
FreeAndNil(FDemodStream);
|
||||
FreeAndNil(FBurstStream);
|
||||
end;
|
||||
|
||||
procedure TDMRDiagnosticCapture.WriteStats;
|
||||
var
|
||||
Stats: TStringList;
|
||||
begin
|
||||
if FBasePath = '' then Exit;
|
||||
Stats := TStringList.Create;
|
||||
try
|
||||
Stats.Add(Format('iq_dropped_bytes=%d', [FIQDropped]));
|
||||
Stats.Add(Format('demod_dropped_bytes=%d', [FDemodDropped]));
|
||||
Stats.Add(Format('burst_dropped_bytes=%d', [FBurstDropped]));
|
||||
Stats.SaveToFile(FBasePath + '.stats.txt');
|
||||
finally
|
||||
Stats.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TDMRDiagnosticCapture.Start(DurationSeconds: Integer;
|
||||
SampleRate: Integer; CenterHz, VfoHz: Double; const Directory: string): string;
|
||||
var
|
||||
Dir, Stamp: string;
|
||||
Meta: TStringList;
|
||||
begin
|
||||
Stop;
|
||||
if DurationSeconds < 1 then DurationSeconds := 1;
|
||||
if Directory <> '' then Dir := IncludeTrailingPathDelimiter(Directory)
|
||||
else Dir := IncludeTrailingPathDelimiter(GetTempDir(False));
|
||||
ForceDirectories(Dir);
|
||||
Stamp := FormatDateTime('yyyymmdd-hhnnss-zzz', Now);
|
||||
FBasePath := Dir + 'ewsdr-dmr-' + Stamp;
|
||||
FIQStream := TFileStream.Create(FBasePath + '.iq24be', fmCreate);
|
||||
FDemodStream := TFileStream.Create(FBasePath + '.demod_f32le', fmCreate);
|
||||
FBurstStream := TFileStream.Create(FBasePath + '.bursts_u8', fmCreate);
|
||||
|
||||
Meta := TStringList.Create;
|
||||
try
|
||||
Meta.Add('{');
|
||||
Meta.Add(' "format": "EWSDR DMR diagnostic capture v1",');
|
||||
Meta.Add(' "iq_format": "interleaved signed 24-bit big-endian I,Q",');
|
||||
Meta.Add(' "demod_format": "mono float32 little-endian, 48000 Hz",');
|
||||
Meta.Add(' "burst_format": "144 uint8 dibits per record",');
|
||||
Meta.Add(Format(' "iq_sample_rate": %d,', [SampleRate]));
|
||||
Meta.Add(Format(' "center_hz": %.0f,', [CenterHz]));
|
||||
Meta.Add(Format(' "vfo_hz": %.0f,', [VfoHz]));
|
||||
Meta.Add(Format(' "duration_seconds": %d', [DurationSeconds]));
|
||||
Meta.Add('}');
|
||||
Meta.SaveToFile(FBasePath + '.json');
|
||||
finally
|
||||
Meta.Free;
|
||||
end;
|
||||
|
||||
FLock.Enter;
|
||||
try
|
||||
FIQRead := 0; FIQWrite := 0;
|
||||
FDemodRead := 0; FDemodWrite := 0;
|
||||
FBurstRead := 0; FBurstWrite := 0;
|
||||
FIQDropped := 0; FDemodDropped := 0; FBurstDropped := 0;
|
||||
FDeadline := GetTickCount64 + QWord(DurationSeconds) * 1000;
|
||||
FAccepting := True;
|
||||
finally
|
||||
FLock.Leave;
|
||||
end;
|
||||
FThread := TDMRDumpWriter.Create(Self);
|
||||
FThread.Start;
|
||||
Result := FBasePath;
|
||||
end;
|
||||
|
||||
procedure TDMRDiagnosticCapture.Stop;
|
||||
begin
|
||||
if FThread = nil then
|
||||
begin
|
||||
CloseStreams;
|
||||
Exit;
|
||||
end;
|
||||
FLock.Enter;
|
||||
try
|
||||
FAccepting := False;
|
||||
finally
|
||||
FLock.Leave;
|
||||
end;
|
||||
RTLEventSetEvent(FWake);
|
||||
FThread.WaitFor;
|
||||
FreeAndNil(FThread);
|
||||
CloseStreams;
|
||||
WriteStats;
|
||||
end;
|
||||
|
||||
procedure TDMRDiagnosticCapture.WriterExecute;
|
||||
var
|
||||
IQBuf, DemodBuf, BurstBuf: TBytes;
|
||||
NIQ, NDemod, NBurst: Integer;
|
||||
AcceptingNow, EmptyNow: Boolean;
|
||||
begin
|
||||
SetLength(IQBuf, WRITER_BLOCK_BYTES);
|
||||
SetLength(DemodBuf, WRITER_BLOCK_BYTES);
|
||||
SetLength(BurstBuf, WRITER_BLOCK_BYTES);
|
||||
repeat
|
||||
FLock.Enter;
|
||||
try
|
||||
if FAccepting and (GetTickCount64 >= FDeadline) then FAccepting := False;
|
||||
NIQ := RingRead(FIQ, FIQRead, FIQWrite, @IQBuf[0], Length(IQBuf));
|
||||
NDemod := RingRead(FDemod, FDemodRead, FDemodWrite,
|
||||
@DemodBuf[0], Length(DemodBuf));
|
||||
NBurst := RingRead(FBursts, FBurstRead, FBurstWrite,
|
||||
@BurstBuf[0], Length(BurstBuf));
|
||||
AcceptingNow := FAccepting;
|
||||
EmptyNow := RingsEmpty;
|
||||
finally
|
||||
FLock.Leave;
|
||||
end;
|
||||
if NIQ > 0 then FIQStream.WriteBuffer(IQBuf[0], NIQ);
|
||||
if NDemod > 0 then FDemodStream.WriteBuffer(DemodBuf[0], NDemod);
|
||||
if NBurst > 0 then FBurstStream.WriteBuffer(BurstBuf[0], NBurst);
|
||||
if (NIQ = 0) and (NDemod = 0) and (NBurst = 0) and AcceptingNow then
|
||||
RTLEventWaitFor(FWake, 100);
|
||||
until (not AcceptingNow) and EmptyNow;
|
||||
CloseStreams;
|
||||
WriteStats;
|
||||
end;
|
||||
|
||||
procedure TDMRDiagnosticCapture.FeedIQ24BE(const Data: array of Byte;
|
||||
Count: Integer);
|
||||
var
|
||||
Wrote: Boolean;
|
||||
begin
|
||||
if Count > Length(Data) then Count := Length(Data);
|
||||
if Count <= 0 then Exit;
|
||||
FLock.Enter;
|
||||
try
|
||||
if not FAccepting then Exit;
|
||||
Wrote := RingWrite(FIQ, FIQRead, FIQWrite, @Data[0], Count, FIQDropped);
|
||||
finally
|
||||
FLock.Leave;
|
||||
end;
|
||||
if Wrote then RTLEventSetEvent(FWake);
|
||||
end;
|
||||
|
||||
procedure TDMRDiagnosticCapture.FeedDemod(const Left, Right: array of Single;
|
||||
Count: Integer);
|
||||
var
|
||||
Mono: array[0..2047] of Single;
|
||||
i, N: Integer;
|
||||
Wrote: Boolean;
|
||||
begin
|
||||
N := Count;
|
||||
if N > Length(Left) then N := Length(Left);
|
||||
if N > Length(Right) then N := Length(Right);
|
||||
if N > Length(Mono) then N := Length(Mono);
|
||||
if N <= 0 then Exit;
|
||||
for i := 0 to N - 1 do Mono[i] := 0.5 * (Left[i] + Right[i]);
|
||||
FLock.Enter;
|
||||
try
|
||||
if not FAccepting then Exit;
|
||||
Wrote := RingWrite(FDemod, FDemodRead, FDemodWrite, @Mono[0],
|
||||
N * SizeOf(Single), FDemodDropped);
|
||||
finally
|
||||
FLock.Leave;
|
||||
end;
|
||||
if Wrote then RTLEventSetEvent(FWake);
|
||||
end;
|
||||
|
||||
procedure TDMRDiagnosticCapture.FeedBurst(const Dibits: array of Byte;
|
||||
Count: Integer);
|
||||
var
|
||||
Wrote: Boolean;
|
||||
begin
|
||||
if Count > Length(Dibits) then Count := Length(Dibits);
|
||||
if Count <= 0 then Exit;
|
||||
FLock.Enter;
|
||||
try
|
||||
if not FAccepting then Exit;
|
||||
Wrote := RingWrite(FBursts, FBurstRead, FBurstWrite, @Dibits[0], Count,
|
||||
FBurstDropped);
|
||||
finally
|
||||
FLock.Leave;
|
||||
end;
|
||||
if Wrote then RTLEventSetEvent(FWake);
|
||||
end;
|
||||
|
||||
function TDMRDiagnosticCapture.Active: Boolean;
|
||||
begin
|
||||
FLock.Enter;
|
||||
try
|
||||
Result := FAccepting;
|
||||
finally
|
||||
FLock.Leave;
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
Reference in New Issue
Block a user