paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-12 16:29:21 +02:00
Code Issues Packages Projects Releases Wiki Activity

* fixed write array

Browse Source 
* read array with maxlen
This commit is contained in:
peter 1999-04-26 18:27:26 +00:00
parent ef48b9e4a9
commit 6da9dfae21
1 changed files with 33 additions and 153 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

186
rtl/inc/text.inc
View File

@ -448,11 +448,14 @@ Begin
End; End;
Type {$ifndef NEWWRITEARRAY}
array00 = array[0..0] Of Char; type
Procedure Write_Array(Len : Longint;var f : TextRec;const p : array00);[Public,Alias:'FPC_WRITE_TEXT_PCHAR_AS_ARRAY']; array00=array[0..0] of char;
{$endif}
Procedure Write_Array(Len : Longint;var f : TextRec;const s : {$ifdef NEWWRITEARRAY} array of char{$else}array00{$endif});[Public,Alias:'FPC_WRITE_TEXT_PCHAR_AS_ARRAY'];
var var
ArrayLen : longint; ArrayLen : longint;
p : pchar;
Begin Begin
If (InOutRes<>0) then If (InOutRes<>0) then
exit; exit;
@ -461,10 +464,13 @@ Begin
InOutRes:=105; InOutRes:=105;
exit; exit;
end; end;
p:=pchar(@s);
ArrayLen:=StrLen(p); ArrayLen:=StrLen(p);
if ArrayLen>high(s) then
ArrayLen:=high(s);
If Len>ArrayLen Then If Len>ArrayLen Then
WriteBlanks(f,Len-ArrayLen); WriteBlanks(f,Len-ArrayLen);
WriteBuffer(f,p,ArrayLen); WriteBuffer(f,p^,ArrayLen);
End; End;
@ -733,14 +739,12 @@ Begin
End; End;
Procedure Read_String(var f : TextRec;var s : String);[Public,Alias:'FPC_READ_TEXT_'+{$ifdef NEWREADINT}'SHORTSTR'{$else}'STRING'{$endif}]; Function ReadPCharLen(var f:TextRec;s:pchar;maxlen:longint):longint;
var var
maxlen,
sPos,len : Longint; sPos,len : Longint;
p,startp,maxp : pchar; p,startp,maxp : pchar;
Begin Begin
{ Delete the string } ReadPCharLen:=0;
s:='';
{ Check error and if file is open } { Check error and if file is open }
If (InOutRes<>0) then If (InOutRes<>0) then
exit; exit;
@ -751,7 +755,6 @@ Begin
end; end;
{ Read maximal until Maxlen is reached } { Read maximal until Maxlen is reached }
sPos:=0; sPos:=0;
MaxLen:=high(s);
repeat repeat
If f.BufPos>=f.BufEnd Then If f.BufPos>=f.BufEnd Then
begin begin
@ -771,12 +774,12 @@ Begin
{ calculate read bytes } { calculate read bytes }
len:=p-startp; len:=p-startp;
inc(f.BufPos,Len); inc(f.BufPos,Len);
Move(startp^,s[sPos+1],Len); Move(startp^,s[sPos],Len);
inc(sPos,Len); inc(sPos,Len);
{ was it a LF? then leave } { was it a LF? then leave }
if (p<maxp) and (p^=#10) then if (p<maxp) and (p^=#10) then
begin begin
if (spos>0) and (s[spos]=#13) then if (spos>0) and (s[spos-1]=#13) then
dec(sPos); dec(sPos);
break; break;
end; end;
@ -784,166 +787,39 @@ Begin
if spos=MaxLen then if spos=MaxLen then
break; break;
until false; until false;
{ Set final length } ReadPCharLen:=spos;
s[0]:=chr(sPos); End;
Procedure Read_String(var f : TextRec;var s : String);[Public,Alias:'FPC_READ_TEXT_'+{$ifdef NEWREADINT}'SHORTSTR'{$else}'STRING'{$endif}];
Begin
s[0]:=chr(ReadPCharLen(f,pchar(@s[1]),high(s)));
End; End;
Procedure Read_PChar(var f : TextRec;var s : PChar);[Public,Alias:'FPC_READ_TEXT_PCHAR_AS_POINTER']; Procedure Read_PChar(var f : TextRec;var s : PChar);[Public,Alias:'FPC_READ_TEXT_PCHAR_AS_POINTER'];
var
p,maxp,startp,sidx : PChar;
len : longint;
Begin Begin
{ Delete the string } pchar(s+ReadPCharLen(f,s,$7fffffff))^:=#0;
s^:=#0;
{ Check error and if file is open }
If (InOutRes<>0) then
exit;
if (f.mode<>fmInput) Then
begin
InOutRes:=104;
exit;
end;
{ Read until #10 is found }
sidx:=s;
repeat
If f.BufPos>=f.BufEnd Then
begin
FileFunc(f.InOutFunc)(f);
If f.BufPos>=f.BufEnd Then
break;
end;
p:=@f.Bufptr^[f.BufPos];
maxp:=@f.Bufptr^[f.BufEnd];
startp:=p;
{ search linefeed }
while (p<maxp) and (P^<>#10) do
inc(p);
{ calculate read bytes }
len:=p-startp;
inc(f.BufPos,Len);
{ update output string, take MaxLen into count }
Move(startp^,sidx^,Len);
inc(sidx,len);
{ was it a LF? then leave }
if (p<maxp) and (p^=#10) then
begin
If pchar(p-1)^=#13 Then
dec(p);
break;
end;
until false;
sidx^:=#0;
End; End;
Procedure Read_Array(var f : TextRec;var s : array00);[Public,Alias:'FPC_READ_TEXT_PCHAR_AS_ARRAY']; Procedure Read_Array(var f : TextRec;var s : {$ifdef NEWWRITEARRAY}array of char{$else}array00{$endif});[Public,Alias:'FPC_READ_TEXT_PCHAR_AS_ARRAY'];
var
p,maxp,startp,sidx : PChar;
len : longint;
Begin Begin
{ Delete the string } pchar(pchar(@s)+ReadPCharLen(f,pchar(@s),{$ifdef NEWWRITEARRAY}high(s){$else}$7fffffff{$endif}))^:=#0;
s[0]:=#0;
{ Check error and if file is open }
If (InOutRes<>0) then
exit;
if (f.mode<>fmInput) Then
begin
InOutRes:=104;
exit;
end;
{ Read until #10 is found }
sidx:=pchar(@s);
repeat
If f.BufPos>=f.BufEnd Then
begin
FileFunc(f.InOutFunc)(f);
If f.BufPos>=f.BufEnd Then
break;
end;
p:=@f.Bufptr^[f.BufPos];
maxp:=@f.Bufptr^[f.BufEnd];
startp:=p;
{ search linefeed }
while (p<maxp) and (P^<>#10) do
inc(p);
{ calculate read bytes }
len:=p-startp;
inc(f.BufPos,Len);
{ update output string, take MaxLen into count }
Move(startp^,sidx^,Len);
inc(sidx,len);
{ was it a LF? then leave }
if (p<maxp) and (p^=#10) then
begin
If pchar(p-1)^=#13 Then
dec(p);
break;
end;
until false;
sidx^:=#0;
End; End;
Procedure Read_AnsiString(var f : TextRec;var s : AnsiString);[Public,Alias:'FPC_READ_TEXT_'+{$ifdef NEWREADINT}'ANSISTR'{$else}'ANSISTRING'{$endif}]; Procedure Read_AnsiString(var f : TextRec;var s : AnsiString);[Public,Alias:'FPC_READ_TEXT_'+{$ifdef NEWREADINT}'ANSISTR'{$else}'ANSISTRING'{$endif}];
var var
p,maxp,startp,sidx : PChar; len : longint;
maxlen,spos,len : longint;
Begin Begin
{ Delete the string } { Delete the string }
AnsiStr_Decr_ref (Pointer(S)); AnsiStr_Decr_ref (Pointer(S));
{ We assign room for 1024 characters totally at random.... } { We assign room for 1024 characters totally at random.... }
Pointer(s):=Pointer(NewAnsiString(1024)); Pointer(s):=Pointer(NewAnsiString(1024));
MaxLen:=1024; len:=ReadPCharLen(f,pchar(s),1024);
{ Check error and if file is open } pchar(pchar(s)+len)^:=#0;
If (InOutRes<>0) then PAnsiRec(Pointer(S)-FirstOff)^.Len:=len;
exit;
if (f.mode<>fmInput) Then
begin
InOutRes:=104;
exit;
end;
{ Read until #10 is found }
sidx:=pchar(s);
spos:=0;
repeat
If f.BufPos>=f.BufEnd Then
begin
FileFunc(f.InOutFunc)(f);
If f.BufPos>=f.BufEnd Then
break;
end;
p:=@f.Bufptr^[f.BufPos];
if SPos+f.BufEnd-f.BufPos>MaxLen then
maxp:=@f.BufPtr^[f.BufPos+MaxLen-SPos]
else
maxp:=@f.Bufptr^[f.BufEnd];
startp:=p;
{ search linefeed }
while (p<maxp) and (P^<>#10) do
inc(p);
{ calculate read bytes }
len:=p-startp;
inc(f.BufPos,Len);
Move(startp^,sidx^,Len);
inc(sidx,len);
inc(spos,len);
{ was it a LF? then leave }
if (p<maxp) and (p^=#10) then
begin
If pchar(sidx-1)^=#13 Then
begin
dec(sidx);
dec(spos);
end;
break;
end;
{ Maxlen reached ? }
if spos=MaxLen then
break;
until false;
sidx^:=#0;
PAnsiRec(Pointer(S)-FirstOff)^.Len:=spos;
End; End;
@ -1335,7 +1211,11 @@ end;
{ {
$Log$ $Log$
Revision 1.44 1999-04-08 15:57:57 peter Revision 1.45 1999-04-26 18:27:26 peter
* fixed write array
* read array with maxlen
Revision 1.44 1999/04/08 15:57:57 peter
+ subrange checking for readln() + subrange checking for readln()
Revision 1.43 1999/04/07 22:05:18 peter Revision 1.43 1999/04/07 22:05:18 peter