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

feat(serial): своя обёртка последовательного порта — macOS собирается

Browse Source 
RTL-модуль Serial собирается только для [android, linux, netbsd, openbsd,
win32, win64] — Darwin в списке нет (rtl-extra/fpmake.pp). Из-за этого под
macOS CAT по последовательному порту стоял заглушкой, а CWKeyer не собирался
вовсе.

★Скопировать чужой исходник было нельзя. Serial.SerSetParams кладёт B-константу
скорости прямо в c_cflag — идиома Linux, где это битовая маска. На BSD и macOS
B115200 это просто ЧИСЛО 115200, и в c_cflag прилетает $1C200: CLOCAL | HUPCL |
CCTS_OFLOW плюс мусор в поле CSIZE. Молча включается аппаратный CTS-flow, и
передача встаёт, если железка не держит CTS, — а ошибки никакой, порт
«открылся».

Новый SerialPort.pas:
* Unix — termios напрямую, Linux и macOS ОДНИМ путём (разница спрятана в
  константах RTL; Darwin даёт и termio, и все TIOCM_*). Скорость только через
  CFSetISpeed/CFSetOSpeed, c_cflag собирается с нуля чистой SerCFlags;
  CRTSCTS — исключительно по явной просьбе; сырой режим и VMIN/VTIME явные;
  open с O_NONBLOCK и снятием флага сразу после (часть USB-драйверов, как и
  tty-устройство на маке, висит в open до DCD).
* Windows — тонкая переадресация в RTL Serial: там он есть и в termios не лезет.
* Неуспех SerOpen на ВСЕХ платформах даёт SER_INVALID_HANDLE (RTL возвращал 0
  под Windows и −1 под Unix, из-за чего вызывающие держали свои развилки).
  Проверка — SerValid.

Точки вызова: CATSerial и CWKeyer переведены на обёртку, заглушка
CAT_SERIAL_STUB и платформенные {$IFDEF} вокруг хендлов убраны. Имена портов по
умолчанию и подсказка в настройках теперь платформенные (SerDefaultPortName /
SerPortNameHint): на маке порт зовётся /dev/cu.usbserial-XXXX, и '/dev/ttyS0'
там — заведомо неверная подсказка; осмысленного умолчания не существует,
поэтому пусто.

Новый стенд test/serial (36 проверок) — на псевдотерминале: открытие, termios
обратным чтением, ★«CRTSCTS сам не включился», ★«в c_cflag нет ничего, кроме
наших флагов», формат через чистую SerCFlags (обратным чтением его не
проверить: pty восьмибитно-чистый и молча меняет CS7 на CS8), обмен, срок
таймаута, CR не превращается в CR+LF, эха нет, и сквозной прогон CAT через
обёртку. Негативный контроль: с `or Cardinal(BitsPerSec)` в SerSetParams (та
самая идиома, что ломает RTL на BSD) проверка c_cflag падает — «1CAB0 против
8B0».

test/platform расширен: теперь сим-компилирует и SerialPort, для его
Windows-ветки добавлена заглушка модуля Serial с теми же сигнатурами.

