Browse Source

compiler: started alternative scheduler, also scheduling ppu files

mattias 4 days ago
parent
commit
68781abf2d

+ 219 - 105
compiler/ctask.pas

@@ -31,7 +31,17 @@ uses
   finput, fmodule, cclasses, globstat;
 
 type
-  { ttask_list }
+  { ttask_list
+
+    About state:
+      Contains scanner/parser position needed for compiling pascal sources,
+      irrelevant for loading ppu(s).
+      It is restored before continuing and saved afterwards (if unfinished).
+      Loading ppu files works recursively and stops when a unit requires (re)compile,
+      A recompile discards the saved state the adds the module to ctask.
+      When the recursion steps back, leaving the current unit unfinished the state is saved,
+      so ctask can continue with another unit.
+  }
 
   ttask_list = class(tlinkedlistitem)
     module : tmodule;
@@ -50,7 +60,6 @@ type
 
   { ttask_handler }
 
-
   ttask_handler = class
   private
     list : ttasklinkedlist;
@@ -67,9 +76,13 @@ type
     // Overload of cancontinue, based on task.
     function cancontinue(t: ttask_list; out firstwaiting: tmodule): boolean; inline;
     // Check modules waiting for t, find highest state and count them
-    function countwaiting(m : tmodule; out highest_state: tmodulestate; out firsthighestwaiting: tmodule): integer;
+    function countwaiting(m : tmodule; out highest_state: tmodulestate; out firsthighestwaiting: tmodule): integer; // EnableCTaskPPU: remove
     // Continue processing this module. Return true if the module is done and can be removed.
-    function continue(t : ttask_list): Boolean;
+    function continue_task(t : ttask_list): Boolean;
+    {$IFDEF EnableCTaskPPU}
+    // Check for a circular dependency and fix it
+    function check_cycle: boolean;
+    {$ENDIF}
     // 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.
@@ -117,7 +130,6 @@ begin
   state:=nil;
 end;
 
-
 destructor ttask_list.destroy;
 begin
   DiscardState;
@@ -161,10 +173,16 @@ constructor ttask_handler.create;
 begin
   list:=ttasklinkedlist.Create;
   hash:=TFPHashList.Create;
+  {$IFDEF EnableCTaskPPU}
+  tmodule.queue_module:=@addmodule;
+  {$ENDIF}
 end;
 
 destructor ttask_handler.destroy;
 begin
+  {$IFDEF EnableCTaskPPU}
+  tmodule.queue_module:=nil;
+  {$ENDIF}
   hash.free;
   hash := nil;
   List.Clear;
@@ -216,24 +234,38 @@ var
 
 begin
   firstwaiting:=nil;
+
   // We do not need to consider the program as long as there are units that need to be treated.
   if (m.is_initial and not m.is_unit) 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_wait : cancontinue:=m.usedunitsloaded(true,firstwaiting);
-    ms_compiling_waitintf : cancontinue:=m.usedunitsloaded(true,firstwaiting);
-    ms_compiling_waitimpl : cancontinue:=m.usedunitsloaded(false,firstwaiting);
-    ms_compiling_waitfinish : cancontinue:=m.nowaitingforunits(firstwaiting);
-    ms_compiled_waitcrc : cancontinue:=m.usedunitsfinalcrc(firstwaiting);
-    ms_compiled : cancontinue:=true;
-    ms_processed : cancontinue:=true;
-    ms_moduleerror : cancontinue:=true;
+
+  {$IFDEF EnableCTaskPPU}
+  if m.do_reload then
+    cancontinue:=tppumodule(m).canreload(firstwaiting)
   else
-    InternalError(2024011802);
+  {$ENDIF}
+  begin
+    case m.state of
+      ms_unknown : cancontinue:=true;
+      ms_registered : cancontinue:=true;
+      {$IFDEF EnableCTaskPPU}
+      ms_load: cancontinue:=tppumodule(m).ppuloadcancontinue(firstwaiting);
+      {$ENDIF}
+      ms_compile : cancontinue:=true;
+      ms_compiling_wait : cancontinue:=m.usedunitsloaded(true,firstwaiting);
+      ms_compiling_waitintf : cancontinue:=m.usedunitsloaded(true,firstwaiting);
+      ms_compiling_waitimpl : cancontinue:=m.usedunitsloaded(false,firstwaiting);
+      ms_compiling_waitfinish : cancontinue:=m.nowaitingforunits(firstwaiting);
+      ms_compiled_waitcrc : cancontinue:=m.usedunitsfinalcrc(firstwaiting);
+      ms_compiled : cancontinue:=true;
+      ms_processed : cancontinue:=true;
+      ms_moduleerror : cancontinue:=true;
+    else
+      InternalError(2024011802);
+    end;
   end;
+
+  // EnableCTaskPPU: remove checksub
   if (not cancontinue) and checksub then
     begin
     checkused(m2);
@@ -267,6 +299,7 @@ var
   i: Integer;
   dep_unit: tdependent_unit;
   state: tmodulestate;
+  waitfor_unit: tmodule;
 begin
   Result:=0;
   highest_state:=ms_registered;
@@ -276,32 +309,55 @@ begin
     // program/library
     exit;
 
-  if m.dependent_units=nil then
-    exit;
-
-  dep_unit:=tdependent_unit(m.dependent_units.First);
-  while dep_unit<>nil do
+  if m.waitingunits<>nil then
+  begin
+    for i:=0 to m.waitingunits.Count-1 do
     begin
-    state:=dep_unit.u.state;
-    if state in [ms_compiled, ms_processed] then
-      // not waiting
-    else if state<highest_state then
-      // worse
-    else if state=highest_state then
-      // same
-      inc(Result)
-    else
+      waitfor_unit:=tmodule(m.waitingunits[i]);
+      state:=waitfor_unit.state;
+      if state in [ms_compiled, ms_processed] then
+        // not waiting
+      else if state<highest_state then
+        // worse
+      else if state=highest_state then
+        // same
+        inc(Result)
+      else
+        begin
+        // better
+        Result:=1;
+        highest_state:=state;
+        firsthighestwaiting:=waitfor_unit;
+        end;
+    end;
+  end;
+
+  if m.dependent_units<>nil then
+  begin
+    dep_unit:=tdependent_unit(m.dependent_units.First);
+    while dep_unit<>nil do
       begin
-      // better
-      Result:=1;
-      highest_state:=state;
-      firsthighestwaiting:=dep_unit.u;
+      state:=dep_unit.u.state;
+      if state in [ms_compiled, ms_processed] then
+        // not waiting
+      else if state<highest_state then
+        // worse
+      else if state=highest_state then
+        // same
+        inc(Result)
+      else
+        begin
+        // better
+        Result:=1;
+        highest_state:=state;
+        firsthighestwaiting:=dep_unit.u;
+        end;
+      dep_unit:=tdependent_unit(dep_unit.Next);
       end;
-    dep_unit:=tdependent_unit(dep_unit.Next);
-    end;
+  end;
 end;
 
-function ttask_handler.continue(t : ttask_list) : Boolean;
+function ttask_handler.continue_task(t : ttask_list) : Boolean;
 
 var
   m : tmodule;
@@ -310,11 +366,23 @@ var
 begin
   m:=t.module;
   orgname:=m.modulename^;
-  {$IFDEF DEBUG_CTASK}Writeln('CTASK: ',m.ToString,' Continues. State: ',m.state);{$ENDIF}
+  {$IFDEF DEBUG_CTASK}Writeln('CTASK: ',m.ToString,' Continues. State: ',m.state,' do_reload=',m.do_reload);{$ENDIF}
   if Assigned(t.state) then
     t.RestoreState;
+  {$IFDEF EnableCTaskPPU}
+  if m.do_reload then
+  begin
+    writeln('ttask_handler.continue ',m.modulename^,' ',m.state,' reloading...');
+    tppumodule(m).reload;
+    exit;
+  end;
+  writeln('ttask_handler.continue ',m.modulename^,' ',m.state,' continue...');
+  {$ENDIF}
   case m.state of
     ms_registered : parser.compile_module(m);
+    {$IFDEF EnableCTaskPPU}
+    ms_load: (m as tppumodule).continueloadppu;
+    {$ENDIF}
     ms_compile :
       begin
         if m=main then
@@ -335,8 +403,13 @@ begin
   else
     InternalError(2024011801);
   end;
+  {$IFDEF EnableCTaskPPU}
+  writeln('ttask_handler.continue AFTER ',m.modulename^,' ',m.state,' reload=',m.do_reload);
+  {$ENDIF}
 
-  if m.state=ms_compiled then
+  if (m.is_initial and not m.is_unit) and (list.Count>1) then
+    // program must wait for all units to finish
+  else if m.state=ms_compiled then
     begin
     parsing_done(m);
     if m.is_initial and not m.is_unit then
@@ -361,6 +434,75 @@ begin
     rebuild_hash;
 end;
 
+{$IFDEF EnableCTaskPPU}
+function ttask_handler.check_cycle: boolean;
+var
+  last: ttask_list;
+
+  function Search(m: tppumodule): boolean;
+  var
+    uu: tused_unit;
+    pm: tppumodule;
+  begin
+    Result:=false;
+
+    // mark module as searched
+    m.cycle_search_stamp:=m.cycle_stamp;
+
+    uu:=tused_unit(m.used_units);
+    while uu<>nil do
+    begin
+      pm:=tppumodule(uu.u);
+      if pm<>nil then
+      begin
+        if pm=last.module then
+          Result:=true
+        else if pm.cycle_stamp=pm.cycle_search_stamp then
+          // already searched
+        else
+          Result:=Result or Search(pm);
+      end;
+      uu:=tused_unit(uu.Next);
+    end;
+
+    if Result then
+    begin
+      // cycle detected -> recompile ppu
+      if m.state=ms_load then
+      begin
+        {$IFDEF DEBUG_CTASK}
+        writeln('PPUALGO check_cycle last=',last.module.modulename^,' ',last.module.state,', RECOMPILE ',m.modulename^,' ',m.state);
+        {$ENDIF}
+        m.recompile_cycle;
+        check_cycle:=true;
+      end;
+    end;
+  end;
+
+var
+  t: ttask_list;
+begin
+  Result:=false;
+
+  // find highest unit_index in queue
+  t:=list.firsttask;
+  if t=nil then exit;
+  last:=nil;
+  while t<>nil do
+    begin
+    if (last=nil) or (last.module.unit_index<t.module.unit_index) then
+      last:=t;
+    t:=t.nexttask;
+    end;
+
+  if tppumodule.cycle_stamp=high(dword) then
+    tppumodule.cycle_stamp:=0
+  else
+    inc(tppumodule.cycle_stamp);
+  Search(tppumodule(last.module));
+end;
+{$ENDIF}
+
 procedure ttask_handler.rebuild_hash;
 
 var
