paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-03 01:09:40 +01:00
Code Issues Packages Projects Releases Wiki Activity

* refactor procsym procdef list

Browse Source 
git-svn-id: trunk@5210 -
This commit is contained in:
peter 2006-11-03 18:44:46 +00:00
parent b56368edce
commit e17b424e28
29 changed files with 425 additions and 553 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
compiler/browcol.pas
View File

@ -1502,12 +1502,12 @@ end;
procsym :
begin
with tprocsym(sym) do
if assigned(first_procdef) then
if assigned(tprocdef(procdeflist[0])) then
begin
ProcessSymTable(Symbol,Symbol^.Items,first_procdef.parast);
if assigned(first_procdef.parast) then
ProcessSymTable(Symbol,Symbol^.Items,tprocdef(procdeflist[0]).parast);
if assigned(tprocdef(procdeflist[0]).parast) then
begin
Symbol^.Params:=TypeNames^.Add(GetAbsProcParmDefStr(first_procdef));
Symbol^.Params:=TypeNames^.Add(GetAbsProcParmDefStr(tprocdef(procdeflist[0])));
end
else { param-definition is NOT assigned }
if assigned(Table.Name) then
@ -1517,9 +1517,9 @@ end;
end;
// if cs_local_browser in current_settings.moduleswitches then
begin
if assigned(first_procdef.localst) and
(first_procdef.localst.symtabletype<>staticsymtable) then
ProcessSymTable(Symbol,Symbol^.Items,first_procdef.localst);
if assigned(tprocdef(procdeflist[0]).localst) and
(tprocdef(procdeflist[0]).localst.symtabletype<>staticsymtable) then
ProcessSymTable(Symbol,Symbol^.Items,tprocdef(procdeflist[0]).localst);
end;
end;
end;

5
compiler/cclasses.pas
View File

