paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-24 07:04:02 +02:00
Code Issues Packages Projects Releases Wiki Activity

* remove do_compile, clearer flow when loading ppu/pas files

Browse Source
This commit is contained in:
Michaël Van Canneyt 2024-05-04 16:58:04 +02:00
parent 3302dae600
commit a888a141a2
2 changed files with 98 additions and 73 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
compiler/fmodule.pas
View File

@ -113,7 +113,6 @@ interface
public public
is_reset, { has reset been called ? } is_reset, { has reset been called ? }
do_reload, { force reloading of the unit } do_reload, { force reloading of the unit }
do_compile, { need to compile the sources }
sources_avail, { if all sources are reachable } sources_avail, { if all sources are reachable }
interface_compiled, { if the interface section has been parsed/compiled/loaded } interface_compiled, { if the interface section has been parsed/compiled/loaded }
is_dbginfo_written, is_dbginfo_written,
@ -647,7 +646,6 @@ implementation
globalmacrosymtable:=nil; globalmacrosymtable:=nil;
localmacrosymtable:=nil; localmacrosymtable:=nil;
do_reload:=false; do_reload:=false;
do_compile:=false;
sources_avail:=true; sources_avail:=true;
mainfilepos.line:=0; mainfilepos.line:=0;
mainfilepos.column:=0; mainfilepos.column:=0;
@ -794,6 +792,7 @@ implementation
var var
i : longint; i : longint;
current_debuginfo_reset : boolean; current_debuginfo_reset : boolean;
m : tmodule;
begin begin
is_reset:=true; is_reset:=true;
if assigned(scanner) then if assigned(scanner) then
@ -906,7 +905,17 @@ implementation
pendingspecializations:=tfphashobjectlist.create(false); pendingspecializations:=tfphashobjectlist.create(false);
if assigned(waitingforunit) and if assigned(waitingforunit) and
(waitingforunit.count<>0) then (waitingforunit.count<>0) then
internalerror(2016070501); begin
Write(Self.modulename^, ' is reset while still waiting for units: ');
for I:=0 to waitingforunit.Count-1 do
begin
M:=tmodule(waitingforunit.Items[i]);
write(m.modulename^,' (state:',M.state,') ');
end;
Writeln;
internalerror(2016070501);
end;
waitingforunit.free; waitingforunit.free;
waitingforunit:=tfpobjectlist.create(false); waitingforunit:=tfpobjectlist.create(false);
linkunitofiles.Free; linkunitofiles.Free;
@ -926,7 +935,6 @@ implementation
stringdispose(mainname); stringdispose(mainname);
FImportLibraryList.Free; FImportLibraryList.Free;
FImportLibraryList:=TFPHashObjectList.Create; FImportLibraryList:=TFPHashObjectList.Create;
do_compile:=false;
do_reload:=false; do_reload:=false;
interface_compiled:=false; interface_compiled:=false;
in_interface:=true; in_interface:=true;
@ -1002,6 +1010,8 @@ implementation
procedure tmodule.flagdependent(callermodule:tmodule); procedure tmodule.flagdependent(callermodule:tmodule);
var var
pm : tdependent_unit; pm : tdependent_unit;
m : tmodule;
begin begin
{ flag all units that depend on this unit for reloading } { flag all units that depend on this unit for reloading }
pm:=tdependent_unit(current_module.dependent_units.first); pm:=tdependent_unit(current_module.dependent_units.first);
@ -1010,16 +1020,16 @@ implementation
{ We do not have to reload the unit that wants to load { We do not have to reload the unit that wants to load
this unit, unless this unit is already compiled during this unit, unless this unit is already compiled during
the loading } the loading }
if (pm.u=callermodule) and m:=pm.u;
(pm.u.state<ms_compiled) then if (m=callermodule) and (m.state<ms_compiled) then
Message1(unit_u_no_reload_is_caller,pm.u.modulename^) Message1(unit_u_no_reload_is_caller,m.modulename^)
else else
if (pm.u.state=ms_compile) and (pm.u.compilecount>1) then if (m.state=ms_compile) {and (pm.u.compilecount>1)} then
Message1(unit_u_no_reload_in_second_compile,pm.u.modulename^) Message1(unit_u_no_reload_in_second_compile,m.modulename^)
else else
begin begin
pm.u.do_reload:=true; m.do_reload:=true;
Message1(unit_u_flag_for_reload,pm.u.modulename^); Message1(unit_u_flag_for_reload,m.modulename^);
end; end;
pm:=tdependent_unit(pm.next); pm:=tdependent_unit(pm.next);
end; end;

