ew8bak/ewsdr
1
0
Fork 0
mirror of https://git.vladimir.cc/vladimir/ewsdr.git synced 2026-08-25 17:27:32 +00:00
Code Issues Packages Projects Releases Wiki Activity

fix(cw): обрыв манипуляции — поколение, а не флаг: пакет следом его отменял

Browse Source 
Один дефект в двух местах: и TCWElemPlayer (чужая манипуляция по TCI), и
TCWSender (передача текста — F1..F8, набор в терминале, CAT KY) сбрасывали
FAbortReq прямо в Enqueue. Поток замечает обрыв только на очередном срезе Hold,
то есть в пределах 5 мс; всё, что прилетело в это окно, снимало флаг, и уже
отданный AbortPlay/AbortSending пропадал бесследно.

Чем это кончается в эфире: обрыв существует ровно затем, чтобы касание
манипулятора, снятие MOX или уход из телеграфа прекратили программную
манипуляцию (как «key hit» в Thetis/pihpsdr). Проглоченный обрыв означает, что
оператор взял ключ в руки, а софт продолжает манипулировать вместе с ним.

Источники, кормящие Enqueue, ровно такие, чтобы в 5 мс попадать: клиент TCI
шлёт элементы KEYER десятками в секунду; терминал отдаёт набор В ЭФИР ПО
СИМВОЛУ на нажатие клавиши; поле текста KY — 25 знаков, поэтому длинное
сообщение логгер шлёт несколькими командами подряд. У передачи текста цена
выше: AbortSending чистит FPending, но взятое сообщение живёт в локальной
переменной потока, и доигрывается ВЕСЬ его остаток — замер на стенде дал 620 мс
(остаток 720-мс тире на 5 WPM), у KEYER — 742 мс.

Лечение общее: вместо флага счётчик поколений. AbortPlay/AbortSending его
инкрементируют, Enqueue не трогает вовсе, поток несёт своё поколение (Take,
Aborted, Hold, SendChar) и принимает новое только сам — когда отпустил ключ и
бросил очередь. У TCWSender есть точка получше: текст и поколение берутся одним
заходом под лок (TakeText(out Gen)), а это закрывает заодно и вторую точку
сброса — ту, что стояла в начале Execute. Добор по ходу передачи стал
TakeMore(Gen): после обрыва не берём ничего, и набранное ПОСЛЕ него не теряется
вместе с брошенным, а уходит следующим сообщением со своим поколением.

