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

Compare commits

base: AI_Slop:c8ccedf569da3a48574ae16ba40ba26c1095ed5c
Branches Tags
AI_Slop:master
..
compare: AI_Slop:5dd464eb1862d01fadc9c111aa98ff360d71605a
Branches Tags
AI_Slop:master

No commits in common. "c8ccedf569da3a48574ae16ba40ba26c1095ed5c" and "5dd464eb1862d01fadc9c111aa98ff360d71605a" have entirely different histories.
c8ccedf569 ... 5dd464eb18

7 changed files with 594 additions and 407 deletions
Show stats Expand all files Collapse all files

349
delphi/KPANSI.PAS
View file

@ -45,77 +45,48 @@ type
TKPAnsi = class(TCustomControl) TKPAnsi = class(TCustomControl)
private private
{ Terminal buffer state } FScreen: TList;
FScreen: TList; { Active screen lines (FRows PTermLine ptrs) } FScrollback: TList;
FScrollback: TList; { Scrollback history (up to FScrollbackSize) } FCursorRow: Integer;
FCursorCol: Integer;
{ Cursor position (0-based row/col within the active screen) } FSaveCurRow: Integer;
FCursorRow: Integer; { Current row (0 = top) } FSaveCurCol: Integer;
FCursorCol: Integer; { Current column (0 = left) } FAttrFG: Integer;
FSaveCurRow: Integer; { Saved row for SCP/RCP (ESC[s / ESC[u) } FAttrBG: Integer;
FSaveCurCol: Integer; { Saved column for SCP/RCP } FAttrBold: Boolean;
FAttrBlink: Boolean;
{ Current text attributes (set by SGR escape sequences) } FAttrReverse: Boolean;
FAttrFG: Integer; { Foreground color index 0-7 } FParseState: TParseState;
FAttrBG: Integer; { Background color index 0-7 } FParamStr: string;
FAttrBold: Boolean; { Bold: maps FG to bright (index + 8) } FMusicStr: string;
FAttrBlink: Boolean; { Blink: cell toggles visibility on timer } FCellWidth: Integer;
FAttrReverse: Boolean; { Reverse video: swap FG/BG at render time } FCellHeight: Integer;
FBlinkOn: Boolean;
{ ANSI escape sequence parser state } FTimerActive: Boolean;
FParseState: TParseState; { Current parser state machine position } FScrollPos: Integer;
FParamStr: string; { Accumulated CSI parameter digits/semicolons } FWrapMode: Boolean;
FMusicStr: string; { Accumulated ANSI music string (ESC[M..^N) } FCols: Integer;
FRows: Integer;
{ Font metrics (measured from OEM charset paint font) } FScrollbackSize: Integer;
FCellWidth: Integer; { Character cell width in pixels (typically 8) } FCursorVisible: Boolean;
FCellHeight: Integer; { Character cell height in pixels (typ 12-16) } FLastCursorRow: Integer;
FOnKeyData: TKeyDataEvent;
{ Blink state } FPaintFont: HFont;
FBlinkOn: Boolean; { Cursor blink phase: True=visible } FStockFont: Boolean;
FLastBlinkTick: Longint; { GetTickCount value at last blink toggle } FBlinkCount: Integer;
FUpdateCount: Integer;
{ Scrollback view } FPendingScroll: Integer;
FScrollPos: Integer; { Lines scrolled back (0=live, >0=viewing history) } FDirtyRow: array[0..255] of Boolean;
FAllDirty: Boolean;
{ Terminal modes } FTextBlinkOn: Boolean;
FWrapMode: Boolean; { Auto-wrap at right margin (DEC ?7h/l) } FGlyphBufH: THandle;
FGlyphBuf: Pointer;
{ Terminal dimensions } FRowBufH: THandle;
FCols: Integer; { Number of columns (default 80) } FRowBuf: Pointer;
FRows: Integer; { Number of rows (default 25) } FDibInfo: TDibInfo;
FScrollbackSize: Integer; { Max scrollback lines to retain (default 500) } FRowBufSize: Integer;
FNibbleFG: Byte;
{ Cursor visibility (DEC ?25h/l) } FNibbleBG: Byte;
FCursorVisible: Boolean; { True if cursor is shown }
FLastCursorRow: Integer; { Previous cursor row for ghost cleanup }
{ Events }
FOnKeyData: TKeyDataEvent; { Keyboard data callback (keys -> serial) }
{ Paint font }
FPaintFont: HFont; { GDI font handle for OEM_CHARSET rendering }
FStockFont: Boolean; { True if FPaintFont is a stock object (no delete) }
{ Dirty tracking: per-row flags for incremental rendering }
FDirtyRow: array[0..255] of Boolean; { True = row needs re-render }
FAllDirty: Boolean; { True = all rows need re-render }
FScrollbarDirty: Boolean; { True = scrollbar range/position needs update }
FTextBlinkOn: Boolean; { Text blink phase: True=visible, False=hidden }
{ Font atlas: glyph bitmaps + nibble lookup table (GlobalAlloc) }
FGlyphBufH: THandle; { GlobalAlloc handle for glyph block (8256 bytes) }
FGlyphBuf: Pointer; { Far ptr: offset 0..63 = nibble table, 64+ = glyphs }
{ Row pixel buffer: reusable 8bpp DIB for one terminal row }
FRowBufH: THandle; { GlobalAlloc handle for pixel buffer }
FRowBuf: Pointer; { Far ptr to pixel data (cols*cellW*cellH bytes) }
FDibInfo: TDibInfo; { BITMAPINFO with 16-color ANSI palette }
FRowBufSize: Integer; { Pixel buffer size in bytes }
{ Nibble table color cache: avoids rebuild when colors unchanged }
FNibbleFG: Byte; { FG index currently in nibble table (255=invalid) }
FNibbleBG: Byte; { BG index currently in nibble table (255=invalid) }
procedure AllocLine(Line: PTermLine); procedure AllocLine(Line: PTermLine);
procedure BuildAtlas; procedure BuildAtlas;
procedure ClearLine(Line: PTermLine); procedure ClearLine(Line: PTermLine);
@ -134,6 +105,7 @@ type
procedure EraseLine(Mode: Integer); procedure EraseLine(Mode: Integer);
procedure ExecuteCSI(FinalCh: Char); procedure ExecuteCSI(FinalCh: Char);
procedure ExecuteMusic; procedure ExecuteMusic;
procedure FlipToScreen;
procedure FreeLineList(List: TList); procedure FreeLineList(List: TList);
function GetCursorCol: Integer; function GetCursorCol: Integer;
function GetCursorRow: Integer; function GetCursorRow: Integer;
@ -154,6 +126,7 @@ 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;
@ -163,12 +136,11 @@ type
public public
constructor Create(AOwner: TComponent); override; constructor Create(AOwner: TComponent); override;
destructor Destroy; override; destructor Destroy; override;
procedure BeginUpdate;
procedure Clear; procedure Clear;
procedure EndUpdate;
procedure Reset; procedure Reset;
procedure FlipToScreen;
procedure TickBlink;
procedure Write(const S: string); procedure Write(const S: string);
procedure WriteDeferred(const S: string);
property CursorCol: Integer read GetCursorCol; property CursorCol: Integer read GetCursorCol;
property CursorRow: Integer read GetCursorRow; property CursorRow: Integer read GetCursorRow;
published published
@ -208,8 +180,10 @@ const
$00FFFFFF { 15 White (bright) } $00FFFFFF { 15 White (bright) }
); );
{ Blink toggle interval in milliseconds (cursor + text blink). } { Blink timer interval. Win16 minimum is ~55 ms (18.2 Hz tick). }
BlinkMs = 500; BlinkTimerMs = 55;
{ 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;
@ -289,6 +263,12 @@ begin
end; end;
procedure TKPAnsi.BeginUpdate;
begin
Inc(FUpdateCount);
end;
procedure TKPAnsi.BuildAtlas; procedure TKPAnsi.BuildAtlas;
{ Render all 256 CP437 characters into a monochrome bitmap, then extract } { Render all 256 CP437 characters into a monochrome bitmap, then extract }
{ per-glyph pixel masks into the glyph block at offset 64. Each glyph } { per-glyph pixel masks into the glyph block at offset 64. Each glyph }
@ -480,13 +460,15 @@ begin
FCellWidth := 8; FCellWidth := 8;
FCellHeight := 16; FCellHeight := 16;
FBlinkOn := True; FBlinkOn := True;
FLastBlinkTick := GetTickCount; FTimerActive := False;
FScrollPos := 0; FScrollPos := 0;
FWrapMode := True; FWrapMode := True;
FPaintFont := 0; FPaintFont := 0;
FStockFont := False; FStockFont := False;
FBlinkCount := 0;
FUpdateCount := 0;
FPendingScroll := 0;
FAllDirty := True; FAllDirty := True;
FScrollbarDirty := False;
FTextBlinkOn := True; FTextBlinkOn := True;
FRowBufSize := 0; FRowBufSize := 0;
FGlyphBufH := 0; FGlyphBufH := 0;
@ -643,6 +625,11 @@ 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
@ -743,12 +730,14 @@ begin
FScreen.Insert(0, Line); FScreen.Insert(0, Line);
{ Scroll down is rare; just repaint everything } { Scroll down is rare; just repaint everything }
FAllDirty := True; FAllDirty := True;
FPendingScroll := 0;
end; end;
procedure TKPAnsi.DoScrollUp; procedure TKPAnsi.DoScrollUp;
var var
Line: PTermLine; Line: PTermLine;
I: Integer;
begin begin
if FScreen.Count < FRows then if FScreen.Count < FRows then
Exit; Exit;
@ -756,19 +745,39 @@ begin
Line := FScreen[0]; Line := FScreen[0];
FScrollback.Add(Line); FScrollback.Add(Line);
FScreen.Delete(0); FScreen.Delete(0);
{ TrimScrollback deferred to ParseData for batching } TrimScrollback;
{ Add blank line at bottom } { Add blank line at bottom }
GetMem(Line, SizeOf(TTermLineRec)); GetMem(Line, SizeOf(TTermLineRec));
AllocLine(Line); AllocLine(Line);
FScreen.Add(Line); FScreen.Add(Line);
FScrollbarDirty := True; UpdateScrollbar;
{ Without ScrollDC, all rows must be re-rendered after a scroll } Inc(FPendingScroll);
{ because the on-screen pixels haven't moved to match FScreen. } if FPendingScroll >= FRows then
begin
{ Scrolled more than one screen; just repaint everything }
FAllDirty := True; FAllDirty := True;
FPendingScroll := 0;
end
else
begin
{ Shift dirty flags up to match the scrolled line positions }
for I := 1 to FRows - 1 do
FDirtyRow[I - 1] := FDirtyRow[I];
FDirtyRow[FRows - 1] := True;
end;
end; end;
procedure TKPAnsi.EndUpdate;
begin
Dec(FUpdateCount);
if FUpdateCount <= 0 then
begin
FUpdateCount := 0;
FlipToScreen;
end;
end;
procedure TKPAnsi.EraseDisplay(Mode: Integer); procedure TKPAnsi.EraseDisplay(Mode: Integer);
@ -1223,7 +1232,8 @@ procedure TKPAnsi.FlipToScreen;
var var
DC: HDC; DC: HDC;
Row: Integer; Row: Integer;
HasDirty: Boolean; R: TRect;
ScrollY: Integer;
begin begin
if not HandleAllocated then if not HandleAllocated then
Exit; Exit;
@ -1232,17 +1242,27 @@ begin
if FRowBuf = nil then if FRowBuf = nil then
Exit; Exit;
{ Scrollback view: force full redraw (line mapping changes) } { Scrollback view: force full redraw, ignore pending scroll }
if FScrollPos <> 0 then if FScrollPos <> 0 then
FAllDirty := True;
{ Deferred scrollbar update (batched from DoScrollUp) }
if FScrollbarDirty then
begin begin
UpdateScrollbar; FAllDirty := True;
FScrollbarDirty := False; FPendingScroll := 0;
end; end;
{ Deferred scroll: shift existing screen pixels up }
if (FPendingScroll > 0) and not FAllDirty then
begin
R.Left := 0;
R.Top := 0;
R.Right := FCols * FCellWidth;
R.Bottom := FRows * FCellHeight;
ScrollY := FPendingScroll * FCellHeight;
DC := GetDC(Handle);
ScrollDC(DC, 0, -ScrollY, R, R, 0, nil);
ReleaseDC(Handle, DC);
end;
FPendingScroll := 0;
{ Dirty old cursor row to erase ghost when cursor moved between rows } { Dirty old cursor row to erase ghost when cursor moved between rows }
if FCursorRow <> FLastCursorRow then if FCursorRow <> FLastCursorRow then
begin begin
@ -1253,22 +1273,6 @@ begin
FLastCursorRow := FCursorRow; FLastCursorRow := FCursorRow;
end; end;
{ Early exit: skip GetDC/ReleaseDC when nothing needs rendering }
if not FAllDirty then
begin
HasDirty := False;
for Row := 0 to FRows - 1 do
begin
if FDirtyRow[Row] then
begin
HasDirty := True;
Break;
end;
end;
if not HasDirty then
Exit;
end;
{ Interleaved render + blast: single buffer is reused per row } { Interleaved render + blast: single buffer is reused per row }
DC := GetDC(Handle); DC := GetDC(Handle);
for Row := 0 to FRows - 1 do for Row := 0 to FRows - 1 do
@ -1484,6 +1488,7 @@ begin
Exit; Exit;
{ Full repaint: render each row into the shared buffer and blast it } { Full repaint: render each row into the shared buffer and blast it }
FPendingScroll := 0;
FAllDirty := True; FAllDirty := True;
for Row := 0 to FRows - 1 do for Row := 0 to FRows - 1 do
@ -1504,90 +1509,28 @@ end;
procedure TKPAnsi.ParseData(const S: string); procedure TKPAnsi.ParseData(const S: string);
{ Process incoming data with an inlined fast path for printable characters. }
{ ~80% of BBS data is printable text in normal state. Inlining avoids the }
{ per-character method call to ProcessChar, and caching the Line pointer }
{ eliminates repeated TList lookups for consecutive chars on the same row. }
{ }
{ Does NOT call FlipToScreen -- the caller (Write) calls FlipToScreen }
{ after ParseData returns, ensuring immediate rendering. }
var var
I: Integer; I: Integer;
Ch: Char;
Line: PTermLine;
FGIdx: Byte;
BGIdx: Byte;
begin begin
Line := nil;
for I := 1 to Length(S) do for I := 1 to Length(S) do
begin ProcessChar(S[I]);
Ch := S[I];
{ Fast path: printable character in normal state }
if (FParseState = psNormal) and (Ch >= ' ') then
begin
if FCursorCol >= FCols then
begin
if FWrapMode then
begin
FCursorCol := 0;
Inc(FCursorRow);
if FCursorRow >= FRows then
begin
FCursorRow := FRows - 1;
DoScrollUp;
end;
Line := nil;
end
else
FCursorCol := FCols - 1;
end;
if Line = nil then
Line := FScreen[FCursorRow];
if FAttrBold then
FGIdx := FAttrFG + 8
else
FGIdx := FAttrFG;
BGIdx := FAttrBG;
if FAttrReverse then
begin
Line^.Cells[FCursorCol].FG := BGIdx;
Line^.Cells[FCursorCol].BG := FGIdx;
end
else
begin
Line^.Cells[FCursorCol].FG := FGIdx;
Line^.Cells[FCursorCol].BG := BGIdx;
end;
Line^.Cells[FCursorCol].Ch := Ch;
Line^.Cells[FCursorCol].Bold := FAttrBold;
Line^.Cells[FCursorCol].Blink := FAttrBlink;
FDirtyRow[FCursorRow] := True;
Inc(FCursorCol);
end
else
begin
{ Slow path: control chars, escape sequences }
Line := nil;
ProcessChar(Ch);
end;
end;
{ Deferred scrollback trim -- batched from DoScrollUp }
TrimScrollback;
{ Snap to bottom on new data } { Snap to bottom on new data }
if FScrollPos <> 0 then if FScrollPos <> 0 then
begin begin
FScrollPos := 0; FScrollPos := 0;
FScrollbarDirty := True; UpdateScrollbar;
FAllDirty := True; FAllDirty := True;
end; end;
{ Reset cursor blink to visible on new data }
FBlinkOn := True;
{ Render immediately -- no throttle. Data hits the screen as soon }
{ as it arrives. BeginUpdate/EndUpdate suppresses intermediate }
{ renders when the caller is batching multiple Write calls. }
if FUpdateCount = 0 then
FlipToScreen;
end; end;
@ -1875,6 +1818,13 @@ 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;
@ -2262,28 +2212,15 @@ end;
procedure TKPAnsi.TrimScrollback; procedure TKPAnsi.TrimScrollback;
{ Batch-optimized: free excess items, shift remainder down in one pass, }
{ then shrink from the end. O(n) total vs O(k*n) for k front-deletions. }
var var
Excess: Integer;
I: Integer;
Line: PTermLine; Line: PTermLine;
begin begin
Excess := FScrollback.Count - FScrollbackSize; while FScrollback.Count > FScrollbackSize do
if Excess <= 0 then
Exit;
{ Free the oldest lines }
for I := 0 to Excess - 1 do
begin begin
Line := FScrollback[I]; Line := FScrollback[0];
FreeMem(Line, SizeOf(TTermLineRec)); FreeMem(Line, SizeOf(TTermLineRec));
FScrollback.Delete(0);
end; end;
{ Shift remaining items down in one pass }
for I := 0 to FScrollback.Count - Excess - 1 do
FScrollback[I] := FScrollback[I + Excess];
{ Remove excess slots from the end (O(1) per deletion) }
for I := 1 to Excess do
FScrollback.Delete(FScrollback.Count - 1);
end; end;
@ -2320,18 +2257,20 @@ begin
end; end;
procedure TKPAnsi.TickBlink; procedure TKPAnsi.WMTimer(var Msg: TWMTimer);
var
Now: Longint;
begin begin
Now := GetTickCount; { Blink counter: toggle cursor and text blink every BlinkInterval ticks }
if Now - FLastBlinkTick >= BlinkMs then Inc(FBlinkCount);
if FBlinkCount >= BlinkInterval then
begin begin
FLastBlinkTick := Now; FBlinkCount := 0;
FBlinkOn := not FBlinkOn; FBlinkOn := not FBlinkOn;
FTextBlinkOn := not FTextBlinkOn; FTextBlinkOn := not FTextBlinkOn;
DirtyBlinkRows; DirtyBlinkRows;
end; end;
{ Render blink changes and any stale dirty rows }
FlipToScreen;
end; end;
@ -2377,16 +2316,6 @@ end;
procedure TKPAnsi.Write(const S: string); procedure TKPAnsi.Write(const S: string);
begin
if Length(S) > 0 then
begin
ParseData(S);
FlipToScreen;
end;
end;
procedure TKPAnsi.WriteDeferred(const S: string);
begin begin
if Length(S) > 0 then if Length(S) > 0 then
ParseData(S); ParseData(S);

289
delphi/KPCOMM.PAS
View file

@ -5,54 +5,80 @@ 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 -> CloseComm. } { Port lifecycle: OpenComm -> BuildCommDCB + SetCommState -> }
{ EnableCommNotification -> CloseComm. }
{ } { }
{ Data is read by polling Input (ReadComm) from a PeekMessage main loop } { WM_COMMNOTIFY messages are received through a hidden utility window }
{ rather than through WM_COMMNOTIFY event dispatch. } { with a registered class and dispatched to ProcessReceiveNotify, }
{ 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);
TKPComm = class(TComponent) TKPComm = class(TComponent)
private private
{ Port state } FCommId: Integer;
FCommId: Integer; { Comm port handle from OpenComm (-1 = closed) } FHWndNotify: HWnd;
FCommPort: Integer;
{ Configuration (published properties) } FSettings: string;
FCommPort: Integer; { Port number (1-based: 1=COM1, 2=COM2, ...) } FPortOpen: Boolean;
FSettings: string; { Baud/parity/data/stop string (e.g. '9600,N,8,1') } FInBufferSize: Integer;
FPortOpen: Boolean; { True while port is open and operational } FOutBufferSize: Integer;
FInBufferSize: Integer; { Receive ring buffer size in bytes } FRThreshold: Integer;
FOutBufferSize: Integer; { Transmit ring buffer size in bytes } FSThreshold: Integer;
FHandshaking: THandshaking; { Flow control mode (none/XonXoff/RtsCts/both) } FHandshaking: THandshaking;
FInputLen: Integer; { Max bytes per Input read (0=up to 255) } FInputLen: Integer;
FInputMode: TInputMode; { Text or binary read mode } FInputMode: TInputMode;
FDTREnable: Boolean;
{ Modem control lines } FRTSEnable: Boolean;
FDTREnable: Boolean; { DTR line state (True=asserted) } FNullDiscard: Boolean;
FRTSEnable: Boolean; { RTS line state (True=asserted) } FEOFEnable: Boolean;
FParityReplace: string;
{ DCB options } FBreakState: Boolean;
FNullDiscard: Boolean; { Strip null bytes from received data } FCommEvent: Integer;
FEOFEnable: Boolean; { Detect EOF character in stream } FCTSState: Boolean;
FParityReplace: string; { Replacement char for parity errors ('' = none) } FDSRState: Boolean;
FCDState: Boolean;
{ Runtime state } FOnComm: TNotifyEvent;
FBreakState: Boolean; { True while break signal is being sent }
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);
@ -72,13 +98,19 @@ 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;
@ -87,6 +119,7 @@ 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;
@ -94,6 +127,11 @@ 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. }
@ -111,6 +149,46 @@ const
dcbDtrflow = $0800; dcbDtrflow = $0800;
dcbRtsflow = $1000; dcbRtsflow = $1000;
{ Hidden notification window class name }
NotifyClassName = 'KPCommNotify';
var
NotifyClassRegistered: Boolean;
{ ----------------------------------------------------------------------- }
{ 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 }
@ -187,6 +265,7 @@ end;
procedure TKPComm.ClosePort; procedure TKPComm.ClosePort;
begin begin
{ Set FPortOpen first to prevent stale WM_COMMNOTIFY processing }
FPortOpen := False; FPortOpen := False;
if FCommId >= 0 then if FCommId >= 0 then
@ -201,6 +280,16 @@ begin
CloseComm(FCommId); CloseComm(FCommId);
FCommId := -1; FCommId := -1;
end; end;
if FHWndNotify <> 0 then
begin
DestroyWindow(FHWndNotify);
FHWndNotify := 0;
end;
FCTSState := False;
FDSRState := False;
FCDState := False;
end; end;
@ -208,11 +297,14 @@ 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;
@ -222,6 +314,10 @@ begin
FEOFEnable := False; FEOFEnable := False;
FParityReplace := '?'; FParityReplace := '?';
FBreakState := False; FBreakState := False;
FCommEvent := 0;
FCTSState := False;
FDSRState := False;
FCDState := False;
end; end;
@ -233,6 +329,14 @@ 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;
@ -287,9 +391,12 @@ 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));
@ -340,10 +447,134 @@ 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 }
SetCommEventMask(FCommId,
ev_CTS or ev_DSR or ev_RLSD or ev_Ring or
ev_Err or ev_Break or ev_RxChar);
{ 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;
@ -426,7 +657,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
raise Exception.Create('WriteComm failed'); DoCommEvent(comEvtTxFull);
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);
MainForm.Run; Application.Run;
end. end.

