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

+ usedasmsymbollist to check and reset only the used symbols (merged)

Browse Source
This commit is contained in:
peter 2000-08-12 15:34:21 +00:00
parent 2c58f511b0
commit cdbe6a1fa3
6 changed files with 321 additions and 164 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

143
compiler/aasm.pas
View File

@ -101,10 +101,9 @@ unit aasm;
pasmsymbol = ^tasmsymbol; pasmsymbol = ^tasmsymbol;
tasmsymbol = object(tnamedindexobject) tasmsymbol = object(tnamedindexobject)
orgbind, defbind,
bind : TAsmsymbind; bind : TAsmsymbind;
typ : TAsmsymtype; typ : TAsmsymtype;
proclocal : boolean;
{ the next fields are filled in the binary writer } { the next fields are filled in the binary writer }
section : tsection; section : tsection;
idx : longint; idx : longint;
@ -116,10 +115,13 @@ unit aasm;
{ alternate symbol which can be used for 'renaming' needed for { alternate symbol which can be used for 'renaming' needed for
inlining } inlining }
altsymbol : pasmsymbol; altsymbol : pasmsymbol;
{ is the symbol local for a procedure/function }
proclocal : boolean;
{ is the symbol in the used list }
inusedlist : boolean;
constructor init(const s:string;_bind:TAsmsymbind;_typ:Tasmsymtype); constructor init(const s:string;_bind:TAsmsymbind;_typ:Tasmsymtype);
procedure reset; procedure reset;
function is_used:boolean; function is_used:boolean;
procedure setbind(t:tasmsymbind);
procedure setaddress(sec:tsection;offset,len:longint); procedure setaddress(sec:tsection;offset,len:longint);
procedure GenerateAltSymbol; procedure GenerateAltSymbol;
end; end;
@ -145,10 +147,6 @@ unit aasm;
end; end;
pasmsymbollist = ^tasmsymbollist;
tasmsymbollist = object(tdictionary)
end;
{ the short name makes typing easier } { the short name makes typing easier }
pai = ^tai; pai = ^tai;
tai = object(tlinkedlist_item) tai = object(tlinkedlist_item)
@ -394,7 +392,8 @@ type
resourcesection,rttilist, resourcesection,rttilist,
resourcestringlist : paasmoutput; resourcestringlist : paasmoutput;
{ asm symbol list } { asm symbol list }
asmsymbollist : pasmsymbollist; asmsymbollist : pdictionary;
usedasmsymbollist : psinglelist;
const const
nextaltnr : longint = 1; nextaltnr : longint = 1;
@ -415,9 +414,13 @@ type
function getasmsymbol(const s : string) : pasmsymbol; function getasmsymbol(const s : string) : pasmsymbol;
function renameasmsymbol(const sold, snew : string):pasmsymbol; function renameasmsymbol(const sold, snew : string):pasmsymbol;
procedure ResetAsmsymbolList; procedure InitUsedAsmSymbolList;
procedure ResetAsmSymbolListAltSymbol; procedure DoneUsedAsmSymbolList;
procedure CheckAsmSymbolListUndefined; procedure UsedAsmSymbolListInsert(p:pasmsymbol);
procedure UsedAsmSymbolListReset;
procedure UsedAsmSymbolListResetAltSym;
procedure UsedAsmSymbolListCheckUndefined;
implementation implementation
@ -903,15 +906,13 @@ uses
constructor tasmsymbol.init(const s:string;_bind:TAsmsymbind;_typ:Tasmsymtype); constructor tasmsymbol.init(const s:string;_bind:TAsmsymbind;_typ:Tasmsymtype);
begin; begin;
{$IFDEF NEWST}
inherited init(s);
{$ELSE}
inherited initname(s); inherited initname(s);
{$ENDIF NEWST}
reset; reset;
orgbind:=_bind; defbind:=_bind;
bind:=_bind;
typ:=_typ; typ:=_typ;
inusedlist:=false;
{ mainly used to remove unused labels from the codesegment }
refs:=0;
end; end;
procedure tasmsymbol.GenerateAltSymbol; procedure tasmsymbol.GenerateAltSymbol;
@ -934,8 +935,6 @@ uses
idx:=-1; idx:=-1;
bind:=AB_EXTERNAL; bind:=AB_EXTERNAL;
proclocal:=false; proclocal:=false;
{ mainly used to remove unused labels from the codesegment }
refs:=0;
end; end;
function tasmsymbol.is_used:boolean; function tasmsymbol.is_used:boolean;
@ -943,21 +942,15 @@ uses
is_used:=(refs>0); is_used:=(refs>0);
end; end;
procedure tasmsymbol.setbind(t:tasmsymbind);
begin
bind:=t;
orgbind:=t;
end;
procedure tasmsymbol.setaddress(sec:tsection;offset,len:longint); procedure tasmsymbol.setaddress(sec:tsection;offset,len:longint);
begin begin
section:=sec; section:=sec;
address:=offset; address:=offset;
size:=len; size:=len;
{ when the typ was reset to External, set it back to the original { when the bind was reset to External, set it back to the default
type it got when defined } bind it got when defined }
if (bind=AB_EXTERNAL) and (orgbind<>AB_NONE) then if (bind=AB_EXTERNAL) and (defbind<>AB_NONE) then
bind:=orgbind; bind:=defbind;
end; end;
@ -1012,25 +1005,23 @@ uses
hp : pasmsymbol; hp : pasmsymbol;
begin begin
hp:=pasmsymbol(asmsymbollist^.search(s)); hp:=pasmsymbol(asmsymbollist^.search(s));
if assigned(hp) then if not assigned(hp) then
begin begin
newasmsymbol:=hp; { Not found, insert it as an External }
exit; hp:=new(pasmsymbol,init(s,AB_EXTERNAL,AT_FUNCTION));
asmsymbollist^.insert(hp);
end; end;
{ Not found, insert it as an External }
hp:=new(pasmsymbol,init(s,AB_EXTERNAL,AT_FUNCTION));
asmsymbollist^.insert(hp);
newasmsymbol:=hp; newasmsymbol:=hp;
end; end;
function newasmsymboltype(const s : string;_bind:TAsmSymBind;_typ:Tasmsymtype) : pasmsymbol; function newasmsymboltype(const s : string;_bind:TAsmSymBind;_typ:Tasmsymtype) : pasmsymbol;
var var
hp : pasmsymbol; hp : pasmsymbol;
begin begin
hp:=pasmsymbol(asmsymbollist^.search(s)); hp:=pasmsymbol(asmsymbollist^.search(s));
if assigned(hp) then if assigned(hp) then
hp^.setbind(_bind) hp^.defbind:=_bind
else else
begin begin
{ Not found, insert it as an External } { Not found, insert it as an External }
@ -1054,41 +1045,84 @@ uses
end; end;
procedure ResetAsmSym(p:Pnamedindexobject);{$ifndef FPC}far;{$endif} {*****************************************************************************
Used AsmSymbolList
*****************************************************************************}
procedure InitUsedAsmSymbolList;
begin begin
pasmsymbol(p)^.reset; if assigned(usedasmsymbollist) then
internalerror(78455782);
new(usedasmsymbollist,init);
usedasmsymbollist^.noclear:=true;
end; end;
procedure ResetAsmsymbolList; procedure DoneUsedAsmSymbolList;
begin begin
asmsymbollist^.foreach({$ifndef TP}@{$endif}resetasmsym); dispose(usedasmsymbollist,done);
usedasmsymbollist:=nil;
end; end;
procedure ResetAltSym(p:Pnamedindexobject);{$ifndef FPC}far;{$endif} procedure UsedAsmSymbolListInsert(p:pasmsymbol);
begin begin
pasmsymbol(p)^.altsymbol:=nil; if not p^.inusedlist then
usedasmsymbollist^.insert(p);
p^.inusedlist:=true;
end; end;
procedure ResetAsmSymbolListAltSymbol; procedure UsedAsmSymbolListReset;
var
hp : pasmsymbol;
begin begin
asmsymbollist^.foreach({$ifndef TP}@{$endif}resetaltsym); hp:=pasmsymbol(usedasmsymbollist^.first);
while assigned(hp) do
begin
with hp^ do
begin
reset;
inusedlist:=false;
end;
hp:=pasmsymbol(hp^.next);
end;
end; end;
procedure checkundefinedasmsym(p:Pnamedindexobject);{$ifndef FPC}far;{$endif} procedure UsedAsmSymbolListResetAltSym;
var
hp : pasmsymbol;
begin begin
if (pasmsymbol(p)^.refs>0) and hp:=pasmsymbol(usedasmsymbollist^.first);
(pasmsymbol(p)^.section=Sec_none) and while assigned(hp) do
(pasmsymbol(p)^.bind<>AB_EXTERNAL) then begin
Message1(asmw_e_undefined_label,pasmsymbol(p)^.name); with hp^ do
begin
altsymbol:=nil;
inusedlist:=false;
end;
hp:=pasmsymbol(hp^.next);
end;
end; end;
procedure CheckAsmSymbolListUndefined;
procedure UsedAsmSymbolListCheckUndefined;
var
hp : pasmsymbol;
begin begin
asmsymbollist^.foreach({$ifndef TP}@{$endif}checkundefinedasmsym); hp:=pasmsymbol(usedasmsymbollist^.first);
while assigned(hp) do
begin
with hp^ do
begin
if (refs>0) and
(section=Sec_none) and
(bind<>AB_EXTERNAL) then
Message1(asmw_e_undefined_label,name);
end;
hp:=pasmsymbol(hp^.next);
end;
end; end;
@ -1146,7 +1180,10 @@ uses
end. end.
{ {
$Log$ $Log$
Revision 1.6 2000-08-09 19:49:44 peter Revision 1.7 2000-08-12 15:34:21 peter
+ usedasmsymbollist to check and reset only the used symbols (merged)
Revision 1.6 2000/08/09 19:49:44 peter
* packenumfixed things so it compiles with 1.0.0 again * packenumfixed things so it compiles with 1.0.0 again
Revision 1.5 2000/08/05 13:25:06 peter Revision 1.5 2000/08/05 13:25:06 peter

108
compiler/ag386bin.pas
View File

@ -185,6 +185,7 @@ unit ag386bin;
sec:=ps^.section; sec:=ps^.section;
ofs:=ps^.address; ofs:=ps^.address;
reloc:=true; reloc:=true;
UsedAsmSymbolListInsert(ps);
end; end;
if j<256 then if j<256 then
begin begin
@ -207,6 +208,7 @@ unit ag386bin;
internalerror(33008); internalerror(33008);
ofs:=ofs-ps^.address; ofs:=ofs-ps^.address;
reloc:=false; reloc:=false;
UsedAsmSymbolListInsert(ps);
end; end;
end; end;
end; end;
@ -214,7 +216,7 @@ unit ag386bin;
{ external bss need speical handling (PM) } { external bss need speical handling (PM) }
if assigned(ps) and (ps^.section=sec_none) then if assigned(ps) and (ps^.section=sec_none) then
begin begin
if currpass<>1 then if currpass=2 then
objectoutput^.writesymbol(ps); objectoutput^.writesymbol(ps);
objectoutput^.WriteSymStabs(sec,ofs,hp,ps,nidx,nother,line,reloc) objectoutput^.WriteSymStabs(sec,ofs,hp,ps,nidx,nother,line,reloc)
end end
@ -308,11 +310,11 @@ unit ag386bin;
else else
curr_n:=n_includefile; curr_n:=n_includefile;
{ get symbol for this includefile } { get symbol for this includefile }
hp:=newasmsymbol('Ltext'+ToStr(IncludeCount)); hp:=newasmsymboltype('Ltext'+ToStr(IncludeCount),AB_LOCAL,AT_FUNCTION);
if currpass=1 then if currpass=1 then
begin begin
hp^.setbind(AB_LOCAL);
hp^.setaddress(objectalloc^.currsec,objectalloc^.sectionsize,0); hp^.setaddress(objectalloc^.currsec,objectalloc^.sectionsize,0);
UsedAsmSymbolListInsert(hp);
end end
else else
objectoutput^.writesymbol(hp); objectoutput^.writesymbol(hp);
@ -355,11 +357,11 @@ unit ag386bin;
exit; exit;
store_sec:=objectalloc^.currsec; store_sec:=objectalloc^.currsec;
objectalloc^.setsection(sec_code); objectalloc^.setsection(sec_code);
hp:=newasmsymbol('Letext'); hp:=newasmsymboltype('Letext',AB_LOCAL,AT_FUNCTION);
if currpass=1 then if currpass=1 then
begin begin
hp^.setbind(AB_LOCAL);
hp^.setaddress(objectalloc^.currsec,objectalloc^.sectionsize,0); hp^.setaddress(objectalloc^.currsec,objectalloc^.sectionsize,0);
UsedAsmSymbolListInsert(hp);
end end
else else
objectoutput^.writesymbol(hp); objectoutput^.writesymbol(hp);
@ -473,7 +475,7 @@ unit ag386bin;
function ti386binasmlist.TreePass1(hp:pai):pai; function ti386binasmlist.TreePass1(hp:pai):pai;
var var
l : longint; i,l : longint;
begin begin
while assigned(hp) do while assigned(hp) do
begin begin
@ -508,8 +510,10 @@ unit ag386bin;
begin begin
if pai_datablock(hp)^.is_global then if pai_datablock(hp)^.is_global then
begin begin
pai_datablock(hp)^.sym^.setbind(AB_COMMON);
pai_datablock(hp)^.sym^.setaddress(sec_none,pai_datablock(hp)^.size,pai_datablock(hp)^.size); pai_datablock(hp)^.sym^.setaddress(sec_none,pai_datablock(hp)^.size,pai_datablock(hp)^.size);
{ force to be common/external, must be after setaddress as that would
set it to AS_GLOBAL }
pai_datablock(hp)^.sym^.bind:=AB_COMMON;
end end
else else
begin begin
@ -518,7 +522,6 @@ unit ag386bin;
objectalloc^.sectionalign(4) objectalloc^.sectionalign(4)
else if l>1 then else if l>1 then
objectalloc^.sectionalign(2); objectalloc^.sectionalign(2);
pai_datablock(hp)^.sym^.setbind(AB_LOCAL);
pai_datablock(hp)^.sym^.setaddress(objectalloc^.currsec,objectalloc^.sectionsize, pai_datablock(hp)^.sym^.setaddress(objectalloc^.currsec,objectalloc^.sectionsize,
pai_datablock(hp)^.size); pai_datablock(hp)^.size);
objectalloc^.sectionalloc(pai_datablock(hp)^.size); objectalloc^.sectionalloc(pai_datablock(hp)^.size);
@ -527,10 +530,6 @@ unit ag386bin;
else else
{$endif} {$endif}
begin begin
if pai_datablock(hp)^.is_global then
pai_datablock(hp)^.sym^.setbind(AB_GLOBAL)
else
pai_datablock(hp)^.sym^.setbind(AB_LOCAL);
l:=pai_datablock(hp)^.size; l:=pai_datablock(hp)^.size;
if l>2 then if l>2 then
objectalloc^.sectionalign(4) objectalloc^.sectionalign(4)
@ -539,6 +538,7 @@ unit ag386bin;
pai_datablock(hp)^.sym^.setaddress(objectalloc^.currsec,objectalloc^.sectionsize,pai_datablock(hp)^.size); pai_datablock(hp)^.sym^.setaddress(objectalloc^.currsec,objectalloc^.sectionsize,pai_datablock(hp)^.size);
objectalloc^.sectionalloc(pai_datablock(hp)^.size); objectalloc^.sectionalloc(pai_datablock(hp)^.size);
end; end;
UsedAsmSymbolListInsert(pai_datablock(hp)^.sym);
end; end;
ait_const_32bit : ait_const_32bit :
objectalloc^.sectionalloc(4); objectalloc^.sectionalloc(4);
@ -556,7 +556,10 @@ unit ag386bin;
objectalloc^.sectionalloc(8); objectalloc^.sectionalloc(8);
ait_const_rva, ait_const_rva,
ait_const_symbol : ait_const_symbol :
objectalloc^.sectionalloc(4); begin
objectalloc^.sectionalloc(4);
UsedAsmSymbolListInsert(pai_const_symbol(hp)^.sym);
end;
ait_section: ait_section:
begin begin
objectalloc^.setsection(pai_section(hp)^.sec); objectalloc^.setsection(pai_section(hp)^.sec);
@ -577,38 +580,60 @@ unit ag386bin;
ait_stabs : ait_stabs :
convertstabs(pai_stabs(hp)^.str); convertstabs(pai_stabs(hp)^.str);
ait_stab_function_name : ait_stab_function_name :
if assigned(pai_stab_function_name(hp)^.str) then begin
funcname:=getasmsymbol(strpas(pai_stab_function_name(hp)^.str)) if assigned(pai_stab_function_name(hp)^.str) then
else begin
funcname:=nil; funcname:=getasmsymbol(strpas(pai_stab_function_name(hp)^.str));
UsedAsmSymbolListInsert(funcname);
end
else
funcname:=nil;
end;
ait_force_line : ait_force_line :
stabslastfileinfo.line:=0; stabslastfileinfo.line:=0;
{$endif} {$endif}
ait_symbol : ait_symbol :
begin begin
if pai_symbol(hp)^.is_global then
pai_symbol(hp)^.sym^.setbind(AB_GLOBAL)
else
pai_symbol(hp)^.sym^.setbind(AB_LOCAL);
pai_symbol(hp)^.sym^.setaddress(objectalloc^.currsec,objectalloc^.sectionsize,0); pai_symbol(hp)^.sym^.setaddress(objectalloc^.currsec,objectalloc^.sectionsize,0);
UsedAsmSymbolListInsert(pai_symbol(hp)^.sym);
end; end;
ait_symbol_end : ait_symbol_end :
begin begin
if target_info.target=target_i386_linux then if target_info.target=target_i386_linux then
pai_symbol(hp)^.sym^.size:=objectalloc^.sectionsize-pai_symbol(hp)^.sym^.address; begin
pai_symbol(hp)^.sym^.size:=objectalloc^.sectionsize-pai_symbol(hp)^.sym^.address;
UsedAsmSymbolListInsert(pai_symbol(hp)^.sym);
end;
end; end;
ait_label : ait_label :
begin begin
if pai_label(hp)^.is_global then
pai_label(hp)^.l^.setbind(AB_GLOBAL)
else
pai_label(hp)^.l^.setbind(AB_LOCAL);
pai_label(hp)^.l^.setaddress(objectalloc^.currsec,objectalloc^.sectionsize,0); pai_label(hp)^.l^.setaddress(objectalloc^.currsec,objectalloc^.sectionsize,0);
UsedAsmSymbolListInsert(pai_label(hp)^.l);
end; end;
ait_string : ait_string :
objectalloc^.sectionalloc(pai_string(hp)^.len); objectalloc^.sectionalloc(pai_string(hp)^.len);
ait_instruction : ait_instruction :
objectalloc^.sectionalloc(paicpu(hp)^.Pass1(objectalloc^.sectionsize)); begin
objectalloc^.sectionalloc(paicpu(hp)^.Pass1(objectalloc^.sectionsize));
{ fixup the references }
for i:=1 to paicpu(hp)^.ops do
begin
with paicpu(hp)^.oper[i-1] do
begin
case typ of
top_ref :
begin
if assigned(ref^.symbol) then
UsedAsmSymbolListInsert(ref^.symbol);
end;
top_symbol :
begin
UsedAsmSymbolListInsert(sym);
end;
end;
end;
end;
end;
ait_direct : ait_direct :
Message(asmw_f_direct_not_supported); Message(asmw_f_direct_not_supported);
ait_cut : ait_cut :
@ -747,8 +772,7 @@ unit ag386bin;
objectoutput^.initwriting(cut_normal); objectoutput^.initwriting(cut_normal);
objectoutput^.defaultsection(sec_code); objectoutput^.defaultsection(sec_code);
{ reset the asmsymbol list } { reset the asmsymbol list }
ResetAsmsymbolList; InitUsedAsmsymbolList;
objectoutput^.defaultsection(sec_code);
{$ifdef MULTIPASS} {$ifdef MULTIPASS}
{ Pass 0 } { Pass 0 }
@ -787,8 +811,9 @@ unit ag386bin;
{$ifdef GDB} {$ifdef GDB}
EndFileLineInfo; EndFileLineInfo;
{$endif GDB} {$endif GDB}
{ check for undefined labels } { check for undefined labels and reset }
CheckAsmSymbolListUndefined; UsedAsmSymbolListCheckUndefined;
{ set section sizes } { set section sizes }
objectoutput^.setsectionsizes(objectalloc^.secsize); objectoutput^.setsectionsizes(objectalloc^.secsize);
{ leave if errors have occured } { leave if errors have occured }
@ -819,6 +844,11 @@ unit ag386bin;
{ write last objectfile } { write last objectfile }
objectoutput^.donewriting; objectoutput^.donewriting;
{ reset the used symbols back, must be after the .o has been
written }
UsedAsmsymbolListReset;
DoneUsedAsmsymbolList;
end; end;
@ -834,6 +864,7 @@ unit ag386bin;
objectoutput^.initwriting(cut_normal); objectoutput^.initwriting(cut_normal);
objectoutput^.defaultsection(sec_code); objectoutput^.defaultsection(sec_code);
startsec:=sec_code; startsec:=sec_code;
{ start with list 1 } { start with list 1 }
currlistidx:=1; currlistidx:=1;
currlist:=list[currlistidx]; currlist:=list[currlistidx];
@ -841,7 +872,7 @@ unit ag386bin;
while assigned(hp) do while assigned(hp) do
begin begin
{ reset the asmsymbol list } { reset the asmsymbol list }
ResetAsmsymbolList; InitUsedAsmSymbolList;
{$ifdef MULTIPASS} {$ifdef MULTIPASS}
{ Pass 0 } { Pass 0 }
@ -866,7 +897,8 @@ unit ag386bin;
EndFileLineInfo; EndFileLineInfo;
{$endif GDB} {$endif GDB}
{ check for undefined labels } { check for undefined labels }
CheckAsmSymbolListUndefined; UsedAsmSymbolListCheckUndefined;
{ set section sizes } { set section sizes }
objectoutput^.setsectionsizes(objectalloc^.secsize); objectoutput^.setsectionsizes(objectalloc^.secsize);
{ leave if errors have occured } { leave if errors have occured }
@ -890,6 +922,11 @@ unit ag386bin;
{ if not end then write the current objectfile } { if not end then write the current objectfile }
objectoutput^.donewriting; objectoutput^.donewriting;
{ reset the used symbols back, must be after the .o has been
written }
UsedAsmsymbolListReset;
DoneUsedAsmsymbolList;
{ end of lists? } { end of lists? }
if not MaybeNextList(hp) then if not MaybeNextList(hp) then
break; break;
@ -1002,7 +1039,10 @@ unit ag386bin;
end. end.
{ {
$Log$ $Log$
Revision 1.5 2000-08-08 19:28:57 peter Revision 1.6 2000-08-12 15:34:22 peter
+ usedasmsymbollist to check and reset only the used symbols (merged)
Revision 1.5 2000/08/08 19:28:57 peter
* memdebug/memory patches (merged) * memdebug/memory patches (merged)
* only once illegal directive (merged) * only once illegal directive (merged)

90
compiler/cobjects.pas
View File

@ -260,6 +260,17 @@ unit cobjects;
procedure inserttree(currtree,currroot:Pnamedindexobject); procedure inserttree(currtree,currroot:Pnamedindexobject);
end; end;
psinglelist=^tsinglelist;
tsinglelist=object
noclear : boolean;
first,
last : Pnamedindexobject;
constructor init;
destructor done;
procedure clear;
procedure insert(p:Pnamedindexobject);
end;
pdynamicarray = ^tdynamicarray; pdynamicarray = ^tdynamicarray;
tdynamicarray = object tdynamicarray = object
posn, posn,
@ -286,8 +297,9 @@ unit cobjects;
pindexarray=^tindexarray; pindexarray=^tindexarray;
tindexarray=object tindexarray=object
first : Pnamedindexobject; noclear : boolean;
count : longint; first : Pnamedindexobject;
count : longint;
constructor init(Agrowsize:longint); constructor init(Agrowsize:longint);
destructor done; destructor done;
procedure clear; procedure clear;
@ -1762,6 +1774,51 @@ end;
end; end;
{****************************************************************************
tsinglelist
****************************************************************************}
constructor tsinglelist.init;
begin
first:=nil;
last:=nil;
noclear:=false;
end;
destructor tsinglelist.done;
begin
if not noclear then
clear;
end;
procedure tsinglelist.clear;
var
hp : pnamedindexobject;
begin
hp:=first;
while assigned(hp) do
begin
dispose(hp,done);
hp:=hp^.next;
end;
first:=nil;
last:=nil;
end;
procedure tsinglelist.insert(p:Pnamedindexobject);
begin
if not assigned(first) then
first:=p
else
last^.next:=p;
last:=p;
p^.next:=nil;
end;
{**************************************************************************** {****************************************************************************
tdynamicarray tdynamicarray
****************************************************************************} ****************************************************************************}
@ -1790,13 +1847,13 @@ end;
procedure tdynamicarray.grow; procedure tdynamicarray.grow;
var var
osize : longint; osize : longint;
{$ifndef REALLOCMEM} {$ifndef USEREALLOCMEM}
odata : pchar; odata : pchar;
{$endif REALLOCMEM} {$endif USEREALLOCMEM}
begin begin
osize:=size; osize:=size;
inc(limit,growcount); inc(limit,growcount);
{$ifndef REALLOCMEM} {$ifndef USEREALLOCMEM}
odata:=data; odata:=data;
getmem(data,size); getmem(data,size);
if assigned(odata) then if assigned(odata) then
@ -1804,9 +1861,9 @@ end;
move(odata^,data^,osize); move(odata^,data^,osize);
freemem(odata,osize); freemem(odata,osize);
end; end;
{$else REALLOCMEM} {$else USEREALLOCMEM}
reallocmem(data,size); reallocmem(data,size);
{$endif REALLOCMEM} {$endif USEREALLOCMEM}
fillchar(data[osize],growcount*elemlen,0); fillchar(data[osize],growcount*elemlen,0);
end; end;
@ -1892,13 +1949,15 @@ end;
count:=0; count:=0;
data:=nil; data:=nil;
first:=nil; first:=nil;
noclear:=false;
end; end;
destructor tindexarray.done; destructor tindexarray.done;
begin begin
if assigned(data) then if assigned(data) then
begin begin
clear; if not noclear then
clear;
freemem(data,size*4); freemem(data,size*4);
data:=nil; data:=nil;
end; end;
@ -1941,13 +2000,13 @@ end;
procedure tindexarray.grow(gsize:longint); procedure tindexarray.grow(gsize:longint);
var var
osize : longint; osize : longint;
{$ifndef REALLOCMEM} {$ifndef USEREALLOCMEM}
odata : Pnamedindexobjectarray; odata : Pnamedindexobjectarray;
{$endif fpc} {$endif USEREALLOCMEM}
begin begin
osize:=size; osize:=size;
inc(size,gsize); inc(size,gsize);
{$ifndef REALLOCMEM} {$ifndef USEREALLOCMEM}
odata:=data; odata:=data;
getmem(data,size*4); getmem(data,size*4);
if assigned(odata) then if assigned(odata) then
@ -1955,9 +2014,9 @@ end;
move(odata^,data^,osize*4); move(odata^,data^,osize*4);
freemem(odata,osize*4); freemem(odata,osize*4);
end; end;
{$else REALLOCMEM} {$else USEREALLOCMEM}
reallocmem(data,size*4); reallocmem(data,size*4);
{$endif REALLOCMEM} {$endif USEREALLOCMEM}
fillchar(data^[osize+1],gsize*4,0); fillchar(data^[osize+1],gsize*4,0);
end; end;
@ -2424,7 +2483,10 @@ end;
end. end.
{ {
$Log$ $Log$
Revision 1.6 2000-08-10 12:20:44 jonas Revision 1.7 2000-08-12 15:34:22 peter
+ usedasmsymbollist to check and reset only the used symbols (merged)
Revision 1.6 2000/08/10 12:20:44 jonas
* reallocmem is now also used under Delphi (merged from fixes branch) * reallocmem is now also used under Delphi (merged from fixes branch)
Revision 1.5 2000/08/09 12:09:45 jonas Revision 1.5 2000/08/09 12:09:45 jonas

7
compiler/hcodegen.pas
View File

@ -373,7 +373,7 @@ implementation
exportssection:=nil; exportssection:=nil;
resourcesection:=nil; resourcesection:=nil;
{ assembler symbols } { assembler symbols }
asmsymbollist:=new(pasmsymbollist,init); asmsymbollist:=new(pdictionary,init);
asmsymbollist^.usehash; asmsymbollist^.usehash;
{ resourcestrings } { resourcestrings }
new(ResourceStrings,Init); new(ResourceStrings,Init);
@ -462,7 +462,10 @@ end.
{ {
$Log$ $Log$
Revision 1.3 2000-08-03 13:17:26 jonas Revision 1.4 2000-08-12 15:34:22 peter
+ usedasmsymbollist to check and reset only the used symbols (merged)
Revision 1.3 2000/08/03 13:17:26 jonas
+ allow regvars to be used inside inlined procs, which required the + allow regvars to be used inside inlined procs, which required the
following changes: following changes:
+ load regvars in genentrycode/free them in genexitcode (cgai386) + load regvars in genentrycode/free them in genexitcode (cgai386)

7
compiler/parser.pas
View File

@ -260,7 +260,7 @@ unit parser;
olddebuglist, olddebuglist,
oldwithdebuglist, oldwithdebuglist,
oldconsts : paasmoutput; oldconsts : paasmoutput;
oldasmsymbollist : pasmsymbollist; oldasmsymbollist : pdictionary;
{ resourcestrings } { resourcestrings }
OldResourceStrings : PResourceStrings; OldResourceStrings : PResourceStrings;
{ akt.. things } { akt.. things }
@ -607,7 +607,10 @@ unit parser;
end. end.
{ {
$Log$ $Log$
Revision 1.2 2000-07-13 11:32:44 michael Revision 1.3 2000-08-12 15:34:22 peter
+ usedasmsymbollist to check and reset only the used symbols (merged)
Revision 1.2 2000/07/13 11:32:44 michael
+ removed logs + removed logs
} }

128
compiler/pass_2.pas
View File

@ -129,7 +129,10 @@ implementation
if p^.proclocal then if p^.proclocal then
begin begin
if not assigned(p^.altsymbol) then if not assigned(p^.altsymbol) then
p^.GenerateAltSymbol; begin
p^.GenerateAltSymbol;
UsedAsmSymbolListInsert(p);
end;
p:=p^.altsymbol; p:=p^.altsymbol;
end; end;
end; end;
@ -138,14 +141,13 @@ implementation
hp,hp2 : pai; hp,hp2 : pai;
localfixup,parafixup, localfixup,parafixup,
i : longint; i : longint;
r : preference;
skipnode : boolean; skipnode : boolean;
begin begin
if inlining_procedure then if inlining_procedure then
begin begin
InitUsedAsmSymbolList;
localfixup:=aktprocsym^.definition^.localst^.address_fixup; localfixup:=aktprocsym^.definition^.localst^.address_fixup;
parafixup:=aktprocsym^.definition^.parast^.address_fixup; parafixup:=aktprocsym^.definition^.parast^.address_fixup;
ResetAsmSymbolListAltSymbol;
hp:=pai(p^.p_asm^.first); hp:=pai(p^.p_asm^.first);
while assigned(hp) do while assigned(hp) do
begin begin
@ -167,24 +169,28 @@ implementation
{$ifdef i386} {$ifdef i386}
{ fixup the references } { fixup the references }
for i:=1 to paicpu(hp2)^.ops do for i:=1 to paicpu(hp2)^.ops do
case paicpu(hp2)^.oper[i-1].typ of begin
top_ref : with paicpu(hp2)^.oper[i-1] do
begin begin
r:=paicpu(hp2)^.oper[i-1].ref; case typ of
case r^.options of top_ref :
ref_parafixup : begin
r^.offsetfixup:=parafixup; case ref^.options of
ref_localfixup : ref_parafixup :
r^.offsetfixup:=localfixup; ref^.offsetfixup:=parafixup;
ref_localfixup :
ref^.offsetfixup:=localfixup;
end;
if assigned(ref^.symbol) then
ReLabel(ref^.symbol);
end;
top_symbol :
begin
ReLabel(sym);
end;
end; end;
if assigned(r^.symbol) then end;
ReLabel(r^.symbol); end;
end;
top_symbol :
begin
ReLabel(paicpu(hp2)^.oper[i-1].sym);
end;
end;
{$endif i386} {$endif i386}
end; end;
ait_marker : ait_marker :
@ -200,7 +206,10 @@ implementation
else else
dispose(hp2,done); dispose(hp2,done);
hp:=pai(hp^.next); hp:=pai(hp^.next);
end end;
{ restore used symbols }
UsedAsmSymbolListResetAltSym;
DoneUsedAsmSymbolList;
end end
else else
begin begin
@ -489,45 +498,45 @@ implementation
if (cs_regalloc in aktglobalswitches) and if (cs_regalloc in aktglobalswitches) and
((procinfo^.flags and (pi_uses_asm or pi_uses_exceptions))=0) then ((procinfo^.flags and (pi_uses_asm or pi_uses_exceptions))=0) then
begin begin
{ can we omit the stack frame ? } { can we omit the stack frame ? }
{ conditions: { conditions:
1. procedure (not main block) 1. procedure (not main block)
2. no constructor or destructor 2. no constructor or destructor
3. no call to other procedures 3. no call to other procedures
4. no interrupt handler 4. no interrupt handler
} }
{!!!!!! this doesn work yet, because of problems with {!!!!!! this doesn work yet, because of problems with
with linux and windows with linux and windows
} }
(* (*
if assigned(aktprocsym) then if assigned(aktprocsym) then
begin begin
if not(assigned(procinfo^._class)) and if not(assigned(procinfo^._class)) and
not(aktprocsym^.definition^.proctypeoption in [potype_constructor,potype_destructor]) and not(aktprocsym^.definition^.proctypeoption in [potype_constructor,potype_destructor]) and
not(po_interrupt in aktprocsym^.definition^.procoptions) and not(po_interrupt in aktprocsym^.definition^.procoptions) and
((procinfo^.flags and pi_do_call)=0) and ((procinfo^.flags and pi_do_call)=0) and
(lexlevel>=normal_function_level) then (lexlevel>=normal_function_level) then
begin begin
{ use ESP as frame pointer } { use ESP as frame pointer }
procinfo^.framepointer:=stack_pointer; procinfo^.framepointer:=stack_pointer;
use_esp_stackframe:=true; use_esp_stackframe:=true;
{ calc parameter distance new } { calc parameter distance new }
dec(procinfo^.framepointer_offset,4); dec(procinfo^.framepointer_offset,4);
dec(procinfo^.selfpointer_offset,4); dec(procinfo^.selfpointer_offset,4);
{ is this correct ???} { is this correct ???}
{ retoffset can be negativ for results in eax !! } { retoffset can be negativ for results in eax !! }
{ the value should be decreased only if positive } { the value should be decreased only if positive }
if procinfo^.retoffset>=0 then if procinfo^.retoffset>=0 then
dec(procinfo^.retoffset,4); dec(procinfo^.retoffset,4);
dec(procinfo^.para_offset,4); dec(procinfo^.para_offset,4);
aktprocsym^.definition^.parast^.address_fixup:=procinfo^.para_offset; aktprocsym^.definition^.parast^.address_fixup:=procinfo^.para_offset;
end; end;
end; end;
*) *)
end; end;
{ process register variable stuff (JM) } { process register variable stuff (JM) }
assign_regvars(p); assign_regvars(p);
load_regvars(procinfo^.aktentrycode,p); load_regvars(procinfo^.aktentrycode,p);
@ -549,7 +558,10 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.5 2000-08-03 13:17:25 jonas Revision 1.6 2000-08-12 15:34:22 peter
+ usedasmsymbollist to check and reset only the used symbols (merged)
Revision 1.5 2000/08/03 13:17:25 jonas
+ allow regvars to be used inside inlined procs, which required the + allow regvars to be used inside inlined procs, which required the
following changes: following changes:
+ load regvars in genentrycode/free them in genexitcode (cgai386) + load regvars in genentrycode/free them in genexitcode (cgai386)