Fix DUC IQ pacing for TX tune

HPSDRNetwork.pas

@@ -21,6 +21,9 @@ uses
 {$ENDIF}
   HPSDRProtocol, SyncObjs;
 
+const
+  DUC_TX_QUEUE_SIZE = 256;  // power of two, bounded latency on TX underrun/overrun
+
 {$IFDEF WINDOWS}
 // ---------------------------------------------------------------------------
 // WinSock2 — type aliases и forward declarations
@@ -108,6 +111,7 @@ type
 
     FReceiveThread:   TThread;
     FKeepaliveThread: TThread;
+    FDUCIQThread:     TThread;
 
     FOnDeviceFound: TOnDeviceFound;
     FOnDDCIQ:       TOnDDCIQPacket;
@@ -140,6 +144,16 @@ type
 
     FSendLock: TCriticalSection;  // защита concurrent UDP sends
 
+    // DUC IQ sender: WDSP отдаёт IQ блоками, а железу нужен равномерный UDP
+    // поток 240 IQ-пар/пакет @ 192 kS/s, то есть пакет каждые 1.25 ms.
+    FDUCIQLock:  TCriticalSection;
+    FDUCIQSem:   PRTLEvent;
+    FDUCIQQueue: array[0..DUC_TX_QUEUE_SIZE - 1] of TDUCIQPacket;
+    FDUCIQHead:  Integer;
+    FDUCIQTail:  Integer;
+    FDUCIQCount: Integer;
+    FDUCIQDrops: LongWord;
+
     function  DoCreateSocket: TSocket;
     procedure DoCloseSocket(var S: TSocket);
     function  DoSendTo(S: TSocket; const Buf; BufLen: Integer;
@@ -153,6 +167,9 @@ type
     procedure HandleMicData(const Buf: array of Byte; Len: Integer);
     procedure StartThreads;
     procedure StopThreads;
+    procedure ResetDUCIQQueue;
+    procedure EnqueueDUCIQ(const Pkt: TDUCIQPacket);
+    function  DequeueDUCIQ(var Pkt: TDUCIQPacket): Boolean;
     function  NextSeq(var S: LongWord): LongWord;
     procedure PackSeqBytes(var B: array of Byte; Seq: LongWord);
 
@@ -194,6 +211,9 @@ implementation
 {$IFDEF WINDOWS}
 var
   WSAData_: WinSock2.TWSAData;
+
+function QueryPerformanceCounter(var lpPerformanceCount: Int64): LongBool; stdcall; external 'kernel32.dll';
+function QueryPerformanceFrequency(var lpFrequency: Int64): LongBool; stdcall; external 'kernel32.dll';
 {$ENDIF}
 
 {$IFDEF WINDOWS}
@@ -378,6 +398,142 @@ begin
   end;
 end;
 
+// ===========================================================================
+// DUC IQ paced sender thread
+// ===========================================================================
+type
+  TDUCIQSenderThread = class(TThread)
+  private
+    FNet: THPSDRNetwork;
+  protected
+    procedure Execute; override;
+  public
+    constructor Create(ANet: THPSDRNetwork);
+  end;
+
+constructor TDUCIQSenderThread.Create(ANet: THPSDRNetwork);
+begin
+  FNet := ANet;
+  FreeOnTerminate := False;
+  inherited Create(False);
+end;
+
+procedure TDUCIQSenderThread.Execute;
+const
+  DUC_IQ_PAIRS_PER_PACKET = 240;
+  DUC_SAMPLE_RATE         = 192000;  // IQ pairs per second
+  DUC_FIFO_THROTTLE       = 1250;    // piHPSDR-style virtual radio FIFO limit
+  DUC_PACKET_INTERVAL_US  = 1250;    // 240 / 192000 seconds
+  DUC_WIN_SPIN_US         = 350;     // final part of 1.25 ms interval: avoid Sleep jitter
+var
+  Pkt:            TDUCIQPacket;
+{$IFDEF WINDOWS}
+  QPCFreq:        Int64;
+  QPCValue:       Int64;
+  NextDueUs:      Int64;
+  NowUs:          Int64;
+  WaitUs:         Int64;
+{$ELSE}
+  VirtualSamples: Integer;
+  LastTick:       QWord;
+  NowTick:        QWord;
+  ElapsedMs:      QWord;
+{$ENDIF}
+
+{$IFDEF WINDOWS}
+  function ClockUs: Int64;
+  begin
+    QueryPerformanceCounter(QPCValue);
+    Result := (QPCValue * 1000000) div QPCFreq;
+  end;
+
+  procedure WaitUntil(DueUs: Int64);
+  begin
+    while not Terminated do
+    begin
+      NowUs := ClockUs;
+      WaitUs := DueUs - NowUs;
+      if WaitUs <= 0 then Break;
+      if WaitUs > 2500 then
+        Sleep(1)
+      else if WaitUs > DUC_WIN_SPIN_US then
+        Sleep(0);
+    end;
+  end;
+{$ELSE}
+  procedure DrainVirtualFIFO;
+  begin
+    NowTick := GetTickCount64;
+    if NowTick > LastTick then
+    begin
+      ElapsedMs := NowTick - LastTick;
+      Dec(VirtualSamples, Integer(ElapsedMs) * (DUC_SAMPLE_RATE div 1000));
+      if VirtualSamples < 0 then VirtualSamples := 0;
+      LastTick := NowTick;
+    end;
+  end;
+{$ENDIF}
+
+begin
+{$IFDEF WINDOWS}
+  if not QueryPerformanceFrequency(QPCFreq) or (QPCFreq <= 0) then
+    QPCFreq := 1000;
+  NextDueUs := ClockUs;
+
+  while not Terminated do
+  begin
+    if not FNet.DequeueDUCIQ(Pkt) then
+    begin
+      RTLEventWaitFor(FNet.FDUCIQSem, 20);
+      NowUs := ClockUs;
+      if NextDueUs < NowUs - DUC_PACKET_INTERVAL_US then
+        NextDueUs := NowUs;
+      Continue;
+    end;
+
+    WaitUntil(NextDueUs);
+    if Terminated then Break;
+
+    FNet.PackSeqBytes(Pkt.Seq, FNet.NextSeq(FNet.FSeqDUCIQ));
+    FNet.DoSendTo(FNet.FSocket, Pkt, SizeOf(Pkt), FNet.FDevice.IPAddress,
+                  FNet.FPortDUCIQ);
+
+    Inc(NextDueUs, DUC_PACKET_INTERVAL_US);
+    NowUs := ClockUs;
+    if NextDueUs < NowUs - DUC_PACKET_INTERVAL_US then
+      NextDueUs := NowUs;
+  end;
+{$ELSE}
+  VirtualSamples := 0;
+  LastTick := GetTickCount64;
+
+  while not Terminated do
+  begin
+    if not FNet.DequeueDUCIQ(Pkt) then
+    begin
+      DrainVirtualFIFO;
+      RTLEventWaitFor(FNet.FDUCIQSem, 20);
+      DrainVirtualFIFO;
+      Continue;
+    end;
+
+    if Terminated then Break;
+    DrainVirtualFIFO;
+
+    FNet.PackSeqBytes(Pkt.Seq, FNet.NextSeq(FNet.FSeqDUCIQ));
+    FNet.DoSendTo(FNet.FSocket, Pkt, SizeOf(Pkt), FNet.FDevice.IPAddress,
+                  FNet.FPortDUCIQ);
+    Inc(VirtualSamples, DUC_IQ_PAIRS_PER_PACKET);
+
+    while (not Terminated) and (VirtualSamples > DUC_FIFO_THROTTLE) do
+    begin
+      Sleep(1);
+      DrainVirtualFIFO;
+    end;
+  end;
+{$ENDIF}
+end;
+
 // ===========================================================================
 // Keepalive thread
 // ===========================================================================
@@ -436,6 +592,7 @@ begin
   FLocalPort       := 0;
   FReceiveThread   := nil;
   FKeepaliveThread := nil;
+  FDUCIQThread     := nil;
   FPortDDCSpec     := PORT_DDC_SPECIFIC;
   FPortDUCSpec     := PORT_DUC_SPECIFIC;
   FPortHPFromPC    := PORT_HP_FROM_PC;
@@ -448,11 +605,16 @@ begin
   FPAEnabled       := True;
   FAlexEnabled     := True;
   FSendLock        := TCriticalSection.Create;
+  FDUCIQLock       := TCriticalSection.Create;
+  FDUCIQSem        := RTLEventCreate;
+  ResetDUCIQQueue;
 end;
 
 destructor THPSDRNetwork.Destroy;
 begin
   Disconnect;
+  RTLEventDestroy(FDUCIQSem);
+  FDUCIQLock.Free;
   FSendLock.Free;
   inherited;
 end;
@@ -471,6 +633,54 @@ begin
   B[3] :=  Seq         and $FF;
 end;
 
+procedure THPSDRNetwork.ResetDUCIQQueue;
+begin
+  FDUCIQLock.Enter;
+  try
+    FDUCIQHead  := 0;
+    FDUCIQTail  := 0;
+    FDUCIQCount := 0;
+    FDUCIQDrops := 0;
+  finally
+    FDUCIQLock.Leave;
+  end;
+end;
+
+procedure THPSDRNetwork.EnqueueDUCIQ(const Pkt: TDUCIQPacket);
+begin
+  FDUCIQLock.Enter;
+  try
+    if FDUCIQCount >= DUC_TX_QUEUE_SIZE then
+    begin
+      FDUCIQTail := (FDUCIQTail + 1) and (DUC_TX_QUEUE_SIZE - 1);
+      Dec(FDUCIQCount);
+      Inc(FDUCIQDrops);
+    end;
+
+    FDUCIQQueue[FDUCIQHead] := Pkt;
+    FDUCIQHead := (FDUCIQHead + 1) and (DUC_TX_QUEUE_SIZE - 1);
+    Inc(FDUCIQCount);
+    RTLEventSetEvent(FDUCIQSem);
+  finally
+    FDUCIQLock.Leave;
+  end;
+end;
+
+function THPSDRNetwork.DequeueDUCIQ(var Pkt: TDUCIQPacket): Boolean;
+begin
+  Result := False;
+  FDUCIQLock.Enter;
+  try
+    if FDUCIQCount <= 0 then Exit;
+    Pkt := FDUCIQQueue[FDUCIQTail];
+    FDUCIQTail := (FDUCIQTail + 1) and (DUC_TX_QUEUE_SIZE - 1);
+    Dec(FDUCIQCount);
+    Result := True;
+  finally
+    FDUCIQLock.Leave;
+  end;
+end;
+
 // ---------------------------------------------------------------------------
 // Сокеты (только FPC RTL Sockets unit)
 // ---------------------------------------------------------------------------
@@ -708,6 +918,7 @@ begin
   FSeqHP      := 0;
   FSeqAudio   := 0;
   FSeqDUCIQ   := 0;
+  ResetDUCIQQueue;
 
   StartThreads;
   Result := True;
@@ -738,15 +949,22 @@ begin
 {$ENDIF}
   FReceiveThread := TReceiveThread.Create(Self);
   FReceiveThread.Priority := tpHighest;     // Сетевой поток — критический
+  FDUCIQThread := TDUCIQSenderThread.Create(Self);
+  FDUCIQThread.Priority := tpHighest;        // TX packet pacing is timing-sensitive
   FKeepaliveThread := TKeepaliveThread.Create(Self);
   FKeepaliveThread.Priority := tpNormal;
 end;
 
 procedure THPSDRNetwork.StopThreads;
 begin
-{$IFDEF WINDOWS}
+  if Assigned(FDUCIQThread) then
-  timeEndPeriod(1);
+  begin
-{$ENDIF}
+    FDUCIQThread.Terminate;
+    RTLEventSetEvent(FDUCIQSem);
+    FDUCIQThread.WaitFor;
+    FreeAndNil(FDUCIQThread);
+  end;
+
   if Assigned(FReceiveThread) then
   begin
     FReceiveThread.Terminate;
@@ -764,6 +982,10 @@ begin
     FKeepaliveThread.WaitFor;
     FreeAndNil(FKeepaliveThread);
   end;
+  ResetDUCIQQueue;
+{$IFDEF WINDOWS}
+  timeEndPeriod(1);
+{$ENDIF}
 end;
 
 // ---------------------------------------------------------------------------
@@ -1081,8 +1303,8 @@ var
   i, Off: Integer;
   IV, QV: Integer;
 begin
+  if not FConnected then Exit;
   FillChar(Pkt, SizeOf(Pkt), 0);
-  PackSeqBytes(Pkt.Seq, NextSeq(FSeqDUCIQ));
   for i := 0 to Min(239, Min(High(IData), High(QData))) do
   begin
     Off := i * 6;
@@ -1095,7 +1317,7 @@ begin
     Pkt.IQData[Off + 4] := Byte((QV shr  8) and $FF);
     Pkt.IQData[Off + 5] := Byte( QV         and $FF);
   end;
-  DoSendTo(FSocket, Pkt, SizeOf(Pkt), FDevice.IPAddress, FPortDUCIQ);
+  EnqueueDUCIQ(Pkt);
 end;
 
 

WDSPEngine.pas

@@ -534,12 +534,22 @@ procedure TTXDSPThread.Execute;
 var
   Avail:    Integer;
   PeriodMs: Integer;
+  PeriodUs: Integer;
+  AccUs:    Integer;
+  DidBlock: Boolean;
 begin
-  // 512 сэмплов / 48000 Гц = ~10.67 мс → округляем вниз до 10 мс
+  // 512 samples / 48000 Hz = 10.666 ms.  Do not floor this to 10 ms:
-  PeriodMs := Max(1, FEngine.FAudioBufSize * 1000 div FEngine.FAudioRate);
+  // that over-produces TX IQ by ~6.7%, eventually forcing DUC queue
+  // corrections/drops and producing periodic sidebands on a pure TUN tone.
+  PeriodUs := Max(1000, FEngine.FAudioBufSize * 1000000 div FEngine.FAudioRate);
+  AccUs    := 0;
 
   while not Terminated do
   begin
+    Inc(AccUs, PeriodUs);
+    PeriodMs := Max(1, AccUs div 1000);
+    Dec(AccUs, PeriodMs * 1000);
+
     // Ждём сигнала от mic-данных ИЛИ истечения периода —
     // в piHPSDR timing идёт от receive thread; здесь — от таймаута
     RTLEventWaitFor(FEngine.FTXMicSem, PeriodMs);
@@ -554,28 +564,34 @@ begin
       FEngine.FOnPullMic(FEngine.FAudioBufSize * 2);
 
     // Обрабатываем накопившиеся блоки с реальными mic-данными
+    DidBlock := False;
     repeat
       Avail := (FEngine.FTXMicHead - FEngine.FTXMicTail + TX_MIC_RING)
                 and (TX_MIC_RING - 1);
       if (Avail >= FEngine.FAudioBufSize) and not Terminated then
-        FEngine.ProcessTXBlock
+      begin
+        FEngine.ProcessTXBlock;
+        DidBlock := True;
+      end
       else
         Break;
     until False;
 
     if Terminated then Break;
 
-    // Если mic-данных не было — обрабатываем один блок тишины, чтобы
+    // Если на этом тике не было ни одного полного mic-блока и mic-данных
-    // DUC IQ поток не прерывался и спектр/водопад обновлялись.
+    // вообще нет — обрабатываем один блок тишины, чтобы DUC IQ поток не
-    // НО для sound-card mic неполный блок (0 < Avail < AudioBufSize) нельзя
+    // прерывался и спектр/водопад обновлялись.
-    // подменять тишиной: PortAudio часто отдаёт 128-сэмпловые callback'и,
+    // Важно: не добавлять silence-block сразу после реального блока. Для TUN
-    // и если в кольце уже есть голосовой хвост — он застрянет, а в эфир
+    // этот "silence" тоже содержит PostGen tone, поэтому лишний блок ломает
-    // уйдёт тишина. Слышно как чередование «голос/тишина» = треск ≈50–100 Гц.
+    // темп DUC IQ и даёт периодические боковые/тр-р-р.
-    // В этом случае ждём следующий тик, хвост накопится до полного блока.
+    // Если же в ring уже есть неполный блок, нельзя подменять его тишиной:
+    // radio mic приходит пакетами по 64 сэмпла, sound-card часто по 128.
+    // Иначе каждый mic packet будит поток раньше срока, а мы генерируем
+    // лишний TX-блок тишины вместо ожидания полного 512-sample блока.
     Avail := (FEngine.FTXMicHead - FEngine.FTXMicTail + TX_MIC_RING)
               and (TX_MIC_RING - 1);
-    if (Avail = 0) or (FEngine.FTXMicSource <> txmsSoundCard) then
+    if (not DidBlock) and (Avail = 0) then
-      if Avail < FEngine.FAudioBufSize then
       FEngine.ProcessTXBlock;
   end;
 end;