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

* Pass loaded from

Browse Source
This commit is contained in:
Michaël Van Canneyt 2024-01-31 13:52:15 +01:00 committed by Michael Van Canneyt
parent 3ce07ef6fa
commit a81715d6ea
1 changed files with 17 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

36
compiler/fppu.pas
View File

@ -68,7 +68,7 @@ interface
function openppustream(strm:TCStream):boolean; function openppustream(strm:TCStream):boolean;
procedure getppucrc; procedure getppucrc;
procedure writeppu; procedure writeppu;
procedure loadppu; procedure loadppu(from_module : tmodule);
procedure discardppu; procedure discardppu;
function needrecompile:boolean; function needrecompile:boolean;
procedure setdefgeneration; procedure setdefgeneration;
@ -1894,7 +1894,7 @@ var
begin begin
if pu.in_interface then if pu.in_interface then
begin begin
tppumodule(pu.u).loadppu; tppumodule(pu.u).loadppu(self);
{ if this unit is compiled we can stop } { if this unit is compiled we can stop }
if state=ms_compiled then if state=ms_compiled then
exit; exit;
@ -1926,7 +1926,6 @@ var
end; end;
pu:=tused_unit(pu.next); pu:=tused_unit(pu.next);
end; end;
{ ok, now load the interface of this unit } { ok, now load the interface of this unit }
if current_module<>self then if current_module<>self then
internalerror(200208187); internalerror(200208187);
@ -1956,7 +1955,7 @@ var
begin begin
if (not pu.in_interface) then if (not pu.in_interface) then
begin begin
tppumodule(pu.u).loadppu; tppumodule(pu.u).loadppu(self);
{ if this unit is compiled we can stop } { if this unit is compiled we can stop }
if state=ms_compiled then if state=ms_compiled then
exit; exit;
@ -2058,7 +2057,7 @@ var
(hp.defsgeneration<defsgeneration) then (hp.defsgeneration<defsgeneration) then
begin begin
hp.defsgeneration:=defsgeneration; hp.defsgeneration:=defsgeneration;
hp.loadppu hp.loadppu(self)
end end
else else
hp.do_reload:=false; hp.do_reload:=false;
@ -2078,22 +2077,20 @@ var
end; end;
procedure tppumodule.loadppu; procedure tppumodule.loadppu(from_module : tmodule);
const const
ImplIntf : array[boolean] of string[15]=('implementation','interface'); ImplIntf : array[boolean] of string[15]=('implementation','interface');
var var
do_load, do_load,
second_time : boolean; second_time : boolean;
old_current_module : tmodule;
pu : tused_unit; pu : tused_unit;
begin begin
old_current_module:=current_module; Message3(unit_u_load_unit,from_module.modulename^,
Message3(unit_u_load_unit,old_current_module.modulename^, ImplIntf[from_module.in_interface],
ImplIntf[old_current_module.in_interface],
modulename^); modulename^);
{ Update loaded_from to detect cycles } { Update loaded_from to detect cycles }
loaded_from:=old_current_module; loaded_from:=from_module ;
{ check if the globalsymtable is already available, but { check if the globalsymtable is already available, but
we must reload when the do_reload flag is set } we must reload when the do_reload flag is set }
@ -2162,7 +2159,7 @@ var
must also be re-resolved, because they will also contain must also be re-resolved, because they will also contain
pointers to procdefs in the old trgobj (in case of a pointers to procdefs in the old trgobj (in case of a
recompile, all old defs are freed) } recompile, all old defs are freed) }
flagdependent(old_current_module); flagdependent(from_module);
reload_flagged_units; reload_flagged_units;
end end
else else
@ -2182,7 +2179,7 @@ var
Message1(unit_u_second_load_unit,modulename^); Message1(unit_u_second_load_unit,modulename^);
Message2(unit_u_previous_state,modulename^,ModuleStateStr[state]); Message2(unit_u_previous_state,modulename^,ModuleStateStr[state]);
{ Flag modules to reload } { Flag modules to reload }
flagdependent(old_current_module); flagdependent(from_module);
{ Reset the module } { Reset the module }
reset; reset;
if state in [ms_compile,ms_second_compile] then if state in [ms_compile,ms_second_compile] then
@ -2240,7 +2237,7 @@ var
printcomments; printcomments;
if recompile_reason=rr_noppu then if recompile_reason=rr_noppu then
begin begin
pu:=tused_unit(loaded_from.used_units.first); pu:=tused_unit(from_module.used_units.first);
while assigned(pu) do while assigned(pu) do
begin begin
if pu.u=self then if pu.u=self then
@ -2248,9 +2245,9 @@ var
pu:=tused_unit(pu.next); pu:=tused_unit(pu.next);
end; end;
if assigned(pu) and assigned(pu.unitsym) then if assigned(pu) and assigned(pu.unitsym) then
MessagePos2(pu.unitsym.fileinfo,unit_f_cant_find_ppu,realmodulename^,loaded_from.realmodulename^) MessagePos2(pu.unitsym.fileinfo,unit_f_cant_find_ppu,realmodulename^,from_module.realmodulename^)
else else
Message2(unit_f_cant_find_ppu,realmodulename^,loaded_from.realmodulename^); Message2(unit_f_cant_find_ppu,realmodulename^,from_module.realmodulename^);
end end
else else
Message1(unit_f_cant_compile_unit,realmodulename^); Message1(unit_f_cant_compile_unit,realmodulename^);
@ -2263,13 +2260,13 @@ var
comments:=nil; comments:=nil;
end; end;
{ Flag modules to reload } { Flag modules to reload }
flagdependent(old_current_module); flagdependent(from_module);
{ Reset the module } { Reset the module }
reset; reset;
{ compile this module } { compile this module }
if not(state in [ms_compile,ms_second_compile]) then if not(state in [ms_compile,ms_second_compile]) then
state:=ms_compile; state:=ms_compile;
compile(mainsource); compile_module(self);
setdefgeneration; setdefgeneration;
end end
else else
@ -2297,7 +2294,8 @@ var
end; end;
{ we are back, restore current_module } { we are back, restore current_module }
set_current_module(old_current_module);
set_current_module(from_module);
end; end;
procedure tppumodule.discardppu; procedure tppumodule.discardppu;