diff --git a/CWMorse.pas b/CWMorse.pas index c2c215f..eed3249 100644 --- a/CWMorse.pas +++ b/CWMorse.pas @@ -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; + FBusy := True; 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; diff --git a/test/tci/tcitest.pas b/test/tci/tcitest.pas index b32a587..51e6516 100644 --- a/test/tci/tcitest.pas +++ b/test/tci/tcitest.pas @@ -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;