./trunk/gcc186/vcs_diff_compiler.patch 2026-03-03-01:03
> uname -a Linux cfarm186 5.10.0-29-amd64 #1 SMP Debian 5.10.216-1 (2024-05-03) x86_64 GNU/Linux
diff --cc compiler/ctask.pas
index f6daa2f6f9,9826b5e6d6..0000000000
--- a/compiler/ctask.pas
+++ b/compiler/ctask.pas
@@@ -28,10 -28,10 +28,10 @@@ unit ctask
interface
uses
- finput, fmodule, cclasses, globtype, globstat;
+ finput, fmodule, cclasses, globals, globtype, globstat;
type
- { ttask_list
+ { ttask_item
About state:
Contains scanner/parser position needed for compiling pascal sources,
@@@ -91,9 -76,15 +91,19 @@@
// Can we continue processing this module ? If not, firstwaiting contains first module that m is waiting for.
function cancontinue(m : tmodule; out firstwaiting: tmodule): boolean;
{ Overload of cancontinue, based on task. }
- function cancontinue(t: ttask_list; out firstwaiting: tmodule): boolean; inline;
+ function cancontinue(t: ttask_item; out firstwaiting: tmodule): boolean; inline;
{ Continue processing this module. Return true if the module is done and can be removed. }
++<<<<<<< HEAD
+ function continue_task(t : ttask_list): Boolean;
++=======
+ function continue_task(t : ttask_item): Boolean;
+ {$IFNDEF DisableCTaskPPU}
+ { Check all modules needing a reload }
+ function check_reloads: boolean;
+ { Check for a circular dependency and fix it }
+ function check_cycle: boolean;
+ {$ENDIF}
++>>>>>>> dd8e24a0b7 (Change class name from ttask_list to ttask_item)
{ 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. }
@@@ -155,40 -144,28 +165,40 @@@ begi
FreeAndNil(state);
end;
- function ttask_list.nexttask: ttask_list;
+ function ttask_item.nexttask: ttask_item;
begin
- Result:=ttask_list(next);
+ Result:=ttask_item(next);
end;
- procedure ttask_list.SaveState;
+ procedure ttask_item.SaveState;
begin
+ if module.fromppu then exit;
+ set_current_module(module);
if State=Nil then
- State:=tglobalstate.Create
+ State:=tglobalstate.Create(true)
else
- State.save;
+ State.save(true);
end;
- procedure ttask_list.RestoreState;
+ procedure ttask_item.RestoreState;
begin
- if not module.is_reset then
- state.restore;
+ if module.fromppu then exit;
+ if module.is_reset then
+ begin
+ writeln('ttask_list.RestoreState is_reset ',module.modulename^,' ',module.statestr);
+ Internalerror(2026030105);
+ end;
+ if state=nil then
+ begin
+ writeln('ttask_list.RestoreState state=nil ',module.modulename^,' ',module.statestr);
+ Internalerror(2026030106);
+ end;
+ state.restore;
if assigned(current_scanner) and assigned(current_scanner.inputfile) then
- if current_scanner.inputfile.closed then
+ if current_scanner.inputfile.closed then
begin
- current_scanner.tempopeninputfile;
- current_scanner.gettokenpos;
+ current_scanner.tempopeninputfile;
+ current_scanner.gettokenpos;
end;
end;
@@@ -213,15 -193,7 +223,19 @@@ begi
inherited destroy;
end;
++<<<<<<< HEAD
+function ttask_handler.findtask(m: tmodule): ttask_list;
+var
+ n: TSymStr;
+begin
+ n:=m.modulename^;
+ Result:=ttask_list(Hash.Find(n));
+end;
+
+function ttask_handler.findtask_nohash(m: tmodule): ttask_list;
++=======
+ function ttask_handler.findtask(m: tmodule): ttask_item;
++>>>>>>> dd8e24a0b7 (Change class name from ttask_list to ttask_item)
begin
result:=list.FirstTask;
@@@ -372,288 -335,85 +386,304 @@@ begi
rebuild_hash;
end;
-{$IFNDEF DisableCTaskPPU}
-function ttask_handler.check_reloads: boolean;
-{ returns true, if something changed }
+procedure ttask_handler.search_finished_scc(m: tmodule{$IFDEF DEBUG_PPU_CYCLES}; const Indent: string{$ENDIF});
+{ called after all circular_unit_groups have beeen computed.
+ depth-first-search all modules and computes tree_unfinished and other_scc_unfinished.
+ marks finished scc with scc_finished:=true.
+ returns an unfinished scc root, which sub sccs are all finished }
var
++<<<<<<< HEAD
+ uu: tused_unit;
+ um: tmodule;
++=======
+ t: ttask_item;
+ m: tppumodule;
+ firstwaiting: tmodule;
++>>>>>>> dd8e24a0b7 (Change class name from ttask_list to ttask_item)
begin
- Result:=false;
+ if m.cycle_search_stamp=tmodule.cycle_stamp then
+ exit;
+ m.cycle_search_stamp:=tmodule.cycle_stamp;
- { check if any do_reload module needs recompile due to crc }
- t:=list.firsttask;
- while t<>nil do
+ {$IFDEF DEBUG_PPU_CYCLES}
+ writeln(Indent,'ttask_handler.search_finished_scc ',m.modulename^,' ',m.statestr);
+ {$ENDIF}
+
+ m.scc_tree_unfinished:=m.do_reload or (m.state<>ms_processed);
+ m.other_scc_unfinished:=false;
+ m.scc_tree_crc_wait:=nil;
+
+ uu:=tused_unit(m.used_units.First);
+ while assigned(uu) do
begin
- m:=tppumodule(t.module);
- if m.do_reload then
- begin
- m.canreload(firstwaiting,true);
- if m.do_reload=false then
- Result:=true;
- end;
- t:=t.nexttask;
+ um:=uu.u;
+ if not um.scc_finished then
+ begin
+ search_finished_scc(um{$IFDEF DEBUG_PPU_CYCLES},Indent+' '{$ENDIF});
+ if um.scc_tree_unfinished then
+ begin
+ m.scc_tree_unfinished:=true;
+ if um.other_scc_unfinished
+ or ((m.scc_lowindex<>um.scc_lowindex) and um.scc_tree_unfinished) then
+ m.other_scc_unfinished:=true;
+ end
+ else if um.other_scc_unfinished then
+ Internalerror(2026022201);
+ if m.scc_tree_crc_wait=nil then
+ m.scc_tree_crc_wait:=um.scc_tree_crc_wait;
+ end;
+ uu:=tused_unit(uu.Next);
+ end;
+
+ if (m.scc_tree_crc_wait=nil)
+ and (m.do_reload or not m.crc_final or not m.interface_compiled) then
+ m.scc_tree_crc_wait:=m;
+
+ if m.scc_root=m then
+ begin
+ um:=m;
+ while assigned(um) do
+ begin
+ if (not m.scc_tree_unfinished) then
+ begin
+ { scc finished }
+ {$IFDEF DEBUG_CTASK}
+ writeln('CTASK finished scc: ',um.modulename^,' ',um.statestr);
+ {$ENDIF}
+ um.scc_finished:=true;
+ um.scc_lowindex:=0;
+ um.scc_index:=0;
+ end;
+ if um.scc_tree_crc_wait=nil then
+ um.scc_tree_crc_wait:=m.scc_tree_crc_wait;
+ um:=um.scc_next;
+ end;
end;
+
+ {$IFDEF DEBUG_PPU_CYCLES}
+ if m=m.scc_root then
+ writeln(Indent,'SCC: ',m.modulename^,' ',m.statestr,' size=',get_scc_count(m),' other_scc=',m.other_scc_unfinished,' tree_crc_wait=',m.scc_tree_crc_wait<>nil);
+ {$ENDIF}
end;
-function ttask_handler.check_cycle: boolean;
-{ returns true if something changed }
+function ttask_handler.find_unfinished_leaf_scc(m: tmodule): tmodule;
var
+ uu: tused_unit;
+ um: tmodule;
+begin
+ if m.cycle_search_stamp=tmodule.cycle_stamp then
+ exit(nil);
+ m.cycle_search_stamp:=tmodule.cycle_stamp;
+
+ if (m=m.scc_root) { m is a scc root }
+ and not m.other_scc_unfinished { scc has no unfinished sub scc }
+ and m.scc_tree_unfinished { scc has at least one unfinished module }
+ then
+ exit(m);
+
+ uu:=tused_unit(m.used_units.First);
+ while assigned(uu) do
+ begin
+ um:=uu.u;
+ if not um.scc_finished then
+ begin
+ Result:=find_unfinished_leaf_scc(um);
+ if Result<>nil then exit;
+ end;
+ uu:=tused_unit(uu.Next);
+ end;
+ Result:=nil;
+end;
+
+function ttask_handler.is_uses_waiting(m: tmodule; uu: tused_unit): boolean;
+var
++<<<<<<< HEAD
+ um: tmodule;
+ check_impl_uses, check_crc: boolean;
+begin
+ um:=uu.u;
+ tppumodule(m).get_check_uses(check_impl_uses, check_crc);
++=======
+ last: ttask_item;
+ cycle_unit: tppumodule;
++>>>>>>> dd8e24a0b7 (Change class name from ttask_list to ttask_item)
- function Search(m: tppumodule): boolean;
- var
- pm: tppumodule;
- firstwaiting: tmodule;
- begin
- Result:=false;
+ if (uu.in_interface or check_impl_uses)
+ and not um.interface_compiled then
+ exit(true); { waiting for interface_compiled }
- { mark module as searched }
- m.cycle_search_stamp:=m.cycle_stamp;
+ if check_crc and not um.crc_final then
+ exit(true); { waiting for crc }
- cancontinue(m,firstwaiting);
- if firstwaiting=nil then
- Internalerror(2026021913);
- pm:=tppumodule(firstwaiting);
- if pm.cycle_stamp=pm.cycle_search_stamp then
+ Result:=false;
+end;
+
+function ttask_handler.check_do_reload_cycle(scc_root: tmodule): boolean;
+{ return true if something changed }
+var
+ m, firstwaiting: tmodule;
+ HasDoReload: Boolean;
+begin
+ Result:=false;
+ HasDoReload:=false;
+ m:=scc_root;
+ while assigned(m) do
begin
- { cycle found }
- cycle_unit:=pm;
- Result:=true;
- end else if Search(pm) then
+ if m.do_reload then
+ begin
+ HasDoReload:=true;
+ if not tppumodule(m).canreload(firstwaiting,false,true) then
+ exit;
+ end;
+ m:=m.scc_next;
+ end;
+
+ if not HasDoReload then
+ exit;
+
+ { reload all do_reloads }
+ Result:=true;
+ m:=scc_root;
+ while assigned(m) do
begin
- { m and pm are part of the cycle }
- Result:=true;
+ if m.do_reload then
+ begin
+ {$IFDEF DEBUG_CTASK}
+ writeln('PPUALGO ttask_handler.check_do_reload_cycle reloading ',m.modulename^,' ',m.statestr,' ...');
+ {$ENDIF}
+ reload_module(m);
+ end;
+ m:=m.scc_next;
end;
+end;
- if Result then
+function ttask_handler.check_crc_mismatches(scc_root: tmodule): boolean;
+{ recompile all scc modules whose crc of used units mismatch }
+var
+ m, next_m: tmodule;
+ pu: tused_unit;
+ check_impl_uses, check_crc: Boolean;
+begin
+ Result:=false;
+ m:=scc_root;
+ while assigned(m) do
begin
- { m is part of the cycle -> recompile ppu }
- if m.fromppu then
+ next_m:=m.scc_next;
+ if tppumodule(m).get_check_uses(check_impl_uses, check_crc) or check_crc then
+ begin
+ pu:=tused_unit(m.used_units.First);
+ while assigned(pu) do
+ begin
+ if pu.in_interface or check_crc then
+ begin
+ if (pu.u.interface_compiled
+ and ((pu.u.interface_crc<>pu.interface_checksum)
+ or (pu.u.indirect_crc<>pu.indirect_checksum)))
+ or (pu.u.crc_final and check_crc and (pu.u.crc<>pu.checksum) ) then
+ begin
+ {$IFDEF DEBUG_CTASK}
+ writeln('PPUALGO ttask_handler.check_crc_mismatches recompile ',m.modulename^,' ',m.statestr,' ',BoolToStr(pu.in_interface,'interface','implementation'),' uses ',pu.u.modulename^,' ...');
+ {$ENDIF}
+ {$ifdef DEBUG_UNIT_CRC_CHANGES}
+ if (pu.u.interface_crc<>pu.interface_checksum) then
+ writeln(' intfcrc change: '+hexstr(pu.u.interface_crc,8)+' for '+pu.u.modulename^+' <> '+hexstr(pu.interface_checksum,8)+' in unit '+m.modulename^)
+ else if (pu.u.indirect_crc<>pu.indirect_checksum) then
+ writeln(V_Normal,' indcrc change: '+hexstr(pu.u.indirect_crc,8)+' for '+pu.u.modulename^+' <> '+hexstr(pu.indirect_checksum,8)+' in unit '+m.modulename^)
+ else
+ writeln(V_Normal,' implcrc change: '+hexstr(pu.u.crc,8)+' for '+pu.u.modulename^+' <> '+hexstr(pu.checksum,8)+' in unit '+m.modulename^);
+ {$endif DEBUG_UNIT_CRC_CHANGES}
+ recompile_module(m);
+ Result:=true;
+ break;
+ end;
+ end;
+ pu:=tused_unit(pu.Next);
+ end;
+ end;
+ m:=next_m;
+ end;
+end;
+
+function ttask_handler.check_cycle_wait_for_pas(scc_root: tmodule): boolean;
+{ find a waiting pas module A (non ppu),
+ dfs through the scc to find all modules waiting for A,
+ choose a ppu module to recompile }
+var
+ pas_mod, best: tmodule;
+
+ function search(m: tmodule): boolean;
+ var
+ uu: tused_unit;
+ um: tmodule;
+ i: Integer;
+ begin
+ Result:=false;
+ if m.cycle_search_stamp=tmodule.cycle_stamp then exit;
+ m.cycle_search_stamp:=tmodule.cycle_stamp;
+
+ uu:=tused_unit(m.used_units.First);
+ while assigned(uu) do
begin
- {$IFDEF DEBUG_CTASK}
- writeln('PPUALGO check_cycle cycle_unit=',cycle_unit.modulename^,' ',cycle_unit.statestr,', RECOMPILE ',m.modulename^,' ',m.statestr);
- {$ENDIF}
- m.recompile_cycle;
- check_cycle:=true; { something changed }
- end else begin
- {$IFDEF DEBUG_CTASK}
- writeln('PPUALGO check_cycle cycle_unit=',cycle_unit.modulename^,' ',cycle_unit.statestr,', KEEPING ',m.modulename^,' ',m.statestr);
- {$ENDIF}
+ um:=uu.u;
+ if um=pas_mod then
+ begin
+ { m waits for pas_mod }
+ Result:=true;
+ if m.fromppu then
+ begin
+ best:=m;
+ exit;
+ end;
+ end;
+ if (um.scc_root=m.scc_root)
+ and is_uses_waiting(m,uu) then
+ begin
+ if search(um) then
+ begin
+ Result:=true;
+ if m.fromppu then
+ begin
+ best:=m;
+ exit;
+ end;
+ end;
+ end;
+ uu:=tused_unit(uu.Next);
end;
- end;
- if m=cycle_unit then
- Result:=false; { the cycle started with m, the remaining path is not part of the cycle }
+ if (m.state=ms_compiling_waitfinish) and assigned(m.waitingforunit) then
+ begin
+ for i:=0 to m.waitingforunit.Count do
+ begin
+ um:=tmodule(m.waitingforunit[i]);
+ if um=pas_mod then
+ begin
+ { m waits for pas_mod }
+ Result:=true;
+ if m.fromppu then
+ begin
+ best:=m;
+ exit;
+ end;
+ end;
+ if search(um) then
+ begin
+ Result:=true;
+ if m.fromppu then
+ begin
+ best:=m;
+ exit;
+ end;
+ end;
+ end;
+ end;
end;
++<<<<<<< HEAD
++=======
+ var
+ t: ttask_item;
++>>>>>>> dd8e24a0b7 (Change class name from ttask_list to ttask_item)
begin
Result:=false;
@@@ -777,8 -489,8 +807,13 @@@ begi
if m.is_unit then
begin
n:=m.modulename^;
++<<<<<<< HEAD
+ t:=findtask_nohash(m);
+ t2:=ttask_list(Hash.Find(n));
++=======
+ t:=findtask(m);
+ t2:=ttask_item(Hash.Find(n));
++>>>>>>> dd8e24a0b7 (Change class name from ttask_list to ttask_item)
if t<>t2 then
begin
if t=nil then
@@@ -811,176 -523,12 +846,181 @@@ begi
{$ENDIF}
end;
-procedure ttask_handler.processqueue;
+function ttask_handler.restore_state(m: tmodule): ttask_list;
+begin
+ Result:=findtask(m);
+ if Result=nil then
+ begin
+ addmodule(m);
+ Result:=findtask(m);
+ end
+ else if Result.state<>nil then
+ Result.RestoreState;
+end;
+
+procedure ttask_handler.clear_state;
+begin
+ symtablestack:=nil;
+ macrosymtablestack:=nil;
+end;
+
+function ttask_handler.reload_module(m: tmodule): ttask_list;
+begin
+ if m.state in [ms_compiled,ms_processed] then
+ begin
+ writeln('ttask_handler.reload_module ',m.modulename^,' ',m.statestr);
+ Internalerror(2026022410);
+ end;
+
+ Result:=restore_state(m);
+ tppumodule(m).reload;
+ Result.SaveState;
+ clear_state;
+end;
+
+function ttask_handler.recompile_module(m: tmodule): ttask_list;
+begin
+ if m.state in [ms_compiled,ms_processed] then
+ begin
+ writeln('ttask_handler.recompile_module ',m.modulename^,' ',m.statestr);
+ Internalerror(2026022411);
+ end;
+ if mf_release in m.moduleflags then
+ begin
+ writeln('ttask_handler.recompile_module ',m.modulename^,' ',m.statestr,' unit was compiled with Ur');
+ Internalerror(2026022412);
+ end;
+
+ Result:=restore_state(m);
+ tppumodule(m).recompile_cycle; // this will call queuemodule
+ clear_state;
+end;
+procedure ttask_handler.update_circular_unit_groups;
var
++<<<<<<< HEAD
+ {$IFDEF DEBUG_PPU_CYCLES}
+ grp_cnt: integer;
+ {$ENDIF}
+ cnt: Integer;
+ cur_index: integer;
+ stack: array of tmodule;
+ stackindex: integer;
+
+ procedure scc_traverse(m: tmodule);
+ var
+ uu: tused_unit;
+ um, prev: tmodule;
+ begin
+ inc(cur_index);
+ m.scc_index:=cur_index;
+ m.scc_lowindex:=cur_index;
+ //writeln('scc_traverse ',m.modulename^,' cur_index=',cur_index,' ',length(stack),' stackindex=',stackindex);
+ stack[stackindex]:=m;
+ inc(stackindex);
+ m.scc_onstack:=true;
+
+ uu:=tused_unit(m.used_units.first);
+ while assigned(uu) do
+ begin
+ um:=uu.u;
+ if not um.scc_finished then
+ begin
+ if um.scc_index=0 then
+ begin
+ scc_traverse(um);
+ if m.scc_lowindex > um.scc_lowindex then
+ m.scc_lowindex:=um.scc_lowindex;
+ end
+ else if um.scc_onstack then
+ begin
+ { um is in same scc }
+ if m.scc_lowindex > um.scc_index then
+ m.scc_lowindex:=um.scc_index;
+ end;
+ end;
+ uu:=tused_unit(uu.next);
+ end;
+
+ if m.scc_lowindex = m.scc_index then
+ begin
+ { new scc, pop from stack }
+ {$IFDEF DEBUG_PPU_CYCLES}
+ writeln('scc_traverse scc_root=',m.modulename^,' ',m.statestr);
+ inc(grp_cnt);
+ {$ENDIF}
+ prev:=nil;
+ repeat
+ dec(stackindex);
+ um:=stack[stackindex];
+ {$IFDEF DEBUG_PPU_CYCLES}
+ if m<>um then writeln(' scc module: ',um.modulename^,' ',um.statestr);
+ {$ENDIF}
+ um.scc_onstack:=false;
+ um.scc_root:=m;
+ um.scc_next:=prev;
+ um.scc_lowindex:=m.scc_lowindex;
+ prev:=um;
+ until m=um;
+ end;
+ end;
++=======
+ t, besttask: ttask_item;
+ firstwaiting, m: tmodule;
++>>>>>>> dd8e24a0b7 (Change class name from ttask_list to ttask_item)
+
+ procedure scc_clear(m: tmodule);
+ var
+ uu: tused_unit;
+ begin
+ if m.scc_finished then exit;
+
+ if m.cycle_search_stamp=tmodule.cycle_stamp then
+ exit; { already visited }
+ m.cycle_search_stamp:=tmodule.cycle_stamp;
+
+ inc(cnt);
+ m.scc_root:=nil;
+ m.scc_next:=nil;
+ m.scc_index:=0;
+ m.scc_lowindex:=0;
+ m.scc_onstack:=false;
+ uu:=tused_unit(m.used_units.First);
+ while assigned(uu) do
+ begin
+ if not uu.u.scc_finished then
+ scc_clear(uu.u);
+ uu:=tused_unit(uu.Next);
+ end;
+ end;
+
+begin
+ cnt:=0;
+ tmodule.increase_cycle_stamp;
+ scc_clear(main_module);
+ stack:=[];
+ SetLength(stack,cnt);
+ stackindex:=0;
+
+ {$IFDEF DEBUG_PPU_CYCLES}
+ grp_cnt:=0;
+ {$ENDIF}
+ cur_index:=0;
+ scc_traverse(main_module);
+ {$IFDEF DEBUG_PPU_CYCLES}
+ writeln('tmodule.update_circular_unit_groups modulecnt=',cnt,' grp_cnt=',grp_cnt);
+ {$ENDIF}
+end;
+procedure ttask_handler.processqueue;
+
+var
+ besttask: ttask_list;
+ firstwaiting, m, scc_root, best: tmodule;
+ n: TSymStr;
+ {$IFDEF DEBUG_CTASK}
+ loopcnt: integer;
+ {$ENDIF}
begin
{ Strategy: goal is to write ppus early, so that mem is freed early and in case of an error
next compile can load ppus instead of compiling again. }
@@@ -1105,10 -603,10 +1145,10 @@@ begi
{$ENDIF}
n:=m.modulename^;
- t:=ttask_list(Hash.Find(n));
+ t:=ttask_item(Hash.Find(n));
{$IFDEF DEBUG_CTASK}
- if findtask(m)<>t then
+ if findtask_nohash(m)<>t then
begin
writeln('ttask_handler.addmodule Hash<>findtask ',m.modulename^);
Internalerror(2026021902);
@@@ -1142,122 -642,99 +1182,166 @@@
{$ENDIF}
end;
++<<<<<<< HEAD
+procedure ttask_handler.write_scc;
++=======
+ procedure ttask_handler.write_queue;
+ var
+ last: ttask_item;
+ cycle_unit: tppumodule;
++>>>>>>> dd8e24a0b7 (Change class name from ttask_list to ttask_item)
- function Search(m: tppumodule): boolean;
+ function Search(m: tmodule; const Indent: string): tmodule;
+ // returns m, if m is an unfinished scc
var
- pm: tppumodule;
- firstwaiting: tmodule;
+ firstwaiting, sub_scc, um: tmodule;
+ uu, um2: tused_unit;
begin
- Result:=false;
-
- { mark module as searched }
- m.cycle_search_stamp:=m.cycle_stamp;
-
- cancontinue(m,firstwaiting);
- if firstwaiting=nil then
- exit;
- pm:=tppumodule(firstwaiting);
- if pm.cycle_stamp=pm.cycle_search_stamp then
- begin
- { cycle found }
- cycle_unit:=pm;
- Result:=true;
- writeln('cycle found: ',pm.modulename^,' ',pm.statestr,' ppu=',pm.fromppu,' used by...');
- end else if Search(pm) then
- begin
- { m and pm are part of the cycle }
- Result:=true;
- end;
+ Result:=nil;
+ if m.cycle_search_stamp=tmodule.cycle_stamp then exit;
+ m.cycle_search_stamp:=tmodule.cycle_stamp;
- if Result then
- begin
- { m is part of the cycle -> recompile ppu }
- writeln(' cycle-path: ',m.modulename^,' ',m.statestr,' ppu=',m.fromppu,' used by...');
- end;
+ sub_scc:=nil;
+ uu:=tused_unit(m.used_units.First);
+ while assigned(uu) do
+ begin
+ um:=Search(uu.u,Indent+' ');
+ if sub_scc=nil then sub_scc:=um;
+ uu:=tused_unit(uu.Next);
+ end;
- if m=cycle_unit then
- Result:=false; { the cycle started with m, the remaining path is not part of the cycle }
+ firstwaiting:=nil;
+ if m=m.scc_root then
+ cancontinue(m,firstwaiting);
+ write(Indent,' ',m.modulename^,' ',m.statestr);
+ if m.scc_finished then
+ write(' scc_finished');
+ if m=m.scc_root then
+ begin
+ if not m.scc_finished and m.scc_tree_unfinished then
+ Result:=m;
+ write(' SCC ',get_scc_count(m),' WaitForSCC=',m.other_scc_unfinished);
+ if sub_scc<>nil then
+ begin
+ // has an unfinished sub scc
+ if not m.other_scc_unfinished then
+ begin
+ writeln;
+ writeln('ERROR: has unfinished sub scc: ',sub_scc.modulename^,' ',sub_scc.statestr,' scc_tree_unfinished=',sub_scc.scc_tree_unfinished);
+ Internalerror(2026022205);
+ end
+ else
+ write(' unfinished sub scc=',sub_scc.modulename^,' ',sub_scc.statestr);
+ end
+ else
+ begin
+ // has no unfinished sub scc
+ if m.other_scc_unfinished then
+ begin
+ writeln;
+ writeln('ERROR: this scc has no unfinished sub scc:');
+ um:=m;
+ while assigned(um) do
+ begin
+ cancontinue(um,firstwaiting);
+ write(' ',um.modulename^,' ',um.statestr,' tree_unfinished=',um.scc_tree_unfinished,' other=',um.other_scc_unfinished);
+ if um.scc_finished then
+ write(' ERROR:scc_finished');
+ if firstwaiting<>nil then
+ write(' WaitsFor=',firstwaiting.modulename^,' ',firstwaiting.statestr)
+ else
+ write(' WaitsFor=nil');
+ if um.scc_root<>m then
+ if um.scc_root<>nil then
+ write(' ERROR:scc_root=',um.scc_root.modulename^)
+ else
+ write(' ERROR:scc_root=nil');
+ writeln;
+
+ um2:=tused_unit(um.used_units.First);
+ while assigned(um2) do
+ begin
+ writeln(' ',um2.u.modulename^,' ',um2.u.statestr,' scc_finished=',um2.u.scc_finished,' tree_unfinished=',um2.u.scc_tree_unfinished);
+ um2:=tused_unit(um2.Next);
+ end;
+
+ um:=um.scc_next;
+ end;
+ Internalerror(2026022206);
+ end;
+ if firstwaiting<>nil then
+ write(' WaitForMod=',firstwaiting.modulename^,' ',firstwaiting.statestr)
+ else
+ write(' WaitForMod=nil');
+ end;
+ end
+ else
+ begin
+ if m.scc_root=nil then
+ write(' ERROR: scc_root=nil')
+ else begin
+ write(' scc_root=',m.scc_root.modulename^);
+ cancontinue(m,firstwaiting);
+ if firstwaiting<>nil then
+ write(' WaitForMod=',firstwaiting.modulename^,' ',firstwaiting.statestr)
+ else
+ write(' WaitForMod=nil');
+ end;
+ end;
+ writeln;
end;
++<<<<<<< HEAD
+begin
+ writeln('ttask_handler.write_scc');
+ tmodule.increase_cycle_stamp;
+ Search(main_module,'');
+end;
++=======
+ var
+ t, wt: ttask_item;
+ firstwaiting, m: tmodule;
+ cc: Boolean;
+ n: TSymStr;
+ begin
+ writeln('ttask_handler.write_queue:');
+ t:=list.firsttask;
+ while t<>nil do
+ begin
+ cc:=cancontinue(t,firstwaiting);
+ m:=t.module;
+
+ if m.is_unit then
+ begin
+ n:=m.modulename^;
+ wt:=ttask_item(Hash.Find(n));
+ if wt<>t then
+ writeln('Error: module=',m.modulename^,' ',m.statestr,' wrong hash task');
+ end;
+
+ if firstwaiting<>nil then
+ begin
+ writeln('queue: ',m.modulename^,' ',m.statestr,' cancontinue=',cc,' firstwaiting=',firstwaiting.modulename^,' ',firstwaiting.statestr,' intfcompiled=',firstwaiting.interface_compiled,' crc=',firstwaiting.crc_final);
+ wt:=findtask(firstwaiting);
+ if wt=nil then
+ writeln('Error: waiting for ',firstwaiting.modulename^,', which is not in queue');
+ end
+ else
+ writeln('queue: ',m.modulename^,' ',m.statestr,' cancontinue=',cc,' firstwaiting=nil');
+ t:=t.nexttask;
+ end;
+
+ { write a cycle: }
++>>>>>>> dd8e24a0b7 (Change class name from ttask_list to ttask_item)
- { find highest unit_index in queue }
- t:=list.firsttask;
- if t=nil then exit;
- last:=nil;
- while t<>nil do
+function ttask_handler.get_scc_count(scc_root: tmodule): integer;
+begin
+ Result:=0;
+ while assigned(scc_root) do
begin
- if (last=nil) or (last.module.unit_index