@@ -380,10 +522,7 @@ procedure ttask_handler.processqueue;
 
 var
   t, besttask: ttask_list;
-  better: boolean;
   firstwaiting, bestmod, m, firsthighestwaiting: tmodule;
-  cnt, bestcnt: Integer;
-  highest_state, bestwaitstate: tmodulestate;
 
 begin
   // Strategy: goal is to write ppus early, so that mem is freed early and in case of an error
@@ -391,76 +530,50 @@ begin
 
   repeat
     {$IFDEF DEBUG_CTASK}writeln('CTASK: ttask_handler.processqueue: task-count=',list.Count);{$ENDIF}
-    besttask:=list.firsttask;
-    if besttask=nil then
+    besttask:=nil;
+    if list.firsttask=nil then
       exit; // completed
 
-    // first search for any module that is ready to be written as ppu
-    while besttask<>nil do
+    // search for any module, that can continue, with furthest state
+    t:=list.firsttask;
+    while t<>nil do
       begin
-      if (besttask.module.state=ms_compiled_waitcrc)
-          and besttask.module.usedunitsfinalcrc(firstwaiting) then
-        // module is ready to be written as ppu
-        break;
-      besttask:=besttask.nexttask;
+      m:=t.module;
+      if (besttask<>nil) and (besttask.module.unit_index>m.unit_index) then
+        // skip
+      else if cancontinue(m,false,firstwaiting) then
+        begin
+        {$IFDEF DEBUG_CTASK}
+        Writeln('CTASK: ',m.ToString,' state=',m.state,' unit_index=',m.unit_index);
+        {$ENDIF}
+        // prefer highest unit_index to complete strongly connected components first
+        if (besttask=nil)
+            or (besttask.module.unit_index<m.unit_index) then
+          besttask:=t;
+        end;
+      t:=t.nexttask;
       end;
 
+    {$IFDEF EnableCTaskPPU}
+    if besttask=nil then
+      if check_cycle then continue;
+    {$ENDIF}
+
     if besttask=nil then
       begin
-      // then search for any module, that can continue, with furthest state and most units waiting
-      bestcnt:=0;
-      bestwaitstate:=ms_registered;
-      t:=list.firsttask;
-      while t<>nil do
-        begin
-        m:=t.module;
-        if (besttask<>nil) and (besttask.module.state>m.state) then
-          // skip
-        else if cancontinue(t.module,false,firstwaiting) then
-          begin
-          cnt:=countwaiting(m,highest_state,firsthighestwaiting);
-          {$IFDEF DEBUG_CTASK}
-          if firsthighestwaiting<>nil then
-            Writeln('CTASK: ',t.module.ToString,' state=',t.module.state,' highwait: ',highest_state,' count=',cnt,' ',firsthighestwaiting.modulename^)
-          else
-            Writeln('CTASK: ',t.module.ToString,' state=',t.module.state,' highwait: ',highest_state,' count=',cnt);
-          {$ENDIF}
-          better:=false;
-          if (besttask=nil)
-              or (besttask.module.state<m.state) then
-            better:=true
-          else if besttask.module.state=m.state then
-            begin
-              if bestwaitstate<highest_state then
-                better:=true
-              else if (bestwaitstate=highest_state) and (bestcnt<cnt) then
-                better:=true;
-            end;
-          if better then
-            begin
-            besttask:=t;
-            bestcnt:=cnt;
-            bestwaitstate:=highest_state;
-            end;
-          end;
-        t:=t.nexttask;
-        end;
-      if besttask=nil then
-        begin
-        // no progress possible
-        write_queue;
-        InternalError(2026012015);
-        end;
+      // no progress possible
+      write_queue;
+      InternalError(2026012015);
       end;
 
-    {$IF defined(DEBUG_CTASK) or defined(Debug_FreeParseMem)}Writeln('CTASK: continuing ',besttask.module.ToString,' state=',besttask.module.state,' total-units=',loaded_units.Count,' tasks=',list.Count);{$ENDIF}
-    if continue(besttask) then
-      begin
+    {$IF defined(DEBUG_CTASK) or defined(Debug_FreeParseMem)}Writeln('CTASK: continuing ',besttask.module.ToString,' state=',besttask.module.statestr,' total-units=',loaded_units.Count,' tasks=',list.Count);{$ENDIF}
+    if continue_task(besttask) then
+    begin
       {$IFDEF DEBUG_CTASK}Writeln('CTASK: ',besttask.module.ToString,' is finished, removing from task list');{$ENDIF}
       hash.Remove(besttask.module);
       list.Remove(besttask);
       FreeAndNil(besttask);
-      end;
+    end;
   until false;
 end;
 
@@ -475,7 +588,7 @@ begin
   e:=ttask_list(Hash.Find(n));
   if e=nil then
     begin
-    {$IFDEF DEBUG_CTASK}Writeln('CTASK: ',m.ToString,' added to task scheduler. State: ',m.state);{$ENDIF}
+    {$IFDEF DEBUG_CTASK}Writeln('CTASK: ',m.ToString,' added to task scheduler. State: ',m.state,' unit_index=',m.unit_index);{$ENDIF}
     // Clear reset flag.
     // This can happen when during load, reset is done and unit is added to task list.
     m.is_reset:=false;
@@ -506,7 +619,7 @@ end;
 procedure ttask_handler.write_queue;
 var
   t: ttask_list;
-  firstwaiting: tmodule;
+  firstwaiting, m: tmodule;
   cc: Boolean;
 begin
   writeln('ttask_handler.write_queue:');
@@ -514,10 +627,11 @@ begin
   while t<>nil do
     begin
     cc:=cancontinue(t,firstwaiting);
+    m:=t.module;
     if firstwaiting<>nil then
-      writeln('queue: ',t.module.realmodulename^,' ',t.module.state,' cancontinue=',cc,' firstwaiting=',firstwaiting.realmodulename^,' ',firstwaiting.state)
+      writeln('queue: ',m.realmodulename^,' ',m.statestr,' cancontinue=',cc,' firstwaiting=',firstwaiting.realmodulename^,' ',firstwaiting.state)
     else
-      writeln('queue: ',t.module.realmodulename^,' ',t.module.state,' cancontinue=',cc,' firstwaiting=nil');
+      writeln('queue: ',m.realmodulename^,' ',m.statestr,' cancontinue=',cc,' firstwaiting=nil');
     t:=t.nexttask;
     end;
 end;

+ 1 - 1
compiler/finput.pas

@@ -116,7 +116,7 @@ interface
      type
         tmodulestate = (ms_unknown,
           ms_registered, // tmodule created
-          ms_load,       // loading ppu
+          ms_load,
           ms_compile,    // parsing and compiling
           ms_compiling_wait,      // waiting for used units of program/library/package
           ms_compiling_waitintf,  // waiting for used units of interface section

+ 173 - 51
compiler/fmodule.pas

@@ -55,6 +55,9 @@ interface
     type
       trecompile_reason = (rr_unknown,
         rr_noppu,rr_sourcenewer,rr_build,rr_crcchanged
+        {$IFDEF EnableCTaskPPU}
+        ,rr_buildcycle
+        {$ENDIF}
       );
 
 {$ifdef VER3_2}
@@ -105,6 +108,33 @@ interface
       end;
       tderefmaparray = array of tderefmaprec;
 
+      {$IFDEF EnableCTaskPPU}
+      tqueue_module_event = procedure(m: tmodule) of object;
+      {$ENDIF}
+
+      { tused_unit }
+
+      tused_unit = class(tlinkedlistitem)
+        checksum,
+        interface_checksum,
+        indirect_checksum: cardinal;
+        in_uses,
+        in_interface    : boolean;
+        u               : tmodule;
+        unitsym         : tunitsym;
+        {$IFDEF EnableCTaskPPU}
+        dependent_added : boolean;
+        {$ENDIF}
+        constructor create(_u : tmodule;intface,inuses:boolean;usym:tunitsym);
+        procedure check_hints;
+      end;
+
+      tdependent_unit = class(tlinkedlistitem)
+        u : tmodule;
+        in_interface : boolean;
+        constructor create(_u : tmodule; frominterface : boolean);
+      end;
+
       { tmodule }
 
       tmodule = class(tmodulebase)
@@ -113,6 +143,9 @@ interface
       public
         is_reset,                 { has reset been called ? }
         do_reload,                { force reloading of the unit }
+        {$IFDEF EnableCTaskPPU}
+        fromppu: boolean;
+        {$ENDIF}
         sources_avail,            { if all sources are reachable }
         interface_compiled,       { if the interface section has been parsed/compiled/loaded }
         is_dbginfo_written,
@@ -203,7 +236,7 @@ interface
 
         moduleoptions: tmoduleoptions;
         deprecatedmsg: pshortstring;
-        loadcount : integer;
+        loadcount : integer; // EnableCTaskPPU: remove
         compilecount : integer;
         consume_semicolon_after_uses : Boolean;
         initfinalchecked : boolean;
@@ -225,11 +258,11 @@ interface
           functions generated }
         used_rtti_attrs: tfpobjectlist;
 
-        { this contains a list of units that needs to be waited for until the
+        { this contains a list of units (tmodule) that needs to be waited for until the
           unit can be finished (code generated, etc.); this is needed to handle
           specializations in circular unit usages correctly }
         waitingforunit: tfpobjectlist;
-        { this contains a list of all units that are waiting for this unit to be
+        { this contains a list of all units (tmodule) that are waiting for this unit to be
           finished }
         waitingunits: tfpobjectlist;
 
@@ -243,7 +276,7 @@ interface
           constant assignments at the module level; does not have to be saved
           into the ppu file, because translated into code during compilation)
            -- actual type: tnode (but fmodule should not depend on node) }