115
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 polled from TKPComm.Input in a PeekMessage main loop; keystrokes } { is fed to the terminal via TKPAnsi.Write; keystrokes from the terminal }
{ from the terminal are sent out via TKPComm.Output. } { are sent out via TKPComm.Output. }
interface interface
@ -17,27 +17,22 @@ uses
type type
TMainForm = class(TForm) TMainForm = class(TForm)
private private
{ Components (owned by Self, freed automatically) } FComm: TKPComm;
FComm: TKPComm; { Serial communications component } FAnsi: TKPAnsi;
FAnsi: TKPAnsi; { ANSI terminal display } FLabelPort: TLabel;
FEditPort: TEdit;
{ Toolbar controls } FLabelSettings: TLabel;
FLabelPort: TLabel; { "Port:" label } FEditSettings: TEdit;
FEditPort: TEdit; { COM port number entry } FBtnOpen: TButton;
FLabelSettings: TLabel; { "Settings:" label } FBtnClose: TButton;
FEditSettings: TEdit; { Baud/parity/data/stop entry } FLabelStatus: TLabel;
FBtnOpen: TButton; { Opens the serial port }
FBtnClose: TButton; { Closes the serial port }
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
@ -72,6 +67,7 @@ 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
@ -82,6 +78,31 @@ begin
end; end;
procedure TMainForm.CommEvent(Sender: TObject);
var
S: string;
begin
case FComm.CommEvent of
comEvReceive:
begin
{ Drain all available data in a single update batch. This }
{ suppresses per-Write rendering so we get one paint at the }
{ end instead of one per 255-byte chunk. }
FAnsi.BeginUpdate;
try
repeat
S := FComm.Input;
if Length(S) > 0 then
FAnsi.Write(S);
until Length(S) = 0;
finally
FAnsi.EndUpdate;
end;
end;
end;
end;
constructor TMainForm.Create(AOwner: TComponent); constructor TMainForm.Create(AOwner: TComponent);
begin begin
inherited CreateNew(AOwner); inherited CreateNew(AOwner);
@ -93,6 +114,7 @@ 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);
@ -155,66 +177,15 @@ 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 ANSI_CHARSET instead of } { If you see accented letters (Ú Ä ¿ ° ± ² Û À Ù), the font is }
{ OEM_CHARSET. } { ANSI_CHARSET instead of 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;
HasData: Boolean;
begin
Show;
FDone := False;
while not FDone do
begin
{ Process all pending Windows messages (keyboard, paint, scrollbar) }
while PeekMessage(Msg, 0, 0, 0, pm_Remove or pm_NoYield) 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 -- read one chunk per iteration }
HasData := False;
if FComm.PortOpen then
begin
S := FComm.Input;
if Length(S) > 0 then
begin
FAnsi.WriteDeferred(S);
HasData := True;
end;
end;
{ Tick blink (dirties rows if interval elapsed), then render }
FAnsi.TickBlink;
FAnsi.FlipToScreen;
{ Yield CPU to other apps when no serial data is flowing. }
{ PM_NOYIELD keeps message draining fast; Yield here gives other }
{ apps a timeslice only when idle. During bulk data flow, HasData }
{ stays True and the loop runs at full speed. }
if not HasData then
Yield;
end;
end;
procedure TMainForm.UpdateStatus; procedure TMainForm.UpdateStatus;
begin begin
if FComm.PortOpen then if FComm.PortOpen then

