AI_Slop/WinComm
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Replace event-driven WM_COMMNOTIFY architecture with polling main loop

Browse source 
The ISR still fills the ring buffer (mandatory for 115200 baud), but the
app now polls ReadComm directly via a PeekMessage loop instead of waiting
for WM_COMMNOTIFY.  Blink uses GetTickCount instead of WM_TIMER.  This
eliminates all Windows message overhead from the data path while keeping
the message loop alive for keyboard, paint, and scrollbar.

Removed from KPCOMM.PAS: NotifyWndProc, hidden notification window,
RegisterClass/CreateWindow, EnableCommNotification, SetCommEventMask,
DoCommEvent, Process*Notify methods, OnComm/CommEvent/RThreshold/
SThreshold properties, modem shadow state (CTS/DSR/CD).

Removed from KPANSI.PAS: WM_TIMER handler, SetTimer/KillTimer, replaced
with public TickBlink method using GetTickCount at 500ms intervals.

Removed from drv/isr.c: checkNotify function and its call from
isrDispatch.  Removed from drv/commdrv.c: pfnPostMessage, all
rxNotifySent/txNotifySent edge-trigger bookkeeping, gutted
enableNotification to a no-op API-compat stub.  Removed from
drv/commdrv.h: rxNotifySent/txNotifySent fields (shifts struct layout),
PostMessageProcT typedef, pfnPostMessage extern.

Co-Authored-By: Claude Opus 4.6 <noreply@anthropic.com>
This commit is contained in:
Scott Duensing 2026-03-01 19:01:40 -06:00
parent acf1a6b691
commit ec0ec8f074
7 changed files with 86 additions and 462 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

45
delphi/KPANSI.PAS
View file

@ -71,9 +71,9 @@ type
FCellWidth: Integer; { Character cell width in pixels (typically 8) } FCellWidth: Integer; { Character cell width in pixels (typically 8) }
FCellHeight: Integer; { Character cell height in pixels (typ 12-16) } FCellHeight: Integer; { Character cell height in pixels (typ 12-16) }
{ Blink/timer state } { Blink state }
FBlinkOn: Boolean; { Cursor blink phase: True=visible } FBlinkOn: Boolean; { Cursor blink phase: True=visible }
FTimerActive: Boolean; { True if WM_TIMER is running (SetTimer) } FLastBlinkTick: Longint; { GetTickCount value at last blink toggle }
{ Scrollback view } { Scrollback view }
FScrollPos: Integer; { Lines scrolled back (0=live, >0=viewing history) } FScrollPos: Integer; { Lines scrolled back (0=live, >0=viewing history) }
@ -97,9 +97,6 @@ type
FPaintFont: HFont; { GDI font handle for OEM_CHARSET rendering } FPaintFont: HFont; { GDI font handle for OEM_CHARSET rendering }
FStockFont: Boolean; { True if FPaintFont is a stock object (no delete) } FStockFont: Boolean; { True if FPaintFont is a stock object (no delete) }
{ Rendering control }
FBlinkCount: Integer; { Timer ticks since last blink toggle }
{ Dirty tracking: per-row flags for incremental rendering } { Dirty tracking: per-row flags for incremental rendering }
FDirtyRow: array[0..255] of Boolean; { True = row needs re-render } FDirtyRow: array[0..255] of Boolean; { True = row needs re-render }
FAllDirty: Boolean; { True = all rows need re-render } FAllDirty: Boolean; { True = all rows need re-render }
@ -158,7 +155,6 @@ type
procedure UpdateScrollbar; procedure UpdateScrollbar;
procedure WMEraseBkgnd(var Msg: TWMEraseBkgnd); message wm_EraseBkgnd; procedure WMEraseBkgnd(var Msg: TWMEraseBkgnd); message wm_EraseBkgnd;
procedure WMGetDlgCode(var Msg: TMessage); message wm_GetDlgCode; procedure WMGetDlgCode(var Msg: TMessage); message wm_GetDlgCode;
procedure WMTimer(var Msg: TWMTimer); message wm_Timer;
procedure WMVScroll(var Msg: TWMScroll); message wm_VScroll; procedure WMVScroll(var Msg: TWMScroll); message wm_VScroll;
protected protected
procedure CreateParams(var Params: TCreateParams); override; procedure CreateParams(var Params: TCreateParams); override;
@ -170,6 +166,7 @@ type
destructor Destroy; override; destructor Destroy; override;
procedure Clear; procedure Clear;
procedure Reset; procedure Reset;
procedure TickBlink;
procedure Write(const S: string); procedure Write(const S: string);
property CursorCol: Integer read GetCursorCol; property CursorCol: Integer read GetCursorCol;
property CursorRow: Integer read GetCursorRow; property CursorRow: Integer read GetCursorRow;
@ -210,10 +207,8 @@ const
$00FFFFFF { 15 White (bright) } $00FFFFFF { 15 White (bright) }
); );
{ Blink timer interval. Win16 minimum is ~55 ms (18.2 Hz tick). } { Blink toggle interval in milliseconds (cursor + text blink). }
BlinkTimerMs = 55; BlinkMs = 500;
{ Cursor and text blink toggle every 9 timer ticks (~500 ms). }
BlinkInterval = 9;
{ OUT_RASTER_PRECIS may not be defined in Delphi 1.0 WinTypes } { OUT_RASTER_PRECIS may not be defined in Delphi 1.0 WinTypes }
OutRasterPrecis = 6; OutRasterPrecis = 6;
@ -484,12 +479,11 @@ begin
FCellWidth := 8; FCellWidth := 8;
FCellHeight := 16; FCellHeight := 16;
FBlinkOn := True; FBlinkOn := True;
FTimerActive := False; FLastBlinkTick := GetTickCount;
FScrollPos := 0; FScrollPos := 0;
FWrapMode := True; FWrapMode := True;
FPaintFont := 0; FPaintFont := 0;
FStockFont := False; FStockFont := False;
FBlinkCount := 0;
FAllDirty := True; FAllDirty := True;
FScrollbarDirty := False; FScrollbarDirty := False;
FTextBlinkOn := True; FTextBlinkOn := True;
@ -648,11 +642,6 @@ end;
destructor TKPAnsi.Destroy; destructor TKPAnsi.Destroy;
begin begin
if FTimerActive and HandleAllocated then
begin
KillTimer(Handle, 1);
FTimerActive := False;
end;
DestroyRowBuffers; DestroyRowBuffers;
if (FPaintFont <> 0) and not FStockFont then if (FPaintFont <> 0) and not FStockFont then
begin begin
@ -1870,13 +1859,6 @@ begin
CreateRowBuffers; CreateRowBuffers;
FAllDirty := True; FAllDirty := True;
{ Start render/blink timer }
if not FTimerActive then
begin
SetTimer(Handle, 1, BlinkTimerMs, nil);
FTimerActive := True;
end;
Invalidate; Invalidate;
end; end;
@ -2322,21 +2304,20 @@ begin
end; end;
procedure TKPAnsi.WMTimer(var Msg: TWMTimer); procedure TKPAnsi.TickBlink;
var
Now: Longint;
begin begin
{ Blink counter: toggle cursor and text blink every BlinkInterval ticks } Now := GetTickCount;
Inc(FBlinkCount); if Now - FLastBlinkTick >= BlinkMs then
if FBlinkCount >= BlinkInterval then
begin begin
FBlinkCount := 0; FLastBlinkTick := Now;
FBlinkOn := not FBlinkOn; FBlinkOn := not FBlinkOn;
FTextBlinkOn := not FTextBlinkOn; FTextBlinkOn := not FTextBlinkOn;
DirtyBlinkRows; DirtyBlinkRows;
end;
{ Render blink changes and any stale dirty rows }
FlipToScreen; FlipToScreen;
end; end;
end;
procedure TKPAnsi.WMVScroll(var Msg: TWMScroll); procedure TKPAnsi.WMVScroll(var Msg: TWMScroll);

