View Issue Details

IDProjectCategoryView StatusLast Update
0037716FPCRTLpublic2020-09-29 00:37
ReporterAndrey "Croco" Stolyarov Assigned ToTomas Hajny  
PrioritynormalSeverityminorReproducibilityalways
Status closedResolutionfixed 
OSLinux 
Product Version3.2.0 
Summary0037716: SeekEof fails on pipelines, FIFOs and sockets (quick fix attached)
DescriptionSeekEof detects unseekable streams incorrectly, tries to call do_seek on unseekable streams and doesn't check nor handle for its failure, so it fails to work on pipelines, FIFOs and sockets (but still works on terminals and disk files).

Details are posted on the forum: https://forum.lazarus.freepascal.org/index.php/topic,51353.0.html
Steps To ReproduceThe simple program that counts the sum of numbers read from stdin (up to EOF)

program SimpleSum;
var
    sum, count, n: longint;
begin
    sum := 0;
    count := 0;
    while not SeekEof do
    begin
        read(n);
        sum := sum + n;
        count := count + 1
    end;
    writeln(count, ' ', sum)
end.

It works when the stdin is not redirected, as well as if it is redirected from a disk file, but it doesn't work for pipelines, like this:

   echo "1 2 3 4 5" | ./sum
Additional InformationThe file text.inc containing the fix is added. The fix is obvious: after the call to do_seek procedure, check for the error and in case of error, fall back to what is done for unseekable streams. With the fix, SeekEof works on any type of a text stream.

However, I'd like to point out that the very function "Do_IsDevice" looks like a nonsense for me, and I don't understand why SeekOf tries to restore the position at all. So the fix can be made better and the function SeekEof -- shorter.
TagsNo tags attached.
Fixed in Revision46853, 46864, 46946
FPCOldBugId
FPCTarget-
Attached Files

Activities

Andrey "Croco" Stolyarov

2020-09-07 11:23

reporter  

text.inc (69,958 bytes)   
{
    This file is part of the Free Pascal Run time library.
    Copyright (c) 1999-2000 by the Free Pascal development team

    See the file COPYING.FPC, included in this distribution,
    for details about the copyright.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

 **********************************************************************}


{****************************************************************************
                    subroutines For TextFile handling
****************************************************************************}

Procedure FileCloseFunc(Var t:TextRec);
Begin
  Do_Close(t.Handle);
  t.Handle:=UnusedHandle;
End;

Procedure FileReadFunc(var t:TextRec);
Begin
  t.BufEnd:=Do_Read(t.Handle,t.Bufptr,t.BufSize);
  t.BufPos:=0;
End;


Procedure FileWriteFunc(var t:TextRec);
var
  i : longint;
Begin
  { prevent unecessary system call }
  if t.BufPos=0 then
    exit;
  i:=Do_Write(t.Handle,t.Bufptr,t.BufPos);
  if i<>t.BufPos then
    InOutRes:=101;
  t.BufPos:=0;
End;


Procedure FileOpenFunc(var t:TextRec);
var
  Flags : Longint;
Begin
  Case t.mode Of
    fmInput : Flags:=$10000;
    fmOutput : Flags:=$11001;
    fmAppend : Flags:=$10101;
  else
   begin
     InOutRes:=102;
     exit;
   end;
  End;
  Do_Open(t,PFileTextRecChar(@t.Name),Flags,False);
  t.CloseFunc:=@FileCloseFunc;
  t.FlushFunc:=nil;
  if t.Mode=fmInput then
   t.InOutFunc:=@FileReadFunc
  else
   begin
     t.InOutFunc:=@FileWriteFunc;
     { Only install flushing if its a NOT a file, and only check if there
       was no error opening the file, because else we always get a bad
       file handle error 6 (PFV) }
     if (InOutRes=0) and
        Do_Isdevice(t.Handle) then
      t.FlushFunc:=@FileWriteFunc;
   end;
End;

Procedure InitText(Var t : Text);

begin
  FillChar(t,SizeOf(TextRec),0);
{ only set things that are not zero }
  TextRec(t).Handle:=UnusedHandle;
  TextRec(t).mode:=fmClosed;
  TextRec(t).BufSize:=TextRecBufSize;
  TextRec(t).Bufptr:=@TextRec(t).Buffer;
  TextRec(t).OpenFunc:=@FileOpenFunc;
  Case DefaultTextLineBreakStyle Of
    tlbsLF: TextRec(t).LineEnd := #10;
    tlbsCRLF: TextRec(t).LineEnd := #13#10;
    tlbsCR: TextRec(t).LineEnd := #13;
  End;
end;