50
drv/commdrv.c
View file

@ -193,7 +193,7 @@ static void readPortConfig(int16_t commId, uint16_t FAR *baseAddr, uint8_t F
static uint16_t readSystemIni(const char FAR *section, const char FAR *key, uint16_t defVal); static uint16_t readSystemIni(const char FAR *section, const char FAR *key, uint16_t defVal);
// ----------------------------------------------------------------------- // -----------------------------------------------------------------------
// Port base addresses and IRQ defaults (overridden by SYSTEM.INI) // Port base addresses and IRQ table
// ----------------------------------------------------------------------- // -----------------------------------------------------------------------
static const uint16_t portBase[MAX_PORTS] = { static const uint16_t portBase[MAX_PORTS] = {
COM1_BASE, COM2_BASE, COM3_BASE, COM4_BASE COM1_BASE, COM2_BASE, COM3_BASE, COM4_BASE
@ -204,18 +204,25 @@ static const uint8_t portIrq[MAX_PORTS] = {
}; };
// ----------------------------------------------------------------------- // -----------------------------------------------------------------------
// Global port state array -- one PortStateT per COM port. // Global port state array
// Accessed from both application context and ISR context.
// Segment address loaded into DS by ISR entry points (isr3/isr4).
// ----------------------------------------------------------------------- // -----------------------------------------------------------------------
PortStateT ports[MAX_PORTS]; PortStateT ports[MAX_PORTS];
// ----------------------------------------------------------------------- // -----------------------------------------------------------------------
// DLL instance handle (saved in LibMain for resource loading) // Global instance handle
// ----------------------------------------------------------------------- // -----------------------------------------------------------------------
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;
@ -715,27 +722,40 @@ 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;
dbgStr("KPCOMM: enableNotif OK\r\n");
return TRUE; return TRUE;
} }
@ -1043,21 +1063,21 @@ static void initPortState(PortStateT *port, int16_t commId)
trigKey[11] = 'E'; trigKey[11] = 'E';
trigKey[12] = 'R'; trigKey[12] = 'R';
trigKey[13] = '\0'; trigKey[13] = '\0';
rxTrigger = readSystemIni("386Enh", trigKey, 1); rxTrigger = readSystemIni("386Enh", trigKey, 8);
} }
switch (rxTrigger) { switch (rxTrigger) {
case 1:
port->fifoTrigger = FCR_TRIG_1;
break;
case 4: case 4:
port->fifoTrigger = FCR_TRIG_4; port->fifoTrigger = FCR_TRIG_4;
break; break;
case 8:
port->fifoTrigger = FCR_TRIG_8;
break;
case 14: case 14:
port->fifoTrigger = FCR_TRIG_14; port->fifoTrigger = FCR_TRIG_14;
break; break;
case 1: case 8:
default: default:
port->fifoTrigger = FCR_TRIG_1; port->fifoTrigger = FCR_TRIG_8;
break; break;
} }