-         tcinitcode     : tobject;
+        tcinitcode     : tobject;
 
         { the current extended rtti directive }
         rtti_directive : trtti_directive;
@@ -255,9 +288,17 @@ interface
         constructor create(LoadedFrom:TModule;const amodulename: string; const afilename:TPathStr;_is_unit:boolean);
         destructor destroy;override;
         procedure reset(for_recompile: boolean);virtual;
+        function statestr: string; virtual;
         procedure loadlocalnamespacelist;
         procedure adddependency(callermodule:tmodule; frominterface : boolean);
+        procedure removedependency(callermodule:tmodule);
+        function hasdependency(callermodule:tmodule): boolean;
         procedure flagdependent(callermodule:tmodule);
+        {$IFDEF EnableCTaskPPU}
+        procedure disconnect_depending_modules; virtual;
+        function is_reload_needed(du: tdependent_unit): boolean; virtual; // true if reload needed after self changed
+        class var queue_module: tqueue_module_event;
+        {$ENDIF}
         procedure addimportedsym(sym:TSymEntry);
         function  addusedunit(hp:tmodule;inuses:boolean;usym:tunitsym):tused_unit;
         function  usesmodule_in_interface(m : tmodule) : boolean;
@@ -281,26 +322,6 @@ interface
         function ToString: RTLString; override;
       end;
 
-       { tused_unit }
-
-       tused_unit = class(tlinkedlistitem)
-          checksum,
-          interface_checksum,
-          indirect_checksum: cardinal;
-          in_uses,
-          in_interface    : boolean;
-          u               : tmodule;
-          unitsym         : tunitsym;
-          constructor create(_u : tmodule;intface,inuses:boolean;usym:tunitsym);
-          procedure check_hints;
-       end;
-
-       tdependent_unit = class(tlinkedlistitem)
-          u : tmodule;
-          in_interface : boolean;
-          constructor create(_u : tmodule; frominterface : boolean);
-       end;
-
     var
        main_module       : tmodule;     { Main module of the program }
        current_module    : tmodule;     { Current module which is compiled or loaded }
@@ -853,6 +874,9 @@ implementation
         m : tmodule;
       begin
         is_reset:=true;
+        {$IFDEF EnableCTaskPPU}
+        fromppu:=false;
+        {$ENDIF}
         LoadCount:=0;
         if assigned(scanner) then
           begin
@@ -960,8 +984,7 @@ implementation
           used_units.free;
           used_units:=TLinkedList.Create;
           end;
-        dependent_units.free;
-        dependent_units:=TLinkedList.Create;
+        // keep dependent_units
         resourcefiles.Free;
         resourcefiles:=TCmdStrList.Create;
         linkorderedsymbols.Free;
@@ -1071,42 +1094,116 @@ implementation
         { This is not needed for programs }
         if not callermodule.is_unit then
           exit;
+        if hasdependency(callermodule) then exit;
         Message2(unit_u_add_depend_to,callermodule.modulename^,modulename^);
         dependent_units.concat(tdependent_unit.create(callermodule,frominterface));
       end;
 
+    procedure tmodule.removedependency(callermodule: tmodule);
+      var
+        du, nextdu: tdependent_unit;
+      begin
+        du:=tdependent_unit(dependent_units.First);
+        while Assigned(du) do
+        begin
+          nextdu:=tdependent_unit(du.Next);
+          if du.u=callermodule then
+            dependent_units.Remove(du);
+          du:=nextdu;
+        end;
+      end;
+
+    function tmodule.hasdependency(callermodule: tmodule): boolean;
+      var
+        du: tdependent_unit;
+      begin
+        du:=tdependent_unit(dependent_units.First);
+        while Assigned(du) do
+        begin
+          if du.u=callermodule then
+            exit(true);
+          du:=tdependent_unit(du.Next);
+        end;
+        Result:=false;
+      end;
 
     procedure tmodule.flagdependent(callermodule:tmodule);
       var
-        pm : tdependent_unit;
+        dm : tdependent_unit;
         m : tmodule;
 
       begin
         { flag all units that depend on this unit for reloading }