Модемные линии (DTR/RTS/CTS/DSR/CD/RI) на pty не проверяются — ioctl TIOCM*
там не работает; это остаётся на живой порт.

Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
Claude-Session: https://claude.ai/code/session_01Bkwwyj7xVRrqnSVEseTRfV
This commit is contained in:
ew8bak
2026-08-24 22:09:44 +03:00
co-authored by Claude Opus 5
parent f2ecd63fe1
commit 05ba39fdad
11 changed files with 943 additions and 122 deletions
Download Patch File Download Diff File Expand all files Collapse all files
SerialPort.pas
+420
View File
@@ -0,0 +1,420 @@
unit SerialPort;
{
SerialPort.pas — последовательный порт: один API на все три платформы.
ЗАЧЕМ СВОЙ. Модуль `Serial` из RTL собирается только для
[android, linux, netbsd, openbsd, win32, win64] — Darwin в списке нет
(rtl-extra/fpmake.pp), поэтому под macOS проект не собирался вовсе, а CAT и
телеграфный ключ приходилось глушить заглушкой.
★И скопировать чужой исходник было нельзя. `Serial.SerSetParams` кладёт
B-константу скорости прямо в c_cflag — идиома Linux, где это битовая маска.
На BSD и macOS `B115200` это просто ЧИСЛО 115200, и в c_cflag прилетает
$1C200, то есть CLOCAL | HUPCL | CCTS_OFLOW плюс мусор в поле CSIZE:
молча включается аппаратный CTS-flow, и передача встаёт, если железка не
держит CTS. Ошибки при этом никакой — порт «открылся». Поэтому скорость
ставим единственным переносимым способом: CFSetISpeed/CFSetOSpeed, а c_cflag
собираем с нуля.
Устройство:
• Unix (Linux и macOS одним путём) — termios напрямую, без развилок по ОС:
разница между ними спрятана в константах RTL. Модемные линии — ioctl
TIOCM*, они есть и там, и там.
• Windows — тонкая переадресация в RTL `Serial` (там он собирается и работает).
Имена и сигнатуры намеренно повторяют RTL-модуль: точки вызова (CATSerial,
CWKeyer) меняют только строку uses. ★Отличие ровно одно, и оно к лучшему:
неуспех SerOpen на ВСЕХ платформах даёт SER_INVALID_HANDLE (RTL возвращал 0
на Windows и −1 на Unix, из-за чего вызывающие держали свои развилки).
Проверять результат следует через SerValid.
}
{$IFDEF FPC}
{$MODE Delphi}
{$ENDIF}
interface
type
{$IFDEF WINDOWS}
TSerialHandle = THandle;
{$ELSE}
TSerialHandle = LongInt;
{$ENDIF}
TParityType = (NoneParity, OddParity, EvenParity);
TSerialFlag = (RtsCtsFlowControl);
TSerialFlags = set of TSerialFlag;
const
// На Windows THandle(-1) — это и есть INVALID_HANDLE_VALUE.
SER_INVALID_HANDLE = TSerialHandle(-1);
{ Открыть порт. Имя — как его пишет система:
Linux /dev/ttyS0, /dev/ttyUSB0, /dev/ttyACM0
macOS /dev/cu.usbserial-XXXX ★именно cu, а не tty: tty-устройство
блокируется на open до появления DCD
Windows COM1, \\.\COM12 для номеров больше девяти
Неуспех — SER_INVALID_HANDLE. }
function SerOpen(const DeviceName: string): TSerialHandle;
procedure SerClose(Handle: TSerialHandle);
{ Годен ли хендл (одна проверка вместо платформенных развилок у вызывающих). }
function SerValid(Handle: TSerialHandle): Boolean;
procedure SerSetParams(Handle: TSerialHandle; BitsPerSec: LongInt;
ByteSize: Integer; Parity: TParityType; StopBits: Integer;
Flags: TSerialFlags);
function SerRead(Handle: TSerialHandle; var Buffer; Count: LongInt): LongInt;
function SerWrite(Handle: TSerialHandle; const Buffer; Count: LongInt): LongInt;
{ Ждать ОДИН байт не дольше TimeOutMs. Результат — сколько прочитано (0 или 1). }
function SerReadTimeout(Handle: TSerialHandle; var Buffer;
TimeOutMs: LongInt): LongInt;
procedure SerSetDTR(Handle: TSerialHandle; State: Boolean);
procedure SerSetRTS(Handle: TSerialHandle; State: Boolean);
function SerGetCTS(Handle: TSerialHandle): Boolean;
function SerGetDSR(Handle: TSerialHandle): Boolean;
function SerGetCD(Handle: TSerialHandle): Boolean;
function SerGetRI(Handle: TSerialHandle): Boolean;
{$IFNDEF WINDOWS}
{ Флаги c_cflag для заданного формата. Вынесено в интерфейс РАДИ СТЕНДА:
псевдотерминал хранит не всё, что ему ставят (CS7 и чётность он молча
заменяет на CS8 без чётности — pty восьмибитно-чистый), поэтому проверять
сборку флагов обратным чтением termios нельзя, а проверять надо. }
function SerCFlags(ByteSize: Integer; Parity: TParityType; StopBits: Integer;
Flags: TSerialFlags): Cardinal;
{$ENDIF}
{ Имя порта по умолчанию для настроек и подсказок в UI: у каждой системы своё,
и '/dev/ttyS0' на маке — заведомо неверная подсказка. Index 0..N. }
function SerDefaultPortName(Index: Integer): string;
{ Пример имени для подсказки под полем ввода. }
function SerPortNameHint: string;
implementation
uses
SysUtils
{$IFDEF WINDOWS}
, Serial // RTL: на Windows он есть и работает
{$ELSE}
, BaseUnix, termio, Unix
{$ENDIF};
{$IFDEF WINDOWS}
// ── Windows: переадресация в RTL ───────────────────────────────────────────
// Своей реализации здесь не нужно: RTL-модуль под Windows собирается и в
// битовые поля termios не лезет — там свой DCB. Приводим только к нашим типам
// и к единому «неуспех = SER_INVALID_HANDLE».
function RtlParity(P: TParityType): Serial.TParityType;
begin
case P of
OddParity: Result := Serial.OddParity;
EvenParity: Result := Serial.EvenParity;
else
Result := Serial.NoneParity;
end;
end;
function RtlFlags(F: TSerialFlags): Serial.TSerialFlags;
begin
Result := [];
if RtsCtsFlowControl in F then Include(Result, Serial.RtsCtsFlowControl);
end;
function SerOpen(const DeviceName: string): TSerialHandle;
begin
Result := Serial.SerOpen(DeviceName);
// ★RTL под Windows отдаёт 0 при неудаче, под Unix −1. Приводим к одному.
if Result = 0 then Result := SER_INVALID_HANDLE;
end;
procedure SerClose(Handle: TSerialHandle);
begin
if SerValid(Handle) then Serial.SerClose(Handle);
end;
procedure SerSetParams(Handle: TSerialHandle; BitsPerSec: LongInt;
ByteSize: Integer; Parity: TParityType; StopBits: Integer;
Flags: TSerialFlags);
begin
Serial.SerSetParams(Handle, BitsPerSec, ByteSize, RtlParity(Parity),
StopBits, RtlFlags(Flags));
end;
function SerRead(Handle: TSerialHandle; var Buffer; Count: LongInt): LongInt;
begin
Result := Serial.SerRead(Handle, Buffer, Count);
end;
function SerWrite(Handle: TSerialHandle; const Buffer; Count: LongInt): LongInt;
begin
Result := Serial.SerWrite(Handle, Buffer, Count);
end;
function SerReadTimeout(Handle: TSerialHandle; var Buffer;
TimeOutMs: LongInt): LongInt;
begin
Result := Serial.SerReadTimeout(Handle, Buffer, TimeOutMs);
end;
procedure SerSetDTR(Handle: TSerialHandle; State: Boolean);
begin
Serial.SerSetDTR(Handle, State);
end;
procedure SerSetRTS(Handle: TSerialHandle; State: Boolean);
begin
Serial.SerSetRTS(Handle, State);
end;
function SerGetCTS(Handle: TSerialHandle): Boolean;
begin
Result := Serial.SerGetCTS(Handle);
end;
function SerGetDSR(Handle: TSerialHandle): Boolean;
begin
Result := Serial.SerGetDSR(Handle);
end;
function SerGetCD(Handle: TSerialHandle): Boolean;
begin
Result := Serial.SerGetCD(Handle);
end;
function SerGetRI(Handle: TSerialHandle): Boolean;
begin
Result := Serial.SerGetRI(Handle);
end;
{$ELSE}
// ── Unix: termios напрямую, один путь для Linux и macOS ────────────────────
function BaudConst(BitsPerSec: LongInt): Cardinal;
// Скорость → константа termios. На Linux это битовая маска, на BSD/macOS —
// само число; обе прячутся за одним именем, поэтому развилки по ОС не нужно.
begin
case BitsPerSec of
50: Result := B50;
75: Result := B75;
110: Result := B110;
134: Result := B134;
150: Result := B150;
200: Result := B200;
300: Result := B300;
600: Result := B600;
1200: Result := B1200;
1800: Result := B1800;
2400: Result := B2400;
4800: Result := B4800;
9600: Result := B9600;
19200: Result := B19200;
38400: Result := B38400;
57600: Result := B57600;
115200: Result := B115200;
230400: Result := B230400;
else
Result := B9600;
end;
end;
function SerCFlags(ByteSize: Integer; Parity: TParityType; StopBits: Integer;
Flags: TSerialFlags): Cardinal;
// ★Только флаги — никаких скоростей (см. шапку модуля). CLOCAL = «модемных
// линий не ждём», без него open и read на кабеле без DCD ведут себя по-разному
// на разных системах.
begin
Result := CREAD or CLOCAL;
case ByteSize of
5: Result := Result or CS5;
6: Result := Result or CS6;
7: Result := Result or CS7;
else
Result := Result or CS8;
end;
case Parity of
OddParity: Result := Result or PARENB or PARODD;
EvenParity: Result := Result or PARENB;
end;
if StopBits = 2 then Result := Result or CSTOPB;
// Аппаратный поток — ТОЛЬКО по явной просьбе. Случайно включённый CRTSCTS
// вешает передачу намертво на кабеле без CTS.
if RtsCtsFlowControl in Flags then Result := Result or CRTSCTS;
end;
function SerOpen(const DeviceName: string): TSerialHandle;
var
Fl: LongInt;
begin
// ★O_NONBLOCK на открытии обязателен: часть USB-драйверов (и любое tty-, а не
// cu-устройство на macOS) висит в open до поднятия DCD. Сразу после открытия
// флаг снимаем — дальше нам нужны обычные блокирующие чтение и запись, а
// ожидание делает fpSelect в SerReadTimeout.
Result := fpOpen(DeviceName, O_RDWR or O_NOCTTY or O_NONBLOCK);
if Result < 0 then Exit(SER_INVALID_HANDLE);
Fl := fpFcntl(Result, F_GetFl, 0);
if Fl >= 0 then fpFcntl(Result, F_SetFl, Fl and (not O_NONBLOCK));
end;
procedure SerClose(Handle: TSerialHandle);
begin
if SerValid(Handle) then fpClose(Handle);
end;
procedure SerSetParams(Handle: TSerialHandle; BitsPerSec: LongInt;
ByteSize: Integer; Parity: TParityType; StopBits: Integer;
Flags: TSerialFlags);
var
Tios: termios;
Speed: Cardinal;
begin
if not SerValid(Handle) then Exit;
FillChar(Tios, SizeOf(Tios), 0);
Tios.c_cflag := SerCFlags(ByteSize, Parity, StopBits, Flags);
// Сырой режим: ни канонической обработки строк, ни эха, ни трансляции
// символов на входе и выходе. CAT — двоичный поток с ';' в роли конца
// команды, любая «помощь» терминала его портит.
Tios.c_iflag := 0;
Tios.c_oflag := 0;
Tios.c_lflag := 0;
Tios.c_cc[VMIN] := 0; // read возвращает то, что есть, и не ждёт
Tios.c_cc[VTIME] := 0;
Speed := BaudConst(BitsPerSec);
CFSetISpeed(Tios, Speed);
CFSetOSpeed(Tios, Speed);
TCFlush(Handle, TCIOFLUSH);
TCSetAttr(Handle, TCSANOW, Tios);
end;
function SerRead(Handle: TSerialHandle; var Buffer; Count: LongInt): LongInt;
begin
if not SerValid(Handle) then Exit(0);
Result := fpRead(Handle, Buffer, Count);
if Result < 0 then Result := 0;
end;
function SerWrite(Handle: TSerialHandle; const Buffer; Count: LongInt): LongInt;
begin
if not SerValid(Handle) then Exit(0);
Result := fpWrite(Handle, Buffer, Count);
if Result < 0 then Result := 0;
end;
function SerReadTimeout(Handle: TSerialHandle; var Buffer;
TimeOutMs: LongInt): LongInt;
var
FDS: TFDSet;
TV: TimeVal;
N: LongInt;
begin
Result := 0;
if not SerValid(Handle) then Exit;
fpFD_Zero(FDS);
fpFD_Set(Handle, FDS);
TV.tv_sec := TimeOutMs div 1000;
TV.tv_usec := (TimeOutMs mod 1000) * 1000;
N := fpSelect(Handle + 1, @FDS, nil, nil, @TV);
if N <= 0 then Exit; // таймаут или ошибка — байта нет
Result := fpRead(Handle, Buffer, 1);
if Result < 0 then Result := 0;
end;
procedure SetModemBit(Handle: TSerialHandle; Bit: Cardinal; State: Boolean);
var
Bits: Cardinal;
begin
if not SerValid(Handle) then Exit;
Bits := Bit;
if State then
fpIOCtl(Handle, TIOCMBIS, @Bits)
else
fpIOCtl(Handle, TIOCMBIC, @Bits);
end;
function ModemBitSet(Handle: TSerialHandle; Bit: Cardinal): Boolean;
var
Bits: Cardinal;
begin
Result := False;
if not SerValid(Handle) then Exit;
Bits := 0;
if fpIOCtl(Handle, TIOCMGET, @Bits) < 0 then Exit;
Result := (Bits and Bit) <> 0;
end;
procedure SerSetDTR(Handle: TSerialHandle; State: Boolean);
begin
SetModemBit(Handle, TIOCM_DTR, State);
end;
procedure SerSetRTS(Handle: TSerialHandle; State: Boolean);
begin
SetModemBit(Handle, TIOCM_RTS, State);
end;
function SerGetCTS(Handle: TSerialHandle): Boolean;
begin
Result := ModemBitSet(Handle, TIOCM_CTS);
end;
function SerGetDSR(Handle: TSerialHandle): Boolean;
begin
Result := ModemBitSet(Handle, TIOCM_DSR);
end;
function SerGetCD(Handle: TSerialHandle): Boolean;
begin
Result := ModemBitSet(Handle, TIOCM_CAR);
end;
function SerGetRI(Handle: TSerialHandle): Boolean;
begin
Result := ModemBitSet(Handle, TIOCM_RNG);
end;
{$ENDIF}
// ── Общее для всех платформ ────────────────────────────────────────────────
function SerValid(Handle: TSerialHandle): Boolean;
begin
// Ноль сюда попадает от RTL под Windows (там это признак неудачи) и не может
// быть настоящим портом на Unix: дескриптор 0 занят стандартным вводом.
Result := (Handle <> SER_INVALID_HANDLE) and (Handle <> 0);
end;
function SerDefaultPortName(Index: Integer): string;
begin
{$IF DEFINED(WINDOWS)}
Result := 'COM' + IntToStr(Index + 1);
{$ELSEIF DEFINED(DARWIN)}
// ★На маке имя порта зависит от переходника (/dev/cu.usbserial-A1B2C3), так
// что осмысленного умолчания не существует — пустая строка честнее наугад
// придуманной. Формат подсказывает SerPortNameHint в окне настроек.
Result := '';
{$ELSE}
Result := '/dev/ttyS' + IntToStr(Index);
{$ENDIF}
end;
function SerPortNameHint: string;
begin
{$IF DEFINED(WINDOWS)}
Result := 'COM3, \\.\COM12';
{$ELSEIF DEFINED(DARWIN)}
Result := '/dev/cu.usbserial-XXXX';
{$ELSE}
Result := '/dev/ttyUSB0, /dev/ttyS0';
{$ENDIF}
end;
end.