267
delphi/KPCOMM.PAS
View file

@ -5,40 +5,16 @@ unit KPComm;
{ TKPComm is a non-visual TComponent descendant providing RS-232 serial } { TKPComm is a non-visual TComponent descendant providing RS-232 serial }
{ I/O via the Windows 3.1 comm API. Installs to the "KP" palette tab. } { I/O via the Windows 3.1 comm API. Installs to the "KP" palette tab. }
{ } { }
{ Port lifecycle: OpenComm -> BuildCommDCB + SetCommState -> } { Port lifecycle: OpenComm -> BuildCommDCB + SetCommState -> CloseComm. }
{ EnableCommNotification -> CloseComm. }
{ } { }
{ WM_COMMNOTIFY messages are received through a hidden utility window } { Data is read by polling Input (ReadComm) from a PeekMessage main loop }
{ with a registered class and dispatched to ProcessReceiveNotify, } { rather than through WM_COMMNOTIFY event dispatch. }
{ ProcessTransmitNotify, and ProcessEventNotify. }
{ }
{ Modem line status (CTS/DSR/CD) is tracked via shadow booleans toggled }
{ on transition events from GetCommEventMask, since the 16-bit comm API }
{ only provides transition events, not absolute line levels. }
interface interface
uses uses
SysUtils, Classes, WinTypes, WinProcs, Messages; SysUtils, Classes, WinTypes, WinProcs, Messages;
const
{ Communication events }
comEvReceive = 1;
comEvSend = 2;
comEvCTS = 3;
comEvDSR = 4;
comEvCD = 5;
comEvRing = 6;
comEvEOF = 7;
{ Error events }
comEvtBreak = 1001;
comEvtFrame = 1004;
comEvtOverrun = 1006;
comEvtRxOver = 1008;
comEvtParity = 1009;
comEvtTxFull = 1010;
type type
THandshaking = (hsNone, hsXonXoff, hsRtsCts, hsBoth); THandshaking = (hsNone, hsXonXoff, hsRtsCts, hsBoth);
TInputMode = (imText, imBinary); TInputMode = (imText, imBinary);
@ -47,7 +23,6 @@ type
private private
{ Port state } { Port state }
FCommId: Integer; { Comm port handle from OpenComm (-1 = closed) } FCommId: Integer; { Comm port handle from OpenComm (-1 = closed) }
FHWndNotify: HWnd; { Hidden window receiving WM_COMMNOTIFY }
{ Configuration (published properties) } { Configuration (published properties) }
FCommPort: Integer; { Port number (1-based: 1=COM1, 2=COM2, ...) } FCommPort: Integer; { Port number (1-based: 1=COM1, 2=COM2, ...) }
@ -55,8 +30,6 @@ type
FPortOpen: Boolean; { True while port is open and operational } FPortOpen: Boolean; { True while port is open and operational }
FInBufferSize: Integer; { Receive ring buffer size in bytes } FInBufferSize: Integer; { Receive ring buffer size in bytes }
FOutBufferSize: Integer; { Transmit ring buffer size in bytes } FOutBufferSize: Integer; { Transmit ring buffer size in bytes }
FRThreshold: Integer; { RX byte count triggering CN_RECEIVE (0=disabled) }
FSThreshold: Integer; { TX free space triggering CN_TRANSMIT (0=disabled) }
FHandshaking: THandshaking; { Flow control mode (none/XonXoff/RtsCts/both) } FHandshaking: THandshaking; { Flow control mode (none/XonXoff/RtsCts/both) }
FInputLen: Integer; { Max bytes per Input read (0=up to 255) } FInputLen: Integer; { Max bytes per Input read (0=up to 255) }
FInputMode: TInputMode; { Text or binary read mode } FInputMode: TInputMode; { Text or binary read mode }
@ -72,26 +45,14 @@ type
{ Runtime state } { Runtime state }
FBreakState: Boolean; { True while break signal is being sent } FBreakState: Boolean; { True while break signal is being sent }
FCommEvent: Integer; { Last event code passed to OnComm (comEv* const) }
{ Modem line shadow state (toggled on transition events from driver) }
FCTSState: Boolean; { CTS line level (toggled on ev_CTS) }
FDSRState: Boolean; { DSR line level (toggled on ev_DSR) }
FCDState: Boolean; { DCD/RLSD line level (toggled on ev_RLSD) }
{ Event handler }
FOnComm: TNotifyEvent; { Fired on comm events; check CommEvent for code }
procedure ApplyHandshaking; procedure ApplyHandshaking;
procedure ApplyOptions; procedure ApplyOptions;
procedure ClosePort; procedure ClosePort;
procedure DoCommEvent(EventCode: Integer);
function GetInBufferCount: Integer; function GetInBufferCount: Integer;
function GetInput: string; function GetInput: string;
function GetOutBufferCount: Integer; function GetOutBufferCount: Integer;
procedure OpenPort; procedure OpenPort;
procedure ProcessEventNotify;
procedure ProcessReceiveNotify;
procedure ProcessTransmitNotify;
procedure SetBreak(Value: Boolean); procedure SetBreak(Value: Boolean);
procedure SetCommPort(Value: Integer); procedure SetCommPort(Value: Integer);
procedure SetDTREnable(Value: Boolean); procedure SetDTREnable(Value: Boolean);
@ -111,19 +72,13 @@ type
property Output: string write SetOutput; property Output: string write SetOutput;
property InBufferCount: Integer read GetInBufferCount; property InBufferCount: Integer read GetInBufferCount;
property OutBufferCount: Integer read GetOutBufferCount; property OutBufferCount: Integer read GetOutBufferCount;
property CDHolding: Boolean read FCDState;
property CTSHolding: Boolean read FCTSState;
property DSRHolding: Boolean read FDSRState;
property Break: Boolean read FBreakState write SetBreak; property Break: Boolean read FBreakState write SetBreak;
property CommEvent: Integer read FCommEvent;
published published
property CommPort: Integer read FCommPort write SetCommPort default 1; property CommPort: Integer read FCommPort write SetCommPort default 1;
property Settings: string read FSettings write SetSettings; property Settings: string read FSettings write SetSettings;
property PortOpen: Boolean read FPortOpen write SetPortOpen default False; property PortOpen: Boolean read FPortOpen write SetPortOpen default False;
property InBufferSize: Integer read FInBufferSize write SetInBufferSize default 4096; property InBufferSize: Integer read FInBufferSize write SetInBufferSize default 4096;
property OutBufferSize: Integer read FOutBufferSize write SetOutBufferSize default 4096; property OutBufferSize: Integer read FOutBufferSize write SetOutBufferSize default 4096;
property RThreshold: Integer read FRThreshold write FRThreshold default 0;
property SThreshold: Integer read FSThreshold write FSThreshold default 0;
property Handshaking: THandshaking read FHandshaking write SetHandshaking default hsNone; property Handshaking: THandshaking read FHandshaking write SetHandshaking default hsNone;
property InputLen: Integer read FInputLen write FInputLen default 0; property InputLen: Integer read FInputLen write FInputLen default 0;
property InputMode: TInputMode read FInputMode write FInputMode default imText; property InputMode: TInputMode read FInputMode write FInputMode default imText;
@ -132,7 +87,6 @@ type
property NullDiscard: Boolean read FNullDiscard write SetNullDiscard default False; property NullDiscard: Boolean read FNullDiscard write SetNullDiscard default False;
property EOFEnable: Boolean read FEOFEnable write FEOFEnable default False; property EOFEnable: Boolean read FEOFEnable write FEOFEnable default False;
property ParityReplace: string read FParityReplace write SetParityReplace; property ParityReplace: string read FParityReplace write SetParityReplace;
property OnComm: TNotifyEvent read FOnComm write FOnComm;
end; end;
procedure Register; procedure Register;
@ -140,11 +94,6 @@ procedure Register;
implementation implementation
const const
{ WM_COMMNOTIFY notification codes }
CN_RECEIVE = $0001;
CN_TRANSMIT = $0002;
CN_EVENT = $0004;
{ DCB Flags field bit masks. The Windows 3.1 DCB packs thirteen 1-bit } { DCB Flags field bit masks. The Windows 3.1 DCB packs thirteen 1-bit }
{ fields into a single UINT (Word) at offset 12 of the structure. } { fields into a single UINT (Word) at offset 12 of the structure. }
{ Delphi 1.0 maps this UINT to TDCB.Flags. } { Delphi 1.0 maps this UINT to TDCB.Flags. }
@ -162,46 +111,6 @@ const
dcbDtrflow = $0800; dcbDtrflow = $0800;
dcbRtsflow = $1000; dcbRtsflow = $1000;
{ Hidden notification window class name }
NotifyClassName = 'KPCommNotify';
var
NotifyClassRegistered: Boolean; { True after RegisterClass for notification window }
{ ----------------------------------------------------------------------- }
{ Hidden notification window procedure }
{ }
{ Receives WM_COMMNOTIFY from the comm driver. Retrieves the TKPComm }
{ instance pointer stored in the window's extra bytes (offset 0) and }
{ dispatches to the appropriate Process* method. }
{ ----------------------------------------------------------------------- }
function NotifyWndProc(Wnd: HWnd; Msg: Word;
WParam: Word; LParam: Longint): Longint; export;
var
Comm: TKPComm;
NotifyCode: Word;
begin
if Msg = wm_CommNotify then
begin
Comm := TKPComm(GetWindowLong(Wnd, 0));
if (Comm <> nil) and Comm.FPortOpen and (Comm.FCommId >= 0) then
begin
NotifyCode := Word(LParam);
if (NotifyCode and CN_RECEIVE) <> 0 then
Comm.ProcessReceiveNotify;
if (NotifyCode and CN_TRANSMIT) <> 0 then
Comm.ProcessTransmitNotify;
if (NotifyCode and CN_EVENT) <> 0 then
Comm.ProcessEventNotify;
end;
Result := 0;
end
else
Result := DefWindowProc(Wnd, Msg, WParam, LParam);
end;
{ ----------------------------------------------------------------------- } { ----------------------------------------------------------------------- }
{ TKPComm } { TKPComm }
@ -277,18 +186,11 @@ end;
procedure TKPComm.ClosePort; procedure TKPComm.ClosePort;
var
Msg: TMsg;
begin begin
{ Set FPortOpen first to prevent stale WM_COMMNOTIFY processing }
FPortOpen := False; FPortOpen := False;
if FCommId >= 0 then if FCommId >= 0 then
begin begin
{ Disable notifications BEFORE dropping modem lines so the ISR }
{ stops posting WM_COMMNOTIFY while we tear down. }
EnableCommNotification(FCommId, 0, -1, -1);
if FBreakState then if FBreakState then
begin begin
ClearCommBreak(FCommId); ClearCommBreak(FCommId);
@ -299,22 +201,6 @@ begin
CloseComm(FCommId); CloseComm(FCommId);
FCommId := -1; FCommId := -1;
end; end;
if FHWndNotify <> 0 then
begin
{ Flush any stale WM_COMMNOTIFY that the ISR posted before we }
{ disabled notifications. Without this, DispatchMessage would }
{ dereference the freed window structure and lock up. }
while PeekMessage(Msg, FHWndNotify, wm_CommNotify,
wm_CommNotify, pm_Remove) do
{ discard };
DestroyWindow(FHWndNotify);
FHWndNotify := 0;
end;
FCTSState := False;
FDSRState := False;
FCDState := False;
end; end;
@ -322,14 +208,11 @@ constructor TKPComm.Create(AOwner: TComponent);
begin begin
inherited Create(AOwner); inherited Create(AOwner);
FCommId := -1; FCommId := -1;
FHWndNotify := 0;
FCommPort := 1; FCommPort := 1;
FSettings := '9600,N,8,1'; FSettings := '9600,N,8,1';
FPortOpen := False; FPortOpen := False;
FInBufferSize := 4096; FInBufferSize := 4096;
FOutBufferSize := 4096; FOutBufferSize := 4096;
FRThreshold := 0;
FSThreshold := 0;
FHandshaking := hsNone; FHandshaking := hsNone;
FInputLen := 0; FInputLen := 0;
FInputMode := imText; FInputMode := imText;
@ -339,10 +222,6 @@ begin
FEOFEnable := False; FEOFEnable := False;
FParityReplace := '?'; FParityReplace := '?';
FBreakState := False; FBreakState := False;
FCommEvent := 0;
FCTSState := False;
FDSRState := False;
FCDState := False;
end; end;
@ -354,14 +233,6 @@ begin
end; end;
procedure TKPComm.DoCommEvent(EventCode: Integer);
begin
FCommEvent := EventCode;
if Assigned(FOnComm) then
FOnComm(Self);
end;
function TKPComm.GetInBufferCount: Integer; function TKPComm.GetInBufferCount: Integer;
var var
Stat: TComStat; Stat: TComStat;
@ -416,12 +287,9 @@ end;
procedure TKPComm.OpenPort; procedure TKPComm.OpenPort;
var var
WC: TWndClass;
DCB: TDCB; DCB: TDCB;
Buf: array[0..255] of Char; Buf: array[0..255] of Char;
Setting: string; Setting: string;
RxTh: Integer;
TxTh: Integer;
begin begin
{ Open the comm port } { Open the comm port }
StrPCopy(Buf, 'COM' + IntToStr(FCommPort)); StrPCopy(Buf, 'COM' + IntToStr(FCommPort));
@ -472,137 +340,10 @@ begin
else else
EscapeCommFunction(FCommId, CLRRTS); EscapeCommFunction(FCommId, CLRRTS);
{ Register notification window class (once per process) }
if not NotifyClassRegistered then
begin
FillChar(WC, SizeOf(WC), 0);
WC.lpfnWndProc := @NotifyWndProc;
WC.cbWndExtra := SizeOf(Longint);
WC.hInstance := HInstance;
WC.lpszClassName := NotifyClassName;
if not RegisterClass(WC) then
begin
CloseComm(FCommId);
FCommId := -1;
raise Exception.Create('RegisterClass failed');
end;
NotifyClassRegistered := True;
end;
{ Create hidden notification window and store Self for dispatch }
FHWndNotify := CreateWindow(NotifyClassName, '', ws_Popup,
0, 0, 0, 0, 0, 0, HInstance, nil);
if FHWndNotify = 0 then
begin
CloseComm(FCommId);
FCommId := -1;
raise Exception.Create('CreateWindow failed');
end;
SetWindowLong(FHWndNotify, 0, Longint(Self));
{ Enable event mask for modem status, errors, and breaks. }
{ ev_RxChar is deliberately excluded: it fires per received byte, }
{ flooding WM_COMMNOTIFY with CN_EVENT on every ISR. Data arrival }
{ is already handled by CN_RECEIVE via EnableCommNotification. }
SetCommEventMask(FCommId,
ev_CTS or ev_DSR or ev_RLSD or ev_Ring or
ev_Err or ev_Break);
{ Enable comm notifications -- -1 disables the notification }
if FRThreshold > 0 then
RxTh := FRThreshold
else
RxTh := -1;
if FSThreshold > 0 then
TxTh := FSThreshold
else
TxTh := -1;
EnableCommNotification(FCommId, FHWndNotify, RxTh, TxTh);
{ Reset modem line shadow state }
FCTSState := False;
FDSRState := False;
FCDState := False;
FPortOpen := True; FPortOpen := True;
end; end;
procedure TKPComm.ProcessEventNotify;
var
EvtMask: Word;
Stat: TComStat;
ErrFlags: Integer;
begin
EvtMask := GetCommEventMask(FCommId,
ev_CTS or ev_DSR or ev_RLSD or ev_Ring or ev_Err or ev_Break);
if (EvtMask and ev_Break) <> 0 then
DoCommEvent(comEvtBreak);
{ Modem line shadow state: toggle on each transition event. }
{ The 16-bit comm API only provides transition events, not }
{ absolute line levels. }
if (EvtMask and ev_CTS) <> 0 then
begin
FCTSState := not FCTSState;
DoCommEvent(comEvCTS);
end;
if (EvtMask and ev_DSR) <> 0 then
begin
FDSRState := not FDSRState;
DoCommEvent(comEvDSR);
end;
if (EvtMask and ev_RLSD) <> 0 then
begin
FCDState := not FCDState;
DoCommEvent(comEvCD);
end;
if (EvtMask and ev_Ring) <> 0 then
DoCommEvent(comEvRing);
if (EvtMask and ev_Err) <> 0 then
begin
ErrFlags := GetCommError(FCommId, Stat);
if (ErrFlags and ce_Frame) <> 0 then
DoCommEvent(comEvtFrame);
if (ErrFlags and ce_Overrun) <> 0 then
DoCommEvent(comEvtOverrun);
if (ErrFlags and ce_RxOver) <> 0 then
DoCommEvent(comEvtRxOver);
if (ErrFlags and ce_RxParity) <> 0 then
DoCommEvent(comEvtParity);
if (ErrFlags and ce_TxFull) <> 0 then
DoCommEvent(comEvtTxFull);
end;
end;
procedure TKPComm.ProcessReceiveNotify;
begin
if FRThreshold <= 0 then
Exit;
{ WM_COMMNOTIFY with CN_RECEIVE means data is available -- the driver }
{ already checked the threshold. No need to call GetCommError here. }
DoCommEvent(comEvReceive);
end;
procedure TKPComm.ProcessTransmitNotify;
var
Stat: TComStat;
begin
if FSThreshold <= 0 then
Exit;
GetCommError(FCommId, Stat);
if Integer(Stat.cbOutQue) <= FSThreshold then
DoCommEvent(comEvSend);
end;
procedure TKPComm.SetBreak(Value: Boolean); procedure TKPComm.SetBreak(Value: Boolean);
begin begin
FBreakState := Value; FBreakState := Value;
@ -685,7 +426,7 @@ begin
begin begin
Written := WriteComm(FCommId, @Value[1], Length(Value)); Written := WriteComm(FCommId, @Value[1], Length(Value));
if Written < 0 then if Written < 0 then
DoCommEvent(comEvtTxFull); raise Exception.Create('WriteComm failed');
end; end;
end; end;

2
delphi/KPTEST.DPR
View file

@ -8,5 +8,5 @@ uses
begin begin
Application.CreateForm(TMainForm, MainForm); Application.CreateForm(TMainForm, MainForm);
Application.Run; MainForm.Run;
end. end.

79
delphi/TESTMAIN.PAS
View file

@ -5,8 +5,8 @@ unit TestMain;
{ } { }
{ Layout: toolbar row at top (port, settings, open/close, status), } { Layout: toolbar row at top (port, settings, open/close, status), }
{ TKPAnsi terminal filling the rest of the form. Received serial data } { TKPAnsi terminal filling the rest of the form. Received serial data }
{ is fed to the terminal via TKPAnsi.Write; keystrokes from the terminal } { is polled from TKPComm.Input in a PeekMessage main loop; keystrokes }
{ are sent out via TKPComm.Output. } { from the terminal are sent out via TKPComm.Output. }
interface interface
@ -29,13 +29,15 @@ type
FBtnOpen: TButton; { Opens the serial port } FBtnOpen: TButton; { Opens the serial port }
FBtnClose: TButton; { Closes the serial port } FBtnClose: TButton; { Closes the serial port }
FLabelStatus: TLabel; { Displays "Open" or "Closed" } FLabelStatus: TLabel; { Displays "Open" or "Closed" }
FDone: Boolean; { True when WM_QUIT received }
procedure AnsiKeyData(Sender: TObject; const Data: string); procedure AnsiKeyData(Sender: TObject; const Data: string);
procedure BtnCloseClick(Sender: TObject); procedure BtnCloseClick(Sender: TObject);
procedure BtnOpenClick(Sender: TObject); procedure BtnOpenClick(Sender: TObject);
procedure CommEvent(Sender: TObject);
procedure UpdateStatus; procedure UpdateStatus;
public public
constructor Create(AOwner: TComponent); override; constructor Create(AOwner: TComponent); override;
procedure Run;
end; end;
var var
@ -70,7 +72,6 @@ begin
try try
FComm.CommPort := StrToInt(FEditPort.Text); FComm.CommPort := StrToInt(FEditPort.Text);
FComm.Settings := FEditSettings.Text; FComm.Settings := FEditSettings.Text;
FComm.RThreshold := 1;
FComm.PortOpen := True; FComm.PortOpen := True;
except except
on E: Exception do on E: Exception do
@ -81,28 +82,6 @@ begin
end; end;
procedure TMainForm.CommEvent(Sender: TObject);
var
S: string;
begin
case FComm.CommEvent of
comEvReceive:
begin
{ Drain all available data. The driver uses edge-triggered }
{ CN_RECEIVE: it posts once when rxCount crosses the threshold }
{ and won't re-post until rxCount drops below and re-crosses. }
{ If we don't drain here, remaining data stalls permanently. }
{ Write renders each chunk immediately (no batching). }
repeat
S := FComm.Input;
if Length(S) > 0 then
FAnsi.Write(S);
until Length(S) = 0;
end;
end;
end;
constructor TMainForm.Create(AOwner: TComponent); constructor TMainForm.Create(AOwner: TComponent);
begin begin
inherited CreateNew(AOwner); inherited CreateNew(AOwner);
@ -114,7 +93,6 @@ begin
{ Serial component } { Serial component }
FComm := TKPComm.Create(Self); FComm := TKPComm.Create(Self);
FComm.OnComm := CommEvent;
{ Row 1: Port and Settings } { Row 1: Port and Settings }
FLabelPort := TLabel.Create(Self); FLabelPort := TLabel.Create(Self);
@ -177,15 +155,54 @@ begin
{ Font diagnostic: write known CP437 box-drawing characters. } { Font diagnostic: write known CP437 box-drawing characters. }
{ If the OEM font is working, you should see: } { If the OEM font is working, you should see: }
{ Line 1: single-line box top ┌───┐ } { Line 1: single-line box top +---+ }
{ Line 2: shade + full block ░▒▓█ } { Line 2: shade + full block ░▒▓█ }
{ Line 3: single-line box bottom └───┘ } { Line 3: single-line box bottom +---+ }
{ If you see accented letters (Ú Ä ¿ ° ± ² Û À Ù), the font is } { If you see accented letters, the font is ANSI_CHARSET instead of }
{ ANSI_CHARSET instead of OEM_CHARSET. } { OEM_CHARSET. }
FAnsi.Write(#$DA#$C4#$C4#$C4#$BF' '#$B0#$B1#$B2#$DB' '#$C0#$C4#$C4#$C4#$D9#13#10); FAnsi.Write(#$DA#$C4#$C4#$C4#$BF' '#$B0#$B1#$B2#$DB' '#$C0#$C4#$C4#$C4#$D9#13#10);
end; end;
procedure TMainForm.Run;
var
Msg: TMsg;
S: string;
begin
FDone := False;
while not FDone do
begin
{ Process all pending Windows messages (keyboard, paint, scrollbar) }
while PeekMessage(Msg, 0, 0, 0, pm_Remove) do
begin
if Msg.message = wm_Quit then
begin
FDone := True;
Break;
end;
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
if FDone then
Break;
{ Poll serial data directly -- no WM_COMMNOTIFY, no events }
if FComm.PortOpen then
begin
repeat
S := FComm.Input;
if Length(S) > 0 then
FAnsi.Write(S);
until Length(S) = 0;
end;
{ Tick blink state (uses GetTickCount, no WM_TIMER) }
FAnsi.TickBlink;
end;
end;
procedure TMainForm.UpdateStatus; procedure TMainForm.UpdateStatus;
begin begin
if FComm.PortOpen then if FComm.PortOpen then

52
drv/commdrv.c
View file

@ -215,16 +215,7 @@ PortStateT ports[MAX_PORTS];
// ----------------------------------------------------------------------- // -----------------------------------------------------------------------
static HANDLE ghInstance = NULL; static HANDLE ghInstance = NULL;
// ----------------------------------------------------------------------- // ISR hit counter for diagnostics (incremented in isr4, wraps at 65535)
// Dynamically resolved PostMessage
//
// comm.drv is loaded from [boot] before USER.EXE, so we can't have a
// static import for PostMessage. Resolve it on first use via
// GetProcAddress(GetModuleHandle("USER"), "PostMessage").
// -----------------------------------------------------------------------
PostMessageProcT pfnPostMessage = NULL;
// ISR hit counter for diagnostics
volatile uint16_t isrHitCount = 0; volatile uint16_t isrHitCount = 0;
@ -577,7 +568,6 @@ int16_t FAR PASCAL _export cflush(int16_t commId, int16_t queue)
port->rxHead = 0; port->rxHead = 0;
port->rxTail = 0; port->rxTail = 0;
port->rxCount = 0; port->rxCount = 0;
port->rxNotifySent = 0;
port->comDeb.qInHead = 0; port->comDeb.qInHead = 0;
port->comDeb.qInTail = 0; port->comDeb.qInTail = 0;
port->comDeb.qInCount = 0; port->comDeb.qInCount = 0;
@ -589,7 +579,6 @@ int16_t FAR PASCAL _export cflush(int16_t commId, int16_t queue)
port->txHead = 0; port->txHead = 0;
port->txTail = 0; port->txTail = 0;
port->txCount = 0; port->txCount = 0;
port->txNotifySent = 0;
port->comDeb.qOutHead = 0; port->comDeb.qOutHead = 0;
port->comDeb.qOutTail = 0; port->comDeb.qOutTail = 0;
port->comDeb.qOutCount = 0; port->comDeb.qOutCount = 0;
@ -726,42 +715,27 @@ void enableFifo(PortStateT *port)
// ----------------------------------------------------------------------- // -----------------------------------------------------------------------
// enableNotification - Register window for WM_COMMNOTIFY (ordinal 100) // enableNotification - Register window for WM_COMMNOTIFY (ordinal 100)
//
// Retained as a no-op stub for API compatibility. Stores threshold
// values but nothing reads them -- polling replaces notifications.
// ----------------------------------------------------------------------- // -----------------------------------------------------------------------
int16_t FAR PASCAL _export enableNotification(int16_t commId, HWND hwnd, int16_t rxThresh, int16_t txThresh) int16_t FAR PASCAL _export enableNotification(int16_t commId, HWND hwnd, int16_t rxThresh, int16_t txThresh)
{ {
PortStateT *port; PortStateT *port;
dbgInt16("KPCOMM: enableNotif Id", commId);
dbgHex16("KPCOMM: enableNotif hwnd", (uint16_t)hwnd);
dbgInt16("KPCOMM: enableNotif rxTh", rxThresh);
dbgInt16("KPCOMM: enableNotif txTh", txThresh);
if (commId < 0 || commId >= MAX_PORTS) { if (commId < 0 || commId >= MAX_PORTS) {
return FALSE; return FALSE;
} }
port = &ports[commId]; port = &ports[commId];
if (!port->isOpen) { if (!port->isOpen) {
dbgStr("KPCOMM: enableNotif not open\r\n");
return FALSE; return FALSE;
} }
// Lazily resolve PostMessage from USER.EXE
// (not available at boot when comm.drv is loaded from [boot])
if (!pfnPostMessage) {
HMODULE hUser = GetModuleHandle("USER");
if (hUser) {
pfnPostMessage = (PostMessageProcT)GetProcAddress(hUser, "PostMessage");
}
}
port->hwndNotify = hwnd; port->hwndNotify = hwnd;
port->rxNotifyThresh = rxThresh; port->rxNotifyThresh = rxThresh;
port->txNotifyThresh = txThresh; port->txNotifyThresh = txThresh;
port->rxNotifySent = 0;
port->txNotifySent = 0;
dbgStr("KPCOMM: enableNotif OK\r\n");
return TRUE; return TRUE;
} }
@ -1095,8 +1069,6 @@ static void initPortState(PortStateT *port, int16_t commId)
port->txImmediate = -1; port->txImmediate = -1;
port->rxNotifyThresh = -1; port->rxNotifyThresh = -1;
port->txNotifyThresh = -1; port->txNotifyThresh = -1;
port->rxNotifySent = 0;
port->txNotifySent = 0;
} }
@ -1294,12 +1266,6 @@ int16_t FAR PASCAL _export reccom(int16_t commId, void FAR *buf, int16_t len)
port->rxCount--; port->rxCount--;
bytesRead++; bytesRead++;
} }
// Reset edge flag under CLI so the next ISR will re-post
// CN_RECEIVE when new data crosses the threshold again.
if (port->rxNotifyThresh >= 0 &&
port->rxCount < (uint16_t)port->rxNotifyThresh) {
port->rxNotifySent = 0;
}
_enable(); _enable();
// If flow control was asserted and buffer has drained, deassert // If flow control was asserted and buffer has drained, deassert
@ -1459,14 +1425,12 @@ int16_t FAR PASCAL _export setque(int16_t commId, int16_t rxSz, int16_t txSz)
port->rxHead = 0; port->rxHead = 0;
port->rxTail = 0; port->rxTail = 0;
port->rxCount = 0; port->rxCount = 0;
port->rxNotifySent = 0;
port->txBufH = newTxH; port->txBufH = newTxH;
port->txBuf = newTxBuf; port->txBuf = newTxBuf;
port->txSize = (uint16_t)txSz; port->txSize = (uint16_t)txSz;
port->txHead = 0; port->txHead = 0;
port->txTail = 0; port->txTail = 0;
port->txCount = 0; port->txCount = 0;
port->txNotifySent = 0;
port->comDeb.qInSize = (uint16_t)rxSz; port->comDeb.qInSize = (uint16_t)rxSz;
port->comDeb.qInCount = 0; port->comDeb.qInCount = 0;
port->comDeb.qInHead = 0; port->comDeb.qInHead = 0;
@ -1534,14 +1498,6 @@ int16_t FAR PASCAL _export sndcom(int16_t commId, void FAR *buf, int16_t len)
port->txCount++; port->txCount++;
bytesWritten++; bytesWritten++;
} }
// Reset TX edge flag under CLI so the ISR will re-post
// CN_TRANSMIT when free space crosses the threshold again.
if (port->txNotifyThresh >= 0) {
uint16_t txFree = port->txSize - port->txCount;
if (txFree < (uint16_t)port->txNotifyThresh) {
port->txNotifySent = 0;
}
}
_enable(); _enable();
// Sync ComDEB queue counts // Sync ComDEB queue counts