@ -24,7 +24,8 @@ unit cclasses;
{$i fpcdefs.inc}
{$ifndef VER2_0}
{$define CCLASSESINLINE}
{ Disabled for now, gives an IE 200311075 when compiling the IDE }
{ $define CCLASSESINLINE}
{$endif}
interface
@ -414,7 +415,7 @@ type
type
{ can't use sizeof(integer) because it crashes gdb }
tdynamicblockdata=array[0..1024*1024-1] of byte;
pdynamicblock = ^tdynamicblock;
tdynamicblock = record
pos,

7
compiler/dbgbase.pas
View File

@ -114,11 +114,14 @@ implementation
procedure TDebugInfo.method_write_defs(p:TObject;arg:pointer);
var
i : longint;
pd : tprocdef;
begin
if tsym(p).typ=procsym then
if tsym(p).typ<>procsym then
exit;
for i:=0 to tprocsym(p).ProcdefList.Count-1 do
begin
pd:=tprocsym(p).first_procdef;
pd:=tprocdef(tprocsym(p).ProcdefList[i]);
insertdef(TAsmList(arg),pd.returndef);
end;
end;

4
compiler/dbgdwarf.pas
View File

@ -1778,8 +1778,8 @@ implementation
var
i : longint;
begin
for i:=1 to sym.procdef_count do
appendprocdef(sym.procdef[i]);
for i:=0 to sym.ProcdefList.Count-1 do
appendprocdef(tprocdef(sym.ProcdefList[i]));
end;
procedure TDebugInfoDwarf.appendsym_property(sym: tpropertysym);

6
compiler/dbgstabs.pas
View File

@ -363,7 +363,7 @@ implementation
state:=arg;
if tsym(p).typ = procsym then
begin
pd := tprocsym(p).first_procdef;
pd :=tprocdef(tprocsym(p).ProcdefList[0]);
if (po_virtualmethod in pd.procoptions) then
begin
lindex := pd.extnumber;
@ -1296,8 +1296,8 @@ implementation
i : longint;
begin
result:=nil;
for i:=1 to sym.procdef_count do
write_procdef(list,sym.procdef[i]);
for i:=0 to sym.ProcdefList.Count-1 do
write_procdef(list,tprocdef(sym.ProcdefList[i]));
end;
var

20
compiler/htypechk.pas
View File

@ -1541,7 +1541,7 @@ implementation
for class entries as the tree keeps always the same }
if (not sym.overloadchecked) and
(sym.owner.symtabletype=ObjectSymtable) and
(po_overload in sym.first_procdef.procoptions) then
(po_overload in tprocdef(sym.ProcdefList[0]).procoptions) then
search_class_overloads(sym);
{ when the class passed is defined in this unit we
@ -1566,9 +1566,9 @@ implementation
end;
{ link all procedures which have the same # of parameters }
for j:=1 to sym.procdef_count do
for j:=0 to sym.ProcdefList.Count-1 do
begin
pd:=sym.procdef[j];
pd:=tprocdef(sym.ProcdefList[j]);
{ Is the procdef visible? This needs to be checked on
procdef level since a symbol can contain both private and
public declarations. But the check should not be done
@ -1593,7 +1593,7 @@ implementation
{ remember if the procedure is declared with the overload directive,
it's information is still needed also after all procs are removed }
has_overload_directive:=(po_overload in sym.first_procdef.procoptions);
has_overload_directive:=(po_overload in tprocdef(sym.ProcdefList[0]).procoptions);
{ when the definition has overload directive set, we search for
overloaded definitions in the symtablestack. The found
@ -1623,13 +1623,13 @@ implementation
begin
{ if this visible procedure doesn't have overload we can stop
searching }
if not(po_overload in srprocsym.first_procdef.procoptions) and
srprocsym.first_procdef.is_visible_for_object(topclassh,nil) then
if not(po_overload in tprocdef(srprocsym.ProcdefList[0]).procoptions) and
tprocdef(srprocsym.ProcdefList[0]).is_visible_for_object(topclassh,nil) then
break;
{ process all overloaded definitions }
for j:=1 to srprocsym.procdef_count do
for j:=0 to srprocsym.ProcdefList.Count-1 do
begin
pd:=srprocsym.procdef[j];
pd:=tprocdef(srprocsym.ProcdefList[j]);
{ only visible procedures need to be added }
if pd.is_visible_for_object(topclassh,nil) then
begin
@ -1713,9 +1713,9 @@ implementation
FProcsym:=srprocsym;
{ process all overloaded definitions }
for j:=1 to srprocsym.procdef_count do
for j:=0 to srprocsym.ProcdefList.Count-1 do
begin
pd:=srprocsym.procdef[j];
pd:=tprocdef(srprocsym.ProcdefList[j]);
{ only when the # of parameter are supported by the
procedure }
if (FParalength>=pd.minparacount) and

55
compiler/ncal.pas
View File

@ -118,7 +118,7 @@ interface
{ called for each definition in a class and verifies if a method
is abstract or not, if it is abstract, give out a warning
}
procedure verifyabstract(p : TObject;arg:pointer);
procedure verifyabstract(sym:TObject;arg:pointer);
procedure insertintolist(l : tnodelist);override;
function pass_1 : tnode;override;
function pass_typecheck:tnode;override;
@ -887,23 +887,29 @@ type
constructor tcallnode.createinternres(const name: string; params: tnode; res:tdef);
var
pd : tprocdef;
begin
createintern(name,params);
typedef := res;
include(callnodeflags,cnf_typedefset);
pd:=tprocdef(symtableprocentry.ProcdefList[0]);
{ both the normal and specified resultdef either have to be returned via a }
{ parameter or not, but no mixing (JM) }
if paramanager.ret_in_param(typedef,symtableprocentry.first_procdef.proccalloption) xor
paramanager.ret_in_param(symtableprocentry.first_procdef.returndef,symtableprocentry.first_procdef.proccalloption) then
if paramanager.ret_in_param(typedef,pd.proccalloption) xor
paramanager.ret_in_param(pd.returndef,pd.proccalloption) then
internalerror(200108291);
end;
constructor tcallnode.createinternreturn(const name: string; params: tnode; returnnode : tnode);
var
pd : tprocdef;
begin
createintern(name,params);
_funcretnode:=returnnode;
if not paramanager.ret_in_param(symtableprocentry.first_procdef.returndef,symtableprocentry.first_procdef.proccalloption) then
pd:=tprocdef(symtableprocentry.ProcdefList[0]);
if not paramanager.ret_in_param(pd.returndef,pd.proccalloption) then
internalerror(200204247);
end;
@ -1135,28 +1141,25 @@ type
end;
procedure tcallnode.verifyabstract(p : TObject;arg:pointer);
procedure tcallnode.verifyabstract(sym:TObject;arg:pointer);
var
hp : tprocdef;
j: integer;
pd : tprocdef;
i : longint;
begin
if (tsym(p).typ=procsym) then
begin
for j:=1 to tprocsym(p).procdef_count do
begin
{ index starts at 1 }
hp:=tprocsym(p).procdef[j];
{ If this is an abstract method insert into the list }
if (po_abstractmethod in hp.procoptions) then
AbstractMethodsList.Insert(hp.procsym.realname)
else
{ If this symbol is a virtual (includes override) method,
then remove it from the list }
if po_virtualmethod in hp.procoptions then
AbstractMethodsList.Remove(hp.procsym.realname);
end;
end;
if (tsym(sym).typ<>procsym) then
exit;
for i:=0 to tprocsym(sym).ProcdefList.Count-1 do
begin
pd:=tprocdef(tprocsym(sym).ProcdefList[i]);
{ If this is an abstract method insert into the list }
if (po_abstractmethod in pd.procoptions) then
AbstractMethodsList.Insert(pd.procsym.realname)
else
{ If this symbol is a virtual (includes override) method,
then remove it from the list }
if po_virtualmethod in pd.procoptions then
AbstractMethodsList.Remove(pd.procsym.realname);
end;
end;
@ -1694,8 +1697,8 @@ type
if (m_delphi in current_settings.modeswitches) and
(cnf_anon_inherited in callnodeflags) and
(symtableprocentry.owner.symtabletype=ObjectSymtable) and
(po_overload in symtableprocentry.first_procdef.procoptions) and
(symtableprocentry.procdef_count>=2) then
(po_overload in tprocdef(symtableprocentry.ProcdefList[0]).procoptions) and
(symtableprocentry.ProcdefList.Count>=2) then
result:=cnothingnode.create
else
begin

6
compiler/ncgld.pas
View File

@ -81,6 +81,7 @@ implementation
var
hregister : tregister;
symtabletype : TSymtabletype;
pd : tprocdef;
href : treference;
newsize : tcgsize;
endrelocatelab,
@ -363,8 +364,9 @@ implementation
end
else
begin
if (po_external in tprocsym(symtableentry).procdef[1].procoptions) then
location.reference.base := cg.g_indirect_sym_load(current_asmdata.CurrAsmList,tprocsym(symtableentry).procdef[1].mangledname);
pd:=tprocdef(tprocsym(symtableentry).ProcdefList[0]);
if (po_external in pd.procoptions) then
location.reference.base := cg.g_indirect_sym_load(current_asmdata.CurrAsmList,pd.mangledname);
{!!!!! Be aware, work on virtual methods too }
if (location.reference.base = NR_NO) then
location.reference.symbol:=current_asmdata.RefAsmSymbol(procdef.mangledname);

8
compiler/ncgutil.pas
View File

@ -1109,9 +1109,9 @@ implementation
end;
procsym :
begin
for i:=1 to tprocsym(p).procdef_count do
for i:=0 to tprocsym(p).ProcdefList.Count-1 do
begin
pd:=tprocsym(p).procdef[i];
pd:=tprocdef(tprocsym(p).ProcdefList[i]);
if assigned(pd.localst) and
(pd.procsym=tprocsym(p)) and
(pd.localst.symtabletype<>staticsymtable) then
@ -1147,9 +1147,9 @@ implementation
end;
procsym :
begin
for i:=1 to tprocsym(p).procdef_count do
for i:=0 to tprocsym(p).ProcdefList.Count-1 do
begin
pd:=tprocsym(p).procdef[i];
pd:=tprocdef(tprocsym(p).ProcdefList[i]);
if assigned(pd.localst) and
(pd.procsym=tprocsym(p)) and
(pd.localst.symtabletype<>staticsymtable) then

2
compiler/nld.pas
View File

@ -316,7 +316,7 @@ implementation
when the expected procvardef is known, see get_information
in htypechk.pas (PFV) }
if not assigned(procdef) then
procdef:=tprocsym(symtableentry).first_procdef
procdef:=tprocdef(tprocsym(symtableentry).ProcdefList[0])
else if po_kylixlocal in procdef.procoptions then
CGMessage(type_e_cant_take_address_of_local_subroutine);

143
compiler/nobj.pas
View File

@ -207,52 +207,53 @@ implementation
end;
end;
procedure tclassheader.insertmsgint(p:TObject;arg:pointer);
var
i : cardinal;
def: Tprocdef;
pt : pprocdeftree;
i : longint;
pd : Tprocdef;
pt : pprocdeftree;
begin
if tsym(p).typ=procsym then
for i:=1 to Tprocsym(p).procdef_count do
if tsym(p).typ<>procsym then
exit;
for i:=0 to Tprocsym(p).ProcdefList.Count-1 do
begin
pd:=tprocdef(Tprocsym(p).ProcdefList[i]);
if po_msgint in pd.procoptions then
begin
def:=Tprocsym(p).procdef[i];
if po_msgint in def.procoptions then
begin
new(pt);
pt^.data:=def;
pt^.l:=nil;
pt^.r:=nil;
insertint(pt,root,plongint(arg)^);
end;
new(pt);
pt^.data:=pd;
pt^.l:=nil;
pt^.r:=nil;
insertint(pt,root,plongint(arg)^);
end;
end;
end;
procedure tclassheader.insertmsgstr(p:TObject;arg:pointer);
var
i : cardinal;
def: Tprocdef;
pt : pprocdeftree;
i : longint;
pd : Tprocdef;
pt : pprocdeftree;
begin
if tsym(p).typ=procsym then
for i:=1 to Tprocsym(p).procdef_count do
if tsym(p).typ<>procsym then
exit;
for i:=0 to Tprocsym(p).ProcdefList.Count-1 do
begin
pd:=tprocdef(Tprocsym(p).ProcdefList[i]);
if po_msgstr in pd.procoptions then
begin
def:=Tprocsym(p).procdef[i];
if po_msgstr in def.procoptions then
begin
new(pt);
pt^.data:=def;
pt^.l:=nil;
pt^.r:=nil;
insertstr(pt,root,plongint(arg)^);
end;
new(pt);
pt^.data:=pd;
pt^.l:=nil;
pt^.r:=nil;
insertstr(pt,root,plongint(arg)^);
end;
end;
end;
procedure tclassheader.writenames(p : pprocdeftree);
var
ca : pchar;
@ -442,19 +443,18 @@ implementation
procedure tclassheader.do_count_published_methods(p:TObject;arg:pointer);
var
i : longint;
i : longint;
pd : tprocdef;
begin
if (tsym(p).typ=procsym) then
begin
for i:=1 to tprocsym(p).procdef_count do
begin
pd:=tprocsym(p).procdef[i];
if (pd.procsym=tsym(p)) and
(sp_published in pd.symoptions) then
inc(plongint(arg)^);
end;
end;
if (tsym(p).typ<>procsym) then
exit;
for i:=0 to Tprocsym(p).ProcdefList.Count-1 do
begin
pd:=tprocdef(Tprocsym(p).ProcdefList[i]);
if (pd.procsym=tsym(p)) and
(sp_published in pd.symoptions) then
inc(plongint(arg)^);
end;
end;
@ -464,28 +464,27 @@ implementation
l : tasmlabel;
pd : tprocdef;
begin
if (tsym(p).typ=procsym) then
begin
for i:=1 to tprocsym(p).procdef_count do
begin
pd:=tprocsym(p).procdef[i];
if (pd.procsym=tsym(p)) and
(sp_published in pd.symoptions) then
begin
current_asmdata.getdatalabel(l);
if (tsym(p).typ<>procsym) then
exit;
for i:=0 to Tprocsym(p).ProcdefList.Count-1 do
begin
pd:=tprocdef(Tprocsym(p).ProcdefList[i]);
if (pd.procsym=tsym(p)) and
(sp_published in pd.symoptions) then
begin
current_asmdata.getdatalabel(l);
current_asmdata.asmlists[al_typedconsts].concat(cai_align.create(const_align(sizeof(aint))));
current_asmdata.asmlists[al_typedconsts].concat(Tai_label.Create(l));
current_asmdata.asmlists[al_typedconsts].concat(Tai_const.Create_8bit(length(tsym(p).realname)));
current_asmdata.asmlists[al_typedconsts].concat(Tai_string.Create(tsym(p).realname));
current_asmdata.asmlists[al_typedconsts].concat(cai_align.create(const_align(sizeof(aint))));
current_asmdata.asmlists[al_typedconsts].concat(Tai_label.Create(l));
current_asmdata.asmlists[al_typedconsts].concat(Tai_const.Create_8bit(length(tsym(p).realname)));
current_asmdata.asmlists[al_typedconsts].concat(Tai_string.Create(tsym(p).realname));
current_asmdata.asmlists[al_globals].concat(Tai_const.Create_sym(l));
if po_abstractmethod in pd.procoptions then
current_asmdata.asmlists[al_globals].concat(Tai_const.Create_sym(nil))
else
current_asmdata.asmlists[al_globals].concat(Tai_const.Createname(pd.mangledname,0));
end;
end;
current_asmdata.asmlists[al_globals].concat(Tai_const.Create_sym(l));
if po_abstractmethod in pd.procoptions then
current_asmdata.asmlists[al_globals].concat(Tai_const.Create_sym(nil))
else
current_asmdata.asmlists[al_globals].concat(Tai_const.Createname(pd.mangledname,0));
end;
end;
end;
@ -612,11 +611,11 @@ implementation
if (_speed=vmtentry^.Hash) and
(_name=vmtentry^.name^) then
begin
hasoverloads:=(Tprocsym(sym).procdef_count>1);
hasoverloads:=(Tprocsym(sym).ProcdefList.Count>1);
{ walk through all defs of the symbol }
for i:=1 to Tprocsym(sym).procdef_count do
begin
pd:=Tprocsym(sym).procdef[i];
for i:=0 to Tprocsym(sym).ProcdefList.Count-1 do
begin
pd:=tprocdef(Tprocsym(sym).ProcdefList[i]);
{ is this procdef visible from the class that we are
generating. This will be used to hide the other procdefs.
@ -791,9 +790,9 @@ implementation
vmtentry:=newvmtentry(tprocsym(sym));
{ Add procdefs }
for i:=1 to Tprocsym(sym).procdef_count do
for i:=0 to Tprocsym(sym).ProcdefList.Count-1 do
begin
pd:=Tprocsym(sym).procdef[i];
pd:=tprocdef(Tprocsym(sym).ProcdefList[i]);
newdefentry(vmtentry,pd,pd.is_visible_for_object(_class,nil));
end;
end;
@ -1102,13 +1101,13 @@ implementation
overloaded definitions in the class, this only needs to be done once
for class entries as the tree keeps always the same }
if (not tprocsym(sym).overloadchecked) and
(po_overload in tprocsym(sym).first_procdef.procoptions) and
(po_overload in tprocdef(tprocsym(sym).ProcdefList[0]).procoptions) and
(tprocsym(sym).owner.symtabletype=ObjectSymtable) then
search_class_overloads(tprocsym(sym));
for i:=1 to tprocsym(sym).procdef_count do
for i:=0 to Tprocsym(sym).ProcdefList.Count-1 do
begin
implprocdef:=tprocsym(sym).procdef[i];
implprocdef:=tprocdef(Tprocsym(sym).ProcdefList[i]);
if (compare_paras(proc.paras,implprocdef.paras,cp_none,[])>=te_equal) and
(proc.proccalloption=implprocdef.proccalloption) and
(proc.proctypeoption=implprocdef.proctypeoption) and

3
compiler/pass_2.pas
View File

@ -134,7 +134,8 @@ implementation
'loadvmt', {loadvmtn}
'guidconstn',
'rttin',
'loadparentfpn'
'loadparentfpn',
'dataconstn'
);
var
p: pchar;

6
compiler/pdecsub.pas
View File

@ -2414,9 +2414,9 @@ const
forwardfound:=false;
{ check overloaded functions if the same function already exists }
for i:=1 to tprocsym(currpd.procsym).procdef_count do
for i:=0 to tprocsym(currpd.procsym).ProcdefList.Count-1 do
begin
fwpd:=tprocsym(currpd.procsym).procdef[i];
fwpd:=tprocdef(tprocsym(currpd.procsym).ProcdefList[i]);
{ Skip overloaded definitions that are declared in other units }
if fwpd.procsym<>currpd.procsym then
@ -2676,7 +2676,7 @@ const
{ if we didn't reuse a forwarddef then we add the procdef to the overloaded
list }
if not forwardfound then
tprocsym(currpd.procsym).addprocdef(currpd);
tprocsym(currpd.procsym).ProcdefList.Add(currpd);
proc_add_definition:=forwardfound;
end;

18
compiler/pexports.pas
View File

@ -38,7 +38,7 @@ implementation
systems,
ppu,fmodule,
{ symtable }
symconst,symbase,symtype,symsym,
symconst,symbase,symdef,symtype,symsym,
{ pass 1 }
node,
ncon,
@ -54,10 +54,11 @@ implementation
var
hp : texported_item;
orgs,
DefString : string;
DefString,
InternalProcName : string;
pt : tnode;
srsym : tsym;
pd : tprocdef;
pt : tnode;
srsym : tsym;
srsymtable : TSymtable;
function IsGreater(hp1,hp2:texported_item):boolean;
@ -96,13 +97,14 @@ implementation
InternalProcName:=ttypedconstsym(srsym).mangledname;
procsym :
begin
if (Tprocsym(srsym).procdef_count>1) or
(po_kylixlocal in tprocsym(srsym).first_procdef.procoptions) or
pd:=tprocdef(tprocsym(srsym).ProcdefList[0]);
if (Tprocsym(srsym).ProcdefList.Count>1) or
(po_kylixlocal in pd.procoptions) or
((tf_need_export in target_info.flags) and
not(po_exports in tprocsym(srsym).first_procdef.procoptions)) then
not(po_exports in pd.procoptions)) then
Message(parser_e_illegal_symbol_exported)
else
InternalProcName:=tprocsym(srsym).first_procdef.mangledname;
InternalProcName:=pd.mangledname;
end;
else
Message(parser_e_illegal_symbol_exported)

2
compiler/pexpr.pas
View File

@ -2250,7 +2250,7 @@ implementation
anon_inherited:=true;
{ For message methods we need to search using the message
number or string }
pd:=tprocsym(current_procinfo.procdef.procsym).first_procdef;
pd:=tprocdef(tprocsym(current_procinfo.procdef.procsym).ProcdefList[0]);
srdef:=nil;
if (po_msgint in pd.procoptions) then
searchsym_in_class_by_msgint(hclassdef,pd.messageinf.i,srdef,srsym,srsymtable)

2
compiler/pmodules.pas
View File

@ -724,7 +724,7 @@ implementation
pd:=tprocdef.create(main_program_level);
include(pd.procoptions,po_global);
pd.procsym:=ps;
ps.addprocdef(pd);
ps.ProcdefList.Add(pd);
{ set procdef options }
pd.proctypeoption:=potype;
pd.proccalloption:=pocall_default;

15
compiler/psub.pas
View File

@ -1401,9 +1401,9 @@ implementation
var
old_current_procinfo : tprocinfo;
pdflags : tpdflags;
pd : tprocdef;
s : string;
pdflags : tpdflags;
pd,firstpd : tprocdef;
s : string;
begin
{ save old state }
old_current_procinfo:=current_procinfo;
@ -1470,12 +1470,13 @@ implementation
begin
{ Give a better error if there is a forward def in the interface and only
a single implementation }
firstpd:=tprocdef(tprocsym(pd.procsym).ProcdefList[0]);
if (not pd.forwarddef) and
(not pd.interfacedef) and
(tprocsym(pd.procsym).procdef_count>1) and
tprocsym(pd.procsym).first_procdef.forwarddef and
tprocsym(pd.procsym).first_procdef.interfacedef and
not(tprocsym(pd.procsym).procdef_count>2) then
(tprocsym(pd.procsym).ProcdefList.Count>1) and
firstpd.forwarddef and
firstpd.interfacedef and
not(tprocsym(pd.procsym).ProcdefList.Count>2) then
begin
MessagePos1(pd.fileinfo,parser_e_header_dont_match_forward,pd.fullprocname(false));
tprocsym(pd.procsym).write_parameter_lists(pd);

12
compiler/ptconst.pas
View File

@ -73,6 +73,7 @@ implementation
tmpguid : tguid;
symidx,
aktpos : longint;
pd : tprocdef;
obj : tobjectdef;
recsym,
srsym : tsym;
@ -424,12 +425,13 @@ implementation
case srsym.typ of
procsym :
begin
if Tprocsym(srsym).procdef_count>1 then
pd:=tprocdef(tprocsym(srsym).ProcdefList[0]);
if Tprocsym(srsym).ProcdefList.Count>1 then
Message(parser_e_no_overloaded_procvars);
if po_abstractmethod in tprocsym(srsym).first_procdef.procoptions then
if po_abstractmethod in pd.procoptions then
Message(type_e_cant_take_address_of_abstract_method)
else
datalist.concat(Tai_const.Createname(tprocsym(srsym).first_procdef.mangledname,offset));
datalist.concat(Tai_const.Createname(pd.mangledname,offset));
end;
globalvarsym :
datalist.concat(Tai_const.Createname(tglobalvarsym(srsym).mangledname,offset));
@ -766,8 +768,8 @@ implementation
if (p.nodetype=loadn) and
(tloadnode(p).symtableentry.typ=procsym) then
begin
datalist.concat(Tai_const.createname(
tprocsym(tloadnode(p).symtableentry).first_procdef.mangledname,0));
pd:=tprocdef(tprocsym(tloadnode(p).symtableentry).ProcdefList[0]);
datalist.concat(Tai_const.createname(pd.mangledname,0));
end
else
Message(parser_e_illegal_expression);

15
compiler/raatt.pas
View File

@ -113,7 +113,7 @@ unit raatt;
{ input }
scanner,
{ symtable }
symbase,symtype,symsym,symtable,
symbase,symtype,symsym,symdef,symtable,
{$ifdef x86}
rax86,
{$endif x86}
@ -1409,13 +1409,12 @@ unit raatt;
typedconstsym :
hs:=ttypedconstsym(sym).mangledname;
procsym :
with Tprocsym(sym) do
begin
if procdef_count>1 then
message(asmr_w_calling_overload_func);
hs:=first_procdef.mangledname;
hssymtyp:=AT_FUNCTION;
end;
begin
if Tprocsym(sym).ProcdefList.Count>1 then
Message(asmr_w_calling_overload_func);
hs:=tprocdef(tprocsym(sym).ProcdefList[0]).mangledname;
hssymtyp:=AT_FUNCTION;
end;
typesym :
begin
if not(ttypesym(sym).typedef.typ in [recorddef,objectdef]) then

4
compiler/rautils.pas
View File

@ -919,11 +919,11 @@ Begin
begin
if opr.typ<>OPR_NONE then
Message(asmr_e_invalid_operand_type);
if Tprocsym(sym).procdef_count>1 then
if Tprocsym(sym).ProcdefList.Count>1 then
Message(asmr_w_calling_overload_func);
l:=opr.ref.offset;
opr.typ:=OPR_SYMBOL;
opr.symbol:=current_asmdata.RefAsmSymbol(tprocsym(sym).first_procdef.mangledname);
opr.symbol:=current_asmdata.RefAsmSymbol(tprocdef(tprocsym(sym).ProcdefList[0]).mangledname);
opr.symofs:=l;
hasvar:=true;
SetupVar:=TRUE;

583
compiler/symsym.pas
View File

@ -78,17 +78,12 @@ interface
constructor create;
end;
Tprocdefcallback = procedure(p:Tprocdef;arg:pointer);
tprocsym = class(tstoredsym)
protected
pdlistfirst,
pdlistlast : pprocdeflist; { linked list of overloaded procdefs }
function getprocdef(nr:cardinal):Tprocdef;
FProcdefList : TFPObjectList;
FProcdefDerefList : TFPList;
public
procdef_count : byte;
overloadchecked : boolean;
property procdef[nr:cardinal]:Tprocdef read getprocdef;
constructor create(const n : string);
constructor ppuload(ppufile:tcompilerppufile);
destructor destroy;override;
@ -101,12 +96,7 @@ interface
procedure ppuwrite(ppufile:tcompilerppufile);override;
procedure buildderef;override;
procedure deref;override;
procedure addprocdef(p:tprocdef);
procedure addprocdef_deref(const d:tderef);
procedure add_para_match_to(Aprocsym:Tprocsym;cpoptions:tcompare_paras_options);
procedure concat_procdefs_to(s:Tprocsym);
procedure foreach_procdef_static(proc2call:Tprocdefcallback;arg:pointer);
function first_procdef:Tprocdef;
function find_procdef_bytype(pt:Tproctypeoption):Tprocdef;
function find_procdef_bypara(para:TFPObjectList;retdef:tdef;cpoptions:tcompare_paras_options):Tprocdef;
function find_procdef_byprocvardef(d:Tprocvardef):Tprocdef;
@ -114,6 +104,7 @@ interface
{ currobjdef is the object def to assume, this is necessary for protected and
private, context is the object def we're really in, this is for the strict stuff }
function is_visible_for_object(currobjdef:tdef;context:tdef):boolean;override;
property ProcdefList:TFPObjectList read FProcdefList;
end;
ttypesym = class(Tstoredsym)
@ -501,335 +492,211 @@ implementation
****************************************************************************}
constructor tprocsym.create(const n : string);
begin
inherited create(procsym,n);
pdlistfirst:=nil;
pdlistlast:=nil;
FProcdefList:=TFPObjectList.Create(false);
FProcdefderefList:=nil;
{ the tprocdef have their own symoptions, make the procsym
always visible }
symoptions:=[sp_public];
overloadchecked:=false;
procdef_count:=0;
end;
constructor tprocsym.ppuload(ppufile:tcompilerppufile);
var
pdderef : tderef;
i,n : longint;
i,
pdcnt : longint;
begin
inherited ppuload(procsym,ppufile);
pdlistfirst:=nil;
pdlistlast:=nil;
procdef_count:=0;
n:=ppufile.getword;
for i:=1to n do
FProcdefList:=TFPObjectList.Create(false);
FProcdefDerefList:=TFPList.Create;
pdcnt:=ppufile.getword;
for i:=1 to pdcnt do
begin
ppufile.getderef(pdderef);
addprocdef_deref(pdderef);
FProcdefDerefList.Add(Pointer(PtrInt(pdderef)));
end;
overloadchecked:=false;
end;
destructor tprocsym.destroy;
var
hp,p : pprocdeflist;
begin
p:=pdlistfirst;
while assigned(p) do
begin
hp:=p^.next;
dispose(p);
p:=hp;
end;
inherited destroy;
FProcdefList.Free;
if assigned(FProcdefDerefList) then
FProcdefDerefList.Free;
inherited destroy;
end;
procedure tprocsym.ppuwrite(ppufile:tcompilerppufile);
var
p : pprocdeflist;
n : word;
i : longint;
begin
inherited ppuwrite(ppufile);
{ count procdefs }
n:=0;
p:=pdlistfirst;
while assigned(p) do
begin
{ only write the proc definitions that belong
to this procsym and are in the global symtable }
if p^.def.owner=owner 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 and are in the global symtable }
if p^.def.owner=owner then
ppufile.putderef(p^.defderef);
p:=p^.next;
end;
ppufile.putword(FProcdefDerefList.Count);
for i:=0 to FProcdefDerefList.Count-1 do
ppufile.putderef(TDeref(PtrInt(FProcdefDerefList[i])));
ppufile.writeentry(ibprocsym);
end;
procedure tprocsym.write_parameter_lists(skipdef:tprocdef);
var
p : pprocdeflist;
i : longint;
pd : tprocdef;
begin
p:=pdlistfirst;
while assigned(p) do
begin
if p^.def<>skipdef then
MessagePos1(p^.def.fileinfo,sym_h_param_list,p^.def.fullprocname(false));
p:=p^.next;
for i:=0 to ProcdefList.Count-1 do
begin
pd:=tprocdef(ProcdefList[i]);
if pd<>skipdef then
MessagePos1(pd.fileinfo,sym_h_param_list,pd.fullprocname(false));
end;
end;
{Makes implicit externals (procedures declared in the interface
section which do not have a counterpart in the implementation)
to be an imported procedure. For mode macpas.}
procedure import_implict_external(pd:tabstractprocdef);
begin
tprocdef(pd).forwarddef:=false;
tprocdef(pd).setmangledname(target_info.CPrefix+tprocdef(pd).procsym.realname);
end;
procedure tprocsym.check_forward;
var
p : pprocdeflist;
i : longint;
pd : tprocdef;
begin
p:=pdlistfirst;
while assigned(p) do
begin
if (p^.def.owner=owner) and (p^.def.forwarddef) then
begin
if (m_mac in current_settings.modeswitches) and (p^.def.interfacedef) then
import_implict_external(p^.def)
else
begin
MessagePos1(p^.def.fileinfo,sym_e_forward_not_resolved,p^.def.fullprocname(false));
{ Turn further error messages off }
p^.def.forwarddef:=false;
end
for i:=0 to ProcdefList.Count-1 do
begin
pd:=tprocdef(ProcdefList[i]);
if (pd.owner=owner) and (pd.forwarddef) then
begin
{ For mode macpas. Make implicit externals (procedures declared in the interface
section which do not have a counterpart in the implementation)
to be an imported procedure }
if (m_mac in current_settings.modeswitches) and
(pd.interfacedef) then
begin
pd.forwarddef:=false;
pd.setmangledname(target_info.CPrefix+tprocdef(pd).procsym.realname);
end
else
begin
MessagePos1(pd.fileinfo,sym_e_forward_not_resolved,pd.fullprocname(false));
{ Turn further error messages off }
pd.forwarddef:=false;
end
end;
p:=p^.next;
end;
end;
procedure tprocsym.buildderef;
var
p : pprocdeflist;
i : longint;
pd : tprocdef;
d : tderef;
begin
p:=pdlistfirst;
while assigned(p) do
begin
if p^.def.owner=owner then
p^.defderef.build(p^.def);
p:=p^.next;
end;
if not assigned(FProcdefDerefList) then
FProcdefDerefList:=TFPList.Create
else
FProcdefDerefList.Clear;
for i:=0 to ProcdefList.Count-1 do
begin
pd:=tprocdef(ProcdefList[i]);
{ only write the proc definitions that belong
to this procsym and are in the global symtable }
if pd.owner=owner then
begin
d.build(pd);
FProcdefDerefList.Add(Pointer(PtrInt(d)));
end;
end;
end;
procedure tprocsym.deref;
var
p : pprocdeflist;
i : longint;
pd : tprocdef;
d : tderef;
begin
{ We have removed the overloaded entries, because they
are not valid anymore and we can't deref them because
the unit were they come from is not necessary in
our uses clause (PFV) }
unchain_overload;
{ Deref our own procdefs }
p:=pdlistfirst;
while assigned(p) do
begin
if not(
(p^.def=nil) or
(p^.def.owner=owner)
) then
internalerror(200310291);
p^.def:=tprocdef(p^.defderef.resolve);
p:=p^.next;
end;
end;
procedure tprocsym.addprocdef(p:tprocdef);
var
pd : pprocdeflist;
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 }
if assigned(pdlistlast) then
begin
pdlistlast^.next:=pd;
pdlistlast:=pd;
end
else
begin
pdlistfirst:=pd;
pdlistlast:=pd;
end;
inc(procdef_count);
end;
function Tprocsym.getprocdef(nr:cardinal):Tprocdef;
var
i : cardinal;
pd : pprocdeflist;
begin
pd:=pdlistfirst;
for i:=2 to nr do
{ Clear all procdefs }
ProcdefList.Clear;
if not assigned(FProcdefDerefList) then
internalerror(200611031);
for i:=0 to FProcdefDerefList.Count-1 do
begin
if not assigned(pd) then
internalerror(200209051);
pd:=pd^.next;
d.dataidx:=PtrInt(FProcdefDerefList[i]);
pd:=tprocdef(d.resolve);
ProcdefList.Add(pd);
end;
getprocdef:=pd^.def;
end;
procedure Tprocsym.add_para_match_to(Aprocsym:Tprocsym;cpoptions:tcompare_paras_options);
var
pd:pprocdeflist;
i : longint;
pd : tprocdef;
begin
pd:=pdlistfirst;
while assigned(pd) do
for i:=0 to ProcdefList.Count-1 do
begin
if Aprocsym.find_procdef_bypara(pd^.def.paras,nil,cpoptions)=nil then
Aprocsym.addprocdef(pd^.def);
pd:=pd^.next;
pd:=tprocdef(ProcdefList[i]);
if Aprocsym.find_procdef_bypara(pd.paras,nil,cpoptions)=nil then
Aprocsym.ProcdefList.Add(pd);
end;
end;
procedure Tprocsym.concat_procdefs_to(s:Tprocsym);
var
pd : pprocdeflist;
begin
pd:=pdlistfirst;
while assigned(pd) do
begin
s.addprocdef(pd^.def);
pd:=pd^.next;
end;
end;
function Tprocsym.first_procdef:Tprocdef;
begin
if assigned(pdlistfirst) then
first_procdef:=pdlistfirst^.def
else
first_procdef:=nil;
end;
procedure Tprocsym.foreach_procdef_static(proc2call:Tprocdefcallback;arg:pointer);
var
p : pprocdeflist;
begin
p:=pdlistfirst;
while assigned(p) do
begin
proc2call(p^.def,arg);
p:=p^.next;
end;
end;
function Tprocsym.Find_procdef_bytype(pt:Tproctypeoption):Tprocdef;
var
p : pprocdeflist;
i : longint;
pd : tprocdef;
begin
result:=nil;
p:=pdlistfirst;
while p<>nil do
begin
if p^.def.proctypeoption=pt then
begin
result:=p^.def;
break;
end;
p:=p^.next;
end;
for i:=0 to ProcdefList.Count-1 do
begin
pd:=tprocdef(ProcdefList[i]);
if pd.proctypeoption=pt then
begin
result:=pd;
exit;
end;
end;
end;
function Tprocsym.Find_procdef_bypara(para:TFPObjectList;retdef:tdef;
cpoptions:tcompare_paras_options):Tprocdef;
var
pd : pprocdeflist;
i : longint;
pd : tprocdef;
eq : tequaltype;
begin
result:=nil;
pd:=pdlistfirst;
while assigned(pd) do
begin
if assigned(retdef) then
eq:=compare_defs(retdef,pd^.def.returndef,nothingn)
else
eq:=te_equal;
if (eq>=te_equal) or
((cpo_allowconvert in cpoptions) and (eq>te_incompatible)) then
begin
eq:=compare_paras(para,pd^.def.paras,cp_value_equal_const,cpoptions);
if (eq>=te_equal) or
((cpo_allowconvert in cpoptions) and (eq>te_incompatible)) then
begin
result:=pd^.def;
break;
end;
end;
pd:=pd^.next;
end;
for i:=0 to ProcdefList.Count-1 do
begin
pd:=tprocdef(ProcdefList[i]);
if assigned(retdef) then
eq:=compare_defs(retdef,pd.returndef,nothingn)
else
eq:=te_equal;
if (eq>=te_equal) or
((cpo_allowconvert in cpoptions) and (eq>te_incompatible)) then
begin
eq:=compare_paras(para,pd.paras,cp_value_equal_const,cpoptions);
if (eq>=te_equal) or
((cpo_allowconvert in cpoptions) and (eq>te_incompatible)) then
begin
result:=pd;
exit;
end;
end;
end;
end;
function Tprocsym.Find_procdef_byprocvardef(d:Tprocvardef):Tprocdef;
var
pd : pprocdeflist;
i : longint;
bestpd,
pd : tprocdef;
eq,besteq : tequaltype;
bestpd : tprocdef;
begin
{ This function will return the pprocdef of pprocsym that
is the best match for procvardef. When there are multiple
@ -837,86 +704,88 @@ implementation
result:=nil;
bestpd:=nil;
besteq:=te_incompatible;
pd:=pdlistfirst;
while assigned(pd) do
begin
eq:=proc_to_procvar_equal(pd^.def,d);
if eq>=te_equal then
begin
{ multiple procvars with the same equal level }
if assigned(bestpd) and
(besteq=eq) then
exit;
if eq>besteq then
begin
besteq:=eq;
bestpd:=pd^.def;
end;
end;
pd:=pd^.next;
end;
for i:=0 to ProcdefList.Count-1 do
begin
pd:=tprocdef(ProcdefList[i]);
eq:=proc_to_procvar_equal(pd,d);
if eq>=te_equal then
begin
{ multiple procvars with the same equal level }
if assigned(bestpd) and
(besteq=eq) then
exit;
if eq>besteq then
begin
besteq:=eq;
bestpd:=pd;
end;
end;
end;
result:=bestpd;
end;
function Tprocsym.Find_procdef_assignment_operator(fromdef,todef:tdef;var besteq:tequaltype):Tprocdef;
var
paraidx,
i : longint;
bestpd,
hpd,
pd : tprocdef;
convtyp : tconverttype;
pd : pprocdeflist;
bestpd : tprocdef;
eq : tequaltype;
hpd : tprocdef;
i : byte;
begin
{ This function will return the pprocdef of pprocsym that
is the best match for procvardef. When there are multiple
matches it returns nil.}
result:=nil;
bestpd:=nil;
besteq:=te_incompatible;
pd:=pdlistfirst;
while assigned(pd) do
for i:=0 to ProcdefList.Count-1 do
begin
if equal_defs(todef,pd^.def.returndef) and
{ the result type must be always really equal and not an alias,
if you mess with this code, check tw4093 }
((todef=pd^.def.returndef) or
(
not(df_unique in todef.defoptions) and
not(df_unique in pd^.def.returndef.defoptions)
)
) then
begin
i:=0;
{ ignore vs_hidden parameters }
while (i<pd^.def.paras.count) and
assigned(pd^.def.paras[i]) and
(vo_is_hidden_para in tparavarsym(pd^.def.paras[i]).varoptions) do
inc(i);
if (i<pd^.def.paras.count) and
assigned(pd^.def.paras[i]) then
begin
eq:=compare_defs_ext(fromdef,tparavarsym(pd^.def.paras[i]).vardef,nothingn,convtyp,hpd,[]);
pd:=tprocdef(ProcdefList[i]);
if equal_defs(todef,pd.returndef) and
{ the result type must be always really equal and not an alias,
if you mess with this code, check tw4093 }
((todef=pd.returndef) or
(
not(df_unique in todef.defoptions) and
not(df_unique in pd.returndef.defoptions)
)
) then
begin
paraidx:=0;
{ ignore vs_hidden parameters }
while (paraidx<pd.paras.count) and
assigned(pd.paras[paraidx]) and
(vo_is_hidden_para in tparavarsym(pd.paras[paraidx]).varoptions) do
inc(paraidx);
if (paraidx<pd.paras.count) and
assigned(pd.paras[paraidx]) then
begin
eq:=compare_defs_ext(fromdef,tparavarsym(pd.paras[paraidx]).vardef,nothingn,convtyp,hpd,[]);
{ alias? if yes, only l1 choice,
if you mess with this code, check tw4093 }
if (eq=te_exact) and
(fromdef<>tparavarsym(pd^.def.paras[i]).vardef) and
((df_unique in fromdef.defoptions) or
(df_unique in tparavarsym(pd^.def.paras[i]).vardef.defoptions)) then
eq:=te_convert_l1;
{ alias? if yes, only l1 choice,
if you mess with this code, check tw4093 }
if (eq=te_exact) and
(fromdef<>tparavarsym(pd.paras[paraidx]).vardef) and
((df_unique in fromdef.defoptions) or
(df_unique in tparavarsym(pd.paras[paraidx]).vardef.defoptions)) then
eq:=te_convert_l1;
if eq=te_exact then
begin
besteq:=eq;
result:=pd^.def;
exit;
end;
if eq>besteq then
begin
bestpd:=pd^.def;
besteq:=eq;
end;
end;
end;
pd:=pd^.next;
if eq=te_exact then
begin
besteq:=eq;
result:=pd;
exit;
end;
if eq>besteq then
begin
bestpd:=pd;
besteq:=eq;
end;
end;
end;
end;
result:=bestpd;
end;
@ -924,71 +793,49 @@ implementation
procedure tprocsym.unchain_overload;
var
p,hp : pprocdeflist;
i : longint;
pd : tprocdef;
begin
{ remove all overloaded procdefs from the
procdeflist that are not in the current symtable }
overloadchecked:=false;
p:=pdlistfirst;
{ reset new lists }
pdlistfirst:=nil;
pdlistlast:=nil;
while assigned(p) do
begin
hp:=p^.next;
{ only keep the proc definitions:
- are not deref'd (def=nil)
- are in the same symtable as the procsym (for example both
are in the staticsymtable) }
if (p^.def=nil) or
(p^.def.owner=owner) then
begin
{ keep, add to list }
if assigned(pdlistlast) then
begin
pdlistlast^.next:=p;
pdlistlast:=p;
end
else
begin
pdlistfirst:=p;
pdlistlast:=p;
end;
p^.next:=nil;
end
else
begin
{ remove }
dispose(p);
dec(procdef_count);
end;
p:=hp;
end;
{ remove all overloaded procdefs from the
procdeflist that are not in the current symtable }
overloadchecked:=false;
{ reset new lists }
for i:=0 to ProcdefList.Count-1 do
begin
pd:=tprocdef(ProcdefList[i]);
{ only keep the proc definitions:
- are not deref'd (def=nil)
- are in the same symtable as the procsym (for example both
are in the staticsymtable) }
if not(pd.owner=owner) then
ProcdefList[i]:=nil;
end;
{ Remove cleared entries }
ProcdefList.Pack;
end;
function tprocsym.is_visible_for_object(currobjdef:tdef;context:tdef):boolean;
var
p : pprocdeflist;
i : longint;
pd : tprocdef;
begin
{ This procsym is visible, when there is at least
one of the procdefs visible }
result:=false;
p:=pdlistfirst;
while assigned(p) do
for i:=0 to ProcdefList.Count-1 do
begin
if (p^.def.owner=owner) and
p^.def.is_visible_for_object(tobjectdef(currobjdef),tobjectdef(context)) then
begin
result:=true;
exit;
end;
p:=p^.next;
pd:=tprocdef(ProcdefList[i]);
if (pd.owner=owner) and
pd.is_visible_for_object(tobjectdef(currobjdef),tobjectdef(context)) then
begin
result:=true;
exit;
end;
end;
end;
{****************************************************************************
TERRORSYM
****************************************************************************}

6
compiler/systems/t_beos.pas
View File

@ -135,6 +135,7 @@ end;
procedure texportlibbeos.generatelib;
var
hp2 : texported_item;
pd : tprocdef;
begin
hp2:=texported_item(current_module._exports.first);
while assigned(hp2) do
@ -144,13 +145,14 @@ begin
begin
{ the manglednames can already be the same when the procedure
is declared with cdecl }
if tprocsym(hp2.sym).first_procdef.mangledname<>hp2.name^ then
pd:=tprocdef(tprocsym(hp2.sym).ProcdefList[0]);
if pd.mangledname<>hp2.name^ then
begin
{$ifdef i386}
{ place jump in al_procedures }
current_asmdata.asmlists[al_procedures].concat(Tai_align.Create_op(4,$90));
current_asmdata.asmlists[al_procedures].concat(Tai_symbol.Createname_global(hp2.name^,AT_FUNCTION,0));
current_asmdata.asmlists[al_procedures].concat(Taicpu.Op_sym(A_JMP,S_NO,current_asmdata.RefAsmSymbol(tprocsym(hp2.sym).first_procdef.mangledname)));
current_asmdata.asmlists[al_procedures].concat(Taicpu.Op_sym(A_JMP,S_NO,current_asmdata.RefAsmSymbol(pd.mangledname)));
current_asmdata.asmlists[al_procedures].concat(Tai_symbol_end.Createname(hp2.name^));
{$endif i386}
end;

8
compiler/systems/t_bsd.pas
View File

@ -152,6 +152,7 @@ end;
procedure texportlibbsd.generatelib; // straight t_linux copy for now.
var
hp2 : texported_item;
pd : tprocdef;
{$ifdef x86}
sym : tasmsymbol;
r : treference;
@ -166,7 +167,8 @@ begin
begin
{ the manglednames can already be the same when the procedure
is declared with cdecl }
if tprocsym(hp2.sym).first_procdef.mangledname<>hp2.name^ then
pd:=tprocdef(tprocsym(hp2.sym).ProcdefList[0]);
if pd.mangledname<>hp2.name^ then
begin
{ place jump in al_procedures }
current_asmdata.asmlists[al_procedures].concat(tai_align.create(target_info.alignment.procalign));
@ -176,7 +178,7 @@ begin
(target_info.system in [system_i386_freebsd]) then
begin
{$ifdef x86}
sym:=current_asmdata.RefAsmSymbol(tprocsym(hp2.sym).first_procdef.mangledname);
sym:=current_asmdata.RefAsmSymbol(pd.mangledname);
reference_reset_symbol(r,sym,0);
if cs_create_pic in current_settings.moduleswitches then
r.refaddr:=addr_pic
@ -186,7 +188,7 @@ begin
{$endif x86}
end
else
cg.a_jmp_name(current_asmdata.asmlists[al_procedures],tprocsym(hp2.sym).first_procdef.mangledname);
cg.a_jmp_name(current_asmdata.asmlists[al_procedures],pd.mangledname);
current_asmdata.asmlists[al_procedures].concat(Tai_symbol_end.Createname(hp2.name^));
end;
end

8
compiler/systems/t_linux.pas
View File

@ -148,6 +148,7 @@ end;
procedure texportliblinux.generatelib;
var
hp2 : texported_item;
pd : tprocdef;
{$ifdef x86}
sym : tasmsymbol;
r : treference;
@ -162,7 +163,8 @@ begin
begin
{ the manglednames can already be the same when the procedure
is declared with cdecl }
if tprocsym(hp2.sym).first_procdef.mangledname<>hp2.name^ then
pd:=tprocdef(tprocsym(hp2.sym).ProcdefList[0]);
if pd.mangledname<>hp2.name^ then
begin
{ place jump in al_procedures }
current_asmdata.asmlists[al_procedures].concat(tai_align.create(target_info.alignment.procalign));
@ -172,7 +174,7 @@ begin
(target_info.system in [system_x86_64_linux,system_i386_linux]) then
begin
{$ifdef x86}
sym:=current_asmdata.RefAsmSymbol(tprocsym(hp2.sym).first_procdef.mangledname);
sym:=current_asmdata.RefAsmSymbol(pd.mangledname);
reference_reset_symbol(r,sym,0);
if cs_create_pic in current_settings.moduleswitches then
r.refaddr:=addr_pic
@ -182,7 +184,7 @@ begin
{$endif x86}
end
else
cg.a_jmp_name(current_asmdata.asmlists[al_procedures],tprocsym(hp2.sym).first_procdef.mangledname);
cg.a_jmp_name(current_asmdata.asmlists[al_procedures],pd.mangledname);
current_asmdata.asmlists[al_procedures].concat(Tai_symbol_end.Createname(hp2.name^));
end;
end

6
compiler/systems/t_nwl.pas
View File

@ -213,6 +213,7 @@ end;
procedure texportlibnetwlibc.generatelib;
var
hp2 : texported_item;
pd : tprocdef;
begin
hp2:=texported_item(current_module._exports.first);
while assigned(hp2) do
@ -222,13 +223,14 @@ begin
begin
{ the manglednames can already be the same when the procedure
is declared with cdecl }
if tprocsym(hp2.sym).first_procdef.mangledname<>hp2.name^ then
pd:=tprocdef(tprocsym(hp2.sym).ProcdefList[0]);
if pd.mangledname<>hp2.name^ then
begin
{$ifdef i386}
{ place jump in al_procedures }
current_asmdata.asmlists[al_procedures].concat(Tai_align.Create_op(4,$90));
current_asmdata.asmlists[al_procedures].concat(Tai_symbol.Createname_global(hp2.name^,AT_FUNCTION,0));
current_asmdata.asmlists[al_procedures].concat(Taicpu.Op_sym(A_JMP,S_NO,current_asmdata.RefAsmSymbol(tprocsym(hp2.sym).first_procdef.mangledname)));
current_asmdata.asmlists[al_procedures].concat(Taicpu.Op_sym(A_JMP,S_NO,current_asmdata.RefAsmSymbol(pd.mangledname)));
current_asmdata.asmlists[al_procedures].concat(Tai_symbol_end.Createname(hp2.name^));
{$endif i386}
end;

6
compiler/systems/t_nwm.pas
View File

@ -205,6 +205,7 @@ end;
procedure texportlibnetware.generatelib;
var
hp2 : texported_item;
pd : tprocdef;
begin
hp2:=texported_item(current_module._exports.first);
while assigned(hp2) do
@ -214,13 +215,14 @@ begin
begin
{ the manglednames can already be the same when the procedure
is declared with cdecl }
if tprocsym(hp2.sym).first_procdef.mangledname<>hp2.name^ then
pd:=tprocdef(tprocsym(hp2.sym).ProcdefList[0]);
if pd.mangledname<>hp2.name^ then
begin
{$ifdef i386}
{ place jump in al_procedures }
current_asmdata.asmlists[al_procedures].concat(Tai_align.Create_op(4,$90));
current_asmdata.asmlists[al_procedures].concat(Tai_symbol.Createname_global(hp2.name^,AT_FUNCTION,0));
current_asmdata.asmlists[al_procedures].concat(Taicpu.Op_sym(A_JMP,S_NO,current_asmdata.RefAsmSymbol(tprocsym(hp2.sym).first_procdef.mangledname)));
current_asmdata.asmlists[al_procedures].concat(Taicpu.Op_sym(A_JMP,S_NO,current_asmdata.RefAsmSymbol(pd.mangledname)));
current_asmdata.asmlists[al_procedures].concat(Tai_symbol_end.Createname(hp2.name^));
{$endif i386}
end;

6
compiler/systems/t_sunos.pas
View File

@ -146,6 +146,7 @@ end;
procedure texportlibsolaris.generatelib;
var
hp2 : texported_item;
pd : tprocdef;
begin
new_section(current_asmdata.asmlists[al_procedures],sec_code,'',0);
hp2:=texported_item(current_module._exports.first);
@ -156,12 +157,13 @@ begin
begin
{ the manglednames can already be the same when the procedure
is declared with cdecl }
if tprocsym(hp2.sym).first_procdef.mangledname<>hp2.name^ then
pd:=tprocdef(tprocsym(hp2.sym).ProcdefList[0]);
if pd.mangledname<>hp2.name^ then
begin
{ place jump in al_procedures }
current_asmdata.asmlists[al_procedures].concat(tai_align.create(target_info.alignment.procalign));
current_asmdata.asmlists[al_procedures].concat(Tai_symbol.Createname_global(hp2.name^,AT_FUNCTION,0));
cg.a_jmp_name(current_asmdata.asmlists[al_procedures],tprocsym(hp2.sym).first_procdef.mangledname);
cg.a_jmp_name(current_asmdata.asmlists[al_procedures],pd.mangledname);
current_asmdata.asmlists[al_procedures].concat(Tai_symbol_end.Createname(hp2.name^));
end;
end

4
compiler/systems/t_win.pas
View File

@ -831,7 +831,7 @@ implementation
typedconstsym :
address_table.concat(Tai_const.Createname_rva(ttypedconstsym(hp.sym).mangledname));
procsym :
address_table.concat(Tai_const.Createname_rva(tprocsym(hp.sym).first_procdef.mangledname));
address_table.concat(Tai_const.Createname_rva(tprocdef(tprocsym(hp.sym).ProcdefList[0]).mangledname));
end;
inc(current_index);
hp:=texported_item(hp.next);
@ -865,7 +865,7 @@ implementation
typedconstsym :
s:=ttypedconstsym(hp.sym).mangledname;
procsym :
s:=tprocsym(hp.sym).first_procdef.mangledname;
s:=tprocdef(tprocsym(hp.sym).ProcdefList[0]).mangledname;
else
s:='';
end;

4
compiler/x86/rax86int.pas
View File

@ -974,9 +974,9 @@ Unit Rax86int;
end;
procsym :
begin
if Tprocsym(sym).procdef_count>1 then
if Tprocsym(sym).ProcdefList.Count>1 then
Message(asmr_w_calling_overload_func);
hs:=tprocsym(sym).first_procdef.mangledname;
hs:=tprocdef(tprocsym(sym).ProcdefList[0]).mangledname;
hssymtyp:=AT_FUNCTION;
end;
typesym :