paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-17 20:49:09 +02:00
Code Issues Packages Projects Releases Wiki Activity

* changed LexLib IO functions into a procedure variables so they can be overridden while keeping the rest of LexLib

Browse Source 
Reintegrate fpcres-rc branch by Martok

git-svn-id: trunk@46370 -
This commit is contained in:
svenbarth 2020-08-12 19:02:13 +00:00
parent ddefc8a682
commit f31ed1551e
1 changed files with 14 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
utils/tply/lexlib.pas
View File

@ -70,15 +70,15 @@ yyleng : Byte (* length of matched text *)
put_char by another suitable set of routines, e.g. if you want to read put_char by another suitable set of routines, e.g. if you want to read
from/write to memory, etc. *) from/write to memory, etc. *)
function get_char : Char; var get_char: function : Char;
(* obtain one character from the input file (null character at end-of- (* obtain one character from the input file (null character at end-of-
file) *) file) *)
procedure unget_char ( c : Char ); var unget_char : procedure ( c : Char );
(* return one character to the input file to be reread in subsequent calls (* return one character to the input file to be reread in subsequent calls
to get_char *) to get_char *)
procedure put_char ( c : Char ); var put_char: procedure ( c : Char );
(* write one character to the output file *) (* write one character to the output file *)
(* Utility routines: *) (* Utility routines: *)
@ -185,7 +185,7 @@ var
bufptr : Integer; bufptr : Integer;
buf : array [1..max_chars] of Char; buf : array [1..max_chars] of Char;
function get_char : Char; function lexlib_get_char : Char;
var i : Integer; var i : Integer;
begin begin
if (bufptr=0) and not eof(yyinput) then if (bufptr=0) and not eof(yyinput) then
@ -199,15 +199,15 @@ function get_char : Char;
end; end;
if bufptr>0 then if bufptr>0 then
begin begin
get_char := buf[bufptr]; lexlib_get_char := buf[bufptr];
dec(bufptr); dec(bufptr);
inc(yycolno); inc(yycolno);
end end
else else
get_char := #0; lexlib_get_char := #0;
end(*get_char*); end(*get_char*);
procedure unget_char ( c : Char ); procedure lexlib_unget_char ( c : Char );
begin begin
if bufptr=max_chars then fatal('input buffer overflow'); if bufptr=max_chars then fatal('input buffer overflow');
inc(bufptr); inc(bufptr);
@ -215,7 +215,7 @@ procedure unget_char ( c : Char );
buf[bufptr] := c; buf[bufptr] := c;
end(*unget_char*); end(*unget_char*);
procedure put_char ( c : Char ); procedure lexlib_put_char ( c : Char );
begin begin
if c=#0 then if c=#0 then
{ ignore } { ignore }
@ -285,7 +285,7 @@ procedure reject;
begin begin
yyreject := true; yyreject := true;
for i := yyleng+1 to yysleng do for i := yyleng+1 to yysleng do
yytext := yytext+get_char; yytext := yytext+get_char();
dec(yymatches); dec(yymatches);
end(*reject*); end(*reject*);
@ -334,7 +334,7 @@ procedure yynew;
procedure yyscan; procedure yyscan;
begin begin
if yyleng=255 then fatal('yytext overflow'); if yyleng=255 then fatal('yytext overflow');
yyactchar := get_char; yyactchar := get_char();
inc(yyleng); inc(yyleng);
yytext[yyleng] := yyactchar; yytext[yyleng] := yyactchar;
end(*yyscan*); end(*yyscan*);
@ -380,7 +380,7 @@ function yyfind ( var n : Integer ) : Boolean;
function yydefault : Boolean; function yydefault : Boolean;
begin begin
yyreject := false; yyreject := false;
yyactchar := get_char; yyactchar := get_char();
if yyactchar<>#0 then if yyactchar<>#0 then
begin begin
put_char(yyactchar); put_char(yyactchar);
@ -406,6 +406,9 @@ procedure yyclear;
begin begin
yywrap := @lexlib_yywrap; yywrap := @lexlib_yywrap;
get_char:= @lexlib_get_char;
unget_char:= @lexlib_unget_char;
put_char:= @lexlib_put_char;
assign(yyinput, ''); assign(yyinput, '');
assign(yyoutput, ''); assign(yyoutput, '');
reset(yyinput); rewrite(yyoutput); reset(yyinput); rewrite(yyoutput);