diff --git a/TCIAdapter.pas b/TCIAdapter.pas index 1065ae7..8821ae6 100644 --- a/TCIAdapter.pas +++ b/TCIAdapter.pas @@ -2998,8 +2998,7 @@ procedure TTCIAdapter.CmdRecorder(Client: TTCIClient; const M: TTCIMessage); var Rx, Sec, Rate: Integer; Path, Req: string; - Data: TTCIPcm; - Held: Int64; // байты бюджета, уходящие писателю вместе с Data + Rec: TTCIRecTake; // куски записи + их место в бюджете Old, New_: TTCIRecorder; begin if not TCITryArgInt(M, 0, Rx) or not ValidRx(Rx) then @@ -3085,8 +3084,10 @@ begin // Забираем рекордер из таблицы (сохранение завершает запись, §4.3) и только // потом снимаем с него данные: копия кольца — это десятки мегабайт, и делать // её под локом DSP-потока нельзя. - Data := nil; - Held := 0; + Rec.Chunks := nil; + Rec.Chunk := 0; + Rec.Count := 0; + Rec.Reserved := 0; Rate := TCI_AUDIO_ENGINE_RATE; FStreamLock.Enter; try @@ -3097,20 +3098,25 @@ begin end; if Old <> nil then begin - // ★Резерв бюджета переезжает вместе с данными: копию держит писатель, и - // отпустит её он же. Иначе SAVE был бы дырой в потолке памяти. - Data := Old.Take(Held); + // ★Куски записи переезжают писателю КАК ЕСТЬ, вместе со своим местом в + // бюджете: сплошная копия удваивала бы пик, а невыпущенный резерв был бы + // дырой в потолке. + Rec := Old.Take; Rate := Old.Rate; Old.Free; end; - if Data = nil then + if Rec.Count <= 0 then begin + // Резерва тут быть неоткуда (кусок выделяется только под сэмпл, который + // тут же и пишется), но возвращаем на всякий случай: единственный путь, + // на котором запись не доходит до писателя. + TCIRecBudgetFree(Rec.Reserved); Reply(Client, TCIBuild('tci_error', [LowerCase(M.Name), 'nothing recorded'])); Exit; end; // Пишет отдельный поток: файл может быть в десятки мегабайт, а мы сейчас в // потоке клиента, который в это время не читает свой сокет. - TTCIWavWriter.Create(Path, Data, Rate, Held); + TTCIWavWriter.Create(Path, Rec, Rate); end; procedure TTCIAdapter.DropClientRecorders(C: TTCIClient); diff --git a/TCIStreams.pas b/TCIStreams.pas index b44b766..a2908c1 100644 --- a/TCIStreams.pas +++ b/TCIStreams.pas @@ -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); diff --git a/doc/TCI.md b/doc/TCI.md index 7627d31..953f3c1 100644 --- a/doc/TCI.md +++ b/doc/TCI.md @@ -529,13 +529,16 @@ ExpertSDR3 давно бы не было. Спрашивается при выделении каждого куска. Отказ не рушит запись: набранное остаётся сохраняемым, просто дальше она не растёт — иначе клиент терял бы уже записанное из-за чужой записи на другом приёмнике. ★`SAVE` бюджет не - обходит: `Take` собирает куски в сплошную копию и **передаёт ей их резерв** - (out-параметр `Reserved`), а не возвращает его сразу — копия живёт дальше в - `TTCIWavWriter`, и отпускает место он же, когда данные больше не нужны - (`ReleaseData` — ровно один раз, сколько бы путей выхода ни было у - `Execute`). Иначе один `SAVE` поднимал бы настоящее потребление вдвое, а на - медленном или зависшем сетевом каталоге очередь writer-потоков росла бы - мимо потолка вовсе. + обходит **и не удваивает пик**: `Take` отдаёт писателю САМИ КУСКИ + (`TTCIRecTake`) вместе с их местом в бюджете, а не сплошную копию. Копия + была бы худшим из вариантов ровно там, где памяти меньше всего: при полном + бюджете рядом жили бы 128 МБ кусков и 128 МБ копии, а счётчик показывал бы + 128. Куски и так лежат встык, поэтому `TTCIWavWriter` пишет их в файл + подряд (хвост последнего за `Count` — не данные), а место отпускает в + `ReleaseData` — ровно один раз, сколько бы путей выхода ни было у + `Execute`. Пока писатель ждёт медленный или зависший сетевой каталог, эти + байты остаются занятыми: потолок держит и очередь сохранений, а не только + сами записи. 3. **Освобождение по трём событиям, а не по одному.** Раньше срок проверял только `Feed`, то есть DSP-поток — а к мёртвому приёмнику он не приходит никогда, и `START` на несуществующий номер оставлял память навсегда. @@ -868,8 +871,10 @@ ExpertSDR3 давно бы не было. выделяет ни байта, бюджет растёт кусками по мере звука и возвращается по `Free`, потолок берётся целиком и сверх него следует отказ, при отказе запись не рушится, окно истекает по часам **без единого `Feed`** и отдаёт память - само, `Take` отдаёт резерв размером с копию и после него занят ровно он, а - писатель возвращает этот резерв по окончании записи. ★Имя файла: простое имя ложится в каталог записей, а каталог из + само, `Take` отдаёт САМИ КУСКИ (2.5 с записи = три куска по секунде, а не + один свёрнутый — сплошной копии не появляется ни на миг), счёт бюджета при + этом не меняется, склеенные куски дают непрерывный звук, и писатель + возвращает резерв по окончании записи. ★Имя файла: простое имя ложится в каталог записей, а каталог из просьбы отбрасывается — абсолютный путь, `..` и буква диска наружу не выводят; пусто, `..`, не-`.wav`, управляющий символ и отсутствие каталога записей дают отказ; существующий файл писатель не перезаписывает. diff --git a/test/tci/tcitest.pas b/test/tci/tcitest.pas index 9fe2625..d442da2 100644 --- a/test/tci/tcitest.pas +++ b/test/tci/tcitest.pas @@ -550,6 +550,26 @@ end; C. Рекордер и WAV ═══════════════════════════════════════════════════════════════════════════ } +function FlatTake(const T: TTCIRecTake): TTCIPcm; +// Склейка кусков записи в один буфер. Живёт ТОЛЬКО в стенде: продовый путь +// сплошной копии не делает вовсе — писатель пишет куски подряд, иначе на +// полном бюджете рядом жили бы куски и их копия, то есть двойной пик. +var C, n, Left: Integer; +begin + Result := nil; + if T.Count <= 0 then Exit; + SetLength(Result, T.Count * 2); + Left := T.Count; + for C := 0 to High(T.Chunks) do + begin + if Left <= 0 then Break; + n := T.Chunk; + if n > Left then n := Left; + Move(T.Chunks[C][0], Result[(T.Count - Left) * 2], n * 2 * SizeOf(SmallInt)); + Dec(Left, n); + end; +end; + procedure TestRecorder; var Rec: TTCIRecorder; @@ -562,7 +582,8 @@ var Sz: LongWord; W: TTCIWavWriter; Waited: Integer; - Was, Held: Int64; + Was: Int64; + Tk: TTCIRecTake; begin WriteLn('C. Рекордер линейного выхода'); @@ -578,29 +599,69 @@ begin Rec.Feed(L, R, 8192); Inc(Total, 8192); end; - Data := Rec.Take(Held); + Tk := Rec.Take; Data := FlatTake(Tk); 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('рекордер: Take отдаёт сами куски, не копию', + (Length(Tk.Chunks) > 0) and (Tk.Count = Length(Data) div 2), + IntToStr(Length(Tk.Chunks))); + Check('рекордер: резерв переехал целиком, счёт не изменился', + TCIRecBudgetUsed = Was + Tk.Reserved, + IntToStr(TCIRecBudgetUsed - Was) + '/' + IntToStr(Tk.Reserved)); + Check('рекордер: резерва хватает на отданные куски', + Tk.Reserved >= Int64(Length(Data)) * SizeOf(SmallInt), + IntToStr(Tk.Reserved)); + TCIRecBudgetFree(Tk.Reserved); // как это сделает писатель + Tk.Chunks := nil; 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(Held)) = 0); + Check('рекордер: Take завершает запись', Length(FlatTake(Rec.Take)) = 0); finally Rec.Free; end; + // ★Отдаются именно куски, а не свёрнутая в один буфер копия: 2.5 секунды + // при куске в секунду — это ТРИ куска. Если бы Take собирал сплошную копию + // (как было), кусок пришёл бы один, а пик памяти на полном бюджете вырос бы + // вдвое: 128 МБ кусков и 128 МБ копии рядом, при счётчике в 128. + Was := TCIRecBudgetUsed; + Rec := TTCIRecorder.Create(0, 48000, 3, nil); + try + for i := 0 to 8191 do begin L[i] := 0.25; R[i] := -0.25; end; + Total := 0; + while Total < 120000 do // 2.5 с при 48 кГц + begin + Rec.Feed(L, R, 8192); + Inc(Total, 8192); + end; + Tk := Rec.Take; + Check('рекордер: кусков ровно по секундам записи', + (Tk.Chunk = 48000) and (Length(Tk.Chunks) = 3) and + (Tk.Count >= 120000), + IntToStr(Length(Tk.Chunks)) + ' × ' + IntToStr(Tk.Chunk)); + Check('рекордер: сплошной копии не появилось', + TCIRecBudgetUsed = Was + Tk.Reserved, + IntToStr(TCIRecBudgetUsed - Was)); + Data := FlatTake(Tk); + Check('рекордер: куски склеиваются в непрерывный звук', + (Length(Data) = Tk.Count * 2) and + (Data[0] = Round(0.25 * 32767)) and + (Data[Length(Data) - 2] = Round(0.25 * 32767))); + Tk.Chunks := nil; + TCIRecBudgetFree(Tk.Reserved); + finally + Rec.Free; + end; + Check('рекордер: счёт закрыт', TCIRecBudgetUsed = Was); + // Порядок отсчётов: первым обязан идти самый ПЕРВЫЙ записанный. Rec := TTCIRecorder.Create(0, 1000, 1, nil); // ёмкость 1000 отсчётов try @@ -610,7 +671,7 @@ begin R[0] := 0; Rec.Feed(L, R, 1); end; - Data := Rec.Take(Held); + Tk := Rec.Take; Data := FlatTake(Tk); Check('рекордер: с начала записи, а не с конца', (Length(Data) = 2000) and (Data[0] = 0) and (Abs(Data[1998] - Round((999 / 4000.0) * 32767)) <= 1), @@ -625,7 +686,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(Held)) > 0); + Check('рекордер: до срока запись есть', Length(FlatTake(Rec.Take)) > 0); finally Rec.Free; end; @@ -633,9 +694,9 @@ begin try Rec.Feed(L, R, 8192); Sleep(1100); // окно закрылось - Check('рекордер: после срока запись удалена', Length(Rec.Take(Held)) = 0); + Check('рекордер: после срока запись удалена', Length(FlatTake(Rec.Take)) = 0); Rec.Feed(L, R, 8192); // и новое аудио уже не принимает - Check('рекордер: истёкший не оживает', Length(Rec.Take(Held)) = 0); + Check('рекордер: истёкший не оживает', Length(FlatTake(Rec.Take)) = 0); finally Rec.Free; end; @@ -668,7 +729,7 @@ begin try Rec.Feed(L, R, 8192); Check('бюджет: при отказе запись не рушится, а стоит пустой', - Length(Rec.Take(Held)) = 0); + Length(FlatTake(Rec.Take)) = 0); finally Rec.Free; end; @@ -697,7 +758,13 @@ begin DeleteFile(Path); SetLength(Data, 2000); for i := 0 to 1999 do Data[i] := i * 8; - W := TTCIWavWriter.Create(Path, Data, 48000, 0); + Tk.Chunks := nil; + SetLength(Tk.Chunks, 1); + Tk.Chunks[0] := Data; + Tk.Chunk := Length(Data) div 2; + Tk.Count := Tk.Chunk; + Tk.Reserved := 0; + W := TTCIWavWriter.Create(Path, Tk, 48000); Waited := 0; while (not FileExists(Path)) and (Waited < 2000) do begin @@ -733,7 +800,13 @@ begin Was := TCIRecBudgetUsed; Check('WAV: резерв под писателя взят', TCIRecBudgetTake(4096)); DeleteFile(Path); - TTCIWavWriter.Create(Path, Data, 48000, 4096); + Tk.Chunks := nil; + SetLength(Tk.Chunks, 1); + Tk.Chunks[0] := Data; + Tk.Chunk := Length(Data) div 2; + Tk.Count := Tk.Chunk; + Tk.Reserved := 4096; + TTCIWavWriter.Create(Path, Tk, 48000); Waited := 0; while (TCIRecBudgetUsed <> Was) and (Waited < 2000) do begin @@ -748,7 +821,13 @@ begin // файл обязан остаться прежним. SetLength(Data, 10); for i := 0 to 9 do Data[i] := 1; - TTCIWavWriter.Create(Path, Data, 48000, 0); + Tk.Chunks := nil; + SetLength(Tk.Chunks, 1); + Tk.Chunks[0] := Data; + Tk.Chunk := 5; + Tk.Count := 5; + Tk.Reserved := 0; + TTCIWavWriter.Create(Path, Tk, 48000); Sleep(200); FS := TFileStream.Create(Path, fmOpenRead); try