paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-07 14:27:59 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Introduce m_processed

Browse Source
This commit is contained in:
Michaël Van Canneyt 2024-02-07 17:11:47 +01:00 committed by Michael Van Canneyt
parent 5298e25c84
commit 462c201ce6
4 changed files with 169 additions and 113 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

113
compiler/ctask.pas
View File

@ -57,9 +57,12 @@ type
public
constructor create;
destructor destroy; override;
// Find the task for module m
function findtask(m : tmodule) : ttask_list;
// Can we continue processing this module ?
function cancontinue(t : ttask_list) : boolean;
// Can we continue processing this module ? If not, firstwaiting contains first module that m is waiting for.
function cancontinue(m : tmodule; checksub : boolean; out firstwaiting: tmodule): boolean;
// Overload of cancontinue, based on task.
function cancontinue(t: ttask_list; out firstwaiting: tmodule): boolean; inline
// Continue processing this module. Return true if the module is done and can be removed.
function continue(t : ttask_list): Boolean;
// process the queue. Note that while processing the queue, elements will be added.
@ -77,7 +80,7 @@ procedure DoneTaskHandler;
implementation
uses verbose, finput, globtype, sysutils, scanner, parser, pmodules;
uses verbose, fppu, finput, globtype, sysutils, scanner, parser, pmodules;
procedure InitTaskHandler;
begin
@ -126,22 +129,21 @@ end;
procedure ttask_list.SaveState;
begin
if State=Nil then
State:=tglobalstate.Create(true);
State:=tglobalstate.Create(true)
else
State.save(true);
end;
procedure ttask_list.RestoreState;
begin
if not module.is_reset then
state.restore(true);
if assigned(current_scanner) and assigned(current_scanner.inputfile) then
if current_scanner.inputfile.closed then
begin
current_scanner.tempopeninputfile;
current_scanner.gettokenpos;
// parser_current_file:=current_scanner.inputfile.name;
end;
end;
{ ttask_handler }
@ -172,25 +174,63 @@ begin
end;
end;
function ttask_handler.cancontinue(t : ttask_list): boolean;
function ttask_handler.cancontinue(m: tmodule; checksub : boolean; out firstwaiting: tmodule): boolean;
procedure CheckUsed(out acandidate : tmodule);
var
itm : TLinkedListItem;
iscandidate : boolean;
m2 : tmodule;
begin
acandidate:=nil;
itm:=m.used_units.First;
while (acandidate=Nil) and assigned(itm) do
begin
iscandidate:=Not (tused_unit(itm).u.state in [ms_compiled]);
if iscandidate then
begin
acandidate:=tused_unit(itm).u;
if not cancontinue(acandidate,false,m2) then
acandidate:=nil;
end;
itm:=itm.Next;
end;
end;
var
m : tmodule;
m2 : tmodule;
begin
m:=t.module;
case m.state of
ms_unknown : cancontinue:=true;
ms_registered : cancontinue:=true;
ms_compile : cancontinue:=true;
ms_compiling_waitimpl : cancontinue:=m.usedunitsloaded(false);
ms_compiling_waitintf : cancontinue:=m.usedunitsloaded(true);
ms_compiling_wait : cancontinue:=m.usedunitsloaded(true);
ms_compiled : cancontinue:=true;
ms_moduleerror : cancontinue:=true;
else
InternalError(2024011802);
end;
firstwaiting:=nil;
if m.is_initial and (list.count>1) then
exit(False);
case m.state of
ms_unknown : cancontinue:=true;
ms_registered : cancontinue:=true;
ms_compile : cancontinue:=true;
ms_compiling_waitimpl : cancontinue:=m.usedunitsloaded(false,firstwaiting);
ms_compiling_waitintf : cancontinue:=m.usedunitsloaded(true,firstwaiting);
ms_compiling_wait : cancontinue:=m.usedunitsloaded(true,firstwaiting);
ms_compiled : cancontinue:=true;
ms_processed : cancontinue:=true;
ms_moduleerror : cancontinue:=true;
else
InternalError(2024011802);
end;
if (not cancontinue) and checksub then
begin
checkused(m2);
if m2<>nil then
firstwaiting:=m2;
end;
end;
function ttask_handler.cancontinue(t : ttask_list; out firstwaiting : tmodule): boolean;
begin
Result:=cancontinue(t.module,true,firstwaiting);
end;
function ttask_handler.continue(t : ttask_list) : Boolean;
@ -205,14 +245,23 @@ begin
case m.state of
ms_registered : parser.compile_module(m);
ms_compile : parser.compile_module(m);
ms_compiled : if (not m.is_initial) or m.is_unit then
(m as tppumodule).post_load_or_compile(m.compilecount>1);
ms_compiling_waitintf : pmodules.parse_unit_interface_declarations(m);
ms_compiling_waitimpl : pmodules.proc_unit_implementation(m);
ms_compiling_wait : pmodules.proc_program_declarations(m,m.islibrary);
ms_processed : ;
else
InternalError(2024011801);
end;
Result:=m.state=ms_compiled;
if not Result then
if m.state=ms_compiled then
begin
parsing_done(m);
if m.is_initial and not m.is_unit then
m.state:=ms_processed;
end;
Result:=m.state=ms_processed;
if not result then
// Not done, save state
t.SaveState;
end;
@ -220,14 +269,15 @@ end;
procedure ttask_handler.processqueue;
var
t : ttask_list;
t,t2 : ttask_list;
process : boolean;
m,firstwaiting : tmodule;
begin
t:=list.firsttask;
While t<>nil do
begin
process:=cancontinue(t);
process:=cancontinue(t,firstwaiting);
if process then
begin
if continue(t) then
@ -238,14 +288,22 @@ begin
// maybe the strategy can be improved.
t:=list.firsttask;
end
else if assigned(firstwaiting) and cancontinue(firstwaiting,true, m) then
begin
t2:=findtask(firstwaiting);
if t2=nil then
t2:=t.nexttask;
t:=t2;
end
else
begin
t:=t.nexttask;
end;
end;
end;
procedure ttask_handler.addmodule(m: tmodule);
var
n : TSymStr;
e : tmodule;
@ -265,7 +323,6 @@ begin
else
begin
// We have a task, if it was reset, then clear the state and move the task to the start.
if m.is_reset then
begin
m.is_reset:=false;

