From 9b77809a73eec1b8b75f72b3b4063fcd4ba8f697 Mon Sep 17 00:00:00 2001 From: Vladimir Date: Wed, 19 Aug 2026 12:50:21 +0300 Subject: [PATCH] =?UTF-8?q?fix(tci,cat):=20=D1=80=D0=B5=D0=B7=D0=B5=D1=80?= =?UTF-8?q?=D0=B2=20=D0=B1=D1=8E=D0=B4=D0=B6=D0=B5=D1=82=D0=B0=20=D0=BF?= =?UTF-8?q?=D0=B5=D1=80=D0=B5=D0=B5=D0=B7=D0=B6=D0=B0=D0=B5=D1=82=20=D0=BF?= =?UTF-8?q?=D0=B8=D1=81=D0=B0=D1=82=D0=B5=D0=BB=D1=8E;=20=D1=81=D1=82?= =?UTF-8?q?=D1=80=D0=BE=D0=B3=D0=B8=D0=B9=20=D1=80=D0=B0=D0=B7=D0=B1=D0=BE?= =?UTF-8?q?=D1=80=20=D0=BF=D0=BE=D0=BB=D0=B5=D0=B9=20ZZ-=D0=BA=D0=BE=D0=BC?= =?UTF-8?q?=D0=B0=D0=BD=D0=B4?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Три замечания по 79132f1. 1. [P2] Лимит памяти рекордеров обходился при SAVE. Take собирал сплошную копию записи, а DropData тут же возвращал исходные куски в бюджет — копия жила дальше в асинхронном TTCIWavWriter уже неучтённой. Один SAVE поднимал настоящее потребление примерно вдвое, а на медленном или зависшем сетевом каталоге очередь writer-потоков и их буферов росла мимо потолка вовсе. Теперь копия НАСЛЕДУЕТ резерв кусков, из которых собрана: Take отдаёт его out-параметром Reserved, писатель держит до конца записи и отпускает в ReleaseData — ровно один раз, сколько бы путей выхода ни было у Execute. Новых денег у бюджета копия не берёт, так что потолок теперь считает и очередь сохранений тоже. 2. [P2] Пять ZZ-команд проверяли длину поля, но не содержимое: StrToIntDef(s, 0) превращал любую нечисловую пару символов в индекс 0. ZZBSxx; переключал диапазон на нулевой вместо ?;, ZZBMxx; и ZZAUxx;/ZZBPxx; двигали VFO, ZZFIxx; выбирал фильтр 0. Разбор приведён к идиоме ZZFL/ZZFH: TryStrToInt, иначе ошибка формата. 3. [P3] Сообщение об отказе запуска TCI звало в Settings → Advanced, а настройки там уже не живут — вкладка CAT (переезд был в de0830f). Стенд 194/194: Take отдаёт резерв размером с копию, после Take занят ровно он, писатель возвращает его по окончании. Без фикса первая проверка краснеет. GUI (--ws=qt6) и демон зелёные. doc/TCI.md §2.5 и сводка стенда, doc/CAT_STATUS.md — таблица разбора. Co-Authored-By: Claude Opus 5 --- CATEngine.pas | 22 ++++++++++++++---- MainForm.pas | 2 +- TCIAdapter.pas | 8 +++++-- TCIStreams.pas | 55 +++++++++++++++++++++++++++++++++++--------- doc/CAT_STATUS.md | 1 + doc/TCI.md | 12 ++++++++-- test/tci/tcitest.pas | 50 ++++++++++++++++++++++++++++++++-------- 7 files changed, 119 insertions(+), 31 deletions(-) diff --git a/CATEngine.pas b/CATEngine.pas index ea8dce9..3903a54 100644 --- a/CATEngine.pas +++ b/CATEngine.pas @@ -1743,10 +1743,13 @@ end; function TCATEngine.ZZAU(const s: string): string; // ZZAU: сдвиг VFO A вверх на один шаг с индексом nn (00..14, см. StepIdxToHz). +// ★Нечисловое поле — ошибка формата: StrToIntDef молча дал бы индекс 0, то +// есть «ZZAUxx;» двигал бы VFO вместо честного «?;» (как в ZZFL/ZZFH). var idx: Integer; begin if Length(s) = 2 then begin - idx := EnsureRange(StrToIntDef(s, 0), 0, 14); + if not TryStrToInt(s, idx) then Exit(CAT_ERROR); + idx := EnsureRange(idx, 0, 14); if Assigned(FCtx.SetVfoA) then FCtx.SetVfoA(SafeGetVfoA + StepIdxToHz(idx)); Result := ''; end else @@ -1755,10 +1758,12 @@ end; function TCATEngine.ZZBP(const s: string): string; // ZZBP: сдвиг VFO B вверх на один шаг с индексом nn (00..14, см. StepIdxToHz). +// Разбор поля — как у ZZAU: нечисловое значит ошибку, а не нулевой индекс. var idx: Integer; begin if Length(s) = 2 then begin - idx := EnsureRange(StrToIntDef(s, 0), 0, 14); + if not TryStrToInt(s, idx) then Exit(CAT_ERROR); + idx := EnsureRange(idx, 0, 14); if Assigned(FCtx.SetVfoB) then FCtx.SetVfoB(SafeGetVfoB + StepIdxToHz(idx)); Result := ''; end else @@ -1811,10 +1816,12 @@ end; function TCATEngine.ZZBM(const s: string): string; // ZZBM: сдвиг VFO B ВНИЗ на один шаг с индексом nn (00..14) — пара к ZZBP. // (Режим — это ZZMD; раньше ZZBM был ошибочно заалиашен на него.) +// Разбор поля — как у ZZAU: нечисловое значит ошибку, а не нулевой индекс. var idx: Integer; begin if Length(s) = 2 then begin - idx := EnsureRange(StrToIntDef(s, 0), 0, 14); + if not TryStrToInt(s, idx) then Exit(CAT_ERROR); + idx := EnsureRange(idx, 0, 14); if Assigned(FCtx.SetVfoB) then FCtx.SetVfoB(SafeGetVfoB - StepIdxToHz(idx)); Result := ''; end else @@ -1825,10 +1832,13 @@ function TCATEngine.ZZBS(const s: string): string; // ZZBS: выбор диапазона. ⚠ Отклонение от Thetis: там поле трёхсимвольное и // несёт КОД диапазона ("160"/"040"/"WWV"), у нас — двузначный ИНДЕКС в списке // диапазонов EWSDR. Менять поздно: на этом формате уже сидят клиенты. +// ★Нечисловое поле — ошибка формата: StrToIntDef переключал бы на диапазон 0, +// то есть уводил бы оператора с рабочего бэнда по опечатке клиента. var idx: Integer; begin if Length(s) = 2 then begin - idx := EnsureRange(StrToIntDef(s, 0), 0, 10); + if not TryStrToInt(s, idx) then Exit(CAT_ERROR); + idx := EnsureRange(idx, 0, 10); if Assigned(FCtx.DoBandByIndex) then FCtx.DoBandByIndex(idx); Result := ''; end else if Length(s) = 0 then @@ -2000,10 +2010,12 @@ end; function TCATEngine.ZZFI(const s: string): string; // ZZFI: индекс текущего фильтра (2 цифры). +// Разбор поля — как у ZZFL/ZZFH: нечисловое значит ошибку, а не фильтр 0. var idx: Integer; begin if Length(s) = 2 then begin - idx := EnsureRange(StrToIntDef(s, 0), 0, 9); + if not TryStrToInt(s, idx) then Exit(CAT_ERROR); + idx := EnsureRange(idx, 0, 9); if Assigned(FCtx.SetFilterIdx) then FCtx.SetFilterIdx(idx); Result := ''; end else if Length(s) = 0 then diff --git a/MainForm.pas b/MainForm.pas index 741b20e..5a4d342 100644 --- a/MainForm.pas +++ b/MainForm.pas @@ -2735,7 +2735,7 @@ begin if not FTCIAdapter.ApplySettings(FTCICfg) then ShowMessage('TCI server failed to start on ' + FTCICfg.BindAddr + ':' + IntToStr(FTCICfg.Port) + '.' + LineEnding + - 'Port busy or address invalid — check Settings → Advanced.'); + 'Port busy or address invalid — check Settings → CAT.'); OnActivate := TCIFormActivate; OnDeactivate := TCIFormDeactivate; diff --git a/TCIAdapter.pas b/TCIAdapter.pas index 53fe548..1065ae7 100644 --- a/TCIAdapter.pas +++ b/TCIAdapter.pas @@ -2999,6 +2999,7 @@ var Rx, Sec, Rate: Integer; Path, Req: string; Data: TTCIPcm; + Held: Int64; // байты бюджета, уходящие писателю вместе с Data Old, New_: TTCIRecorder; begin if not TCITryArgInt(M, 0, Rx) or not ValidRx(Rx) then @@ -3085,6 +3086,7 @@ begin // потом снимаем с него данные: копия кольца — это десятки мегабайт, и делать // её под локом DSP-потока нельзя. Data := nil; + Held := 0; Rate := TCI_AUDIO_ENGINE_RATE; FStreamLock.Enter; try @@ -3095,7 +3097,9 @@ begin end; if Old <> nil then begin - Data := Old.Take; + // ★Резерв бюджета переезжает вместе с данными: копию держит писатель, и + // отпустит её он же. Иначе SAVE был бы дырой в потолке памяти. + Data := Old.Take(Held); Rate := Old.Rate; Old.Free; end; @@ -3106,7 +3110,7 @@ begin end; // Пишет отдельный поток: файл может быть в десятки мегабайт, а мы сейчас в // потоке клиента, который в это время не читает свой сокет. - TTCIWavWriter.Create(Path, Data, Rate); + TTCIWavWriter.Create(Path, Data, Rate, Held); end; procedure TTCIAdapter.DropClientRecorders(C: TTCIClient); diff --git a/TCIStreams.pas b/TCIStreams.pas index b4c111b..b44b766 100644 --- a/TCIStreams.pas +++ b/TCIStreams.pas @@ -214,8 +214,12 @@ type destructor Destroy; override; procedure Feed(const L, R: array of Single; N: Integer); { Забрать накопленное и завершить запись. nil — либо не записано ничего, - либо окно уже истекло (по документу это одно и то же: записи нет). } - function Take: TTCIPcm; + либо окно уже истекло (по документу это одно и то же: записи нет). + ★Reserved — сколько байт бюджета УХОДИТ ВМЕСТЕ С ДАННЫМИ: копия живёт + дальше в писателе, и пока он её не отпустит, она обязана оставаться + учтённой. Вызывающий передаёт это число писателю (или возвращает сам + через TCIRecBudgetFree, если писателя не будет). } + function Take(out Reserved: Int64): TTCIPcm; { Окно закрылось по часам. Спрашивает тик сервера: у мёртвого приёмника Feed не зовут вовсе, и без этого вопроса память жила бы до Stop. } function Expired: Boolean; @@ -225,17 +229,23 @@ type end; { Писатель WAV в своём потоке: файл до 60 МБ, а зовут сохранение из тика - сервера — блокировать его на секунду диска нельзя. Данные забирает себе. } + сервера — блокировать его на секунду диска нельзя. Данные забирает себе + ВМЕСТЕ С ИХ РЕЗЕРВОМ в общем бюджете (AReserved из TTCIRecorder.Take) и + отпускает его, только когда данные больше не нужны. Пока писатель ждёт + медленный диск, эти байты остаются занятыми — так потолок и держит + очередь сохранений, а не только сами записи. } TTCIWavWriter = class(TThread) private FPath: string; FData: TTCIPcm; FRate: Integer; + FReserved: Int64; + procedure ReleaseData; protected procedure Execute; override; public constructor Create(const APath: string; const AData: TTCIPcm; - ARateHz: Integer); + ARateHz: Integer; AReserved: Int64); end; { Коэффициент прореживания SrcRate → WantRate: наибольший целый делитель, @@ -843,11 +853,13 @@ begin end; end; -function TTCIRecorder.Take: TTCIPcm; +function TTCIRecorder.Take(out Reserved: Int64): TTCIPcm; var C, n, Left: Integer; + Copy_: Int64; begin - Result := nil; + Result := nil; + Reserved := 0; FLock.Enter; try // Проверка срока и здесь: аудио могло не идти вовсе (мьют, стоящий @@ -857,6 +869,13 @@ begin // Склейка кусков в один буфер — единственное копирование за всю запись, и // оно идёт уже вне DSP-потока: SAVE вынимает рекордер из таблицы раньше, // чем зовёт Take, так что кормить его больше некому. + // ★Копия НЕ берёт у бюджета новых денег и НЕ отпускает старых: она + // наследует резерв кусков, из которых собрана. Иначе SAVE был бы дырой в + // потолке — DropData возвращал бы куски сразу, а копия жила бы дальше в + // писателе неучтённой, и на медленном (или зависшем) сетевом каталоге + // writer-потоки копились бы без всякой границы. + Copy_ := Int64(FCount) * 2 * SizeOf(SmallInt); + if Copy_ > FBytes then Copy_ := FBytes; // не отдать больше, чем занято SetLength(Result, FCount * 2); Left := FCount; for C := 0 to High(FChunks) do @@ -867,6 +886,10 @@ begin Move(FChunks[C][0], Result[(FCount - Left) * 2], n * 2 * SizeOf(SmallInt)); Dec(Left, n); end; + // Из общего резерва оставляем ровно то, что перешло в копию, остальное + // (хвост последнего куска) возвращаем — этим и займётся DropData. + Reserved := Copy_; + Dec(FBytes, Copy_); DropData; // SAVE завершает запись (§4.3) finally FLock.Leave; @@ -878,16 +901,26 @@ end; ═══════════════════════════════════════════════════════════════════════════ } constructor TTCIWavWriter.Create(const APath: string; - const AData: TTCIPcm; ARateHz: Integer); + const AData: TTCIPcm; ARateHz: Integer; AReserved: Int64); begin inherited Create(True); FreeOnTerminate := True; - FPath := APath; - FData := AData; - FRate := ARateHz; + FPath := APath; + FData := AData; + FRate := ARateHz; + FReserved := AReserved; Start; end; +procedure TTCIWavWriter.ReleaseData; +// Данные и их место в бюджете уходят вместе и ровно один раз — сколько бы +// путей выхода ни было у Execute. +begin + FData := nil; + TCIRecBudgetFree(FReserved); + FReserved := 0; +end; + procedure TTCIWavWriter.Execute; // Заголовок собираем в буфере: WAV — это фиксированные 44 байта, и городить // два десятка отдельных Write ради них незачем (а строковые литералы в @@ -954,7 +987,7 @@ begin // клиенту уже некому: команда давно подтверждена. Молчим, но и не падаем: // исключение из потока утащило бы за собой процесс. end; - FData := nil; + ReleaseData; end; { ═══════════════════════════════════════════════════════════════════════════ diff --git a/doc/CAT_STATUS.md b/doc/CAT_STATUS.md index 44c0c75..95a59dd 100644 --- a/doc/CAT_STATUS.md +++ b/doc/CAT_STATUS.md @@ -272,6 +272,7 @@ Thetis, у нас есть, ширины полей совпадают с `CATSt |---|---| | `TCATEngine.Parse` | команды без параметров не проверяли суффикс: `TXanything;` доходил до `CmdTX` и **поднимал передачу**; так же вели себя `RX UP DN BD BU QI RC ID IF`. Эталон отбраковывает лишний суффикс в парсере, по таблице ширин; у нас таблицы нет — список безаргументных команд теперь в `IsParamless` | | `ZZFL` / `ZZFH` | принимали поле любой длины от 4 символов и гнали его через `StrToIntDef`: `ZZFLabcd;` молча схлопывал кромку в ноль. Поле фиксированное — ровно 5 символов со знаком, разбор строгий | +| `ZZAU` `ZZBP` `ZZBM` `ZZBS` `ZZFI` | длину поля проверяли, а содержимое — нет: `StrToIntDef(s, 0)` превращал любую нечисловую пару символов в индекс 0. То есть `ZZBSxx;` **переключал диапазон** на нулевой вместо `?;`, `ZZBMxx;` и `ZZAUxx;`/`ZZBPxx;` двигали VFO, а `ZZFIxx;` выбирал фильтр 0. Разбор приведён к идиоме `ZZFL`/`ZZFH`: `TryStrToInt`, иначе ошибка формата | | `KY` / `ZZKY` | текст не ограничивался; поле у Kenwood фиксированное, 25 символов. Длиннее — `?;`: очередь передачи не должна расти произвольно, иначе один пакет уводит станцию в эфир на неопределённое время | | `CATTcp.SendStr` | один `send` на ответ. TCP не обязан отдать весь буфер за раз — длинный ответ (`IF`, `ZZEB`, список режимов) мог уехать обрезанным, и молча: усечение здесь не ошибка. Теперь дописываем остаток в цикле | | `CATSerial` | порт помечался активным ДО `SerOpen`; при отказе он навсегда оставался «работающим» в `ActiveCount` и UI, а причина нигде не оседала. Открытие переехало из потока в `TCATSerialPort.Start` (синхронно), появилось свойство `LastError`, поток теперь только читает, а закрывает владелец в `Stop`. Заодно Andromeda-порт назначается только на реально поднявшийся порт | diff --git a/doc/TCI.md b/doc/TCI.md index 84072b9..7627d31 100644 --- a/doc/TCI.md +++ b/doc/TCI.md @@ -528,7 +528,14 @@ ExpertSDR3 давно бы не было. 2. **Общий бюджет `TCI_RECORD_MAX_BYTES` (128 МБ) на все рекордеры сразу.** Спрашивается при выделении каждого куска. Отказ не рушит запись: набранное остаётся сохраняемым, просто дальше она не растёт — иначе клиент терял бы - уже записанное из-за чужой записи на другом приёмнике. + уже записанное из-за чужой записи на другом приёмнике. ★`SAVE` бюджет не + обходит: `Take` собирает куски в сплошную копию и **передаёт ей их резерв** + (out-параметр `Reserved`), а не возвращает его сразу — копия живёт дальше в + `TTCIWavWriter`, и отпускает место он же, когда данные больше не нужны + (`ReleaseData` — ровно один раз, сколько бы путей выхода ни было у + `Execute`). Иначе один `SAVE` поднимал бы настоящее потребление вдвое, а на + медленном или зависшем сетевом каталоге очередь writer-потоков росла бы + мимо потолка вовсе. 3. **Освобождение по трём событиям, а не по одному.** Раньше срок проверял только `Feed`, то есть DSP-поток — а к мёртвому приёмнику он не приходит никогда, и `START` на несуществующий номер оставлял память навсегда. @@ -861,7 +868,8 @@ ExpertSDR3 давно бы не было. выделяет ни байта, бюджет растёт кусками по мере звука и возвращается по `Free`, потолок берётся целиком и сверх него следует отказ, при отказе запись не рушится, окно истекает по часам **без единого `Feed`** и отдаёт память - само. ★Имя файла: простое имя ложится в каталог записей, а каталог из + само, `Take` отдаёт резерв размером с копию и после него занят ровно он, а + писатель возвращает этот резерв по окончании записи. ★Имя файла: простое имя ложится в каталог записей, а каталог из просьбы отбрасывается — абсолютный путь, `..` и буква диска наружу не выводят; пусто, `..`, не-`.wav`, управляющий символ и отсутствие каталога записей дают отказ; существующий файл писатель не перезаписывает. diff --git a/test/tci/tcitest.pas b/test/tci/tcitest.pas index 746df56..9fe2625 100644 --- a/test/tci/tcitest.pas +++ b/test/tci/tcitest.pas @@ -562,12 +562,13 @@ var Sz: LongWord; W: TTCIWavWriter; Waited: Integer; - Was: Int64; + Was, Held: Int64; begin WriteLn('C. Рекордер линейного выхода'); // Максимум записи — 1 секунда: подаём полторы, лишнее не берём. ★Именно НЕ // берём: окно записи по §4.3 начинается со START, а не «последняя секунда». + Was := TCIRecBudgetUsed; // счёт бюджета ДО записи Rec := TTCIRecorder.Create(0, 48000, 1, nil); try Total := 0; @@ -577,12 +578,25 @@ begin Rec.Feed(L, R, 8192); Inc(Total, 8192); end; - Data := Rec.Take; + Data := Rec.Take(Held); Check('рекордер: длина по максимуму', Length(Data) = 48000 * 2, IntToStr(Length(Data))); + // ★Take отдаёт данные ВМЕСТЕ с их местом в бюджете: копия живёт дальше в + // писателе, и до конца записи она обязана оставаться учтённой. Иначе SAVE + // был бы дырой в потолке — куски вернулись бы сразу, а копия висела бы + // неучтённой, и очередь сохранений на медленном диске росла бы без границ. + Check('рекордер: Take передаёт резерв размером с копию', + Held = Int64(Length(Data)) * SizeOf(SmallInt), + IntToStr(Held)); + Check('рекордер: после Take занят ровно резерв копии', + TCIRecBudgetUsed = Was + Held, + IntToStr(TCIRecBudgetUsed - Was)); + TCIRecBudgetFree(Held); // как это сделает писатель + Check('рекордер: возврат резерва закрывает счёт', + TCIRecBudgetUsed = Was, IntToStr(TCIRecBudgetUsed - Was)); Check('рекордер: уровень сохранён', (Data[0] = Round(0.25 * 32767)) and (Data[1] = -Round(0.25 * 32767))); - Check('рекордер: Take завершает запись', Length(Rec.Take) = 0); + Check('рекордер: Take завершает запись', Length(Rec.Take(Held)) = 0); finally Rec.Free; end; @@ -596,7 +610,7 @@ begin R[0] := 0; Rec.Feed(L, R, 1); end; - Data := Rec.Take; + Data := Rec.Take(Held); Check('рекордер: с начала записи, а не с конца', (Length(Data) = 2000) and (Data[0] = 0) and (Abs(Data[1998] - Round((999 / 4000.0) * 32767)) <= 1), @@ -611,7 +625,7 @@ begin try for i := 0 to 8191 do begin L[i] := 0.25; R[i] := -0.25; end; Rec.Feed(L, R, 8192); - Check('рекордер: до срока запись есть', Length(Rec.Take) > 0); + Check('рекордер: до срока запись есть', Length(Rec.Take(Held)) > 0); finally Rec.Free; end; @@ -619,9 +633,9 @@ begin try Rec.Feed(L, R, 8192); Sleep(1100); // окно закрылось - Check('рекордер: после срока запись удалена', Length(Rec.Take) = 0); + Check('рекордер: после срока запись удалена', Length(Rec.Take(Held)) = 0); Rec.Feed(L, R, 8192); // и новое аудио уже не принимает - Check('рекордер: истёкший не оживает', Length(Rec.Take) = 0); + Check('рекордер: истёкший не оживает', Length(Rec.Take(Held)) = 0); finally Rec.Free; end; @@ -654,7 +668,7 @@ begin try Rec.Feed(L, R, 8192); Check('бюджет: при отказе запись не рушится, а стоит пустой', - Length(Rec.Take) = 0); + Length(Rec.Take(Held)) = 0); finally Rec.Free; end; @@ -683,7 +697,7 @@ begin DeleteFile(Path); SetLength(Data, 2000); for i := 0 to 1999 do Data[i] := i * 8; - W := TTCIWavWriter.Create(Path, Data, 48000); + W := TTCIWavWriter.Create(Path, Data, 48000, 0); Waited := 0; while (not FileExists(Path)) and (Waited < 2000) do begin @@ -713,12 +727,28 @@ begin finally FS.Free; end; + // ★Писатель отпускает резерв, когда данные ему больше не нужны — иначе + // потолок памяти держал бы только сами записи, а очередь сохранений на + // медленном диске росла бы мимо него. + Was := TCIRecBudgetUsed; + Check('WAV: резерв под писателя взят', TCIRecBudgetTake(4096)); + DeleteFile(Path); + TTCIWavWriter.Create(Path, Data, 48000, 4096); + Waited := 0; + while (TCIRecBudgetUsed <> Was) and (Waited < 2000) do + begin + Sleep(10); + Inc(Waited, 10); + end; + Check('WAV: писатель вернул резерв по окончании', + TCIRecBudgetUsed = Was, IntToStr(TCIRecBudgetUsed - Was)); + // ★Существующий файл не трогаем: имя приходит из сети, и fmCreate затирал // бы любой доступный процессу файл. Пишем поверх заведомо другой длиной — // файл обязан остаться прежним. SetLength(Data, 10); for i := 0 to 9 do Data[i] := 1; - TTCIWavWriter.Create(Path, Data, 48000); + TTCIWavWriter.Create(Path, Data, 48000, 0); Sleep(200); FS := TFileStream.Create(Path, fmOpenRead); try