* Introduce task (Single main-level task at the moment, no change in behaviour).

compiler/compiler.pas

@@ -152,6 +152,7 @@ uses
 {$ifdef aix}
   ,i_aix
 {$endif aix}
+  ,ctask
   ,globtype;
 
 function Compile(const cmd:TCmdStr):longint;
@@ -159,6 +160,8 @@ function Compile(const cmd:TCmdStr):longint;
 implementation
 
 uses
+  finput,
+  fppu,
   aasmcpu;
 
 {$if defined(MEMDEBUG)}
@@ -196,6 +199,7 @@ begin
   DoneGlobals;
   DoneFileUtils;
   donetokens;
+  DoneTaskHandler;
 end;
 
 
@@ -233,6 +237,7 @@ begin
   InitAsm;
   InitWpo;
 
+  InitTaskHandler;
   CompilerInitedAfterArgs:=true;
 end;
 
@@ -261,6 +266,8 @@ var
 {$endif SHOWUSEDMEM}
   ExceptionMask : TFPUExceptionMask;
   totaltime : real;
+  m : tppumodule;
+
 begin
   try
     try
@@ -291,7 +298,14 @@ begin
         parser.preprocess(inputfilepath+inputfilename)
        else
   {$endif PREPROCWRITE}
-        parser.compile(inputfilepath+inputfilename);
+         begin
+         m:=tppumodule.create(Nil,'',inputfilepath+inputfilename,false);
+         m.state:=ms_compile;
+         m.is_initial:=true;
+         task_handler.addmodule(m);
+         task_handler.processqueue;
+         end;
+
 
        { Show statistics }
        if status.errorcount=0 then

compiler/ctask.pas

@@ -0,0 +1,286 @@
+{
+    Copyright (c) 2024- by Michael Van Canneyt
+
+    This unit handles the compiler tasks.
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ ****************************************************************************
+}
+
+unit ctask;
+
+{$mode ObjFPC}
+
+interface
+
+uses
+  fmodule, cclasses, globstat;
+
+type
+  { ttask_list }
+
+  ttask_list = class(tlinkedlistitem)
+     module : tmodule;
+     state : tglobalstate;
+     constructor create(_m : tmodule);
+     destructor destroy; override;
+     procedure SaveState;
+     Procedure RestoreState;
+     procedure DiscardState;
+     function nexttask : ttask_list; inline;
+  end;
+
+  ttasklinkedlist = class(tlinkedlist)
+    function firsttask : ttask_list; inline;
+  end;
+
+  { ttask_handler }
+
+
+  ttask_handler = class
+  private
+    list : ttasklinkedlist;
+    hash : TFPHashList;
+    main : tmodule;
+  public
+    constructor create;
+    destructor destroy; override;
+    function findtask(m : tmodule) : ttask_list;
+    // Can we continue processing this module ?
+    function cancontinue(t : ttask_list) : boolean;
+    // 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.
+    procedure processqueue;
+    // add a module to the queue. If a module is already in the queue, we do not add it again.
+    procedure addmodule(m : tmodule);
+  end;
+
+
+var
+  task_handler : TTask_handler;
+
+procedure InitTaskHandler;
+procedure DoneTaskHandler;
+
+implementation
+
+uses verbose, finput, globtype, sysutils, scanner, parser, pmodules;
+
+procedure InitTaskHandler;
+begin
+  task_handler:=ttask_handler.create;
+end;
+
+procedure DoneTaskHandler;
+begin
+  freeandnil(task_handler);
+end;
+
+{ ttasklinkedlist }
+
+function ttasklinkedlist.firsttask: ttask_list;
+begin
+  Result:=ttask_list(first);
+end;
+
+{ ttask_list }
+
+constructor ttask_list.create(_m: tmodule);
+begin
+  inherited create;
+  module:=_m;
+  state:=nil;
+end;
+
+
+destructor ttask_list.destroy;
+begin
+  DiscardState;
+  Inherited;
+end;
+
+procedure ttask_list.DiscardState;
+
+begin
+  FreeAndNil(state);
+end;
+
+function ttask_list.nexttask: ttask_list;
+begin
+  Result:=ttask_list(next);
+end;
+
+procedure ttask_list.SaveState;
+begin
+  if State=Nil then
+    State:=tglobalstate.Create(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 }
+
+constructor ttask_handler.create;
+begin
+  list:=ttasklinkedlist.Create;
+  hash:=TFPHashList.Create;
+end;
+
+destructor ttask_handler.destroy;
+begin
+  hash.free;
+  List.Clear;
+  FreeAndNil(list);
+  inherited destroy;
+end;
+
+function ttask_handler.findtask(m: tmodule): ttask_list;
+
+begin
+  result:=list.FirstTask;
+  while result<>nil do
+    begin
+    if result.module=m then
+      exit;
+    result:=result.nexttask;
+    end;
+end;
+
+function ttask_handler.cancontinue(t : ttask_list): boolean;
+
+var
+  m : 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;
+end;
+
+function ttask_handler.continue(t : ttask_list) : Boolean;
+
+var
+  m : tmodule;
+
+begin
+  m:=t.module;
+  if Assigned(t.state) then
+    t.RestoreState;
+  case m.state of
+    ms_registered : parser.compile_module(m);
+    ms_compile : parser.compile_module(m);
+    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);
+  else
+    InternalError(2024011801);
+  end;
+  Result:=m.state=ms_compiled;
+  if not Result then
+    // Not done, save state
+    t.SaveState;
+end;
+
+procedure ttask_handler.processqueue;
+
+var
+  t : ttask_list;
+  process : boolean;
+
+begin
+  t:=list.firsttask;
+  While t<>nil do
+    begin
+    process:=cancontinue(t);
+    if process then
+      begin
+      if continue(t) then
+        begin
+        hash.Remove(t.module);
+        list.Remove(t);
+        end;
+      // maybe the strategy can be improved.
+      t:=list.firsttask;
+      end
+    else
+      t:=t.nexttask;
+    end;
+end;
+
+procedure ttask_handler.addmodule(m: tmodule);
+
+
+var
+  n : TSymStr;
+  e : tmodule;
+  t : ttask_list;
+
+begin
+  n:=m.modulename^;
+  e:=tmodule(Hash.Find(n));
+  if e=nil then
+    begin
+    t:=ttask_list.create(m);
+    list.insert(t);
+    hash.Add(n,t);
+    if list.count=1 then
+      main:=m;
+    end
+  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;
+      t:=findtask(m);
+      if assigned(t) then
+        begin
+        t.DiscardState;
+        list.Remove(t);
+        list.insertbefore(t,list.First);
+        end;
+      end;
+    end;
+end;
+
+
+
+end.
+

