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

* fixed unitsym-globalsymtable relation so the uses of a unit

Browse Source 
is counted correctly
This commit is contained in:
peter 2003-10-22 15:22:33 +00:00
parent 37762b957f
commit fcabdbbf35
10 changed files with 165 additions and 233 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

99
compiler/fmodule.pas
View File

@ -42,7 +42,7 @@ interface
uses uses
cutils,cclasses, cutils,cclasses,
globals,finput, globals,finput,
symbase,aasmbase; symbase,symsym,aasmbase;
type type
@ -76,8 +76,11 @@ interface
tmodule = class; tmodule = class;
tused_unit = class; tused_unit = class;
tunitmap = array[0..maxunits-1] of tmodule; tunitmaprec = record
punitmap = ^tunitmap; u : tmodule;
unitsym : tunitsym;
end;
punitmap = ^tunitmaprec;
tmodule = class(tmodulebase) tmodule = class(tmodulebase)
do_reload, { force reloading of the unit } do_reload, { force reloading of the unit }
@ -93,7 +96,7 @@ interface
flags : cardinal; { the PPU flags } flags : cardinal; { the PPU flags }
islibrary : boolean; { if it is a library (win32 dll) } islibrary : boolean; { if it is a library (win32 dll) }
map : punitmap; { mapping of all used units } map : punitmap; { mapping of all used units }
unitcount : longint; { local unit counter } mapsize : longint; { number of units in the map }
globalsymtable, { pointer to the global symtable of this unit } globalsymtable, { pointer to the global symtable of this unit }
localsymtable : tsymtable;{ pointer to the local symtable of this unit } localsymtable : tsymtable;{ pointer to the local symtable of this unit }
scanner : pointer; { scanner object used } scanner : pointer; { scanner object used }
@ -130,8 +133,9 @@ interface
procedure reset;virtual; procedure reset;virtual;
procedure adddependency(callermodule:tmodule); procedure adddependency(callermodule:tmodule);
procedure flagdependent(callermodule:tmodule); procedure flagdependent(callermodule:tmodule);
function addusedunit(hp:tmodule;inuses:boolean):tused_unit; function addusedunit(hp:tmodule;inuses:boolean;usym:tunitsym):tused_unit;
procedure numberunits; procedure numberunits;
procedure allunitsused;
procedure setmodulename(const s:string); procedure setmodulename(const s:string);
end; end;
@ -143,7 +147,8 @@ interface
in_interface, in_interface,
is_stab_written : boolean; is_stab_written : boolean;
u : tmodule; u : tmodule;
constructor create(_u : tmodule;intface,inuses:boolean); unitsym : tunitsym;
constructor create(_u : tmodule;intface,inuses:boolean;usym:tunitsym);
end; end;
tdependent_unit = class(tlinkedlistitem) tdependent_unit = class(tlinkedlistitem)
@ -302,13 +307,14 @@ implementation
TUSED_UNIT TUSED_UNIT
****************************************************************************} ****************************************************************************}
constructor tused_unit.create(_u : tmodule;intface,inuses:boolean); constructor tused_unit.create(_u : tmodule;intface,inuses:boolean;usym:tunitsym);
begin begin
u:=_u; u:=_u;
in_interface:=intface; in_interface:=intface;
in_uses:=inuses; in_uses:=inuses;
is_stab_written:=false; is_stab_written:=false;
unitid:=0; unitid:=0;
unitsym:=usym;
if _u.state=ms_compiled then if _u.state=ms_compiled then
begin begin
checksum:=u.crc; checksum:=u.crc;
@ -373,12 +379,12 @@ implementation
interface_crc:=0; interface_crc:=0;
flags:=0; flags:=0;
scanner:=nil; scanner:=nil;
new(map); map:=nil;
mapsize:=0;
globalsymtable:=nil; globalsymtable:=nil;
localsymtable:=nil; localsymtable:=nil;
loaded_from:=LoadedFrom; loaded_from:=LoadedFrom;
do_reload:=false; do_reload:=false;
unitcount:=1;
do_compile:=false; do_compile:=false;
sources_avail:=true; sources_avail:=true;
recompile_reason:=rr_unknown; recompile_reason:=rr_unknown;
@ -509,7 +515,12 @@ implementation
localsymtable.free; localsymtable.free;
localsymtable:=nil; localsymtable:=nil;
end; end;
fillchar(map^,sizeof(tunitmap),#0); if assigned(map) then
begin
freemem(map);
map:=nil;
end;
mapsize:=0;
sourcefiles.free; sourcefiles.free;
sourcefiles:=tinputfilemanager.create; sourcefiles:=tinputfilemanager.create;
librarydata.free; librarydata.free;
@ -546,7 +557,6 @@ implementation
crc:=0; crc:=0;
interface_crc:=0; interface_crc:=0;
flags:=0; flags:=0;
unitcount:=1;
recompile_reason:=rr_unknown; recompile_reason:=rr_unknown;
{ {
The following fields should not The following fields should not
@ -596,11 +606,11 @@ implementation
end; end;
function tmodule.addusedunit(hp:tmodule;inuses:boolean):tused_unit; function tmodule.addusedunit(hp:tmodule;inuses:boolean;usym:tunitsym):tused_unit;
var var
pu : tused_unit; pu : tused_unit;
begin begin
pu:=tused_unit.create(hp,in_interface,inuses); pu:=tused_unit.create(hp,in_interface,inuses,usym);
used_units.concat(pu); used_units.concat(pu);
addusedunit:=pu; addusedunit:=pu;
end; end;
@ -608,33 +618,54 @@ implementation
procedure tmodule.numberunits; procedure tmodule.numberunits;
var var
counter : word; pu : tused_unit;
hp : tused_unit; hp : tmodule;
hp1 : tmodule; i : integer;
begin begin
{ Reset all numbers to -1 } { Reset all numbers to -1 }
hp1:=tmodule(loaded_units.first); hp:=tmodule(loaded_units.first);
while assigned(hp1) do while assigned(hp) do
begin begin
if assigned(hp1.globalsymtable) then if assigned(hp.globalsymtable) then
hp1.globalsymtable.unitid:=$ffff; hp.globalsymtable.unitid:=$ffff;
hp1:=tmodule(hp1.next); hp:=tmodule(hp.next);
end; end;
{ Allocate map }
mapsize:=used_units.count+1;
reallocmem(map,mapsize*sizeof(tunitmaprec));
{ Our own symtable gets unitid 0, for a program there is { Our own symtable gets unitid 0, for a program there is
no globalsymtable } no globalsymtable }
if assigned(globalsymtable) then if assigned(globalsymtable) then
globalsymtable.unitid:=0; globalsymtable.unitid:=0;
map^[0]:=self; map[0].u:=self;
map[0].unitsym:=nil;
{ number units and map } { number units and map }
counter:=1; i:=1;
hp:=tused_unit(used_units.first); pu:=tused_unit(used_units.first);
while assigned(hp) do while assigned(pu) do
begin begin
tsymtable(hp.u.globalsymtable).unitid:=counter; if assigned(pu.u.globalsymtable) then
map^[counter]:=hp.u; begin
inc(counter); tsymtable(pu.u.globalsymtable).unitid:=i;
hp:=tused_unit(hp.next); map[i].u:=pu.u;
end; map[i].unitsym:=pu.unitsym;
inc(i);
end;
pu:=tused_unit(pu.next);
end;
end;
procedure tmodule.allunitsused;
var
i : longint;
begin
for i:=0 to mapsize-1 do
begin
if assigned(map[i].unitsym) and
(map[i].unitsym.refs=0) then
MessagePos2(map[i].unitsym.fileinfo,sym_n_unit_not_used,map[i].u.modulename^,modulename^);
end;
end; end;
@ -652,7 +683,11 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.38 2003-10-01 20:34:48 peter Revision 1.39 2003-10-22 15:22:33 peter
* fixed unitsym-globalsymtable relation so the uses of a unit
is counted correctly
Revision 1.38 2003/10/01 20:34:48 peter
* procinfo unit contains tprocinfo * procinfo unit contains tprocinfo
* cginfo renamed to cgbase * cginfo renamed to cgbase
* moved cgmessage to verbose * moved cgmessage to verbose

37
compiler/fppu.pas
View File

@ -692,7 +692,7 @@ uses
{ set the state of this unit before registering, this is { set the state of this unit before registering, this is
needed for a correct circular dependency check } needed for a correct circular dependency check }
hp:=registerunit(self,hs,''); hp:=registerunit(self,hs,'');
pu:=addusedunit(hp,false); pu:=addusedunit(hp,false,nil);
pu.checksum:=checksum; pu.checksum:=checksum;
pu.interface_checksum:=intfchecksum; pu.interface_checksum:=intfchecksum;
end; end;
@ -834,7 +834,7 @@ uses
procedure tppumodule.load_symtable_refs; procedure tppumodule.load_symtable_refs;
var var
b : byte; b : byte;
unitindex : word; i : longint;
begin begin
{ load local symtable first } { load local symtable first }
if ((flags and uf_local_browser)<>0) then if ((flags and uf_local_browser)<>0) then
@ -847,13 +847,8 @@ uses
if (flags and uf_has_browser)<>0 then if (flags and uf_has_browser)<>0 then
begin begin
tstoredsymtable(globalsymtable).load_references(ppufile,true); tstoredsymtable(globalsymtable).load_references(ppufile,true);
unitindex:=1; for i:=0 to mapsize-1 do
while assigned(map^[unitindex]) do tstoredsymtable(globalsymtable).load_references(ppufile,false);
begin
{ each unit wrote one browser entry }
tstoredsymtable(globalsymtable).load_references(ppufile,false);
inc(unitindex);
end;
b:=ppufile.readentry; b:=ppufile.readentry;
if b<>ibendbrowser then if b<>ibendbrowser then
Message1(unit_f_ppu_invalid_entry,tostr(b)); Message1(unit_f_ppu_invalid_entry,tostr(b));
@ -1046,14 +1041,10 @@ uses
var var
pu : tused_unit; pu : tused_unit;
load_refs : boolean; load_refs : boolean;
nextmapentry : longint;
begin begin
if current_module<>self then if current_module<>self then
internalerror(200212284); internalerror(200212284);
load_refs:=true; load_refs:=true;
{ Add current unit to the map }
map^[0]:=self;
nextmapentry:=1;
{ load the used units from interface } { load the used units from interface }
in_interface:=true; in_interface:=true;
pu:=tused_unit(used_units.first); pu:=tused_unit(used_units.first);
@ -1081,14 +1072,10 @@ uses
do_compile:=true; do_compile:=true;
exit; exit;
end; end;
{ setup the map entry for deref }
map^[nextmapentry]:=pu.u;
inc(nextmapentry);
if nextmapentry>maxunits then
Message(unit_f_too_much_units);
end; end;
pu:=tused_unit(pu.next); pu:=tused_unit(pu.next);
end; end;
numberunits;
{ 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
@ -1118,14 +1105,10 @@ uses
do_compile:=true; do_compile:=true;
exit; exit;
end; end;
{ setup the map entry for deref }
map^[nextmapentry]:=pu.u;
inc(nextmapentry);
if nextmapentry>maxunits then
Message(unit_f_too_much_units);
end; end;
pu:=tused_unit(pu.next); pu:=tused_unit(pu.next);
end; end;
numberunits;
{ read the implementation/objectdata part } { read the implementation/objectdata part }
load_implementation; load_implementation;
@ -1326,7 +1309,7 @@ uses
if second_time then if second_time then
reload_flagged_units reload_flagged_units
else else
usedunits.concat(tused_unit.create(self,true,false)); usedunits.concat(tused_unit.create(self,true,false,nil));
{ reopen the old module } { reopen the old module }
{$ifdef SHORT_ON_FILE_HANDLES} {$ifdef SHORT_ON_FILE_HANDLES}
@ -1421,7 +1404,11 @@ uses
end. end.
{ {
$Log$ $Log$
Revision 1.39 2003-09-05 17:41:12 florian Revision 1.40 2003-10-22 15:22:33 peter
* fixed unitsym-globalsymtable relation so the uses of a unit
is counted correctly
Revision 1.39 2003/09/05 17:41:12 florian
* merged Wiktor's Watcom patches in 1.1 * merged Wiktor's Watcom patches in 1.1
Revision 1.38 2003/08/23 22:29:24 peter Revision 1.38 2003/08/23 22:29:24 peter

10
compiler/gdb.pas
View File

@ -32,8 +32,8 @@ uses
{$else} {$else}
strings, strings,
{$endif} {$endif}
globtype,cpubase, globtype,
globals,aasmtai; aasmtai;
{stab constants } {stab constants }
Const Const
@ -233,7 +233,11 @@ end.
{ {
$Log$ $Log$
Revision 1.16 2002-11-17 16:31:56 carl Revision 1.17 2003-10-22 15:22:33 peter
* fixed unitsym-globalsymtable relation so the uses of a unit
is counted correctly
Revision 1.16 2002/11/17 16:31:56 carl
* memory optimization (3-4%) : cleanup of tai fields, * memory optimization (3-4%) : cleanup of tai fields,
cleanup of tdef and tsym fields. cleanup of tdef and tsym fields.
* make it work for m68k * make it work for m68k

12
compiler/globals.pas
View File

@ -79,8 +79,6 @@ interface
maxparasize = high(word); maxparasize = high(word);
{ maximum nesting of routines } { maximum nesting of routines }
maxnesting = 32; maxnesting = 32;
{ maximum of units which are supported for a compilation }
maxunits = 1024;
treelogfilename = 'tree.log'; treelogfilename = 'tree.log';
@ -238,7 +236,7 @@ interface
RelocSection : boolean = true; RelocSection : boolean = true;
RelocSectionSetExplicitly : boolean = false; RelocSectionSetExplicitly : boolean = false;
LinkTypeSetExplicitly : boolean = false; LinkTypeSetExplicitly : boolean = false;
DLLsource : boolean = false; DLLsource : boolean = false;
DLLImageBase : pstring = nil; DLLImageBase : pstring = nil;
UseDeffileForExport : boolean = true; UseDeffileForExport : boolean = true;
@ -1616,7 +1614,7 @@ implementation
{ Utils directory } { Utils directory }
utilsdirectory:=''; utilsdirectory:='';
utilsprefix:=''; utilsprefix:='';
{ Search Paths } { Search Paths }
librarysearchpath:=TSearchPathList.Create; librarysearchpath:=TSearchPathList.Create;
@ -1712,7 +1710,11 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.109 2003-10-11 19:32:04 marco Revision 1.110 2003-10-22 15:22:33 peter
* fixed unitsym-globalsymtable relation so the uses of a unit
is counted correctly
Revision 1.109 2003/10/11 19:32:04 marco
* -Xd * -Xd
Revision 1.108 2003/10/08 14:10:16 mazen Revision 1.108 2003/10/08 14:10:16 mazen

9
compiler/pdecobj.pas
View File

@ -833,9 +833,8 @@ implementation
begin begin
hp:=nil; hp:=nil;
{ reads the parent class } { reads the parent class }
if token=_LKLAMMER then if try_to_consume(_LKLAMMER) then
begin begin
consume(_LKLAMMER);
id_type(tt,pattern,false); id_type(tt,pattern,false);
childof:=tobjectdef(tt.def); childof:=tobjectdef(tt.def);
if (not assigned(childof)) or if (not assigned(childof)) or
@ -1158,7 +1157,11 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.70 2003-10-21 18:16:13 peter Revision 1.71 2003-10-22 15:22:33 peter
* fixed unitsym-globalsymtable relation so the uses of a unit
is counted correctly
Revision 1.70 2003/10/21 18:16:13 peter
* IncompatibleTypes() added that will include unit names when * IncompatibleTypes() added that will include unit names when
the typenames are the same the typenames are the same

96
compiler/pmodules.pas
View File

@ -408,7 +408,6 @@ implementation
hp:=registerunit(current_module,s,''); hp:=registerunit(current_module,s,'');
hp.loadppu; hp.loadppu;
hp.adddependency(current_module); hp.adddependency(current_module);
current_module.addusedunit(hp,false);
{ add to symtable stack } { add to symtable stack }
tsymtable(hp.globalsymtable).next:=symtablestack; tsymtable(hp.globalsymtable).next:=symtablestack;
symtablestack:=hp.globalsymtable; symtablestack:=hp.globalsymtable;
@ -416,6 +415,8 @@ implementation
unitsym:=tunitsym.create(s,hp.globalsymtable); unitsym:=tunitsym.create(s,hp.globalsymtable);
inc(unitsym.refs); inc(unitsym.refs);
refsymtable.insert(unitsym); refsymtable.insert(unitsym);
{ add to used units }
current_module.addusedunit(hp,false,unitsym);
end; end;
begin begin
@ -511,8 +512,13 @@ implementation
{ Need to register the unit? } { Need to register the unit? }
if not assigned(hp2) then if not assigned(hp2) then
hp2:=registerunit(current_module,sorg,fn); hp2:=registerunit(current_module,sorg,fn);
{ Create unitsym, we need to use the name as specified, we
can not use the modulename because that can be different
when -Un is used }
unitsym:=tunitsym.create(sorg,nil);
refsymtable.insert(unitsym);
{ the current module uses the unit hp2 } { the current module uses the unit hp2 }
current_module.addusedunit(hp2,true); current_module.addusedunit(hp2,true,unitsym);
end end
else else
Message1(sym_e_duplicate_id,s); Message1(sym_e_duplicate_id,s);
@ -530,29 +536,27 @@ implementation
pu:=tused_unit(current_module.used_units.first); pu:=tused_unit(current_module.used_units.first);
while assigned(pu) do while assigned(pu) do
begin begin
if pu.in_uses then { Only load the units that are in the current
(interface/implementation) uses clause }
if pu.in_uses and
(pu.in_interface=current_module.in_interface) then
begin begin
{ store the original name to create the unitsym }
sorg:=pu.u.realmodulename^;
tppumodule(pu.u).loadppu; tppumodule(pu.u).loadppu;
{ is our module compiled? then we can stop } { is our module compiled? then we can stop }
if current_module.state=ms_compiled then if current_module.state=ms_compiled then
exit; exit;
{ add this unit to the dependencies } { add this unit to the dependencies }
pu.u.adddependency(current_module); pu.u.adddependency(current_module);
{ save crc values }
pu.checksum:=pu.u.crc; pu.checksum:=pu.u.crc;
pu.interface_checksum:=pu.u.interface_crc; pu.interface_checksum:=pu.u.interface_crc;
{ Create unitsym, we need to use the name as specified, we { connect unitsym to the globalsymtable of the unit }
can not use the modulename because that can be different pu.unitsym.unitsymtable:=pu.u.globalsymtable;
when -Un is used. But when the names are the same then { increase refs of the unitsym when the unit contains
force the name of the module so there will be no difference initialization/finalization code so it doesn't trigger
in the case of the name } the unit not used hint }
if upper(sorg)=pu.u.modulename^ then
sorg:=pu.u.realmodulename^;
unitsym:=tunitsym.create(sorg,pu.u.globalsymtable);
if (pu.u.flags and (uf_init or uf_finalize))<>0 then if (pu.u.flags and (uf_init or uf_finalize))<>0 then
inc(unitsym.refs); inc(pu.unitsym.refs);
refsymtable.insert(unitsym);
end; end;
pu:=tused_unit(pu.next); pu:=tused_unit(pu.next);
end; end;
@ -654,7 +658,7 @@ implementation
{$EndIf GDB} {$EndIf GDB}
procedure parse_implementation_uses(symt:tsymtable); procedure parse_implementation_uses;
begin begin
if token=_USES then if token=_USES then
begin begin
@ -749,7 +753,7 @@ implementation
end; end;
procedure gen_implicit_initfinal(list:taasmoutput;flag:word;st:tsymtable); procedure gen_implicit_initfinal(flag:word;st:tsymtable);
var var
pd : tprocdef; pd : tprocdef;
begin begin
@ -802,7 +806,6 @@ implementation
store_crc,store_interface_crc : cardinal; store_crc,store_interface_crc : cardinal;
s2 : ^string; {Saves stack space} s2 : ^string; {Saves stack space}
force_init_final : boolean; force_init_final : boolean;
initfinalcode : taasmoutput;
pd : tprocdef; pd : tprocdef;
begin begin
consume(_UNIT); consume(_UNIT);
@ -879,13 +882,7 @@ implementation
loadunits; loadunits;
{ has it been compiled at a higher level ?} { has it been compiled at a higher level ?}
if current_module.state=ms_compiled then if current_module.state=ms_compiled then
begin exit;
{ this unit symtable is obsolete }
{ dispose(unitst,done);
disposed as localsymtable !! }
RestoreUnitSyms;
exit;
end;
end; end;
{ ... but insert the symbol table later } { ... but insert the symbol table later }
st.next:=symtablestack; st.next:=symtablestack;
@ -956,13 +953,10 @@ implementation
refsymtable:=st; refsymtable:=st;
{ Read the implementation units } { Read the implementation units }
parse_implementation_uses(unitst); parse_implementation_uses;
if current_module.state=ms_compiled then if current_module.state=ms_compiled then
begin exit;
RestoreUnitSyms;
exit;
end;
{ reset ranges/stabs in exported definitions } { reset ranges/stabs in exported definitions }
reset_global_defs; reset_global_defs;
@ -1015,12 +1009,7 @@ implementation
{ should we force unit initialization? } { should we force unit initialization? }
{ this is a hack, but how can it be done better ? } { this is a hack, but how can it be done better ? }
if force_init_final and ((current_module.flags and uf_init)=0) then if force_init_final and ((current_module.flags and uf_init)=0) then
begin gen_implicit_initfinal(uf_init,st);
initfinalcode:=taasmoutput.create;
gen_implicit_initfinal(initfinalcode,uf_init,st);
codesegment.concatlist(initfinalcode);
initfinalcode.free;
end;
{ finalize? } { finalize? }
if token=_FINALIZATION then if token=_FINALIZATION then
begin begin
@ -1036,12 +1025,7 @@ implementation
release_main_proc(pd); release_main_proc(pd);
end end
else if force_init_final then else if force_init_final then
begin gen_implicit_initfinal(uf_finalize,st);
initfinalcode:=taasmoutput.create;
gen_implicit_initfinal(initfinalcode,uf_finalize,st);
codesegment.concatlist(initfinalcode);
initfinalcode.free;
end;
{ the last char should always be a point } { the last char should always be a point }
consume(_POINT); consume(_POINT);
@ -1059,17 +1043,14 @@ implementation
ResourceStrings.WriteResourceFile(ForceExtension(current_module.ppufilename^,'.rst')); ResourceStrings.WriteResourceFile(ForceExtension(current_module.ppufilename^,'.rst'));
end; end;
{ test static symtable }
if (Errorcount=0) then if (Errorcount=0) then
begin begin
{ test static symtable }
tstoredsymtable(st).allsymbolsused; tstoredsymtable(st).allsymbolsused;
tstoredsymtable(st).allunitsused;
tstoredsymtable(st).allprivatesused; tstoredsymtable(st).allprivatesused;
current_module.allunitsused;
end; end;
{ size of the static data }
// datasize:=st.datasize;
{$ifdef GDB} {$ifdef GDB}
{ add all used definitions even for implementation} { add all used definitions even for implementation}
if (cs_debuginfo in aktmoduleswitches) then if (cs_debuginfo in aktmoduleswitches) then
@ -1169,8 +1150,6 @@ implementation
current_module.localsymtable:=nil; current_module.localsymtable:=nil;
end; end;
RestoreUnitSyms;
{ leave when we got an error } { leave when we got an error }
if (Errorcount>0) and not status.skip_error then if (Errorcount>0) and not status.skip_error then
begin begin
@ -1188,7 +1167,6 @@ implementation
main_file: tinputfile; main_file: tinputfile;
st : tsymtable; st : tsymtable;
hp : tmodule; hp : tmodule;
initfinalcode : taasmoutput;
pd : tprocdef; pd : tprocdef;
begin begin
DLLsource:=islibrary; DLLsource:=islibrary;
@ -1317,14 +1295,10 @@ implementation
{ should we force unit initialization? } { should we force unit initialization? }
if tstaticsymtable(current_module.localsymtable).needs_init_final then if tstaticsymtable(current_module.localsymtable).needs_init_final then
begin begin
initfinalcode:=taasmoutput.create;
{ initialize section } { initialize section }
gen_implicit_initfinal(initfinalcode,uf_init,st); gen_implicit_initfinal(uf_init,st);
codesegment.concatlist(initfinalcode);
{ finalize section } { finalize section }
gen_implicit_initfinal(initfinalcode,uf_finalize,st); gen_implicit_initfinal(uf_finalize,st);
codesegment.concatlist(initfinalcode);
initfinalcode.free;
end; end;
{ Add symbol to the exports section for win32 so smartlinking a { Add symbol to the exports section for win32 so smartlinking a
@ -1371,12 +1345,12 @@ implementation
exit; exit;
end; end;
{ test static symtable }
if (Errorcount=0) then if (Errorcount=0) then
begin begin
{ test static symtable }
tstoredsymtable(st).allsymbolsused; tstoredsymtable(st).allsymbolsused;
tstoredsymtable(st).allunitsused;
tstoredsymtable(st).allprivatesused; tstoredsymtable(st).allprivatesused;
current_module.allunitsused;
end; end;
{ generate a list of threadvars } { generate a list of threadvars }
@ -1444,7 +1418,11 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.129 2003-10-21 15:14:33 peter Revision 1.130 2003-10-22 15:22:33 peter
* fixed unitsym-globalsymtable relation so the uses of a unit
is counted correctly
Revision 1.129 2003/10/21 15:14:33 peter
* fixed memleak for initfinalcode * fixed memleak for initfinalcode
* exit from generatecode when there are already errors * exit from generatecode when there are already errors

8
compiler/symnot.pas
View File

@ -28,7 +28,7 @@ unit symnot;
interface interface
uses cclasses,symbase,symtype; uses cclasses,symtype;
type Tnotification_flag=(vn_onread,vn_onwrite,vn_unknown); type Tnotification_flag=(vn_onread,vn_onwrite,vn_unknown);
Tnotification_flags=set of Tnotification_flag; Tnotification_flags=set of Tnotification_flag;
@ -65,7 +65,11 @@ end.
{ {
$Log$ $Log$
Revision 1.2 2002-12-31 09:55:58 daniel Revision 1.3 2003-10-22 15:22:33 peter
* fixed unitsym-globalsymtable relation so the uses of a unit
is counted correctly
Revision 1.2 2002/12/31 09:55:58 daniel
+ Notification implementation complete + Notification implementation complete
+ Add for loop code optimization using notifications + Add for loop code optimization using notifications
results in 1.5-1.9% speed improvement in nestloop benchmark results in 1.5-1.9% speed improvement in nestloop benchmark

46
compiler/symsym.pas
View File

@ -89,12 +89,10 @@ interface
tunitsym = class(tstoredsym) tunitsym = class(tstoredsym)
unitsymtable : tsymtable; unitsymtable : tsymtable;
prevsym : tunitsym;
constructor create(const n : string;ref : tsymtable); constructor create(const n : string;ref : tsymtable);
constructor ppuload(ppufile:tcompilerppufile); constructor ppuload(ppufile:tcompilerppufile);
destructor destroy;override; destructor destroy;override;
procedure ppuwrite(ppufile:tcompilerppufile);override; procedure ppuwrite(ppufile:tcompilerppufile);override;
procedure restoreunitsym;
{$ifdef GDB} {$ifdef GDB}
procedure concatstabto(asmlist : taasmoutput);override; procedure concatstabto(asmlist : taasmoutput);override;
{$endif GDB} {$endif GDB}
@ -681,12 +679,6 @@ implementation
make_ref:=old_make_ref; make_ref:=old_make_ref;
typ:=unitsym; typ:=unitsym;
unitsymtable:=ref; unitsymtable:=ref;
if assigned(ref) and
(ref.symtabletype=globalsymtable) then
begin
prevsym:=tglobalsymtable(ref).unitsym;
tglobalsymtable(ref).unitsym:=self;
end;
end; end;
constructor tunitsym.ppuload(ppufile:tcompilerppufile); constructor tunitsym.ppuload(ppufile:tcompilerppufile);
@ -695,43 +687,11 @@ implementation
inherited loadsym(ppufile); inherited loadsym(ppufile);
typ:=unitsym; typ:=unitsym;
unitsymtable:=nil; unitsymtable:=nil;
prevsym:=nil;
refs:=0; refs:=0;
end; end;
{ we need to remove it from the prevsym chain ! }
procedure tunitsym.restoreunitsym;
var pus,ppus : tunitsym;
begin
if assigned(unitsymtable) and
(unitsymtable.symtabletype=globalsymtable) then
begin
ppus:=nil;
pus:=tglobalsymtable(unitsymtable).unitsym;
if pus=self then
tglobalsymtable(unitsymtable).unitsym:=prevsym
else while assigned(pus) do
begin
if pus=self then
begin
ppus.prevsym:=prevsym;
break;
end
else
begin
ppus:=pus;
pus:=ppus.prevsym;
end;
end;
end;
unitsymtable:=nil;
prevsym:=nil;
end;
destructor tunitsym.destroy; destructor tunitsym.destroy;
begin begin
restoreunitsym;
inherited destroy; inherited destroy;
end; end;
@ -2645,7 +2605,11 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.128 2003-10-21 18:14:30 peter Revision 1.129 2003-10-22 15:22:33 peter
* fixed unitsym-globalsymtable relation so the uses of a unit
is counted correctly
Revision 1.128 2003/10/21 18:14:30 peter
* fix writing of widechar to ppu * fix writing of widechar to ppu
Revision 1.127 2003/10/17 14:38:32 peter Revision 1.127 2003/10/17 14:38:32 peter

71
compiler/symtable.pas
View File

@ -50,7 +50,6 @@ interface
procedure _needs_init_final(p : tnamedindexitem;arg:pointer); procedure _needs_init_final(p : tnamedindexitem;arg:pointer);
procedure check_forward(sym : TNamedIndexItem;arg:pointer); procedure check_forward(sym : TNamedIndexItem;arg:pointer);
procedure labeldefined(p : TNamedIndexItem;arg:pointer); procedure labeldefined(p : TNamedIndexItem;arg:pointer);
procedure unitsymbolused(p : TNamedIndexItem;arg:pointer);
procedure varsymbolused(p : TNamedIndexItem;arg:pointer); procedure varsymbolused(p : TNamedIndexItem;arg:pointer);
procedure TestPrivate(p : TNamedIndexItem;arg:pointer); procedure TestPrivate(p : TNamedIndexItem;arg:pointer);
procedure objectprivatesymbolused(p : TNamedIndexItem;arg:pointer); procedure objectprivatesymbolused(p : TNamedIndexItem;arg:pointer);
@ -77,7 +76,6 @@ interface
function speedsearch(const s : stringid;speedvalue : cardinal) : tsymentry;override; function speedsearch(const s : stringid;speedvalue : cardinal) : tsymentry;override;
procedure allsymbolsused; procedure allsymbolsused;
procedure allprivatesused; procedure allprivatesused;
procedure allunitsused;
procedure check_forwards; procedure check_forwards;
procedure checklabels; procedure checklabels;
function needs_init_final : boolean; function needs_init_final : boolean;
@ -147,10 +145,8 @@ interface
tglobalsymtable = class(tabstractunitsymtable) tglobalsymtable = class(tabstractunitsymtable)
public public
unitsym : tunitsym;
unittypecount : word; unittypecount : word;
constructor create(const n : string); constructor create(const n : string);
destructor destroy;override;
procedure ppuload(ppufile:tcompilerppufile);override; procedure ppuload(ppufile:tcompilerppufile);override;
procedure ppuwrite(ppufile:tcompilerppufile);override; procedure ppuwrite(ppufile:tcompilerppufile);override;
procedure load_references(ppufile:tcompilerppufile;locals:boolean);override; procedure load_references(ppufile:tcompilerppufile;locals:boolean);override;
@ -214,7 +210,6 @@ interface
function search_default_property(pd : tobjectdef) : tpropertysym; function search_default_property(pd : tobjectdef) : tpropertysym;
{*** symtable stack ***} {*** symtable stack ***}
procedure RestoreUnitSyms;
{$ifdef DEBUG} {$ifdef DEBUG}
procedure test_symtablestack; procedure test_symtablestack;
procedure list_symtablestack; procedure list_symtablestack;
@ -592,8 +587,10 @@ implementation
{ unit uses count } { unit uses count }
if (unitid<>0) and if (unitid<>0) and
(symtabletype = globalsymtable) and (symtabletype = globalsymtable) and
assigned(tglobalsymtable(self).unitsym) then assigned(current_module) and
inc(tglobalsymtable(self).unitsym.refs); (unitid<current_module.mapsize) and
assigned(current_module.map[unitid].unitsym) then
inc(current_module.map[unitid].unitsym.refs);
{$ifdef GDB} {$ifdef GDB}
{ if it is a type, we need the stabs of this type { if it is a type, we need the stabs of this type
@ -677,17 +674,6 @@ implementation
end; end;
procedure TStoredSymtable.unitsymbolused(p : TNamedIndexItem;arg:pointer);
begin
if (tsym(p).typ=unitsym) and
(tunitsym(p).refs=0) and
{ do not claim for unit name itself !! }
assigned(tunitsym(p).unitsymtable) and
(tunitsym(p).unitsymtable.symtabletype=globalsymtable) then
MessagePos2(tsym(p).fileinfo,sym_n_unit_not_used,p.name,current_module.modulename^);
end;
procedure TStoredSymtable.varsymbolused(p : TNamedIndexItem;arg:pointer); procedure TStoredSymtable.varsymbolused(p : TNamedIndexItem;arg:pointer);
begin begin
if (tsym(p).typ=varsym) and if (tsym(p).typ=varsym) and
@ -891,12 +877,6 @@ implementation
end; end;
procedure tstoredsymtable.allunitsused;
begin
foreach({$ifdef FPCPROCVAR}@{$endif}unitsymbolused,nil);
end;
procedure tstoredsymtable.allsymbolsused; procedure tstoredsymtable.allsymbolsused;
begin begin
foreach({$ifdef FPCPROCVAR}@{$endif}varsymbolused,nil); foreach({$ifdef FPCPROCVAR}@{$endif}varsymbolused,nil);
@ -1338,12 +1318,12 @@ implementation
exit; exit;
if not assigned(name) then if not assigned(name) then
name := stringdup('Main_program'); name := stringdup('Main_program');
if (symtabletype = globalsymtable) and {if (symtabletype = globalsymtable) and
(current_module.globalsymtable<>self) then (current_module.globalsymtable<>self) then
begin begin
unitid:=current_module.unitcount; unitid:=current_module.unitcount;
inc(current_module.unitcount); inc(current_module.unitcount);
end; end;}
asmList.concat(tai_comment.Create(strpnew('Begin unit '+name^+' has index '+tostr(unitid)))); asmList.concat(tai_comment.Create(strpnew('Begin unit '+name^+' has index '+tostr(unitid))));
if cs_gdb_dbx in aktglobalswitches then if cs_gdb_dbx in aktglobalswitches then
begin begin
@ -1479,7 +1459,6 @@ implementation
symtabletype:=globalsymtable; symtabletype:=globalsymtable;
symtablelevel:=main_program_level; symtablelevel:=main_program_level;
unitid:=0; unitid:=0;
unitsym:=nil;
{$ifdef GDB} {$ifdef GDB}
if cs_gdb_dbx in aktglobalswitches then if cs_gdb_dbx in aktglobalswitches then
begin begin
@ -1500,22 +1479,6 @@ implementation
end; end;
destructor tglobalsymtable.destroy;
var
pus : tunitsym;
begin
pus:=unitsym;
while assigned(pus) do
begin
unitsym:=pus.prevsym;
pus.prevsym:=nil;
pus.unitsymtable:=nil;
pus:=unitsym;
end;
inherited destroy;
end;
procedure tglobalsymtable.ppuload(ppufile:tcompilerppufile); procedure tglobalsymtable.ppuload(ppufile:tcompilerppufile);
{$ifdef GDB} {$ifdef GDB}
var var
@ -2215,22 +2178,6 @@ implementation
Symtable Stack Symtable Stack
****************************************************************************} ****************************************************************************}
procedure RestoreUnitSyms;
var
p : tsymtable;
begin
p:=symtablestack;
while assigned(p) do
begin
if (p.symtabletype=globalsymtable) and
assigned(tglobalsymtable(p).unitsym) and
((tglobalsymtable(p).unitsym.owner=current_module.globalsymtable) or
(tglobalsymtable(p).unitsym.owner=current_module.localsymtable)) then
tglobalsymtable(p).unitsym.restoreunitsym;
p:=p.next;
end;
end;
{$ifdef DEBUG} {$ifdef DEBUG}
procedure test_symtablestack; procedure test_symtablestack;
var var
@ -2312,7 +2259,11 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.117 2003-10-21 18:16:13 peter Revision 1.118 2003-10-22 15:22:33 peter
* fixed unitsym-globalsymtable relation so the uses of a unit
is counted correctly
Revision 1.117 2003/10/21 18:16:13 peter
* IncompatibleTypes() added that will include unit names when * IncompatibleTypes() added that will include unit names when
the typenames are the same the typenames are the same

10
compiler/symtype.pas
View File

@ -772,9 +772,9 @@ implementation
begin begin
idx:=(data[i] shl 8) or data[i+1]; idx:=(data[i] shl 8) or data[i+1];
inc(i,2); inc(i,2);
if idx>maxunits then if idx>current_module.mapsize then
internalerror(200306231); internalerror(200306231);
pm:=current_module.map^[idx]; pm:=current_module.map[idx].u;
if not assigned(pm) then if not assigned(pm) then
internalerror(200212273); internalerror(200212273);
st:=pm.globalsymtable; st:=pm.globalsymtable;
@ -862,7 +862,11 @@ finalization
end. end.
{ {
$Log$ $Log$
Revision 1.29 2003-10-17 14:38:32 peter Revision 1.30 2003-10-22 15:22:33 peter
* fixed unitsym-globalsymtable relation so the uses of a unit
is counted correctly
Revision 1.29 2003/10/17 14:38:32 peter
* 64k registers supported * 64k registers supported
* fixed some memory leaks * fixed some memory leaks