mirror of
https://git.vladimir.cc/vladimir/ewsdr.git
synced 2026-08-25 18:43:51 +00:00
fix(platform): монотонные часы переполнялись на Windows и были стенными на macOS
Два дефекта в источнике времени, на котором стоят абсолютные дедлайны пейсинга
TX: планировщик TX_CHRONO и отправитель DUC ведут по нему сетку, и скачок часов
для них означает не потерю точности, а остановку выдачи.
* Windows: (V * 1000000) div QPCFreq переполняет Int64 на 9.223e12 тиках — при
типовой для Windows 8+ частоте QPC 10 МГц это 10.7 суток аптайма, дальше
разрыв повторяется каждые 21.35 суток (2^64/10^6). Между разрывами функция
линейна, поэтому страдает не «всякая машина старше N суток», а сессия,
пережившая сам момент скачка: время уходит в большой минус, NextDueUs
становится недостижим, маркеры TX_CHRONO прекращаются до перезапуска, долг
TCI уходит в минус, а проверки вида `FTxLastRxUs > 0` перестают срабатывать.
★Мест было ДВА: PlatformUtils.MonotonicUs и локальная ClockUs в потоке
отправителя DUC (win-ветка HPSDRNetwork) — вторая пейсит ВСЕ передачи на
Windows, не только TCI: WaitUntil на переполненной разности выходит сразу,
пакеты уходят без выдержки, очередь опустошается пачкой и сохнет.
Лечение — общая TicksToUs через частное и остаток (остаток меньше частоты,
произведение не переполняется; потолок отодвинулся на сотни тысяч лет).
* macOS: MonotonicUs проваливалась в общий Unix-{$ELSE} с fpgettimeofday, то
есть на СТЕННЫЕ часы. Шаг NTP назад — планировщик замирает до недостижимого
срока, вперёд — выдаёт пачку и начисляет фиктивный долг. Взят
mach_absolute_time + mach_timebase_info: монотонен и есть на любой версии
(clock_gettime на macOS только с 10.12), пересчёт тоже через частное/остаток —
на Apple Silicon база 125/3.
Публикация состояния часов: всё держится в ОДНОМ слове и поднимается в
initialization, до старта любых потоков. Пара «значение + флаг» на слабой
модели памяти (Windows ARM, Apple Silicon) позволяла читателю увидеть флаг
раньше значения, получить частоту 0 и вернуть время 0 — единичный ноль в
монотонных часах есть прыжок на десятки лет назад. Windows: QPCFreq, где 0 —
не выбран, >0 — частота, -1 — QPC непригоден (тогда GetTickCount64, чтобы часы
хотя бы шли). Darwin: MachBase = numer shl 32 or denom.
Стенд, секция H: совпадение со старой формулой ниже порога, ★негативный
контроль на пороге (старая даёт -922337203685 мкс, новая +922337203685),
монотонность через прежний разрыв, 100 суток на частотах 10/3.579545/24/1 МГц,
год при 24 МГц, и контракт «один источник на все потоки» — четыре потока,
~850 тыс. чтений, ни нулей, ни хода назад. Итого 274/274, test/cat 50/50.
★Чего стенд не покрывает: win- и darwin-ветки здесь не компилируются вовсе
(кросс-RTL не установлен). Их тела проверялись вырезкой в пробную программу с
подставным API — синтаксис и арифметика сходятся, живой вызов системного
счётчика остаётся за прогоном на той платформе.
Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
Claude-Session: https://claude.ai/code/session_01Bkwwyj7xVRrqnSVEseTRfV
This commit is contained in:
Claude Opus 5
+186
-1
@@ -28,7 +28,7 @@ program tcitest;
|
||||
uses
|
||||
cthreads, Classes, SysUtils, Math, SyncObjs, Sockets, BaseUnix,
|
||||
TCIProtocol, TCIStreams, TCIServer, TCIAdapter, RadioController,
|
||||
WsClient, WebUtils, WDSPEngine, Settings, CWMorse;
|
||||
WsClient, WebUtils, WDSPEngine, Settings, CWMorse, PlatformUtils;
|
||||
|
||||
var
|
||||
Passed, Failed: Integer;
|
||||
@@ -2207,6 +2207,186 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
type
|
||||
// Читатель монотонных часов для проверки контракта «один источник на все
|
||||
// потоки»: каждый поток следит за СВОЕЙ последовательностью.
|
||||
TClockReader = class(TThread)
|
||||
private
|
||||
FBack: Integer; // сколько раз время пошло назад
|
||||
FZero: Integer; // сколько раз вернулся ноль (непроинициализированный источник)
|
||||
FReads: Integer;
|
||||
FMs: Integer;
|
||||
protected
|
||||
procedure Execute; override;
|
||||
public
|
||||
constructor Create(Ms: Integer);
|
||||
property Back: Integer read FBack;
|
||||
property Zero: Integer read FZero;
|
||||
property Reads: Integer read FReads;
|
||||
end;
|
||||
|
||||
constructor TClockReader.Create(Ms: Integer);
|
||||
begin
|
||||
FMs := Ms;
|
||||
inherited Create(False);
|
||||
end;
|
||||
|
||||
procedure TClockReader.Execute;
|
||||
var
|
||||
Deadline: QWord;
|
||||
Prev, Cur: Int64;
|
||||
begin
|
||||
Prev := MonotonicUs;
|
||||
Deadline := GetTickCount64 + QWord(FMs);
|
||||
while GetTickCount64 < Deadline do
|
||||
begin
|
||||
Cur := MonotonicUs;
|
||||
Inc(FReads);
|
||||
if Cur = 0 then Inc(FZero);
|
||||
if Cur < Prev then Inc(FBack);
|
||||
Prev := Cur;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TestMonotonicTicks;
|
||||
// Пересчёт тиков счётчика в микросекунды (PlatformUtils.TicksToUs).
|
||||
// ★Проверять это на Linux можно и нужно: сама функция платформы не знает, а
|
||||
// ветки, которые её зовут (QPC на Windows, mach на macOS), на стенде не
|
||||
// исполняются вовсе. Считаем моделью, по граничным значениям.
|
||||
// ★Чего стенд НЕ покрывает: сами ветки MonotonicUs под Windows и Darwin здесь
|
||||
// даже не компилируются (кросс-RTL не установлен). Их тела проверялись
|
||||
// отдельно — вырезанием из PlatformUtils.pas в пробную программу с подставным
|
||||
// API (QueryPerformance*/mach_*): синтаксис и арифметика сходятся, живой вызов
|
||||
// системного счётчика остаётся непроверенным до прогона на той платформе.
|
||||
const
|
||||
US_PER_S = 1000000;
|
||||
// Частоты, которые встречаются живьём: 10 МГц — типовая для Windows 8+ на
|
||||
// x86, 3.579545 МГц — старые чипсеты, 24 МГц — часть ARM, 1 МГц — «круглый»
|
||||
// случай.
|
||||
FREQS: array[0..3] of Int64 = (10000000, 3579545, 24000000, 1000000);
|
||||
var
|
||||
i, k: Integer;
|
||||
F, V, Prev, Cur, Old, Want, Days: Int64;
|
||||
Mono, Exact: Boolean;
|
||||
Readers: array of TClockReader;
|
||||
Total, Zeros, Backs: Integer;
|
||||
begin
|
||||
WriteLn('H. Монотонные часы: пересчёт тиков в микросекунды');
|
||||
|
||||
Check('часы: секунда счётчика = 1 000 000 мкс',
|
||||
TicksToUs(10000000, 10000000) = US_PER_S,
|
||||
IntToStr(TicksToUs(10000000, 10000000)));
|
||||
Check('часы: нулевая частота не роняет и не врёт временем',
|
||||
TicksToUs(123456789, 0) = 0);
|
||||
|
||||
// ── Совпадение со старой формулой ТАМ, ГДЕ ТА ЕЩЁ РАБОТАЛА ──
|
||||
// Правка не имеет права менять показания на нормальных значениях: это тот же
|
||||
// пересчёт, только без промежуточного произведения.
|
||||
Exact := True;
|
||||
F := 10000000;
|
||||
V := 0;
|
||||
for k := 0 to 200 do
|
||||
begin
|
||||
Old := (V * US_PER_S) div F; // прежняя форма, ниже порога верна
|
||||
if TicksToUs(V, F) <> Old then Exact := False;
|
||||
V := V + 37 * 1000 * 1000 * 1000; // шагаем по ~час аптайма
|
||||
end;
|
||||
Check('часы: ниже порога переполнения показания те же, что и раньше', Exact);
|
||||
|
||||
// ── Порог, на котором ломалась старая форма ──
|
||||
// 2^63 / 10^6 = 9223372036854.775 тиков; первый тик ЗА ним — 9223372036855,
|
||||
// при 10 МГц это 10.67 суток аптайма.
|
||||
V := 9223372036855; // первый тик за порогом
|
||||
Old := (V * US_PER_S) div F; // ★старая форма: уже переполнилась
|
||||
Cur := TicksToUs(V, F);
|
||||
Days := Cur div (Int64(86400) * US_PER_S);
|
||||
WriteLn(Format(' .. порог: тик %d при 10 МГц = %d суток; старая форма даёт ' +
|
||||
'%d мкс, новая %d мкс', [V, Days, Old, Cur]));
|
||||
Check('часы: старая форма на пороге уходила в минус (негативный контроль)',
|
||||
Old < 0, IntToStr(Old));
|
||||
// При 10 МГц микросекунда — это десять тиков.
|
||||
Check('часы: новая форма на пороге считает верно',
|
||||
(Cur > 0) and (Abs(Cur - V div 10) <= 1), IntToStr(Cur));
|
||||
|
||||
// ── Монотонность через разрыв старой формулы ──
|
||||
// Ради этого всё и делалось: планировщик TX ведёт АБСОЛЮТНЫЕ дедлайны, и один
|
||||
// скачок времени назад останавливает выдачу маркеров до перезапуска.
|
||||
Mono := True;
|
||||
Prev := TicksToUs(V - 1000, F);
|
||||
for k := -999 to 1000 do
|
||||
begin
|
||||
Cur := TicksToUs(V + k, F);
|
||||
if Cur < Prev then Mono := False;
|
||||
Prev := Cur;
|
||||
end;
|
||||
Check('часы: через прежний разрыв время не идёт назад', Mono);
|
||||
|
||||
// ── Сто суток аптайма на всех живых частотах ──
|
||||
Exact := True;
|
||||
Mono := True;
|
||||
for i := 0 to High(FREQS) do
|
||||
begin
|
||||
F := FREQS[i];
|
||||
Days := 100;
|
||||
V := Days * 86400 * F;
|
||||
Want := Days * 86400 * US_PER_S;
|
||||
if Abs(TicksToUs(V, F) - Want) > 1 then Exact := False;
|
||||
// И заодно шаг: на любой частоте время обязано расти, а не прыгать.
|
||||
Prev := TicksToUs(V, F);
|
||||
for k := 1 to 500 do
|
||||
begin
|
||||
Cur := TicksToUs(V + Int64(k) * (F div 1000), F); // шаг 1 мс
|
||||
if (Cur < Prev) or (Cur - Prev > 1100) then Mono := False;
|
||||
Prev := Cur;
|
||||
end;
|
||||
end;
|
||||
Check('часы: 100 суток аптайма считаются точно на всех живых частотах', Exact);
|
||||
Check('часы: шаг 1 мс остаётся шагом 1 мс на всех живых частотах', Mono);
|
||||
|
||||
// Год аптайма при 24 МГц — заведомо за пределами всего, что бывает.
|
||||
F := 24000000;
|
||||
V := Int64(365) * 86400 * F;
|
||||
Check('часы: год аптайма при 24 МГц не переполняется',
|
||||
Abs(TicksToUs(V, F) - Int64(365) * 86400 * US_PER_S) <= 1,
|
||||
IntToStr(TicksToUs(V, F)));
|
||||
|
||||
// Живой источник платформы обязан идти вперёд и не стоять.
|
||||
Prev := MonotonicUs;
|
||||
Sleep(30);
|
||||
Cur := MonotonicUs;
|
||||
Check('часы: живой MonotonicUs идёт вперёд',
|
||||
(Cur > Prev) and (Cur - Prev >= 20000) and (Cur - Prev < 2000000),
|
||||
Format('%d мкс за 30 мс сна', [Cur - Prev]));
|
||||
|
||||
// ── Контракт «один источник на все потоки» ──
|
||||
// ★Ленивая инициализация часов из рабочего потока публиковала бы состояние
|
||||
// обычной записью, и сосед на слабой модели памяти вправе увидеть её
|
||||
// частично: результат — единичный НОЛЬ, то есть прыжок времени на десятки
|
||||
// лет назад в бухгалтерии TX. Поэтому источник поднимается в initialization,
|
||||
// а состояние держится в ОДНОМ слове. Здесь проверяем сам контракт: ни нулей,
|
||||
// ни хода назад под нагрузкой из нескольких потоков.
|
||||
// (На Linux это ветка clock_gettime, состояния у неё нет вовсе — проверка
|
||||
// страхует от регресса, если ленивое состояние заведут и здесь.)
|
||||
SetLength(Readers, 4);
|
||||
for i := 0 to High(Readers) do Readers[i] := TClockReader.Create(150);
|
||||
Total := 0;
|
||||
Zeros := 0;
|
||||
Backs := 0;
|
||||
for i := 0 to High(Readers) do
|
||||
begin
|
||||
Readers[i].WaitFor;
|
||||
Inc(Total, Readers[i].Reads);
|
||||
Inc(Zeros, Readers[i].Zero);
|
||||
Inc(Backs, Readers[i].Back);
|
||||
Readers[i].Free;
|
||||
end;
|
||||
WriteLn(Format(' .. четыре потока: %d чтений часов, нулей %d, ходов назад %d',
|
||||
[Total, Zeros, Backs]));
|
||||
Check('часы: из нескольких потоков не возвращают ноль', Zeros = 0,
|
||||
IntToStr(Zeros));
|
||||
Check('часы: из нескольких потоков не идут назад', Backs = 0, IntToStr(Backs));
|
||||
end;
|
||||
|
||||
procedure TestEndToEnd;
|
||||
const
|
||||
PORT = 40098;
|
||||
@@ -2657,6 +2837,11 @@ begin
|
||||
TestServer;
|
||||
TestEndToEnd;
|
||||
TestTxPacing;
|
||||
// ★Часы идут ПОСЛЕ тяжёлых частей намеренно: они создают потоки, а брошенный
|
||||
// TX-поток движка когда-то лишал процесс этой возможности вовсе (лечение — в
|
||||
// WDSPEngine.Close, остановка потока вынесена до гейта FInitialized). Порядок
|
||||
// сохраняет ту проверку живой: упадёт снова — увидим здесь.
|
||||
TestMonotonicTicks;
|
||||
WriteLn;
|
||||
WriteLn(Format('Итого: %d проверок, провалено %d', [Passed + Failed, Failed]));
|
||||
if Failed > 0 then Halt(1);
|
||||
|
||||
Reference in New Issue
Block a user