-        pm:=tdependent_unit(dependent_units.first);
-        while assigned(pm) do
-         begin
-           { We do not have to reload the unit that wants to load
-             this unit, unless this unit is already compiled during
-             the loading }
-           m:=pm.u;
-           {$IFDEF DEBUG_PPU_CYCLES}
-           writeln('PPUALGO tmodule.flagdependent ',modulename^,' state=',state,', dependent ',m.modulename^,' ',m.state);
-           {$ENDIF}
-           if (m=callermodule) and (m.state<ms_compiled_waitcrc) then
-             Message1(unit_u_no_reload_is_caller,m.modulename^)
-           else
-            if (m.state=ms_compile) {and (pm.u.compilecount>1)} then
-              Message1(unit_u_no_reload_in_second_compile,m.modulename^)
-           else
-            begin
-              m.do_reload:=true;
-              Message1(unit_u_flag_for_reload,m.modulename^);
-            end;
-           pm:=tdependent_unit(pm.next);
-         end;
+        dm:=tdependent_unit(dependent_units.first);
+        while assigned(dm) do
+        begin
+          { We do not have to reload the unit that wants to load
+            this unit, unless this unit is already compiled during
+            the loading }
+          m:=dm.u;
+          {$IFDEF DEBUG_PPU_CYCLES}
+          writeln('PPUALGO tmodule.flagdependent ',modulename^,' state=',statestr,', is used by ',BoolToStr(dm.in_interface,'interface','implementation'),' of ',m.modulename^,' ',m.statestr);
+          {$ENDIF}
+          {$IFDEF EnableCTaskPPU}
+          if not m.do_reload and is_reload_needed(dm) then
+          begin
+            m.do_reload:=true;
+            Message1(unit_u_flag_for_reload,m.modulename^);
+            queue_module(m);
+            { We have to flag the units that depend on this unit even
+              though it didn't change, because they might also
+              indirectly depend on the unit that did change (e.g.,
+              in case rgobj, rgx86 and rgcpu have been compiled
+              already, and then rgobj is recompiled for some reason
+              -> rgx86 is re-reresolved, but the vmtentries of trgcpu
+              must also be re-resolved, because they will also contain
+              pointers to procdefs in the old trgobj (in case of a
+              recompile, all old defs are freed) }
+            flagdependent(m);
+          end;
+          {$ELSE}
+          if (m=callermodule) and (m.state<ms_compiled_waitcrc) then
+            Message1(unit_u_no_reload_is_caller,m.modulename^)
+          else if (m.state=ms_compile) then
+            Message1(unit_u_no_reload_in_second_compile,m.modulename^)
+          else
+          begin
+            m.do_reload:=true;
+            Message1(unit_u_flag_for_reload,m.modulename^);
+          end;
+          {$ENDIF}
+          dm:=tdependent_unit(dm.next);
+        end;
       end;
 
+    function tmodule.statestr: string;
+    begin
+      str(state,Result);
+      if do_reload then
+        Result:='do_reload,'+Result;
+    end;
+
+    {$IFDEF EnableCTaskPPU}
+    procedure tmodule.disconnect_depending_modules;
+    var
+      uu: tused_unit;
+    begin
+      uu:=tused_unit(used_units.first);
+      while assigned(uu) do
+      begin
+        uu.u.removedependency(self);
+        uu.dependent_added:=false;
+        uu:=tused_unit(uu.next);
+      end;
+    end;
+
+    function tmodule.is_reload_needed(du: tdependent_unit): boolean;
+      begin
+        Result:=(du.u.state in [ms_compiling_waitfinish,ms_compiled_waitcrc,ms_compiled,ms_processed])
+             or (du.in_interface and du.u.interface_compiled);
+        // Note: see also the override in fppu.tppumodule
+      end;
+    {$ENDIF EnableCTaskPPU}
 
     procedure tmodule.addimportedsym(sym:TSymEntry);
       begin
@@ -1123,9 +1220,33 @@ implementation
         addusedunit:=pu;
       end;
 
-
     function tmodule.usedunitsloaded(interface_units : boolean; out firstwaiting : tmodule): boolean;
-
+    {$IFDEF EnableCTaskPPU}
+      var
+        uu: tused_unit;
+        ok: Boolean;
+      begin
+        Result:=true;
+        firstwaiting:=nil;
+        uu:=tused_unit(used_units.First);
+        while assigned(uu) do
+        begin
+          ok:=uu.u.interface_compiled and not uu.u.do_reload;
+          { $IFDEF DEBUG_CTASK_VERBOSE}
+          writeln('  ',ToString,' checking state of ', uu.u.ToString,' : ',uu.u.statestr,' : ',ok);
+          { $ENDIF}
+          if not ok then
+          begin
+            Result:=false;
+            firstwaiting:=uu.u;
+            {$IFNDEF DEBUG_CTASK_VERBOSE}
+            break;
+            {$ENDIF}
+          end;
+          uu:=tused_unit(uu.Next);
+        end;
+      end;
+    {$ELSE}
       const
         statesneeded : array[boolean] of tmodulestates = (
           [ms_processed, ms_compiled, ms_compiling_waitimpl, ms_compiling_waitfinish, ms_compiled_waitcrc],
@@ -1157,6 +1278,7 @@ implementation
           itm:=itm.Next;
           end;
       end;
+    {$ENDIF}
 
     function tmodule.nowaitingforunits(out firstwaiting : tmodule): Boolean;
 

+ 612 - 107
compiler/fppu.pas

@@ -52,6 +52,13 @@ interface
           sourcefn   : TPathStr; { Source specified with "uses .. in '..'" }
           comments   : TCmdStrList;
           nsprefix   : TCmdStr; { Namespace prefix the unit was found with }
+{$ifdef EnableCTaskPPU}
+          loadedfrommodule: tmodule;
+          ppu_waitingfor_crc: boolean;
+          class var cycle_stamp: dword;
+          var
+          cycle_search_stamp: dword;
+{$endif}
 {$ifdef Test_Double_checksum}
           interface_read_crc_index,
           interface_write_crc_index,
@@ -65,6 +72,7 @@ interface
 {$endif def Test_Double_checksum}
           constructor create(LoadedFrom:TModule;const amodulename: string; const afilename:TPathStr;_is_unit:boolean);
           destructor destroy;override;
+          function statestr: string; override;
           procedure reset(for_recompile: boolean);override;
           procedure re_resolve(loadfrom: tmodule);
           function  openppufile:boolean;
@@ -72,11 +80,19 @@ interface
           procedure getppucrc;
           procedure writeppu;
           function loadppu(from_module : tmodule) : boolean;
+{$ifdef EnableCTaskPPU}
+          function continueloadppu : boolean;
+          function canreload(out firstwaiting: tmodule): boolean;
+          procedure reload;
+          function ppuloadcancontinue(out firstwaiting: tmodule): boolean;
+          function is_reload_needed(pu: tdependent_unit): boolean; override;
+          procedure recompile_cycle;
+{$endif}
           procedure post_load_or_compile(from_module : tmodule; second_time: boolean);
           procedure discardppu;
-          function  needrecompile:boolean;
+          function  needrecompile:boolean; // EnableCTaskPPU: remove
           procedure setdefgeneration;
-          procedure reload_flagged_units;
+          procedure reload_flagged_units; // EnableCTaskPPU: remove
           procedure end_of_parsing;override;
        private
           unitimportsymsderefs : tfplist;
@@ -90,20 +106,24 @@ interface
           function check_loadfrompackage: boolean;
           procedure check_reload(from_module: tmodule; var do_load: boolean);
           function  openppu(ppufiletime:longint):boolean;
-          procedure prepare_second_load(from_module: tmodule);
+          procedure prepare_second_load(from_module: tmodule); // EnableCTaskPPU: remove
           procedure recompile_from_sources(from_module: tmodule);
           function  search_unit_files(loaded_from : tmodule; onlysource:boolean):TAvailableUnitFiles;
           function  search_unit(loaded_from : tmodule; onlysource,shortname:boolean):TAvailableUnitFiles;
           function  loadfrompackage:boolean;
           procedure load_interface;
           procedure load_implementation;
-          procedure load_usedunits;
+          function load_usedunits: boolean;
+{$ifdef EnableCTaskPPU}
+          function load_usedunits_section: boolean;
+          function ppu_check_used_crcs: boolean;
+{$endif}
           procedure printcomments;
           procedure queuecomment(const s:TMsgStr;v,w:longint);
           procedure buildderefunitimportsyms;
           procedure derefunitimportsyms;
           procedure freederefunitimportsyms;
-          procedure try_load_ppufile(from_module: tmodule);
+          procedure try_load_ppufile(from_module: tmodule); // EnableCTaskPPU: remove
           procedure writesourcefiles;
           procedure writeusedunit(intf:boolean);
           procedure writelinkcontainer(var p:tlinkcontainer;id:byte;strippath:boolean);
@@ -181,9 +201,26 @@ var
         inherited Destroy;
       end;
 
+    function tppumodule.statestr: string;
+      begin
+        Result:=inherited statestr;
+        {$IFDEF EnableCTaskPPU}
+        if state<>ms_load then exit;
+        if ppu_waitingfor_crc then
+          Result:=Result+',waitcrc'
+        else if interface_compiled then
+          Result:=Result+',interface_compiled'
+        else
+          Result:=Result+',waitintf';
+        {$ENDIF}
+      end;
 
     procedure tppumodule.reset(for_recompile : boolean);
       begin
+        {$IFDEF EnableCTaskPPU}
+        loadedfrommodule:=nil;
+        ppu_waitingfor_crc:=false;
+        {$ENDIF}
         inc(currentdefgeneration);
         discardppu;
         freederefunitimportsyms;
@@ -215,6 +252,10 @@ var
             tunitwpoinfo(wpoinfo).derefimpl;
           end;
 
+        {$IFDEF EnableCTaskPPU}
+        { all dependent units were already flagged recursively for reload }
+        defsgeneration:=currentdefgeneration;
+        {$ELSE}
         { We have to flag the units that depend on this unit even
           though it didn't change, because they might also
           indirectly depend on the unit that did change (e.g.,
@@ -226,6 +267,7 @@ var
           recompile, all old defs are freed) }
         flagdependent(loadfrom);
         reload_flagged_units;
+        {$ENDIF}
       end;
 
 
@@ -465,7 +507,6 @@ var
         search_unit_files:=found;
       end;
 
-
     function tppumodule.search_unit(loaded_from : tmodule; onlysource,shortname:boolean):TAvailableUnitFiles;
       var
          singlepathstring,
@@ -787,8 +828,13 @@ var
 
                 { now load the unit and all used units }
                 load_interface;
+                {$IFDEF EnableCTaskPPU}
+                if not load_usedunits then
+                  internalerror(2026020415);
+                {$ELSE}
                 setdefgeneration;
                 load_usedunits;
+                {$ENDIF}
                 Message1(unit_u_finished_loading_unit,modulename^);
 
                 result:=true;
@@ -1834,8 +1880,8 @@ var
          { create and write header }
          ppufile.header.common.size:=ppufile.size;
          ppufile.header.checksum:=ppufile.crc;
-         ppufile.header.interface_checksum:=ppufile.interface_crc;
-         ppufile.header.indirect_checksum:=ppufile.indirect_crc;
+         ppufile.header.interface_checksum:=interface_crc;
+         ppufile.header.indirect_checksum:=indirect_crc;
          ppufile.header.common.compiler:=wordversion;
          ppufile.header.common.cpu:=word(target_cpu);
          ppufile.header.common.target:=word(target_info.system);
@@ -1847,8 +1893,9 @@ var
          { save crc in current module also }
          crc_final:=true;
          crc:=ppufile.crc;
-         interface_crc:=ppufile.interface_crc;
-         indirect_crc:=ppufile.indirect_crc;
+         // make sure, the interface_crc is not affected by the implementation
+         // interface_crc:=ppufile.interface_crc;
+         // indirect_crc:=ppufile.indirect_crc;
          {$IFDEF Debug_WaitCRC}
          writeln('tppumodule.writeppu ',realmodulename^,' crc=',hexstr(crc,8));
          {$ENDIF}
@@ -1937,10 +1984,14 @@ var
 
          { save crc  }
          crc:=ppufile.crc;
-         interface_crc:=ppufile.interface_crc;
-         indirect_crc:=ppufile.indirect_crc;
+         if in_interface then
+           begin
+             // make sure, the interface_crc is not affected by the implementation
+             interface_crc:=ppufile.interface_crc;
+             indirect_crc:=ppufile.indirect_crc;
+           end;
          {$IFDEF Debug_WaitCRC}
-         writeln('tppumodule.getppucrc ',realmodulename^,' crc=',hexstr(crc,8));
+         writeln('tppumodule.getppucrc ',realmodulename^,' in_interface=',in_interface,' crc=',hexstr(crc,8),' interface_crc=',hexstr(interface_crc,8));
          {$ENDIF}
 
          { end of implementation, to generate a correct ppufile
@@ -1972,9 +2023,9 @@ var
          { create and write header, this will only be used
            for debugging purposes }
          ppufile.header.common.size:=ppufile.size;
-         ppufile.header.checksum:=ppufile.crc;
-         ppufile.header.interface_checksum:=ppufile.interface_crc;
-         ppufile.header.indirect_checksum:=ppufile.indirect_crc;
+         ppufile.header.checksum:=crc;
+         ppufile.header.interface_checksum:=interface_crc;
+         ppufile.header.indirect_checksum:=indirect_crc;
          ppufile.header.common.compiler:=wordversion;
          ppufile.header.common.cpu:=word(target_cpu);
          ppufile.header.common.target:=word(target_info.system);
@@ -1984,80 +2035,95 @@ var
          discardppu;
       end;
 
-
-    procedure tppumodule.load_usedunits;
+      function tppumodule.load_usedunits: boolean;
       // self is a ppu (or in a package)
       var
         pu           : tused_unit;
       begin
+        Result:=true;
         if current_module<>self then
-         internalerror(200212284);
-        { load the used units from interface }
-        in_interface:=true;
-        pu:=tused_unit(used_units.first);
-        while assigned(pu) do
-         begin
-           if pu.in_interface then
+          internalerror(200212284);
+        if not interface_compiled then
+        begin
+          { load the used units from interface }
+          in_interface:=true;
+          {$IFDEF EnableCTaskPPU}
+          if not load_usedunits_section then
+            exit(false); // e.g. fail or some used unit interface is not ready
+          {$ELSE}
+          pu:=tused_unit(used_units.first);
+          while assigned(pu) do
+           begin
+             if pu.in_interface then
+              begin
+                tppumodule(pu.u).loadppu(self);
+                { if this unit is scheduled for compilation or compiled we can stop }
+                if state<>ms_load then
+                  exit;
+                { add this unit to the dependencies }
+                pu.u.adddependency(self,true);
+                { need to recompile the current unit, check the interface
+                  crc. And when not compiled with -Ur then check the complete
+                  crc }
+                if (pu.u.interface_crc<>pu.interface_checksum) or
+                   (pu.u.indirect_crc<>pu.indirect_checksum) or
+                   (
+                    (not(mf_release in moduleflags)) and
+                    (pu.u.crc<>pu.checksum)
+                   ) then
+                 begin
+                   Message2(unit_u_recompile_crc_change,realmodulename^,pu.u.ppufilename,@queuecomment);
+  {$ifdef DEBUG_UNIT_CRC_CHANGES}
+                   if (pu.u.interface_crc<>pu.interface_checksum) then
+                     Comment(V_Normal,'  intfcrc change: '+hexstr(pu.u.interface_crc,8)+' for '+pu.u.ppufilename+' <> '+hexstr(pu.interface_checksum,8)+' in unit '+realmodulename^)
+                   else if (pu.u.indirect_crc<>pu.indirect_checksum) then
+                     Comment(V_Normal,'  indcrc change: '+hexstr(pu.u.indirect_crc,8)+' for '+pu.u.ppufilename+' <> '+hexstr(pu.indirect_checksum,8)+' in unit '+realmodulename^)
+                   else
+                     Comment(V_Normal,'  implcrc change: '+hexstr(pu.u.crc,8)+' for '+pu.u.ppufilename+' <> '+hexstr(pu.checksum,8)+' in unit '+realmodulename^);
+  {$endif DEBUG_UNIT_CRC_CHANGES}
+                   recompile_reason:=rr_crcchanged;
+                   {$IFDEF DEBUG_PPU_CYCLES}
+                   writeln('PPUALGO tppumodule.load_usedunits ',modulename^,' interface uses "',pu.u.modulename^,'" old=',state,' new=',ms_compile);
+                   {$ENDIF}
+                   state:=ms_compile;
+                   exit;
+                 end;
+              end;
+             pu:=tused_unit(pu.next);
+           end;
+          {$ENDIF}
+          { ok, now load the interface of this unit }
+          if current_module<>self then
+            internalerror(200208187);
+          deflist.count:=ppufile.header.deflistsize;
+          symlist.count:=ppufile.header.symlistsize;
+          globalsymtable:=tglobalsymtable.create(realmodulename^,moduleid);
+          tstoredsymtable(globalsymtable).ppuload(ppufile);
+
+          if ppufile.readentry<>ibexportedmacros then
+            Message(unit_f_ppu_read_error);
+          if boolean(ppufile.getbyte) then
             begin
-              tppumodule(pu.u).loadppu(self);
-              { if this unit is scheduled for compilation or compiled we can stop }
-              if state<>ms_load then
-                exit;
-              { add this unit to the dependencies }
-              pu.u.adddependency(self,true);
-              { need to recompile the current unit, check the interface
-                crc. And when not compiled with -Ur then check the complete
-                crc }
-              if (pu.u.interface_crc<>pu.interface_checksum) or
-                 (pu.u.indirect_crc<>pu.indirect_checksum) or
-                 (
-                  (not(mf_release in moduleflags)) and
-                  (pu.u.crc<>pu.checksum)
-                 ) then
-               begin
-                 Message2(unit_u_recompile_crc_change,realmodulename^,pu.u.ppufilename,@queuecomment);
-{$ifdef DEBUG_UNIT_CRC_CHANGES}
-                 if (pu.u.interface_crc<>pu.interface_checksum) then
-                   Comment(V_Normal,'  intfcrc change: '+hexstr(pu.u.interface_crc,8)+' for '+pu.u.ppufilename+' <> '+hexstr(pu.interface_checksum,8)+' in unit '+realmodulename^)
-                 else if (pu.u.indirect_crc<>pu.indirect_checksum) then
-                   Comment(V_Normal,'  indcrc change: '+hexstr(pu.u.indirect_crc,8)+' for '+pu.u.ppufilename+' <> '+hexstr(pu.indirect_checksum,8)+' in unit '+realmodulename^)
-                 else
-                   Comment(V_Normal,'  implcrc change: '+hexstr(pu.u.crc,8)+' for '+pu.u.ppufilename+' <> '+hexstr(pu.checksum,8)+' in unit '+realmodulename^);
-{$endif DEBUG_UNIT_CRC_CHANGES}
-                 recompile_reason:=rr_crcchanged;
-                 {$IFDEF DEBUG_PPU_CYCLES}
-                 writeln('PPUALGO tppumodule.load_usedunits ',modulename^,' interface uses "',pu.u.modulename^,'" old=',state,' new=',ms_compile);
-                 {$ENDIF}
-                 state:=ms_compile;
-                 exit;
-               end;
+              globalmacrosymtable:=tmacrosymtable.Create(true);
+              tstoredsymtable(globalmacrosymtable).ppuload(ppufile)
             end;
-           pu:=tused_unit(pu.next);
-         end;
-        { ok, now load the interface of this unit }
-        if current_module<>self then
-         internalerror(200208187);
-        deflist.count:=ppufile.header.deflistsize;
-        symlist.count:=ppufile.header.symlistsize;
-        globalsymtable:=tglobalsymtable.create(realmodulename^,moduleid);
-        tstoredsymtable(globalsymtable).ppuload(ppufile);
-
-        if ppufile.readentry<>ibexportedmacros then
-          Message(unit_f_ppu_read_error);
-        if boolean(ppufile.getbyte) then
-          begin
-            globalmacrosymtable:=tmacrosymtable.Create(true);
-            tstoredsymtable(globalmacrosymtable).ppuload(ppufile)
-          end;
 
-        interface_compiled:=true;
+          interface_compiled:=true;
 
-        { read the implementation part, containing
-          the implementation uses and ObjData }
-        in_interface:=false;
-        load_implementation;
+          { read the implementation part, containing
+            the implementation uses and ObjData }
+          in_interface:=false;
+          load_implementation;
+        end;
 
         { now only read the implementation uses }
+        {$IFDEF EnableCTaskPPU}
+        if not ppu_waitingfor_crc then
+        begin
+          if not load_usedunits_section then
+            exit(false); // fail or some used unit interface is not ready
+        end;
+        {$ELSE}
         pu:=tused_unit(used_units.first);
         while assigned(pu) do
          begin
@@ -2090,30 +2156,222 @@ var
             end;
            pu:=tused_unit(pu.next);
          end;
+        {$ENDIF}
+
+        {$IFDEF EnableCTaskPPU}
+        if not ppu_waitingfor_crc then
+        {$ENDIF}
+        begin
+          { load implementation symtable }
+          if mf_local_symtable in moduleflags then
+            begin
+              localsymtable:=tstaticsymtable.create(realmodulename^,moduleid);
+              tstaticsymtable(localsymtable).ppuload(ppufile);
+            end;
+
+          { we can now dereference all pointers to the implementation parts }
+          tstoredsymtable(globalsymtable).derefimpl(false);
+          { we've just loaded the localsymtable from the ppu file, so everything
+            in it was registered by definition (otherwise it wouldn't have been in
+            there) }
+          if assigned(localsymtable) then
+            tstoredsymtable(localsymtable).derefimpl(false);
+
+          derefunitimportsyms;
+
+          { read whole program optimisation-related information }
+          wpoinfo:=tunitwpoinfo.ppuload(ppufile);
+          tunitwpoinfo(wpoinfo).deref;
+          tunitwpoinfo(wpoinfo).derefimpl;
+        end;
+
+        {$IFDEF EnableCTaskPPU}
+        // check CRCs
+        ppu_waitingfor_crc:=true;
+        if not ppu_check_used_crcs then exit;
+
+        state:=ms_compiled;
+        {$ENDIF}
+      end;
+
+    {$IFDEF EnableCTaskPPU}
+    function tppumodule.load_usedunits_section: boolean;
+      var
+        pu: tused_unit;
+        IntfCRCValid, CRCValid: Boolean;
+      begin
+        Result:=true;
+        pu:=tused_unit(used_units.first);
+        while assigned(pu) do
+        begin
+          if pu.in_interface=in_interface then
+          begin
+            tppumodule(pu.u).loadppu(self);
+            { if this unit is scheduled for compilation or compiled we can stop }
+            if state<>ms_load then
+            begin
+              {$IFDEF DEBUG_PPU_CYCLES}
+              writeln('tppumodule.load_usedunits_section STOPPED ',modulename^,' ',statestr);
+              {$ENDIF}
+              exit(false);
+            end;
+            {$IFDEF DEBUG_PPU_CYCLES}
+            writeln('PPUALGO tppumodule.load_usedunits_section ',modulename^,' (',statestr,') ',BoolToStr(in_interface,'interface','implementation'),' uses "',pu.u.modulename^,'" state=',pu.u.statestr);
+            {$ENDIF}
+
+            if not pu.dependent_added then
+            begin
+              { add this unit to the dependencies }
+              pu.u.adddependency(self,true);
+              pu.dependent_added:=true;
+            end;
+
+            { check crc(s) if recompile is needed.
+              Currently ppus wait for a pas to be compiled, because a ppu cannot
+              use only the interface of a pas.
+              If an unit of a cycle is recompiled, the whole cycle is recompiled.
+
+              If this ppu was compiled with -Ur only check interface_crc, not crc }
+            CRCValid:=(not pu.u.do_reload) and (pu.u.state in [ms_load,ms_compiled,ms_processed]);
+            IntfCRCValid:=CRCValid {or (pu.u.state in [ms_compiling_waitimpl,ms_compiling_waitfinish,ms_compiled_waitcrc])};
+
+            if (IntfCRCValid and
+                     ((pu.u.interface_crc<>pu.interface_checksum) or
+                      (pu.u.indirect_crc<>pu.indirect_checksum)))
+                or (CRCValid and
+                  (not (mf_release in moduleflags)) and
+                  (pu.u.crc<>pu.checksum)
+                 ) then
+            begin
+              Message2(unit_u_recompile_crc_change,realmodulename^,pu.u.ppufilename,@queuecomment);
+  {$ifdef DEBUG_UNIT_CRC_CHANGES}
+              if (pu.u.interface_crc<>pu.interface_checksum) then
+                Comment(V_Normal,'  intfcrc change: '+hexstr(pu.u.interface_crc,8)+' for '+pu.u.ppufilename+' <> '+hexstr(pu.interface_checksum,8)+' in unit '+realmodulename^)
+              else if (pu.u.indirect_crc<>pu.indirect_checksum) then
+                Comment(V_Normal,'  indcrc change: '+hexstr(pu.u.indirect_crc,8)+' for '+pu.u.ppufilename+' <> '+hexstr(pu.indirect_checksum,8)+' in unit '+realmodulename^)
+              else
+                Comment(V_Normal,'  implcrc change: '+hexstr(pu.u.crc,8)+' for '+pu.u.ppufilename+' <> '+hexstr(pu.checksum,8)+' in unit '+realmodulename^);
+  {$endif DEBUG_UNIT_CRC_CHANGES}
+              recompile_reason:=rr_crcchanged;
+              {$IFDEF DEBUG_PPU_CYCLES}
+              writeln('PPUALGO tppumodule.load_usedunits_section ',modulename^,' ',BoolToStr(in_interface,'interface','implementation'),' uses "',pu.u.modulename^,'" old=',statestr,' new=',ms_compile);
+              {$ENDIF}
+              state:=ms_compile;
+              exit(false);
+            end;
+
+            if (not CRCValid) or (not pu.u.interface_compiled) then
+            begin
+              // an used unit is delayed
+              // Important: load the rest of the uses section
+              {$IFDEF DEBUG_PPU_CYCLES}
+              if not Result then writeln('PPUALGO tppumodule.load_usedunits_section ',modulename^,' ',BoolToStr(in_interface,'interface','implementation'),' uses "',pu.u.modulename^,'", state=',pu.u.statestr,', waiting for crc...');
+              {$ENDIF}
+              Result:=false;
+            end;
+          end;
+          pu:=tused_unit(pu.next);
+        end;
+      end;
 
-        { load implementation symtable }
-        if mf_local_symtable in moduleflags then
+    function tppumodule.ppu_check_used_crcs: boolean;
+    var
+      pu: tused_unit;
+    begin
+      Result:=false;
+      pu:=tused_unit(used_units.first);
+      while assigned(pu) do
+      begin
+        if pu.u.state in [ms_load,ms_compiled_waitcrc,ms_compiled,ms_processed] then
+        begin
+          if (pu.u.crc<>pu.checksum) then
           begin
-            localsymtable:=tstaticsymtable.create(realmodulename^,moduleid);
-            tstaticsymtable(localsymtable).ppuload(ppufile);
+            {$ifdef DEBUG_UNIT_CRC_CHANGES}
+            Comment(V_Normal,'  implcrc change: '+hexstr(pu.u.crc,8)+' for '+pu.u.ppufilename+' <> '+hexstr(pu.checksum,8)+' in unit '+realmodulename^);
+            {$endif DEBUG_UNIT_CRC_CHANGES}
+            recompile_reason:=rr_crcchanged;
+            {$IFDEF DEBUG_PPU_CYCLES}
+            writeln('PPUALGO tppumodule.ppu_check_used_crcs ',modulename^,' interface uses "',pu.u.modulename^,'" old=',statestr,' new=',ms_compile);
+            {$ENDIF}
+            state:=ms_compile;
+            exit;
           end;
+        end else begin
+          // waiting for crc
+          exit;
+        end;
+        pu:=tused_unit(pu.next);
+      end;
+      Result:=true;
+    end;
 
-        { we can now derefence all pointers to the implementation parts }
-        tstoredsymtable(globalsymtable).derefimpl(false);
-        { we've just loaded the localsymtable from the ppu file, so everything
-          in it was registered by definition (otherwise it wouldn't have been in
-          there) }
-        if assigned(localsymtable) then
-          tstoredsymtable(localsymtable).derefimpl(false);
+    function tppumodule.ppuloadcancontinue(out firstwaiting: tmodule): boolean;
+    var
+      pu: tused_unit;
+      uses_busy, check: Boolean;
+    begin
+      Result:=false;
+      firstwaiting:=nil;
+      if state<>ms_load then
+        Internalerror(2026020610);
+
+      if do_reload and not interface_compiled then
+        exit(true);
+
+      pu:=tused_unit(used_units.first);
+      while assigned(pu) do
+      begin
+        check:=false;
+        if do_reload then
+          // waiting for referenced used units
+          check:=pu.in_interface or ppu_waitingfor_crc
+        else if not interface_compiled then
+          // waiting for interface uses
+          check:=pu.in_interface
+        else if not ppu_waitingfor_crc then
+          // waiting for implementation uses
+          check:=not pu.in_interface
+        else
+          // waiting for crcs
+          check:=true;
+
+        if check then
+        begin
+          if not (pu.u.state in [ms_load,ms_compiled_waitcrc,ms_compiled,ms_processed])
+              or not pu.u.interface_compiled
+              or pu.u.do_reload
+              then
+          begin
+            firstwaiting:=pu.u;
+            exit;
+          end;
+        end;
+        pu:=tused_unit(pu.next);
+      end;
+      Result:=true;
+    end;
 
-        derefunitimportsyms;
+    function tppumodule.is_reload_needed(pu: tdependent_unit): boolean;
+      begin
+        if pu.u.state=ms_load then
+          Result:=tppumodule(pu.u).ppu_waitingfor_crc
+                or (pu.in_interface and pu.u.interface_compiled)
+        else
+          Result:=inherited is_reload_needed(pu);
+      end;
 
-        { read whole program optimisation-related information }
-        wpoinfo:=tunitwpoinfo.ppuload(ppufile);
-        tunitwpoinfo(wpoinfo).deref;
-        tunitwpoinfo(wpoinfo).derefimpl;
+    procedure tppumodule.recompile_cycle;
+      var
+        from_module: tmodule;
+      begin
+        recompile_reason:=rr_buildcycle;
+        from_module:=current_module;
+        set_current_module(self);
+        recompile_from_sources(loadedfrommodule);
+        set_current_module(from_module);
       end;
 
+    {$ENDIF EnableCTaskPPU}
 
     function tppumodule.needrecompile:boolean;
       var
@@ -2126,6 +2384,7 @@ var
            { need to recompile the current unit, check the interface
              crc. And when not compiled with -Ur then check the complete
              crc }
+
            if (pu.u.interface_crc<>pu.interface_checksum) or
               (pu.u.indirect_crc<>pu.indirect_checksum) or
               (
@@ -2197,14 +2456,18 @@ var
         do_reload:=false;
         { When the unit is already loaded or being loaded
          we can maybe skip a complete reload/recompile }
-        if assigned(globalsymtable) and
-          (not needrecompile) then
+        if assigned(globalsymtable)
+          {$IFDEF EnableCTaskPPU}
+          {$ELSE}
+          and (not needrecompile)
+          {$ENDIF}
+          then
          begin
            { When we don't have any data stored yet there
              is nothing to resolve }
            if interface_compiled and
              { it makes no sense to re-resolve the unit if it is already finally compiled }
-               not (state in [ms_compiled_waitcrc,ms_compiled,ms_processed]) then
+               not (state in [ms_compiled,ms_processed]) then
              begin
                re_resolve(from_module);
              end
@@ -2273,14 +2536,14 @@ var
           {$ENDIF}
           state:=ms_compile;
         end;
-        if not (state=ms_compile) then
+        if state=ms_load then
          begin
            load_interface;
            setdefgeneration;
-           if not (state=ms_compile) then
+           if state=ms_load then
             begin
               load_usedunits;
-              if not (state=ms_compile) then begin
+              if state=ms_load then begin
                 {$IFDEF DEBUG_PPU_CYCLES}
                 writeln('PPUALGO tppumodule.try_load_ppufile ',modulename^,' state=',state,' do_reload=',do_reload);
                 {$ENDIF}
@@ -2297,12 +2560,13 @@ var
 
       var
         pu : tused_unit;
+        was_interfaced_compiled: Boolean;
       begin
         { recompile the unit or give a fatal error if sources not available }
-        if not(sources_avail) then
+        if not sources_avail then
          begin
            search_unit_files(from_module,true);
-           if not(sources_avail) then
+           if not sources_avail then
             begin
               printcomments;
               if recompile_reason=rr_noppu then
@@ -2330,15 +2594,26 @@ var
           comments:=nil;
         end;
         {$IFDEF DEBUG_PPU_CYCLES}
-        writeln('PPUALGO tppumodule.recompile_from_sources ',modulename^,' old=',state,' new=',ms_compile);
+        writeln('PPUALGO tppumodule.recompile_from_sources ',modulename^,' old=',statestr,' new=',ms_compile);
         {$ENDIF}
         { Flag modules to reload }
         flagdependent(from_module);
+        {$IFDEF EnableCTaskPPU}
+        was_interfaced_compiled:=interface_compiled;
+        { disconnect dependending modules }
+        disconnect_depending_modules;
+        {$ENDIF}
         { Reset the module }
         reset(true);
         { mark this module for recompilation }
         state:=ms_compile;
+        {$IFDEF EnableCTaskPPU}
+        if was_interfaced_compiled then
+          setdefgeneration;
+        queue_module(Self); // queue after reset, so task state is cleared!
+        {$ELSE}
         setdefgeneration;
+        {$ENDIF}
       end;
 
     procedure tppumodule.post_load_or_compile(from_module : tmodule; second_time : boolean);
@@ -2350,10 +2625,13 @@ var
       if in_interface then
         internalerror(200212283);
 
+      {$IFDEF EnableCTaskPPU}
+      {$ELSE}
       { for a second_time recompile reload all dependent units,
         for a first time compile register the unit _once_ }
       if second_time or do_reload then
         reload_flagged_units;
+      {$ENDIF}
 
       { reopen the old module }
 {$ifdef SHORT_ON_FILE_HANDLES}
@@ -2367,14 +2645,75 @@ var
     function tppumodule.loadppu(from_module : tmodule) : boolean;
       const
         ImplIntf : array[boolean] of string[15]=('implementation','interface');
+      {$IFDEF EnableCTaskPPU}
+      begin
+        Result:=false;
+
+        writeln('PPUALGO tppumodule.loadppu START ',modulename^,' (',statestr,') used by "',from_module.modulename^,'" (',from_module.statestr,')');
+
+        Message3(unit_u_load_unit,from_module.modulename^,
+                 ImplIntf[from_module.in_interface],
+                 modulename^);
+
+        if do_reload then
+          exit(false); // delay reload until used units are ready
+
+        if state>ms_registered then
+          exit(interface_compiled);
+
+        loadedfrommodule:=from_module;
+
+        set_current_module(self);
+
+        if check_loadfrompackage then
+        begin
+          // No need to do anything, restore situation and exit.
+          set_current_module(from_module);
+          {$IFDEF DEBUG_PPU_CYCLES}
+          writeln('PPUALGO tppumodule.loadppu from package: ',modulename^,' (',statestr,') used by "',from_module.modulename^,'" (',from_module.statestr,')');
+          {$ENDIF}
+          exit(state in [ms_compiled,ms_processed]);
+        end;
+
+        { close old_current_ppu on system that are
+          short on file handles like DOS PM }
+{$ifdef SHORT_ON_FILE_HANDLES}
+        if from_module.is_unit and
+            assigned(tppumodule(from_module).ppufile) then
+          tppumodule(from_module).ppufile.tempclose;
+{$endif SHORT_ON_FILE_HANDLES}
+
+        // search ppu file
+        Message1(unit_u_loading_unit,modulename^);
+        if auPPU in search_unit_files(from_module,false) then
+        begin
+          state:=ms_load;
+          fromppu:=true;
+          load_interface;
+        end
+        else begin
+          {$IFDEF DEBUG_PPU_CYCLES}
+          writeln('PPUALGO tppumodule.try_load_ppufile ',modulename^,' no ppu found old=',statestr,' new=',ms_compile);
+          {$ENDIF}
+          // recompile_reason is already set by search_unit_files
+          state:=ms_compile;
+        end;
+
+        Result:=continueloadppu;
+
+        set_current_module(from_module);
+      end;
+
+      {$ELSE}
       var
         do_load,
         second_time: boolean;
 
       begin
+        Result:=false;
+
         Inc(LoadCount);
 
-        Result:=false;
         Message3(unit_u_load_unit,from_module.modulename^,
                  ImplIntf[from_module.in_interface],
                  modulename^);
@@ -2460,6 +2799,172 @@ var
         if LoadCount>0 then
           Dec(LoadCount);
       end;
+      {$ENDIF}
+
+    {$ifdef EnableCTaskPPU}
+    function tppumodule.continueloadppu: boolean;
+      var
+        old_module: tmodule;
+        do_load: boolean;
+        pu: tused_unit;
+      begin
+        old_module:=current_module;
+        set_current_module(self);
+
+        if do_reload then
+          Internalerror(2026021017);
+
+        if state=ms_load then
+        begin
+          if load_usedunits then
+          begin
+            {$IFDEF DEBUG_PPU_CYCLES}
+            writeln('PPUALGO tppumodule.continueloadppu ',modulename^,' finished state=',statestr);
+            {$ENDIF}
+            Message1(unit_u_finished_loading_unit,modulename^);
+          end else if state=ms_load then
+          begin
+            {$IFDEF DEBUG_PPU_CYCLES}
+            writeln('PPUALGO tppumodule.continueloadppu ',modulename^,' delay state=',statestr);
+            {$ENDIF}
+            { loading unfinished or reset, restore current_module }
+            set_current_module(old_module);
+            queue_module(Self);
+            exit;
+          end else if state<>ms_compile then
+            internalerror(2026020510);
+        end;
+
+        { PPU is not needed anymore }
+        if assigned(ppufile) then
+          discardppu;
+
+        if state=ms_compiled then
+        begin
+          Result:=true;
+          post_load_or_compile(loadedfrommodule,false);
+        end else if state=ms_compile then
+          recompile_from_sources(loadedfrommodule)
+        else begin
+          queue_module(Self);
+        end;
+
+        { we are back, restore current_module }
+        set_current_module(old_module);
+      end;
+
+    function tppumodule.canreload(out firstwaiting: tmodule): boolean;
+      var
+        check_impl_uses, check_crc: Boolean;
+        pu: tused_unit;
+      begin
+        firstwaiting:=nil;
+        if not interface_compiled then
+          exit(true);
+
+        // if implementation was parsed then implementation uses must be checked too
+        if state=ms_load then
+          check_impl_uses:=ppu_waitingfor_crc
+        else
+          check_impl_uses:=state in [ms_compiling_waitimpl..ms_compiled,ms_processed];
+
+        // if the crc(s) of used unit are known
+        check_crc:=state in [ms_load,ms_compiled,ms_processed];
+
+        pu:=tused_unit(used_units.first);
+        while assigned(pu) do
+        begin
+          if pu.in_interface or check_impl_uses then
+          begin
+            if not pu.u.interface_compiled
+                or pu.u.do_reload
+                or (check_crc
+                  and not (pu.u.state in [ms_load,ms_compiled_waitcrc,ms_compiled,ms_processed])) then
+            begin
+              firstwaiting:=pu.u;
+              exit(false);
+            end;
+          end;
+          pu:=tused_unit(pu.next);
+        end;
+        Result:=true;
+      end;
+
+    procedure tppumodule.reload;
+      var
+        pu: tused_unit;
+        do_load, check_impl_uses, check_crc: Boolean;
+      begin
+        if not do_reload then
+          Internalerror(2026021015);
+
+        if fromppu and (state in [ms_compiled,ms_processed]) then
+        begin
+          // reload ppu: check crcs again
+          state:=ms_load;
+          ppu_waitingfor_crc:=true;
+        end;
+
+        if interface_compiled then
+        begin
+          // if implementation was parsed then implementation uses must be checked too
+          if state=ms_load then
+            check_impl_uses:=ppu_waitingfor_crc
+          else
+            check_impl_uses:=state in [ms_compiling_waitimpl..ms_compiled,ms_processed];
+
+          // if the crc(s) of used unit are known
+          check_crc:=state in [ms_load,ms_compiled,ms_processed];
+
+          pu:=tused_unit(used_units.first);
+          while assigned(pu) do
+          begin
+            if pu.in_interface or check_impl_uses then
+            begin
+              if not pu.u.interface_compiled
+                  or pu.u.do_reload
+                  or (check_crc
+                    and not (pu.u.state in [ms_load,ms_compiled_waitcrc,ms_compiled,ms_processed])) then
+              begin
+                // bug in ctask.cancontinue
+                writeln('tppumodule.continueloadppu reloading ',modulename^,', but ',pu.u.modulename^,' not ready (',pu.u.statestr,').');
+                Internalerror(2026020918);
+              end;
+
+              if (pu.u.interface_crc<>pu.interface_checksum) or
+                  (pu.u.indirect_crc<>pu.indirect_checksum)
+                  or (check_crc and
+                    (not (mf_release in moduleflags)) and
+                    (pu.u.crc<>pu.checksum)
+                   ) then
+              begin
+                Message2(unit_u_recompile_crc_change,realmodulename^,pu.u.ppufilename,@queuecomment);
+    {$ifdef DEBUG_UNIT_CRC_CHANGES}
+                if (pu.u.interface_crc<>pu.interface_checksum) then
+                  Comment(V_Normal,'  intfcrc change: '+hexstr(pu.u.interface_crc,8)+' for '+pu.u.ppufilename+' <> '+hexstr(pu.interface_checksum,8)+' in unit '+realmodulename^)
+                else if (pu.u.indirect_crc<>pu.indirect_checksum) then
+                  Comment(V_Normal,'  indcrc change: '+hexstr(pu.u.indirect_crc,8)+' for '+pu.u.ppufilename+' <> '+hexstr(pu.indirect_checksum,8)+' in unit '+realmodulename^)
+                else
+                  Comment(V_Normal,'  implcrc change: '+hexstr(pu.u.crc,8)+' for '+pu.u.ppufilename+' <> '+hexstr(pu.checksum,8)+' in unit '+realmodulename^);
+    {$endif DEBUG_UNIT_CRC_CHANGES}
+                recompile_reason:=rr_crcchanged;
+                {$IFDEF DEBUG_PPU_CYCLES}
+                writeln('PPUALGO tppumodule.reload ',modulename^,' ',BoolToStr(in_interface,'interface','implementation'),' uses "',pu.u.modulename^,'" old=',statestr,' new=',ms_compile);
+                {$ENDIF}
+                state:=ms_compile;
+                exit;
+              end;
+
+            end;
+            pu:=tused_unit(pu.next);
+          end;
+        end;
+
+        do_load:=true;
+        check_reload(loadedfrommodule,do_load);
+      end;
+
+    {$endif}
 
     procedure tppumodule.discardppu;
       begin
@@ -2550,8 +3055,8 @@ var
                       HaveCycle:=FindCycle(CallerModule,hp,Cycle);
                       if HaveCycle then
                       begin
-                      {$IFDEF DEBUGCYCLE}
-                         Writeln('Done cycle check');
+                        {$IFDEF DEBUGCYCLE}
+                        Writeln('Done cycle check');
                         CyclePath:='';
                         hp2:=TModule(Cycle[Cycle.Count-1]);
                         for i:=0 to Cycle.Count-1 do begin

+ 50 - 15
compiler/pmodules.pas

@@ -192,6 +192,7 @@ implementation
         hp : tppumodule;
         unitsym : tunitsym;
         isnew,load_ok : boolean;
+        uu: tused_unit;
 
       begin
         { load unit }
@@ -199,24 +200,29 @@ implementation
         if isnew then
           usedunits.concat(tused_unit.create(hp,true,addasused,nil));
         load_ok:=hp.loadppu(curr);
-        hp.adddependency(curr,curr.in_interface);
         if not load_ok then
           { We must schedule a compile. }
           task_handler.addmodule(hp);
+        hp.adddependency(curr,curr.in_interface);
 
         { add to symtable stack }
         if assigned(hp.globalsymtable) then
           symtablestack.push(hp.globalsymtable);
         if (m_mac in current_settings.modeswitches) and
             assigned(hp.globalmacrosymtable) then
-           macrosymtablestack.push(hp.globalmacrosymtable);
+          macrosymtablestack.push(hp.globalmacrosymtable);
         { insert unitsym }
         unitsym:=cunitsym.create(hp.modulename^,hp);
         inc(unitsym.refs);
         tabstractunitsymtable(curr.localsymtable).insertunit(unitsym);
         if addasused then
+        begin
           { add to used units }
-          curr.addusedunit(hp,false,unitsym);
+          uu:=curr.addusedunit(hp,false,unitsym);
+          {$IFDEF EnableCTaskPPU}
+          uu.dependent_added:=true;
+          {$ENDIF}
+        end;
         result:=hp;
       end;
 
@@ -701,7 +707,6 @@ implementation
          pu  : tused_unit;
          state: tglobalstate;
          isLoaded : Boolean;
-         mwait : tmodule;
          lu : tmodule;
 
          procedure restorestate;
@@ -719,12 +724,11 @@ implementation
 
       begin
         Result:=true;
-        mwait:=nil;
         current_scanner.tempcloseinputfile;
         state:=tglobalstate.create(true);
-         { Load the units }
-         pu:=tused_unit(curr.used_units.first);
-         while assigned(pu) do
+        { Load the units }
+        pu:=tused_unit(curr.used_units.first);
+        while assigned(pu) do
           begin
             lu:=pu.u;
             { Only load the units that are in the current
@@ -732,18 +736,39 @@ implementation
             if pu.in_uses and
                (pu.in_interface=frominterface) then
              begin
-               if (lu.state in [ms_compiling_waitimpl..ms_compiled,ms_processed]) then
+               {$IFDEF EnableCTaskPPU}
+               // always call loadppu for the cycle test
+               tppumodule(lu).loadppu(curr);
+               if not (curr.state in [ms_compile,ms_compiling_wait,ms_compiling_waitintf,ms_compiling_waitimpl]) then
+               begin
+                 {$IFDEF DEBUG_PPU_CYCLES}
+                 writeln('loadunits STOPPED ',curr.modulename^,' ',curr.statestr);
+                 {$ENDIF}
+                 Result:=false;
+                 break;
+               end;
+               if not pu.dependent_added then
+               begin
+                 pu.dependent_added:=true;
+                 lu.adddependency(curr,frominterface);
+               end;
+               if not lu.interface_compiled or lu.do_reload then
+               begin
+                 // an used unit is delayed
+                 // Important: load the rest of the uses section
+                 Result:=false;
+               end;
+               {$ELSE}
+               if lu.interface_compiled then
                  isLoaded:=true
                else if (lu.state=ms_registered) then
                   // try to load
-                 isLoaded:=tppumodule(lu).loadppu(curr)
+                 isLoaded:=tppumodule(lu).loadppu(curr) and lu.interface_compiled
                else
                  isLoaded:=False;
                isLoaded:=IsLoaded and not lu.is_reset ;
                if not IsLoaded then
                  begin
-                   if mwait=nil then
-                     mwait:=lu;
                    // In case of is_reset, the task handler will discard the state if the module was already there
                    task_handler.addmodule(lu);
                  end;
@@ -753,17 +778,18 @@ implementation
                if curr.is_reset then
                  break;
                { is our module compiled? then we can stop }
-               if curr.state in [ms_compiled,ms_processed] then
+               if curr.state in [ms_compiled_waitcrc,ms_compiled,ms_processed] then
                  break;
                { add this unit to the dependencies }
                lu.adddependency(curr,frominterface);
+               {$ENDIF}
                { check hints }
                pu.check_hints;
              end;
             pu:=tused_unit(pu.next);
           end;
 
-         Restorestate;
+        Restorestate;
       end;
 
      {
@@ -1307,10 +1333,13 @@ type
         curr.in_interface:=false;
         curr.interface_compiled:=true;
 
+        {$IFDEF EnableCTaskPPU}
+        {$ELSE}
         { First reload all units depending on our interface, we need to do this
           in the implementation part to prevent erroneous circular references }
         tppumodule(curr).setdefgeneration;
         tppumodule(curr).reload_flagged_units;
+        {$ENDIF}
 
         { Parse the implementation section }
         if (m_mac in current_settings.modeswitches) and try_to_consume(_END) then
@@ -3009,9 +3038,15 @@ type
          else
            curr.consume_semicolon_after_uses:=false;
 
+         {$IFDEF EnableCTaskPPU}
+         if curr.is_initial then
+           load_ok:=false; // delay program, so ctask can finish all units
          if not load_ok then
            curr.state:=ms_compiling_wait;
-
+         {$ELSE}
+         if not load_ok then
+           curr.state:=ms_compiling_wait;
+         {$ENDIF}
 
          { Can we continue compiling ? }
 

+ 1 - 7
tests/tppu/bug41457/bug41457_ant.pas

@@ -2,13 +2,7 @@ unit bug41457_ant;
 
 interface
 
-uses
-  bug41457_seagull
-  ,bug41457_eagle
-  ;
-
-implementation
-
 uses bug41457_bird;
 
+implementation
 end.

+ 7 - 1
tests/tppu/bug41457/bug41457_bird.pas

@@ -2,7 +2,13 @@ unit bug41457_bird;
 
 interface
 
-uses bug41457_ant;
+uses
+  bug41457_seagull
+  ,bug41457_eagle
+  ;
 
 implementation
+
+uses bug41457_ant;
+
 end.

+ 1 - 1
tests/tppu/bug41457/bug41457_hawk.pas

@@ -4,6 +4,6 @@ interface
 
 implementation
 
-uses bug41457_ant;
+uses bug41457_bird;
 
 end.

+ 1 - 1
tests/tppu/bug41457/bug41457_seagull.pas

@@ -4,6 +4,6 @@ interface
 
 implementation
 
-uses bug41457_ant;
+uses bug41457_bird;
 
 end.

+ 40 - 6
tests/tppu/tcrecompile.pas

@@ -292,8 +292,13 @@ begin
   Step:='Second compile';
   UnitPath:=Dir+';'+Dir+PathDelim+'src2';
   Compile;
+  {$IFDEF EnableCTaskPPU}
+  // the main src is always compiled, bird changed, ant is only reloaded, not recompiled
+  CheckCompiled(['changeleaf1_prg.pas','changeleaf1_bird.pas']);
+  {$ELSE}
   // the main src is always compiled, bird changed, so ant must be recompiled as well
   CheckCompiled(['changeleaf1_prg.pas','changeleaf1_ant.pas','changeleaf1_bird.pas']);
+  {$ENDIF}
 end;
 
 procedure TTestRecompile.TestChangeInner1;
@@ -391,12 +396,19 @@ begin
   Step:='Second compile';
   UnitPath:=Dir+';'+Dir+PathDelim+'src2';
   Compile;
+  {$IFDEF EnableCTaskPPU}
+  // the main src is always compiled, cat changed but not crc,
+  // because a ppu needs the crc, bird waits in intf, so ant waits in intf, creating a waiting loop
+  // triggering a recompile of all the ppus of the whole cycle
+  CheckCompiled(['cycle3_changec_prg.pas','cycle3_changec_ant.pas','cycle3_changec_bird.pas','cycle3_changec_cat.pas']);
+  {$ELSE}
   // the main src is always compiled, cat changed, so bird must be recompiled as well
   CheckCompiled(['cycle3_changec_prg.pas','cycle3_changec_ant.pas','cycle3_changec_bird.pas','cycle3_changec_cat.pas']);
+  {$ENDIF}
 end;
 
 procedure TTestRecompile.TestCycleImpl3_ChangeC;
-// prog->ant->bird->cat, cat.impl->ant, change cat
+// prog->ant.impl->bird.impl->cat, cat.impl->ant, change cat impl
 var
   Dir: String;
 begin
@@ -416,8 +428,13 @@ begin
   Step:='Second compile';
   UnitPath:=Dir+';'+Dir+PathDelim+'src2';
   Compile;
+  {$IFDEF EnableCTaskPPU}
+  // the main src is always compiled, cat changed but not crc
+  CheckCompiled(['cycleimpl3_changec_prg.pas','cycleimpl3_changec_cat.pas']);
+  {$ELSE}
   // the main src is always compiled, cat changed, so bird must be recompiled as well
   CheckCompiled(['cycleimpl3_changec_prg.pas','cycleimpl3_changec_ant.pas','cycleimpl3_changec_bird.pas','cycleimpl3_changec_cat.pas']);
+  {$ENDIF}
 end;
 
 procedure TTestRecompile.TestChangeInlineBodyBug;
@@ -474,10 +491,15 @@ begin
 end;
 
 procedure TTestRecompile.TestBug41457;
+// ant: intf->bird
+// bird: intf->seagull,eagle, impl->ant
+// seagull: impl->bird
+// eagle: intf->hawk
+// hawk: impl->bird
 begin
   UnitPath:='bug41457';
   OutDir:=UnitPath+PathDelim+'ppus';
-  MainSrc:=UnitPath+PathDelim+'bug41457_bird.pas';
+  MainSrc:=UnitPath+PathDelim+'bug41457_ant.pas';
 
   Step:='First compile';
   CleanOutputDir;
@@ -489,11 +511,13 @@ begin
     'bug41457_seagull.pas']);
 
   Step:='Second compile';
-  // the two deepest nodes of the two cycles are eagle and hawk, which are not recompiled
   Compile;
-  CheckCompiled(['bug41457_ant.pas',
-    'bug41457_bird.pas',
-    'bug41457_seagull.pas']);
+  {$IFDEF EnableCTaskPPU}
+  CheckCompiled(['bug41457_ant.pas']);
+  {$ELSE}
+  // the main src is always compiled
+  CheckCompiled(['bug41457_ant.pas','bug41457_bird.pas','bug41457_seagull.pas']);
+  {$ENDIF}
 end;
 
 procedure TTestRecompile.TestImplInline1;
@@ -511,8 +535,13 @@ begin
 
   Step:='Second compile';
   Compile;
+  {$IFDEF EnableCTaskPPU}
+  // the main src is always compiled
+  CheckCompiled(['implinline1_ant.pas']);
+  {$ELSE}
   // the main src is always compiled, and since bird ppu depends on ant, it is always compiled as well
   CheckCompiled(['implinline1_ant.pas','implinline1_bird.pas']);
+  {$ENDIF}
 end;
 
 procedure TTestRecompile.TestImplInline2;
@@ -602,11 +631,16 @@ begin
   Step:='Second compile';
   UnitPath:=Dir+';'+Dir+PathDelim+'src2';
   Compile;
+  {$IFDEF EnableCTaskPPU}
+  // the main src is always compiled, cat impl of the generic changed, so specialization in ant changed
+  CheckCompiled(['generic_indirectuses_prg.pas','generic_indirectuses_ant.pas','generic_indirectuses_cat.pas']);
+  {$ELSE}
   // the main src is always compiled,
   // cat changed, so bird must be recompiled as well. bird should get the same CRCs.
   // finally even though ant does ant directly use cat, ant specializes the changed generic
   //   function from cat, so ant must be recompiled as well.
   CheckCompiled(['generic_indirectuses_prg.pas','generic_indirectuses_ant.pas','generic_indirectuses_bird.pas','generic_indirectuses_cat.pas']);
+  {$ENDIF}
 end;
 
 initialization

+ 5 - 0
tests/tppu/testppu.lpi

@@ -78,6 +78,11 @@
         <DebugInfoType Value="dsDwarf3"/>
       </Debugging>
     </Linking>
+    <Other>
+      <OtherDefines Count="1">
+        <Define0 Value="EnableCTaskPPU"/>
+      </OtherDefines>
+    </Other>
   </CompilerOptions>
   <Debugging>
     <Exceptions Count="3">