* Introduce m_processed

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;

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'
         );
 

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;
 

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