diff --git a/compiler/ctask.pas b/compiler/ctask.pas index 11a8bc7c3c..ce991c5135 100644 --- a/compiler/ctask.pas +++ b/compiler/ctask.pas @@ -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; diff --git a/compiler/finput.pas b/compiler/finput.pas index 60f1500986..790554f4b8 100644 --- a/compiler/finput.pas +++ b/compiler/finput.pas @@ -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' ); diff --git a/compiler/parser.pas b/compiler/parser.pas index 69a9c35887..dc52954dc3 100644 --- a/compiler/parser.pas +++ b/compiler/parser.pas @@ -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; diff --git a/compiler/scanner.pas b/compiler/scanner.pas index b854762cb9..4352d80a0c 100644 --- a/compiler/scanner.pas +++ b/compiler/scanner.pas @@ -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