117
drv/commdrv.h
View file

@ -322,87 +322,86 @@ typedef struct {
// ----------------------------------------------------------------------- // -----------------------------------------------------------------------
// Port state structure // Port state structure
//
// One per COM port. Accessed from both application context (reccom,
// sndcom, etc.) and ISR context (handleRx, handleTx).
// Fields shared between contexts are protected by _disable()/_enable().
// ----------------------------------------------------------------------- // -----------------------------------------------------------------------
typedef struct { typedef struct {
// Stock-compatible ComDEB -- must be at offset 0. // Stock-compatible ComDEB -- must be kept synchronized.
// cevt (SetCommEventMask) returns a FAR pointer to this. // cevt returns a FAR pointer to this.
// Third-party code reads msrShadow at offset 35 (KB Q101417).
ComDebT comDeb; ComDebT comDeb;
// Hardware identification (from SYSTEM.INI or defaults) uint16_t baseAddr; // UART base I/O address
uint16_t baseAddr; // UART base I/O address (e.g. 0x03F8 for COM1) uint8_t irq; // IRQ number (3 or 4)
uint8_t irq; // IRQ number (3 for COM2/4, 4 for COM1/3) int16_t commId; // Port ID (0=COM1, 1=COM2, ...)
int16_t commId; // Port index (0=COM1, 1=COM2, 2=COM3, 3=COM4) uint8_t isOpen; // Port open flag
uint8_t isOpen; // Nonzero while port is open (guards ISR dispatch) uint8_t is16550; // 16550 FIFO detected
uint8_t is16550; // Nonzero if 16550 FIFO detected at init uint8_t fifoEnabled; // FIFO enabled (COMnFIFO setting)
uint8_t fifoEnabled; // Nonzero if FIFO use enabled (COMnFIFO in SYSTEM.INI) uint8_t fifoTrigger; // RX FIFO trigger FCR bits (FCR_TRIG_*)
uint8_t fifoTrigger; // RX FIFO trigger level FCR bits (FCR_TRIG_*)
// Receive ring buffer (GlobalAlloc'd GMEM_FIXED for ISR stability) // Ring buffers (GlobalAlloc'd GMEM_FIXED)
HGLOBAL rxBufH; // GlobalAlloc handle (for GlobalFree on close) HGLOBAL rxBufH; // Receive buffer handle
uint8_t FAR *rxBuf; // Far pointer to buffer data uint8_t FAR *rxBuf; // Receive ring buffer
uint16_t rxSize; // Buffer capacity in bytes uint16_t rxSize; // Buffer size
uint16_t rxHead; // Write position -- ISR increments uint16_t rxHead; // Write position (ISR writes)
uint16_t rxTail; // Read position -- reccom increments uint16_t rxTail; // Read position (app reads)
uint16_t rxCount; // Bytes in buffer (ISR increments, reccom decrements) uint16_t rxCount; // Bytes in buffer
// Transmit ring buffer (GlobalAlloc'd GMEM_FIXED for ISR stability) HGLOBAL txBufH; // Transmit buffer handle
HGLOBAL txBufH; // GlobalAlloc handle (for GlobalFree on close) uint8_t FAR *txBuf; // Transmit ring buffer
uint8_t FAR *txBuf; // Far pointer to buffer data uint16_t txSize; // Buffer size
uint16_t txSize; // Buffer capacity in bytes uint16_t txHead; // Write position (app writes)
uint16_t txHead; // Write position -- sndcom increments uint16_t txTail; // Read position (ISR reads)
uint16_t txTail; // Read position -- ISR (handleTx) increments uint16_t txCount; // Bytes in buffer
uint16_t txCount; // Bytes in buffer (sndcom increments, ISR decrements)
// Serial parameters (cached from DCB at inicom/setcom time) // DCB shadow
uint16_t baudRate; // Baud rate (raw or CBR_* index for >32767) uint16_t baudRate; // Current baud rate
uint8_t byteSize; // Data bits per character (5-8) uint8_t byteSize; // Data bits (5-8)
uint8_t parity; // Parity mode (NOPARITY, ODDPARITY, EVENPARITY, ...) uint8_t parity; // Parity mode
uint8_t stopBits; // Stop bits (ONESTOPBIT, TWOSTOPBITS) uint8_t stopBits; // Stop bits
// Flow control state (managed by ISR and application code) // Flow control state
uint8_t hsMode; // Handshaking mode (HS_NONE/XONXOFF/RTSCTS/BOTH) uint8_t hsMode; // Handshaking mode
uint8_t txStopped; // Nonzero = TX halted (received XOFF or CTS dropped) uint8_t txStopped; // TX halted by flow control
uint8_t rxStopped; // Nonzero = we sent XOFF or dropped RTS uint8_t rxStopped; // We sent XOFF / dropped RTS
uint8_t xonChar; // XON character to send/recognize (default 0x11 DC1) uint8_t xonChar; // XON character (default 0x11)
uint8_t xoffChar; // XOFF character to send/recognize (default 0x13 DC3) uint8_t xoffChar; // XOFF character (default 0x13)
uint16_t xoffLim; // Assert flow control when rxCount > rxSize - xoffLim uint16_t xoffLim; // Send XOFF when rxCount > rxSize - xoffLim
uint16_t xonLim; // Release flow control when rxCount < xonLim uint16_t xonLim; // Send XON when rxCount < xonLim
// Modem control line shadow (tracks EscapeCommFunction calls) // Modem control shadow
uint8_t dtrState; // Nonzero = DTR is asserted uint8_t dtrState; // DTR line state
uint8_t rtsState; // Nonzero = RTS is asserted (when not flow-controlled) uint8_t rtsState; // RTS line state (when not flow-controlled)
// Error accumulator (sticky CE_* bits, cleared by stacom/GetCommError) // Error accumulator
uint16_t errorFlags; // Accumulated CE_RXOVER, CE_OVERRUN, CE_FRAME, etc. uint16_t errorFlags; // CE_* error flags (sticky until read)
// WM_COMMNOTIFY event notification (stored for API compat, not used) // Event notification
HWND hwndNotify; // Target window for PostMessage (0=disabled) HWND hwndNotify; // Window for WM_COMMNOTIFY
int16_t rxNotifyThresh; // CN_RECEIVE threshold (-1=disabled) int16_t rxNotifyThresh; // CN_RECEIVE threshold (-1=disabled)
int16_t txNotifyThresh; // CN_TRANSMIT threshold (-1=disabled) int16_t txNotifyThresh; // CN_TRANSMIT threshold (-1=disabled)
// ISR chaining and PIC management // ISR state
void (FAR *prevIsr)(void); // Previous ISR vector (restored on unhook) void (FAR *prevIsr)(void); // Previous ISR in chain
uint8_t irqMask; // PIC mask bit for this IRQ (1 << irq) uint8_t irqMask; // PIC mask bit for this IRQ
uint8_t breakState; // Nonzero while break signal is active on line uint8_t breakState; // Break signal active
// Priority transmit (XON/XOFF flow control characters) // Priority transmit
int16_t txImmediate; // -1=none, 0..255=char to send before buffered data int16_t txImmediate; // -1=none, else char to send immediately
// Full DCB copy (returned by getdcb, updated by setcom) // DCB copy for GetCommState
DCB dcb; DCB dcb; // Full DCB for GETDCB/SETCOM
} PortStateT; } PortStateT;
// ----------------------------------------------------------------------- // -----------------------------------------------------------------------
// Global port state array (one entry per COM port, indexed by commId) // Global port state array
// ----------------------------------------------------------------------- // -----------------------------------------------------------------------
extern PortStateT ports[MAX_PORTS]; extern PortStateT ports[MAX_PORTS];
// ISR hit counter for diagnostics (incremented in isr4, wraps at 65535) // -----------------------------------------------------------------------
// Dynamically resolved PostMessage (USER.EXE not loaded at boot)
// -----------------------------------------------------------------------
typedef BOOL (FAR PASCAL *PostMessageProcT)(HWND, UINT, WPARAM, LPARAM);
extern PostMessageProcT pfnPostMessage;
// ISR hit counter for diagnostics
extern volatile uint16_t isrHitCount; extern volatile uint16_t isrHitCount;
// ----------------------------------------------------------------------- // -----------------------------------------------------------------------

55
drv/isr.c
View file

@ -10,6 +10,7 @@
// 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);
@ -20,17 +21,11 @@ void _far _interrupt isr4(void);
// ----------------------------------------------------------------------- // -----------------------------------------------------------------------
// Saved previous ISR vectors for IRQ3 and IRQ4 // Saved previous ISR vectors for IRQ3 and IRQ4
//
// When we hook an IRQ via DPMI, the original vector is saved here so
// unhookIsr can restore it. Only saved/restored on first-use/last-use
// of each IRQ (ref-counted for shared IRQs like COM1+COM3).
// ----------------------------------------------------------------------- // -----------------------------------------------------------------------
static void (_far _interrupt *prevIsr3)(void) = NULL; // Original IRQ3 vector static void (_far _interrupt *prevIsr3)(void) = NULL;
static void (_far _interrupt *prevIsr4)(void) = NULL; // Original IRQ4 vector static void (_far _interrupt *prevIsr4)(void) = NULL;
// Reference counts: how many open ports share each IRQ. // Track how many ports are using each IRQ so we know when to unhook
// hookIsr increments; unhookIsr decrements. Vector is only
// installed/restored when the count transitions through 0.
static int16_t irq3RefCount = 0; static int16_t irq3RefCount = 0;
static int16_t irq4RefCount = 0; static int16_t irq4RefCount = 0;
@ -81,6 +76,46 @@ 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: rxCount crossed threshold from below
if (port->rxNotifyThresh >= 0 && port->rxCount >= (uint16_t)port->rxNotifyThresh) {
notifyBits |= CN_RECEIVE;
}
// CN_TRANSMIT: space available crossed threshold
if (port->txNotifyThresh >= 0) {
uint16_t txFree = port->txSize - port->txCount;
if (txFree >= (uint16_t)port->txNotifyThresh) {
notifyBits |= CN_TRANSMIT;
}
}
// 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
// ----------------------------------------------------------------------- // -----------------------------------------------------------------------
@ -396,6 +431,8 @@ 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);
} }