compiler/finput.pas

@@ -117,17 +117,25 @@ interface
      type
         tmodulestate = (ms_unknown,
           ms_registered,
-          ms_load,ms_compile,
-          ms_second_load,ms_second_compile,
-          ms_compiled
+          ms_load,
+          ms_compile,
+          ms_compiling_waitintf,
+          ms_compiling_waitimpl,
+          ms_compiling_wait,
+          ms_compiled,
+          ms_moduleerror
         );
      const
-        ModuleStateStr : array[TModuleState] of string[20] = (
+        ModuleStateStr : array[TModuleState] of string[32] = (
           'Unknown',
           'Registered',
-          'Load','Compile',
-          'Second_Load','Second_Compile',
-          'Compiled'
+          'Load',
+          'Compile',
+          'Compiling_Waiting_interface',
+          'Compiling_Waiting_implementation',
+          'Compiling_Waiting',
+          'Compiled',
+          'Error'
         );
 
      type
@@ -162,6 +170,7 @@ interface
 {$ifdef DEBUG_NODE_XML}
           ppxfilefail: Boolean;     { If the ppxfile could not be accessed, flag it }
 {$endif DEBUG_NODE_XML}
+          is_initial : boolean;     { is this the initial module, i.e. the one specified on the command-line ?}
           constructor create(const s:string);
           destructor destroy;override;
           procedure setfilename(const fn:TPathStr;allowoutput:boolean);
@@ -627,8 +636,7 @@ uses
            p:=path;
 
          { lib and exe could be loaded with a file specified with -o }
-         if AllowOutput and
-            (compile_level=1) and
+         if AllowOutput and is_initial and
             (OutputFileName<>'')then
            begin
              exefilename:=p+OutputFileName;

compiler/fmodule.pas

@@ -107,6 +107,7 @@ interface
       private
         FImportLibraryList : TFPHashObjectList;
       public
+        is_reset,                 { has reset been called ? }
         do_reload,                { force reloading of the unit }
         do_compile,               { need to compile the sources }
         sources_avail,            { if all sources are reachable }
@@ -198,6 +199,8 @@ interface
 
         moduleoptions: tmoduleoptions;
         deprecatedmsg: pshortstring;
+        loadcount : integer;
+        compilecount : integer;
 
         { contains a list of types that are extended by helper types; the key is
           the full name of the type and the data is a TFPObjectList of
@@ -251,6 +254,7 @@ interface
         procedure addimportedsym(sym:TSymEntry);
         function  addusedunit(hp:tmodule;inuses:boolean;usym:tunitsym):tused_unit;
         function  usesmodule_in_interface(m : tmodule) : boolean;
+        function usedunitsloaded(interface_units: boolean): boolean;
         procedure updatemaps;
         function  derefidx_unit(id:longint):longint;
         function  resolve_unit(id:longint):tmodule;
@@ -782,6 +786,7 @@ implementation
         i   : longint;
         current_debuginfo_reset : boolean;
       begin
+        is_reset:=true;
         if assigned(scanner) then
           begin
             { also update current_scanner if it was pointing
@@ -1000,7 +1005,7 @@ implementation
               (pm.u.state<>ms_compiled) then
              Message1(unit_u_no_reload_is_caller,pm.u.modulename^)
            else
-            if pm.u.state=ms_second_compile then
+            if (pm.u.state=ms_compile) and (pm.u.compilecount>1) then
               Message1(unit_u_no_reload_in_second_compile,pm.u.modulename^)
            else
             begin
@@ -1027,6 +1032,27 @@ implementation
         addusedunit:=pu;
       end;
 
+
+    function tmodule.usedunitsloaded(interface_units : boolean): boolean;
+
+    var
+      itm : TLinkedListItem;
+
+    begin
+      Result:=True;
+      itm:=self.used_units.First;
+      while Result and assigned(itm) do
+        begin
+        if (tused_unit(itm).in_interface=interface_units) then
+          begin
+          result:=tused_unit(itm).u.state in [ms_compiled,ms_compiling_waitimpl];
+          if not result then
+            writeln('module ',modulename^,' : cannot continue, interface unit ',tused_unit(itm).u.modulename^,' is not fully loaded');
+          end;
+        itm:=itm.Next;
+        end;
+    end;
+
     function tmodule.usesmodule_in_interface(m: tmodule): boolean;
 
     var

compiler/fppu.pas

@@ -2177,14 +2177,14 @@ var
           flagdependent(from_module);
           { Reset the module }
           reset;
-          if state in [ms_compile,ms_second_compile] then
+          if state in [ms_compile] then
             begin
               Message1(unit_u_second_compile_unit,modulename^);
-              state:=ms_second_compile;
+              state:=ms_compile;
               do_compile:=true;
             end
           else
-            state:=ms_second_load;
+            state:=ms_load;
         end;
 
     procedure tppumodule.try_load_ppufile(from_module : tmodule);
@@ -2249,7 +2249,7 @@ var
         { Reset the module }
         reset;
         { compile this module }
-        if not(state in [ms_compile,ms_second_compile]) then
+        if not (state in [ms_compile]) then
           state:=ms_compile;
         compile_module(self);
         setdefgeneration;

compiler/globals.pas

@@ -405,7 +405,6 @@ Const
 
        block_type : tblock_type;         { type of currently parsed block }
 
-       compile_level : word;
        exceptblockcounter    : integer;  { each except block gets a unique number check gotos      }
        current_exceptblock        : integer;  { the exceptblock number of the current block (0 if none) }
        LinkLibraryAliases : TLinkStrMap;
@@ -1702,7 +1701,6 @@ implementation
         do_build:=false;
         do_release:=false;
         do_make:=true;
-        compile_level:=0;
         codegenerror:=false;
 
         { Output }

compiler/parser.pas

@@ -347,7 +347,7 @@ implementation
            internalerror(200811121);
          if assigned(current_structdef) then
            internalerror(200811122);
-         inc(compile_level);
+         inc(module.compilecount);
          parser_current_file:=module.mainsource;
          { Uses heap memory instead of placing everything on the
            stack. This is needed because compile() can be called
@@ -383,7 +383,7 @@ implementation
 
        { reset the unit or create a new program }
          { a unit compiled at command line must be inside the loaded_unit list }
-         if (compile_level=1) then
+         if (module.is_initial) then
            begin
              if assigned(current_module) then
                internalerror(200501158);
@@ -395,7 +395,7 @@ implementation
          else
            set_current_module(module);
          if not(assigned(current_module) and
-                (current_module.state in [ms_compile,ms_second_compile])) then
+                (current_module.state in [ms_compile])) then
            internalerror(200212281);
 
          { load current asmdata from current_module }
@@ -423,7 +423,7 @@ implementation
            message if we are trying to use a program as unit.}
          try
            try
-             if (token=_UNIT) or (compile_level>1) then
+             if (token=_UNIT) or (not module.is_initial) then
                begin
                  module.is_unit:=true;
                  finished:=proc_unit(module);
@@ -454,7 +454,7 @@ implementation
 
            { the program or the unit at the command line should not need to wait
              for other units }
-           if (compile_level=1) and not finished then
+           if (module.is_initial) and not finished then
              internalerror(2012091901);
          finally
            if assigned(module) then
@@ -472,7 +472,7 @@ implementation
                  end;
              end;
 
-            if (compile_level=1) and
+            if (module.is_initial) and
                (status.errorcount=0) then
               { Write Browser Collections }
               do_extractsymbolinfo;
@@ -485,7 +485,7 @@ implementation
             exceptblockcounter:=0;
 
             { Shut down things when the last file is compiled succesfull }
-            if (compile_level=1) and
+            if (module.is_initial) and
                 (status.errorcount=0) then
               begin
                 parser_current_file:='';
@@ -499,7 +499,7 @@ implementation
 
           { free now what we did not free earlier in
             proc_program PM }
-          if (compile_level=1) and needsymbolinfo then
+          if (module.is_initial) and needsymbolinfo then
             begin
               hp:=tmodule(loaded_units.first);
               while assigned(hp) do
@@ -515,7 +515,7 @@ implementation
               { free also unneeded units we didn't free before }
               unloaded_units.Clear;
              end;
-           dec(compile_level);
+
            { 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

compiler/pmodules.pas

@@ -28,8 +28,11 @@ interface
 uses fmodule;
 
     function proc_unit(curr: tmodule):boolean;
+    function parse_unit_interface_declarations(curr : tmodule) : boolean;
+    function proc_unit_implementation(curr: tmodule):boolean;
     procedure proc_package(curr: tmodule);
     procedure proc_program(curr: tmodule; islibrary : boolean);
+    procedure proc_program_declarations(curr : tmodule; islibrary : boolean);
 
 implementation
 
@@ -1117,7 +1120,7 @@ type
            curr.mode_switch_allowed:= false;
 
          consume(_UNIT);
-         if compile_level=1 then
+         if curr.is_initial then
           Status.IsExe:=false;
 
          unitname:=orgpattern;
@@ -2015,7 +2018,7 @@ type
              pkg.initmoduleinfo(curr);
 
              { create the executable when we are at level 1 }
-             if (compile_level=1) then
+             if (curr.is_initial) then
                begin
                  { create global resource file by collecting all resource files }
                  CollectResourceFiles;
@@ -2278,7 +2281,7 @@ type
           end;
         { create the executable when we are at level 1 }
 
-        if (not curr.is_unit) and (compile_level=1) then
+        if (not curr.is_unit) and (curr.is_initial) then
           proc_create_executable(curr,sysinitmod,islibrary);
 
         { Give Fatal with error count for linker errors }

compiler/scandir.pas

@@ -1524,7 +1524,7 @@ unit scandir;
       begin
         if not (target_info.system in systems_all_windows) then
           Message(scan_w_setpeuserversion_not_support);
-        if (compile_level<>1) then
+        if (not current_module.is_initial) then
           Message(scan_n_only_exe_version)
         else
           do_version(peuserversionmajor,peuserversionminor,dummyrev,dummystr,false,SetPEUserVersionSetExplicitely);
@@ -1537,7 +1537,7 @@ unit scandir;
       begin
         if not (target_info.system in systems_all_windows) then
           Message(scan_w_setpeosversion_not_support);
-        if (compile_level<>1) then
+        if (not current_module.is_initial) then
           Message(scan_n_only_exe_version)
         else
           do_version(peosversionmajor,peosversionminor,dummyrev,dummystr,false,SetPEOSVersionSetExplicitely);
@@ -1550,7 +1550,7 @@ unit scandir;
       begin
         if not (target_info.system in systems_all_windows) then
           Message(scan_w_setpesubsysversion_not_support);
-        if (compile_level<>1) then
+        if (not current_module.is_initial) then
           Message(scan_n_only_exe_version)
         else
           do_version(pesubsysversionmajor,pesubsysversionminor,dummyrev,dummystr,false,SetPESubSysVersionSetExplicitely);
@@ -1702,7 +1702,7 @@ unit scandir;
             Message(scan_n_version_not_support);
             exit;
           end;
-        if (compile_level<>1) then
+        if (not current_module.is_initial) then
           Message(scan_n_only_exe_version)
         else
           begin