mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2026-02-19 19:36:26 +01:00
compiler: ctask scheduler loads ppu files, fixed cycle check, fixed -Ur
This commit is contained in:
mattias
parent
8af23fd95b
commit
060425cab6
@ -72,14 +72,12 @@ type
|
||||
// Find the task for module m
|
||||
function findtask(m : tmodule) : ttask_list;
|
||||
// Can we continue processing this module ? If not, firstwaiting contains first module that m is waiting for.
|
||||
function cancontinue(m : tmodule; checksub : boolean; out firstwaiting: tmodule): boolean;
|
||||
function cancontinue(m : tmodule; out firstwaiting: tmodule): boolean;
|
||||
// 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; // EnableCTaskPPU: remove
|
||||
// Continue processing this module. Return true if the module is done and can be removed.
|
||||
function continue_task(t : ttask_list): Boolean;
|
||||
{$IFDEF EnableCTaskPPU}
|
||||
{$IFNDEF DisableCTaskPPU}
|
||||
// Check for a circular dependency and fix it
|
||||
function check_cycle: boolean;
|
||||
{$ENDIF}
|
||||
@ -173,14 +171,14 @@ constructor ttask_handler.create;
|
||||
begin
|
||||
list:=ttasklinkedlist.Create;
|
||||
hash:=TFPHashList.Create;
|
||||
{$IFDEF EnableCTaskPPU}
|
||||
{$IFNDEF DisableCTaskPPU}
|
||||
tmodule.queue_module:=@addmodule;
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
destructor ttask_handler.destroy;
|
||||
begin
|
||||
{$IFDEF EnableCTaskPPU}
|
||||
{$IFNDEF DisableCTaskPPU}
|
||||
tmodule.queue_module:=nil;
|
||||
{$ENDIF}
|
||||
hash.free;
|
||||
@ -203,35 +201,9 @@ begin
|
||||
{$IFDEF DEBUG_CTASK_VERBOSE}Writeln('No task found for '+m.ToString);{$ENDIF}
|
||||
end;
|
||||
|
||||
function ttask_handler.cancontinue(m: tmodule; checksub : boolean; out firstwaiting: tmodule): boolean;
|
||||
|
||||
procedure CheckUsed(out acandidate : tmodule);
|
||||
|
||||
var
|
||||
itm : TLinkedListItem;
|
||||
iscandidate : boolean;
|
||||
m2 : tmodule;
|
||||
|
||||
begin
|
||||
acandidate:=nil;
|
||||
itm:=m.used_units.First;
|
||||
while assigned(itm) do
|
||||
begin
|
||||
iscandidate:=Not (tused_unit(itm).u.state in [ms_processed,ms_compiled]);
|
||||
if iscandidate then
|
||||
begin
|
||||
acandidate:=tused_unit(itm).u;
|
||||
if cancontinue(acandidate,false,m2) then
|
||||
break;
|
||||
end;
|
||||
itm:=itm.Next;
|
||||
end;
|
||||
acandidate:=nil;
|
||||
end;
|
||||
|
||||
function ttask_handler.cancontinue(m: tmodule; out firstwaiting: tmodule): boolean;
|
||||
var
|
||||
m2 : tmodule;
|
||||
|
||||
begin
|
||||
firstwaiting:=nil;
|
||||
|
||||
@ -239,7 +211,7 @@ begin
|
||||
if (m.is_initial and not m.is_unit) and (list.count>1) then
|
||||
exit(False);
|
||||
|
||||
{$IFDEF EnableCTaskPPU}
|
||||
{$IFNDEF DisableCTaskPPU}
|
||||
if m.do_reload then
|
||||
cancontinue:=tppumodule(m).canreload(firstwaiting)
|
||||
else
|
||||
@ -248,7 +220,7 @@ begin
|
||||
case m.state of
|
||||
ms_unknown : cancontinue:=true;
|
||||
ms_registered : cancontinue:=true;
|
||||
{$IFDEF EnableCTaskPPU}
|
||||
{$IFNDEF DisableCTaskPPU}
|
||||
ms_load: cancontinue:=tppumodule(m).ppuloadcancontinue(firstwaiting);
|
||||
{$ENDIF}
|
||||
ms_compile : cancontinue:=true;
|
||||
@ -260,18 +232,13 @@ begin
|
||||
ms_compiled : cancontinue:=true;
|
||||
ms_processed : cancontinue:=true;
|
||||
ms_moduleerror : cancontinue:=true;
|
||||
{$IFDEF DisableCTaskPPU}
|
||||
else
|
||||
InternalError(2024011802);
|
||||
{$ENDIF}
|
||||
end;
|
||||
end;
|
||||
|
||||
// EnableCTaskPPU: remove checksub
|
||||
if (not cancontinue) and checksub then
|
||||
begin
|
||||
checkused(m2);
|
||||
if m2<>nil then
|
||||
firstwaiting:=m2;
|
||||
end;
|
||||
{$IFDEF DEBUG_CTASK_VERBOSE}
|
||||
Write('CTASK: ',m.ToString,' state: ',m.state,', can continue: ',Result);
|
||||
if result then
|
||||
@ -290,71 +257,7 @@ end;
|
||||
function ttask_handler.cancontinue(t : ttask_list; out firstwaiting : tmodule): boolean;
|
||||
|
||||
begin
|
||||
Result:=cancontinue(t.module,true,firstwaiting);
|
||||
end;
|
||||
|
||||
function ttask_handler.countwaiting(m: tmodule; out highest_state: tmodulestate; out
|
||||
firsthighestwaiting: tmodule): integer;
|
||||
var
|
||||
i: Integer;
|
||||
dep_unit: tdependent_unit;
|
||||
state: tmodulestate;
|
||||
waitfor_unit: tmodule;
|
||||
begin
|
||||
Result:=0;
|
||||
highest_state:=ms_registered;
|
||||
firsthighestwaiting:=nil;
|
||||
|
||||
if m.is_initial and not m.is_unit then
|
||||
// program/library
|
||||
exit;
|
||||
|
||||
if m.waitingunits<>nil then
|
||||
begin
|
||||
for i:=0 to m.waitingunits.Count-1 do
|
||||
begin
|
||||
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
|
||||
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;
|
||||
end;
|
||||
Result:=cancontinue(t.module,firstwaiting);
|
||||
end;
|
||||
|
||||
function ttask_handler.continue_task(t : ttask_list) : Boolean;
|
||||
@ -369,18 +272,16 @@ begin
|
||||
{$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}
|
||||
{$IFNDEF DisableCTaskPPU}
|
||||
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}
|
||||
{$IFNDEF DisableCTaskPPU}
|
||||
ms_load: (m as tppumodule).continueloadppu;
|
||||
{$ENDIF}
|
||||
ms_compile :
|
||||
@ -403,9 +304,6 @@ begin
|
||||
else
|
||||
InternalError(2024011801);
|
||||
end;
|
||||
{$IFDEF EnableCTaskPPU}
|
||||
writeln('ttask_handler.continue AFTER ',m.modulename^,' ',m.state,' reload=',m.do_reload);
|
||||
{$ENDIF}
|
||||
|
||||
if (m.is_initial and not m.is_unit) and (list.Count>1) then
|
||||
// program must wait for all units to finish
|
||||
@ -434,7 +332,7 @@ begin
|
||||
rebuild_hash;
|
||||
end;
|
||||
|
||||
{$IFDEF EnableCTaskPPU}
|
||||
{$IFNDEF DisableCTaskPPU}
|
||||
function ttask_handler.check_cycle: boolean;
|
||||
var
|
||||
last: ttask_list;
|
||||
@ -449,7 +347,7 @@ var
|
||||
// mark module as searched
|
||||
m.cycle_search_stamp:=m.cycle_stamp;
|
||||
|
||||
uu:=tused_unit(m.used_units);
|
||||
uu:=tused_unit(m.used_units.First);
|
||||
while uu<>nil do
|
||||
begin
|
||||
pm:=tppumodule(uu.u);
|
||||
@ -471,7 +369,7 @@ var
|
||||
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);
|
||||
writeln('PPUALGO check_cycle last=',last.module.modulename^,' ',last.module.statestr,', RECOMPILE ',m.modulename^,' ',m.statestr);
|
||||
{$ENDIF}
|
||||
m.recompile_cycle;
|
||||
check_cycle:=true;
|
||||
@ -490,15 +388,17 @@ begin
|
||||
last:=nil;
|
||||
while t<>nil do
|
||||
begin
|
||||
{$IFDEF DEBUG_CTASK}
|
||||
writeln('PPUALGO check_cycle queued: ',t.module.modulename^,' ',t.module.statestr);
|
||||
{$ENDIF}
|
||||
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);
|
||||
Internalerror(2026021623);
|
||||
inc(tppumodule.cycle_stamp);
|
||||
Search(tppumodule(last.module));
|
||||
end;
|
||||
{$ENDIF}
|
||||
@ -541,7 +441,7 @@ begin
|
||||
m:=t.module;
|
||||
if (besttask<>nil) and (besttask.module.unit_index>m.unit_index) then
|
||||
// skip
|
||||
else if cancontinue(m,false,firstwaiting) then
|
||||
else if cancontinue(m,firstwaiting) then
|
||||
begin
|
||||
{$IFDEF DEBUG_CTASK}
|
||||
Writeln('CTASK: ',m.ToString,' state=',m.state,' unit_index=',m.unit_index);
|
||||
@ -554,7 +454,7 @@ begin
|
||||
t:=t.nexttask;
|
||||
end;
|
||||
|
||||
{$IFDEF EnableCTaskPPU}
|
||||
{$IFNDEF DisableCTaskPPU}
|
||||
if besttask=nil then
|
||||
if check_cycle then continue;
|
||||
{$ENDIF}
|
||||
|
||||
@ -55,7 +55,7 @@ interface
|
||||
type
|
||||
trecompile_reason = (rr_unknown,
|
||||
rr_noppu,rr_sourcenewer,rr_build,rr_crcchanged
|
||||
{$IFDEF EnableCTaskPPU}
|
||||
{$IFNDEF DisableCTaskPPU}
|
||||
,rr_buildcycle
|
||||
{$ENDIF}
|
||||
);
|
||||
@ -108,7 +108,7 @@ interface
|
||||
end;
|
||||
tderefmaparray = array of tderefmaprec;
|
||||
|
||||
{$IFDEF EnableCTaskPPU}
|
||||
{$IFNDEF DisableCTaskPPU}
|
||||
tqueue_module_event = procedure(m: tmodule) of object;
|
||||
{$ENDIF}
|
||||
|
||||
@ -122,7 +122,7 @@ interface
|
||||
in_interface : boolean;
|
||||
u : tmodule;
|
||||
unitsym : tunitsym;
|
||||
{$IFDEF EnableCTaskPPU}
|
||||
{$IFNDEF DisableCTaskPPU}
|
||||
dependent_added : boolean;
|
||||
{$ENDIF}
|
||||
constructor create(_u : tmodule;intface,inuses:boolean;usym:tunitsym);
|
||||
@ -143,7 +143,7 @@ interface
|
||||
public
|
||||
is_reset, { has reset been called ? }
|
||||
do_reload, { force reloading of the unit }
|
||||
{$IFDEF EnableCTaskPPU}
|
||||
{$IFNDEF DisableCTaskPPU}
|
||||
fromppu: boolean;
|
||||
{$ENDIF}
|
||||
sources_avail, { if all sources are reachable }
|
||||
@ -236,7 +236,9 @@ interface
|
||||
|
||||
moduleoptions: tmoduleoptions;
|
||||
deprecatedmsg: pshortstring;
|
||||
loadcount : integer; // EnableCTaskPPU: remove
|
||||
{$IFDEF DisableCTaskPPU}
|
||||
loadcount : integer;
|
||||
{$ENDIF}
|
||||
compilecount : integer;
|
||||
consume_semicolon_after_uses : Boolean;
|
||||
initfinalchecked : boolean;
|
||||
@ -294,7 +296,7 @@ interface
|
||||
procedure removedependency(callermodule:tmodule);
|
||||
function hasdependency(callermodule:tmodule): boolean;
|
||||
procedure flagdependent(callermodule:tmodule);
|
||||
{$IFDEF EnableCTaskPPU}
|
||||
{$IFNDEF DisableCTaskPPU}
|
||||
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;
|
||||
@ -538,15 +540,17 @@ implementation
|
||||
in_interface:=intface;
|
||||
in_uses:=inuses;
|
||||
unitsym:=usym;
|
||||
if _u.state in [ms_compiled_waitcrc,ms_compiled,ms_processed] then
|
||||
if _u.state in [ms_load,ms_compiled_waitcrc,ms_compiled,ms_processed] then
|
||||
checksum:=u.crc
|
||||
else
|
||||
checksum:=0;
|
||||
if _u.interface_compiled then
|
||||
begin
|
||||
checksum:=u.crc;
|
||||
interface_checksum:=u.interface_crc;
|
||||
indirect_checksum:=u.indirect_crc;
|
||||
end
|
||||
else
|
||||
begin
|
||||
checksum:=0;
|
||||
interface_checksum:=0;
|
||||
indirect_checksum:=0;
|
||||
end;
|
||||
@ -874,10 +878,11 @@ implementation
|
||||
m : tmodule;
|
||||
begin
|
||||
is_reset:=true;
|
||||
{$IFDEF EnableCTaskPPU}
|
||||
{$IFDEF DisableCTaskPPU}
|
||||
LoadCount:=0;
|
||||
{$ELSE}
|
||||
fromppu:=false;
|
||||
{$ENDIF}
|
||||
LoadCount:=0;
|
||||
if assigned(scanner) then
|
||||
begin
|
||||
{ also update current_scanner if it was pointing
|
||||
@ -1144,7 +1149,7 @@ implementation
|
||||
{$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}
|
||||
{$IFNDEF DisableCTaskPPU}
|
||||
if not m.do_reload and is_reload_needed(dm) then
|
||||
begin
|
||||
m.do_reload:=true;
|
||||
@ -1183,7 +1188,7 @@ implementation
|
||||
Result:='do_reload,'+Result;
|
||||
end;
|
||||
|
||||
{$IFDEF EnableCTaskPPU}
|
||||
{$IFNDEF DisableCTaskPPU}
|
||||
procedure tmodule.disconnect_depending_modules;
|
||||
var
|
||||
uu: tused_unit;
|
||||
@ -1203,7 +1208,7 @@ implementation
|
||||
or (du.in_interface and du.u.interface_compiled);
|
||||
// Note: see also the override in fppu.tppumodule
|
||||
end;
|
||||
{$ENDIF EnableCTaskPPU}
|
||||
{$ENDIF}
|
||||
|
||||
procedure tmodule.addimportedsym(sym:TSymEntry);
|
||||
begin
|
||||
@ -1221,7 +1226,7 @@ implementation
|
||||
end;
|
||||
|
||||
function tmodule.usedunitsloaded(interface_units : boolean; out firstwaiting : tmodule): boolean;
|
||||
{$IFDEF EnableCTaskPPU}
|
||||
{$IFNDEF DisableCTaskPPU}
|
||||
var
|
||||
uu: tused_unit;
|
||||
ok: Boolean;
|
||||
@ -1232,9 +1237,9 @@ implementation
|
||||
while assigned(uu) do
|
||||
begin
|
||||
ok:=uu.u.interface_compiled and not uu.u.do_reload;
|
||||
{ $IFDEF DEBUG_CTASK_VERBOSE}
|
||||
{$IFDEF DEBUG_CTASK_VERBOSE}
|
||||
writeln(' ',ToString,' checking state of ', uu.u.ToString,' : ',uu.u.statestr,' : ',ok);
|
||||
{ $ENDIF}
|
||||
{$ENDIF}
|
||||
if not ok then
|
||||
begin
|
||||
Result:=false;
|
||||
|
||||
@ -52,13 +52,13 @@ interface
|
||||
sourcefn : TPathStr; { Source specified with "uses .. in '..'" }
|
||||
comments : TCmdStrList;
|
||||
nsprefix : TCmdStr; { Namespace prefix the unit was found with }
|
||||
{$ifdef EnableCTaskPPU}
|
||||
{$IFNDEF DisableCTaskPPU}
|
||||
loadedfrommodule: tmodule;
|
||||
ppu_waitingfor_crc: boolean;
|
||||
class var cycle_stamp: dword;
|
||||
var
|
||||
cycle_search_stamp: dword;
|
||||
{$endif}
|
||||
{$endif}
|
||||
{$ifdef Test_Double_checksum}
|
||||
interface_read_crc_index,
|
||||
interface_write_crc_index,
|
||||
@ -80,19 +80,23 @@ interface
|
||||
procedure getppucrc;
|
||||
procedure writeppu;
|
||||
function loadppu(from_module : tmodule) : boolean;
|
||||
{$ifdef EnableCTaskPPU}
|
||||
{$IFNDEF DisableCTaskPPU}
|
||||
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}
|
||||
{$endif}
|
||||
procedure post_load_or_compile(from_module : tmodule; second_time: boolean);
|
||||
procedure discardppu;
|
||||
function needrecompile:boolean; // EnableCTaskPPU: remove
|
||||
{$IFDEF DisableCTaskPPU}
|
||||
function needrecompile:boolean;
|
||||
{$ENDIF}
|
||||
procedure setdefgeneration;
|
||||
procedure reload_flagged_units; // EnableCTaskPPU: remove
|
||||
{$IFDEF DisableCTaskPPU}
|
||||
procedure reload_flagged_units;
|
||||
{$ENDIF}
|
||||
procedure end_of_parsing;override;
|
||||
private
|
||||
unitimportsymsderefs : tfplist;
|
||||
@ -106,7 +110,9 @@ 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); // EnableCTaskPPU: remove
|
||||
{$IFDEF DisableCTaskPPU}
|
||||
procedure prepare_second_load(from_module: tmodule);
|
||||
{$ENDIF}
|
||||
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;
|
||||
@ -114,16 +120,18 @@ interface
|
||||
procedure load_interface;
|
||||
procedure load_implementation;
|
||||
function load_usedunits: boolean;
|
||||
{$ifdef EnableCTaskPPU}
|
||||
{$IFNDEF DisableCTaskPPU}
|
||||
function load_usedunits_section: boolean;
|
||||
function ppu_check_used_crcs: boolean;
|
||||
{$endif}
|
||||
{$endif}
|
||||
procedure printcomments;
|
||||
procedure queuecomment(const s:TMsgStr;v,w:longint);
|
||||
procedure buildderefunitimportsyms;
|
||||
procedure derefunitimportsyms;
|
||||
procedure freederefunitimportsyms;
|
||||
procedure try_load_ppufile(from_module: tmodule); // EnableCTaskPPU: remove
|
||||
{$IFDEF DisableCTaskPPU}
|
||||
procedure try_load_ppufile(from_module: tmodule);
|
||||
{$ENDIF}
|
||||
procedure writesourcefiles;
|
||||
procedure writeusedunit(intf:boolean);
|
||||
procedure writelinkcontainer(var p:tlinkcontainer;id:byte;strippath:boolean);
|
||||
@ -204,7 +212,7 @@ var
|
||||
function tppumodule.statestr: string;
|
||||
begin
|
||||
Result:=inherited statestr;
|
||||
{$IFDEF EnableCTaskPPU}
|
||||
{$IFNDEF DisableCTaskPPU}
|
||||
if state<>ms_load then exit;
|
||||
if ppu_waitingfor_crc then
|
||||
Result:=Result+',waitcrc'
|
||||
@ -217,7 +225,7 @@ var
|
||||
|
||||
procedure tppumodule.reset(for_recompile : boolean);
|
||||
begin
|
||||
{$IFDEF EnableCTaskPPU}
|
||||
{$IFNDEF DisableCTaskPPU}
|
||||
loadedfrommodule:=nil;
|
||||
ppu_waitingfor_crc:=false;
|
||||
{$ENDIF}
|
||||
@ -252,7 +260,7 @@ var
|
||||
tunitwpoinfo(wpoinfo).derefimpl;
|
||||
end;
|
||||
|
||||
{$IFDEF EnableCTaskPPU}
|
||||
{$IFNDEF DisableCTaskPPU}
|
||||
{ all dependent units were already flagged recursively for reload }
|
||||
defsgeneration:=currentdefgeneration;
|
||||
{$ELSE}
|
||||
@ -828,7 +836,7 @@ var
|
||||
|
||||
{ now load the unit and all used units }
|
||||
load_interface;
|
||||
{$IFDEF EnableCTaskPPU}
|
||||
{$IFNDEF DisableCTaskPPU}
|
||||
if not load_usedunits then
|
||||
internalerror(2026020415);
|
||||
{$ELSE}
|
||||
@ -1417,9 +1425,11 @@ var
|
||||
hp:=registerunit(self,hs,'',isnew);
|
||||
if isnew then
|
||||
usedunits.Concat(tused_unit.create(hp,in_interface,true,nil));
|
||||
{$IFDEF DisableCTaskPPU}
|
||||
if LoadCount=1 then
|
||||
pu:=addusedunit(hp,false,nil)
|
||||
else
|
||||
{$ENDIF}
|
||||
begin
|
||||
pu:=findusedunit(hp);
|
||||
{ Safety, normally this should not happen:
|
||||
@ -1890,9 +1900,22 @@ var
|
||||
|
||||
{ flush to be sure }
|
||||
ppufile.flush;
|
||||
|
||||
{ save crc in current module also }
|
||||
if not crc_final then
|
||||
begin
|
||||
crc_final:=true;
|
||||
crc:=ppufile.crc;
|
||||
end;
|
||||
{$IFDEF Debug_WaitCRC}
|
||||
writeln('tppumodule.writeppu ',realmodulename^,' crc=',hexstr(crc,8));
|
||||
{$ENDIF}
|
||||
|
||||
{ create and write header }
|
||||
{ Note: the interface_crc and indirect_crc were computed in getppucrc
|
||||
after the interface was compiled. The implementation must *not* effect them. }
|
||||
ppufile.header.common.size:=ppufile.size;
|
||||
ppufile.header.checksum:=ppufile.crc;
|
||||
ppufile.header.checksum:=crc;
|
||||
ppufile.header.interface_checksum:=interface_crc;
|
||||
ppufile.header.indirect_checksum:=indirect_crc;
|
||||
ppufile.header.common.compiler:=wordversion;
|
||||
@ -1903,16 +1926,6 @@ var
|
||||
ppufile.header.symlistsize:=current_module.symlist.count;
|
||||
ppufile.writeheader;
|
||||
|
||||
{ save crc in current module also }
|
||||
crc_final:=true;
|
||||
crc:=ppufile.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}
|
||||
|
||||
{$ifdef Test_Double_checksum_write}
|
||||
Writeln(ppufile.CRCFile,'End of implementation CRC in writeppu method of ',ppufilename,
|
||||
' implementation_crc=$',hexstr(ppufile.crc,8),
|
||||
@ -1999,7 +2012,7 @@ var
|
||||
crc:=ppufile.crc;
|
||||
if in_interface then
|
||||
begin
|
||||
// Note: the interface_crc is not affected by the implementation
|
||||
// Note: the interface_crc and indirect_crc are not affected by the implementation
|
||||
interface_crc:=ppufile.interface_crc;
|
||||
indirect_crc:=ppufile.indirect_crc;
|
||||
end;
|
||||
@ -2060,7 +2073,7 @@ var
|
||||
begin
|
||||
{ load the used units from interface }
|
||||
in_interface:=true;
|
||||
{$IFDEF EnableCTaskPPU}
|
||||
{$IFNDEF DisableCTaskPPU}
|
||||
if not load_usedunits_section then
|
||||
exit(false); // e.g. fail or some used unit interface is not ready
|
||||
{$ELSE}
|
||||
@ -2130,7 +2143,7 @@ var
|
||||
end;
|
||||
|
||||
{ now only read the implementation uses }
|
||||
{$IFDEF EnableCTaskPPU}
|
||||
{$IFNDEF DisableCTaskPPU}
|
||||
if not ppu_waitingfor_crc then
|
||||
begin
|
||||
if not load_usedunits_section then
|
||||
@ -2171,7 +2184,7 @@ var
|
||||
end;
|
||||
{$ENDIF}
|
||||
|
||||
{$IFDEF EnableCTaskPPU}
|
||||
{$IFNDEF DisableCTaskPPU}
|
||||
if not ppu_waitingfor_crc then
|
||||
{$ENDIF}
|
||||
begin
|
||||
@ -2198,7 +2211,7 @@ var
|
||||
tunitwpoinfo(wpoinfo).derefimpl;
|
||||
end;
|
||||
|
||||
{$IFDEF EnableCTaskPPU}
|
||||
{$IFNDEF DisableCTaskPPU}
|
||||
// check CRCs
|
||||
ppu_waitingfor_crc:=true;
|
||||
if not ppu_check_used_crcs then exit;
|
||||
@ -2207,7 +2220,7 @@ var
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
{$IFDEF EnableCTaskPPU}
|
||||
{$IFNDEF DisableCTaskPPU}
|
||||
function tppumodule.load_usedunits_section: boolean;
|
||||
var
|
||||
pu: tused_unit;
|
||||
@ -2245,8 +2258,8 @@ var
|
||||
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_waitcrc,ms_compiled,ms_processed]);
|
||||
IntfCRCValid:=CRCValid {or (pu.u.state in [ms_compiling_waitimpl,ms_compiling_waitfinish,ms_compiled_waitcrc])};
|
||||
CRCValid:=(not pu.u.do_reload) and pu.u.crc_final;
|
||||
IntfCRCValid:=(not pu.u.do_reload) and pu.u.interface_compiled;
|
||||
|
||||
if (IntfCRCValid and
|
||||
((pu.u.interface_crc<>pu.interface_checksum) or
|
||||
@ -2273,10 +2286,14 @@ var
|
||||
exit(false);
|
||||
end;
|
||||
|
||||
if (not CRCValid) or (not pu.u.interface_compiled) then
|
||||
if pu.u.do_reload
|
||||
or (not pu.u.interface_compiled)
|
||||
or ((state=ms_load)
|
||||
and not (mf_release in moduleflags)
|
||||
and not pu.u.crc_final) then
|
||||
begin
|
||||
// an used unit is delayed
|
||||
// Important: load the rest of the uses section
|
||||
// Important: do not break, load the remaining 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}
|
||||
@ -2350,6 +2367,8 @@ var
|
||||
|
||||
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
|
||||
@ -2384,8 +2403,9 @@ var
|
||||
set_current_module(from_module);
|
||||
end;
|
||||
|
||||
{$ENDIF EnableCTaskPPU}
|
||||
{$ENDIF}
|
||||
|
||||
{$IFDEF DisableCTaskPPU}
|
||||
function tppumodule.needrecompile:boolean;
|
||||
var
|
||||
pu : tused_unit;
|
||||
@ -2419,7 +2439,7 @@ var
|
||||
pu:=tused_unit(pu.next);
|
||||
end;
|
||||
end;
|
||||
|
||||
{$ENDIF}
|
||||
|
||||
procedure tppumodule.setdefgeneration;
|
||||
begin
|
||||
@ -2427,7 +2447,7 @@ var
|
||||
inc(currentdefgeneration);
|
||||
end;
|
||||
|
||||
|
||||
{$IFDEF DisableCTaskPPU}
|
||||
procedure tppumodule.reload_flagged_units;
|
||||
var
|
||||
hp : tppumodule;
|
||||
@ -2447,6 +2467,7 @@ var
|
||||
hp:=tppumodule(hp.next);
|
||||
end;
|
||||
end;
|
||||
{$ENDIF}
|
||||
|
||||
procedure tppumodule.end_of_parsing;
|
||||
begin
|
||||
@ -2470,8 +2491,7 @@ var
|
||||
{ When the unit is already loaded or being loaded
|
||||
we can maybe skip a complete reload/recompile }
|
||||
if assigned(globalsymtable)
|
||||
{$IFDEF EnableCTaskPPU}
|
||||
{$ELSE}
|
||||
{$IFDEF DisableCTaskPPU}
|
||||
and (not needrecompile)
|
||||
{$ENDIF}
|
||||
then
|
||||
@ -2510,7 +2530,8 @@ var
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure tppumodule.prepare_second_load(from_module: tmodule);
|
||||
{$IFDEF DisableCTaskPPU}
|
||||
procedure tppumodule.prepare_second_load(from_module: tmodule);
|
||||
|
||||
const
|
||||
CompileStates = [ms_compile, ms_compiling_wait,
|
||||
@ -2536,7 +2557,9 @@ var
|
||||
else
|
||||
state:=ms_load;
|
||||
end;
|
||||
{$ENDIF}
|
||||
|
||||
{$IFDEF DisableCTaskPPU}
|
||||
procedure tppumodule.try_load_ppufile(from_module : tmodule);
|
||||
|
||||
begin
|
||||
@ -2568,6 +2591,7 @@ var
|
||||
if assigned(ppufile) then
|
||||
discardppu;
|
||||
end;
|
||||
{$ENDIF}
|
||||
|
||||
procedure tppumodule.recompile_from_sources(from_module : tmodule);
|
||||
|
||||
@ -2611,7 +2635,7 @@ var
|
||||
{$ENDIF}
|
||||
{ Flag modules to reload }
|
||||
flagdependent(from_module);
|
||||
{$IFDEF EnableCTaskPPU}
|
||||
{$IFNDEF DisableCTaskPPU}
|
||||
was_interfaced_compiled:=interface_compiled;
|
||||
{ disconnect dependending modules }
|
||||
disconnect_depending_modules;
|
||||
@ -2620,7 +2644,7 @@ var
|
||||
reset(true);
|
||||
{ mark this module for recompilation }
|
||||
state:=ms_compile;
|
||||
{$IFDEF EnableCTaskPPU}
|
||||
{$IFNDEF DisableCTaskPPU}
|
||||
if was_interfaced_compiled then
|
||||
setdefgeneration;
|
||||
queue_module(Self); // queue after reset, so task state is cleared!
|
||||
@ -2638,8 +2662,7 @@ var
|
||||
if in_interface then
|
||||
internalerror(200212283);
|
||||
|
||||
{$IFDEF EnableCTaskPPU}
|
||||
{$ELSE}
|
||||
{$IFDEF DisableCTaskPPU}
|
||||
{ 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
|
||||
@ -2658,11 +2681,13 @@ var
|
||||
function tppumodule.loadppu(from_module : tmodule) : boolean;
|
||||
const
|
||||
ImplIntf : array[boolean] of string[15]=('implementation','interface');
|
||||
{$IFDEF EnableCTaskPPU}
|
||||
{$IFNDEF DisableCTaskPPU}
|
||||
begin
|
||||
Result:=false;
|
||||
|
||||
{$IFDEF DEBUG_PPU_CYCLES}
|
||||
writeln('PPUALGO tppumodule.loadppu START ',modulename^,' (',statestr,') used by "',from_module.modulename^,'" (',from_module.statestr,')');
|
||||
{$ENDIF}
|
||||
|
||||
Message3(unit_u_load_unit,from_module.modulename^,
|
||||
ImplIntf[from_module.in_interface],
|
||||
@ -2814,7 +2839,7 @@ var
|
||||
end;
|
||||
{$ENDIF}
|
||||
|
||||
{$ifdef EnableCTaskPPU}
|
||||
{$IFNDEF DisableCTaskPPU}
|
||||
function tppumodule.continueloadppu: boolean;
|
||||
var
|
||||
old_module: tmodule;
|
||||
|
||||
@ -219,7 +219,7 @@ implementation
|
||||
begin
|
||||
{ add to used units }
|
||||
uu:=curr.addusedunit(hp,false,unitsym);
|
||||
{$IFDEF EnableCTaskPPU}
|
||||
{$IFNDEF DisableCTaskPPU}
|
||||
uu.dependent_added:=true;
|
||||
{$ENDIF}
|
||||
end;
|
||||
@ -736,7 +736,7 @@ implementation
|
||||
if pu.in_uses and
|
||||
(pu.in_interface=frominterface) then
|
||||
begin
|
||||
{$IFDEF EnableCTaskPPU}
|
||||
{$IFNDEF DisableCTaskPPU}
|
||||
// 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
|
||||
@ -1327,14 +1327,18 @@ type
|
||||
{$IFDEF Debug_WaitCRC}
|
||||
writeln('parse_unit_interface_declarations ',curr.realmodulename^);
|
||||
{$ENDIF}
|
||||
{$IFDEF DisableCTaskPPU}
|
||||
if not(cs_compilesystem in current_settings.moduleswitches) and
|
||||
(Errorcount=0) then
|
||||
tppumodule(curr).getppucrc;
|
||||
{$ELSE}
|
||||
if Errorcount=0 then
|
||||
tppumodule(curr).getppucrc;
|
||||
{$ENDIF}
|
||||
curr.in_interface:=false;
|
||||
curr.interface_compiled:=true;
|
||||
|
||||
{$IFDEF EnableCTaskPPU}
|
||||
{$ELSE}
|
||||
{$IFDEF DisableCTaskPPU}
|
||||
{ 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;
|
||||
@ -1799,9 +1803,8 @@ type
|
||||
if not module.usedunitsfinalcrc(waitingmodule) then
|
||||
begin
|
||||
{ Some used units are still compiling, so their CRCs can change.
|
||||
Compute the final CRC of this module, for the case of a
|
||||
circular dependency, and wait.
|
||||
}
|
||||
Compute the final CRC of this module and wait.
|
||||
Needed for compiling circular dependent units. }
|
||||
{$IF defined(Debug_WaitCRC) or defined(Debug_FreeParseMem)}
|
||||
writeln('finish_compile_unit ',module.realmodulename^,' waiting for used unit CRCs...');
|
||||
{$ENDIF}
|
||||
@ -3047,7 +3050,7 @@ type
|
||||
else
|
||||
curr.consume_semicolon_after_uses:=false;
|
||||
|
||||
{$IFDEF EnableCTaskPPU}
|
||||
{$IFNDEF DisableCTaskPPU}
|
||||
if curr.is_initial then
|
||||
load_ok:=false; // delay program, so ctask can finish all units
|
||||
if not load_ok then
|
||||
|
||||
@ -297,13 +297,8 @@ 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;
|
||||
@ -401,15 +396,10 @@ 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;
|
||||
@ -433,13 +423,8 @@ 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;
|
||||
@ -517,12 +502,7 @@ begin
|
||||
|
||||
Step:='Second compile';
|
||||
Compile;
|
||||
{$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;
|
||||
@ -540,13 +520,8 @@ 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;
|
||||
@ -636,18 +611,9 @@ begin
|
||||
Step:='Second compile';
|
||||
UnitPath:=Dir+';'+Dir+PathDelim+'src2';
|
||||
Compile;
|
||||
{$IFDEF EnableCTaskPPU}
|
||||
// the main src is always compiled, cat intf class TCat changed, so bird and ant are recompiled
|
||||
CheckCompiled(['ancestorchange1_ant.pas','ancestorchange1_bird.pas','ancestorchange1_cat.pas',
|
||||
'ancestorchange1_eagle.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(['ancestorchange1_ant.pas','ancestorchange1_bird.pas','ancestorchange1_cat.pas',
|
||||
'ancestorchange1_eagle.pas']);
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
procedure TTestRecompile.TestGeneric_IndirectUses;
|
||||
@ -672,16 +638,8 @@ 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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user