fix(tci): SAVE отдаёт писателю сами куски записи, а не сплошную копию

Потолок 128 МБ всё ещё пробивался примерно вдвое на пике: Take собирал
линейную копию ДО освобождения FChunks, поэтому при полном бюджете рядом
жили ~128 МБ кусков и ~128 МБ копии, а счётчик показывал 128. Передача
резерва писателю (9b77809) закрывала учёт, но не сам пик.

Копии больше нет вовсе. Take отдаёт куски КАК ЕСТЬ — новый TTCIRecTake
(Chunks + Chunk + Count + Reserved), — и вместе с ними уезжает их место в
бюджете целиком. TTCIWavWriter пишет куски в файл подряд: в WAV сэмплы и
так лежат встык, а хвост последнего куска за Count просто не наш. Место
отпускается в ReleaseData, ровно один раз на любом пути выхода Execute.

Продовый путь теперь не выделяет под запись ни одного лишнего байта:
TTCIPcm остался только внутри куска. Склейка нужна одному стенду, чтобы
проверять порядок и уровень, — она и живёт в стенде (FlatTake).

Стенд 199/199: 2.5 с записи отдаются ТРЕМЯ кусками по секунде (свёрнутая
копия дала бы один), счёт бюджета при Take не меняется, резерва хватает
на отданные куски, склеенные куски дают непрерывный звук, писатель
возвращает резерв по окончании. Проверено, что копирующая реализация Take
краснит четыре проверки. GUI (--ws=qt6) и демон зелёные.

Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
This commit is contained in:
2026-08-19 13:18:20 +03:00
co-authored by Claude Opus 5
parent 9b77809a73
commit 7aae0fdfcd
4 changed files with 195 additions and 90 deletions
+69 -54
View File
@@ -52,6 +52,21 @@ const
type
{ Накопленная запись: 16-битный PCM с чередованием L/R. }
TTCIPcm = array of SmallInt;
TTCIPcmChunks = array of TTCIPcm;
{ ★Забранная запись — КУСКИ КАК ЕСТЬ, без сплошной копии. Копия удваивала бы
пик памяти ровно в тот момент, когда её меньше всего: при полном бюджете
рядом жили бы 128 МБ кусков и 128 МБ копии, а счётчик показывал бы 128.
Куски переезжают к писателю вместе со своим местом в бюджете (Reserved),
и WAV собирается из них подряд — данные в нём и так лежат встык.
Chunk — сэмплов на канал в ПОЛНОМ куске (последний бывает неполным),
Count — сколько их занято всего. }
TTCIRecTake = record
Chunks: TTCIPcmChunks;
Chunk: Integer;
Count: Integer;
Reserved: Int64;
end;
{ Дециматор с целым коэффициентом. Прямая свёртка по линии задержки: выход
считается только на нужной фазе, поэтому цена не зависит от M. }
@@ -196,7 +211,7 @@ type
TTCIRecorder = class
private
FLock: TCriticalSection;
FChunks: array of TTCIPcm; // куски по FChunk сэмплов на канал, L/R вперемешку
FChunks: TTCIPcmChunks; // куски по FChunk сэмплов на канал, L/R вперемешку
FChunk: Integer; // сэмплов на канал в куске
FCap: Integer; // потолок в сэмплах на канал
FCount: Integer; // накоплено сэмплов на канал
@@ -213,13 +228,13 @@ type
constructor Create(ARx, ARateHz, AMaxSec: Integer; AOwner: TObject);
destructor Destroy; override;
procedure Feed(const L, R: array of Single; N: Integer);
{ Забрать накопленное и завершить запись. nil — либо не записано ничего,
либо окно уже истекло (по документу это одно и то же: записи нет).
★Reserved — сколько байт бюджета УХОДИТ ВМЕСТЕ С ДАННЫМИ: копия живёт
дальше в писателе, и пока он её не отпустит, она обязана оставаться
учтённой. Вызывающий передаёт это число писателю (или возвращает сам
через TCIRecBudgetFree, если писателя не будет). }
function Take(out Reserved: Int64): TTCIPcm;
{ Забрать накопленное и завершить запись. Count = 0 — либо не записано
ничего, либо окно уже истекло (по документу это одно и то же: записи
нет). ★Вместе с кусками уходит и их место в бюджете (Reserved): пока
писатель их не отпустит, они обязаны оставаться учтёнными. Вызывающий
передаёт запись писателю или сам возвращает Reserved через
TCIRecBudgetFree, если писателя не будет. }
function Take: TTCIRecTake;
{ Окно закрылось по часам. Спрашивает тик сервера: у мёртвого приёмника
Feed не зовут вовсе, и без этого вопроса память жила бы до Stop. }
function Expired: Boolean;
@@ -230,22 +245,21 @@ type
{ Писатель WAV в своём потоке: файл до 60 МБ, а зовут сохранение из тика
сервера — блокировать его на секунду диска нельзя. Данные забирает себе
ВМЕСТЕ С ИХ РЕЗЕРВОМ в общем бюджете (AReserved из TTCIRecorder.Take) и
отпускает его, только когда данные больше не нужны. Пока писатель ждёт
КУСКАМИ, вместе с их местом в общем бюджете (TTCIRecTake.Reserved), и
отпускает его, только когда они больше не нужны. Пока писатель ждёт
медленный диск, эти байты остаются занятыми — так потолок и держит
очередь сохранений, а не только сами записи. }
TTCIWavWriter = class(TThread)
private
FPath: string;
FData: TTCIPcm;
FRec: TTCIRecTake;
FRate: Integer;
FReserved: Int64;
procedure ReleaseData;
protected
procedure Execute; override;
public
constructor Create(const APath: string; const AData: TTCIPcm;
ARateHz: Integer; AReserved: Int64);
constructor Create(const APath: string; const ARec: TTCIRecTake;
ARateHz: Integer);
end;
{ Коэффициент прореживания SrcRate → WantRate: наибольший целый делитель,
@@ -853,44 +867,33 @@ begin
end;
end;
function TTCIRecorder.Take(out Reserved: Int64): TTCIPcm;
var
C, n, Left: Integer;
Copy_: Int64;
function TTCIRecorder.Take: TTCIRecTake;
begin
Result := nil;
Reserved := 0;
Result.Chunks := nil;
Result.Chunk := FChunk;
Result.Count := 0;
Result.Reserved := 0;
FLock.Enter;
try
// Проверка срока и здесь: аудио могло не идти вовсе (мьют, стоящий
// приёмник), и тогда Feed часы не смотрел ни разу.
if (not FExpired) and (GetTickCount64 >= FEndsAt) then DropData;
if FExpired or (FCount <= 0) then Exit;
// Склейка кусков в один буфер — единственное копирование за всю запись, и
// оно идёт уже вне 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
if FExpired or (FCount <= 0) then
begin
if Left <= 0 then Break;
n := FChunk;
if n > Left then n := Left;
Move(FChunks[C][0], Result[(FCount - Left) * 2], n * 2 * SizeOf(SmallInt));
Dec(Left, n);
DropData; // SAVE завершает запись в любом случае (§4.3)
Exit;
end;
// Из общего резерва оставляем ровно то, что перешло в копию, остальное
// (хвост последнего куска) возвращаем — этим и займётся DropData.
Reserved := Copy_;
Dec(FBytes, Copy_);
DropData; // SAVE завершает запись (§4.3)
// ★Куски отдаём КАК ЕСТЬ — ни одного лишнего байта. Сплошная копия жила бы
// рядом с ними до самого DropData и удваивала пик (см. TTCIRecTake).
Result.Chunks := FChunks;
Result.Count := FCount;
Result.Reserved := FBytes;
// Дальше — то же, что делает DropData, но БЕЗ возврата бюджета и без
// освобождения кусков: и то и другое переехало к писателю.
FChunks := nil;
FBytes := 0;
FCount := 0;
FExpired := True;
finally
FLock.Leave;
end;
@@ -901,24 +904,25 @@ end;
═══════════════════════════════════════════════════════════════════════════ }
constructor TTCIWavWriter.Create(const APath: string;
const AData: TTCIPcm; ARateHz: Integer; AReserved: Int64);
const ARec: TTCIRecTake; ARateHz: Integer);
begin
inherited Create(True);
FreeOnTerminate := True;
FPath := APath;
FData := AData;
FRate := ARateHz;
FReserved := AReserved;
FPath := APath;
FRec := ARec;
FRate := ARateHz;
Start;
end;
procedure TTCIWavWriter.ReleaseData;
// Данные и их место в бюджете уходят вместе и ровно один раз — сколько бы
// путей выхода ни было у Execute.
var i: Integer;
begin
FData := nil;
TCIRecBudgetFree(FReserved);
FReserved := 0;
for i := 0 to High(FRec.Chunks) do FRec.Chunks[i] := nil;
FRec.Chunks := nil;
TCIRecBudgetFree(FRec.Reserved);
FRec.Reserved := 0;
end;
procedure TTCIWavWriter.Execute;
@@ -930,6 +934,7 @@ var
H: THandle;
Hdr: array[0..43] of Byte;
DataBytes: LongWord;
i, n, Left: Integer;
procedure PutTag(Ofs: Integer; const Tag: string);
var i: Integer;
@@ -950,7 +955,7 @@ var
begin
try
DataBytes := LongWord(Length(FData) * SizeOf(SmallInt));
DataBytes := LongWord(Int64(FRec.Count) * 2 * SizeOf(SmallInt));
FillChar(Hdr, SizeOf(Hdr), 0);
PutTag(0, 'RIFF');
PutU32(4, 36 + DataBytes);
@@ -976,7 +981,17 @@ begin
FS := THandleStream.Create(H);
try
FS.Write(Hdr[0], SizeOf(Hdr));
if DataBytes > 0 then FS.Write(FData[0], DataBytes);
// Куски пишем подряд: в WAV сэмплы и так лежат встык, а хвост
// последнего куска за FRec.Count — не наши данные.
Left := FRec.Count;
for i := 0 to High(FRec.Chunks) do
begin
if Left <= 0 then Break;
n := FRec.Chunk;
if n > Left then n := Left;
FS.Write(FRec.Chunks[i][0], n * 2 * SizeOf(SmallInt));
Dec(Left, n);
end;
finally
FS.Free;
FileClose(H);