4
compiler/finput.pas
View File

@ -123,8 +123,11 @@ interface
ms_compiling_waitimpl,
ms_compiling_wait,
ms_compiled,
ms_processed,
ms_moduleerror
);
tmodulestates = set of tmodulestate;
const
ModuleStateStr : array[TModuleState] of string[32] = (
'Unknown',
@ -135,6 +138,7 @@ interface
'Compiling_Waiting_implementation',
'Compiling_Waiting',
'Compiled',
'Processed',
'Error'
);

163
compiler/parser.pas
View File

@ -30,8 +30,9 @@ uses fmodule;
{$ifdef PREPROCWRITE}
procedure preprocess(const filename:string);
{$endif PREPROCWRITE}
procedure compile(const filename:string);
procedure compile_module(module : tmodule);
function compile(const filename:string) : boolean;
function compile_module(module : tmodule) : boolean;
procedure parsing_done(module : tmodule);
procedure initparser;
procedure doneparser;
@ -54,6 +55,71 @@ implementation
pbase,psystem,pmodules,psub,ncgrtti,
cpuinfo,procinfo;
procedure parsing_done(module: tmodule);
var
hp,hp2 : tmodule;
begin
module.end_of_parsing;
if (module.is_initial) and
(status.errorcount=0) then
{ Write Browser Collections }
do_extractsymbolinfo;
// olddata.restore(false);
{ Restore all locally modified warning messages }
RestoreLocalVerbosity(current_settings.pmessage);
current_exceptblock:=0;
exceptblockcounter:=0;
{ Shut down things when the last file is compiled succesfull }
if (module.is_initial) and (module.state=ms_compiled) and
(status.errorcount=0) then
begin
parser_current_file:='';
{ Close script }
if (not AsmRes.Empty) then
begin
Message1(exec_i_closing_script,AsmRes.Fn);
AsmRes.WriteToDisk;
end;
end;
{ free now what we did not free earlier in
proc_program PM }
if (module.is_initial) and (module.state=ms_compiled) and needsymbolinfo then
begin
hp:=tmodule(loaded_units.first);
while assigned(hp) do
begin
hp2:=tmodule(hp.next);
if (hp<>module) then
begin
loaded_units.remove(hp);
hp.free;
end;
hp:=hp2;
end;
{ free also unneeded units we didn't free before }
unloaded_units.Clear;
end;
{ If used units are compiled current_module is already the same as
the stored module. Now if the unit is not finished its scanner is
not yet freed and thus set_current_module would reopen the scanned
file which will result in pointing to the wrong position in the
file. In the normal case current_scanner and current_module.scanner
would be Nil, thus nothing bad would happen }
{ if olddata.old_current_module<>current_module then
set_current_module(olddata.old_current_module);}
FreeLocalVerbosity(current_settings.pmessage);
end;
procedure initparser;
begin
@ -321,27 +387,26 @@ implementation
Compile a source file
*****************************************************************************}
procedure compile(const filename:string);
function compile(const filename:string) : boolean;
var
m : TModule;
begin
m:=tppumodule.create(nil,'',filename,false);
// m.is_initial:=initial;
m.state:=ms_compile;
compile_module(m);
result:=compile_module(m);
end;
procedure compile_module(module : tmodule);
function compile_module(module : tmodule) : boolean;
var
olddata : tglobalstate;
hp,hp2 : tmodule;
finished : boolean;
sc : tscannerfile;
begin
Result:=True;
{ parsing a procedure or declaration should be finished }
if assigned(current_procinfo) then
internalerror(200811121);
@ -354,7 +419,6 @@ implementation
recursively }
{ handle the postponed case first }
flushpendingswitchesstate;
olddata:=tglobalstate.create(false);
{ reset parser, a previous fatal error could have left these variables in an unreliable state, this is
important for the IDE }
@ -431,10 +495,10 @@ implementation
else if (token=_ID) and (idtoken=_PACKAGE) then
begin
module.IsPackage:=true;
proc_package(module);
finished:=proc_package(module);
end
else
proc_program(module,token=_LIBRARY);
finished:=proc_program(module,token=_LIBRARY);
except
on ECompilerAbort do
raise;
@ -451,83 +515,14 @@ implementation
raise;
end;
end;
Result:=Finished;
{ the program or the unit at the command line should not need to wait
for other units }
if (module.is_initial) and not finished then
internalerror(2012091901);
// if (module.is_initial) and not finished then
// internalerror(2012091901);
finally
if assigned(module) then
begin
if finished then
module.end_of_parsing
else
begin
{ these are saved in the unit's state and thus can be set to
Nil again as would be done by tmodule.end_of_parsing }
macrosymtablestack:=nil;
symtablestack:=nil;
if current_scanner=current_module.scanner then
set_current_scanner(nil);
end;
end;
if (module.is_initial) and
(status.errorcount=0) then
{ Write Browser Collections }
do_extractsymbolinfo;
olddata.restore(false);
{ Restore all locally modified warning messages }
RestoreLocalVerbosity(current_settings.pmessage);
current_exceptblock:=0;
exceptblockcounter:=0;
{ Shut down things when the last file is compiled succesfull }
if (module.is_initial) and
(status.errorcount=0) then
begin
parser_current_file:='';
{ Close script }
if (not AsmRes.Empty) then
begin
Message1(exec_i_closing_script,AsmRes.Fn);
AsmRes.WriteToDisk;
end;
end;
{ free now what we did not free earlier in
proc_program PM }
if (module.is_initial) and needsymbolinfo then
begin
hp:=tmodule(loaded_units.first);
while assigned(hp) do
begin
hp2:=tmodule(hp.next);
if (hp<>module) then
begin
loaded_units.remove(hp);
hp.free;
end;
hp:=hp2;
end;
{ free also unneeded units we didn't free before }
unloaded_units.Clear;
end;
{ If used units are compiled current_module is already the same as
the stored module. Now if the unit is not finished its scanner is
not yet freed and thus set_current_module would reopen the scanned
file which will result in pointing to the wrong position in the
file. In the normal case current_scanner and current_module.scanner
would be Nil, thus nothing bad would happen }
if olddata.old_current_module<>current_module then
set_current_module(olddata.old_current_module);
FreeLocalVerbosity(current_settings.pmessage);
FreeAndNil(olddata);
if finished then
parsing_done(module);
end;
end;

2
compiler/scanner.pas
View File

@ -3029,7 +3029,7 @@ type
if assigned(onfreescanner) then
onfreescanner(self);
if assigned(current_module) and
(current_module.state=ms_compiled) and
(current_module.state in [ms_processed,ms_compiled]) and
(status.errorcount=0) then
checkpreprocstack
else