{$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
Procedure Assign(out t:Text;const s : UnicodeString);
begin
  InitText(t);
{$ifdef FPC_ANSI_TEXTFILEREC}
  TextRec(t).Name:=ToSingleByteFileSystemEncodedFileName(S);
{$else FPC_ANSI_TEXTFILEREC}
  TextRec(t).Name:=S;
{$endif FPC_ANSI_TEXTFILEREC}
  { null terminate, since the name array is regularly used as p(wide)char }
  TextRec(t).Name[high(TextRec(t).Name)]:=#0;
end;
{$endif FPC_HAS_FEATURE_WIDESTRINGS}


{$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
Procedure Assign(out t:Text;const s: RawByteString);
Begin
  InitText(t);
{$ifdef FPC_ANSI_TEXTFILEREC}
  { ensure the characters in the record's filename are encoded correctly }
  TextRec(t).Name:=ToSingleByteFileSystemEncodedFileName(S);
{$else FPC_ANSI_TEXTFILEREC}
  TextRec(t).Name:=S;
{$endif FPC_ANSI_TEXTFILEREC}
  { null terminate, since the name array is regularly used as p(wide)char }
  TextRec(t).Name[high(TextRec(t).Name)]:=#0;
End;
{$endif FPC_HAS_FEATURE_ANSISTRINGS}


Procedure Assign(out t:Text;const s: ShortString);
Begin
{$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
  Assign(t,AnsiString(s));
{$else FPC_HAS_FEATURE_ANSISTRINGS}
  InitText(t);
  { warning: no encoding support }
  TextRec(t).Name:=s;
  { null terminate, since the name array is regularly used as p(wide)char }
  TextRec(t).Name[high(TextRec(t).Name)]:=#0;
{$endif FPC_HAS_FEATURE_ANSISTRINGS}
End;


Procedure Assign(out t:Text;const p: PAnsiChar);
Begin
{$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
  Assign(t,AnsiString(p));
{$else FPC_HAS_FEATURE_ANSISTRINGS}
  { no use in making this the one that does the work, since the name field is
    limited to 255 characters anyway }
  Assign(t,strpas(p));
{$endif FPC_HAS_FEATURE_ANSISTRINGS}
End;


Procedure Assign(out t:Text;const c: AnsiChar);
Begin
{$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
  Assign(t,AnsiString(c));
{$else FPC_HAS_FEATURE_ANSISTRINGS}
  Assign(t,ShortString(c));
{$endif FPC_HAS_FEATURE_ANSISTRINGS}
End;


Procedure Close(var t : Text);[IOCheck];
Begin
  if InOutRes<>0 then
   Exit;
  case TextRec(t).mode of
    fmInput,fmOutput,fmAppend:
      Begin
        { Write pending buffer }
        If Textrec(t).Mode=fmoutput then
          FileFunc(TextRec(t).InOutFunc)(TextRec(t));
{$ifdef FPC_HAS_FEATURE_CONSOLEIO}
        { Only close functions not connected to stdout.}
        If ((TextRec(t).Handle<>StdInputHandle) and
            (TextRec(t).Handle<>StdOutputHandle) and
            (TextRec(t).Handle<>StdErrorHandle)) Then
{$endif FPC_HAS_FEATURE_CONSOLEIO}
          FileFunc(TextRec(t).CloseFunc)(TextRec(t));
        TextRec(t).mode := fmClosed;
        { Reset buffer for safety }
        TextRec(t).BufPos:=0;
        TextRec(t).BufEnd:=0;
      End
    else inOutRes := 103;
  End;
End;


Procedure OpenText(var t : Text;mode,defHdl:Longint);
Begin
  Case TextRec(t).mode Of {This gives the fastest code}
   fmInput,fmOutput,fmInOut : Close(t);
   fmClosed : ;
  else
   Begin
     InOutRes:=102;
     exit;
   End;
  End;
  TextRec(t).mode:=mode;
  TextRec(t).bufpos:=0;
  TextRec(t).bufend:=0;

{$ifdef FPC_HAS_CPSTRING}
{$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
  { if no codepage is yet assigned then assign default ansi codepage }
  TextRec(t).CodePage:=TranslatePlaceholderCP(TextRec(t).CodePage);
{$else FPC_HAS_FEATURE_ANSISTRINGS}
  TextRec(t).CodePage:=0;
{$endif FPC_HAS_FEATURE_ANSISTRINGS}
{$endif FPC_HAS_CPSTRING}
  FileFunc(TextRec(t).OpenFunc)(TextRec(t));
  { reset the mode to closed when an error has occurred }
  if InOutRes<>0 then
   TextRec(t).mode:=fmClosed;
End;


Procedure Rewrite(var t : Text);[IOCheck];
Begin
  If InOutRes<>0 then
   exit;
  OpenText(t,fmOutput,1);
End;


Procedure Reset(var t : Text);[IOCheck];
Begin
  If InOutRes<>0 then
   exit;
  OpenText(t,fmInput,0);
End;


Procedure Append(var t : Text);[IOCheck];
Begin
  If InOutRes<>0 then
   exit;
  OpenText(t,fmAppend,1);
End;


Procedure Flush(var t : Text);[IOCheck];
Begin
  If InOutRes<>0 then
   exit;
  if TextRec(t).mode<>fmOutput then
   begin
     if TextRec(t).mode=fmInput then
      InOutRes:=105
     else
      InOutRes:=103;
     exit;
   end;
{ Not the flushfunc but the inoutfunc should be used, because that
  writes the data, flushfunc doesn't need to be assigned }
  FileFunc(TextRec(t).InOutFunc)(TextRec(t));
End;


Procedure Erase(var t:Text);[IOCheck];
Begin
  if InOutRes<>0 then
    exit;
  if TextRec(t).mode<>fmClosed then
    begin
      InOutRes:=102;
      exit;
    end;
  Do_Erase(PFileTextRecChar(@TextRec(t).Name),false);
End;


{$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
Procedure Rename(var t : Text;const s : unicodestring);[IOCheck];
{$ifdef FPCRTL_FILESYSTEM_SINGLE_BYTE_API}
var
  fs: RawByteString;
{$endif FPCRTL_FILESYSTEM_SINGLE_BYTE_API}
Begin
  if InOutRes<>0 then
    exit;
  if TextRec(t).mode<>fmClosed then
    begin
      InOutRes:=102;
      exit;
    end;
{$ifdef FPCRTL_FILESYSTEM_SINGLE_BYTE_API}
  { it's slightly faster to convert the unicodestring here to rawbytestring
    than doing it in do_rename(), because here we still know the length }
  fs:=ToSingleByteFileSystemEncodedFileName(s);
  Do_Rename(PFileTextRecChar(@TextRec(t).Name),PAnsiChar(fs),false,true);
  If InOutRes=0 then
     TextRec(t).Name:=fs
{$else FPCRTL_FILESYSTEM_SINGLE_BYTE_API}
  Do_Rename(PFileTextRecChar(@TextRec(t).Name),PUnicodeChar(S),false,false);
  If InOutRes=0 then
{$ifdef FPC_ANSI_TEXTTextRec}
    TextRec(t).Name:=ToSingleByteFileSystemEncodedFileName(s);
{$else FPC_ANSI_TEXTFILEREC}
    TextRec(t).Name:=s
{$endif FPC_ANSI_TEXTFILEREC}
{$endif FPCRTL_FILESYSTEM_SINGLE_BYTE_API}
End;
{$endif FPC_HAS_FEATURE_WIDESTRINGS}



{$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
Procedure Rename(var t : Text;const s : rawbytestring);[IOCheck];
var
{$ifdef FPCRTL_FILESYSTEM_SINGLE_BYTE_API}
  fs: RawByteString;
  pdst: PAnsiChar;
{$else FPCRTL_FILESYSTEM_SINGLE_BYTE_API}
  fs: UnicodeString;
  pdst: PUnicodeChar;
{$endif FPCRTL_FILESYSTEM_SINGLE_BYTE_API}
  dstchangeable: boolean;
Begin
  if InOutRes<>0 then
    exit;
  if TextRec(t).mode<>fmClosed then
    begin
      InOutRes:=102;
      exit;
    end;
{$ifdef FPCRTL_FILESYSTEM_SINGLE_BYTE_API}
  dstchangeable:=false;
  pdst:=PAnsiChar(s);
  if TranslatePlaceholderCP(StringCodePage(s))<>DefaultFileSystemCodePage then
    begin
      fs:=ToSingleByteFileSystemEncodedFileName(s);
      pdst:=PAnsiChar(fs);
      dstchangeable:=true;
    end
  else
    fs:=s;
{$else FPCRTL_FILESYSTEM_SINGLE_BYTE_API}
   { it's slightly faster to convert the rawbytestring here to unicodestring
     than doing it in do_rename, because here we still know the length }
   fs:=unicodestring(s);
   pdst:=PUnicodeChar(fs);
   dstchangeable:=true;
{$endif FPCRTL_FILESYSTEM_SINGLE_BYTE_API}
  Do_Rename(PFileTextRecChar(@TextRec(t).Name),pdst,false,dstchangeable);
  If InOutRes=0 then
{$if defined(FPC_ANSI_TEXTTextRec) and not defined(FPCRTL_FILESYSTEM_SINGLE_BYTE_API)}
    TextRec(t).Name:=ToSingleByteFileSystemEncodedFileName(fs)
{$else FPC_ANSI_TEXTTextRec and not FPCRTL_FILESYSTEM_SINGLE_BYTE_API}
    TextRec(t).Name:=fs
{$endif FPC_ANSI_TEXTTextRec and not FPCRTL_FILESYSTEM_SINGLE_BYTE_API}
End;
{$endif FPC_HAS_FEATURE_ANSISTRINGS}


Procedure Rename(var t : Text;const s : ShortString);[IOCheck];
{$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
Begin
  Rename(t,AnsiString(s));
End;
{$else FPC_HAS_FEATURE_ANSISTRINGS}
var
  p : array[0..255] Of Char;
Begin
  Move(s[1],p,Length(s));
  p[Length(s)]:=#0;
  Rename(t,Pchar(@p));
End;
{$endif FPC_HAS_FEATURE_ANSISTRINGS}

Procedure Rename(var t:Text;const p:PAnsiChar);
{$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
Begin
  Rename(t,AnsiString(p));
End;
{$else FPC_HAS_FEATURE_ANSISTRINGS}
var
  len: SizeInt;
Begin
  if InOutRes<>0 then
    exit;
  if TextRec(t).mode<>fmClosed then
    begin
      InOutRes:=102;
      exit;
    end;
  Do_Rename(PFileTextRecChar(@TextRec(t).Name),p,false,false);
  { check error code of do_rename }
  if InOutRes=0 then
    begin
      len:=min(StrLen(p),high(TextRec(t).Name));
      Move(p^,TextRec(t).Name,len);
      TextRec(t).Name[len]:=#0;
    end;
End;
{$endif FPC_HAS_FEATURE_ANSISTRINGS}

Procedure Rename(var t : Text;const c : AnsiChar);[IOCheck];
{$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
Begin
  Rename(t,AnsiString(c));
End;
{$else FPC_HAS_FEATURE_ANSISTRINGS}
var
  p : array[0..1] Of AnsiChar;
Begin
  p[0]:=c;
  p[1]:=#0;
  Rename(t,PAnsiChar(@p));
End;
{$endif FPC_HAS_FEATURE_ANSISTRINGS}

Function Eof(Var t: Text): Boolean;[IOCheck];
Begin
  If (InOutRes<>0) then
   exit(true);
  if (TextRec(t).mode<>fmInput) Then
   begin
     if TextRec(t).mode=fmOutput then
      InOutRes:=104
     else
      InOutRes:=103;
     exit(true);
   end;
  If TextRec(t).BufPos>=TextRec(t).BufEnd Then
   begin
     FileFunc(TextRec(t).InOutFunc)(TextRec(t));
     If TextRec(t).BufPos>=TextRec(t).BufEnd Then
      exit(true);
   end;
  Eof:=CtrlZMarksEOF and (TextRec(t).Bufptr^[TextRec(t).BufPos]=#26);
end;


Function Eof:Boolean;
Begin
  Eof:=Eof(Input);
End;


Function SeekEof (Var t : Text) : Boolean;
var
  oldfilepos : Int64;
  oldbufpos, oldbufend : SizeInt;
  reads: longint;
  isdevice: boolean;
Begin
  If (InOutRes<>0) then
   exit(true);
  if (TextRec(t).mode<>fmInput) Then
   begin
     if TextRec(t).mode=fmOutPut then
      InOutRes:=104
     else
      InOutRes:=103;
     exit(true);
   end;
  { try to save the current position in the file, seekeof() should not move }
  { the current file position (JM)                                          }
  oldbufpos := TextRec(t).BufPos;
  oldbufend := TextRec(t).BufEnd;
  reads := 0;
  oldfilepos := -1;
  isdevice := Do_IsDevice(TextRec(t).handle);
  repeat
    If TextRec(t).BufPos>=TextRec(t).BufEnd Then
     begin
       { signal that the we will have to do a seek }
       inc(reads);
       if not isdevice and
          (reads = 1) then
         begin
           oldfilepos := Do_FilePos(TextRec(t).handle) - TextRec(t).BufEnd;
           { the following 2 lines added by Croco }
	   if InOutRes <> 0 then
	     isdevice := true;
           InOutRes:=0;
         end;
       FileFunc(TextRec(t).InOutFunc)(TextRec(t));
       If TextRec(t).BufPos>=TextRec(t).BufEnd Then
        begin
          { if we only did a read in which we didn't read anything, the }
          { old buffer is still valid and we can simply restore the     }
          { pointers (JM)                                               }
          dec(reads);
          SeekEof := true;
          break;
        end;
     end;
    case TextRec(t).Bufptr^[TextRec(t).BufPos] of
      #26 :
        if CtrlZMarksEOF then
          begin
            SeekEof := true;
            break;
          end;
     #10,#13,#9,' ' :
       ;
    else
     begin
       SeekEof := false;
       break;
     end;
    end;
   inc(TextRec(t).BufPos);
  until false;
  { restore file position if not working with a device }
  if not isdevice then
    { if we didn't modify the buffer, simply restore the BufPos and BufEnd  }
    { (the latter because it's now probably set to zero because nothing was }
    {  was read anymore)                                                    }
    if (reads = 0) then
      begin
        TextRec(t).BufPos:=oldbufpos;
        TextRec(t).BufEnd:=oldbufend;
      end
    { otherwise return to the old filepos and reset the buffer }
    else
      begin
        do_seek(TextRec(t).handle,oldfilepos);
        { the following if, replacing 3 old lines, added by Croco }
	if InOutRes = 0 then
	  begin
            FileFunc(TextRec(t).InOutFunc)(TextRec(t));
            TextRec(t).BufPos:=oldbufpos;
	  end
	else
          InOutRes:=0;
      end;
End;


Function SeekEof : Boolean;
Begin
  SeekEof:=SeekEof(Input);
End;


Function Eoln(var t:Text) : Boolean;
Begin
  If (InOutRes<>0) then
   exit(true);
  if (TextRec(t).mode<>fmInput) Then
   begin
     if TextRec(t).mode=fmOutPut then
      InOutRes:=104
     else
      InOutRes:=103;
     exit(true);
   end;
  If TextRec(t).BufPos>=TextRec(t).BufEnd Then
   begin
     FileFunc(TextRec(t).InOutFunc)(TextRec(t));
     If TextRec(t).BufPos>=TextRec(t).BufEnd Then
      exit(true);
   end;
  if CtrlZMarksEOF and (TextRec (T).BufPtr^[TextRec (T).BufPos] = #26) then
   exit (true);
  Eoln:=(TextRec(t).Bufptr^[TextRec(t).BufPos] in [#10,#13]);
End;


Function Eoln : Boolean;
Begin
  Eoln:=Eoln(Input);
End;


Function SeekEoln (Var t : Text) : Boolean;
Begin
  If (InOutRes<>0) then
   exit(true);
  if (TextRec(t).mode<>fmInput) Then
   begin
     if TextRec(t).mode=fmOutput then
      InOutRes:=104
     else
      InOutRes:=103;
     exit(true);
   end;
  repeat
    If TextRec(t).BufPos>=TextRec(t).BufEnd Then
     begin
       FileFunc(TextRec(t).InOutFunc)(TextRec(t));
       If TextRec(t).BufPos>=TextRec(t).BufEnd Then
        exit(true);
     end;
    case TextRec(t).Bufptr^[TextRec(t).BufPos] of
         #26: if CtrlZMarksEOF then
               exit (true);
     #10,#13 : exit(true);
      #9,' ' : ;
    else
     exit(false);
    end;
    inc(TextRec(t).BufPos);
  until false;
End;


Function SeekEoln : Boolean;
Begin
  SeekEoln:=SeekEoln(Input);
End;


Procedure SetTextBuf(Var F : Text; Var Buf; Size : SizeInt);
Begin
  TextRec(f).BufPtr:=@Buf;
  TextRec(f).BufSize:=Size;
  TextRec(f).BufPos:=0;
  TextRec(f).BufEnd:=0;
End;

Procedure SetTextLineEnding(Var f:Text; Ending:string);
Begin
  TextRec(F).LineEnd:=Ending;
End;

function GetTextCodePage(var T: Text): TSystemCodePage;
begin
{$if defined(FPC_HAS_CPSTRING) and defined(FPC_HAS_FEATURE_ANSISTRINGS)}
  GetTextCodePage:=TextRec(T).CodePage;
{$else}
  GetTextCodePage:=0;
{$endif}
end;


procedure SetTextCodePage(var T: Text; CodePage: TSystemCodePage);
begin
{$if defined(FPC_HAS_CPSTRING) and defined(FPC_HAS_FEATURE_ANSISTRINGS)}
  TextRec(T).CodePage:=TranslatePlaceholderCP(CodePage);
{$endif}
end;


Function fpc_get_input:PText;compilerproc;
begin
  fpc_get_input:=@Input;
end;


Function fpc_get_output:PText;compilerproc;
begin
  fpc_get_output:=@Output;
end;


Procedure fpc_textinit_iso(var t : Text;nr : DWord);compilerproc;
begin
{$ifdef FPC_HAS_FEATURE_COMMANDARGS}
  assign(t,paramstr(nr));
{$else FPC_HAS_FEATURE_COMMANDARGS}
  { primitive workaround for targets supporting no command line arguments,
    invent some file name, try to avoid complex procedures like concating strings which might
    pull-in bigger parts of the rtl }
  assign(t,chr((nr mod 16)+65));
{$endif FPC_HAS_FEATURE_COMMANDARGS}
end;


Procedure fpc_textinit_filename_iso(var t : Text;nr : DWord;const filename : string);compilerproc;
begin
{$ifdef FPC_HAS_FEATURE_COMMANDARGS}
  if paramstr(nr)='' then
    assign(t,filename+'.txt')
  else
    assign(t,paramstr(nr));
{$else FPC_HAS_FEATURE_COMMANDARGS}
  { primitive workaround for targets supporting no command line arguments,
    invent some file name, try to avoid complex procedures like concating strings which might
    pull-in bigger parts of the rtl }
  assign(t,chr((nr mod 16)+65));
{$endif FPC_HAS_FEATURE_COMMANDARGS}
end;



Procedure fpc_textclose_iso(var t : Text);compilerproc;
begin
  { reset inout result as this procedure is only called by the compiler and no I/O checking is carried out,
    so further I/O does not fail }
  inoutres:=0;
  close(t);
  inoutres:=0;
end;


{*****************************************************************************
                               Write(Ln)
*****************************************************************************}

Procedure fpc_WriteBuffer(var f:Text;const b;len:SizeInt);
var
  p   : pchar;
  left,
  idx : SizeInt;
begin
  p:=pchar(@b);
  idx:=0;
  left:=TextRec(f).BufSize-TextRec(f).BufPos;
  while len>left do
   begin
     move(p[idx],TextRec(f).Bufptr^[TextRec(f).BufPos],left);
     dec(len,left);
     inc(idx,left);
     inc(TextRec(f).BufPos,left);
     FileFunc(TextRec(f).InOutFunc)(TextRec(f));
     left:=TextRec(f).BufSize-TextRec(f).BufPos;
   end;
  move(p[idx],TextRec(f).Bufptr^[TextRec(f).BufPos],len);
  inc(TextRec(f).BufPos,len);
end;


Procedure fpc_WriteBlanks(var f:Text;len:longint);
var
  left : longint;
begin
  left:=TextRec(f).BufSize-TextRec(f).BufPos;
  while len>left do
   begin
     FillChar(TextRec(f).Bufptr^[TextRec(f).BufPos],left,' ');
     dec(len,left);
     inc(TextRec(f).BufPos,left);
     FileFunc(TextRec(f).InOutFunc)(TextRec(f));
     left:=TextRec(f).BufSize-TextRec(f).BufPos;
   end;
  FillChar(TextRec(f).Bufptr^[TextRec(f).BufPos],len,' ');
  inc(TextRec(f).BufPos,len);
end;


Procedure fpc_Write_End(var f:Text); iocheck; compilerproc;
begin
  if TextRec(f).FlushFunc<>nil then
   FileFunc(TextRec(f).FlushFunc)(TextRec(f));
end;


Procedure fpc_Writeln_End(var f:Text); iocheck; compilerproc;
begin
  If InOutRes <> 0 then exit;
  case TextRec(f).mode of
    fmOutput { fmAppend gets changed to fmOutPut in do_open (JM) }:
      begin
        { Write EOL }
        fpc_WriteBuffer(f,TextRec(f).LineEnd[1],length(TextRec(f).LineEnd));
        { Flush }
        if TextRec(f).FlushFunc<>nil then
          FileFunc(TextRec(f).FlushFunc)(TextRec(f));
      end;
    fmInput: InOutRes:=105
    else InOutRes:=103;
  end;
end;


Procedure fpc_Write_Text_ShortStr(Len : Longint;var f : Text;const s : String); iocheck; [Public,Alias:'FPC_WRITE_TEXT_SHORTSTR']; compilerproc;
Begin
  If (InOutRes<>0) then
   exit;
  case TextRec(f).mode of
    fmOutput { fmAppend gets changed to fmOutPut in do_open (JM) }:
      begin
        If Len>Length(s) Then
          fpc_WriteBlanks(f,Len-Length(s));
        fpc_WriteBuffer(f,s[1],Length(s));
      end;
    fmInput: InOutRes:=105
    else InOutRes:=103;
  end;
End;


Procedure fpc_Write_Text_ShortStr_Iso(Len : Longint;var f : Text;const s : String); iocheck; [Public,Alias:'FPC_WRITE_TEXT_SHORTSTR_ISO']; compilerproc;
Begin
  If (InOutRes<>0) then
   exit;
  case TextRec(f).mode of
    fmOutput { fmAppend gets changed to fmOutPut in do_open (JM) }:
      begin
        { default value? }
        If Len=-1 then
          Len:=length(s);

        If Len>Length(s) Then
          begin
            fpc_WriteBlanks(f,Len-Length(s));
            fpc_WriteBuffer(f,s[1],Length(s));
          end
        else
          fpc_WriteBuffer(f,s[1],Len);
      end;
    fmInput: InOutRes:=105
    else InOutRes:=103;
  end;
End;


{ provide local access to write_str }
procedure Write_Str(Len : Longint;var f : Text;const s : String); iocheck; [external name 'FPC_WRITE_TEXT_SHORTSTR'];

{ provide local access to write_str_iso }
procedure Write_Str_Iso(Len : Longint;var f : Text;const s : String); iocheck; [external name 'FPC_WRITE_TEXT_SHORTSTR_ISO'];

Procedure fpc_Write_Text_Pchar_as_Array(Len : Longint;var f : Text;const s : array of char; zerobased: boolean = true); iocheck; compilerproc;
var
  ArrayLen : longint;
  p : pchar;
Begin
  If (InOutRes<>0) then
   exit;
  case TextRec(f).mode of
    fmOutput { fmAppend gets changed to fmOutPut in do_open (JM) }:
      begin
        p:=pchar(@s);
        if zerobased then
          begin
            { can't use StrLen, since that one could try to read past the end }
            { of the heap (JM)                                                }
            ArrayLen:=IndexByte(p^,high(s)+1,0);
            { IndexByte returns -1 if not found (JM) }
            if ArrayLen = -1 then
              ArrayLen := high(s)+1;
          end
        else
          ArrayLen := high(s)+1;
        If Len>ArrayLen Then
          fpc_WriteBlanks(f,Len-ArrayLen);
        fpc_WriteBuffer(f,p^,ArrayLen);
      end;
    fmInput: InOutRes:=105
    else InOutRes:=103;
  end;
End;


Procedure fpc_Write_Text_Pchar_as_Array_Iso(Len : Longint;var f : Text;const s : array of char; zerobased: boolean = true); iocheck; compilerproc;
var
  ArrayLen : longint;
  p : pchar;
Begin
  If (InOutRes<>0) then
   exit;
  case TextRec(f).mode of
    fmOutput { fmAppend gets changed to fmOutPut in do_open (JM) }:
      begin
        p:=pchar(@s);
        if zerobased then
          begin
            { can't use StrLen, since that one could try to read past the end }
            { of the heap (JM)                                                }
            ArrayLen:=IndexByte(p^,high(s)+1,0);
            { IndexByte returns -1 if not found (JM) }
            if ArrayLen = -1 then
              ArrayLen := high(s)+1;
          end
        else
          ArrayLen := high(s)+1;

        { default value? }
        If Len=-1 then
          Len:=ArrayLen;

        If Len>ArrayLen Then
          begin
            fpc_WriteBlanks(f,Len-ArrayLen);
            fpc_WriteBuffer(f,p^,ArrayLen);
          end
        else
          fpc_WriteBuffer(f,p^,Len);
      end;
    fmInput: InOutRes:=105
    else InOutRes:=103;
  end;
End;


Procedure fpc_Write_Text_PChar_As_Pointer(Len : Longint;var f : Text;p : PChar); iocheck; compilerproc;
var
  PCharLen : longint;
Begin
  If (p=nil) or (InOutRes<>0) then
   exit;
  case TextRec(f).mode of
    fmOutput { fmAppend gets changed to fmOutPut in do_open (JM) }:
      begin
        PCharLen:=StrLen(p);
        If Len>PCharLen Then
          fpc_WriteBlanks(f,Len-PCharLen);
        fpc_WriteBuffer(f,p^,PCharLen);
      end;
    fmInput: InOutRes:=105
    else InOutRes:=103;
  end;
End;


Procedure fpc_Write_Text_AnsiStr (Len : Longint; Var f : Text; const S : RawByteString); iocheck; [Public,alias:'FPC_WRITE_TEXT_ANSISTR']; compilerproc;
{
 Writes a AnsiString to the Text file T
}
var
  SLen: longint;
  a: RawByteString;
begin
  If (InOutRes<>0) then
   exit;
  case TextRec(f).mode of
    fmOutput { fmAppend gets changed to fmOutPut in do_open (JM) }:
      begin
        SLen:=Length(s);
        If Len>SLen Then
          fpc_WriteBlanks(f,Len-SLen);
        if SLen > 0 then
          begin
            {$if defined(FPC_HAS_CPSTRING) and defined(FPC_HAS_FEATURE_ANSISTRINGS)}
            if TextRec(f).CodePage<>TranslatePlaceholderCP(StringCodePage(S)) then
              begin
                a:=fpc_AnsiStr_To_AnsiStr(S,TextRec(f).CodePage);
                fpc_WriteBuffer(f,PAnsiChar(a)^,Length(a));
              end
            else
            {$endif}
            fpc_WriteBuffer(f,PAnsiChar(s)^,SLen);
          end;
      end;
    fmInput: InOutRes:=105
    else InOutRes:=103;
  end;
end;


{$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
Procedure fpc_Write_Text_UnicodeStr (Len : Longint; Var f : Text; const S : UnicodeString); iocheck; compilerproc;
{
 Writes a UnicodeString to the Text file T
}
var
  SLen: longint;
  a: RawByteString;
begin
  If (pointer(S)=nil) or (InOutRes<>0) then
   exit;
  case TextRec(f).mode of
    fmOutput { fmAppend gets changed to fmOutPut in do_open (JM) }:
      begin
        SLen:=Length(s);
        If Len>SLen Then
          fpc_WriteBlanks(f,Len-SLen);
        {$ifdef FPC_HAS_CPSTRING}
        WideStringManager.Unicode2AnsiMoveProc(PUnicodeChar(S),a,TextRec(f).CodePage,SLen);
        {$else}
        a:=s;
        {$endif FPC_HAS_CPSTRING}
        { length(a) can be > slen, e.g. after utf-16 -> utf-8 }
        fpc_WriteBuffer(f,PAnsiChar(a)^,Length(a));
      end;
    fmInput: InOutRes:=105
    else InOutRes:=103;
  end;
end;
{$endif FPC_HAS_FEATURE_WIDESTRINGS}


{$ifndef FPC_WIDESTRING_EQUAL_UNICODESTRING}
Procedure fpc_Write_Text_WideStr (Len : Longint; Var f : Text; const S : WideString); iocheck; compilerproc;
{
 Writes a WideString to the Text file T
}
var
  SLen: longint;
  a: RawByteString;
begin
  If (pointer(S)=nil) or (InOutRes<>0) then
   exit;
  case TextRec(f).mode of
    fmOutput { fmAppend gets changed to fmOutPut in do_open (JM) }:
      begin
        SLen:=Length(s);
        If Len>SLen Then
          fpc_WriteBlanks(f,Len-SLen);
        {$ifdef FPC_HAS_CPSTRING}
        widestringmanager.Wide2AnsiMoveProc(PWideChar(s), a, TextRec(f).CodePage, SLen);
        {$else}
        a:=s;
        {$endif}
        { length(a) can be > slen, e.g. after utf-16 -> utf-8 }
        fpc_WriteBuffer(f,PAnsiChar(a)^,Length(a));
      end;
    fmInput: InOutRes:=105
    else InOutRes:=103;
  end;
end;
{$endif FPC_WIDESTRING_EQUAL_UNICODESTRING}

Procedure fpc_Write_Text_SInt(Len : Longint;var t : Text;l : ValSInt); iocheck; compilerproc;
var
  s : String;
Begin
  If (InOutRes<>0) then
   exit;
  Str(l,s);
  Write_Str(Len,t,s);
End;


Procedure fpc_Write_Text_UInt(Len : Longint;var t : Text;l : ValUInt); iocheck; compilerproc;
var
  s : String;
Begin
  If (InOutRes<>0) then
   exit;
  Str(L,s);
  Write_Str(Len,t,s);
End;


Procedure fpc_Write_Text_SInt_Iso(Len : Longint;var t : Text;l : ValSInt); iocheck; compilerproc;
var
  s : String;
Begin
  If (InOutRes<>0) then
   exit;
  Str(l,s);
  { default value? }
  if len=-1 then
    len:=11
  else if len<length(s) then
    len:=length(s);
  Write_Str_Iso(Len,t,s);
End;


Procedure fpc_Write_Text_UInt_Iso(Len : Longint;var t : Text;l : ValUInt); iocheck; compilerproc;
var
  s : String;
Begin
  If (InOutRes<>0) then
   exit;
  Str(L,s);
  { default value? }
  if len=-1 then
    len:=11
  else if len<length(s) then
    len:=length(s);
  Write_Str_Iso(Len,t,s);
End;

{$ifndef CPU64}
procedure fpc_write_text_qword(len : longint;var t : text;q : qword); iocheck; compilerproc;
var
  s : string;
begin
  if (InOutRes<>0) then
   exit;
  str(q,s);
  write_str(len,t,s);
end;


procedure fpc_write_text_int64(len : longint;var t : text;i : int64); iocheck; compilerproc;
var
  s : string;
begin
  if (InOutRes<>0) then
   exit;
  str(i,s);
  write_str(len,t,s);
end;


procedure fpc_write_text_qword_iso(len : longint;var t : text;q : qword); iocheck; compilerproc;
var
  s : string;
begin
  if (InOutRes<>0) then
    exit;
  str(q,s);
  { default value? }
  if len=-1 then
    len:=20
  else if len<length(s) then
    len:=length(s);
  write_str_iso(len,t,s);
end;


procedure fpc_write_text_int64_iso(len : longint;var t : text;i : int64); iocheck; compilerproc;
var
  s : string;
begin
  if (InOutRes<>0) then
   exit;
  str(i,s);
  { default value? }
  if len=-1 then
    len:=20
  else if len<length(s) then
    len:=length(s);
  write_str_iso(len,t,s);
end;

{$endif CPU64}

{$if defined(CPU16) or defined(CPU8)}
procedure fpc_write_text_longword(len : longint;var t : text;q : longword); iocheck; compilerproc;
var
  s : string;
begin
  if (InOutRes<>0) then
   exit;
  str(q,s);
  write_str(len,t,s);
end;


procedure fpc_write_text_longint(len : longint;var t : text;i : longint); iocheck; compilerproc;
var
  s : string;
begin
  if (InOutRes<>0) then
   exit;
  str(i,s);
  write_str(len,t,s);
end;


procedure fpc_write_text_longword_iso(len : longint;var t : text;q : longword); iocheck; compilerproc;
var
  s : string;
begin
  if (InOutRes<>0) then
    exit;
  str(q,s);
  { default value? }
  if len=-1 then
    len:=11
  else if len<length(s) then
    len:=length(s);
  write_str_iso(len,t,s);
end;


procedure fpc_write_text_longint_iso(len : longint;var t : text;i : longint); iocheck; compilerproc;
var
  s : string;
begin
  if (InOutRes<>0) then
   exit;
  str(i,s);
  { default value? }
  if len=-1 then
    len:=11
  else if len<length(s) then
    len:=length(s);
  write_str_iso(len,t,s);
end;


procedure fpc_write_text_word(len : longint;var t : text;q : word); iocheck; compilerproc;
var
  s : string;
begin
  if (InOutRes<>0) then
   exit;
  str(q,s);
  write_str(len,t,s);
end;


procedure fpc_write_text_smallint(len : longint;var t : text;i : smallint); iocheck; compilerproc;
var
  s : string;
begin
  if (InOutRes<>0) then
   exit;
  str(i,s);
  write_str(len,t,s);
end;


procedure fpc_write_text_word_iso(len : longint;var t : text;q : word); iocheck; compilerproc;
var
  s : string;
begin
  if (InOutRes<>0) then
    exit;
  str(q,s);
  { default value? }
  if len=-1 then
    len:=11
  else if len<length(s) then
    len:=length(s);
  write_str_iso(len,t,s);
end;


procedure fpc_write_text_smallint_iso(len : longint;var t : text;i : smallint); iocheck; compilerproc;
var
  s : string;
begin
  if (InOutRes<>0) then
   exit;
  str(i,s);
  { default value? }
  if len=-1 then
    len:=11
  else if len<length(s) then
    len:=length(s);
  write_str_iso(len,t,s);
end;
{$endif CPU16 or CPU8}

{$ifndef FPUNONE}
Procedure fpc_Write_Text_Float(rt,fixkomma,Len : Longint;var t : Text;r : ValReal); iocheck; compilerproc;
var
  s : String;
Begin
  If (InOutRes<>0) then
   exit;
  Str_real(Len,fixkomma,r,treal_type(rt),s);
  Write_Str(Len,t,s);
End;


Procedure fpc_Write_Text_Float_iso(rt,fixkomma,Len : Longint;var t : Text;r : ValReal); iocheck; compilerproc;
var
  s : String;
Begin
  If (InOutRes<>0) then
   exit;
  Str_real_iso(Len,fixkomma,r,treal_type(rt),s);
  Write_Str(Len,t,s);
End;
{$endif}

procedure fpc_write_text_enum(typinfo,ord2strindex:pointer;len:sizeint;var t:text;ordinal:longint); iocheck; compilerproc;

var
    s:string;

begin
{$ifdef EXCLUDE_COMPLEX_PROCS}
  runerror(219);
{$else EXCLUDE_COMPLEX_PROCS}
  if textrec(t).mode<>fmoutput then
    begin
      if textrec(t).mode=fminput then
        inoutres:=105
      else
        inoutres:=103;
      exit;
    end;
  inoutres := fpc_shortstr_enum_intern(ordinal, len, typinfo, ord2strindex, s);
  if (inoutres <> 0) then
    exit;
  fpc_writeBuffer(t,s[1],length(s));
{$endif EXCLUDE_COMPLEX_PROCS}
end;

Procedure fpc_Write_Text_Currency(fixkomma,Len : Longint;var t : Text;c : Currency); iocheck; compilerproc;
{$ifdef EXCLUDE_COMPLEX_PROCS}
      begin
        runerror(217);
      end;
{$else EXCLUDE_COMPLEX_PROCS}
var
  s : String;
Begin
  If (InOutRes<>0) then
   exit;
  str(c:Len:fixkomma,s);
  Write_Str(Len,t,s);
End;
{$endif EXCLUDE_COMPLEX_PROCS}

Procedure fpc_Write_Text_Boolean(Len : Longint;var t : Text;b : Boolean); iocheck; compilerproc;
Begin
  If (InOutRes<>0) then
   exit;
{ Can't use array[boolean] because b can be >0 ! }
  if b then
    Write_Str(Len,t,'TRUE')
  else
    Write_Str(Len,t,'FALSE');
End;


Procedure fpc_Write_Text_Boolean_Iso(Len : Longint;var t : Text;b : Boolean); iocheck; compilerproc;
Begin
  If (InOutRes<>0) then
   exit;
  { Can't use array[boolean] because b can be >0 ! }
  { default value? }
  If Len=-1 then
    Len:=5;
  if b then
    Write_Str_Iso(Len,t,'true')
  else
    Write_Str_Iso(Len,t,'false');
End;


Procedure fpc_Write_Text_Char(Len : Longint;var t : Text;c : Char); iocheck; compilerproc;
Begin
  If (InOutRes<>0) then
    exit;
  if (TextRec(t).mode<>fmOutput) Then
   begin
     if TextRec(t).mode=fmClosed then
      InOutRes:=103
     else
      InOutRes:=105;
     exit;
   end;
  If Len>1 Then
    fpc_WriteBlanks(t,Len-1);
  If TextRec(t).BufPos>=TextRec(t).BufSize Then
    FileFunc(TextRec(t).InOutFunc)(TextRec(t));
  TextRec(t).Bufptr^[TextRec(t).BufPos]:=c;
  Inc(TextRec(t).BufPos);
End;


Procedure fpc_Write_Text_Char_Iso(Len : Longint;var t : Text;c : Char); iocheck; compilerproc;
Begin
  If (InOutRes<>0) then
    exit;
  if (TextRec(t).mode<>fmOutput) Then
   begin
     if TextRec(t).mode=fmClosed then
      InOutRes:=103
     else
      InOutRes:=105;
     exit;
   end;
  { default value? }
  If Len=-1 then
    Len:=1;
  If Len>1 Then
    fpc_WriteBlanks(t,Len-1)
  else If Len<1 Then
    exit;
  If TextRec(t).BufPos>=TextRec(t).BufSize Then
    FileFunc(TextRec(t).InOutFunc)(TextRec(t));
  TextRec(t).Bufptr^[TextRec(t).BufPos]:=c;
  Inc(TextRec(t).BufPos);
End;


{$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
Procedure fpc_Write_Text_WideChar(Len : Longint;var t : Text;c : WideChar); iocheck; compilerproc;
var
  a: RawByteString;
Begin
  If (InOutRes<>0) then
    exit;
  if (TextRec(t).mode<>fmOutput) Then
   begin
     if TextRec(t).mode=fmClosed then
      InOutRes:=103
     else
      InOutRes:=105;
     exit;
   end;
  If Len>1 Then
    fpc_WriteBlanks(t,Len-1);
  If TextRec(t).BufPos>=TextRec(t).BufSize Then
    FileFunc(TextRec(t).InOutFunc)(TextRec(t));
  { a widechar can be translated into more than a single ansichar }
  {$ifdef FPC_HAS_CPSTRING}
  widestringmanager.Wide2AnsiMoveProc(@c,a,TextRec(t).CodePage,1);
  {$else}
  a:=c;
  {$endif}
  fpc_WriteBuffer(t,PAnsiChar(a)^,Length(a));
End;
{$endif FPC_HAS_FEATURE_WIDESTRINGS}


{*****************************************************************************
                                Read(Ln)
*****************************************************************************}

Function NextChar(var f:Text;var s:string):Boolean;
begin
  NextChar:=false;
  if (TextRec(f).BufPos<TextRec(f).BufEnd) then
   if not (CtrlZMarksEOF) or (TextRec(f).Bufptr^[TextRec(f).BufPos]<>#26) then
    begin
     if length(s)<high(s) then
      begin
        inc(s[0]);
        s[length(s)]:=TextRec(f).BufPtr^[TextRec(f).BufPos];
      end;
     Inc(TextRec(f).BufPos);
     If TextRec(f).BufPos>=TextRec(f).BufEnd Then
      FileFunc(TextRec(f).InOutFunc)(TextRec(f));
     NextChar:=true;
   end;
end;


Function IgnoreSpaces(var f:Text):Boolean;
{
  Removes all leading spaces,tab,eols from the input buffer, returns true if
  the buffer is empty
}
var
  s : string;
begin
  s:='';
  IgnoreSpaces:=false;
  { Return false when already at EOF }
  if (TextRec(f).BufPos>=TextRec(f).BufEnd) then
   exit;
(* Check performed separately to avoid accessing memory outside buffer *)
  if CtrlZMarksEOF and (TextRec(f).Bufptr^[TextRec(f).BufPos]=#26) then
   exit;
  while (TextRec(f).Bufptr^[TextRec(f).BufPos] <= ' ') do
   begin
     if not NextChar(f,s) then
      exit;
     { EOF? }
     if (TextRec(f).BufPos>=TextRec(f).BufEnd) then
      break;
     if CtrlZMarksEOF and (TextRec(f).Bufptr^[TextRec(f).BufPos]=#26) then
      break;
   end;
  IgnoreSpaces:=true;
end;


procedure ReadNumeric(var f:Text;var s:string);
{
  Read numeric input, if buffer is empty then return True
}
begin
  repeat
    if not NextChar(f,s) then
      exit;
  until (length(s)=high(s)) or (TextRec(f).BufPtr^[TextRec(f).BufPos] <= ' ');
end;


function CheckRead(var f:Text):Boolean;
begin
  CheckRead:=False;
{ Check error and if file is open and load buf if empty }
  If (InOutRes<>0) then
    exit;
  if (TextRec(f).mode<>fmInput) Then
    begin
      case TextRec(f).mode of
        fmOutPut,fmAppend:
          InOutRes:=104;
        else
          InOutRes:=103;
      end;
      exit;
    end;
  if TextRec(f).BufPos>=TextRec(f).BufEnd Then
    FileFunc(TextRec(f).InOutFunc)(TextRec(f));
  CheckRead:=True;
end;


procedure ReadInteger(var f:Text;var s:string);
{
 Ignore leading blanks (incl. EOF) and return the first characters matching
 an integer in the format recognized by the Val procedure:
      [+-]?[0-9]+
   or [+-]?(0x|0X|x|X)[0-9A-Za-z]+
   or [+-]?&[0-7]+
   or [+-]?%[0-1]+
 A partial match may be returned, e.g.: '' or '+' or '0x'.
 Used by some fpc_Read_Text_*_Iso functions which implement the read()
 standard function in ISO mode.
}
var
  Base: Integer;
begin
    s := '';
    with TextRec(f) do begin
        if not CheckRead(f) then Exit;

        IgnoreSpaces(f);

        if BufPos >= BufEnd then Exit;
        if BufPtr^[BufPos] in ['+','-'] then
            NextChar(f,s);

        Base := 10;

        if BufPos >= BufEnd then Exit;
        if BufPtr^[BufPos] in ['$','x','X','%','&'] then
        begin
            case BufPtr^[BufPos] of
              '$','x','X': Base := 16;
	      '%': Base := 2;
              '&': Base := 8;
	    end;
            NextChar(f,s);
        end else if BufPtr^[BufPos] = '0' then
        begin
            NextChar(f,s);
            if BufPos >= BufEnd then Exit;
            if BufPtr^[BufPos] in ['x','X'] then
            begin
                Base := 16;
                NextChar(f,s);
            end;
        end;

        while (BufPos < BufEnd) and (Length(s) < High(s)) do
            if (((Base = 2) and (BufPtr^[BufPos] in ['0'..'1']))
	      or ((Base = 8) and (BufPtr^[BufPos] in ['0'..'7']))
              or ((Base = 10) and (BufPtr^[BufPos] in ['0'..'9']))
              or ((Base = 16) and (BufPtr^[BufPos] in ['0'..'9','a'..'f','A'..'F']))) then
                 NextChar(f,s)
	    else Exit;
   end;
end;


procedure ReadReal(var f:Text;var s:string);
{
 Ignore leading blanks (incl. EOF) and return the first characters matching
 a float number in the format recognized by the Val procedure:
      [+-]?([0-9]+)?\.[0-9]+([eE][+-]?[0-9]+)?
   or [+-]?[0-9]+\.([0-9]+)?([eE][+-]?[0-9]+)?
 A partial match may be returned, e.g.: '' or '+' or '.' or '1e' or even '+.'.
 Used by some fpc_Read_Text_*_Iso functions which implement the read()
 standard function in ISO mode.
}
var digit: Boolean;
begin
    s := '';
    with TextRec(f) do begin
        if not CheckRead(f) then Exit;

        IgnoreSpaces(f);

        if BufPos >= BufEnd then Exit;
        if BufPtr^[BufPos] in ['+','-'] then
            NextChar(f,s);

        digit := false;
        if BufPos >= BufEnd then Exit;
	if BufPtr^[BufPos] in ['0'..'9'] then
        begin
            digit := true;
            repeat
                NextChar(f,s);
                if (BufPos >= BufEnd) or (Length(s) >= High(s)) then Exit;
            until not (BufPtr^[BufPos] in ['0'..'9']);
        end;

        if BufPtr^[BufPos] = '.' then
        begin
            NextChar(f,s);

            if (BufPos >= BufEnd) or (Length(s) >= High(s)) then Exit;
	    if BufPtr^[BufPos] in ['0'..'9'] then
            begin
                digit := true;
                repeat
                    NextChar(f,s);
                    if (BufPos >= BufEnd) or (Length(s) >= High(s)) then Exit;
                until not (BufPtr^[BufPos] in ['0'..'9']);
            end;
        end;

        {at least one digit is required on the left of the exponent}
        if digit and (BufPtr^[BufPos] in ['e','E']) then
        begin
            NextChar(f,s);

            if (BufPos >= BufEnd) or (Length(s) >= High(s)) then Exit;
            if BufPtr^[BufPos] in ['+','-'] then
                NextChar(f,s);

	    while (BufPos < BufEnd) and (Length(s) < High(s)) do
                if BufPtr^[BufPos] in ['0'..'9'] then
                    NextChar(f,s)
                else break;
        end;
    end;
end;


Procedure fpc_Read_End(var f:Text);[Public,Alias:'FPC_READ_END']; iocheck; compilerproc;
begin
  if TextRec(f).FlushFunc<>nil then
   FileFunc(TextRec(f).FlushFunc)(TextRec(f));
end;


Procedure fpc_ReadLn_End(var f : Text);[Public,Alias:'FPC_READLN_END']; iocheck; compilerproc;
var prev: char;
Begin
  If not CheckRead(f) then
    exit;
  if (TextRec(f).BufPos>=TextRec(f).BufEnd) then
    { Flush if set }
    begin
      if (TextRec(f).FlushFunc<>nil) then
        FileFunc(TextRec(f).FlushFunc)(TextRec(f));
      exit;
    end;
  if CtrlZMarksEOF and (TextRec (F).BufPtr^ [TextRec (F).BufPos] = #26) then
   Exit;
  repeat
    prev := TextRec(f).BufPtr^[TextRec(f).BufPos];
    inc(TextRec(f).BufPos);
{ no system uses #10#13 as line seperator (#10 = *nix, #13 = Mac, }
{ #13#10 = Dos), so if we've got #10, we can safely exit          }
    if prev = #10 then
      exit;
    {$ifdef MACOS}
    if prev = #13 then
      {StdInput on macos never have dos line ending, so this is safe.}
      if TextRec(f).Handle = StdInputHandle then
        exit;
    {$endif MACOS}
    if TextRec(f).BufPos>=TextRec(f).BufEnd Then
      begin
        FileFunc(TextRec(f).InOutFunc)(TextRec(f));
        if (TextRec(f).BufPos>=TextRec(f).BufEnd) then
          { Flush if set }
          begin
           if (TextRec(f).FlushFunc<>nil) then
             FileFunc(TextRec(f).FlushFunc)(TextRec(f));
           exit;
         end;
      end;
   if CtrlZMarksEOF and (TextRec (F).BufPtr^ [TextRec (F).BufPos] = #26) then
    Exit;
   if (prev=#13) then
     { is there also a #10 after it? }
     begin
       if (TextRec(f).BufPtr^[TextRec(f).BufPos]=#10) then
         { yes, skip that one as well }
         inc(TextRec(f).BufPos);
       exit;
     end;
  until false;
End;


Procedure fpc_ReadLn_End_Iso(var f : Text);[Public,Alias:'FPC_READLN_END_ISO']; iocheck; compilerproc;
var prev: char;
Begin
  If not CheckRead(f) then
    exit;
  if (TextRec(f).BufPos>=TextRec(f).BufEnd) then
    { Flush if set }
    begin
      if (TextRec(f).FlushFunc<>nil) then
        FileFunc(TextRec(f).FlushFunc)(TextRec(f));
      exit;
    end;
  if TextRec (F).BufPtr^ [TextRec (F).BufPos] = #26 then
    begin
      inc(TextRec(f).BufPos);
      Exit;
    end;
  repeat
    prev := TextRec(f).BufPtr^[TextRec(f).BufPos];
    inc(TextRec(f).BufPos);
{ no system uses #10#13 as line seperator (#10 = *nix, #13 = Mac, }
{ #13#10 = Dos), so if we've got #10, we can safely exit          }
    if prev = #10 then
      exit;
    {$ifdef MACOS}
    if prev = #13 then
      {StdInput on macos never have dos line ending, so this is safe.}
      if TextRec(f).Handle = StdInputHandle then
        exit;
    {$endif MACOS}
    if TextRec(f).BufPos>=TextRec(f).BufEnd Then
      begin
        FileFunc(TextRec(f).InOutFunc)(TextRec(f));
        if (TextRec(f).BufPos>=TextRec(f).BufEnd) then
          { Flush if set }
          begin
           if (TextRec(f).FlushFunc<>nil) then
             FileFunc(TextRec(f).FlushFunc)(TextRec(f));
           exit;
         end;
      end;
   if TextRec (F).BufPtr^ [TextRec (F).BufPos] = #26 then
     begin
       inc(TextRec(f).BufPos);
       Exit;
     end;
   if (prev=#13) then
     { is there also a #10 after it? }
     begin
       if (TextRec(f).BufPtr^[TextRec(f).BufPos]=#10) then
         { yes, skip that one as well }
         inc(TextRec(f).BufPos);
       exit;
     end;
  until false;
End;


Function ReadPCharLen(var f:Text;s:pchar;maxlen:longint):longint;
var
  sPos,len : Longint;
  p,startp,maxp : pchar;
  end_of_string:boolean;
Begin
{$ifdef EXCLUDE_COMPLEX_PROCS}
  runerror(219);
{$else EXCLUDE_COMPLEX_PROCS}
  ReadPCharLen:=0;
  If not CheckRead(f) then
    exit;
{ Read maximal until Maxlen is reached }
  sPos:=0;
  end_of_string:=false;
  repeat
    If TextRec(f).BufPos>=TextRec(f).BufEnd Then
     begin
       FileFunc(TextRec(f).InOutFunc)(TextRec(f));
       If TextRec(f).BufPos>=TextRec(f).BufEnd Then
         break;
     end;
    p:=@TextRec(f).Bufptr^[TextRec(f).BufPos];
    if SPos+TextRec(f).BufEnd-TextRec(f).BufPos>MaxLen then
     maxp:=@TextRec(f).BufPtr^[TextRec(f).BufPos+MaxLen-SPos]
    else
     maxp:=@TextRec(f).Bufptr^[TextRec(f).BufEnd];
    startp:=p;
  { find stop character }
    while p<maxp do
      begin
        { Optimization: Do a quick check for a control character first }
        if (p^<' ') then
          begin
            if (p^ in [#10,#13]) or
               (ctrlZmarkseof and (p^=#26)) then
              begin
                end_of_string:=true;
                break;
              end;
          end;
        inc(p);
      end;
  { calculate read bytes }
    len:=p-startp;
    inc(TextRec(f).BufPos,Len);
    Move(startp^,s[sPos],Len);
    inc(sPos,Len);
  until (spos=MaxLen) or end_of_string;
  ReadPCharLen:=spos;
{$endif EXCLUDE_COMPLEX_PROCS}
End;


Procedure fpc_Read_Text_ShortStr(var f : Text;out s : String); iocheck; compilerproc;
Begin
  s[0]:=chr(ReadPCharLen(f,pchar(@s[1]),high(s)));
End;


Procedure fpc_Read_Text_PChar_As_Pointer(var f : Text; const s : PChar); iocheck; compilerproc;
Begin
  pchar(s+ReadPCharLen(f,s,$7fffffff))^:=#0;
End;


Procedure fpc_Read_Text_PChar_As_Array(var f : Text;out s : array of char; zerobased: boolean = false); iocheck; compilerproc;
var
  len: longint;
Begin
  len := ReadPCharLen(f,pchar(@s),high(s)+1);
  if zerobased and
     (len > high(s)) then
    len := high(s);
  if (len <= high(s)) then
    s[len] := #0;
End;


{$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
Procedure fpc_Read_Text_AnsiStr(var f : Text;out s : RawByteString{$ifdef FPC_HAS_CPSTRING};cp : TSystemCodePage{$endif FPC_HAS_CPSTRING}); [public, alias: 'FPC_READ_TEXT_ANSISTR']; iocheck; compilerproc;
var
  slen,len : SizeInt;
Begin
  slen:=0;
  Repeat
    // SetLength will reallocate the length.
    SetLength(s,slen+255);
    len:=ReadPCharLen(f,pchar(Pointer(s)+slen),255);
    inc(slen,len);
  Until len<255;
  // Set actual length
  SetLength(s,Slen);
  {$ifdef FPC_HAS_CPSTRING}
  SetCodePage(s,TextRec(f).CodePage,false);
  if cp<>TextRec(f).CodePage then
    s:=fpc_AnsiStr_To_AnsiStr(s,cp);
  {$endif FPC_HAS_CPSTRING}
End;

Procedure fpc_Read_Text_AnsiStr_Intern(var f : Text;out s : RawByteString{$ifdef FPC_HAS_CPSTRING};cp : TSystemCodePage{$endif FPC_HAS_CPSTRING}); [external name 'FPC_READ_TEXT_ANSISTR'];
{$endif FPC_HAS_FEATURE_ANSISTRINGS}


{$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
Procedure fpc_Read_Text_UnicodeStr(var f : Text;out us : UnicodeString); iocheck; compilerproc;
var
  s: RawByteString;
Begin
  // all standard input is assumed to be ansi-encoded
  fpc_Read_Text_AnsiStr_Intern(f,s{$ifdef FPC_HAS_CPSTRING},DefaultSystemCodePage{$endif FPC_HAS_CPSTRING});
  // Convert to unicodestring
  {$ifdef FPC_HAS_CPSTRING}
  widestringmanager.Ansi2UnicodeMoveProc(PAnsiChar(s),StringCodePage(s),us,Length(s));
  {$else}
  us:=s;
  {$endif}
End;
{$endif FPC_HAS_FEATURE_WIDESTRINGS}

{$ifndef FPC_WIDESTRING_EQUAL_UNICODESTRING}
Procedure fpc_Read_Text_WideStr(var f : Text;out ws : WideString); iocheck; compilerproc;
var
  s: RawByteString;
Begin
  // all standard input is assumed to be ansi-encoded
  fpc_Read_Text_AnsiStr_Intern(f,s{$ifdef FPC_HAS_CPSTRING},DefaultSystemCodePage{$endif FPC_HAS_CPSTRING});
  // Convert to widestring
  {$ifdef FPC_HAS_CPSTRING}
  widestringmanager.Ansi2WideMoveProc(PAnsiChar(s),StringCodePage(s),ws,Length(s));
  {$else}
  ws:=s;
  {$endif}
End;
{$endif FPC_WIDESTRING_EQUAL_UNICODESTRING}

procedure fpc_Read_Text_Char(var f : Text; out c: char); [public, alias: 'FPC_READ_TEXT_CHAR']; iocheck; compilerproc;
Begin
  c:=#0;
  If not CheckRead(f) then
    exit;
  If TextRec(f).BufPos>=TextRec(f).BufEnd Then
    begin
      c := #26;
      exit;
    end;
  c:=TextRec(f).Bufptr^[TextRec(f).BufPos];
  inc(TextRec(f).BufPos);
end;

procedure fpc_Read_Text_Char_intern(var f : Text; out c: char); iocheck; [external name 'FPC_READ_TEXT_CHAR'];


function fpc_GetBuf_Text(var f : Text) : pchar; iocheck; compilerproc;
Begin
  Result:=@TextRec(f).Bufptr^[TextRec(f).BufEnd];
  if TextRec(f).mode=fmOutput then
    exit;
  If not CheckRead(f) then
    exit;
  If TextRec(f).BufPos>=TextRec(f).BufEnd Then
    exit;
  Result:=@TextRec(f).Bufptr^[TextRec(f).BufPos];
end;


{$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
procedure fpc_Read_Text_WideChar(var f : Text; out wc: widechar); iocheck;compilerproc;
var
  ws: widestring;
  i: longint;
  { maximum code point length is 6 characters (with UTF-8) }
  str: array[0..5] of char;
Begin
  fillchar(str[0],sizeof(str),0);
  for i:=low(str) to high(str) do
    begin
      fpc_Read_Text_Char_intern(f,str[i]);
      case widestringmanager.CodePointLengthProc(@str[0],i+1) of
        -1: { possibly incomplete code point, try with an extra character }
           ;
        0: { null character }
          begin
            wc:=#0;
            exit;
          end;
        else
          begin
            { valid code point -> convert to widestring}
            {$ifdef FPC_HAS_CPSTRING}
            widestringmanager.Ansi2WideMoveProc(@str[0],TextRec(f).CodePage,ws,i+1);
            {$else}
            widestringmanager.Ansi2WideMoveProc(@str[0],DefaultSystemCodePage,ws,i+1);
            {$endif}
            { has to be exactly one widechar }
            if length(ws)=1 then
              begin
                wc:=ws[1];
                exit
              end
            else
              break;
          end;
      end;
    end;
  { invalid widechar input }
  inoutres:=106;
end;
{$endif FPC_HAS_FEATURE_WIDESTRINGS}


procedure fpc_Read_Text_Char_Iso(var f : Text; out c: char); iocheck;compilerproc;
Begin
  c:=' ';
  If not CheckRead(f) then
    exit;
  If TextRec(f).BufPos>=TextRec(f).BufEnd Then
    begin
      c:=' ';
      exit;
    end;
  c:=TextRec(f).Bufptr^[TextRec(f).BufPos];
  inc(TextRec(f).BufPos);
  if c=#13 then
    begin
      c:=' ';
      If not CheckRead(f) or
        (TextRec(f).BufPos>=TextRec(f).BufEnd) then
        exit;
      If TextRec(f).Bufptr^[TextRec(f).BufPos]=#10 then
        inc(TextRec(f).BufPos);

      { ignore #26 following a new line }
      If not CheckRead(f) or
        (TextRec(f).BufPos>=TextRec(f).BufEnd) then
        exit;
      If TextRec(f).Bufptr^[TextRec(f).BufPos]=#26 then
        inc(TextRec(f).BufPos);
    end
  else if c=#10 then
    begin
      c:=' ';
      { ignore #26 following a new line }
      If not CheckRead(f) or
        (TextRec(f).BufPos>=TextRec(f).BufEnd) then
        exit;
      If TextRec(f).Bufptr^[TextRec(f).BufPos]=#26 then
        inc(TextRec(f).BufPos);
      end
  else if c=#26 then
    c:=' ';
end;


Procedure fpc_Read_Text_SInt(var f : Text; out l : ValSInt); iocheck; compilerproc;
var
  hs   : String;
  code : ValSInt;
Begin
  l:=0;
  If not CheckRead(f) then
    exit;
  hs:='';
  if IgnoreSpaces(f) then
   begin
     { When spaces were found and we are now at EOF,
       then we return 0 }
     if (TextRec(f).BufPos>=TextRec(f).BufEnd) then
      exit;
     if CtrlZMarksEOF and (TextRec(f).Bufptr^[TextRec(f).BufPos]=#26) then
      exit;
     ReadNumeric(f,hs);
   end;
   if (hs = '') then
    L := 0
   else
    begin
     Val(hs,l,code);
     if Code <> 0 then
      InOutRes:=106;
    end;
End;


Procedure fpc_Read_Text_SInt_Iso(var f : Text; out l : ValSInt); iocheck; compilerproc;
var
  hs   : String;
  code : ValSInt;
Begin
    ReadInteger(f,hs);

    Val(hs,l,code);
    if Code <> 0 then
        InOutRes:=106;
End;


Procedure fpc_Read_Text_UInt(var f : Text; out u : ValUInt);  iocheck; compilerproc;
var
  hs   : String;
  code : ValSInt;
Begin
  u:=0;
  If not CheckRead(f) then
    exit;
  hs:='';
  if IgnoreSpaces(f) then
   begin
     { When spaces were found and we are now at EOF,
       then we return 0 }
     if (TextRec(f).BufPos>=TextRec(f).BufEnd) then
      exit;
     ReadNumeric(f,hs);
   end;
   if (hs = '') then
    u := 0
   else
    begin
      val(hs,u,code);
      If code<>0 Then
        InOutRes:=106;
    end;
End;

Procedure fpc_Read_Text_UInt_Iso(var f : Text; out u : ValUInt);  iocheck; compilerproc;
var
  hs   : String;
  code : ValSInt;
Begin
   ReadInteger(f,hs);
   Val(hs,u,code);
   If code<>0 Then
       InOutRes:=106;
End;


{$ifndef FPUNONE}
procedure fpc_Read_Text_Float(var f : Text; out v : ValReal); iocheck; compilerproc;
var
  hs : string;
  code : Word;
begin
  v:=0.0;
  If not CheckRead(f) then
    exit;
  hs:='';
  if IgnoreSpaces(f) then
   begin
     { When spaces were found and we are now at EOF,
       then we return 0 }
     if (TextRec(f).BufPos>=TextRec(f).BufEnd) then
      exit;
     ReadNumeric(f,hs);
   end;
  val(hs,v,code);
  If code<>0 Then
   InOutRes:=106;
end;


procedure fpc_Read_Text_Float_Iso(var f : Text; out v : ValReal); iocheck; compilerproc;
var
  hs : string;
  code : Word;
begin
  ReadReal(f,hs);
  Val(hs,v,code);
  If code<>0 Then
    InOutRes:=106;
end;
{$endif}

procedure fpc_read_text_enum(str2ordindex:pointer;var t:text;out ordinal:longint); iocheck;compilerproc;

var s:string;
    code:valsint;

begin
  if not checkread(t) then
    exit;
  s:='';
  if ignorespaces(t) then
    begin
      { When spaces were found and we are now at EOF, then we return 0 }
      if (TextRec(t).BufPos>=TextRec(t).BufEnd) then
        exit;
      ReadNumeric(t,s);
    end;
  ordinal:=fpc_val_enum_shortstr(str2ordindex,s,code);
  if code<>0 then
   InOutRes:=106;
end;

procedure fpc_Read_Text_Currency(var f : Text; out v : Currency); iocheck; compilerproc;
var
  hs : string;
  code : ValSInt;
begin
{$ifdef FPUNONE}
  v:=0;
{$else}
  v:=0.0;
{$endif}
  If not CheckRead(f) then
    exit;
  hs:='';
  if IgnoreSpaces(f) then
   begin
     { When spaces were found and we are now at EOF,
       then we return 0 }
     if (TextRec(f).BufPos>=TextRec(f).BufEnd) then
      exit;
     ReadNumeric(f,hs);
   end;
  val(hs,v,code);
  If code<>0 Then
   InOutRes:=106;
end;


procedure fpc_Read_Text_Currency_Iso(var f : Text; out v : Currency); iocheck; compilerproc;
var
  hs : string;
  code : ValSInt;
begin
  ReadReal(f,hs);
  Val(hs,v,code);
  If code<>0 Then
   InOutRes:=106;
end;


{$ifndef cpu64}

procedure fpc_Read_Text_QWord(var f : text; out q : qword); iocheck; compilerproc;
var
  hs   : String;
  code : longint;
Begin
  q:=0;
  If not CheckRead(f) then
    exit;
  hs:='';
  if IgnoreSpaces(f) then
   begin
     { When spaces were found and we are now at EOF,
       then we return 0 }
     if (TextRec(f).BufPos>=TextRec(f).BufEnd) then
      exit;
     ReadNumeric(f,hs);
   end;
  val(hs,q,code);
  If code<>0 Then
   InOutRes:=106;
End;

procedure fpc_Read_Text_QWord_Iso(var f : text; out q : qword); iocheck; compilerproc;
var
  hs   : String;
  code : longint;
Begin
   ReadInteger(f,hs);
   Val(hs,q,code);
   If code<>0 Then
       InOutRes:=106;
End;

procedure fpc_Read_Text_Int64(var f : text; out i : int64); iocheck; compilerproc;
var
  hs   : String;
  code : Longint;
Begin
  i:=0;
  If not CheckRead(f) then
    exit;
  hs:='';
  if IgnoreSpaces(f) then
   begin
     { When spaces were found and we are now at EOF,
       then we return 0 }
     if (TextRec(f).BufPos>=TextRec(f).BufEnd) then
      exit;
     ReadNumeric(f,hs);
   end;
  Val(hs,i,code);
  If code<>0 Then
   InOutRes:=106;
End;

procedure fpc_Read_Text_Int64_Iso(var f : text; out i : int64); iocheck; compilerproc;
var
  hs   : String;
  code : Longint;
Begin
    ReadInteger(f,hs);
    Val(hs,i,code);
    If code<>0 Then
       InOutRes:=106;
End;


{$endif CPU64}

{$if defined(CPU16) or defined(CPU8)}
procedure fpc_Read_Text_LongWord(var f : text; out q : longword); iocheck; compilerproc;
var
  hs   : String;
  code : longint;
Begin
  q:=0;
  If not CheckRead(f) then
    exit;
  hs:='';
  if IgnoreSpaces(f) then
   begin
     { When spaces were found and we are now at EOF,
       then we return 0 }
     if (TextRec(f).BufPos>=TextRec(f).BufEnd) then
      exit;
     ReadNumeric(f,hs);
   end;
  val(hs,q,code);
  If code<>0 Then
   InOutRes:=106;
End;

procedure fpc_Read_Text_LongInt(var f : text; out i : longint); iocheck; compilerproc;
var
  hs   : String;
  code : Longint;
Begin
  i:=0;
  If not CheckRead(f) then
    exit;
  hs:='';
  if IgnoreSpaces(f) then
   begin
     { When spaces were found and we are now at EOF,
       then we return 0 }
     if (TextRec(f).BufPos>=TextRec(f).BufEnd) then
      exit;
     ReadNumeric(f,hs);
   end;
  Val(hs,i,code);
  If code<>0 Then
   InOutRes:=106;
End;
{$endif CPU16 or CPU8}



{*****************************************************************************
                              WriteStr/ReadStr
*****************************************************************************}

const
  { pointer to target string }
  StrPtrIndex = 1;
  { temporary destination for writerstr, because the original value of the
    destination may be used in the writestr expression }
  TempWriteStrDestIndex = 9;
  ShortStrLenIndex = 17;
  { how many bytes of the string have been processed already (used for readstr) }
  BytesReadIndex = 17;

procedure WriteStrShort(var t: textrec);
var
  str: pshortstring;
  newbytes,
  oldlen: longint;
begin
  if (t.bufpos=0) then
    exit;
  str:=pshortstring(ppointer(@t.userdata[TempWriteStrDestIndex])^);
  newbytes:=t.BufPos;
  oldlen:=length(str^);
  if (oldlen+t.bufpos > t.userdata[ShortStrLenIndex]) then
    begin
      newbytes:=t.userdata[ShortStrLenIndex]-oldlen;
{$ifdef writestr_iolencheck}
      // GPC only gives an io error if {$no-truncate-strings} is active
      // FPC does not have this setting (it never gives errors when a
      // a string expression is truncated)

      { "disk full" }
      inoutres:=101;
{$endif}
    end;
  setlength(str^,length(str^)+newbytes);
  move(t.bufptr^,str^[oldlen+1],newbytes);
  t.bufpos:=0;
end;


procedure WriteStrShortFlush(var t: textrec);
begin
  { move written data from internal buffer to temporary string (don't move
    directly from buffer to final string, because the temporary string may
    already contain data in case the textbuf was smaller than the string
    length) }
  WriteStrShort(t);
  { move written data to original string }
  move(PPointer(@t.userdata[TempWriteStrDestIndex])^^,
       PPointer(@t.userdata[StrPtrIndex])^^,
       t.userdata[ShortStrLenIndex]+1);
  { free temporary buffer }
  freemem(PPointer(@t.userdata[TempWriteStrDestIndex])^);
end;



{$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
procedure WriteStrAnsi(var t: textrec);
var
  str: pansistring;
  oldlen: longint;
begin
  if (t.bufpos=0) then
    exit;
  str:=pansistring(@t.userdata[TempWriteStrDestIndex]);
  oldlen:=length(str^);
  setlength(str^,oldlen+t.bufpos);
  move(t.bufptr^,str^[oldlen+1],t.bufpos);
  t.bufpos:=0;
end;


procedure WriteStrAnsiFlush(var t: textrec);
begin
  { see comment in WriteStrShortFlush }
  WriteStrAnsi(t);
  pansistring(ppointer(@t.userdata[StrPtrIndex])^)^:=
    pansistring(@t.userdata[TempWriteStrDestIndex])^;
  { free memory/finalize temp }
  pansistring(@t.userdata[TempWriteStrDestIndex])^:='';
end;
{$endif FPC_HAS_FEATURE_ANSISTRINGS}


{$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
function EndOfLastCompleteUTF8CodePoint(var t: textrec): SizeInt;
var
  i, codepointlen: sizeint;
begin
  for i:=t.bufpos-1 downto 0 do
    begin
      { we don't care about combining diacritical marks here: we just want a
        valid UTF-8 codepoint that we can translate to UTF-16. The combining
        diacritical marks can be translated separately }
      codepointlen:=Utf8CodePointLen(pchar(@t.bufptr^[i]),(t.bufpos-1-i)+1,false);
      { complete codepoint -> flush till here }
      if codepointlen>0 then
        begin
          result:=i+codepointlen;
          exit;
        end
    end;
  { all invalid data, or the buffer is too small to be able to deal with the
    complete utf8char -> nothing else to do but to handle the entire buffer
    (and end up with a partial/invalid character) }
  result:=t.bufpos;
end;


procedure WriteStrUnicodeIntern(var t: textrec; flush: boolean);
var
  temp: unicodestring;
  str: punicodestring;
  validend: SizeInt;
begin
  if (t.bufpos=0) then
    exit;
  str:=punicodestring(@t.userdata[TempWriteStrDestIndex]);
  if not flush then
    validend:=EndOfLastCompleteUTF8CodePoint(t)
  else
    validend:=t.bufpos;
  widestringmanager.Ansi2UnicodeMoveProc(@t.bufptr^[0],CP_UTF8,temp,validend);
  str^:=str^+temp;
  dec(t.bufpos,validend);
  { move remainder to the start }
  if t.bufpos<>0 then
    move(t.bufptr^[validend],t.bufptr^[0],t.bufpos);
end;


procedure WriteStrUnicode(var t: textrec);
begin
  WriteStrUnicodeIntern(t,false);
end;


procedure WriteStrUnicodeFlush(var t: textrec);
begin
  { see comment in WriteStrShortFlush }
  WriteStrUnicodeIntern(t,true);
  punicodestring(ppointer(@t.userdata[StrPtrIndex])^)^:=
    punicodestring(@t.userdata[TempWriteStrDestIndex])^;
  { free memory/finalize temp }
  punicodestring(@t.userdata[TempWriteStrDestIndex])^:='';
end;
{$endif FPC_HAS_FEATURE_WIDESTRINGS}

{$ifndef FPC_WIDESTRING_EQUAL_UNICODESTRING}
procedure WriteStrWideIntern(var t: textrec; flush: boolean);
var
  temp: unicodestring;
  str: pwidestring;
  validend: SizeInt;
begin
  if (t.bufpos=0) then
    exit;
  str:=pwidestring(@t.userdata[TempWriteStrDestIndex]);
  if not flush then
    validend:=EndOfLastCompleteUTF8CodePoint(t)
  else
    validend:=t.bufpos;
  widestringmanager.Ansi2UnicodeMoveProc(@t.bufptr^[0],CP_UTF8,temp,validend);
  str^:=str^+temp;
  dec(t.bufpos,validend);
  { move remainder to the start }
  if t.bufpos<>0 then
    move(t.bufptr^[validend],t.bufptr^[0],t.bufpos);
end;


procedure WriteStrWide(var t: textrec);
begin
  WriteStrUnicodeIntern(t,false);
end;


procedure WriteStrWideFlush(var t: textrec);
begin
  { see comment in WriteStrShortFlush }
  WriteStrWideIntern(t,true);
  pwidestring(ppointer(@t.userdata[StrPtrIndex])^)^:=
    pwidestring(@t.userdata[TempWriteStrDestIndex])^;
  { free memory/finalize temp }
  finalize(pwidestring(@t.userdata[TempWriteStrDestIndex])^);
end;
{$endif FPC_WIDESTRING_EQUAL_UNICODESTRING}

procedure SetupWriteStrCommon(out t: textrec; cp: TSystemCodePage);
begin
  // initialise
  Assign(text(t),'');
  t.mode:=fmOutput;
  t.OpenFunc:=nil;
  t.CloseFunc:=nil;
{$if defined(FPC_HAS_CPSTRING) and defined(FPC_HAS_FEATURE_ANSISTRINGS)}
  t.CodePage:=TranslatePlaceholderCP(cp);
{$endif}
end;


procedure fpc_SetupWriteStr_Shortstr(var ReadWriteStrText: text; var s: shortstring); compilerproc;
begin
  SetupWriteStrCommon(TextRec(ReadWriteStrText),DefaultSystemCodePage);
  PPointer(@TextRec(ReadWriteStrText).userdata[StrPtrIndex])^:=@s;

  { temporary destination (see comments for TempWriteStrDestIndex) }
  getmem(PPointer(@TextRec(ReadWriteStrText).userdata[TempWriteStrDestIndex])^,high(s)+1);
  setlength(pshortstring(ppointer(@TextRec(ReadWriteStrText).userdata[TempWriteStrDestIndex])^)^,0);

  TextRec(ReadWriteStrText).userdata[ShortStrLenIndex]:=high(s);
  TextRec(ReadWriteStrText).InOutFunc:=@WriteStrShort;
  TextRec(ReadWriteStrText).FlushFunc:=@WriteStrShortFlush;
end;


{$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
procedure fpc_SetupWriteStr_Ansistr(var ReadWriteStrText: text; var s: ansistring; cp: TSystemCodePage); compilerproc;
begin
  { destination rawbytestring -> use CP_ACP }
  if cp=CP_NONE then
    cp:=CP_ACP;
  SetupWriteStrCommon(TextRec(ReadWriteStrText),cp);
  PPointer(@TextRec(ReadWriteStrText).userdata[StrPtrIndex])^:=@s;

  { temp destination ansistring, nil = empty string }
  PPointer(@TextRec(ReadWriteStrText).userdata[TempWriteStrDestIndex])^:=nil;

  TextRec(ReadWriteStrText).InOutFunc:=@WriteStrAnsi;
  TextRec(ReadWriteStrText).FlushFunc:=@WriteStrAnsiFlush;
end;
{$endif FPC_HAS_FEATURE_ANSISTRINGS}


{$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
procedure fpc_SetupWriteStr_Unicodestr(var ReadWriteStrText: text; var s: unicodestring); compilerproc;
begin
  SetupWriteStrCommon(TextRec(ReadWriteStrText),CP_UTF8);
  PPointer(@TextRec(ReadWriteStrText).userdata[StrPtrIndex])^:=@s;

  { temp destination unicodestring, nil = empty string }
  PPointer(@TextRec(ReadWriteStrText).userdata[TempWriteStrDestIndex])^:=nil;

  TextRec(ReadWriteStrText).InOutFunc:=@WriteStrUnicode;
  TextRec(ReadWriteStrText).FlushFunc:=@WriteStrUnicodeFlush;
end;
{$endif FPC_HAS_FEATURE_WIDESTRINGS}


{$ifndef FPC_WIDESTRING_EQUAL_UNICODESTRING}
procedure fpc_SetupWriteStr_Widestr(var ReadWriteStrText: text; var s: widestring); compilerproc;
begin
  SetupWriteStrCommon(TextRec(ReadWriteStrText),CP_UTF8);
  PPointer(@TextRec(ReadWriteStrText).userdata[StrPtrIndex])^:=@s;

  { temp destination widestring }
  PWideString(@TextRec(ReadWriteStrText).userdata[TempWriteStrDestIndex])^:='';

  TextRec(ReadWriteStrText).InOutFunc:=@WriteStrWide;
  TextRec(ReadWriteStrText).FlushFunc:=@WriteStrWideFlush;
end;
{$endif FPC_WIDESTRING_EQUAL_UNICODESTRING}


{$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
procedure ReadAnsiStrFinal(var t: textrec);
begin
  { finalise the temp ansistring }
  PAnsiString(@t.userdata[StrPtrIndex])^ := '';
end;
{$endif FPC_HAS_FEATURE_ANSISTRINGS}


procedure ReadStrCommon(var t: textrec; strdata: pchar; len: sizeint);
var
  newbytes: sizeint;
begin
  newbytes := len - PSizeInt(@t.userdata[BytesReadIndex])^;
  if (t.BufSize <= newbytes) then
    newbytes := t.BufSize;
  if (newbytes > 0) then
    begin
      move(strdata[PSizeInt(@t.userdata[BytesReadIndex])^],t.BufPtr^,newbytes);
      inc(PSizeInt(@t.userdata[BytesReadIndex])^,newbytes);
    end;
  t.BufEnd:=newbytes;
  t.BufPos:=0;
end;


procedure ReadStrAnsi(var t: textrec);
var
  str: pansistring;
begin
  str:=pansistring(@t.userdata[StrPtrIndex]);
  ReadStrCommon(t,@str^[1],length(str^));
end;


procedure SetupReadStrCommon(out t: textrec; cp: TSystemCodePage);
begin
  // initialise
  Assign(text(t),'');
  t.mode:=fmInput;
  t.OpenFunc:=nil;
  t.CloseFunc:=nil;
{$if defined(FPC_HAS_CPSTRING) and defined(FPC_HAS_FEATURE_ANSISTRINGS)}
  t.CodePage:=TranslatePlaceholderCP(cp);
  {$endif}
  PSizeInt(@t.userdata[BytesReadIndex])^:=0;
end;


{$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
procedure fpc_SetupReadStr_Ansistr(var ReadWriteStrText: text; const s: ansistring); [public, alias: 'FPC_SETUPREADSTR_ANSISTR']; compilerproc;
begin
  SetupReadStrCommon(TextRec(ReadWriteStrText),StringCodePage(s));
  { we need a reference, because 's' may be a temporary expression }
  PAnsiString(@TextRec(ReadWriteStrText).userdata[StrPtrIndex])^:=s;
  TextRec(ReadWriteStrText).InOutFunc:=@ReadStrAnsi;
  { this is called at the end, by fpc_read_end }
  TextRec(ReadWriteStrText).FlushFunc:=@ReadAnsiStrFinal;
end;

procedure fpc_SetupReadStr_Ansistr_Intern(var ReadWriteStrText: text; const s: rawbytestring); [external name 'FPC_SETUPREADSTR_ANSISTR'];
{$endif FPC_HAS_FEATURE_ANSISTRINGS}


procedure fpc_SetupReadStr_Shortstr(var ReadWriteStrText: text; const s: shortstring); compilerproc;
begin
  { the reason we convert the short string to ansistring, is because the semantics of
    readstr are defined as:

    *********************
    Apart from the restrictions imposed by requirements given in this clause,
    the execution of readstr(e,v 1 ,...,v n ) where e denotes a
    string-expression and v 1 ,...,v n denote variable-accesses possessing the
    char-type (or a subrange of char-type), the integer-type (or a subrange of
    integer-type), the real-type, a fixed-string-type, or a
    variable-string-type, shall be equivalent to

            begin
            rewrite(f);
            writeln(f, e);
            reset(f);
            read(f, v 1 ,...,v n )
            end
    *********************

    This means that any side effects caused by the evaluation of v 1 .. v n
    must not affect the value of e (= our argument s) -> we need a copy of it.
    An ansistring is the easiest way to get a threadsafe copy, and allows us
    to use the other ansistring readstr helpers too.
  }
{$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
  fpc_SetupReadStr_Ansistr_Intern(ReadWriteStrText,s);
{$else FPC_HAS_FEATURE_ANSISTRINGS}
  runerror(217);
{$endif FPC_HAS_FEATURE_ANSISTRINGS}
end;


{$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
procedure fpc_SetupReadStr_Unicodestr(var ReadWriteStrText: text; const s: unicodestring); compilerproc;
begin
  { we use an utf8string to avoid code duplication }
  fpc_SetupReadStr_Ansistr_Intern(ReadWriteStrText,utf8string(s));
end;
{$endif FPC_HAS_FEATURE_WIDESTRINGS}


{$ifndef FPC_WIDESTRING_EQUAL_UNICODESTRING}
procedure fpc_SetupReadStr_Widestr(var ReadWriteStrText: text; const s: widestring); compilerproc;
begin
  { we use an utf8string to avoid code duplication }
  fpc_SetupReadStr_Ansistr_Intern(ReadWriteStrText,utf8string(s));
end;
{$endif FPC_WIDESTRING_EQUAL_UNICODESTRING}


{*****************************************************************************
                               Initializing
*****************************************************************************}

procedure OpenStdIO(var f:text;mode:longint;hdl:thandle);
begin
  Assign(f,'');
  TextRec(f).Handle:=hdl;
  TextRec(f).Mode:=mode;
  TextRec(f).Closefunc:=@FileCloseFunc;
  case mode of
    fmInput :
      begin
        TextRec(f).InOutFunc:=@FileReadFunc;
      {$if defined(FPC_HAS_CPSTRING) and defined(FPC_HAS_FEATURE_WIDESTRINGS)}
        TextRec(f).CodePage:=WideStringManager.GetStandardCodePageProc(scpConsoleInput);
      {$endif}
      end;
    fmOutput :
      begin
        TextRec(f).InOutFunc:=@FileWriteFunc;
        {$if defined(FPC_HAS_CPSTRING) and defined(FPC_HAS_FEATURE_WIDESTRINGS)}
        TextRec(f).CodePage:=WideStringManager.GetStandardCodePageProc(scpConsoleOutput);
      {$endif}
        if Do_Isdevice(hdl) then
          TextRec(f).FlushFunc:=@FileWriteFunc;
      end;
  else
   HandleError(102);
  end;
end;


text.inc (69,958 bytes)   

Tomas Hajny

2020-09-07 12:18

manager   ~0125421

Hello,

First of all, thanks for your report and the provided suggested solution. Unfortunately, you provided the full text.inc file instead of just a diff file. Moreover, your basis for the modified version of text.inc was apparently not the latest trunk version and you didn't mention which SVN revision might serve as basis for creating a proper diff file. Could you please provide this information?

In addition, you stated your doubts regarding usefullness of the Do_IsDevice function. What is the basis of your concern in this area? Is your judgement based on looking at a particular implementation of this function for one of targets supported in FPC? Maybe the whole issue may be resolved by fixing that particular implementation of Do_IsDevice rather than changing the common cross-platform SeekEof? Or is your concern based on something more fundamental like that it shouldn't be important for SeekEof whether the text file handle is associated with a device rather than a file stored on some disk (or other compatible media)?

Andrey "Croco" Stolyarov

2020-09-07 13:01

reporter   ~0125423

Last edited: 2020-09-07 13:09

View 2 revisions

Sorry, I'm new to fpc development process, so it took some time for me to figure out these rules for submitting patches. The patch created with git according to the instructions is attached.

As of Do_IsDevice, the question is a bit harder and needs a detailed report with closer look to the sources (which I did 4 years ago, but perhaps I should refresh my impression). What I can tell for sure is that in SeekEof there's no need for calling Do_IsDevice, because on MOST (if not all) of the platforms the implementation of Do_IsDevice has nothing to do with seekability of the stream. On Linux, it is implemented as isatty(3) using ioctl, and on most other platforms it is implemented simply by checking whether the stream is one of the stdin/stdout/stderr. Well, it should at least be named differently, shouldn't it?

And one more thing. To me, the difference in SeekEof's behaviour on different kinds of streams looks weird, I'd suggest removing all the code that tries to restore the file position. SeekEof advances the position in non-seekable streams (e.g. terminal input), and I'd prefer it to do the same on files.

You won't break backwards compatibility because SeekEof in its present state (which dates back, as far as I can tell, to the times Free Pascal was started) is unusable, so I hardly can imagine a realworld program that uses it.
seekeof_unseekable_streams_fix.patch (1,189 bytes)   
From a86392f8d9885bd2ef7d79609195d47ff10cc95c Mon Sep 17 00:00:00 2001
From: "Andrey Vikt. Stolyarov" <avst at intelib org>
Date: Mon, 7 Sep 2020 13:33:06 +0300
Subject: [PATCH] Added the (dirty) fix for non-seekable streams

---
 rtl/inc/text.inc | 12 +++++++++---
 1 file changed, 9 insertions(+), 3 deletions(-)

diff --git a/rtl/inc/text.inc b/rtl/inc/text.inc
index 0ae0f4a..6edcf89 100644
--- a/rtl/inc/text.inc
+++ b/rtl/inc/text.inc
@@ -472,6 +472,8 @@ Begin
           (reads = 1) then
          begin
            oldfilepos := Do_FilePos(TextRec(t).handle) - TextRec(t).BufEnd;
+           if InOutRes <> 0 then
+             isdevice := true;
            InOutRes:=0;
          end;
        FileFunc(TextRec(t).InOutFunc)(TextRec(t));
@@ -516,9 +518,13 @@ Begin
     else
       begin
         do_seek(TextRec(t).handle,oldfilepos);
-        InOutRes:=0;
-        FileFunc(TextRec(t).InOutFunc)(TextRec(t));
-        TextRec(t).BufPos:=oldbufpos;
+        if InOutRes = 0 then
+          begin
+            FileFunc(TextRec(t).InOutFunc)(TextRec(t));
+            TextRec(t).BufPos:=oldbufpos;
+          end
+        else
+          InOutRes:=0;
       end;
 End;
 
-- 
2.1.4

Marco van de Voort

2020-09-11 22:35

manager   ~0125491

A possible way would be testing with stat and s_* macros. These are kept in rtl/bsd|linux/osmacros.inc but need to be double checked for recent changes.

https://pubs.opengroup.org/onlinepubs/009695399/basedefs/sys/stat.h.html

Andrey "Croco" Stolyarov

2020-09-12 00:56

reporter   ~0125494

Well, I'm sorry, but possible way for _what_? I'm a bit confused with this.

Within the SeekEof function, we can't use these macros because they aren't portable. Furthermore, SeekEof does not need it. What it is supposed to do is to read and drop whitespace chars until either a non-whitespace char is encountered (in which it must be kept in the stream, and false is returned), or the EOF condition is met (then, we return false). As far as I can tell, the low-level (crossplatform) implementation of streams allows for this; actually, SeekEoln uses the same mechanics successfully, and, even better news, SeekEof with the fix I propose (see the diff), it seems to work well (sorry, I'm unable to test this for platforms other than Linux... but, well, proper error handling hardly can break anything).

In its present version, SeekEof (for reasons that remain unclear for me) tries not to "consume" all whitespaces. For this, on some streams (well, those for which Do_IsDevice returns false) it tries to do do_filepos and it DOESN'T check for errors. Actually, all we have to change is to DO the check, and in case do_filepos fails (which means the stream is actually unseekable, which, in turn, has absolutely nothing to do with the question if it is a "device" or not). This is what my fix does. I don't like this way of solving this particular problem, but I've got to admit this is perhaps the minimal possible change to make SeekEof handle non-seekable streams correctly.

If you mean the Do_IsDevice function, not SeekEof, then, to my mind, the first thing we must do is to determine what EXACTLY it is supposed to do. To check for seekability of the stream, one doesn't need the stat(2) syscall, it is more straightforward to use the lseek(2) syscall, e.g., in the form lseek(fd, 0, SEEK_CUR) -- BTW, this is exactly what Do_FilePos from rtl/unix/sysfile.inc does, so the error check I propose in my fix is the most straightforward way to check for seekability). However, if the function is supposed to check for seekability, it (to my mind) must not be named Do_IsDevice, because it leads to confusion.

Anyway, what to do with Do_IsDevice is not the primary question here. My fix does no changes related to Do_IsDevice nor to its usage, it only adds correct error handling with fallback to the strategy of not restoring the file position for streams that don't allow for it.

Actually, there are two distinct questions that remain untouched by my fix, but still would be good to be answered. The first is, well, what should that Do_IsDevice do (this requires certain investigation of how it is used in various places). The second is, why on the Earth anyone would need (or like) SeekEof trying that hard not to consume whitespaces from the stream. However, one doesn't need to answer any of these two questions in order to apply my fix, because the fix doesn't imply any answers for these questions.

Tomas Hajny

2020-09-12 01:05

manager   ~0125495

Last edited: 2020-09-12 01:22

View 2 revisions

Indeed, this looks like the way forward (except that I'll use the ostypes.inc constants rather than the macros) - thanks Marco!

Regarding the comment about naming of Do_IsDevice - well, yes, the original name is derived from the test originally performed on DOS (which doesn't have real pipes, because redirection is handled using temporary files there). Since Do_IsDevice is not exposed outside of the System unit, changing the name shouldn't be necessary, proper documentation seems to be more important than an internal function name from my point of view.

@Croco: Yes, your fix may be applied independently from Do_IsDevice changes; don't worry, it will be applied. Nevertheless, I believe that Do_IsDevice should be extended as well. I already _did_ perform the suggested investigation of its use (actually, I have already had some knowledge about it before, but I checked to confirm my understanding). Regarding what Do_IsDevice is supposed to do - well, it's basically supposed to check whether the handle belongs to a file stored on a disk, or to something else (like console, but also pipes mentioned by you). Seeking may hardly be successful for handle types belonging to character devices, pipes or sockets, and buffering should not be used for these types of handles either, because the output is expected immediately in all these cases.

Andrey "Croco" Stolyarov

2020-09-12 02:26

reporter   ~0125497

Marco, Tomas,

thanks for discussing this.

I've got no time right now to look for usages of Do_IsDevice (hope to do this tomorrow); however, if the desired check is for seekability of the stream, I wouldn't recommend to use the stat(2) syscall for it. Such a check is based on the assumptions we (first) know all possible file types and (second) we can always deduce from the file type if it can be lseek'ed or not. However, neither of these is actually true. First: some filesystems provide files of types that stat(2) simply doesn't know about, such as "doors" on Solaris; okay, I don't exactly remember what happens when you mount Solaris-formatted disk under Linux, but I know for sure Linux kernel supports these filesystems. Second: you might expect some file types to be seekable (or non-seekable) "for sure", but only to see one day they don't obey. AFAIR, on the /proc (and other "special" filesystems) there are some files having "normal" file type but nonetheless non-seekable. And on FreeBSD (may be on some other BSDs as well, but I don't know for sure) there are no block devices, all the device files are of type S_IFCHR (in the terminology of stat(2)), but some of them (well, those corresponding to disks... surprize!) _are_ seekable.

The only reliable way to determine whether the stream is seekable or not is to try lseek(2) on it.

@Tomas: may be you know anything about the grounds why SeekEof tries to restore the position? SeekEoln, which is similar by its nature, doesn't do anything like that, and the only obvious (well, obvious to me... or just known to me) use case for SeekEof is when you read from a text stream anything more complicated than chars and whole lines, primarily numbers (when you can't use Eof because when you've just read the last token in the stream, the EOF condition is typically not met because of trailing spaces and the LF char at the end of the last line). But when you read tokens, you perhaps don't care how much whitespace is there between any two of the tokens, so why to bother restoring the position which is just some WS chars back?

Tomas Hajny

2020-09-12 22:15

manager   ~0125517

Thanks for your comments, but the real problem is that (as you pointed out correctly) do_isdevice cannot distinguish/handle pipes properly in its current implementation (and moreover, some targets don't provide reasonable implementation of Do_IsDevice as pointed out by you as well). That is an issue regardless from the SeekEof changes which I already applied in the meantime - I used your patch with one small change / addition. I believe that the check for Do_IsDevice is still appropriate in SeekEof, because it makes no sense to try seeking on handles known for not supporting them correctly. If anybody uses SeekEof on a handle corresponding to a block device like a disk due to the RTL not being able to distinguish a character device from a block device on a particular operating system... - well, then such a person deserves what (s)he gets whatever the implementation is... ;-)

Regarding your question about restoring the position - I'd need to have a look at it in more detail, but I prefer fixing the incomplete Do_IsDevice implementations first.

Irfan Bagus

2020-09-14 04:43

reporter   ~0125533

hi, r46853 based on this bug report introduce new bug for avr target

text.inc(214,18) Error: Identifier not found "F"

typo perhaps on this line

Move(c,TextRec(F).Name,counter+1);

Tomas Hajny

2020-09-14 07:20

manager   ~0125534

Last edited: 2020-09-14 08:07

View 2 revisions

I'm very sorry - apparently, my SVN tree wasn't clean which probably resulted in this issue. :-( Fixed now.

Tomas Hajny

2020-09-15 12:18

manager   ~0125546

Fix applied plus System.Do_IsDevice implementation is improved in addition as well (r46863).

Andrey "Croco" Stolyarov

2020-09-17 12:37

reporter   ~0125591

Last edited: 2020-09-17 12:47

View 3 revisions

Hi,

I finally took a look on uses (as opposite to implementations) of Do_IsDevice, and I've got kinda bad news.

Assuming that cross-platform code is in the rtl/inc/ directory, I see three pieces of code that use Do_IsDevice. The first is already known to us here, within SeekEof, where Do_IsDevice is used to check if the stream supports repositioning (is seekable) or not.

The second is in dump_stack (see rtl/inc/system.inc). As far as I can tell, here it is used to determine how many records to print, basing on where the output goes: to the human user sitting on a console or somewhere else. For this use, the previous version of Do_IsDevice (both checking whether the stream is one of the "standard" streams _and_ checking if it is a tty) perfectly fits, but the new version doesn't.

The last case is again in text.inc, within the Procedure FileOpenFunc and procedure OpenStdIo, both seem to be for the same purpose -- namely to decide whether to assign the FlushFunc field of the TextRec or not. This looks confusing to me but seems to have nothing to do with both previous cases. There's a comment there:

     { Only install flushing if its a NOT a file, and only check if there
       was no error opening the file, because else we always get a bad
       file handle error 6 (PFV) }

I suspect this is a property of a particular platform, but the guess can be wrong here; also, I think this time Do_IsDevice is used to check if the stream is a real file.

Having said all this, I conclude that Do_IsDevice simply can not be implemented "consistently" because it is used in different places for completely different purposes. The situation is hopeless, it is impossible to fix it.

My suggestion generally remains the same, but now I'm able to be more specific. First of all, the function Do_IsDevice, to my mind, _must_ be renamed, because neither of the three cases need the check for the stream being (literally) a device. If the function remains named as it is, this will inevitably lead to more confusion in future, just like it already did.

The only reasonable case of the three mentioned above is, as far as I can tell, the check if the stream goes to a human user, which appears in the dump_stack procedure. For this purpose, on unix-like systems the function should perhaps be implemented as isatty(3), and on most of other platforms it can remain being implemented as the check for the stream being "standard"; at least both implementations are consistent with the purpose. So I strongly suggest to rename Do_IsDevice to Do_IsATty, Do_IsTerminal or Do_IsConsole.

For both uses within the text.inc file (SeekEof and file opening), calling Do_IsDevice is weird. I've got to repeat my own statement here: one of the most important properties of a text stream as a universal paradigm is that it must have exactly the same behavior regardless of the technical nature of the stream. That is, there must be no difference whether we read from a file, from a device, from a socket or from whatever source that can provide us with a sequence of bytes.

As of SeekEof, the only use case of it I can imagine (and for which is originally made) is as follows:

while not SeekEof(f) do begin
   read(f, n);
   { handle n }
end

where n is something more complicated than a char (e.g., number), because for chars one can use the Eof function. If f is a seekable stream, the current implementation of SeekEof, after reading some whitespace, repositions the stream back to the start of the whitespace sequence, just for the subsequent read to read all these whitespace chars back in again, so together they do kinda monkey business. It might be not a big problem provided that noone notices, heh; however, actually this IS a problem for any relatively long stream (e.g., a gigabyte or so of numbers in text form), because every call to SeekEof does _three_ syscalls: the first is either stat(2) or ioctl(2) (depending on the implementation of Do_IsDevice), the second is the lseek(2) from within do_filepos, the last one is again lseek(2) from do_seek. As far as I can see, the input is buffered (every syscall reads 256 bytes, which is not the best choice, but, well, it works), which is done in order not to emit the read(2) syscall too often (e.g. for every char or even for every group of chars that form a number). With the existing implementation of SeekEof, things work approx. 300 times slower than they should (the actual figure will depend on average length of a number in the stream; however, where there must be ONE read(2) for every 256 bytes, SeekEof adds THREE more -- absolutely useless -- syscalls for EVERY NUMBER being read, and its syscalls with theis context switching, not the program itself, what consumes most of the machine's time).

The only reason we've got for keeping this behavior is the (strange) comment in the source that "seekeof should not move", without any explanations. I believe this is insufficient reason to effectively make the only correct way of reading text numbers unacceptably inefficient (actually, unusable).

As of the last use of Do_IsDevice, I think we should try not to install that "flushing function" for any streams, thus eliminating the last existing calls to Do_IsDevice.

Andrey "Croco" Stolyarov

2020-09-17 14:29

reporter   ~0125592

Please take a look at my note 0125591

Tomas Hajny

2020-09-17 15:30

manager   ~0125593

First of all, let's start with simple question - if your original bug report is resolved, it should be possible to close it. Considering that the provided patch was applied, I'd expect that this should be the case, but if you have some tests suggesting otherwise, let me know. If you see some other issues, it might be more appropriate to open a new bug report and possibly add a relationship to this one to it.

Now to your comments - the third use case of Do_IsDevice (installatin of the flushing function) is supposed to ensure compatibility to TP/BP. The expected behaviour is that while text file output is buffered in general, no buffering should be performed for output going to console, because otherwise e.g. text prompts asking the user to provide his input would not be shown before the program starts waiting for the user input (i.e. the user might consider the program "frozen" / not doing anything, etc.). This has already been the case in TP/BP and the reasons are still equally valid. If the output is redirected to a file, there's no reason not to perform the buffering (obviously, the performance is better when buffering is used). However, there are other types of file handles which should be better served immediately (equally to the console), because there is 'someone' or 'something' waiting for this output (preferably immediately rather than at some later point) - that's the case of pipes and sockets (neither of them supported for TP/BP programs running under DOS, because 'piping' the output there involved redirection to a temporary file and reading input for the second program started after finishing the first one from that temporary file). This is the primary reason for my change and the by far most important use case for Do_IsDevice. And no, this case is not related to one particular platform but rather equally valid for all targets suporting both files and either a console, or possibility of interprocess communication involving text files.

Your assumption regarding the original implementation of Do_IsDevice as expressed in 'the previous version of Do_IsDevice (both checking whether the stream is one of the "standard" streams _and_ checking if it is a tty)' - is not correct, because there wasn't a _single_ implementation which would have been doing these two checks together. Some of them were checking handle value to be on of the three "special" handles (without doing anything else), the others were checking the handle type to be a character device / tty (without checking the handle value). Anyway, checking the handle value doesn't make much sense, because it says nothing about the behaviour / features of the associated device.

Regarding the SeekEof use case - I believe that the real reason for checking the handle type is trying to avoid reading everything byte by byte if it's possible to perform a Seek instead, _and_ avoiding the seek call if the handle type is known not to support seeking. I understand your view that it might be better to try the seek call anyway rather than making decisions based on the handle type. I don't share your view completely, but I wouldn't want to say that there is just one correct solution and anything else is wrong. I still want to check the SeekEof in more detail to understand the exact process flow in different cases better and I'll be happy to fix possible 'monkey business' scenarios - I just don't think that this is related to the original bug report directly, nor that this should depend on details of the Do_IsDevice implementation.

Finally, yes, I noticed the third case related to stack dumping as well. To be honest, I don't consider this very important, because it doesn't have impact for standard behaviour of any FPC compiled program (it impacts only the behaviour in case of an error). Considering the fact that stack dumps are just one of support debugging tools rather than primary solution for anything, it shouldn't matter much, especially if pipes may go directly to console as well if using something like 'tee', as well as be used for other purposes.

Andrey "Croco" Stolyarov

2020-09-17 17:37

reporter   ~0125594

Tomas, thank you for the quick reply.

If for some reason you prefer to have this ticket closed, and another one created, I don't mind, feel free to close this ticket and I'll create another one. However, as it looks to me, it is not a good idea to close this ticket because it contains important discussion, which is far from being finished and/or "settled" in any way. I'm afraid you don't catch some important things and I'll try now to explain them better.

I'm not sure if the "third case" is really about preventing terminal output from being buffered so that the user doesn't see the prompts; however if it is so, then I can't understand your words about "other types of file handles which should be better served immediately". Definitely they shouldn't. In unix world, it is typical to pass terabytes of data (e.g. archives) thru pipes, and if they become unbuffered, it will be a catastrophe. Protocols such as SMTP, HTTP and many others are done on TCP sockets in text form, so these sockets are text streams; if you really want to prevent them from being buffered, then please reconsider.

From the other hand, the problem of prompts being buffered is well-known, and in the standard C i/o library (BTW, long before TP/BP, in mid-1970s) it is solved in a well-documented (and even officially standardized) way: _output_ buffers connected to TTYs (and only to them!) are flushed on LF char as well as on any _input_ operation on the same tty. I think it is okay not to buffer them at all (that is, "serve immediately"), but only in case there's a terminal -- not pipe, nor FIFO, nor socket, nor a char-oriented device other than tty (errr, just yesterday I copied several gigabytes of 'data' from /dev/zero, which is traditional way to create a file, e.g, for swapping... fortunately, it is buffered). Terminals are rarely passed gigs of data, as they supposed to be human-interacting; this is not the case for other types of streams. BTW, this is exactly what that isatty(3) function, which we had to mention several times, was made for; the bufferizatioin strategy in C stdio is determined by calling this function.

So, if calling Do_IsDevice from opening a text stream serves this purpose, then it is obviously better to rename it into smth. like Do_IsATty (which clearly explains what does it do) and keep calling it both from stream opening and from dump_stack (despite it might be not so important, why to break it?) Anyway, I'm afraid it is better to revert your changes on Do_IsDevice implementation.

As of platforms where Do_IsDevice implemented by checking for being "standard" stream, I'm not familiar with these platform, but I assume there might be no way to redirect i/o for std* streams and, at the same time, no tty devices as such. In this case such a replacement for isatty might be reasonable.

The last but not least, for SeekEof. Look, it doesn't need to perform any seek, if under the term "seek" we mean changing the current position in a stream. Seeks can't help to achieve what SeekEof is for: if you do any seek "instead of reading", then how will you know whether there were WS chars only, or there was at least one non-WS char?

And it doesn't "read byte by byte", it does that FileFunc(TextRec(t).InOutFunc)(TextRec(t)) which (well, I think so) performs buffered input -- meaning that it either give away another byte if there are buffered bytes, or does another syscall to get more of them. Actually, this is the only i/o operation SeekEof should do, regardless of the type of the stream.

I'd like to stress once again that everything else that we see in its code, serves the very strange purpose: to restore the initial position after the result is found, that is, effectively, "takeback" all whitespace chars it passed thru (and the subsequent read will have to read them again, reducing the efficiency even more, although not too much, as the things are too bad already). It costs that three syscalls every time SeekEof is called, while there actually mostly should be no syscalls at all on most calls to SeekEof, and once in 256 bytes there have to be a call to the syscall read(2).

If you give me a couple of hours, I'll try to strip these off the SeekEof's code, test what I get and report it here.

Andrey "Croco" Stolyarov

2020-09-17 21:19

reporter   ~0125596

Last edited: 2020-09-17 21:24

View 3 revisions

Ok, so here is my simplified version of SeekEof:


Function SeekEof (Var t : Text) : Boolean;
Begin
  If (InOutRes<>0) then
    exit(true);
  if (TextRec(t).mode<>fmInput) Then
  begin
    if TextRec(t).mode=fmOutPut then
      InOutRes:=104
    else
      InOutRes:=103;
    exit(true)
  end;
  repeat
    If TextRec(t).BufPos>=TextRec(t).BufEnd Then
    begin
      FileFunc(TextRec(t).InOutFunc)(TextRec(t));
      If TextRec(t).BufPos>=TextRec(t).BufEnd Then
      begin
        SeekEof := true;
        break
      end;
    end;
    case TextRec(t).Bufptr^[TextRec(t).BufPos] of
      0000026 :
        if CtrlZMarksEOF then
        begin
          SeekEof := true;
          break
        end;
      0000010,0000013,0000009,' ' :
        ;
      else
        begin
          SeekEof := false;
          break
        end;
    end;
    inc(TextRec(t).BufPos)
  until false
End;


The patch is attached. I've just compiled my sample program (that SimpleSum one from the initial ticket text) and it works as desired at least for tty input, pipeline and input redirected from (large) text file, doing buffered input and emitting no extra syscalls. I've checked that with strace; I'd recommend everyone who's interested to do the same both with the current version of SeekEof and with my version, specially on a disk file; you'll be surprized with the difference.

Thanks for reading!

P.S. Sorry, how do I prevent these "number" signs to turn into references?
simplify_seekeof.patch (3,776 bytes)   
From 110a411fd3df94f821381c8ddbed5b5dafb23536 Mon Sep 17 00:00:00 2001
From: "Andrey Vikt. Stolyarov" <avst at intelib org>
Date: Thu, 17 Sep 2020 22:09:01 +0300
Subject: [PATCH] SeekEof simplified by eliminating all the code that tries to
 restore the position

---
 rtl/inc/text.inc | 103 +++++++++++++++----------------------------------------
 1 file changed, 27 insertions(+), 76 deletions(-)

diff --git a/rtl/inc/text.inc b/rtl/inc/text.inc
index c78e6fa..dbe14f7 100644
--- a/rtl/inc/text.inc
+++ b/rtl/inc/text.inc
@@ -440,93 +440,44 @@ End;
 
 
 Function SeekEof (Var t : Text) : Boolean;
-var
-  oldfilepos : Int64;
-  oldbufpos, oldbufend : SizeInt;
-  reads: longint;
-  isdevice: boolean;
 Begin
   If (InOutRes<>0) then
-   exit(true);
+    exit(true);
   if (TextRec(t).mode<>fmInput) Then
-   begin
-     if TextRec(t).mode=fmOutPut then
+  begin
+    if TextRec(t).mode=fmOutPut then
       InOutRes:=104
-     else
+    else
       InOutRes:=103;
-     exit(true);
-   end;
-  { try to save the current position in the file, seekeof() should not move }
-  { the current file position (JM)                                          }
-  oldbufpos := TextRec(t).BufPos;
-  oldbufend := TextRec(t).BufEnd;
-  reads := 0;
-  oldfilepos := -1;
-  isdevice := Do_IsDevice(TextRec(t).handle);
+    exit(true)
+  end;
   repeat
     If TextRec(t).BufPos>=TextRec(t).BufEnd Then
-     begin
-       { signal that the we will have to do a seek }
-       inc(reads);
-       if not isdevice and
-          (reads = 1) then
-         begin
-           oldfilepos := Do_FilePos(TextRec(t).handle) - TextRec(t).BufEnd;
-           if InOutRes <> 0 then
-             isdevice := true;
-           InOutRes:=0;
-         end;
-       FileFunc(TextRec(t).InOutFunc)(TextRec(t));
-       If TextRec(t).BufPos>=TextRec(t).BufEnd Then
-        begin
-          { if we only did a read in which we didn't read anything, the }
-          { old buffer is still valid and we can simply restore the     }
-          { pointers (JM)                                               }
-          dec(reads);
-          SeekEof := true;
-          break;
-        end;
-     end;
+    begin
+      FileFunc(TextRec(t).InOutFunc)(TextRec(t));
+      If TextRec(t).BufPos>=TextRec(t).BufEnd Then
+      begin
+        SeekEof := true;
+        break
+      end;
+    end;
     case TextRec(t).Bufptr^[TextRec(t).BufPos] of
       #26 :
         if CtrlZMarksEOF then
-          begin
-            SeekEof := true;
-            break;
-          end;
-     #10,#13,#9,' ' :
-       ;
-    else
-     begin
-       SeekEof := false;
-       break;
-     end;
+        begin
+          SeekEof := true;
+          break
+        end;
+      #10,#13,#9,' ' :
+        ;
+      else
+        begin
+          SeekEof := false;
+          break
+        end;
     end;
-   inc(TextRec(t).BufPos);
-  until false;
-  { restore file position if not working with a device }
-  if not isdevice then
-    { if we didn't modify the buffer, simply restore the BufPos and BufEnd  }
-    { (the latter because it's now probably set to zero because nothing was }
-    {  was read anymore)                                                    }
-    if (reads = 0) then
-      begin
-        TextRec(t).BufPos:=oldbufpos;
-        TextRec(t).BufEnd:=oldbufend;
-      end
-    { otherwise return to the old filepos and reset the buffer }
-    else
-      begin
-        InOutRes := 0;
-        do_seek(TextRec(t).handle,oldfilepos);
-        if InOutRes = 0 then
-          begin
-            FileFunc(TextRec(t).InOutFunc)(TextRec(t));
-            TextRec(t).BufPos:=oldbufpos;
-          end
-        else
-          InOutRes:=0;
-      end;
+    inc(TextRec(t).BufPos)
+  until false
 End;
 
 
-- 
2.1.4

simplify_seekeof.patch (3,776 bytes)   

Tomas Hajny

2020-09-17 23:50

manager   ~0125604

I'm afraid that you misunderstand the purpose of SeekEof. My old TP/BP Library Reference states something like: "SeekEof function does almost the same thing as the Eof function except that it ignores all the whitespace characters between the current position and the end of file." In other words - the only purpose of SeekEof is to check, whether there is still some valid input (before end of the file) to be consumed. It's also the reason why the file position is being returned to the original position as set before calling this function. Moreover, the FPC documentation of this function clearly states that this function should never be used on anything except regular files. This is the reason of the Do_IsDevice check within the current SeekEof implementation, and extending the Do_IsDevice check to include sockets and pipes is absolutely inline with the documentation from this point of view.

Regarding passing of terabytes through pipes, etc. - you can certainly do so, but you shouldn't do that using text files as defined in FPC RTL. First, text files are supposed to serve for processing text, not binary files, and I doubt that terabyte files are text files. Second, the performance of I/O with a buffer of 256 bytes would be obviously completely unacceptable if used for terabyte files. Take just the simplest case of piping the output through 'tee' - the output goes first to the pipe and from it to the console to be displayed to the user (but the FPC program cannot know where it goes from the other side of the pipe).

Finally, please, don't compare FPC RTL with C RTL, the two are simply designed differently and saying that one is 'standardized' makes no sense - that's like saying that since German is standardized to start all nouns with a capital letter since ages, Russian should do the same. Do you propose throwing away the FPC RTL (which is designed, documented and used in certain way) and start using the C I/O library, or what?

Andrey "Croco" Stolyarov

2020-09-19 00:32

reporter   ~0125635

Last edited: 2020-09-19 01:43

View 2 revisions

Sorry, but no, I don't misunderstand what SeekEof is for; in early and mid-1990s, I used Turbo and Borland Pascal to write DOS (and rarely Win-3.1) programs for money, and I perfectly remember what SeekEof is (was) for. It has only one use case, and it is the use case shown in my notes above. If you can show another use case for it, please do. As for the use case of reading numbers, "ignoring" spaces is semantically exactly the same as "reading and dropping" (or "skipping") them; I guess that in the manual you cite, someone just used unclear wording.

BTW, this game can be played by two players, heh. As TP/BP in 1990s was my primary tool for earning money, I've got the original BP 7.0 box with 5 inch diskettes and all the books, bought around 1995; I keep it as a kind of souvenir. So I've just dig it up from my bookshelf; the book to cite is "Borland Pascal With Objects, Version 7.0, Programmer's Reference". SeekEof is documented at page 198. Here's what is said there (sorry, the markup is lost in the citation; well, do you want me to send you a photo or a scan of the book as a proof? sounds stupid, but I can do):

=======================

Purpose: Returns the end-of-file status of a file.

Target: Protected; Real; Windows

Declaration: function SeekEof [ (var F: Text) ]: Boolean;

Remarks: SeekEof corresponds to Eof except that it skips all blanks, tabs, and end-of-line markers before returning the end-of-file status. This is useful when reading numeric values from a text file. With {$I-}, IOResult returns 0 if the operation was successful; otherwise, it returns a nonzero error code.

Restrictions: Can be used only on text files. File must be open.

See also: Eof, SeekEoln.

=======================

Please note, first, the word "skips" (the same word is used in that book in explanation what does read do with blanks when it reads numbers from a text file), and, second, the explanation of what it is "useful for". Please note as well that TP/BP was never intended to be cross-platform; Free Pascal is, so programs created with FP should perhaps be useful on other platforms as well, including unix-like systems where text streams are not always files.

Furthermore, Free Pascal doesn't provide anything like ungetc(3), and read doesn't let the user to tell if the variable passed to read got assigned to zero because a real zero has just been read or because of EOF; hence there's no correct way to use read for reading numbers from a text stream if there's no SeekEof, as well as if SeekEof is broken (as it still is, because issuing 3 useless syscalls for each use of SeekEof where there should be none of them is clearly inappropriate). Do you really think it would be good for me to tell my students and readers of my book that they must not use read for reading numbers, but instead they must read all numbers char by char, converting them to ints/longs/reals manually? It will be the only alternative if SeekEof remains in its present state -- which is useless (if you disagree, please try constructing use case for it in its present state, such that it relies on the restoring the position).

As of the documentation, oh, yes, I noticed it right when my readers reported me SeekEof is broken (it was 4 years ago, and wording there changed a bit since then, perhaps someone tried to fix it but failed). Okay, documenting bugs as features instead of fixing them is a thing I definitely don't like; do you? Furthermore, literally "can only be used on real files" means "can not be used at all", because, first, there's no (documented/portable) way to tell if it is a file or not, and, second, In Unix, a program that reads data from a text file (only reads, without complicated mix of reads and writes) must be able to read from any stream, otherwise it can not be considered correct; so even if we determine we can't use SeekEof on the stream we've got this time, then WHAT? There's no replacement for SeekEof which works with other kinds of streams. So, in case this is not a bug, it is perhaps better to write in documentation that SeekEof must not be used at all. The next thing to document is that read must not be used to read numbers from text streams. Errr... where do we end up?

As of gigabytes thru text streams (not files -- "stream" is a more general thing; however, I've seen text files -- real disk files storing text -- that were larger that 2G so 32-bit lseek failed to work with them). Certainly you can believe all people around "should not" do something, but you can't tell all the world to stop doing that. Just recall the last time you downloaded something large (like a video) via HTTP/HTTPS, or received it by email. Once again, these protocols -- both WWW and email -- use text streams, and yes, these are TEXT streams. Daemons like xinetd even let people write TCP servers in the form of programs that have such a socket as stdin/stdout, and I wouldn't like to surprise anyone with a statement that Free Pascal is unsuitable for writing such a server.

There are even lots of encoders intended to represent binary data as text, such as uuencode, base64 etc. And, yes, you can like it or not, but in Unix world it is common to pass terabytes of data via text streams, e.g., in the form of XML or simply as a text using LFs as delimiters, not only by networks, but inside a single system too. Furthermore, it is common to pass raw (binary) data through stdin/stdout (e.g. all compressors, such as gzip, bzip2, xz etc. work this way, and tar calls them exactly this way). That's because byte stream is one of the key paradigms that make Unix what it is. As far as I can tell, in FP, stdin, stdout and stderr can not be anything else than of type text -- so is it good to declare that FP can not be used to write another compressing program? This is just an example; the practice of passing gigabytes thru standard io streams is common.

As of 256-bytes buffers, BTW, it might surprise you, but it's not as bad as you expect. It is only 16 times less than 4kb pages which are used by most of software (and it is senseless to make it larger than 4Kb, because for the reasons related to kernel implementation, it will not give any significant efficiency gain). 16 read syscalls instead of 1 read syscall is not very good, but still more or less acceptable. But approx. 1000 stat or ioctl syscalls, 2000 lseek syscalls and 1000 read syscalls (because buffer is not valid after changing position and has to be read again) -- all instead of just 1 read -- is, well, worse. I assume numbers here to have 3 digits in average, so with the space it takes average of 4 bytes per number; if numbers will be mostly 1-digit, multiply all the figures by two.

About the tee program, it is a good example, but in this argument it is good for me, not for you :-) First of all, it is possible to watch for a real disk file to grow, with, e.g., 'tail -f', or with 'less' (press Shift-F being in less to get this function; I often use these to watch my log files), so that smart human user can be sitting even behind a disk file. You wouldn't offer to disable buffering for general files, would you? Some programs use explicit flushing, and this includes traditional syslog which flushed after every message, but why do you want to FORCE such a behavior for ALL programs written in FP?

Next, have you ever seen a Unix program that, having its output redirected trough a pipeline to tee, wouldn't do output buffering? I never seen such a program; it is possible to write one using explicit flushing, but it is not what people would expect. And trust me, people wouldn't expect that redirecting output thru pipeline turns buffering off. For a tty, it is expected the (human) user is there; but only TTYs are special in this respect; actually, human user CAN be anywhere, because (s)he is all-mighty, but this is not a reason to switch off all buffering we have. Pipes and sockets are nothing special in this respect.

I don't "compare" FPC RTL with C RTL (at least because there's no such thing as C RTL), my intention was to show the problem of buffered stdout is well- and long- known, and there's certain practice adopted to solve it. Certainly this is not about standards; honestly speaking, I dislike most of existing standards, I even hate some of them (specially these of C++, they effectively killed my favorite programming language). It is even not about C as such; it is about Unix traditions and practices that exist for 40+ years -- just because they are convenient, not because of any standards, standards appeared many years later.

And since you asked it this way, what I PROPOSE is, first, to fix SeekEof which is still obviously broken. Second, I propose to provide a correct way of reading numbers from text streams which is now absent (and the only thing needed for it is to fix SeekEof). The third thing I propose is to roll back your fix to Do_IsDevice, because it fixes nothing, but can break something (although I'm not sure it really does, as I'm still not sure what's going on in that code of opening text streams).

Perhaps the last thing I propose is that, before continuing to advocate the current implementation of SeekEof, you answer two simple questions. First of them is what SeekEof is for -- not "how should it work", but exactly "what it is for". I stress that there's no use case for existing implementation; can you show I'm wrong? And the second question is how to read numbers from a text stream (NOT using char-by-char reading with manual conversion) so that it works for any existing kind of a text stream. With my implementation of SeekEof this is obvious, but as far as I can tell, without it this is impossible. Again, can you prove I'm wrong?

Andrey "Croco" Stolyarov

2020-09-22 15:29

reporter   ~0125756

Last edited: 2020-09-22 15:33

View 2 revisions

And one more thing. Once I took my BP box, I recalled one of the floppies contains the original RTL source code. I've got no working 5" floppy drive, but after a certain search I found my backup of these floppies, made 20+ years ago. So here is the file with implementation of Eof, Eoln, SeekEof and SeekEoln from The Genuine Borland Pascal. It is in assembly language, but it is easy to see that, first, the four functions share most of the implementations (so it is clear SeekEof and SeekEoln work on a similar manner) and, second, none of them does any repositioning, they only do reading.

Sven Barth

2020-09-23 10:20

manager   ~0125771

Last edited: 2020-09-23 11:01

View 2 revisions

Please don't upload copyrighted files.

Andrey "Croco" Stolyarov

2020-09-23 14:35

reporter   ~0125775

According to the law of my home country (Russia), citation of copyrighted material for educational purposes is lawful, and the file I uploaded is small enough (compared to the whole BP or even to the whole RTL) to be considered a citation. Anyway, sorry for the inconvenience, I will not upload anything else like that.

Tomas Hajny

2020-09-23 16:20

manager   ~0125777

Indeed, no copyrighted materials should appear here nor be used as source for any patches, etc. Please note that this includes verbatim copies of the documentation (also copyrighted). If you want to check the behaviour, you should create a test program which can be used to compare the behaviour of FPC to TP/BP and/or Delphi. In fact, I did just that few days ago and it indeed suggests that in spite of the TP/BP documentation (see below for my comments to that), repositioning the file pointer should not happen within SeekEof. I'm still waiting for the final response from the member of the core team who performed the change 19 years ago (to get confirmation for my test program, in particular that it doesn't miss some special case which might have led to the current implementation) and intend to modify SeekEof accordingly afterwards.

I consider the TP/BP documentation very misleading (and probably source of the confusion), because it says, as you correctly quoted, that the purpose of SeekEof is "returning the end of file status" and that "SeekEof corresponds to Eof". Returning status of whatever certainly does not imply changing something and SeekEof from this point of view for sure doesn't "correspond" to Eof, because Eof would never perform any change on the file and/or current position within this file. Nevertheless, please accept my apology for my previous statement about your supposed misunderstanding of this function, I should have performed the compatibility test before making that statement.

Please note that I consider the discussion about potential performance implications of SeekEof changing the position as purely academic, because I'm convinced that it cannot have any considerable impact in real-world scenarios.

Also note that I will _not_ revert my changes performed to Do_IsDevice based on discussion within this bug report, and I will reject potential new bug reports stating that Do_IsDevice should be changed unless there are clear arguments showing why the performed changes cause problems in real-world use-cases on particular platforms (note that the original behaviour differed a lot across the supported targets!) and what is the real measurable effect.

Tomas Hajny

2020-09-24 21:34

manager   ~0125829

Fix to SeekEof applied.

Andrey "Croco" Stolyarov

2020-09-28 21:44

reporter   ~0125940

Tomas,

thank you for fixing SeekEof. Unfortunately, your effort to also "fix" Do_IsDevice which wasn't broken, made fpc effectively useless for the whole class of programs known as "unix filters", and many more, which looks totally inappropriate for me; so I've just created another ticket on that issue.

Tomas Hajny

2020-09-29 00:37

manager   ~0125949

Closing since the reporter confirmed the fix.

Issue History

Date Modified Username Field Change
2020-09-07 11:23 Andrey "Croco" Stolyarov New Issue
2020-09-07 11:23 Andrey "Croco" Stolyarov File Added: text.inc
2020-09-07 12:18 Tomas Hajny Status new => feedback
2020-09-07 12:18 Tomas Hajny FPCTarget => -
2020-09-07 12:18 Tomas Hajny Note Added: 0125421
2020-09-07 13:01 Andrey "Croco" Stolyarov Note Added: 0125423
2020-09-07 13:01 Andrey "Croco" Stolyarov File Added: seekeof_unseekable_streams_fix.patch
2020-09-07 13:01 Andrey "Croco" Stolyarov Status feedback => new
2020-09-07 13:09 Andrey "Croco" Stolyarov Note Edited: 0125423 View Revisions
2020-09-11 22:35 Marco van de Voort Note Added: 0125491
2020-09-12 00:56 Andrey "Croco" Stolyarov Note Added: 0125494
2020-09-12 01:05 Tomas Hajny Note Added: 0125495
2020-09-12 01:22 Tomas Hajny Note Edited: 0125495 View Revisions
2020-09-12 01:23 Tomas Hajny Assigned To => Tomas Hajny
2020-09-12 01:23 Tomas Hajny Status new => assigned
2020-09-12 02:26 Andrey "Croco" Stolyarov Note Added: 0125497
2020-09-12 22:15 Tomas Hajny Note Added: 0125517
2020-09-14 04:43 Irfan Bagus Note Added: 0125533
2020-09-14 07:20 Tomas Hajny Note Added: 0125534
2020-09-14 08:07 Tomas Hajny Note Edited: 0125534 View Revisions
2020-09-15 12:18 Tomas Hajny Status assigned => resolved
2020-09-15 12:18 Tomas Hajny Resolution open => fixed
2020-09-15 12:18 Tomas Hajny Fixed in Revision => 46853, 46864
2020-09-15 12:18 Tomas Hajny Note Added: 0125546
2020-09-17 12:37 Andrey "Croco" Stolyarov Note Added: 0125591
2020-09-17 12:45 Andrey "Croco" Stolyarov Note Edited: 0125591 View Revisions
2020-09-17 12:47 Andrey "Croco" Stolyarov Note Edited: 0125591 View Revisions
2020-09-17 14:29 Andrey "Croco" Stolyarov Status resolved => feedback
2020-09-17 14:29 Andrey "Croco" Stolyarov Resolution fixed => open
2020-09-17 14:29 Andrey "Croco" Stolyarov Note Added: 0125592
2020-09-17 15:30 Tomas Hajny Note Added: 0125593
2020-09-17 17:37 Andrey "Croco" Stolyarov Note Added: 0125594
2020-09-17 17:37 Andrey "Croco" Stolyarov Status feedback => assigned
2020-09-17 21:19 Andrey "Croco" Stolyarov Note Added: 0125596
2020-09-17 21:19 Andrey "Croco" Stolyarov File Added: simplify_seekeof.patch
2020-09-17 21:23 Andrey "Croco" Stolyarov Note Edited: 0125596 View Revisions
2020-09-17 21:24 Andrey "Croco" Stolyarov Note Edited: 0125596 View Revisions
2020-09-17 23:50 Tomas Hajny Note Added: 0125604
2020-09-19 00:32 Andrey "Croco" Stolyarov Note Added: 0125635
2020-09-19 01:43 Andrey "Croco" Stolyarov Note Edited: 0125635 View Revisions
2020-09-22 15:29 Andrey "Croco" Stolyarov Note Added: 0125756
2020-09-22 15:29 Andrey "Croco" Stolyarov File Added: TFUN.ASM
2020-09-22 15:33 Andrey "Croco" Stolyarov Note Edited: 0125756 View Revisions
2020-09-23 10:20 Sven Barth File Deleted: TFUN.ASM
2020-09-23 10:20 Sven Barth Note Added: 0125771
2020-09-23 11:01 Tomas Hajny Note Edited: 0125771 View Revisions
2020-09-23 14:35 Andrey "Croco" Stolyarov Note Added: 0125775
2020-09-23 16:20 Tomas Hajny Note Added: 0125777
2020-09-24 21:34 Tomas Hajny Status assigned => resolved
2020-09-24 21:34 Tomas Hajny Resolution open => fixed
2020-09-24 21:34 Tomas Hajny Fixed in Revision 46853, 46864 => 46853, 46864, 46946
2020-09-24 21:34 Tomas Hajny Note Added: 0125829
2020-09-28 21:44 Andrey "Croco" Stolyarov Note Added: 0125940
2020-09-29 00:37 Tomas Hajny Status resolved => closed
2020-09-29 00:37 Tomas Hajny Note Added: 0125949