139
compiler/fppu.pas
View File

@ -44,6 +44,8 @@ interface
type type
{ tppumodule } { tppumodule }
TAvailableUnitFile = (auPPU,auSrc);
TAvailableUnitFiles = set of TAvailableUnitFile;
tppumodule = class(tmodule) tppumodule = class(tmodule)
ppufile : tcompilerppufile; { the PPU file } ppufile : tcompilerppufile; { the PPU file }
@ -90,8 +92,8 @@ interface
function openppu(ppufiletime:longint):boolean; function openppu(ppufiletime:longint):boolean;
procedure prepare_second_load(from_module: tmodule); procedure prepare_second_load(from_module: tmodule);
procedure recompile_from_sources(from_module: tmodule); procedure recompile_from_sources(from_module: tmodule);
function search_unit_files(loaded_from : tmodule; onlysource:boolean):boolean; function search_unit_files(loaded_from : tmodule; onlysource:boolean):TAvailableUnitFiles;
function search_unit(loaded_from : tmodule; onlysource,shortname:boolean):boolean; function search_unit(loaded_from : tmodule; onlysource,shortname:boolean):TAvailableUnitFiles;
function loadfrompackage:boolean; function loadfrompackage:boolean;
procedure load_interface; procedure load_interface;
procedure load_implementation; procedure load_implementation;
@ -438,28 +440,24 @@ var
Message1(unit_u_ppu_crc,hexstr(ppufile.header.indirect_checksum,8)+' (indc)'); Message1(unit_u_ppu_crc,hexstr(ppufile.header.indirect_checksum,8)+' (indc)');
Comment(V_used,'Number of definitions: '+tostr(ppufile.header.deflistsize)); Comment(V_used,'Number of definitions: '+tostr(ppufile.header.deflistsize));
Comment(V_used,'Number of symbols: '+tostr(ppufile.header.symlistsize)); Comment(V_used,'Number of symbols: '+tostr(ppufile.header.symlistsize));
do_compile:=false;
openppu:=true; openppu:=true;
end; end;
function tppumodule.search_unit_files(loaded_from : tmodule; onlysource:boolean):boolean; function tppumodule.search_unit_files(loaded_from : tmodule; onlysource:boolean):TAvailableUnitFiles;
var var
found : boolean; found : TAvailableUnitFiles;
begin begin
found:=false; found:=search_unit(loaded_from,onlysource,false);
if search_unit(loaded_from,onlysource,false) then if (found=[]) and
found:=true;
if (not found) and
(ft83 in AllowedFilenameTransFormations) and (ft83 in AllowedFilenameTransFormations) and
(length(modulename^)>8) and (length(modulename^)>8) then
search_unit(loaded_from,onlysource,true) then found:=search_unit(loaded_from,onlysource,true);
found:=true;
search_unit_files:=found; search_unit_files:=found;
end; end;
function tppumodule.search_unit(loaded_from : tmodule; onlysource,shortname:boolean):boolean; function tppumodule.search_unit(loaded_from : tmodule; onlysource,shortname:boolean):TAvailableUnitFiles;
var var
singlepathstring, singlepathstring,
filename : TCmdStr; filename : TCmdStr;
@ -512,7 +510,6 @@ var
singlepathstring:=FixPath(s,false); singlepathstring:=FixPath(s,false);
{ Check for Sources } { Check for Sources }
ppufile:=nil; ppufile:=nil;
do_compile:=true;
recompile_reason:=rr_noppu; recompile_reason:=rr_noppu;
{Check for .pp file} {Check for .pp file}
Found:=UnitExists(sourceext,hs,prefix); Found:=UnitExists(sourceext,hs,prefix);
@ -549,30 +546,32 @@ var
SourceSearchPath:=Found; SourceSearchPath:=Found;
end; end;
Function SearchPath(const s,prefix:TCmdStr):boolean; Function SearchPath(const s,prefix:TCmdStr):TAvailableUnitFiles;
var var
found : boolean; found : TAvailableUnitFiles;
begin begin
{ First check for a ppu, then for the source } { First check for a ppu, then for the source }
found:=false; found:=[];
if not onlysource then if not onlysource then
found:=PPUSearchPath(s,prefix); if PPUSearchPath(s,prefix) then
if not found then Include(found,auPPU);
found:=SourceSearchPath(s,prefix); if found=[] then
if SourceSearchPath(s,prefix) then
Include(found,auSrc);
SearchPath:=found; SearchPath:=found;
end; end;
Function SearchPathList(list:TSearchPathList;const prefix:TCmdStr):boolean; Function SearchPathList(list:TSearchPathList;const prefix:TCmdStr):TAvailableUnitFiles;
var var
hp : TCmdStrListItem; hp : TCmdStrListItem;
found : boolean; found : TAvailableUnitFiles;
begin begin
found:=false; found:=[];
hp:=TCmdStrListItem(list.First); hp:=TCmdStrListItem(list.First);
while assigned(hp) do while assigned(hp) do
begin begin
found:=SearchPath(hp.Str,prefix); found:=SearchPath(hp.Str,prefix);
if found then if found<>[] then
break; break;
hp:=TCmdStrListItem(hp.next); hp:=TCmdStrListItem(hp.next);
end; end;
@ -588,34 +587,38 @@ var
result:=PPUSearchPath(main_module.Path,prefix); result:=PPUSearchPath(main_module.Path,prefix);
end; end;
function SearchSourcePaths(const prefix:TCmdStr):boolean; function SearchSourcePaths(const prefix:TCmdStr):TAvailableUnitFiles;
begin begin
result:=SourceSearchPath('.',prefix); result:=[];
if (not result) and Assigned(main_module) and (main_module.Path<>'') then if SourceSearchPath('.',prefix) then
result:=SourceSearchPath(main_module.Path,prefix); include(Result,auSrc);
if (not result) and Assigned(loaded_from) then if (result=[]) and Assigned(main_module) and (main_module.Path<>'') then
if SourceSearchPath(main_module.Path,prefix) then
include(Result,auSrc);
if (result=[]) and Assigned(loaded_from) then
result:=SearchPathList(loaded_from.LocalUnitSearchPath,prefix); result:=SearchPathList(loaded_from.LocalUnitSearchPath,prefix);
if not result then if (result=[]) then
result:=SearchPathList(UnitSearchPath,prefix); result:=SearchPathList(UnitSearchPath,prefix);
end; end;
function SearchNamespaceList(const prefixes:TCmdStrList):boolean; function SearchNamespaceList(const prefixes:TCmdStrList): TAvailableUnitFiles;
var var
nsitem : TCmdStrListItem; nsitem : TCmdStrListItem;
res : Boolean; res : TAvailableUnitFiles;
begin begin
res:=false; res:=[];
nsitem:=TCmdStrListItem(prefixes.first); nsitem:=TCmdStrListItem(prefixes.first);
while assigned(nsitem) do while assigned(nsitem) do
begin begin
if not onlysource then if not onlysource then
begin begin
res:=SearchPPUPaths(nsitem.str); if SearchPPUPaths(nsitem.str) then
if res then Include(res,auPPU);
if res<>[] then
break; break;
end; end;
res:=SearchSourcePaths(nsitem.str); res:=SearchSourcePaths(nsitem.str);
if res then if res<>[] then
break; break;
nsitem:=TCmdStrListItem(nsitem.next); nsitem:=TCmdStrListItem(nsitem.next);
end; end;
@ -626,9 +629,10 @@ var
var var
fnd : boolean; fnd : TAvailableUnitFiles;
hs : TPathStr; hs : TPathStr;
begin begin
fnd:=[];
if shortname then if shortname then
filename:=FixFileName(Copy(realmodulename^,1,8)) filename:=FixFileName(Copy(realmodulename^,1,8))
else else
@ -644,46 +648,49 @@ var
8. global unit pathlist 8. global unit pathlist
9. for each default namespace: 9. for each default namespace:
repeat 1 - 3 and 5 - 8 with namespace as prefix } repeat 1 - 3 and 5 - 8 with namespace as prefix }
fnd:=false;
if not onlysource then if not onlysource then
fnd:=SearchPPUPaths(''); if SearchPPUPaths('') then
if (not fnd) and (sourcefn<>'') then include(fnd,auPPU);
if (fnd=[]) and (sourcefn<>'') then
begin begin
{ the full filename is specified so we can't use here the { the full filename is specified so we can't use here the
searchpath (PFV) } searchpath (PFV) }
if CheckVerbosity(V_Tried) then if CheckVerbosity(V_Tried) then
Message1(unit_t_unitsearch,ChangeFileExt(sourcefn,sourceext)); Message1(unit_t_unitsearch,ChangeFileExt(sourcefn,sourceext));
fnd:=FindFile(ChangeFileExt(sourcefn,sourceext),'',true,hs); if FindFile(ChangeFileExt(sourcefn,sourceext),'',true,hs) then
if not fnd then include(fnd,auSrc);
if (fnd=[]) then
begin begin
if CheckVerbosity(V_Tried) then if CheckVerbosity(V_Tried) then
Message1(unit_t_unitsearch,ChangeFileExt(sourcefn,pasext)); Message1(unit_t_unitsearch,ChangeFileExt(sourcefn,pasext));
fnd:=FindFile(ChangeFileExt(sourcefn,pasext),'',true,hs); if FindFile(ChangeFileExt(sourcefn,pasext),'',true,hs) then
include(fnd,auSrc);
end; end;
if not fnd and if (fnd=[]) and
((m_mac in current_settings.modeswitches) or ((m_mac in current_settings.modeswitches) or
(tf_p_ext_support in target_info.flags)) then (tf_p_ext_support in target_info.flags)) then
begin begin
if CheckVerbosity(V_Tried) then if CheckVerbosity(V_Tried) then
Message1(unit_t_unitsearch,ChangeFileExt(sourcefn,pext)); Message1(unit_t_unitsearch,ChangeFileExt(sourcefn,pext));
fnd:=FindFile(ChangeFileExt(sourcefn,pext),'',true,hs); if FindFile(ChangeFileExt(sourcefn,pext),'',true,hs) then
include(fnd,auSrc)
end; end;
if fnd then if [auSrc]=fnd then
begin begin
sources_avail:=true; sources_avail:=true;
do_compile:=true; state:=ms_compile;
recompile_reason:=rr_noppu; recompile_reason:=rr_noppu;
mainsource:=hs; mainsource:=hs;
SetFileName(hs,false); SetFileName(hs,false);
end; end;
end; end;
if not fnd then if fnd=[] then
begin begin
fnd:=SearchSourcePaths(''); fnd:=SearchSourcePaths('');
// current_namespacelist is set to the current module's namespacelist. // current_namespacelist is set to the current module's namespacelist.
if not fnd and assigned(current_namespacelist) and (current_namespacelist.count>0) then if (fnd=[]) and assigned(current_namespacelist) and (current_namespacelist.count>0) then
fnd:=SearchNameSpaceList(current_namespacelist); fnd:=SearchNameSpaceList(current_namespacelist);
if not fnd and (namespacelist.count>0) then if (fnd=[]) and (namespacelist.count>0) then
fnd:=SearchNameSpaceList(namespacelist); fnd:=SearchNameSpaceList(namespacelist);
end; end;
search_unit:=fnd; search_unit:=fnd;
@ -1256,7 +1263,7 @@ var
if (orgfiletime<>-1) and if (orgfiletime<>-1) and
(source_time<>orgfiletime) then (source_time<>orgfiletime) then
begin begin
do_compile:=true; state:=ms_compile;
recompile_reason:=rr_sourcenewer; recompile_reason:=rr_sourcenewer;
Message2(unit_u_source_modified,hs,ppufilename,@queuecomment); Message2(unit_u_source_modified,hs,ppufilename,@queuecomment);
temp:=temp+' *'; temp:=temp+' *';
@ -1292,7 +1299,7 @@ var
available } available }
if do_build and sources_avail then if do_build and sources_avail then
begin begin
do_compile:=true; state:=ms_compile;
recompile_reason:=rr_build; recompile_reason:=rr_build;
end; end;
end; end;
@ -1572,7 +1579,7 @@ var
Message1(unit_f_ppu_invalid_entry,tostr(b)); Message1(unit_f_ppu_invalid_entry,tostr(b));
end; end;
{ we can already stop when we know that we must recompile } { we can already stop when we know that we must recompile }
if do_compile then if state=ms_compile then
exit; exit;
until false; until false;
end; end;
@ -1969,7 +1976,7 @@ var
Comment(V_Normal,' implcrc change: '+hexstr(pu.u.crc,8)+' for '+pu.u.ppufilename+' <> '+hexstr(pu.checksum,8)+' in unit '+realmodulename^); 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} {$endif DEBUG_UNIT_CRC_CHANGES}
recompile_reason:=rr_crcchanged; recompile_reason:=rr_crcchanged;
do_compile:=true; state:=ms_compile;
exit; exit;
end; end;
end; end;
@ -2022,7 +2029,7 @@ var
Comment(V_Normal,' indcrc change (2): '+hexstr(pu.u.indirect_crc,8)+' for '+pu.u.ppufilename+' <> '+hexstr(pu.indirect_checksum,8)+' in unit '+realmodulename^); Comment(V_Normal,' indcrc change (2): '+hexstr(pu.u.indirect_crc,8)+' for '+pu.u.ppufilename+' <> '+hexstr(pu.indirect_checksum,8)+' in unit '+realmodulename^);
{$endif DEBUG_UNIT_CRC_CHANGES} {$endif DEBUG_UNIT_CRC_CHANGES}
recompile_reason:=rr_crcchanged; recompile_reason:=rr_crcchanged;
do_compile:=true; state:=ms_compile;
exit; exit;
end; end;
end; end;
@ -2192,7 +2199,6 @@ var
begin begin
Message1(unit_u_second_compile_unit,modulename^); Message1(unit_u_second_compile_unit,modulename^);
state:=ms_compile; state:=ms_compile;
do_compile:=true;
end end
else else
state:=ms_load; state:=ms_load;
@ -2202,15 +2208,18 @@ var
begin begin
Message1(unit_u_loading_unit,modulename^); Message1(unit_u_loading_unit,modulename^);
search_unit_files(from_module,false); if auPPU in search_unit_files(from_module,false) then
if not do_compile then state:=ms_load
else
state:=ms_compile;
if not (state=ms_compile) then
begin begin
load_interface; load_interface;
setdefgeneration; setdefgeneration;
if not do_compile then if not (state=ms_compile) then
begin begin
load_usedunits; load_usedunits;
if not do_compile then if not (state=ms_compile) then
Message1(unit_u_finished_loading_unit,modulename^); Message1(unit_u_finished_loading_unit,modulename^);
end; end;
end; end;
@ -2296,6 +2305,7 @@ var
second_time : boolean; second_time : boolean;
begin begin
Result:=false; Result:=false;
Message3(unit_u_load_unit,from_module.modulename^, Message3(unit_u_load_unit,from_module.modulename^,
ImplIntf[from_module.in_interface], ImplIntf[from_module.in_interface],
@ -2327,6 +2337,11 @@ var
{ loading the unit for a second time? } { loading the unit for a second time? }
if state=ms_registered then if state=ms_registered then
state:=ms_load state:=ms_load
else if (state in [ms_compile, ms_compiling_waitintf]) then
begin
{ no use continuing if we must be compiled }
exit(false)
end
else else
begin begin
second_time:=true; second_time:=true;
@ -2343,11 +2358,11 @@ var
{ try to opening ppu, skip this when we already { try to opening ppu, skip this when we already
know that we need to compile the unit } know that we need to compile the unit }
if not do_compile then if not (state=ms_compile) then
try_load_ppufile(from_module); try_load_ppufile(from_module);
{ Do we need to recompile the unit } { Do we need to recompile the unit }
if do_compile then if (state=ms_compile) then
recompile_from_sources(from_module) recompile_from_sources(from_module)
else else
state:=ms_compiled; state:=ms_compiled;