unit TxHealth;

{
  TxHealth.pas — тихий детектор голодания очереди TX.

  ЗАЧЕМ. Всплеск своего сигнала, рождённый НАШИМ трактом, физически невозможен
  без одного события: очередь DUC простаивает дольше подушки отправителя
  (DUC_FIFO_THROTTLE = 2000 отсчётов при 192 кГц = 10.42 мс). Доказано pcap-
  съёмом: шесть всплесков в дампе — шесть простоев 10.3-23.5 мс, а паузы 8 мс и
  короче не дали ни одного. Значит счётчик таких простоев — ПОЛНЫЙ детектор:
  молчит он — всплеск не наш (смотреть приёмный тракт, PA, реле, спуры),
  сработал — наш, и момент известен с точностью до микросекунд.

  ★ГЛАВНОЕ ПРАВИЛО, оплаченное регрессом. Прошлый прибор (TxTrace) писал дамп
  СИНХРОННО в хвосте SetMOX — десятки миллисекунд ровно в том окне, где жила
  гонка FTxRunning, и тем самым ЧИНИЛ дефект собой: с зондами всплесков не было,
  без них они возвращались. Поэтому здесь в тракте передачи не делается НИЧЕГО,
  кроме записи в память:
    * потоки передачи (отправитель DUC, сетевой поток статуса, планировщик TCI)
      только пишут в кольцо и в счётчики — ни файлов, ни локов, ни форматирования;
    * ВСЮ работу с диском делает ПОТРЕБИТЕЛЬ (таймер UI 100 мс / цикл демона),
      вызывая TxHealthService. Своих потоков юнит не заводит.

  Детектор включён ВСЕГДА: переменной окружения нет намеренно — прибор, который
  надо не забыть включить, к моменту дефекта выключен.
}

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

interface

const
  // Подушка отправителя: DUC_FIFO_THROTTLE = 2000 отсчётов при DUC_SAMPLE_RATE
  // = 192000 (копия из HPSDRNetwork.pas — юнит намеренно ни от чего не зависит).
  // Простой ДЛИННЕЕ неё гарантированно осушает FIFO радио: в эфире остаётся
  // голая несущая гетеродина DUC.
  TXH_CUSHION_US = 10417;

  // Источник модуляции в сводке (что именно кормило передатчик).
  txhSrcRadio = 0;
  txhSrcCard  = 1;
  txhSrcWeb   = 2;
  txhSrcTCI   = 3;

type
  // Один опасный простой очереди — с контекстом пейсинга TCI на тот момент.
  TTxDrought = record
    Session:   LongInt;   // к какой передаче относится
    AtMs:      Integer;   // от фронта PTT
    LenUs:     Integer;   // длительность простоя
    Queue:     Integer;   // глубина очереди DUC на выходе из простоя
    Lead:      Integer;   // аванс, кадров (0 — модуляция не из TCI)
    Owed:      Integer;   // долг, кадров
    InFlight:  Integer;   // в полёте, кадров
    Quantum:   Integer;   // квант запроса, кадров
    StepUs:    Integer;   // шаг планировщика
    GapUs:     Integer;   // период между пачками клиента
  end;

  // Сводка по одной передаче.
  TTxSession = record
    Id:            LongInt;
    StartedAt:     TDateTime;
    LenMs:         Integer;
    Source:        Integer;    // txhSrc*
    Droughts:      Integer;    // простоев всего
    Dangerous:     Integer;    // из них длиннее подушки
    LongestUs:     Integer;
    FirstDangerMs: Integer;    // -1 — опасных не было
    FifoEmpty:     Integer;    // HP-статусов с битом «DUC FIFO пуст»
  end;

// ── Пишут потоки передачи (только память) ───────────────────────────────────
procedure TxHealthPtt(On_: Boolean; Source: Integer);
procedure TxHealthDrought(FromUs, ToUs: Int64; QueueDepth: Integer);
procedure TxHealthFifoEmpty;
procedure TxHealthPublishTci(Lead, Owed, InFlight, Quantum, StepUs,
  GapUs: Integer);

// ── Зовёт потребитель (UI-таймер / цикл демона) ─────────────────────────────
{ Забрать готовые сводки и дописать их в ~/.config/ewsdr/txhealth.log.
  Возвращает число записанных передач. Работа с диском — только здесь. }
function  TxHealthService: Integer;
{ Снять следующую сводку, не трогая диск (Service стоит на этих двух; стенду и
  любому иному потребителю — тоже). }
function  TxHealthTake(out S: TTxSession): Boolean;
{ Index-й опасный простой этой передачи, пока он ещё жив в кольце. }
function  TxHealthDetail(Id: LongInt; Index: Integer; out D: TTxDrought): Boolean;
{ Опасных простоев за весь сеанс — для индикации в UI. }
function  TxHealthDangerTotal: Integer;
{ Последняя записанная сводка (для UI/стенда), False — сводок ещё не было. }
function  TxHealthLastSession(out S: TTxSession): Boolean;
{ Путь журнала. }
function  TxHealthLogPath: string;