20
drv/commdrv.h
View file

@ -324,7 +324,7 @@ typedef struct {
// Port state structure // Port state structure
// //
// One per COM port. Accessed from both application context (reccom, // One per COM port. Accessed from both application context (reccom,
// sndcom, etc.) and ISR context (handleRx, handleTx, checkNotify). // sndcom, etc.) and ISR context (handleRx, handleTx).
// Fields shared between contexts are protected by _disable()/_enable(). // Fields shared between contexts are protected by _disable()/_enable().
// ----------------------------------------------------------------------- // -----------------------------------------------------------------------
typedef struct { typedef struct {
@ -380,12 +380,10 @@ typedef struct {
// Error accumulator (sticky CE_* bits, cleared by stacom/GetCommError) // Error accumulator (sticky CE_* bits, cleared by stacom/GetCommError)
uint16_t errorFlags; // Accumulated CE_RXOVER, CE_OVERRUN, CE_FRAME, etc. uint16_t errorFlags; // Accumulated CE_RXOVER, CE_OVERRUN, CE_FRAME, etc.
// WM_COMMNOTIFY event notification // WM_COMMNOTIFY event notification (stored for API compat, not used)
HWND hwndNotify; // Target window for PostMessage (0=disabled) HWND hwndNotify; // Target window for PostMessage (0=disabled)
int16_t rxNotifyThresh; // CN_RECEIVE fires when rxCount >= this (-1=disabled) int16_t rxNotifyThresh; // CN_RECEIVE threshold (-1=disabled)
int16_t txNotifyThresh; // CN_TRANSMIT fires when txFree >= this (-1=disabled) int16_t txNotifyThresh; // CN_TRANSMIT threshold (-1=disabled)
uint8_t rxNotifySent; // Edge flag: 1 = CN_RECEIVE posted, suppresses repeats
uint8_t txNotifySent; // Edge flag: 1 = CN_TRANSMIT posted, suppresses repeats
// ISR chaining and PIC management // ISR chaining and PIC management
void (FAR *prevIsr)(void); // Previous ISR vector (restored on unhook) void (FAR *prevIsr)(void); // Previous ISR vector (restored on unhook)
@ -404,16 +402,6 @@ typedef struct {
// ----------------------------------------------------------------------- // -----------------------------------------------------------------------
extern PortStateT ports[MAX_PORTS]; extern PortStateT ports[MAX_PORTS];
// -----------------------------------------------------------------------
// Dynamically resolved PostMessage
//
// COMM.DRV loads at boot from [boot] in SYSTEM.INI, before USER.EXE
// is available. PostMessage is resolved lazily on first use via
// GetModuleHandle("USER") + GetProcAddress. NULL until resolved.
// -----------------------------------------------------------------------
typedef BOOL (FAR PASCAL *PostMessageProcT)(HWND, UINT, WPARAM, LPARAM);
extern PostMessageProcT pfnPostMessage;
// ISR hit counter for diagnostics (incremented in isr4, wraps at 65535) // ISR hit counter for diagnostics (incremented in isr4, wraps at 65535)
extern volatile uint16_t isrHitCount; extern volatile uint16_t isrHitCount;

59
drv/isr.c
View file

@ -10,7 +10,6 @@
// Prototypes // Prototypes
// ----------------------------------------------------------------------- // -----------------------------------------------------------------------
static void checkFlowRx(PortStateT *port); static void checkFlowRx(PortStateT *port);
static void checkNotify(PortStateT *port);
static void handleLsr(PortStateT *port, uint8_t lsr); static void handleLsr(PortStateT *port, uint8_t lsr);
static void handleMsr(PortStateT *port); static void handleMsr(PortStateT *port);
static void handleRx(PortStateT *port, uint8_t lsr); static void handleRx(PortStateT *port, uint8_t lsr);
@ -82,62 +81,6 @@ static void checkFlowRx(PortStateT *port)
} }
// -----------------------------------------------------------------------
// checkNotify - Post WM_COMMNOTIFY if threshold conditions met
//
// Called at end of ISR dispatch, outside the IIR loop.
// Uses PostMessage to avoid reentrancy issues.
// -----------------------------------------------------------------------
static void checkNotify(PortStateT *port)
{
uint16_t notifyBits;
if (!port->hwndNotify) {
return;
}
notifyBits = 0;
// CN_RECEIVE: edge-triggered -- post once when rxCount reaches
// threshold, suppress until count drops below and re-crosses.
// Without edge detection, every ISR with rxCount >= 1 floods the
// message queue with stale WM_COMMNOTIFY, delaying keyboard input.
if (port->rxNotifyThresh >= 0) {
if (port->rxCount >= (uint16_t)port->rxNotifyThresh) {
if (!port->rxNotifySent) {
notifyBits |= CN_RECEIVE;
port->rxNotifySent = 1;
}
} else {
port->rxNotifySent = 0;
}
}
// CN_TRANSMIT: edge-triggered -- post once when free space reaches
// threshold, suppress until space drops below and re-crosses.
if (port->txNotifyThresh >= 0) {
uint16_t txFree = port->txSize - port->txCount;
if (txFree >= (uint16_t)port->txNotifyThresh) {
if (!port->txNotifySent) {
notifyBits |= CN_TRANSMIT;
port->txNotifySent = 1;
}
} else {
port->txNotifySent = 0;
}
}
// CN_EVENT: any event bits accumulated
if (port->comDeb.evtWord & port->comDeb.evtMask) {
notifyBits |= CN_EVENT;
}
if (notifyBits && pfnPostMessage) {
pfnPostMessage(port->hwndNotify, WM_COMMNOTIFY, (WPARAM)port->commId, (LPARAM)notifyBits);
}
}
// ----------------------------------------------------------------------- // -----------------------------------------------------------------------
// handleLsr - Process line status errors // handleLsr - Process line status errors
// ----------------------------------------------------------------------- // -----------------------------------------------------------------------
@ -453,8 +396,6 @@ void isrDispatch(PortStateT *port)
port->comDeb.qOutCount = port->txCount; port->comDeb.qOutCount = port->txCount;
port->comDeb.qOutHead = port->txHead; port->comDeb.qOutHead = port->txHead;
port->comDeb.qOutTail = port->txTail; port->comDeb.qOutTail = port->txTail;
checkNotify(port);
} }