Bypass 255-byte string limit and batch plain text runs in parser

Add ReadInputBuf to TKPComm for direct PChar reads up to 2048 bytes,
eliminating short string allocation and 8x fewer ReadComm API calls.
Add ParseDataBuf to TKPAnsi with run batching: scans ahead for printable
text runs, computes colors once per run, fills cells in tight loop
without per-character state/wrap checks.

Co-Authored-By: Claude Opus 4.6 <noreply@anthropic.com>
This commit is contained in:
Scott Duensing 2026-03-02 17:15:35 -06:00
parent 64b3962c59
commit 8e3bad86e3
3 changed files with 91 additions and 33 deletions

View file

@ -143,6 +143,7 @@ type
procedure InsertChars(N: Integer);
procedure InsertLines(N: Integer);
procedure ParseData(const S: string);
procedure ParseDataBuf(Buf: PChar; Len: Integer);
procedure ParseSGR;
procedure ProcessChar(Ch: Char);
procedure RecalcCellSize;
@ -171,6 +172,7 @@ type
procedure TickBlink;
procedure Write(const S: string);
procedure WriteDeferred(const S: string);
procedure WriteDeferredBuf(Buf: PChar; Len: Integer);
property CursorCol: Integer read GetCursorCol;
property CursorRow: Integer read GetCursorRow;
published
@ -1554,29 +1556,38 @@ end;
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. }
{ String wrapper -- delegates to ParseDataBuf for actual processing. }
begin
if Length(S) > 0 then
ParseDataBuf(@S[1], Length(S));
end;
procedure TKPAnsi.ParseDataBuf(Buf: PChar; Len: Integer);
{ Process incoming data from a PChar buffer (no string allocation needed). }
{ Fast path batches runs of printable characters: colors are computed once }
{ per run, and cells are filled in a tight loop without per-character state }
{ checks. Run length is bounded by end of input, end of current row, or }
{ next non-printable character -- whichever comes first. }
{ }
{ Does NOT call FlipToScreen -- the caller (Write) calls FlipToScreen }
{ after ParseData returns, ensuring immediate rendering. }
{ Does NOT call FlipToScreen -- the caller handles rendering. }
var
I: Integer;
Ch: Char;
Line: PTermLine;
FGIdx: Byte;
BGIdx: Byte;
RunEnd: Integer;
Remaining: Integer;
begin
Line := nil;
I := 0;
for I := 1 to Length(S) do
while I < Len do
begin
Ch := S[I];
{ Fast path: printable character in normal state }
if (FParseState = psNormal) and (Ch >= ' ') then
if (FParseState = psNormal) and (Buf[I] >= ' ') then
begin
{ Handle wrap at right margin }
if FCursorCol >= FCols then
begin
if FWrapMode then
@ -1597,33 +1608,55 @@ begin
if Line = nil then
Line := FScreen[FCursorRow];
{ Compute colors once for the entire run }
if FAttrBold then
FGIdx := FAttrFG + 8
else
FGIdx := FAttrFG;
BGIdx := FAttrBG;
{ Find run end: stop at control char, end of input, or end of row }
Remaining := FCols - FCursorCol;
RunEnd := I;
while (RunEnd < Len) and (Buf[RunEnd] >= ' ') and
(RunEnd - I < Remaining) do
Inc(RunEnd);
{ Fill cells in tight loop -- no per-character state/wrap checks }
if FAttrReverse then
begin
while I < RunEnd do
begin
Line^.Cells[FCursorCol].Ch := Buf[I];
Line^.Cells[FCursorCol].FG := BGIdx;
Line^.Cells[FCursorCol].BG := FGIdx;
Line^.Cells[FCursorCol].Bold := FAttrBold;
Line^.Cells[FCursorCol].Blink := FAttrBlink;
Inc(FCursorCol);
Inc(I);
end;
end
else
begin
while I < RunEnd do
begin
Line^.Cells[FCursorCol].Ch := Buf[I];
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);
Inc(I);
end;
end;
FDirtyRow[FCursorRow] := True;
end
else
begin
{ Slow path: control chars, escape sequences }
Line := nil;
ProcessChar(Ch);
ProcessChar(Buf[I]);
Inc(I);
end;
end;
@ -1637,7 +1670,6 @@ begin
FScrollbarDirty := True;
FAllDirty := True;
end;
end;
@ -2453,6 +2485,13 @@ begin
end;
procedure TKPAnsi.WriteDeferredBuf(Buf: PChar; Len: Integer);
begin
if Len > 0 then
ParseDataBuf(Buf, Len);
end;
{ ----------------------------------------------------------------------- }
{ Component registration }
{ ----------------------------------------------------------------------- }

View file

@ -68,6 +68,7 @@ type
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function ReadInputBuf(Buf: PChar; BufSize: Integer): Integer;
property Input: string read GetInput;
property Output: string write SetOutput;
property InBufferCount: Integer read GetInBufferCount;
@ -273,6 +274,22 @@ begin
end;
function TKPComm.ReadInputBuf(Buf: PChar; BufSize: Integer): Integer;
{ Read up to BufSize bytes into a caller-supplied buffer. Bypasses the }
{ 255-byte short string limit of the Input property, allowing the drain }
{ loop to read 2048+ bytes per call and reducing ReadComm/API overhead. }
var
BytesRead: Integer;
begin
Result := 0;
if not FPortOpen or (FCommId < 0) then
Exit;
BytesRead := ReadComm(FCommId, Buf, BufSize);
if BytesRead > 0 then
Result := BytesRead;
end;
function TKPComm.GetOutBufferCount: Integer;
var
Stat: TComStat;

View file

@ -167,9 +167,11 @@ end;
procedure TMainForm.Run;
const
RenderMs = 50; { Minimum ms between renders during bulk flow (20 fps) }
BufSize = 2048; { Read buffer -- 8x larger than 255-byte string limit }
var
Msg: TMsg;
S: string;
Buf: array[0..BufSize - 1] of Char;
Len: Integer;
HasData: Boolean;
Now: Longint;
LastRenderTick: Longint;
@ -194,16 +196,16 @@ begin
if FDone then
Break;
{ Drain all available serial data before rendering. Batching }
{ many chunks into one render pass avoids per-chunk GDI overhead. }
{ Messages are checked between chunks so keyboard stays responsive.}
{ Drain all available serial data before rendering. Reads up to }
{ 2048 bytes per call, bypassing the 255-byte short string limit. }
{ Messages are checked between chunks so keyboard stays responsive. }
HasData := False;
if FComm.PortOpen then
begin
S := FComm.Input;
while (Length(S) > 0) and not FDone do
Len := FComm.ReadInputBuf(@Buf, BufSize);
while (Len > 0) and not FDone do
begin
FAnsi.WriteDeferred(S);
FAnsi.WriteDeferredBuf(@Buf, Len);
HasData := True;
{ Check for messages between chunks }
while PeekMessage(Msg, 0, 0, 0, pm_Remove or pm_NoYield) do
@ -216,7 +218,7 @@ begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
S := FComm.Input;
Len := FComm.ReadInputBuf(@Buf, BufSize);
end;
end;