implementation

uses
  SysUtils, Math, PlatformUtils;

const
  RING_SIZE = 256;              // опасных простоев в памяти (хвост важнее)
  RING_MASK = RING_SIZE - 1;
  SESS_SIZE = 32;               // сводок, ждущих потребителя
  SESS_MASK = SESS_SIZE - 1;
  MAX_DETAIL = 24;              // строк подробностей на передачу в журнале

var
  // Кольцо опасных простоев: пишет поток отправителя DUC, читает потребитель.
  Ring:     array[0..RING_SIZE - 1] of TTxDrought;
  RingSeq:  LongInt = 0;

  // Кольцо сводок: пишет поток, снимающий PTT, читает потребитель.
  Sess:     array[0..SESS_SIZE - 1] of TTxSession;
  SessSeq:  LongInt = 0;        // сколько сводок сложено
  SessRead: LongInt = 0;        // сколько забрал потребитель

  // Текущая передача.
  CurId:      LongInt = 0;
  CurStartUs: Int64   = 0;
  CurStartAt: TDateTime = 0;
  CurSource:  Integer = txhSrcRadio;
  CurOn:      Boolean = False;
  CurDroughts, CurDanger, CurLongest, CurFirstMs, CurFifoEmpty: Integer;

  // Снимок пейсинга TCI — публикует планировщик, читает поток отправителя.
  // Простые записи без лока: числа диагностические, рвань в них безвредна, а
  // лок в потоке отправителя DUC — недопустимый риск для тайминга.
  PubLead, PubOwed, PubFlight, PubQuantum, PubStep, PubGap: Integer;

  DangerTotal: Integer = 0;
  LastSess:    TTxSession;
  HaveLast:    Boolean = False;

procedure TxHealthPtt(On_: Boolean; Source: Integer);
// Фронт PTT. Только память: несколько записей, никакого ввода-вывода.
var
  S: TTxSession;
  Idx: LongInt;
begin
  if On_ then
  begin
    if CurOn then Exit;
    InterlockedIncrement(CurId);
    CurStartUs   := MonotonicUs;
    CurStartAt   := Now;
    CurSource    := Source;
    CurDroughts  := 0;
    CurDanger    := 0;
    CurLongest   := 0;
    CurFirstMs   := -1;
    CurFifoEmpty := 0;
    CurOn        := True;
    Exit;
  end;

  if not CurOn then Exit;
  CurOn := False;
  S.Id            := CurId;
  S.StartedAt     := CurStartAt;
  S.LenMs         := Integer((MonotonicUs - CurStartUs) div 1000);
  S.Source        := CurSource;
  S.Droughts      := CurDroughts;
  S.Dangerous     := CurDanger;
  S.LongestUs     := CurLongest;
  S.FirstDangerMs := CurFirstMs;
  S.FifoEmpty     := CurFifoEmpty;
  Idx := InterlockedIncrement(SessSeq) - 1;
  Sess[Idx and SESS_MASK] := S;
end;

procedure TxHealthDrought(FromUs, ToUs: Int64; QueueDepth: Integer);
// Поток отправителя DUC, на выходе очереди из простоя. Дороже всего здесь одно
// вычитание: время простоя измерил вызывающий, он же держит его границы.
var
  LenUs, AtMs: Integer;
  Idx: LongInt;
  P: ^TTxDrought;
begin
  if not CurOn then Exit;
  LenUs := Integer(ToUs - FromUs);
  if LenUs < 0 then Exit;
  Inc(CurDroughts);
  if LenUs > CurLongest then CurLongest := LenUs;
  if LenUs <= TXH_CUSHION_US then Exit;

  Inc(CurDanger);
  InterlockedIncrement(DangerTotal);
  AtMs := Integer((FromUs - CurStartUs) div 1000);
  if CurFirstMs < 0 then CurFirstMs := AtMs;

  Idx := InterlockedIncrement(RingSeq) - 1;
  P := @Ring[Idx and RING_MASK];
  P^.Session  := CurId;
  P^.AtMs     := AtMs;
  P^.LenUs    := LenUs;
  P^.Queue    := QueueDepth;
  P^.Lead     := PubLead;
  P^.Owed     := PubOwed;
  P^.InFlight := PubFlight;
  P^.Quantum  := PubQuantum;
  P^.StepUs   := PubStep;
  P^.GapUs    := PubGap;
end;

procedure TxHealthFifoEmpty;
// Сетевой поток, разбор HP-статуса: радио говорит, что его DUC FIFO пуст.
// ★На этой прошивке поле ГЛУБИНЫ FIFO статично (всегда 256) и веры ему нет —
// а вот бит в байте статуса мы раньше не читали вовсе. Если прошивка его
// заполняет, получаем жалобу самого железа как независимого свидетеля.
begin
  if CurOn then Inc(CurFifoEmpty);
