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

* changed resulttype and firstpass processing from recursion into loop, based

Browse Source 
on patch/idea by J. Gareth Moreton (as part of his patch in #35857)

git-svn-id: trunk@43004 -
This commit is contained in:
Jonas Maebe 2019-09-15 16:18:14 +00:00
parent f4921daee6
commit 9e7cf37cd6
1 changed files with 95 additions and 109 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

204
compiler/pass_1.pas
View File

@ -59,54 +59,61 @@ implementation
Global procedures Global procedures
*****************************************************************************} *****************************************************************************}
procedure typecheckpass_internal_loop(var p : tnode; out node_changed: boolean);
var
hp : tnode;
begin
codegenerror:=false;
repeat
current_filepos:=p.fileinfo;
current_settings.localswitches:=p.localswitches;
status.verbosity:=p.verbosity;
hp:=p.pass_typecheck;
{ should the node be replaced? }
if assigned(hp) then
begin
node_changed:=true;
p.free;
{ switch to new node }
p:=hp;
end;
until not assigned(hp) or
assigned(hp.resultdef);
if codegenerror then
begin
include(p.flags,nf_error);
{ default to errortype if no type is set yet }
if p.resultdef=nil then
p.resultdef:=generrordef;
end;
end;
procedure typecheckpass_internal(var p : tnode; out node_changed: boolean); procedure typecheckpass_internal(var p : tnode; out node_changed: boolean);
var var
oldcodegenerror : boolean; oldcodegenerror : boolean;
oldlocalswitches : tlocalswitches; oldlocalswitches : tlocalswitches;
oldverbosity : longint; oldverbosity : longint;
oldpos : tfileposinfo; oldpos : tfileposinfo;
hp : tnode;
begin begin
node_changed:=false; node_changed:=false;
if (p.resultdef=nil) then if (p.resultdef=nil) then
begin begin
oldcodegenerror:=codegenerror; oldcodegenerror:=codegenerror;
oldpos:=current_filepos; oldpos:=current_filepos;
oldlocalswitches:=current_settings.localswitches; oldlocalswitches:=current_settings.localswitches;
oldverbosity:=status.verbosity; oldverbosity:=status.verbosity;
codegenerror:=false; typecheckpass_internal_loop(p, node_changed);
current_filepos:=p.fileinfo; current_settings.localswitches:=oldlocalswitches;
current_settings.localswitches:=p.localswitches; current_filepos:=oldpos;
status.verbosity:=p.verbosity; status.verbosity:=oldverbosity;
hp:=p.pass_typecheck; codegenerror:=codegenerror or oldcodegenerror;
{ should the node be replaced? } end
if assigned(hp) then
begin
node_changed:=true;
p.free;
{ switch to new node }
p:=hp;
{ run typecheckpass }
typecheckpass(p);
end;
current_settings.localswitches:=oldlocalswitches;
current_filepos:=oldpos;
status.verbosity:=oldverbosity;
if codegenerror then
begin
include(p.flags,nf_error);
{ default to errortype if no type is set yet }
if p.resultdef=nil then
p.resultdef:=generrordef;
end;
codegenerror:=codegenerror or oldcodegenerror;
end
else else
begin begin
{ update the codegenerror boolean with the previous result of this node } { update the codegenerror boolean with the previous result of this node }
if (nf_error in p.flags) then if (nf_error in p.flags) then
codegenerror:=true; codegenerror:=true;
end; end;
end; end;
@ -141,84 +148,63 @@ implementation
oldpos : tfileposinfo; oldpos : tfileposinfo;
oldverbosity: longint; oldverbosity: longint;
hp : tnode; hp : tnode;
nodechanged : boolean;
begin begin
if (nf_pass1_done in p.flags) then if (nf_pass1_done in p.flags) then
exit; exit;
if not(nf_error in p.flags) then if not(nf_error in p.flags) then
begin begin
oldcodegenerror:=codegenerror; oldcodegenerror:=codegenerror;
oldpos:=current_filepos; oldpos:=current_filepos;
oldlocalswitches:=current_settings.localswitches; oldlocalswitches:=current_settings.localswitches;
oldverbosity:=status.verbosity; oldverbosity:=status.verbosity;
codegenerror:=false; codegenerror:=false;
current_filepos:=p.fileinfo; repeat
current_settings.localswitches:=p.localswitches; { checks make always a call }
status.verbosity:=p.verbosity; if ([cs_check_range,cs_check_overflow,cs_check_stack] * current_settings.localswitches <> []) then
{ checks make always a call } include(current_procinfo.flags,pi_do_call);
if ([cs_check_range,cs_check_overflow,cs_check_stack] * current_settings.localswitches <> []) then { determine the resultdef if not done }
include(current_procinfo.flags,pi_do_call); if (p.resultdef=nil) then
{ determine the resultdef if not done } begin
if (p.resultdef=nil) then typecheckpass_internal_loop(p,nodechanged);
begin end;
hp:=p.pass_typecheck;
{ should the node be replaced? } hp:=nil;
if assigned(hp) then if not(nf_error in p.flags) then
begin begin
p.free; current_filepos:=p.fileinfo;
{ switch to new node } current_settings.localswitches:=p.localswitches;
p:=hp; status.verbosity:=p.verbosity;
{ run typecheckpass } { first pass }
typecheckpass(p); hp:=p.pass_1;
end; { inlining happens in pass_1 and can cause new }
if codegenerror then { simplify opportunities }
begin if not assigned(hp) then
include(p.flags,nf_error); hp:=p.simplify(true);
{ default to errortype if no type is set yet } { should the node be replaced? }
if p.resultdef=nil then if assigned(hp) then
p.resultdef:=generrordef; begin
end; p.free;
codegenerror:=codegenerror or oldcodegenerror; { switch to new node }
end; p:=hp;
if not(nf_error in p.flags) then end;
begin if codegenerror then
{ first pass } include(p.flags,nf_error)
hp:=p.pass_1; else
{ should the node be replaced? } begin
if assigned(hp) then
begin
p.free;
{ switch to new node }
p := hp;
{ run firstpass }
firstpass(p);
end
else
begin
{ inlining happens in pass_1 and can cause new }
{ simplify opportunities }
hp:=p.simplify(true);
if assigned(hp) then
begin
p.free;
p := hp;
firstpass(p);
end;
end;
if codegenerror then
include(p.flags,nf_error)
else
begin
{$ifdef EXTDEBUG} {$ifdef EXTDEBUG}
if (p.expectloc=LOC_INVALID) then if (p.expectloc=LOC_INVALID) then
Comment(V_Warning,'Expectloc is not set in firstpass: '+nodetype2str[p.nodetype]); Comment(V_Warning,'Expectloc is not set in firstpass: '+nodetype2str[p.nodetype]);
{$endif EXTDEBUG} {$endif EXTDEBUG}
end; end;
end; end;
include(p.flags,nf_pass1_done); until not assigned(hp) or
codegenerror:=codegenerror or oldcodegenerror; (nf_pass1_done in hp.flags);
current_settings.localswitches:=oldlocalswitches; include(p.flags,nf_pass1_done);
current_filepos:=oldpos; codegenerror:=codegenerror or oldcodegenerror;
status.verbosity:=oldverbosity; current_settings.localswitches:=oldlocalswitches;
current_filepos:=oldpos;
status.verbosity:=oldverbosity;
end end
else else
codegenerror:=true; codegenerror:=true;