Стенд: 244 проверки (было 238). В C2 — регрессия на KEYER, новая часть C3 на
передачу текста (раньше TCWSender стендом не покрывался вовсе): длительность
точки по скорости, старт сообщения, обрыв с пакетом следом, и что после обрыва
передача снова идёт. Обе регрессии проверены негативным контролем — на старом
CWMorse.pas они падают с теми самыми 742 и 620 мс.

Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
This commit is contained in:
ew8bak
2026-08-20 10:44:52 +03:00
co-authored by Claude Opus 5
parent 6aa4db3cb8
commit 210f3e6457
2 changed files with 203 additions and 37 deletions
Download Patch File Download Diff File Expand all files Collapse all files
CWMorse.pas
+81 -36
View File
@@ -33,7 +33,8 @@ type
FLock: TCriticalSection;
FWake: TEvent;
FPending: string; // очередь текста (под FLock)
FAbortReq: Boolean; // «бросить и отпустить ключ» (под FLock)
FAbortGen: Cardinal; // «бросить и отпустить ключ» — СЧЁТЧИК, не флаг
// (под FLock): см. AbortSending
FBusy: Boolean; // идёт передача (под FLock)
FWPM: Integer; // под FLock
FWeight: Integer; // 33..66, 50 = симметрично (под FLock)
@@ -41,13 +42,19 @@ type
FSent: string;
FUnsent: string;
FTrimTail: Boolean; // Backspace дотянулся до уже взятого текста
function TakeText: string;
function Aborted: Boolean;
// Текст и поколение обрыва берутся ОДНИМ заходом под лок: между ними
// AbortSending вклиниться не может, иначе обрыв достался бы уже взятому
// тексту и потерялся.
function TakeText(out Gen: Cardinal): string;
// Добор в идущее сообщение. Если обрыв уже случился — не берём ничего:
// набранное ПОСЛЕ обрыва дождётся следующего сообщения со своим поколением.
function TakeMore(Gen: Cardinal): string;
function Aborted(Gen: Cardinal): Boolean;
procedure Key(Down: Boolean);
// Выдержать Ms миллисекунд, просыпаясь дробно ради отзывчивости на abort.
// Возвращает False, если передачу оборвали.
function Hold(Deadline: QWord): Boolean;
procedure SendChar(Ch: Char; var Deadline: QWord);
function Hold(Deadline: QWord; Gen: Cardinal): Boolean;
procedure SendChar(Ch: Char; var Deadline: QWord; Gen: Cardinal);
protected
procedure Execute; override;
public
@@ -99,13 +106,14 @@ type
FQ: array of TCWElement; // кольцо (под FLock)
FHead: Integer;
FCount: Integer;
FAbortReq: Boolean;
FAbortGen: Cardinal; // растёт на каждый AbortPlay (под FLock)
FBusy: Boolean;
FDown: Boolean; // состояние ключа (только поток)
procedure Key(Down: Boolean);
function Take(out E: TCWElement): Boolean;
function Aborted: Boolean;
function Hold(Deadline: QWord): Boolean;
function CurGen: Cardinal;
function Take(Gen: Cardinal; out E: TCWElement): Boolean;
function Aborted(Gen: Cardinal): Boolean;
function Hold(Deadline: QWord; Gen: Cardinal): Boolean;
protected
procedure Execute; override;
public
@@ -189,7 +197,11 @@ begin
if S = '' then Exit;
FLock.Enter;
try
FAbortReq := False;
// Поколение обрыва здесь НЕ трогаем: снять его вправе только сам поток,
// когда отпустил ключ. Иначе символ, набранный (или присланный логгером
// командой KY) в те миллисекунды, пока поток спит в Hold, отменял бы уже
// отданный AbortSending — оператор берёт манипулятор, а софт продолжает
// манипулировать вместе с ним остатком сообщения.
FPending := FPending + S;
finally
FLock.Leave;
@@ -202,7 +214,7 @@ begin
FLock.Enter;
try
FPending := '';
FAbortReq := True;
Inc(FAbortGen); // счётчик: обрыв не потеряется и не отменится
finally
FLock.Leave;
end;
@@ -277,22 +289,36 @@ begin
end;
end;
function TCWSender.TakeText: string;
function TCWSender.TakeText(out Gen: Cardinal): string;
begin
FLock.Enter;
try
Result := FPending;
FPending := '';
Gen := FAbortGen;
finally
FLock.Leave;
end;
end;
function TCWSender.TakeMore(Gen: Cardinal): string;
begin
FLock.Enter;
try
if FAbortGen <> Gen then Exit('');
Result := FPending;
FPending := '';
finally
FLock.Leave;
end;
end;
function TCWSender.Aborted: Boolean;
function TCWSender.Aborted(Gen: Cardinal): Boolean;
// «Обрыв случился после того, как поток взял этот текст».
begin
FLock.Enter;
try
Result := FAbortReq;
Result := FAbortGen <> Gen;
finally
FLock.Leave;
end;
@@ -303,12 +329,12 @@ begin
if Assigned(FKeyEvent) then FKeyEvent(Down);
end;
function TCWSender.Hold(Deadline: QWord): Boolean;
function TCWSender.Hold(Deadline: QWord; Gen: Cardinal): Boolean;
var Now_: QWord; Slice: Integer;
begin
Result := True;
repeat
if Terminated or Aborted then Exit(False);
if Terminated or Aborted(Gen) then Exit(False);
Now_ := GetTickCount64;
if Now_ >= Deadline then Exit(True);
// Дробим сон: обрыв передачи не должен ждать конца длинного тире.
@@ -318,7 +344,7 @@ begin
until False;
end;
procedure TCWSender.SendChar(Ch: Char; var Deadline: QWord);
procedure TCWSender.SendChar(Ch: Char; var Deadline: QWord; Gen: Cardinal);
// Deadline — момент, к которому знак должен закончиться; ведём его вперёд,
// чтобы длительности не «уползали» на ошибке каждого Sleep.
var
@@ -344,7 +370,7 @@ begin
begin
// Межсловный интервал = 7 точек; 3 из них уже отданы после прошлого знака.
Inc(Deadline, 4 * Dit);
Hold(Deadline);
Hold(Deadline, Gen);
Exit;
end;
@@ -354,13 +380,13 @@ begin
begin
Key(True);
if Code[i] = '-' then Inc(Deadline, 3 * Mark) else Inc(Deadline, Mark);
if not Hold(Deadline) then begin Key(False); Exit; end;
if not Hold(Deadline, Gen) then begin Key(False); Exit; end;
Key(False);
Inc(Deadline, Gap); // пауза между элементами знака
if not Hold(Deadline) then Exit;
if not Hold(Deadline, Gen) then Exit;
end;
Inc(Deadline, 2 * Dit); // добор до 3 точек между знаками
Hold(Deadline);
Hold(Deadline, Gen);
end;
procedure TCWSender.Execute;
@@ -369,18 +395,18 @@ var
i, KeepLen: Integer;
Trim: Boolean;
Deadline: QWord;
Gen: Cardinal;
begin
while not Terminated do
begin
FWake.WaitFor(200);
if Terminated then Break;
Text := TakeText;
Text := TakeText(Gen);
if Text = '' then Continue;
FLock.Enter;
try
FBusy := True;
FAbortReq := False;
finally
FLock.Leave;
end;
@@ -389,7 +415,7 @@ begin
i := 1;
while i <= Length(Text) do
begin
if Terminated or Aborted then Break;
if Terminated or Aborted(Gen) then Break;
// Backspace мог съесть хвост уже взятого текста — отсекаем.
FLock.Enter;
try
@@ -415,10 +441,10 @@ begin
finally
FLock.Leave;
end;
SendChar(Text[i], Deadline);
SendChar(Text[i], Deadline, Gen);
// Дописанное в очередь по ходу передачи подхватываем без паузы —
// иначе поток допередал бы «старый» текст и уснул на 200 мс.
if i = Length(Text) then Text := Text + TakeText;
if i = Length(Text) then Text := Text + TakeMore(Gen);
Inc(i);
end;
finally
@@ -478,7 +504,10 @@ begin
FQ[i].Mark := Mark;
FQ[i].Ms := Ms;
Inc(FCount);
FAbortReq := False;
// Поколение аборта здесь НЕ трогаем: сбрасывать его вправе только сам
// проигрыватель, когда увидел обрыв. Иначе элемент, прилетевший из сети в
// те миллисекунды, пока поток спит в Hold, отменял бы уже отданный
// AbortPlay — оператор жмёт манипулятор, а чужая манипуляция продолжается.
FBusy := True;
finally
FLock.Leave;
@@ -486,12 +515,22 @@ begin
FWake.SetEvent;
end;
function TCWElemPlayer.Take(out E: TCWElement): Boolean;
function TCWElemPlayer.CurGen: Cardinal;
begin
FLock.Enter;
try
Result := FAbortGen;
finally
FLock.Leave;
end;
end;
function TCWElemPlayer.Take(Gen: Cardinal; out E: TCWElement): Boolean;
begin
Result := False;
FLock.Enter;
try
if FAbortReq or (FCount = 0) then Exit;
if (FAbortGen <> Gen) or (FCount = 0) then Exit;
E := FQ[FHead];
FHead := (FHead + 1) mod Length(FQ);
Dec(FCount);
@@ -505,7 +544,7 @@ procedure TCWElemPlayer.AbortPlay;
begin
FLock.Enter;
try
FAbortReq := True;
Inc(FAbortGen); // не флаг, а счётчик: обрыв не потеряется и не отменится
FHead := 0;
FCount := 0;
finally
@@ -514,11 +553,12 @@ begin
FWake.SetEvent;
end;
function TCWElemPlayer.Aborted: Boolean;
function TCWElemPlayer.Aborted(Gen: Cardinal): Boolean;
// «Обрыв случился после того, как поток взял это поколение».
begin
FLock.Enter;
try
Result := FAbortReq;
Result := FAbortGen <> Gen;
finally
FLock.Leave;
end;
@@ -551,13 +591,13 @@ begin
if Assigned(FKeyEvent) then FKeyEvent(Down);
end;
function TCWElemPlayer.Hold(Deadline: QWord): Boolean;
function TCWElemPlayer.Hold(Deadline: QWord; Gen: Cardinal): Boolean;
// Тот же приём, что у TCWSender: абсолютный дедлайн и дробный сон, чтобы обрыв
// не ждал конца длинного тире.
var Now_: QWord; Slice: Integer;
begin
repeat
if Terminated or Aborted then Exit(False);
if Terminated or Aborted(Gen) then Exit(False);
Now_ := GetTickCount64;
if Now_ >= Deadline then Exit(True);
Slice := Integer(Deadline - Now_);
@@ -570,13 +610,15 @@ procedure TCWElemPlayer.Execute;
var
E: TCWElement;
Deadline: QWord;
Gen: Cardinal;
begin
Deadline := 0;
Gen := CurGen;
while not Terminated do
begin
FWake.WaitFor(200);
if Terminated then Break;
while Take(E) do
while Take(Gen, E) do
begin
// Первая пачка (или после простоя) начинается «сейчас»: догонять прошлое
// нечего, а старый дедлайн проиграл бы очередь одним махом.
@@ -584,7 +626,7 @@ begin
Deadline := GetTickCount64;
Key(E.Mark);
Inc(Deadline, QWord(E.Ms));
if not Hold(Deadline) then Break;
if not Hold(Deadline, Gen) then Break;
end;
// Очередь кончилась (или её бросили) — ключ отпускаем всегда: несущая без
// хозяина в эфире не остаётся, а следующая пачка начнётся заново.
@@ -592,6 +634,9 @@ begin
Deadline := 0;
FLock.Enter;
try
// Обрыв отработан — ключ отпущен, старая очередь брошена. Принимаем
// текущее поколение: то, что клиент прислал уже ПОСЛЕ обрыва, играем.
Gen := FAbortGen;
if FCount = 0 then FBusy := False;
finally
FLock.Leave;
test/tci/tcitest.pas
+121
View File
@@ -1039,6 +1039,7 @@ var
Ev: TCWKeyEvent;
i, Waited, Bad: Integer;
D1, D2, D3: Int64;
T0: QWord;
begin
WriteLn('C2. Чужая манипуляция (KEYER)');
Log := TKeyLog.Create;
@@ -1108,6 +1109,32 @@ begin
Check('KEYER: обрыв гасит очередь', Log.Count = Bad, IntToStr(Log.Count - Bad));
Check('KEYER: после обрыва ключ отпущен',
(Log.Count > 0) and (not Log.Down[Log.Count - 1]));
// ★Обрыв нельзя отменить пакетом из сети. Клиент шлёт элементы пачками по
// несколько десятков в секунду; такой пакет, прилетевший в те миллисекунды,
// пока поток спит в Hold, раньше снимал флаг обрыва — оператор трогает
// манипулятор, а чужая манипуляция продолжает держать ключ до конца
// текущего элемента. Меряем задержку отпускания от момента обрыва.
for i := 0 to 4 do P.Enqueue(True, 400);
Sleep(60);
Log.Count := 0; // ключ уже замкнут — ждём именно отпускания
T0 := GetTickCount64;
P.AbortPlay;
P.Enqueue(True, 400); // «пакет пришёл следом за обрывом»
Waited := 0;
while (Log.Count = 0) and (Waited < 1000) do
begin
Sleep(5);
Inc(Waited, 5);
end;
// Отсчёт по стенным часам: Log.At отсчитывается от ПЕРВОГО фронта пачки,
// а нам нужна задержка от самого обрыва (опрос с шагом 5 мс).
D1 := Int64(GetTickCount64) - Int64(T0);
Check('KEYER: обрыв не отменяется пакетом следом',
(Log.Count > 0) and (not Log.Down[0]) and (D1 < 100),
Format('%d/%d', [Log.Count, D1]));
P.AbortPlay; // и хвост этого пакета тоже гасим
Sleep(120);
// Нулевые и отрицательные длительности не элементы: первое нажатие клиента
// (keyer:0,true,0) не должно порождать ни одного фронта.
Log.Count := 0;
@@ -1122,6 +1149,99 @@ begin
end;
end;
procedure TestTextSender;
// Передача текста (F1..F8, набор в терминале, CAT KY). Проверяем не «пошли
// фронты», а что ОБРЫВ работает: касание манипулятора и снятие MOX обязаны
// прекратить программную манипуляцию, чем бы её ни кормили.
var
Log: TKeyLog;
S: TCWSender;
Ev: TCWKeyEvent;
Waited: Integer;
D: Int64;
T0: QWord;
begin
WriteLn('C3. Передача текста (KY / F1..F8)');
Log := TKeyLog.Create;
Ev := Log.Key;
S := TCWSender.Create(Ev);
try
// 'E' на 20 WPM — одна точка длиной в один Dit (1200/20 = 60 мс).
S.SetSpeed(20, 50);
S.Enqueue('E');
Waited := 0;
while (Log.Count < 2) and (Waited < 2000) do
begin
Sleep(5);
Inc(Waited, 5);
end;
Sleep(50);
Check('KY: точка — два фронта', Log.Count = 2, IntToStr(Log.Count));
if Log.Count >= 2 then
begin
D := Int64(Log.At[1]) - Int64(Log.At[0]);
Check('KY: длительность точки по скорости', Abs(D - 60) < 30, IntToStr(D));
end
else
Check('KY: длительность точки по скорости', False);
// ★Обрыв нельзя отменить символом, набранным следом. Терминал шлёт текст
// ПО СИМВОЛУ на нажатие клавиши, логгер — кусками по 25 знаков в KY;
// такой символ, пришедший в те миллисекунды, пока поток спит в Hold,
// раньше снимал флаг обрыва — и в эфир уходил весь остаток сообщения,
// хотя оператор уже взял манипулятор. 5 WPM: тире длиной 720 мс, попасть
// в него легко.
S.SetSpeed(5, 50);
Log.Count := 0;
S.Enqueue('OOOO');
// Ждём не «появился фронт», а замыкания ключа ЭТИМ сообщением: предыдущее
// ещё доигрывает межзнаковую паузу, и его завершающий Key(False) прилетит
// сюда же.
Waited := 0;
while (Waited < 3000)
and not ((Log.Count > 0) and Log.Down[Log.Count - 1]) do
begin
Sleep(5);
Inc(Waited, 5);
end;
Check('KY: сообщение пошло',
(Log.Count > 0) and Log.Down[Log.Count - 1], IntToStr(Log.Count));
Sleep(100); // середина первого тире (720 мс на 5 WPM)
Log.Count := 0; // ключ уже замкнут — ждём именно отпускания
T0 := GetTickCount64;
S.AbortSending;
S.Enqueue('E'); // «символ пришёл следом за обрывом»
Waited := 0;
while (Log.Count = 0) and (Waited < 2000) do
begin
Sleep(5);
Inc(Waited, 5);
end;
D := Int64(GetTickCount64) - Int64(T0);
Check('KY: обрыв не отменяется символом следом',
(Log.Count > 0) and (not Log.Down[0]) and (D < 100),
Format('%d/%d', [Log.Count, D]));
S.AbortSending; // и хвост этого символа тоже гасим
Sleep(150);
// Обрыв не глушит передачу навсегда: следующее сообщение играется.
Log.Count := 0;
S.SetSpeed(20, 50);
S.Enqueue('E');
Waited := 0;
while (Log.Count < 2) and (Waited < 2000) do
begin
Sleep(5);
Inc(Waited, 5);
end;
Check('KY: после обрыва передача снова идёт', Log.Count = 2,
IntToStr(Log.Count));
finally
S.Free;
Log.Free;
end;
end;
{ ═══════════════════════════════════════════════════════════════════════════
D. Живой сервер: команды потоков
═══════════════════════════════════════════════════════════════════════════ }
@@ -2116,6 +2236,7 @@ begin
TestStreamOut;
TestRecorder;
TestKeyPlayer;
TestTextSender;
TestServer;
TestEndToEnd;
WriteLn;