end;

procedure TxHealthPublishTci(Lead, Owed, InFlight, Quantum, StepUs,
  GapUs: Integer);
// Планировщик TCI. Публикация состояния пейсинга для контекста простоев.
begin
  PubLead    := Lead;
  PubOwed    := Owed;
  PubFlight  := InFlight;
  PubQuantum := Quantum;
  PubStep    := StepUs;
  PubGap     := GapUs;
end;

function TxHealthDangerTotal: Integer;
begin
  Result := DangerTotal;
end;

function TxHealthLastSession(out S: TTxSession): Boolean;
begin
  Result := HaveLast;
  if Result then S := LastSess;
end;

function TxHealthLogPath: string;
begin
  Result := GetAppCfgDir + 'txhealth.log';
end;

function SourceName(Src: Integer): string;
begin
  case Src of
    txhSrcTCI:  Result := 'TCI';
    txhSrcWeb:  Result := 'web';
    txhSrcCard: Result := 'звуковая карта';
  else
    Result := 'микрофон радио';
  end;
end;

function TxHealthTake(out S: TTxSession): Boolean;
var Have: LongInt;
begin
  Have := SessSeq;
  if Have <= SessRead then Exit(False);
  // Сводки, которые кольцо успело затереть, пропускаем: журнал честно отражает
  // хвост, а отстать на SESS_SIZE передач потребитель может лишь простояв
  // секунды — чего с таймером 100 мс не бывает.
  if Have - SessRead > SESS_SIZE then SessRead := Have - SESS_SIZE;
  S := Sess[SessRead and SESS_MASK];
  Inc(SessRead);
  LastSess := S;
  HaveLast := True;
  Result := True;
end;

function TxHealthDetail(Id: LongInt; Index: Integer; out D: TTxDrought): Boolean;
var
  i, Seen, Total: LongInt;
begin
  Result := False;
  Total  := RingSeq;
  Seen   := 0;
  for i := Max(0, Total - RING_SIZE) to Total - 1 do
  begin
    if Ring[i and RING_MASK].Session <> Id then Continue;
    if Seen = Index then
    begin
      D := Ring[i and RING_MASK];
      Exit(True);
    end;
    Inc(Seen);
  end;
end;

procedure WriteSession(var F: TextFile; const S: TTxSession);
// Одна передача: строка сводки плюс подробности по опасным простоям.
var
  Shown: Integer;
  R: TTxDrought;
  Verdict: string;
begin
  if S.Dangerous > 0 then
    Verdict := 'ОПАСНО'
  else
    Verdict := 'чисто';
  if S.FirstDangerMs >= 0 then
    Verdict := Verdict + Format(' (первое на %d мс)', [S.FirstDangerMs]);
  WriteLn(F, Format('%s  %s  передача %.1f с, источник %s: осушений %d, ' +
                    'опасных %d, самое длинное %.1f мс, FIFO-EMPTY %d',
          [FormatDateTime('yyyy-mm-dd hh:nn:ss', S.StartedAt), Verdict,
           S.LenMs / 1000.0, SourceName(S.Source), S.Droughts, S.Dangerous,
           S.LongestUs / 1000.0, S.FifoEmpty]));
  if S.Dangerous <= 0 then Exit;

  Shown := 0;
  while TxHealthDetail(S.Id, Shown, R) do
  begin
    Inc(Shown);
    if Shown > MAX_DETAIL then
    begin
      WriteLn(F, '    … остальные опущены');
      Break;
    end;
    WriteLn(F, Format('    опасный #%d: на %d мс от PTT, %.1f мс, очередь %d, ' +
                      'аванс %d, долг %d, в полёте %d, квант %d, шаг %d мкс, ' +
                      'пачка клиента %.1f мс',
            [Shown, R.AtMs, R.LenUs / 1000.0, R.Queue, R.Lead, R.Owed,
             R.InFlight, R.Quantum, R.StepUs, R.GapUs / 1000.0]));
  end;
end;

function TxHealthService: Integer;
// ★Единственное место с диском, и зовут его только потребители (таймер UI,
// цикл демона) — никогда не поток передачи.
var
  F: TextFile;
  S: TTxSession;
begin
  Result := 0;
  if SessSeq <= SessRead then Exit;

  AssignFile(F, TxHealthLogPath);
  try
    if FileExists(TxHealthLogPath) then Append(F) else Rewrite(F);
    try
      while TxHealthTake(S) do
      begin
        WriteSession(F, S);
        Inc(Result);
      end;
    finally
      CloseFile(F);
    end;
  except
    // Журнал — вспомогательный: не пишется, так и ладно. Сводки при этом
    // считаем забранными, иначе они копились бы и пытались писаться каждые
    // 100 мс.
    on E: Exception do SessRead := SessSeq;
  end;
end;

end.