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

* Better use of routines in pbase and symtable. 4k code removed.

Browse Source
This commit is contained in:
daniel 1999-04-14 18:41:24 +00:00
parent 9d1959e462
commit 1335d7de8a
2 changed files with 52 additions and 55 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
compiler/pbase.pas
View File

@ -68,6 +68,10 @@ unit pbase;
{ a syntax error is written } { a syntax error is written }
procedure consume(i : ttoken); procedure consume(i : ttoken);
{Tries to consume the token i, and returns true if it was consumed:
if token=i.}
function try_to_consume(i:Ttoken):boolean;
{ consumes all tokens til atoken (for error recovering } { consumes all tokens til atoken (for error recovering }
procedure consume_all_until(atoken : ttoken); procedure consume_all_until(atoken : ttoken);
@ -112,6 +116,19 @@ unit pbase;
end; end;
end; end;
function try_to_consume(i:Ttoken):boolean;
begin
try_to_consume:=false;
if (token=i) or (idtoken=i) then
begin
try_to_consume:=true;
if token=_END then
last_endtoken_filepos:=tokenpos;
current_scanner^.readtoken;
end;
end;
procedure consume_all_until(atoken : ttoken); procedure consume_all_until(atoken : ttoken);
begin begin
@ -130,8 +147,8 @@ unit pbase;
procedure emptystats; procedure emptystats;
begin begin
while token=SEMICOLON do repeat
consume(SEMICOLON); until not try_to_consume(semicolon);
end; end;
@ -183,7 +200,10 @@ end.
{ {
$Log$ $Log$
Revision 1.19 1999-04-08 20:59:42 florian Revision 1.20 1999-04-14 18:41:24 daniel
* Better use of routines in pbase and symtable. 4k code removed.
Revision 1.19 1999/04/08 20:59:42 florian
* fixed problem with default properties which are a class * fixed problem with default properties which are a class
* case bug (from the mailing list with -O2) fixed, the * case bug (from the mailing list with -O2) fixed, the
distance of the case labels can be greater than the positive distance of the case labels can be greater than the positive

77
compiler/pstatmnt.pas
View File

@ -87,11 +87,8 @@ unit pstatmnt;
else else
if_a:=nil; if_a:=nil;
if token=_ELSE then if try_to_consume(_ELSE) then
begin else_a:=statement
consume(_ELSE);
else_a:=statement;
end
else else
else_a:=nil; else_a:=nil;
if_statement:=genloopnode(ifn,ex,if_a,else_a,false); if_statement:=genloopnode(ifn,ex,if_a,else_a,false);
@ -117,13 +114,9 @@ unit pstatmnt;
last^.left:=gennode(statementn,nil,statement); last^.left:=gennode(statementn,nil,statement);
last:=last^.left; last:=last^.left;
end; end;
if token<>SEMICOLON then if not try_to_consume(SEMICOLON) then
break break;
else emptystats;
consume(SEMICOLON);
while token=SEMICOLON do
consume(SEMICOLON);
end; end;
consume(_END); consume(_END);
statements_til_end:=gensinglenode(blockn,first); statements_til_end:=gensinglenode(blockn,first);
@ -263,8 +256,8 @@ unit pstatmnt;
if (token=_ELSE) or (token=_OTHERWISE) then if (token=_ELSE) or (token=_OTHERWISE) then
begin begin
if token=_ELSE then consume(_ELSE) if not try_to_consume(_ELSE) then
else consume(_OTHERWISE); consume(_OTHERWISE);
elseblock:=statements_til_end; elseblock:=statements_til_end;
end end
else else
@ -304,11 +297,9 @@ unit pstatmnt;
last^.left:=gennode(statementn,nil,statement); last^.left:=gennode(statementn,nil,statement);
last:=last^.left; last:=last^.left;
end; end;
if token<>SEMICOLON then if not try_to_consume(SEMICOLON) then
break; break;
consume(SEMICOLON); emptystats;
while token=SEMICOLON do
consume(SEMICOLON);
end; end;
consume(_UNTIL); consume(_UNTIL);
dec(statement_level); dec(statement_level);
@ -545,16 +536,14 @@ unit pstatmnt;
last^.left:=gennode(statementn,nil,statement); last^.left:=gennode(statementn,nil,statement);
last:=last^.left; last:=last^.left;
end; end;
if token<>SEMICOLON then if not try_to_consume(SEMICOLON) then
break; break;
consume(SEMICOLON);
emptystats; emptystats;
end; end;
p_try_block:=gensinglenode(blockn,first); p_try_block:=gensinglenode(blockn,first);
if token=_FINALLY then if try_to_consume(_FINALLY) then
begin begin
consume(_FINALLY);
p_finally_block:=statements_til_end; p_finally_block:=statements_til_end;
try_statement:=gennode(tryfinallyn,p_try_block,p_finally_block); try_statement:=gennode(tryfinallyn,p_try_block,p_finally_block);
dec(statement_level); dec(statement_level);
@ -577,9 +566,8 @@ unit pstatmnt;
objname:=pattern; objname:=pattern;
consume(ID); consume(ID);
{ is a explicit name for the exception given ? } { is a explicit name for the exception given ? }
if token=COLON then if try_to_consume(COLON) then
begin begin
consume(COLON);
getsym(pattern,true); getsym(pattern,true);
consume(ID); consume(ID);
if srsym^.typ=unitsym then if srsym^.typ=unitsym then
@ -651,9 +639,8 @@ unit pstatmnt;
{ remove exception symtable } { remove exception symtable }
if assigned(exceptsymtable) then if assigned(exceptsymtable) then
dellexlevel; dellexlevel;
if token<>SEMICOLON then if not try_to_consume(SEMICOLON) then
break; break;
consume(SEMICOLON);
emptystats; emptystats;
until (token=_END) or(token=_ELSE); until (token=_END) or(token=_ELSE);
if token=_ELSE then if token=_ELSE then
@ -685,9 +672,8 @@ unit pstatmnt;
begin begin
consume(_EXIT); consume(_EXIT);
if token=LKLAMMER then if try_to_consume(LKLAMMER) then
begin begin
consume(LKLAMMER);
p:=comp_expr(true); p:=comp_expr(true);
consume(RKLAMMER); consume(RKLAMMER);
if procinfo.retdef=pdef(voiddef) then if procinfo.retdef=pdef(voiddef) then
@ -746,10 +732,9 @@ unit pstatmnt;
consume(_ASM); consume(_ASM);
{ END is read } { END is read }
if token=LECKKLAMMER then if try_to_consume(LECKKLAMMER) then
begin begin
{ it's possible to specify the modified registers } { it's possible to specify the modified registers }
consume(LECKKLAMMER);
asmstat^.object_preserved:=true; asmstat^.object_preserved:=true;
if token<>RECKKLAMMER then if token<>RECKKLAMMER then
repeat repeat
@ -786,8 +771,8 @@ unit pstatmnt;
{$endif m68k} {$endif m68k}
else consume(RECKKLAMMER); else consume(RECKKLAMMER);
consume(CSTRING); consume(CSTRING);
if token=COMMA then consume(COMMA) if not try_to_consume(COMMA) then
else break; break;
until false; until false;
consume(RECKKLAMMER); consume(RECKKLAMMER);
end end
@ -822,12 +807,13 @@ unit pstatmnt;
tt : ttreetyp; tt : ttreetyp;
begin begin
ht:=token; ht:=token;
if token=_NEW then consume(_NEW) if try_to_consume(_NEW) then
else consume(_DISPOSE);
if ht=_NEW then
tt:=hnewn tt:=hnewn
else else
begin
consume(_DISPOSE);
tt:=hdisposen; tt:=hdisposen;
end;
consume(LKLAMMER); consume(LKLAMMER);
p:=comp_expr(true); p:=comp_expr(true);
@ -843,11 +829,10 @@ unit pstatmnt;
new(o,init); (*Also a valid new statement*) new(o,init); (*Also a valid new statement*)
end;} end;}
if token=COMMA then if try_to_consume(COMMA) then
begin begin
{ extended syntax of new and dispose } { extended syntax of new and dispose }
{ function styled new is handled in factor } { function styled new is handled in factor }
consume(COMMA);
{ destructors have no parameters } { destructors have no parameters }
destrukname:=pattern; destrukname:=pattern;
consume(ID); consume(ID);
@ -884,18 +869,7 @@ unit pstatmnt;
exit; exit;
end; end;
{ search cons-/destructor, also in parent classes } { search cons-/destructor, also in parent classes }
sym:=nil; sym:=search_class_member(classh,pattern);
while assigned(classh) do
begin
store_allow:=allow_only_static;
allow_only_static:=false;
sym:=classh^.publicsyms^.search(pattern);
allow_only_static:=store_allow;
srsymtable:=classh^.publicsyms;
if assigned(sym) then
break;
classh:=classh^.childof;
end;
{ the second parameter of new/dispose must be a call } { the second parameter of new/dispose must be a call }
{ to a cons-/destructor } { to a cons-/destructor }
if (not assigned(sym)) or (sym^.typ<>procsym) then if (not assigned(sym)) or (sym^.typ<>procsym) then
@ -1291,7 +1265,10 @@ unit pstatmnt;
end. end.
{ {
$Log$ $Log$
Revision 1.75 1999-04-14 09:14:53 peter Revision 1.76 1999-04-14 18:41:25 daniel
* Better use of routines in pbase and symtable. 4k code removed.
Revision 1.75 1999/04/14 09:14:53 peter
* first things to store the symbol/def number in the ppu * first things to store the symbol/def number in the ppu
Revision 1.74 1999/04/09 12:22:06 pierre Revision 1.74 1999/04/09 12:22:06 pierre