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

+ implemented creation of methodname/address tables

Browse Source
This commit is contained in:
florian 1999-09-12 14:50:50 +00:00
parent 0b1a446166
commit c3b3c19887
2 changed files with 67 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

57
compiler/hcgdata.pas
View File

@ -30,6 +30,8 @@ interface
{ generates the message tables for a class }
function genstrmsgtab(_class : pobjectdef) : pasmlabel;
function genintmsgtab(_class : pobjectdef) : pasmlabel;
{ generates the method name table }
function genpublishedmethodstable(_class : pobjectdef) : pasmlabel;
{ generates a VMT for _class }
procedure genvmt(list : paasmoutput;_class : pobjectdef);
@ -255,6 +257,56 @@ implementation
end;
end;
procedure do_count(p : pnamedindexobject);{$ifndef FPC}far;{$endif FPC}
begin
if (psym(p)^.typ=procsym) and (sp_published in psym(p)^.symoptions) then
inc(count);
end;
procedure genpubmethodtableentry(p : pnamedindexobject);{$ifndef FPC}far;{$endif FPC}
var
hp : pprocdef;
pt : pprocdeftree;
l : pasmlabel;
begin
if (psym(p)^.typ=procsym) and (sp_published in psym(p)^.symoptions) then
begin
hp:=pprocsym(p)^.definition;
if assigned(hp^.nextoverloaded) then
internalerror(1209992);
getlabel(l);
consts^.concat(new(pai_label,init(l)));
consts^.concat(new(pai_const,init_8bit(length(p^.name))));
consts^.concat(new(pai_string,init(p^.name)));
datasegment^.concat(new(pai_const_symbol,init(l)));
datasegment^.concat(new(pai_const_symbol,initname(hp^.mangledname)));
end;
end;
function genpublishedmethodstable(_class : pobjectdef) : pasmlabel;
var
l : pasmlabel;
begin
count:=0;
_class^.symtable^.foreach({$ifndef TP}@{$endif}do_count);
if count>0 then
begin
getlabel(l);
datasegment^.concat(new(pai_label,init(l)));
datasegment^.concat(new(pai_const,init_32bit(count)));
_class^.symtable^.foreach({$ifndef TP}@{$endif}genpubmethodtableentry);
genpublishedmethodstable:=l;
end
else
genpublishedmethodstable:=nil;
end;
{*****************************************************************************
VMT
@ -563,7 +615,10 @@ implementation
end.
{
$Log$
Revision 1.15 1999-09-01 13:44:56 florian
Revision 1.16 1999-09-12 14:50:50 florian
+ implemented creation of methodname/address tables
Revision 1.15 1999/09/01 13:44:56 florian
* fixed writing of class rtti: vmt offset were written wrong
Revision 1.14 1999/08/03 22:02:52 peter

14
compiler/pdecl.pas
View File

@ -1386,7 +1386,8 @@ unit pdecl;
hp1 : pdef;
oldprocsym : pprocsym;
oldparse_only : boolean;
intmessagetable,strmessagetable,classnamelabel : pasmlabel;
methodnametable,intmessagetable,
strmessagetable,classnamelabel : pasmlabel;
storetypeforwardsallowed : boolean;
vmtlist : taasmoutput;
@ -1731,6 +1732,7 @@ unit pdecl;
class is written, because we need the labels defined }
if is_a_class then
begin
methodnametable:=genpublishedmethodstable(aktclass);
{ rtti }
if (oo_can_have_published in aktclass^.objectoptions) then
aktclass^.generate_rtti;
@ -1786,7 +1788,10 @@ unit pdecl;
else
datasegment^.concat(new(pai_const,init_32bit(0)));
{ pointer to method table }
datasegment^.concat(new(pai_const,init_32bit(0)));
if assigned(methodnametable) then
datasegment^.concat(new(pai_const_symbol,init(methodnametable)))
else
datasegment^.concat(new(pai_const,init_32bit(0)));
{ pointer to field table }
datasegment^.concat(new(pai_const,init_32bit(0)));
{ pointer to type info of published section }
@ -2527,7 +2532,10 @@ unit pdecl;
end.
{
$Log$
Revision 1.151 1999-09-12 08:48:09 florian
Revision 1.152 1999-09-12 14:50:50 florian
+ implemented creation of methodname/address tables
Revision 1.151 1999/09/12 08:48:09 florian
* bugs 593 and 607 fixed
* some other potential bugs with array constructors fixed
* for classes compiled in $M+ and it's childs, the default access method