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

* re-resolving added instead of reloading from ppu

Browse Source 
* tderef object added to store deref info for resolving
This commit is contained in:
peter 2003-06-07 20:26:32 +00:00
parent e142cebe6e
commit e7975c7592
15 changed files with 802 additions and 507 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
compiler/fmodule.pas
View File

@ -83,6 +83,7 @@ interface
do_reload, { force reloading of the unit }
do_compile, { need to compile the sources }
sources_avail, { if all sources are reachable }
interface_compiled, { if the interface section has been parsed/compiled/loaded }
is_unit,
in_interface, { processing the implementation part? }
in_global : boolean; { allow global settings }
@ -372,7 +373,7 @@ uses
interface_crc:=0;
flags:=0;
scanner:=nil;
map:=nil;
new(map);
globalsymtable:=nil;
localsymtable:=nil;
loaded_from:=LoadedFrom;
@ -400,8 +401,7 @@ uses
{$endif}
hpi : tprocinfo;
begin
if assigned(map) then
dispose(map);
dispose(map);
if assigned(imports) then
imports.free;
if assigned(_exports) then
@ -509,11 +509,7 @@ uses
localsymtable.free;
localsymtable:=nil;
end;
if assigned(map) then
begin
dispose(map);
map:=nil;
end;
fillchar(map^,sizeof(tunitmap),#0);
sourcefiles.free;
sourcefiles:=tinputfilemanager.create;
librarydata.free;
@ -544,6 +540,7 @@ uses
linkothersharedlibs:=TLinkContainer.Create;
uses_imports:=false;
do_compile:=false;
interface_compiled:=false;
in_interface:=true;
in_global:=true;
crc:=0;
@ -625,12 +622,14 @@ uses
no globalsymtable }
if assigned(globalsymtable) then
globalsymtable.unitid:=0;
{ number units }
map^[0]:=self;
{ number units and map }
counter:=1;
hp:=tused_unit(used_units.first);
while assigned(hp) do
begin
tsymtable(hp.u.globalsymtable).unitid:=counter;
map^[counter]:=hp.u;
inc(counter);
hp:=tused_unit(hp.next);
end;
@ -651,7 +650,11 @@ uses
end.
{
$Log$
Revision 1.35 2003-05-25 10:27:12 peter
Revision 1.36 2003-06-07 20:26:32 peter
* re-resolving added instead of reloading from ppu
* tderef object added to store deref info for resolving
Revision 1.35 2003/05/25 10:27:12 peter
* moved Comment calls to messge file
Revision 1.34 2003/05/23 14:27:35 peter

301
compiler/fppu.pas
View File

@ -54,6 +54,7 @@ interface
procedure getppucrc;
procedure writeppu;
procedure loadppu;
function needrecompile:boolean;
private
function search_unit(onlysource,shortname:boolean):boolean;
procedure load_interface;
@ -1028,9 +1029,7 @@ uses
if current_module<>self then
internalerror(200212284);
load_refs:=true;
{ init the map }
new(map);
fillchar(map^,sizeof(tunitmap),#0);
{ Add current unit to the map }
map^[0]:=self;
nextmapentry:=1;
{ load the used units from interface }
@ -1058,8 +1057,6 @@ uses
Message2(unit_u_recompile_crc_change,realmodulename^,pu.u.realmodulename^);
recompile_reason:=rr_crcchanged;
do_compile:=true;
dispose(map);
map:=nil;
exit;
end;
{ setup the map entry for deref }
@ -1076,6 +1073,7 @@ uses
internalerror(200208187);
globalsymtable:=tglobalsymtable.create(modulename^);
tstoredsymtable(globalsymtable).ppuload(ppufile);
interface_compiled:=true;
{ now only read the implementation uses }
in_interface:=false;
@ -1096,8 +1094,6 @@ uses
Message2(unit_u_recompile_crc_change,realmodulename^,pu.u.realmodulename^+' {impl}');
recompile_reason:=rr_crcchanged;
do_compile:=true;
dispose(map);
map:=nil;
exit;
end;
{ setup the map entry for deref }
@ -1119,10 +1115,31 @@ uses
internalerror(200208188);
load_symtable_refs;
end;
end;
{ remove the map, it's not needed anymore }
dispose(map);
map:=nil;
function tppumodule.needrecompile:boolean;
var
pu : tused_unit;
begin
result:=false;
pu:=tused_unit(used_units.first);
while assigned(pu) do
begin
{ 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.in_interface) and
(pu.u.crc<>pu.checksum)
) then
begin
result:=true;
exit;
end;
pu:=tused_unit(pu.next);
end;
end;
@ -1130,6 +1147,7 @@ uses
const
ImplIntf : array[boolean] of string[15]=('implementation','interface');
var
do_load,
second_time : boolean;
hp,
old_current_module : tmodule;
@ -1138,154 +1156,189 @@ uses
Message3(unit_u_load_unit,old_current_module.modulename^,
ImplIntf[old_current_module.in_interface],
modulename^);
if modulename^='NCGUTIL' then
do_load:=do_load;
{ check if the globalsymtable is already available, but
we must reload when the do_reload flag is set }
if do_reload then
begin
Message(unit_u_forced_reload);
do_reload:=false;
end
else
begin
if assigned(globalsymtable) then
exit;
end;
if (not do_reload) and
assigned(globalsymtable) then
exit;
{ reset }
do_load:=true;
second_time:=false;
current_module:=self;
SetCompileModule(current_module);
Fillchar(aktfilepos,0,sizeof(aktfilepos));
{ we are loading a new module, save the state of the scanner
and reset scanner+module }
if assigned(current_scanner) then
current_scanner.tempcloseinputfile;
current_scanner:=nil;
{ loading the unit for a second time? }
if state=ms_registered then
state:=ms_load
else
{ A force reload }
if do_reload then
begin
{ try to load the unit a second time first }
Message1(unit_u_second_load_unit,modulename^);
Message2(unit_u_previous_state,modulename^,ModuleStateStr[state]);
{ Flag modules to reload }
flagdependent(old_current_module);
{ Reset the module }
reset;
if state=ms_compile then
Message(unit_u_forced_reload);
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
begin
Message1(unit_u_second_compile_unit,modulename^);
state:=ms_second_compile;
do_compile:=true;
end
else
state:=ms_second_load;
second_time:=true;
{ When we don't have any data stored yet there
is nothing to resolve }
if interface_compiled then
begin
Comment(V_Used,'Re-resolving unit');
aktglobalsymtable:=tstoredsymtable(globalsymtable);
tstoredsymtable(globalsymtable).deref;
tstoredsymtable(globalsymtable).derefimpl;
if assigned(localsymtable) then
begin
aktstaticsymtable:=tstoredsymtable(localsymtable);
tstoredsymtable(localsymtable).deref;
tstoredsymtable(localsymtable).derefimpl;
end;
end
else
Comment(V_Used,'Skipping re-resolving, still loading used units');
do_load:=false;
end;
end;
{ close old_current_ppu on system that are
short on file handles like DOS PM }
if do_load then
begin
{ we are loading a new module, save the state of the scanner
and reset scanner+module }
if assigned(current_scanner) then
current_scanner.tempcloseinputfile;
current_scanner:=nil;
{ loading the unit for a second time? }
if state=ms_registered then
state:=ms_load
else
begin
{ try to load the unit a second time first }
Message1(unit_u_second_load_unit,modulename^);
Message2(unit_u_previous_state,modulename^,ModuleStateStr[state]);
{ Flag modules to reload }
flagdependent(old_current_module);
{ Reset the module }
reset;
if state=ms_compile then
begin
Message1(unit_u_second_compile_unit,modulename^);
state:=ms_second_compile;
do_compile:=true;
end
else
state:=ms_second_load;
second_time:=true;
end;
{ close old_current_ppu on system that are
short on file handles like DOS PM }
{$ifdef SHORT_ON_FILE_HANDLES}
if old_current_module.is_unit and
assigned(tppumodule(old_current_module).ppufile) then
tppumodule(old_current_module).ppufile.tempclose;
if old_current_module.is_unit and
assigned(tppumodule(old_current_module).ppufile) then
tppumodule(old_current_module).ppufile.tempclose;
{$endif SHORT_ON_FILE_HANDLES}
{ try to opening ppu, skip this when we already
know that we need to compile the unit }
if not do_compile then
begin
Message1(unit_u_loading_unit,modulename^);
search_unit(false,false);
{ try to opening ppu, skip this when we already
know that we need to compile the unit }
if not do_compile then
begin
load_interface;
Message1(unit_u_loading_unit,modulename^);
search_unit(false,false);
if not do_compile then
begin
load_usedunits;
load_interface;
if not do_compile then
Message1(unit_u_finished_loading_unit,modulename^);
begin
load_usedunits;
if not do_compile then
Message1(unit_u_finished_loading_unit,modulename^);
end;
end;
{ PPU is not needed anymore }
if assigned(ppufile) then
begin
ppufile.closefile;
ppufile.free;
ppufile:=nil;
end;
end;
{ PPU is not needed anymore }
if assigned(ppufile) then
begin
ppufile.closefile;
ppufile.free;
ppufile:=nil;
end;
end;
{ Do we need to recompile the unit }
if do_compile then
begin
{ recompile the unit or give a fatal error if sources not available }
if not(sources_avail) then
{ Do we need to recompile the unit }
if do_compile then
begin
if (not search_unit(true,false)) and
(length(modulename^)>8) then
search_unit(true,true);
{ recompile the unit or give a fatal error if sources not available }
if not(sources_avail) then
begin
if recompile_reason=rr_noppu then
Message1(unit_f_cant_find_ppu,modulename^)
else
Message1(unit_f_cant_compile_unit,modulename^);
if (not search_unit(true,false)) and
(length(modulename^)>8) then
search_unit(true,true);
if not(sources_avail) then
begin
if recompile_reason=rr_noppu then
Message1(unit_f_cant_find_ppu,modulename^)
else
Message1(unit_f_cant_compile_unit,modulename^);
end;
end;
{ Flag modules to reload }
flagdependent(old_current_module);
{ Reset the module }
reset;
{ compile this module }
if not(state in [ms_compile,ms_second_compile]) then
state:=ms_compile;
compile(mainsource^);
end;
{ Flag modules to reload }
flagdependent(old_current_module);
{ Reset the module }
reset;
{ compile this module }
if not(state in [ms_compile,ms_second_compile]) then
state:=ms_compile;
compile(mainsource^);
end;
{ set compiled flag }
if current_module<>self then
internalerror(200212282);
state:=ms_compiled;
{ set compiled flag }
if current_module<>self then
internalerror(200212282);
state:=ms_compiled;
if in_interface then
internalerror(200212283);
if in_interface then
internalerror(200212283);
{ for a second_time recompile reload all dependent units,
for a first time compile register the unit _once_ }
if second_time then
begin
{ now reload all dependent units }
hp:=tmodule(loaded_units.first);
while assigned(hp) do
{ for a second_time recompile reload all dependent units,
for a first time compile register the unit _once_ }
if second_time then
begin
if hp.do_reload then
tppumodule(hp).loadppu;
hp:=tmodule(hp.next);
end;
end
else
usedunits.concat(tused_unit.create(self,true,false));
{ now reload all dependent units }
hp:=tmodule(loaded_units.first);
while assigned(hp) do
begin
if hp.do_reload then
tppumodule(hp).loadppu;
hp:=tmodule(hp.next);
end;
end
else
usedunits.concat(tused_unit.create(self,true,false));
{ reopen the old module }
{ reopen the old module }
{$ifdef SHORT_ON_FILE_HANDLES}
if old_current_module.is_unit and
assigned(tppumodule(old_current_module).ppufile) then
tppumodule(old_current_module).ppufile.tempopen;
if old_current_module.is_unit and
assigned(tppumodule(old_current_module).ppufile) then
tppumodule(old_current_module).ppufile.tempopen;
{$endif SHORT_ON_FILE_HANDLES}
{ we are back, restore current_module and current_scanner }
{ reload old scanner }
current_scanner:=tscannerfile(old_current_module.scanner);
if assigned(current_scanner) then
begin
current_scanner.tempopeninputfile;
current_scanner.gettokenpos
end
else
fillchar(aktfilepos,sizeof(aktfilepos),0);
end;
{ we are back, restore current_module }
current_module:=old_current_module;
current_scanner:=tscannerfile(current_module.scanner);
if assigned(current_scanner) then
begin
current_scanner.tempopeninputfile;
current_scanner.gettokenpos;
end
else
fillchar(aktfilepos,sizeof(aktfilepos),0);
SetCompileModule(current_module);
end;
@ -1359,7 +1412,11 @@ uses
end.
{
$Log$
Revision 1.35 2003-05-25 10:27:12 peter
Revision 1.36 2003-06-07 20:26:32 peter
* re-resolving added instead of reloading from ppu
* tderef object added to store deref info for resolving
Revision 1.35 2003/05/25 10:27:12 peter
* moved Comment calls to messge file
Revision 1.34 2003/05/23 17:04:37 peter

20
compiler/ncal.pas
View File

@ -73,10 +73,12 @@ interface
{ the symbol containing the definition of the procedure }
{ to call }
symtableprocentry : tprocsym;
symtableprocentryderef : tderef;
{ symtable where the entry was found, needed for with support }
symtableproc : tsymtable;
{ the definition of the procedure to call }
procdefinition : tabstractprocdef;
procdefinitionderef : tderef;
{ tree that contains the pointer to the object for this method }
methodpointer : tnode;
{ function return node, this is used to pass the data for a
@ -970,12 +972,12 @@ type
constructor tcallnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
begin
inherited ppuload(t,ppufile);
symtableprocentry:=tprocsym(ppufile.getderef);
ppufile.getderef(symtableprocentryderef);
{$ifdef fpc}
{$warning FIXME: No withsymtable support}
{$endif}
symtableproc:=nil;
procdefinition:=tprocdef(ppufile.getderef);
ppufile.getderef(procdefinitionderef);
restypeset:=boolean(ppufile.getbyte);
methodpointer:=ppuloadnode(ppufile);
funcretnode:=ppuloadnode(ppufile);
@ -986,8 +988,8 @@ type
procedure tcallnode.ppuwrite(ppufile:tcompilerppufile);
begin
inherited ppuwrite(ppufile);
ppufile.putderef(symtableprocentry);
ppufile.putderef(procdefinition);
ppufile.putderef(symtableprocentry,symtableprocentryderef);
ppufile.putderef(procdefinition,procdefinitionderef);
ppufile.putbyte(byte(restypeset));
ppuwritenode(ppufile,methodpointer);
ppuwritenode(ppufile,funcretnode);
@ -998,9 +1000,9 @@ type
procedure tcallnode.derefimpl;
begin
inherited derefimpl;
resolvesym(pointer(symtableprocentry));
symtableprocentry:=tprocsym(symtableprocentryderef.resolve);
symtableproc:=symtableprocentry.owner;
resolvedef(pointer(procdefinition));
procdefinition:=tprocdef(procdefinitionderef.resolve);
if assigned(methodpointer) then
methodpointer.derefimpl;
if assigned(funcretnode) then
@ -2589,7 +2591,11 @@ begin
end.
{
$Log$
Revision 1.164 2003-06-03 21:05:48 peter
Revision 1.165 2003-06-07 20:26:32 peter
* re-resolving added instead of reloading from ppu
* tderef object added to store deref info for resolving
Revision 1.164 2003/06/03 21:05:48 peter
* fix check for procedure without parameters
* calling constructor as member will not allocate memory

20
compiler/nflw.pas
View File

@ -117,6 +117,7 @@ interface
tgotonode = class(tnode)
labsym : tlabelsym;
labsymderef : tderef;
exceptionblock : integer;
// internlab : tinterngotolabel;
constructor create(p : tlabelsym);virtual;
@ -134,6 +135,7 @@ interface
tlabelnode = class(tunarynode)
labelnr : tasmlabel;
labsym : tlabelsym;
labsymderef : tderef;
exceptionblock : integer;
constructor createcase(p : tasmlabel;l:tnode);virtual;
constructor create(p : tlabelsym;l:tnode);virtual;
@ -948,7 +950,7 @@ implementation
constructor tgotonode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
begin
inherited ppuload(t,ppufile);
labsym:=tlabelsym(ppufile.getderef);
ppufile.getderef(labsymderef);
exceptionblock:=ppufile.getbyte;
end;
@ -956,7 +958,7 @@ implementation
procedure tgotonode.ppuwrite(ppufile:tcompilerppufile);
begin
inherited ppuwrite(ppufile);
ppufile.putderef(labsym);
ppufile.putderef(labsym,labsymderef);
ppufile.putbyte(exceptionblock);
end;
@ -964,7 +966,7 @@ implementation
procedure tgotonode.derefimpl;
begin
inherited derefimpl;
resolvesym(pointer(labsym));
labsym:=tlabelsym(labsymderef.resolve);
end;
@ -1036,7 +1038,7 @@ implementation
constructor tlabelnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
begin
inherited ppuload(t,ppufile);
labsym:=tlabelsym(ppufile.getderef);
ppufile.getderef(labsymderef);
labelnr:=tasmlabel(ppufile.getasmsymbol);
exceptionblock:=ppufile.getbyte;
end;
@ -1045,7 +1047,7 @@ implementation
procedure tlabelnode.ppuwrite(ppufile:tcompilerppufile);
begin
inherited ppuwrite(ppufile);
ppufile.putderef(labsym);
ppufile.putderef(labsym,labsymderef);
ppufile.putasmsymbol(labelnr);
ppufile.putbyte(exceptionblock);
end;
@ -1054,7 +1056,7 @@ implementation
procedure tlabelnode.derefimpl;
begin
inherited derefimpl;
resolvesym(pointer(labsym));
labsym:=tlabelsym(labsymderef.resolve);
objectlibrary.derefasmsymbol(tasmsymbol(labelnr));
end;
@ -1427,7 +1429,11 @@ begin
end.
{
$Log$
Revision 1.76 2003-06-07 18:57:04 jonas
Revision 1.77 2003-06-07 20:26:32 peter
* re-resolving added instead of reloading from ppu
* tderef object added to store deref info for resolving
Revision 1.76 2003/06/07 18:57:04 jonas
+ added freeintparaloc
* ppc get/freeintparaloc now check whether the parameter regs are
properly allocated/deallocated (and get an extra list para)

27
compiler/nld.pas
View File

@ -36,8 +36,10 @@ interface
type
tloadnode = class(tunarynode)
symtableentry : tsym;
symtableentryderef : tderef;
symtable : tsymtable;
procdef : tprocdef;
procdefderef : tderef;
constructor create(v : tsym;st : tsymtable);virtual;
constructor create_procvar(v : tsym;d:tprocdef;st : tsymtable);virtual;
constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
@ -105,6 +107,7 @@ interface
l1,l2 : longint;
rttitype : trttitype;
rttidef : tstoreddef;
rttidefderef : tderef;
constructor create(def:tstoreddef;rt:trttitype);virtual;
constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
procedure ppuwrite(ppufile:tcompilerppufile);override;
@ -313,26 +316,26 @@ implementation
constructor tloadnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
begin
inherited ppuload(t,ppufile);
symtableentry:=tsym(ppufile.getderef);
ppufile.getderef(symtableentryderef);
symtable:=nil;
procdef:=tprocdef(ppufile.getderef);
ppufile.getderef(procdefderef);
end;
procedure tloadnode.ppuwrite(ppufile:tcompilerppufile);
begin
inherited ppuwrite(ppufile);
ppufile.putderef(symtableentry);
ppufile.putderef(procdef);
ppufile.putderef(symtableentry,symtableentryderef);
ppufile.putderef(procdef,procdefderef);
end;
procedure tloadnode.derefimpl;
begin
inherited derefimpl;
resolvesym(pointer(symtableentry));
symtableentry:=tsym(symtableentryderef.resolve);
symtable:=symtableentry.owner;
resolvedef(pointer(procdef));
procdef:=tprocdef(procdefderef.resolve);
end;
@ -1181,7 +1184,7 @@ implementation
constructor trttinode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
begin
inherited ppuload(t,ppufile);
rttidef:=tstoreddef(ppufile.getderef);
ppufile.getderef(rttidefderef);
rttitype:=trttitype(ppufile.getbyte);
end;
@ -1189,7 +1192,7 @@ implementation
procedure trttinode.ppuwrite(ppufile:tcompilerppufile);
begin
inherited ppuwrite(ppufile);
ppufile.putderef(rttidef);
ppufile.putderef(rttidef,rttidefderef);
ppufile.putbyte(byte(rttitype));
end;
@ -1197,7 +1200,7 @@ implementation
procedure trttinode.derefimpl;
begin
inherited derefimpl;
resolvedef(pointer(rttidef));
rttidef:=tstoreddef(rttidefderef.resolve);
end;
@ -1253,7 +1256,11 @@ begin
end.
{
$Log$
Revision 1.98 2003-06-07 18:57:04 jonas
Revision 1.99 2003-06-07 20:26:32 peter
* re-resolving added instead of reloading from ppu
* tderef object added to store deref info for resolving
Revision 1.98 2003/06/07 18:57:04 jonas
+ added freeintparaloc
* ppc get/freeintparaloc now check whether the parameter regs are
properly allocated/deallocated (and get an extra list para)

20
compiler/nmem.pas
View File

@ -41,6 +41,7 @@ interface
taddrnode = class(tunarynode)
getprocvardef : tprocvardef;
getprocvardefderef : tderef;
constructor create(l : tnode);virtual;
constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
procedure ppuwrite(ppufile:tcompilerppufile);override;
@ -69,6 +70,7 @@ interface
tsubscriptnode = class(tunarynode)
vs : tvarsym;
vsderef : tderef;
constructor create(varsym : tsym;l : tnode);virtual;
constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
procedure ppuwrite(ppufile:tcompilerppufile);override;
@ -176,14 +178,14 @@ implementation
constructor taddrnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
begin
inherited ppuload(t,ppufile);
getprocvardef:=tprocvardef(ppufile.getderef);
ppufile.getderef(getprocvardefderef);
end;
procedure taddrnode.ppuwrite(ppufile:tcompilerppufile);
begin
inherited ppuwrite(ppufile);
ppufile.putderef(getprocvardef);
ppufile.putderef(getprocvardef,getprocvardefderef);
end;
procedure Taddrnode.mark_write;
@ -196,7 +198,7 @@ implementation
procedure taddrnode.derefimpl;
begin
inherited derefimpl;
resolvedef(pointer(getprocvardef));
getprocvardef:=tprocvardef(getprocvardefderef.resolve);
end;
@ -516,21 +518,21 @@ implementation
constructor tsubscriptnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
begin
inherited ppuload(t,ppufile);
vs:=tvarsym(ppufile.getderef);
ppufile.getderef(vsderef);
end;
procedure tsubscriptnode.ppuwrite(ppufile:tcompilerppufile);
begin
inherited ppuwrite(ppufile);
ppufile.putderef(vs);
ppufile.putderef(vs,vsderef);
end;
procedure tsubscriptnode.derefimpl;
begin
inherited derefimpl;
resolvesym(pointer(vs));
vs:=tvarsym(vsderef.resolve);
end;
@ -902,7 +904,11 @@ begin
end.
{
$Log$
Revision 1.56 2003-06-07 18:57:04 jonas
Revision 1.57 2003-06-07 20:26:32 peter
* re-resolving added instead of reloading from ppu
* tderef object added to store deref info for resolving
Revision 1.56 2003/06/07 18:57:04 jonas
+ added freeintparaloc
* ppc get/freeintparaloc now check whether the parameter regs are
properly allocated/deallocated (and get an extra list para)

8
compiler/pmodules.pas
View File

@ -948,6 +948,7 @@ implementation
{ Parse the implementation section }
consume(_IMPLEMENTATION);
current_module.in_interface:=false;
current_module.interface_compiled:=true;
Message1(unit_u_loading_implementation_units,current_module.modulename^);
@ -1270,6 +1271,7 @@ implementation
{ set implementation flag }
current_module.in_interface:=false;
current_module.interface_compiled:=true;
{ insert after the unit symbol tables the static symbol table }
{ of the program }
@ -1459,7 +1461,11 @@ So, all parameters are passerd into registers in sparc architecture.}
end.
{
$Log$
Revision 1.111 2003-06-03 20:21:45 mazen
Revision 1.112 2003-06-07 20:26:32 peter
* re-resolving added instead of reloading from ppu
* tderef object added to store deref info for resolving
Revision 1.111 2003/06/03 20:21:45 mazen
- removed unneeded ifdefs
- removed unneeded cases for sparc and x86_64

8
compiler/ppu.pas
View File

@ -41,7 +41,7 @@ type
{$endif Test_Double_checksum}
const
CurrentPPUVersion=35;
CurrentPPUVersion=36;
{ buffer sizes }
maxentrysize = 1024;
@ -983,7 +983,11 @@ end;
end.
{
$Log$
Revision 1.38 2003-05-26 19:39:51 peter
Revision 1.39 2003-06-07 20:26:32 peter
* re-resolving added instead of reloading from ppu
* tderef object added to store deref info for resolving
Revision 1.38 2003/05/26 19:39:51 peter
* removed systems unit
Revision 1.37 2003/05/26 15:49:54 jonas

36
compiler/symbase.pas
View File

@ -135,19 +135,6 @@ interface
{$endif GDB}
end;
{************************************************
TDeref
************************************************}
tderef = class
dereftype : tdereftype;
index : word;
next : tderef;
constructor create(typ:tdereftype;i:word);
destructor destroy;override;
end;
var
registerdef : boolean; { true, when defs should be registered }
@ -155,6 +142,7 @@ interface
symtablestack : tsymtable; { linked list of symtables }
aktrecordsymtable : tsymtable; { current record read from ppu symtable }
aktstaticsymtable : tsymtable; { current static for local ppu symtable }
aktglobalsymtable : tsymtable; { current global for local ppu symtable }
aktlocalsymtable : tsymtable; { current proc local for local ppu symtable }
@ -328,26 +316,14 @@ implementation
{$endif GDB}
{****************************************************************************
TDeref
****************************************************************************}
constructor tderef.create(typ:tdereftype;i:word);
begin
dereftype:=typ;
index:=i;
next:=nil;
end;
destructor tderef.destroy;
begin
end;
end.
{
$Log$
Revision 1.12 2003-04-27 11:21:34 peter
Revision 1.13 2003-06-07 20:26:32 peter
* re-resolving added instead of reloading from ppu
* tderef object added to store deref info for resolving
Revision 1.12 2003/04/27 11:21:34 peter
* aktprocdef renamed to current_procdef
* procinfo renamed to current_procinfo
* procinfo will now be stored in current_module so it can be

11
compiler/symconst.pas
View File

@ -94,12 +94,13 @@ type
tdereftype = (derefnil,
derefaktrecordindex,
derefaktstaticindex,
derefaktglobalindex,
derefaktlocalindex,
derefunit,
derefrecord,
derefindex,
dereflocal,
derefpara,
derefaktlocal
derefpara
);
{ symbol options }
@ -352,7 +353,11 @@ implementation
end.
{
$Log$
Revision 1.56 2003-05-22 21:31:35 peter
Revision 1.57 2003-06-07 20:26:32 peter
* re-resolving added instead of reloading from ppu
* tderef object added to store deref info for resolving
Revision 1.56 2003/05/22 21:31:35 peter
* defer codegeneration for nested procedures
Revision 1.55 2003/05/15 21:10:32 peter

120
compiler/symdef.pas
View File

@ -50,9 +50,12 @@ interface
************************************************}
tstoreddef = class(tdef)
typesymderef : tderef;
{ persistent (available across units) rtti and init tables }
rttitablesym,
inittablesym : tsym; {trttisym}
rttitablesymderef,
inittablesymderef : tderef;
{ local (per module) rtti and init tables }
localrttilab : array[trttitype] of tasmlabel;
{ linked list of global definitions }
@ -100,7 +103,9 @@ interface
tparaitem = class(TLinkedListItem)
paratype : ttype; { required for procvar }
parasym : tsym;
parasymderef : tderef;
defaultvalue : tsym; { tconstsym }
defaultvaluederef : tderef;
paratyp : tvarspez; { required for procvar }
paraloc : tparalocation;
is_hidden : boolean; { is this a hidden (implicit) parameter }
@ -250,6 +255,7 @@ interface
procedure writefields(sym:tnamedindexitem;arg:pointer);
public
childof : tobjectdef;
childofderef : tderef;
objname,
objrealname : pstring;
objectoptions : tobjectoptions;
@ -306,13 +312,14 @@ interface
function count: longint;
function interfaces(intfindex: longint): tobjectdef;
function interfacesderef(intfindex: longint): tderef;
function ioffsets(intfindex: longint): plongint;
function searchintf(def: tdef): longint;
procedure addintf(def: tdef);
procedure deref;
{ add interface reference loaded from ppu }
procedure addintfref(def: pointer);
procedure addintf_deref(const d:tderef);
procedure clearmappings;
procedure addmappings(intfindex: longint; const name, newname: string);
@ -485,17 +492,20 @@ interface
symoptions : tsymoptions;
{ symbol owning this definition }
procsym : tsym;
procsymderef : tderef;
{ alias names }
aliasnames : tstringlist;
{ symtables }
localst : tsymtable;
funcretsym : tsym;
funcretsymderef : tderef;
{ browser info }
lastref,
defref,
lastwritten : tref;
refcount : longint;
_class : tobjectdef;
_classderef : tderef;
{ it's a tree, but this not easy to handle }
{ used for inlined procs }
code : tnode;
@ -549,6 +559,7 @@ interface
pprocdeflist = ^tprocdeflist;
tprocdeflist = record
def : tprocdef;
defderef : tderef;
next : pprocdeflist;
end;
@ -587,6 +598,7 @@ interface
has_jumps : boolean;
firstenum : tsym; {tenumsym}
basedef : tenumdef;
basedefderef : tderef;
constructor create;
constructor create_subrange(_basedef:tenumdef;_min,_max:longint);
constructor ppuload(ppufile:tcompilerppufile);
@ -877,12 +889,12 @@ implementation
fillchar(localrttilab,sizeof(localrttilab),0);
{ load }
indexnr:=ppufile.getword;
typesym:=ttypesym(pointer(ppufile.getderef));
ppufile.getderef(typesymderef);
ppufile.getsmallset(defoptions);
if df_has_rttitable in defoptions then
rttitablesym:=tsym(ppufile.getderef);
ppufile.getderef(rttitablesymderef);
if df_has_inittable in defoptions then
inittablesym:=tsym(ppufile.getderef);
ppufile.getderef(inittablesymderef);
end;
@ -922,12 +934,12 @@ implementation
procedure tstoreddef.ppuwritedef(ppufile:tcompilerppufile);
begin
ppufile.putword(indexnr);
ppufile.putderef(typesym);
ppufile.putderef(typesym,typesymderef);
ppufile.putsmallset(defoptions);
if df_has_rttitable in defoptions then
ppufile.putderef(rttitablesym);
ppufile.putderef(rttitablesym,rttitablesymderef);
if df_has_inittable in defoptions then
ppufile.putderef(inittablesym);
ppufile.putderef(inittablesym,inittablesymderef);
{$ifdef GDB}
if globalnb = 0 then
begin
@ -945,9 +957,11 @@ implementation
procedure tstoreddef.deref;
begin
resolvesym(pointer(typesym));
resolvesym(pointer(rttitablesym));
resolvesym(pointer(inittablesym));
typesym:=ttypesym(typesymderef.resolve);
if df_has_rttitable in defoptions then
rttitablesym:=trttisym(rttitablesymderef.resolve);
if df_has_inittable in defoptions then
inittablesym:=trttisym(inittablesymderef.resolve);
end;
@ -1473,7 +1487,7 @@ implementation
begin
inherited ppuloaddef(ppufile);
deftype:=enumdef;
basedef:=tenumdef(ppufile.getderef);
ppufile.getderef(basedefderef);
minval:=ppufile.getlongint;
maxval:=ppufile.getlongint;
savesize:=ppufile.getlongint;
@ -1523,7 +1537,7 @@ implementation
procedure tenumdef.deref;
begin
inherited deref;
resolvedef(pointer(basedef));
basedef:=tenumdef(basedefderef.resolve);
end;
@ -1536,7 +1550,7 @@ implementation
procedure tenumdef.ppuwrite(ppufile:tcompilerppufile);
begin
inherited ppuwritedef(ppufile);
ppufile.putderef(basedef);
ppufile.putderef(basedef,basedefderef);
ppufile.putlongint(min);
ppufile.putlongint(max);
ppufile.putlongint(savesize);
@ -3177,8 +3191,8 @@ implementation
while assigned(hp) do
begin
hp.paratype.resolve;
resolvesym(pointer(hp.defaultvalue));
resolvesym(pointer(hp.parasym));
hp.defaultvalue:=tsym(hp.defaultvaluederef.resolve);
hp.parasym:=tvarsym(hp.parasymderef.resolve);
hp:=TParaItem(hp.next);
end;
end;
@ -3208,8 +3222,10 @@ implementation
hp:=TParaItem.Create;
hp.paratyp:=tvarspez(ppufile.getbyte);
ppufile.gettype(hp.paratype);
hp.defaultvalue:=tsym(ppufile.getderef);
hp.parasym:=tsym(ppufile.getderef);
ppufile.getderef(hp.defaultvaluederef);
hp.defaultvalue:=nil;
ppufile.getderef(hp.parasymderef);
hp.parasym:=nil;
hp.is_hidden:=boolean(ppufile.getbyte);
{ later, we'll gerate this on the fly (FK) }
paraloclen:=ppufile.getbyte;
@ -3252,8 +3268,8 @@ implementation
begin
ppufile.putbyte(byte(hp.paratyp));
ppufile.puttype(hp.paratype);
ppufile.putderef(hp.defaultvalue);
ppufile.putderef(hp.parasym);
ppufile.putderef(hp.defaultvalue,hp.defaultvaluederef);
ppufile.putderef(hp.parasym,hp.parasymderef);
ppufile.putbyte(byte(hp.is_hidden));
{ write the length of tparalocation so ppudump can
parse the .ppu without knowing the tparalocation size }
@ -3435,14 +3451,14 @@ implementation
_mangledname:=nil;
overloadnumber:=ppufile.getword;
extnumber:=ppufile.getword;
_class := tobjectdef(ppufile.getderef);
procsym := tsym(ppufile.getderef);
ppufile.getderef(_classderef);
ppufile.getderef(procsymderef);
ppufile.getposinfo(fileinfo);
ppufile.getsmallset(symoptions);
{ inline stuff }
if proccalloption=pocall_inline then
begin
funcretsym:=tsym(ppufile.getderef);
ppufile.getderef(funcretsymderef);
code:=ppuloadnode(ppufile);
end
else
@ -3553,8 +3569,8 @@ implementation
ppufile.putstring(mangledname);
ppufile.putword(overloadnumber);
ppufile.putword(extnumber);
ppufile.putderef(_class);
ppufile.putderef(procsym);
ppufile.putderef(_class,_classderef);
ppufile.putderef(procsym,procsymderef);
ppufile.putposinfo(fileinfo);
ppufile.putsmallset(symoptions);
@ -3565,7 +3581,7 @@ implementation
{ inline stuff }
if proccalloption=pocall_inline then
begin
ppufile.putderef(funcretsym);
ppufile.putderef(funcretsym,funcretsymderef);
ppuwritenode(ppufile,code);
end;
ppufile.do_crc:=oldintfcrc;
@ -3749,14 +3765,16 @@ implementation
ref : tref;
pdo : tobjectdef;
move_last : boolean;
d : tderef;
begin
d.reset;
move_last:=lastwritten=lastref;
if move_last and
(((current_module.flags and uf_local_browser)=0) or
not locals) then
exit;
{ write address of this symbol }
ppufile.putderef(self);
ppufile.putderef(self,d);
{ write refs }
if assigned(lastwritten) then
ref:=lastwritten
@ -3920,10 +3938,10 @@ implementation
procedure tprocdef.deref;
begin
inherited deref;
resolvedef(pointer(_class));
_class:=tobjectdef(_classderef.resolve);
{ procsym that originaly defined this definition, should be in the
same symtable }
resolvesym(pointer(procsym));
procsym:=tprocsym(procsymderef.resolve);
end;
@ -3942,7 +3960,7 @@ implementation
tlocalsymtable(localst).derefimpl;
aktlocalsymtable:=oldlocalsymtable;
{ funcretsym, this is always located in the localst }
resolvesym(pointer(funcretsym));
funcretsym:=tsym(funcretsymderef.resolve);
end
else
begin
@ -4325,6 +4343,7 @@ implementation
constructor tobjectdef.ppuload(ppufile:tcompilerppufile);
var
i,implintfcount: longint;
d : tderef;
begin
inherited ppuloaddef(ppufile);
deftype:=objectdef;
@ -4333,7 +4352,7 @@ implementation
vmt_offset:=ppufile.getlongint;
objrealname:=stringdup(ppufile.getstring);
objname:=stringdup(upper(objrealname^));
childof:=tobjectdef(ppufile.getderef);
ppufile.getderef(childofderef);
ppufile.getsmallset(objectoptions);
{ load guid }
@ -4353,7 +4372,8 @@ implementation
implintfcount:=ppufile.getlongint;
for i:=1 to implintfcount do
begin
implementedinterfaces.addintfref(ppufile.getderef);
ppufile.getderef(d);
implementedinterfaces.addintf_deref(d);
implementedinterfaces.ioffsets(i)^:=ppufile.getlongint;
end;
end
@ -4408,7 +4428,7 @@ implementation
ppufile.putlongint(size);
ppufile.putlongint(vmt_offset);
ppufile.putstring(objrealname^);
ppufile.putderef(childof);
ppufile.putderef(childof,childofderef);
ppufile.putsmallset(objectoptions);
if objecttype in [odt_interfacecom,odt_interfacecorba] then
begin
@ -4423,7 +4443,7 @@ implementation
ppufile.putlongint(implintfcount);
for i:=1 to implintfcount do
begin
ppufile.putderef(implementedinterfaces.interfaces(i));
ppufile.putderef(implementedinterfaces.interfaces(i),implementedinterfaces.interfacesderef(i));
ppufile.putlongint(implementedinterfaces.ioffsets(i)^);
end;
end;
@ -4439,7 +4459,7 @@ implementation
oldrecsyms : tsymtable;
begin
inherited deref;
resolvedef(pointer(childof));
childof:=tobjectdef(childofderef.resolve);
oldrecsyms:=aktrecordsymtable;
aktrecordsymtable:=symtable;
tstoredsymtable(symtable).deref;
@ -5299,10 +5319,12 @@ implementation
type
timplintfentry = class(TNamedIndexItem)
intf: tobjectdef;
intfderef : tderef;
ioffs: longint;
namemappings: tdictionary;
procdefs: TIndexArray;
constructor create(aintf: tobjectdef);
constructor create_deref(const d:tderef);
destructor destroy; override;
end;
@ -5315,6 +5337,18 @@ implementation
procdefs:=nil;
end;
constructor timplintfentry.create_deref(const d:tderef);
begin
inherited create;
intf:=nil;
intfderef:=d;
ioffs:=-1;
namemappings:=nil;
procdefs:=nil;
end;
destructor timplintfentry.destroy;
begin
if assigned(namemappings) then
@ -5352,6 +5386,12 @@ implementation
interfaces:=timplintfentry(finterfaces.search(intfindex)).intf;
end;
function timplementedinterfaces.interfacesderef(intfindex: longint): tderef;
begin
checkindex(intfindex);
interfacesderef:=timplintfentry(finterfaces.search(intfindex)).intfderef;
end;
function timplementedinterfaces.ioffsets(intfindex: longint): plongint;
begin
checkindex(intfindex);
@ -5376,12 +5416,12 @@ implementation
begin
for i:=1 to count do
with timplintfentry(finterfaces.search(i)) do
resolvedef(pointer(intf));
intf:=tobjectdef(intfderef.resolve);
end;
procedure timplementedinterfaces.addintfref(def: pointer);
procedure timplementedinterfaces.addintf_deref(const d:tderef);
begin
finterfaces.insert(timplintfentry.create(tobjectdef(def)));
finterfaces.insert(timplintfentry.create_deref(d));
end;
procedure timplementedinterfaces.addintf(def: tdef);
@ -5726,7 +5766,11 @@ implementation
end.
{
$Log$
Revision 1.149 2003-06-05 20:05:55 peter
Revision 1.150 2003-06-07 20:26:32 peter
* re-resolving added instead of reloading from ppu
* tderef object added to store deref info for resolving
Revision 1.149 2003/06/05 20:05:55 peter
* removed changesettype because that will change the definition
of the setdef forever and can result in a different between
original interface and current implementation definition

149
compiler/symppu.pas
View File

@ -40,7 +40,7 @@ interface
function getexprint:tconstexprint;
function getptruint:TConstPtrUInt;
procedure getposinfo(var p:tfileposinfo);
function getderef : pointer;
procedure getderef(var d:tderef);
function getsymlist:tsymlist;
procedure gettype(var t:ttype);
function getasmsymbol:tasmsymbol;
@ -48,7 +48,7 @@ interface
procedure putexprint(v:tconstexprint);
procedure PutPtrUInt(v:TConstPtrUInt);
procedure putposinfo(const p:tfileposinfo);
procedure putderef(p : tsymtableentry);
procedure putderef(s:tsymtableentry;const d:tderef);
procedure putsymlist(p:tsymlist);
procedure puttype(const t:ttype);
procedure putasmsymbol(s:tasmsymbol);
@ -164,50 +164,22 @@ implementation
end;
function tcompilerppufile.getderef : pointer;
var
hp,p : tderef;
b : tdereftype;
procedure tcompilerppufile.getderef(var d:tderef);
begin
p:=nil;
repeat
hp:=p;
b:=tdereftype(getbyte);
case b of
derefnil :
break;
derefunit,
derefaktrecordindex,
derefaktlocal,
derefaktstaticindex :
begin
p:=tderef.create(b,getword);
p.next:=hp;
break;
end;
derefindex,
dereflocal,
derefpara,
derefrecord :
begin
p:=tderef.create(b,getword);
p.next:=hp;
end;
end;
until false;
getderef:=p;
d.len:=getbyte;
getdata(d.data,d.len);
end;
function tcompilerppufile.getsymlist:tsymlist;
var
sym : tsym;
symderef : tderef;
slt : tsltype;
idx : longint;
p : tsymlist;
begin
p:=tsymlist.create;
p.def:=tdef(getderef);
getderef(p.defderef);
repeat
slt:=tsltype(getbyte);
case slt of
@ -217,8 +189,8 @@ implementation
sl_load,
sl_subscript :
begin
sym:=tsym(getderef);
p.addsym(slt,sym);
getderef(symderef);
p.addsymderef(slt,symderef);
end;
sl_vec :
begin
@ -226,7 +198,7 @@ implementation
p.addconst(slt,idx);
end;
else
internalerror(200110204);
internalerror(200110204);
end;
until false;
getsymlist:=tsymlist(p);
@ -235,8 +207,9 @@ implementation
procedure tcompilerppufile.gettype(var t:ttype);
begin
t.def:=tdef(getderef);
t.sym:=tsym(getderef);
getderef(t.deref);
t.def:=nil;
t.sym:=nil;
end;
@ -359,83 +332,11 @@ implementation
end;
procedure tcompilerppufile.putderef(p : tsymtableentry);
procedure tcompilerppufile.putderef(s:tsymtableentry;const d:tderef);
begin
if p=nil then
putbyte(ord(derefnil))
else
begin
{ Static symtable ? }
if p.owner.symtabletype=staticsymtable then
begin
putbyte(ord(derefaktstaticindex));
putword(p.indexnr);
end
{ Local record/object symtable ? }
else if (p.owner=aktrecordsymtable) then
begin
putbyte(ord(derefaktrecordindex));
putword(p.indexnr);
end
{ Local local/para symtable ? }
else if (p.owner=aktlocalsymtable) then
begin
putbyte(ord(derefaktlocal));
putword(p.indexnr);
end
else
begin
putbyte(ord(derefindex));
putword(p.indexnr);
{ Current unit symtable ? }
repeat
if not assigned(p) then
internalerror(556655);
case p.owner.symtabletype of
{ when writing the pseudo PPU file
to get CRC values the globalsymtable is not yet
a unitsymtable PM }
globalsymtable :
begin
{ check if the unit is available in the uses
clause, else it's an error }
if p.owner.unitid=$ffff then
internalerror(55665566);
putbyte(ord(derefunit));
putword(p.owner.unitid);
break;
end;
staticsymtable :
begin
putbyte(ord(derefaktstaticindex));
putword(p.indexnr);
break;
end;
localsymtable :
begin
p:=p.owner.defowner;
putbyte(ord(dereflocal));
putword(p.indexnr);
end;
parasymtable :
begin
p:=p.owner.defowner;
putbyte(ord(derefpara));
putword(p.indexnr);
end;
objectsymtable,
recordsymtable :
begin
p:=p.owner.defowner;
putbyte(ord(derefrecord));
putword(p.indexnr);
end;
else
internalerror(556656);
end;
until false;
end;
end;
d.build(s);
putbyte(d.len);
putdata(d.data,d.len);
end;
@ -443,7 +344,7 @@ implementation
var
hp : psymlistitem;
begin
putderef(p.def);
putderef(p.def,p.defderef);
hp:=p.firstsym;
while assigned(hp) do
begin
@ -452,7 +353,7 @@ implementation
sl_call,
sl_load,
sl_subscript :
putderef(hp^.sym);
putderef(hp^.sym,hp^.symderef);
sl_vec :
putlongint(hp^.value);
else
@ -476,13 +377,11 @@ implementation
(t.sym.owner.unitid<>1))
) then
begin
putderef(nil);
putderef(t.sym);
putderef(t.sym,t.deref);
end
else
begin
putderef(t.def);
putderef(nil);
putderef(t.def,t.deref);
end;
end;
@ -506,7 +405,11 @@ implementation
end.
{
$Log$
Revision 1.18 2002-12-21 13:07:34 peter
Revision 1.19 2003-06-07 20:26:32 peter
* re-resolving added instead of reloading from ppu
* tderef object added to store deref info for resolving
Revision 1.18 2002/12/21 13:07:34 peter
* type redefine fix for tb0437
Revision 1.17 2002/10/05 12:43:29 carl

127
compiler/symsym.pas
View File

@ -132,6 +132,7 @@ interface
procedure ppuwrite(ppufile:tcompilerppufile);override;
procedure deref;override;
procedure addprocdef(p:tprocdef);
procedure addprocdef_deref(const d:tderef);
procedure add_para_match_to(Aprocsym:Tprocsym);
procedure concat_procdefs_to(s:Tprocsym);
procedure foreach_procdef_static(proc2call:Tprocdefcallback;arg:pointer);
@ -213,6 +214,7 @@ interface
tpropertysym = class(tstoredsym)
propoptions : tpropertyoptions;
propoverriden : tpropertysym;
propoverridenderef : tderef;
proptype,
indextype : ttype;
index,
@ -276,7 +278,7 @@ interface
tconstsym = class(tstoredsym)
consttype : ttype;
consttyp : tconsttyp;
value : tconstvalue;
value : tconstvalue;
resstrindex : longint; { needed for resource strings }
constructor create_ord(const n : string;t : tconsttyp;v : tconstexprint);
constructor create_ord_typed(const n : string;t : tconsttyp;v : tconstexprint;const tt:ttype);
@ -298,6 +300,7 @@ interface
tenumsym = class(tstoredsym)
value : longint;
definition : tenumdef;
definitionderef : tderef;
nextenum : tenumsym;
constructor create(const n : string;def : tenumdef;v : longint);
constructor ppuload(ppufile:tcompilerppufile);
@ -472,6 +475,7 @@ implementation
function tstoredsym.write_references(ppufile:tcompilerppufile;locals:boolean):boolean;
var
d : tderef;
ref : tref;
symref_written,move_last : boolean;
begin
@ -482,6 +486,7 @@ implementation
move_last:=true;
symref_written:=false;
{ write symbol refs }
d.reset;
if assigned(lastwritten) then
ref:=lastwritten
else
@ -493,7 +498,7 @@ implementation
{ write address to this symbol }
if not symref_written then
begin
ppufile.putderef(self);
ppufile.putderef(self,d);
symref_written:=true;
end;
ppufile.putposinfo(ref.posinfo);
@ -803,19 +808,20 @@ implementation
constructor tprocsym.ppuload(ppufile:tcompilerppufile);
var
pd : tprocdef;
pdderef : tderef;
i,n : longint;
begin
inherited loadsym(ppufile);
typ:=procsym;
pdlistfirst:=nil;
pdlistlast:=nil;
procdef_count:=0;
repeat
pd:=tprocdef(ppufile.getderef);
if pd=nil then
break;
addprocdef(pd);
until false;
n:=ppufile.getword;
for i:=1to n do
begin
ppufile.getderef(pdderef);
addprocdef_deref(pdderef);
end;
{$ifdef GDB}
is_global:=false;
{$endif GDB}
@ -839,6 +845,38 @@ implementation
end;
procedure tprocsym.ppuwrite(ppufile:tcompilerppufile);
var
p : pprocdeflist;
n : word;
begin
inherited writesym(ppufile);
{ count procdefs }
n:=0;
p:=pdlistfirst;
while assigned(p) do
begin
{ only write the proc definitions that belong
to this procsym }
if (p^.def.procsym=self) then
inc(n);
p:=p^.next;
end;
ppufile.putword(n);
{ write procdefs }
p:=pdlistfirst;
while assigned(p) do
begin
{ only write the proc definitions that belong
to this procsym }
if (p^.def.procsym=self) then
ppufile.putderef(p^.def,p^.defderef);
p:=p^.next;
end;
ppufile.writeentry(ibprocsym);
end;
procedure tprocsym.write_parameter_lists(skipdef:tprocdef);
var
p : pprocdeflist;
@ -879,7 +917,7 @@ implementation
p:=pdlistfirst;
while assigned(p) do
begin
resolvedef(pointer(p^.def));
p^.def:=tprocdef(p^.defderef.resolve);
p:=p^.next;
end;
end;
@ -891,6 +929,31 @@ implementation
begin
new(pd);
pd^.def:=p;
pd^.defderef.reset;
pd^.next:=nil;
{ Add at end of list to keep always
a correct order, also after loading from ppu }
if assigned(pdlistlast) then
begin
pdlistlast^.next:=pd;
pdlistlast:=pd;
end
else
begin
pdlistfirst:=pd;
pdlistlast:=pd;
end;
inc(procdef_count);
end;
procedure tprocsym.addprocdef_deref(const d:tderef);
var
pd : pprocdeflist;
begin
new(pd);
pd^.def:=nil;
pd^.defderef:=d;
pd^.next:=nil;
{ Add at end of list to keep always
a correct order, also after loading from ppu }
@ -1226,25 +1289,6 @@ implementation
end;
procedure tprocsym.ppuwrite(ppufile:tcompilerppufile);
var
p : pprocdeflist;
begin
inherited writesym(ppufile);
p:=pdlistfirst;
while assigned(p) do
begin
{ only write the proc definitions that belong
to this procsym }
if (p^.def.procsym=self) then
ppufile.putderef(p^.def);
p:=p^.next;
end;
ppufile.putderef(nil);
ppufile.writeentry(ibprocsym);
end;
function tprocsym.write_references(ppufile:tcompilerppufile;locals:boolean) : boolean;
var
p : pprocdeflist;
@ -1352,7 +1396,7 @@ implementation
ppufile.getsmallset(propoptions);
if (ppo_is_override in propoptions) then
begin
propoverriden:=tpropertysym(ppufile.getderef);
ppufile.getderef(propoverridenderef);
{ we need to have these objects initialized }
readaccess:=tsymlist.create;
writeaccess:=tsymlist.create;
@ -1379,16 +1423,18 @@ implementation
inherited destroy;
end;
function tpropertysym.gettypedef:tdef;
begin
gettypedef:=proptype.def;
end;
procedure tpropertysym.deref;
begin
if (ppo_is_override in propoptions) then
begin
resolvesym(pointer(propoverriden));
propoverriden:=tpropertysym(propoverridenderef.resolve);
dooverride(propoverriden);
end
else
@ -1413,7 +1459,7 @@ implementation
inherited writesym(ppufile);
ppufile.putsmallset(propoptions);
if (ppo_is_override in propoptions) then
ppufile.putderef(propoverriden)
ppufile.putderef(propoverriden,propoverridenderef)
else
begin
ppufile.puttype(proptype);
@ -2271,7 +2317,7 @@ implementation
begin
inherited loadsym(ppufile);
typ:=enumsym;
definition:=tenumdef(ppufile.getderef);
ppufile.getderef(definitionderef);
value:=ppufile.getlongint;
nextenum := Nil;
end;
@ -2279,7 +2325,7 @@ implementation
procedure tenumsym.deref;
begin
resolvedef(pointer(definition));
definition:=tenumdef(definitionderef.resolve);
order;
end;
@ -2314,7 +2360,7 @@ implementation
procedure tenumsym.ppuwrite(ppufile:tcompilerppufile);
begin
inherited writesym(ppufile);
ppufile.putderef(definition);
ppufile.putderef(definition,definitionderef);
ppufile.putlongint(value);
ppufile.writeentry(ibenumsym);
end;
@ -2391,7 +2437,10 @@ implementation
function ttypesym.write_references(ppufile:tcompilerppufile;locals:boolean):boolean;
var
d : tderef;
begin
d.reset;
if not inherited write_references(ppufile,locals) then
begin
{ write address of this symbol if record or object
@ -2399,7 +2448,7 @@ implementation
because we need it for the symtable }
if (restype.def.deftype in [recorddef,objectdef]) then
begin
ppufile.putderef(self);
ppufile.putderef(self,d);
ppufile.writeentry(ibsymref);
end;
end;
@ -2613,7 +2662,11 @@ implementation
end.
{
$Log$
Revision 1.108 2003-06-05 17:53:30 peter
Revision 1.109 2003-06-07 20:26:32 peter
* re-resolving added instead of reloading from ppu
* tderef object added to store deref info for resolving
Revision 1.108 2003/06/05 17:53:30 peter
* fix to compile without gdb
Revision 1.107 2003/06/02 22:59:17 florian

37
compiler/symtable.pas
View File

@ -161,6 +161,8 @@ interface
destructor destroy;override;
procedure ppuload(ppufile:tcompilerppufile);override;
procedure ppuwrite(ppufile:tcompilerppufile);override;
procedure load_references(ppufile:tcompilerppufile;locals:boolean);override;
procedure write_references(ppufile:tcompilerppufile;locals:boolean);override;
procedure insert(sym : tsymentry);override;
procedure insertvardata(sym : tsymentry);override;
{$ifdef GDB}
@ -433,6 +435,7 @@ implementation
procedure tstoredsymtable.load_references(ppufile:tcompilerppufile;locals:boolean);
var
b : byte;
d : tderef;
sym : tstoredsym;
prdef : tstoreddef;
begin
@ -444,15 +447,15 @@ implementation
case b of
ibsymref :
begin
sym:=tstoredsym(ppufile.getderef);
resolvesym(pointer(sym));
ppufile.getderef(d);
sym:=tstoredsym(d.resolve);
if assigned(sym) then
sym.load_references(ppufile,locals);
end;
ibdefref :
begin
prdef:=tstoreddef(ppufile.getderef);
resolvedef(pointer(prdef));
ppufile.getderef(d);
prdef:=tstoreddef(d.resolve);
if assigned(prdef) then
begin
if prdef.deftype<>procdef then
@ -1746,6 +1749,8 @@ implementation
end;
{$endif GDB}
aktglobalsymtable:=self;
next:=symtablestack;
symtablestack:=self;
@ -1784,6 +1789,8 @@ implementation
procedure tglobalsymtable.ppuwrite(ppufile:tcompilerppufile);
begin
aktglobalsymtable:=self;
{ write the symtable entries }
inherited ppuwrite(ppufile);
@ -1803,6 +1810,22 @@ implementation
end;
procedure tglobalsymtable.load_references(ppufile:tcompilerppufile;locals:boolean);
begin
aktglobalsymtable:=self;
inherited load_references(ppufile,locals);
end;
procedure tglobalsymtable.write_references(ppufile:tcompilerppufile;locals:boolean);
begin
aktglobalsymtable:=self;
inherited write_references(ppufile,locals);
end;
procedure tglobalsymtable.insert(sym:tsymentry);
var
hsym : tsym;
@ -2429,7 +2452,11 @@ implementation
end.
{
$Log$
Revision 1.103 2003-05-25 11:34:17 peter
Revision 1.104 2003-06-07 20:26:32 peter
* re-resolving added instead of reloading from ppu
* tderef object added to store deref info for resolving
Revision 1.103 2003/05/25 11:34:17 peter
* methodpointer self pushing fixed
Revision 1.102 2003/05/23 14:27:35 peter

402
compiler/symtype.pas
View File

@ -98,6 +98,21 @@ interface
function gettypedef:tdef;virtual;
end;
{************************************************
TDeref
************************************************}
tderefdata = array[0..31] of byte;
tderef = object
len : longint;
data : tderefdata;
procedure reset;
procedure setdata(l:longint;var d);
procedure build(s:tsymtableentry);
function resolve:tsymtableentry;
end;
{************************************************
TType
************************************************}
@ -105,6 +120,7 @@ interface
ttype = object
def : tdef;
sym : tsym;
deref : tderef;
procedure reset;
procedure setdef(p:tdef);
procedure setsym(p:tsym);
@ -119,12 +135,14 @@ interface
tsymlistitem = record
sltype : tsltype;
sym : tsym;
symderef : tderef;
value : longint;
next : psymlistitem;
end;
tsymlist = class
def : tdef;
defderef : tderef;
firstsym,
lastsym : psymlistitem;
constructor create;
@ -132,6 +150,7 @@ interface
function empty:boolean;
procedure setdef(p:tdef);
procedure addsym(slt:tsltype;p:tsym);
procedure addsymderef(slt:tsltype;const d:tderef);
procedure addconst(slt:tsltype;v:longint);
procedure clear;
function getcopy:tsymlist;
@ -139,10 +158,6 @@ interface
end;
{ resolving }
procedure resolvesym(var sym:pointer);
procedure resolvedef(var def:pointer);
{$ifdef MEMDEBUG}
var
membrowser,
@ -315,23 +330,28 @@ implementation
procedure ttype.resolve;
var
p : tsymtableentry;
begin
if assigned(sym) then
begin
resolvesym(pointer(sym));
setsym(sym);
if not assigned(def) then
internalerror(200212271);
end
else
if assigned(def) then
p:=deref.resolve;
if assigned(p) then
begin
resolvedef(pointer(def));
if not assigned(def) then
internalerror(200212272);
end;
if p is tsym then
begin
setsym(tsym(p));
if not assigned(def) then
internalerror(200212272);
end
else
begin
setdef(tdef(p));
end;
end
else
reset;
end;
{****************************************************************************
TSymList
****************************************************************************}
@ -387,6 +407,25 @@ implementation
new(hp);
hp^.sltype:=slt;
hp^.sym:=p;
hp^.symderef.reset;
hp^.value:=0;
hp^.next:=nil;
if assigned(lastsym) then
lastsym^.next:=hp
else
firstsym:=hp;
lastsym:=hp;
end;
procedure tsymlist.addsymderef(slt:tsltype;const d:tderef);
var
hp : psymlistitem;
begin
new(hp);
hp^.sltype:=slt;
hp^.sym:=nil;
hp^.symderef:=d;
hp^.value:=0;
hp^.next:=nil;
if assigned(lastsym) then
@ -404,6 +443,7 @@ implementation
new(hp);
hp^.sltype:=slt;
hp^.sym:=nil;
hp^.symderef.reset;
hp^.value:=v;
hp^.next:=nil;
if assigned(lastsym) then
@ -443,114 +483,262 @@ implementation
var
hp : psymlistitem;
begin
resolvedef(pointer(def));
def:=tdef(defderef.resolve);
hp:=firstsym;
while assigned(hp) do
begin
if assigned(hp^.sym) then
resolvesym(pointer(hp^.sym));
hp^.sym:=tsym(hp^.symderef.resolve);
hp:=hp^.next;
end;
end;
{*****************************************************************************
Symbol / Definition Resolving
*****************************************************************************}
{****************************************************************************
Tderef
****************************************************************************}
procedure resolvederef(var p:tderef;var st:tsymtable;var idx:word);
var
hp : tderef;
pd : tdef;
pm : tmodule;
procedure tderef.reset;
begin
st:=nil;
idx:=0;
while assigned(p) do
len:=0;
end;
procedure tderef.setdata(l:longint;var d);
begin
len:=l;
if l>sizeof(tderefdata) then
internalerror(200306068);
move(d,data,len);
end;
procedure tderef.build(s:tsymtableentry);
procedure addowner(s:tsymtableentry);
var
typ : tdereftype;
idx : word;
begin
if not assigned(s.owner) then
internalerror(200306063);
case s.owner.symtabletype of
globalsymtable :
begin
{ check if the unit is available in the uses
clause, else it's an error }
if s.owner.unitid=$ffff then
internalerror(200306063);
data[len]:=ord(derefunit);
typ:=derefunit;
idx:=s.owner.unitid;
end;
localsymtable :
begin
addowner(s.owner.defowner);
typ:=dereflocal;
idx:=s.owner.defowner.indexnr;
end;
parasymtable :
begin
addowner(s.owner.defowner);
typ:=derefpara;
idx:=s.owner.defowner.indexnr;
end;
objectsymtable,
recordsymtable :
begin
addowner(s.owner.defowner);
typ:=derefrecord;
idx:=s.owner.defowner.indexnr;
end;
else
internalerror(200306065);
end;
if len+3>sizeof(tderefdata) then
internalerror(200306062);
data[len]:=ord(typ);
data[len+1]:=idx shr 8;
data[len+2]:=idx and $ff;
inc(len,3);
end;
begin
len:=0;
if assigned(s) then
begin
case p.dereftype of
derefaktrecordindex :
begin
st:=aktrecordsymtable;
idx:=p.index;
end;
derefaktstaticindex :
begin
st:=aktstaticsymtable;
idx:=p.index;
end;
derefaktlocal :
begin
st:=aktlocalsymtable;
idx:=p.index;
end;
derefunit :
begin
pm:=current_module.map^[p.index];
if not assigned(pm) then
internalerror(200212273);
st:=pm.globalsymtable;
end;
derefrecord :
begin
pd:=tdef(st.getdefnr(p.index));
st:=pd.getsymtable(gs_record);
if not assigned(st) then
internalerror(200212274);
end;
dereflocal :
begin
pd:=tdef(st.getdefnr(p.index));
st:=pd.getsymtable(gs_local);
if not assigned(st) then
internalerror(200212275);
end;
derefpara :
begin
pd:=tdef(st.getdefnr(p.index));
st:=pd.getsymtable(gs_para);
if not assigned(st) then
internalerror(200212276);
end;
derefindex :
begin
idx:=p.index;
end;
else
internalerror(200212277);
end;
hp:=p;
p:=p.next;
hp.free;
{ symtableentry type }
if s is tsym then
data[len]:=1
else
data[len]:=2;
inc(len);
{ Static symtable of current unit ? }
if (s.owner.symtabletype=staticsymtable) and
(s.owner.unitid=0) then
begin
data[len]:=ord(derefaktstaticindex);
data[len+1]:=s.indexnr shr 8;
data[len+2]:=s.indexnr and $ff;
inc(len,3);
end
{ Global symtable of current unit ? }
else if (s.owner.symtabletype=globalsymtable) and
(s.owner.unitid=0) then
begin
data[len]:=ord(derefaktglobalindex);
data[len+1]:=s.indexnr shr 8;
data[len+2]:=s.indexnr and $ff;
inc(len,3);
end
{ Local record/object symtable ? }
else if (s.owner=aktrecordsymtable) then
begin
data[len]:=ord(derefaktrecordindex);
data[len+1]:=s.indexnr shr 8;
data[len+2]:=s.indexnr and $ff;
inc(len,3);
end
{ Local local/para symtable ? }
else if (s.owner=aktlocalsymtable) then
begin
data[len]:=ord(derefaktlocalindex);
data[len+1]:=s.indexnr shr 8;
data[len+2]:=s.indexnr and $ff;
inc(len,3);
end
else
begin
addowner(s);
data[len]:=ord(derefindex);
data[len+1]:=s.indexnr shr 8;
data[len+2]:=s.indexnr and $ff;
inc(len,3);
end;
end
else
begin
{ nil pointer }
data[len]:=0;
inc(len);
end;
end;
procedure resolvedef(var def:pointer);
function tderef.resolve:tsymtableentry;
var
st : tsymtable;
idx : word;
pd : tdef;
pm : tmodule;
typ : tdereftype;
st : tsymtable;
idx,
symidx : word;
issym : boolean;
i : longint;
begin
resolvederef(tderef(pointer(def)),st,idx);
result:=nil;
{ not initialized }
if len=0 then
internalerror(200306067);
st:=nil;
symidx:=0;
issym:=false;
i:=0;
case data[i] of
0 :
begin
{ nil pointer }
exit;
end;
1 :
begin
{ tsym }
issym:=true;
end;
2 :
begin
{ tdef }
end;
else
internalerror(200306066);
end;
inc(i);
while (i<len) do
begin
typ:=tdereftype(data[i]);
idx:=(data[i+1] shl 8) or data[i+2];
inc(i,3);
case typ of
derefaktrecordindex :
begin
st:=aktrecordsymtable;
symidx:=idx;
end;
derefaktstaticindex :
begin
st:=aktstaticsymtable;
symidx:=idx;
end;
derefaktglobalindex :
begin
st:=aktglobalsymtable;
symidx:=idx;
end;
derefaktlocalindex :
begin
st:=aktlocalsymtable;
symidx:=idx;
end;
derefunit :
begin
pm:=current_module.map^[idx];
if not assigned(pm) then
internalerror(200212273);
st:=pm.globalsymtable;
end;
derefrecord :
begin
if not assigned(st) then
internalerror(200306068);
pd:=tdef(st.getdefnr(idx));
st:=pd.getsymtable(gs_record);
if not assigned(st) then
internalerror(200212274);
end;
dereflocal :
begin
if not assigned(st) then
internalerror(200306069);
pd:=tdef(st.getdefnr(idx));
st:=pd.getsymtable(gs_local);
if not assigned(st) then
internalerror(200212275);
end;
derefpara :
begin
if not assigned(st) then
internalerror(2003060610);
pd:=tdef(st.getdefnr(idx));
st:=pd.getsymtable(gs_para);
if not assigned(st) then
internalerror(200212276);
end;
derefindex :
symidx:=idx;
else
internalerror(200212277);
end;
end;
if assigned(st) then
def:=tdef(st.getdefnr(idx))
else
def:=nil;
begin
if issym then
result:=st.getsymnr(symidx)
else
result:=st.getdefnr(symidx);
end;
end;
procedure resolvesym(var sym:pointer);
var
st : tsymtable;
idx : word;
begin
resolvederef(tderef(pointer(sym)),st,idx);
if assigned(st) then
sym:=tsym(st.getsymnr(idx))
else
sym:=nil;
end;
{$ifdef MEMDEBUG}
initialization
membrowser:=TMemDebug.create('BrowserRefs');
@ -578,7 +766,11 @@ finalization
end.
{
$Log$
Revision 1.24 2002-12-29 18:26:31 peter
Revision 1.25 2003-06-07 20:26:32 peter
* re-resolving added instead of reloading from ppu
* tderef object added to store deref info for resolving
Revision 1.24 2002/12/29 18:26:31 peter
* also use gettypename for procdef always
Revision 1.23 2002/12/29 14:57:50 peter