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

* converted rest of VMT generation to high level typed const builder

Browse Source 
git-svn-id: trunk@30369 -
This commit is contained in:
Jonas Maebe 2015-03-29 18:16:48 +00:00
parent 9bf410e6a0
commit 69e7b06cef
1 changed files with 211 additions and 193 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

404
compiler/ncgvmt.pas
View File

@ -42,6 +42,8 @@ interface
_Class : tobjectdef; _Class : tobjectdef;
{ message tables } { message tables }
root : pprocdeftree; root : pprocdeftree;
{ implemented interface vtables }
fintfvtablelabels: array of TAsmLabel;
procedure disposeprocdeftree(p : pprocdeftree); procedure disposeprocdeftree(p : pprocdeftree);
procedure insertmsgint(p:TObject;arg:pointer); procedure insertmsgint(p:TObject;arg:pointer);
@ -49,7 +51,7 @@ interface
procedure insertint(p : pprocdeftree;var at : pprocdeftree;var count:longint); procedure insertint(p : pprocdeftree;var at : pprocdeftree;var count:longint);
procedure insertstr(p : pprocdeftree;var at : pprocdeftree;var count:longint); procedure insertstr(p : pprocdeftree;var at : pprocdeftree;var count:longint);
function RedirectToEmpty(procdef: tprocdef): boolean; function RedirectToEmpty(procdef: tprocdef): boolean;
procedure writenames(list : TAsmList;p : pprocdeftree); procedure writenames(tcb: ttai_typedconstbuilder; p: pprocdeftree);
procedure writeintentry(tcb: ttai_typedconstbuilder; p: pprocdeftree; entrydef: tdef); procedure writeintentry(tcb: ttai_typedconstbuilder; p: pprocdeftree; entrydef: tdef);
procedure writestrentry(tcb: ttai_typedconstbuilder; p: pprocdeftree; entrydef: tdef); procedure writestrentry(tcb: ttai_typedconstbuilder; p: pprocdeftree; entrydef: tdef);
{$ifdef WITHDMT} {$ifdef WITHDMT}
@ -62,12 +64,11 @@ interface
procedure do_count_published_methods(p:TObject;arg:pointer); procedure do_count_published_methods(p:TObject;arg:pointer);
procedure do_gen_published_methods(p:TObject;arg:pointer); procedure do_gen_published_methods(p:TObject;arg:pointer);
{ virtual methods } { virtual methods }
procedure writevirtualmethods(List:TAsmList); procedure writevirtualmethods(tcb: ttai_typedconstbuilder);
{ interface tables } { interface tables }
function intf_get_vtbl_name(AImplIntf:TImplementedInterface): string; procedure intf_create_vtbl(tcb: ttai_typedconstbuilder; AImplIntf: TImplementedInterface; intfindex: longint);
procedure intf_create_vtbl(rawdata: TAsmList;AImplIntf:TImplementedInterface); procedure intf_gen_intf_ref(tcb: ttai_typedconstbuilder; AImplIntf: TImplementedInterface; intfindex: longint; interfaceentrydef, interfaceentrytypedef: tdef);
procedure intf_gen_intf_ref(tcb: ttai_typedconstbuilder; AImplIntf: TImplementedInterface; interfaceentrydef, interfaceentrytypedef: tdef); procedure intf_write_table(tcb: ttai_typedconstbuilder; out lab: TAsmLabel; out intftabledef: trecorddef);
function intf_write_table(list : TAsmList):TAsmLabel;
{ get a table def of the form { get a table def of the form
record record
count: countdef; count: countdef;
@ -78,10 +79,10 @@ interface
procedure gettabledef(const basename: string; countdef, elementdef: tdef; count: longint; packrecords: shortint; out recdef: trecorddef; out arrdef: tarraydef); procedure gettabledef(const basename: string; countdef, elementdef: tdef; count: longint; packrecords: shortint; out recdef: trecorddef; out arrdef: tarraydef);
function getrecorddef(const name: string; const fields: array of tdef; packrecords: shortint): trecorddef; function getrecorddef(const name: string; const fields: array of tdef; packrecords: shortint): trecorddef;
{ generates the message tables for a class } { generates the message tables for a class }
function genstrmsgtab(list : TAsmList) : tasmlabel; procedure genstrmsgtab(tcb: ttai_typedconstbuilder; out lab: tasmlabel; out msgstrtabledef: trecorddef);
function genintmsgtab(list : TAsmList) : tasmlabel; procedure genintmsgtab(tcb: ttai_typedconstbuilder; out lab: tasmlabel; out msginttabledef: trecorddef);
function genpublishedmethodstable(list : TAsmList) : tasmlabel; procedure genpublishedmethodstable(tcb: ttai_typedconstbuilder; out lab: tasmlabel; out pubmethodsdef: trecorddef);
function generate_field_table(list : TAsmList) : tasmlabel; procedure generate_field_table(tcb: ttai_typedconstbuilder; out lab: tasmlabel; out fieldtabledef: trecorddef);
procedure generate_abstract_stub(list:TAsmList;pd:tprocdef); procedure generate_abstract_stub(list:TAsmList;pd:tprocdef);
{$ifdef WITHDMT} {$ifdef WITHDMT}
{ generates a DMT for _class } { generates a DMT for _class }
@ -229,28 +230,26 @@ implementation
end; end;
procedure TVMTWriter.writenames(list : TAsmList;p : pprocdeftree); procedure TVMTWriter.writenames(tcb: ttai_typedconstbuilder; p: pprocdeftree);
var var
ca : pchar; ca : pchar;
len : byte; len : byte;
tcb : ttai_typedconstbuilder; datatcb : ttai_typedconstbuilder;
begin begin
current_asmdata.getglobaldatalabel(p^.nl);
if assigned(p^.l) then if assigned(p^.l) then
writenames(list,p^.l); writenames(tcb,p^.l);
tcb:=ctai_typedconstbuilder.create([tcalo_is_lab]); tcb.start_internal_data_builder(current_asmdata.AsmLists[al_const],sec_rodata_norel,'',datatcb,p^.nl);
len:=length(p^.data.messageinf.str^); len:=length(p^.data.messageinf.str^);
tcb.maybe_begin_aggregate(getarraydef(cansichartype,len+1)); datatcb.maybe_begin_aggregate(getarraydef(cansichartype,len+1));
tcb.emit_tai(tai_const.create_8bit(len),cansichartype); datatcb.emit_tai(tai_const.create_8bit(len),cansichartype);
getmem(ca,len+1); getmem(ca,len+1);
move(p^.data.messageinf.str^[1],ca^,len); move(p^.data.messageinf.str^[1],ca^,len);
ca[len]:=#0; ca[len]:=#0;
tcb.emit_tai(Tai_string.Create_pchar(ca,len),getarraydef(cansichartype,len)); datatcb.emit_tai(Tai_string.Create_pchar(ca,len),getarraydef(cansichartype,len));
tcb.maybe_end_aggregate(getarraydef(cansichartype,len+1)); datatcb.maybe_end_aggregate(getarraydef(cansichartype,len+1));
list.concatList(tcb.get_final_asmlist(p^.nl,getarraydef(cansichartype,len+1),sec_rodata_norel,'',sizeof(pint))); tcb.finish_internal_data_builder(datatcb,p^.nl,getarraydef(cansichartype,len+1),sizeof(pint));
tcb.free;
if assigned(p^.r) then if assigned(p^.r) then
writenames(list,p^.r); writenames(tcb,p^.r);
end; end;
procedure TVMTWriter.writestrentry(tcb: ttai_typedconstbuilder; p: pprocdeftree; entrydef: tdef); procedure TVMTWriter.writestrentry(tcb: ttai_typedconstbuilder; p: pprocdeftree; entrydef: tdef);
@ -270,11 +269,10 @@ implementation
end; end;
function TVMTWriter.genstrmsgtab(list : TAsmList) : tasmlabel; procedure TVMTWriter.genstrmsgtab(tcb: ttai_typedconstbuilder; out lab: tasmlabel; out msgstrtabledef: trecorddef);
var var
count : longint; count : longint;
tcb: ttai_typedconstbuilder; datatcb: ttai_typedconstbuilder;
msgstrtabdef: trecorddef;
msgstrentry: tdef; msgstrentry: tdef;
msgarraydef: tarraydef; msgarraydef: tarraydef;
begin begin
@ -283,13 +281,12 @@ implementation
{ insert all message handlers into a tree, sorted by name } { insert all message handlers into a tree, sorted by name }
_class.symtable.SymList.ForEachCall(@insertmsgstr,@count); _class.symtable.SymList.ForEachCall(@insertmsgstr,@count);
tcb:=ctai_typedconstbuilder.create([tcalo_is_lab]);
{ write all names } { write all names }
if assigned(root) then if assigned(root) then
writenames(list,root); writenames(tcb,root);
{ now start writing of the message string table } { now start writing the message string table }
current_asmdata.getlabel(result,alt_data); tcb.start_internal_data_builder(current_asmdata.AsmLists[al_const],sec_rodata,'',datatcb,lab);
{ {
TStringMessageTable = record TStringMessageTable = record
count : longint; count : longint;
@ -299,21 +296,20 @@ implementation
Instead of 0 as the upper bound, use the actual upper bound Instead of 0 as the upper bound, use the actual upper bound
} }
msgstrentry:=search_system_type('TMSGSTRTABLE').typedef; msgstrentry:=search_system_type('TMSGSTRTABLE').typedef;
gettabledef('fpc_intern_TStringMessageTable_',s32inttype,msgstrentry,count,0,msgstrtabdef,msgarraydef); gettabledef('fpc_intern_TStringMessageTable_',s32inttype,msgstrentry,count,0,msgstrtabledef,msgarraydef);
{ outer record (TStringMessageTable) } { outer record (TStringMessageTable) }
tcb.maybe_begin_aggregate(msgstrtabdef); datatcb.maybe_begin_aggregate(msgstrtabledef);
tcb.emit_tai(Tai_const.Create_32bit(count),s32inttype); datatcb.emit_tai(Tai_const.Create_32bit(count),s32inttype);
if assigned(root) then if assigned(root) then
begin begin
{ array of TMsgStrTable } { array of TMsgStrTable }
tcb.maybe_begin_aggregate(msgarraydef); datatcb.maybe_begin_aggregate(msgarraydef);
writestrentry(tcb,root,msgstrentry); writestrentry(datatcb,root,msgstrentry);
tcb.maybe_end_aggregate(msgarraydef); datatcb.maybe_end_aggregate(msgarraydef);
disposeprocdeftree(root); disposeprocdeftree(root);
end; end;
tcb.maybe_end_aggregate(msgstrtabdef); datatcb.maybe_end_aggregate(msgstrtabledef);
list.concatList(tcb.get_final_asmlist(result,msgstrtabdef,sec_rodata,'',sizeof(pint))); tcb.finish_internal_data_builder(datatcb,lab,msgstrtabledef,sizeof(pint));
tcb.free;
end; end;
@ -334,13 +330,11 @@ implementation
end; end;
function TVMTWriter.genintmsgtab(list : TAsmList) : tasmlabel; procedure TVMTWriter.genintmsgtab(tcb: ttai_typedconstbuilder; out lab: tasmlabel; out msginttabledef: trecorddef);
var var
r : tasmlabel;
count : longint; count : longint;
tcb: ttai_typedconstbuilder; datatcb: ttai_typedconstbuilder;
msgintdef: trecorddef; msgintdef: trecorddef;
msginttabledef: trecorddef;
msgintarrdef: tarraydef; msgintarrdef: tarraydef;
begin begin
root:=nil; root:=nil;
@ -363,22 +357,19 @@ implementation
msgs : array[0..0] of TMsgIntTable; msgs : array[0..0] of TMsgIntTable;
end; end;
} }
current_asmdata.getlabel(r,alt_data); tcb.start_internal_data_builder(current_asmdata.AsmLists[al_const],sec_rodata,'',datatcb,lab);
tcb:=ctai_typedconstbuilder.create([tcalo_is_lab]);
genintmsgtab:=r;
gettabledef('fpc_msgint_table_entries_',s32inttype,msginttabledef,count,0,msgintdef,msgintarrdef); gettabledef('fpc_msgint_table_entries_',s32inttype,msginttabledef,count,0,msgintdef,msgintarrdef);
tcb.maybe_begin_aggregate(msgintdef); datatcb.maybe_begin_aggregate(msgintdef);
tcb.emit_tai(Tai_const.Create_32bit(count),s32inttype); datatcb.emit_tai(Tai_const.Create_32bit(count),s32inttype);
if assigned(root) then if assigned(root) then
begin begin
tcb.maybe_begin_aggregate(msgintarrdef); datatcb.maybe_begin_aggregate(msgintarrdef);
writeintentry(tcb,root,msginttabledef); writeintentry(datatcb,root,msginttabledef);
tcb.maybe_end_aggregate(msgintarrdef); datatcb.maybe_end_aggregate(msgintarrdef);
disposeprocdeftree(root); disposeprocdeftree(root);
end; end;
tcb.maybe_end_aggregate(msgintdef); datatcb.maybe_end_aggregate(msgintdef);
list.concatList(tcb.get_final_asmlist(result,msgintdef,sec_rodata,'',sizeof(pint))); tcb.finish_internal_data_builder(datatcb,lab,msgintdef,sizeof(pint));
tcb.free;
end; end;
{$ifdef WITHDMT} {$ifdef WITHDMT}
@ -490,7 +481,6 @@ implementation
type type
tvmtasmoutput = record tvmtasmoutput = record
pubmethodstcb: ttai_typedconstbuilder; pubmethodstcb: ttai_typedconstbuilder;
list: tasmlist;
methodnamerec: trecorddef; methodnamerec: trecorddef;
end; end;
pvmtasmoutput = ^tvmtasmoutput; pvmtasmoutput = ^tvmtasmoutput;
@ -501,7 +491,7 @@ implementation
l : tasmlabel; l : tasmlabel;
pd : tprocdef; pd : tprocdef;
lists: pvmtasmoutput absolute arg; lists: pvmtasmoutput absolute arg;
tcb : ttai_typedconstbuilder; datatcb : ttai_typedconstbuilder;
namedef : tdef; namedef : tdef;
begin begin
if (tsym(p).typ<>procsym) then if (tsym(p).typ<>procsym) then
@ -512,13 +502,10 @@ implementation
if (pd.procsym=tsym(p)) and if (pd.procsym=tsym(p)) and
(pd.visibility=vis_published) then (pd.visibility=vis_published) then
begin begin
current_asmdata.getlabel(l,alt_data);
{ l: name_of_method } { l: name_of_method }
tcb:=ctai_typedconstbuilder.create([tcalo_is_lab]); lists^.pubmethodstcb.start_internal_data_builder(current_asmdata.AsmLists[al_const],sec_rodata_norel,'',datatcb,l);
namedef:=datatcb.emit_shortstring_const(tsym(p).realname);
namedef:=tcb.emit_shortstring_const(tsym(p).realname); lists^.pubmethodstcb.finish_internal_data_builder(datatcb,l,namedef,sizeof(pint));
lists^.list.concatList(tcb.get_final_asmlist(l,namedef,sec_rodata_norel,'',sizeof(pint)));
tcb.free;
{ the tmethodnamerec } { the tmethodnamerec }
lists^.pubmethodstcb.maybe_begin_aggregate(lists^.methodnamerec); lists^.pubmethodstcb.maybe_begin_aggregate(lists^.methodnamerec);
{ convert the pointer to the name into a generic pshortstring, { convert the pointer to the name into a generic pshortstring,
@ -540,20 +527,16 @@ implementation
end; end;
function TVMTWriter.genpublishedmethodstable(list : TAsmList) : tasmlabel; procedure TVMTWriter.genpublishedmethodstable(tcb: ttai_typedconstbuilder; out lab: tasmlabel; out pubmethodsdef: trecorddef);
var var
l : tasmlabel;
count : longint; count : longint;
lists : tvmtasmoutput; lists : tvmtasmoutput;
pubmethodsdef: trecorddef;
pubmethodsarraydef: tarraydef; pubmethodsarraydef: tarraydef;
begin begin
count:=0; count:=0;
_class.symtable.SymList.ForEachCall(@do_count_published_methods,@count); _class.symtable.SymList.ForEachCall(@do_count_published_methods,@count);
if count>0 then if count>0 then
begin begin
lists.list:=list;
{ in the list of the published methods (from objpas.inc): { in the list of the published methods (from objpas.inc):
tmethodnamerec = packed record tmethodnamerec = packed record
name : pshortstring; name : pshortstring;
@ -567,8 +550,7 @@ implementation
entries : packed array[0..0] of tmethodnamerec; entries : packed array[0..0] of tmethodnamerec;
end; end;
} }
lists.pubmethodstcb:=ctai_typedconstbuilder.create([tcalo_is_lab]); tcb.start_internal_data_builder(current_asmdata.AsmLists[al_const],sec_rodata,'',lists.pubmethodstcb,lab);
current_asmdata.getlabel(l,alt_data);
gettabledef('fpc_intern_tmethodnametable_',u32inttype,lists.methodnamerec,count,1,pubmethodsdef,pubmethodsarraydef); gettabledef('fpc_intern_tmethodnametable_',u32inttype,lists.methodnamerec,count,1,pubmethodsdef,pubmethodsarraydef);
{ begin tmethodnametable } { begin tmethodnametable }
lists.pubmethodstcb.maybe_begin_aggregate(pubmethodsdef); lists.pubmethodstcb.maybe_begin_aggregate(pubmethodsdef);
@ -582,29 +564,28 @@ implementation
lists.pubmethodstcb.maybe_end_aggregate(pubmethodsarraydef); lists.pubmethodstcb.maybe_end_aggregate(pubmethodsarraydef);
{ end methodnametable } { end methodnametable }
lists.pubmethodstcb.maybe_end_aggregate(pubmethodsdef); lists.pubmethodstcb.maybe_end_aggregate(pubmethodsdef);
list.concatlist(lists.pubmethodstcb.get_final_asmlist(l,pubmethodsdef,sec_rodata,'',sizeof(pint))); tcb.finish_internal_data_builder(lists.pubmethodstcb,lab,pubmethodsdef,sizeof(pint));
lists.pubmethodstcb.free;
genpublishedmethodstable:=l;
end end
else else
genpublishedmethodstable:=nil; begin
lab:=nil;
pubmethodsdef:=nil;
end;
end; end;
function TVMTWriter.generate_field_table(list : TAsmList) : tasmlabel; procedure TVMTWriter.generate_field_table(tcb: ttai_typedconstbuilder; out lab: tasmlabel; out fieldtabledef: trecorddef);
var var
i : longint; i : longint;
sym : tsym; sym : tsym;
fieldtable,
classtable : tasmlabel; classtable : tasmlabel;
classindex, classindex,
fieldcount : longint; fieldcount : longint;
classtablelist : TFPList; classtablelist : TFPList;
tcb: ttai_typedconstbuilder; datatcb: ttai_typedconstbuilder;
packrecords: longint; packrecords: longint;
classdef: tobjectdef; classdef: tobjectdef;
classtabledef, classtabledef: trecorddef;
fieldtabledef: trecorddef;
begin begin
classtablelist:=TFPList.Create; classtablelist:=TFPList.Create;
{ retrieve field info fields } { retrieve field info fields }
@ -626,34 +607,30 @@ implementation
if fieldcount>0 then if fieldcount>0 then
begin begin
current_asmdata.getlabel(fieldtable,alt_data);
current_asmdata.getlabel(classtable,alt_data);
if (tf_requires_proper_alignment in target_info.flags) then if (tf_requires_proper_alignment in target_info.flags) then
packrecords:=0 packrecords:=0
else else
packrecords:=1; packrecords:=1;
{ generate the class table } { generate the class table }
tcb:=ctai_typedconstbuilder.create([tcalo_is_lab]); tcb.start_internal_data_builder(current_asmdata.AsmLists[al_const],sec_rodata,'',datatcb,classtable);
tcb.begin_anonymous_record('$fpc_intern_classtable_'+tostr(classtablelist.Count-1), datatcb.begin_anonymous_record('$fpc_intern_classtable_'+tostr(classtablelist.Count-1),
packrecords, packrecords,
targetinfos[target_info.system]^.alignment.recordalignmin, targetinfos[target_info.system]^.alignment.recordalignmin,
targetinfos[target_info.system]^.alignment.maxCrecordalign); targetinfos[target_info.system]^.alignment.maxCrecordalign);
tcb.emit_tai(Tai_const.Create_16bit(classtablelist.count),u16inttype); datatcb.emit_tai(Tai_const.Create_16bit(classtablelist.count),u16inttype);
for i:=0 to classtablelist.Count-1 do for i:=0 to classtablelist.Count-1 do
begin begin
classdef:=tobjectdef(classtablelist[i]); classdef:=tobjectdef(classtablelist[i]);
{ type of the field } { type of the field }
tcb.queue_init(voidpointertype); datatcb.queue_init(voidpointertype);
{ reference to the vmt } { reference to the vmt }
tcb.queue_emit_asmsym( datatcb.queue_emit_asmsym(
current_asmdata.RefAsmSymbol(classdef.vmt_mangledname,AT_DATA), current_asmdata.RefAsmSymbol(classdef.vmt_mangledname,AT_DATA),
tfieldvarsym(classdef.vmt_field).vardef); tfieldvarsym(classdef.vmt_field).vardef);
end; end;
classtabledef:=tcb.end_anonymous_record; classtabledef:=datatcb.end_anonymous_record;
list.concatlist(tcb.get_final_asmlist(classtable,classtabledef,sec_rodata,'',sizeof(pint))); tcb.finish_internal_data_builder(datatcb,classtable,classtabledef,sizeof(pint));
tcb.free;
{ write fields } { write fields }
{ {
@ -667,17 +644,17 @@ implementation
Fields: array[0..0] of TFieldInfo Fields: array[0..0] of TFieldInfo
end; end;
} }
tcb:=ctai_typedconstbuilder.create([tcalo_is_lab]); tcb.start_internal_data_builder(current_asmdata.AsmLists[al_const],sec_rodata,'',datatcb,lab);
{ can't easily specify a name here for reuse of the constructed def, { can't easily specify a name here for reuse of the constructed def,
since it's full of variable length shortstrings (-> all of those since it's full of variable length shortstrings (-> all of those
lengths and their order would have to incorporated in the name, lengths and their order would have to incorporated in the name,
plus there would be very little chance that it could actually be plus there would be very little chance that it could actually be
reused } reused }
tcb.begin_anonymous_record('',packrecords, datatcb.begin_anonymous_record('',packrecords,
targetinfos[target_info.system]^.alignment.recordalignmin, targetinfos[target_info.system]^.alignment.recordalignmin,
targetinfos[target_info.system]^.alignment.maxCrecordalign); targetinfos[target_info.system]^.alignment.maxCrecordalign);
tcb.emit_tai(Tai_const.Create_16bit(fieldcount),u16inttype); datatcb.emit_tai(Tai_const.Create_16bit(fieldcount),u16inttype);
tcb.emit_tai(Tai_const.Create_sym(classtable),getpointerdef(classtabledef)); datatcb.emit_tai(Tai_const.Create_sym(classtable),getpointerdef(classtabledef));
for i:=0 to _class.symtable.SymList.Count-1 do for i:=0 to _class.symtable.SymList.Count-1 do
begin begin
sym:=tsym(_class.symtable.SymList[i]); sym:=tsym(_class.symtable.SymList[i]);
@ -695,26 +672,26 @@ implementation
Name: ShortString; Name: ShortString;
end; end;
} }
tcb.begin_anonymous_record('$fpc_intern_fieldinfo_'+tostr(length(tfieldvarsym(sym).realname)),packrecords, datatcb.begin_anonymous_record('$fpc_intern_fieldinfo_'+tostr(length(tfieldvarsym(sym).realname)),packrecords,
targetinfos[target_info.system]^.alignment.recordalignmin, targetinfos[target_info.system]^.alignment.recordalignmin,
targetinfos[target_info.system]^.alignment.maxCrecordalign); targetinfos[target_info.system]^.alignment.maxCrecordalign);
tcb.emit_tai(Tai_const.Create_pint(tfieldvarsym(sym).fieldoffset),ptruinttype); datatcb.emit_tai(Tai_const.Create_pint(tfieldvarsym(sym).fieldoffset),ptruinttype);
classindex:=classtablelist.IndexOf(tfieldvarsym(sym).vardef); classindex:=classtablelist.IndexOf(tfieldvarsym(sym).vardef);
if classindex=-1 then if classindex=-1 then
internalerror(200611033); internalerror(200611033);
tcb.emit_tai(Tai_const.Create_16bit(classindex+1),u16inttype); datatcb.emit_tai(Tai_const.Create_16bit(classindex+1),u16inttype);
tcb.emit_shortstring_const(tfieldvarsym(sym).realname); datatcb.emit_shortstring_const(tfieldvarsym(sym).realname);
tcb.end_anonymous_record; datatcb.end_anonymous_record;
end; end;
end; end;
fieldtabledef:=tcb.end_anonymous_record; fieldtabledef:=datatcb.end_anonymous_record;
list.concatlist(tcb.get_final_asmlist(fieldtable,fieldtabledef,sec_rodata,'',sizeof(pint))); tcb.finish_internal_data_builder(datatcb,lab,fieldtabledef,sizeof(pint));
tcb.free;
result:=fieldtable;
end end
else else
result:=nil; begin
fieldtabledef:=nil;
lab:=nil;
end;
classtablelist.free; classtablelist.free;
end; end;
@ -724,22 +701,17 @@ implementation
Interface tables Interface tables
**************************************} **************************************}
function TVMTWriter.intf_get_vtbl_name(AImplIntf:TImplementedInterface): string; procedure TVMTWriter.intf_create_vtbl(tcb: ttai_typedconstbuilder; AImplIntf: TImplementedInterface; intfindex: longint);
begin
result:=make_mangledname('VTBL',_class.owner,_class.objname^+'_$_'+AImplIntf.IntfDef.objname^);
end;
procedure TVMTWriter.intf_create_vtbl(rawdata: TAsmList;AImplIntf:TImplementedInterface);
var var
datatcb : ttai_typedconstbuilder;
pd : tprocdef; pd : tprocdef;
vtblstr, hs : TSymStr;
hs : string;
i : longint; i : longint;
begin begin
vtblstr:=intf_get_vtbl_name(AImplIntf); tcb.start_internal_data_builder(current_asmdata.AsmLists[al_const],sec_rodata,'',datatcb,fintfvtablelabels[intfindex]);
rawdata.concat(cai_align.create(const_align(sizeof(pint)))); datatcb.begin_anonymous_record('',0,
rawdata.concat(tai_symbol.createname(vtblstr,AT_DATA,0)); targetinfos[target_info.system]^.alignment.recordalignmin,
targetinfos[target_info.system]^.alignment.maxCrecordalign);
if assigned(AImplIntf.procdefs) then if assigned(AImplIntf.procdefs) then
begin begin
for i:=0 to AImplIntf.procdefs.count-1 do for i:=0 to AImplIntf.procdefs.count-1 do
@ -748,14 +720,18 @@ implementation
hs:=make_mangledname('WRPR',_class.owner,_class.objname^+'_$_'+AImplIntf.IntfDef.objname^+'_$_'+ hs:=make_mangledname('WRPR',_class.owner,_class.objname^+'_$_'+AImplIntf.IntfDef.objname^+'_$_'+
tostr(i)+'_$_'+pd.mangledname); tostr(i)+'_$_'+pd.mangledname);
{ create reference } { create reference }
rawdata.concat(Tai_const.Createname(hs,AT_FUNCTION,0)); datatcb.emit_tai(Tai_const.Createname(hs,AT_FUNCTION,0),pd.getcopyas(procvardef,pc_address_only));
end; end;
end; end
rawdata.concat(tai_symbol_end.createname(vtblstr)); else
{ can't have an empty symbol on LLVM }
datatcb.emit_tai(tai_const.Create_nil_codeptr,voidpointertype);
tcb.finish_internal_data_builder(datatcb,fintfvtablelabels[intfindex],
datatcb.end_anonymous_record,sizeof(pint));
end; end;
procedure TVMTWriter.intf_gen_intf_ref(tcb: ttai_typedconstbuilder; AImplIntf: TImplementedInterface; interfaceentrydef, interfaceentrytypedef: tdef); procedure TVMTWriter.intf_gen_intf_ref(tcb: ttai_typedconstbuilder; AImplIntf: TImplementedInterface; intfindex: longint; interfaceentrydef, interfaceentrytypedef: tdef);
var var
pd: tprocdef; pd: tprocdef;
begin begin
@ -769,7 +745,7 @@ implementation
{ VTable } { VTable }
tcb.queue_init(voidpointertype); tcb.queue_init(voidpointertype);
tcb.queue_emit_asmsym(current_asmdata.RefAsmSymbol(intf_get_vtbl_name(AImplIntf.VtblImplIntf),AT_DATA),AImplIntf.VtblImplIntf.IntfDef); tcb.queue_emit_asmsym(fintfvtablelabels[intfindex],AImplIntf.VtblImplIntf.IntfDef);
{ IOffset field } { IOffset field }
case AImplIntf.VtblImplIntf.IType of case AImplIntf.VtblImplIntf.IType of
etFieldValue, etFieldValueClass, etFieldValue, etFieldValueClass,
@ -799,44 +775,52 @@ implementation
end; end;
function TVMTWriter.intf_write_table(list : TAsmList):TAsmLabel; procedure TVMTWriter.intf_write_table(tcb: ttai_typedconstbuilder; out lab: TAsmLabel; out intftabledef: trecorddef);
var var
i : longint; i : longint;
ImplIntf : TImplementedInterface; ImplIntf : TImplementedInterface;
tcb : ttai_typedconstbuilder; datatcb : ttai_typedconstbuilder;
tabledef : tdef;
interfaceentrydef : tdef; interfaceentrydef : tdef;
interfaceentrytypedef: tdef; interfaceentrytypedef: tdef;
interfacearray: tdef; interfacearray: tdef;
begin begin
current_asmdata.getlabel(result,alt_data); setlength(fintfvtablelabels,_class.ImplementedInterfaces.count);
tcb:=ctai_typedconstbuilder.create([tcalo_is_lab]);
tcb.begin_anonymous_record('',0,
targetinfos[target_info.system]^.alignment.recordalignmin,
targetinfos[target_info.system]^.alignment.maxCrecordalign);
tcb.emit_tai(Tai_const.Create_pint(_class.ImplementedInterfaces.count),search_system_type('SIZEUINT').typedef);
interfaceentrydef:=search_system_type('TINTERFACEENTRY').typedef;
interfaceentrytypedef:=search_system_type('TINTERFACEENTRYTYPE').typedef;
interfacearray:=getarraydef(interfaceentrydef,_class.ImplementedInterfaces.count);
tcb.maybe_begin_aggregate(interfacearray);
{ Write vtbl references }
for i:=0 to _class.ImplementedInterfaces.count-1 do
begin
ImplIntf:=TImplementedInterface(_class.ImplementedInterfaces[i]);
intf_gen_intf_ref(tcb,ImplIntf,interfaceentrydef,interfaceentrytypedef);
end;
tcb.maybe_end_aggregate(interfacearray);
tabledef:=tcb.end_anonymous_record;
list.concatlist(tcb.get_final_asmlist(result,tabledef,sec_rodata,'',tabledef.alignment));
{ Write vtbls } { Write unique vtbls }
for i:=0 to _class.ImplementedInterfaces.count-1 do for i:=0 to _class.ImplementedInterfaces.count-1 do
begin begin
ImplIntf:=TImplementedInterface(_class.ImplementedInterfaces[i]); ImplIntf:=TImplementedInterface(_class.ImplementedInterfaces[i]);
if ImplIntf.VtblImplIntf=ImplIntf then if ImplIntf.VtblImplIntf=ImplIntf then
intf_create_vtbl(list,ImplIntf); intf_create_vtbl(tcb,ImplIntf,i)
end; end;
tcb.free; { Set labels for aliased vtbls (after all unique vtbls have been
written, so all labels have been defined already) }
for i:=0 to _class.ImplementedInterfaces.count-1 do
begin
ImplIntf:=TImplementedInterface(_class.ImplementedInterfaces[i]);
if ImplIntf.VtblImplIntf<>ImplIntf then
fintfvtablelabels[i]:=fintfvtablelabels[_class.ImplementedInterfaces.IndexOf(ImplIntf.VtblImplIntf)];
end;
tcb.start_internal_data_builder(current_asmdata.AsmLists[al_const],sec_rodata,'',datatcb,lab);
datatcb.begin_anonymous_record('',0,
targetinfos[target_info.system]^.alignment.recordalignmin,
targetinfos[target_info.system]^.alignment.maxCrecordalign);
datatcb.emit_tai(Tai_const.Create_pint(_class.ImplementedInterfaces.count),search_system_type('SIZEUINT').typedef);
interfaceentrydef:=search_system_type('TINTERFACEENTRY').typedef;
interfaceentrytypedef:=search_system_type('TINTERFACEENTRYTYPE').typedef;
interfacearray:=getarraydef(interfaceentrydef,_class.ImplementedInterfaces.count);
datatcb.maybe_begin_aggregate(interfacearray);
{ Write vtbl references }
for i:=0 to _class.ImplementedInterfaces.count-1 do
begin
ImplIntf:=TImplementedInterface(_class.ImplementedInterfaces[i]);
intf_gen_intf_ref(datatcb,ImplIntf,i,interfaceentrydef,interfaceentrytypedef);
end;
datatcb.maybe_end_aggregate(interfacearray);
intftabledef:=datatcb.end_anonymous_record;
tcb.finish_internal_data_builder(datatcb,lab,intftabledef,intftabledef.alignment);
end; end;
@ -995,7 +979,7 @@ implementation
end; end;
procedure TVMTWriter.writevirtualmethods(List:TAsmList); procedure TVMTWriter.writevirtualmethods(tcb: ttai_typedconstbuilder);
var var
vmtpd : tprocdef; vmtpd : tprocdef;
vmtentry : pvmtentry; vmtentry : pvmtentry;
@ -1025,7 +1009,7 @@ implementation
procname:='FPC_EMPTYMETHOD' procname:='FPC_EMPTYMETHOD'
else if not wpoinfomanager.optimized_name_for_vmt(_class,vmtpd,procname) then else if not wpoinfomanager.optimized_name_for_vmt(_class,vmtpd,procname) then
procname:=vmtpd.mangledname; procname:=vmtpd.mangledname;
List.concat(Tai_const.createname(procname,AT_FUNCTION,0)); tcb.emit_tai(Tai_const.Createname(procname,AT_FUNCTION,0),vmtpd.getcopyas(procvardef,pc_address_only));
{$ifdef vtentry} {$ifdef vtentry}
hs:='VTENTRY'+'_'+_class.vmt_mangledname+'$$'+tostr(_class.vmtmethodoffset(i) div sizeof(pint)); hs:='VTENTRY'+'_'+_class.vmt_mangledname+'$$'+tostr(_class.vmtmethodoffset(i) div sizeof(pint));
current_asmdata.asmlists[al_globals].concat(tai_symbol.CreateName(hs,AT_DATA,0)); current_asmdata.asmlists[al_globals].concat(tai_symbol.CreateName(hs,AT_DATA,0));
@ -1044,9 +1028,13 @@ implementation
dmtlabel : tasmlabel; dmtlabel : tasmlabel;
{$endif WITHDMT} {$endif WITHDMT}
interfacetable : tasmlabel; interfacetable : tasmlabel;
templist : TAsmList; tcb, datatcb: ttai_typedconstbuilder;
tcb: ttai_typedconstbuilder;
classnamedef: tdef; classnamedef: tdef;
methodnametabledef,
fieldtabledef,
interfacetabledef,
strmessagetabledef,
intmessagetabledef: trecorddef;
begin begin
{$ifdef WITHDMT} {$ifdef WITHDMT}
dmtlabel:=gendmt; dmtlabel:=gendmt;
@ -1055,7 +1043,6 @@ implementation
already been removed from the symtablestack -> add it again, so that already been removed from the symtablestack -> add it again, so that
newly created defs here end up in the right unit } newly created defs here end up in the right unit }
symtablestack.push(current_module.localsymtable); symtablestack.push(current_module.localsymtable);
templist:=TAsmList.Create;
strmessagetable:=nil; strmessagetable:=nil;
interfacetable:=nil; interfacetable:=nil;
fieldtablelabel:=nil; fieldtablelabel:=nil;
@ -1063,48 +1050,55 @@ implementation
intmessagetable:=nil; intmessagetable:=nil;
classnamelabel:=nil; classnamelabel:=nil;
classnamedef:=nil;
methodnametabledef:=nil;
fieldtabledef:=nil;
interfacetabledef:=nil;
strmessagetabledef:=nil;
intmessagetabledef:=nil;
{ generate VMT }
tcb:=ctai_typedconstbuilder.create([tcalo_make_dead_strippable]);
{ write tables for classes, this must be done before the actual { write tables for classes, this must be done before the actual
class is written, because we need the labels defined } class is written, because we need the labels defined }
if is_class(_class) then if is_class(_class) then
begin begin
{ write class name } { write class name }
current_asmdata.getlabel(classnamelabel,alt_data); tcb.start_internal_data_builder(current_asmdata.asmlists[al_const],sec_rodata_norel,'',datatcb,classnamelabel);
tcb:=ctai_typedconstbuilder.create([tcalo_is_lab]);
hs:=_class.RttiName; hs:=_class.RttiName;
classnamedef:=tcb.emit_shortstring_const(_class.RttiName); classnamedef:=datatcb.emit_shortstring_const(_class.RttiName);
templist.concatlist(tcb.get_final_asmlist(classnamelabel,classnamedef,sec_rodata_norel,'',sizeof(pint))); tcb.finish_internal_data_builder(datatcb,classnamelabel,classnamedef,sizeof(pint));
tcb.free;
{ interface table } { interface table }
if _class.ImplementedInterfaces.count>0 then if _class.ImplementedInterfaces.count>0 then
interfacetable:=intf_write_table(templist); intf_write_table(tcb,interfacetable,interfacetabledef);
methodnametable:=genpublishedmethodstable(templist); genpublishedmethodstable(tcb,methodnametable,methodnametabledef);
fieldtablelabel:=generate_field_table(templist); generate_field_table(tcb,fieldtablelabel,fieldtabledef);
{ generate message and dynamic tables } { generate message and dynamic tables }
if (oo_has_msgstr in _class.objectoptions) then if (oo_has_msgstr in _class.objectoptions) then
strmessagetable:=genstrmsgtab(templist); genstrmsgtab(tcb,strmessagetable,strmessagetabledef);
if (oo_has_msgint in _class.objectoptions) then if (oo_has_msgint in _class.objectoptions) then
intmessagetable:=genintmsgtab(templist); genintmsgtab(tcb,intmessagetable,intmessagetabledef);
end; end;
{ write debug info } tcb.begin_anonymous_record('',voidpointertype.alignment,
maybe_new_object_file(current_asmdata.asmlists[al_globals]); targetinfos[target_info.system]^.alignment.recordalignmin,
new_section(current_asmdata.asmlists[al_globals],sec_rodata,_class.vmt_mangledname,const_align(sizeof(pint))); targetinfos[target_info.system]^.alignment.maxCrecordalign);
current_asmdata.asmlists[al_globals].concat(Tai_symbol.Createname_global(_class.vmt_mangledname,AT_DATA,0));
{ determine the size with symtable.datasize, because } { determine the size with symtable.datasize, because }
{ size gives back 4 for classes } { size gives back 4 for classes }
current_asmdata.asmlists[al_globals].concat(Tai_const.Create(aitconst_ptr,tObjectSymtable(_class.symtable).datasize)); tcb.emit_ord_const(tObjectSymtable(_class.symtable).datasize,ptrsinttype);
current_asmdata.asmlists[al_globals].concat(Tai_const.Create(aitconst_ptr,-int64(tObjectSymtable(_class.symtable).datasize))); tcb.emit_ord_const(-int64(tObjectSymtable(_class.symtable).datasize),ptrsinttype);
{$ifdef WITHDMT} {$ifdef WITHDMT}
if _class.classtype=ct_object then if _class.classtype=ct_object then
begin begin
if assigned(dmtlabel) then if assigned(dmtlabel) then
current_asmdata.asmlists[al_globals].concat(Tai_const_symbol.Create(dmtlabel))) tcb.emit_tai(dmtlabel,voidpointertype)
else else
current_asmdata.asmlists[al_globals].concat(Tai_const.Create_ptr(0)); tcb.emit_tai(Tai_const.Create_nil_dataptr,voidpointertype);
end; end;
{$endif WITHDMT} {$endif WITHDMT}
{ write pointer to parent VMT, this isn't implemented in TP } { write pointer to parent VMT, this isn't implemented in TP }
@ -1113,57 +1107,84 @@ implementation
{ it is not written for parents that don't have any vmt !! } { it is not written for parents that don't have any vmt !! }
if assigned(_class.childof) and if assigned(_class.childof) and
(oo_has_vmt in _class.childof.objectoptions) then (oo_has_vmt in _class.childof.objectoptions) then
current_asmdata.asmlists[al_globals].concat(Tai_const.Createname(_class.childof.vmt_mangledname,AT_DATA,0)) begin
tcb.queue_init(voidpointertype);
tcb.queue_emit_asmsym(
current_asmdata.RefAsmSymbol(_class.childof.vmt_mangledname,AT_DATA),
tfieldvarsym(_class.childof.vmt_field).vardef);
end
else else
current_asmdata.asmlists[al_globals].concat(Tai_const.Create_nil_dataptr); tcb.emit_tai(Tai_const.Create_nil_dataptr,voidpointertype);
{ write extended info for classes, for the order see rtl/inc/objpash.inc } { write extended info for classes, for the order see rtl/inc/objpash.inc }
if is_class(_class) then if is_class(_class) then
begin begin
{ pointer to class name string } { pointer to class name string }
current_asmdata.asmlists[al_globals].concat(Tai_const.Create_sym(classnamelabel)); tcb.emit_tai(Tai_const.Create_sym(classnamelabel),getpointerdef(classnamedef));
{ pointer to dynamic table or nil } { pointer to dynamic table or nil }
if (oo_has_msgint in _class.objectoptions) then if (oo_has_msgint in _class.objectoptions) then
current_asmdata.asmlists[al_globals].concat(Tai_const.Create_sym(intmessagetable)) begin
tcb.queue_init(voidpointertype);
tcb.queue_emit_asmsym(intmessagetable,getpointerdef(intmessagetabledef));
end
else else
current_asmdata.asmlists[al_globals].concat(Tai_const.Create_nil_dataptr); tcb.emit_tai(Tai_const.Create_nil_dataptr,voidpointertype);
{ pointer to method table or nil } { pointer to method table or nil }
if assigned(methodnametable) then if assigned(methodnametable) then
current_asmdata.asmlists[al_globals].concat(Tai_const.Create_sym(methodnametable)) begin
tcb.queue_init(voidpointertype);
tcb.queue_emit_asmsym(methodnametable,getpointerdef(methodnametabledef))
end
else else
current_asmdata.asmlists[al_globals].concat(Tai_const.Create_nil_dataptr); tcb.emit_tai(Tai_const.Create_nil_dataptr,voidpointertype);
{ pointer to field table } { pointer to field table }
if assigned(fieldtablelabel) then if assigned(fieldtablelabel) then
current_asmdata.asmlists[al_globals].concat(Tai_const.Create_sym(fieldtablelabel)) begin
tcb.queue_init(voidpointertype);
tcb.queue_emit_asmsym(fieldtablelabel,fieldtabledef)
end
else else
current_asmdata.asmlists[al_globals].concat(Tai_const.Create_nil_dataptr); tcb.emit_tai(Tai_const.Create_nil_dataptr,voidpointertype);
{ pointer to type info of published section } { pointer to type info of published section }
current_asmdata.asmlists[al_globals].concat(Tai_const.Create_sym(RTTIWriter.get_rtti_label(_class,fullrtti))); tcb.emit_tai(Tai_const.Create_sym(RTTIWriter.get_rtti_label(_class,fullrtti)),voidpointertype);
{ inittable for con-/destruction } { inittable for con-/destruction }
if _class.members_need_inittable then if _class.members_need_inittable then
current_asmdata.asmlists[al_globals].concat(Tai_const.Create_sym(RTTIWriter.get_rtti_label(_class,initrtti))) tcb.emit_tai(Tai_const.Create_sym(RTTIWriter.get_rtti_label(_class,initrtti)),voidpointertype)
else else
current_asmdata.asmlists[al_globals].concat(Tai_const.Create_nil_dataptr); tcb.emit_tai(Tai_const.Create_nil_dataptr,voidpointertype);
{ auto table } { auto table }
current_asmdata.asmlists[al_globals].concat(Tai_const.Create_nil_dataptr); tcb.emit_tai(Tai_const.Create_nil_dataptr,voidpointertype);
{ interface table } { interface table }
if _class.ImplementedInterfaces.count>0 then if _class.ImplementedInterfaces.count>0 then
current_asmdata.asmlists[al_globals].concat(Tai_const.Create_sym(interfacetable)) begin
tcb.queue_init(voidpointertype);
tcb.queue_emit_asmsym(interfacetable,interfacetabledef)
end
else if _class.implements_any_interfaces then else if _class.implements_any_interfaces then
current_asmdata.asmlists[al_globals].concat(Tai_const.Create_nil_dataptr) tcb.emit_tai(Tai_const.Create_nil_dataptr,voidpointertype)
else else
current_asmdata.asmlists[al_globals].concat(Tai_const.Create_sym(current_asmdata.RefAsmSymbol('FPC_EMPTYINTF',AT_DATA))); tcb.emit_tai(Tai_const.Create_sym(current_asmdata.RefAsmSymbol('FPC_EMPTYINTF',AT_DATA)),voidpointertype);
{ table for string messages } { table for string messages }
if (oo_has_msgstr in _class.objectoptions) then if (oo_has_msgstr in _class.objectoptions) then
current_asmdata.asmlists[al_globals].concat(Tai_const.Create_sym(strmessagetable)) begin
tcb.queue_init(voidpointertype);
tcb.queue_emit_asmsym(strmessagetable,strmessagetabledef);
end
else else
current_asmdata.asmlists[al_globals].concat(Tai_const.Create_nil_dataptr); tcb.emit_tai(Tai_const.Create_nil_dataptr,voidpointertype);
end; end;
{ write virtual methods } { write virtual methods }
writevirtualmethods(current_asmdata.asmlists[al_globals]); writevirtualmethods(tcb);
current_asmdata.asmlists[al_globals].concat(Tai_const.Create_nil_codeptr); tcb.emit_tai(Tai_const.Create_nil_codeptr,voidcodepointertype);
{ write the size of the VMT }
current_asmdata.asmlists[al_globals].concat(Tai_symbol_end.Createname(_class.vmt_mangledname)); { concatenate the VMT to the asmlist }
current_asmdata.asmlists[al_globals].concatlist(
tcb.get_final_asmlist(
current_asmdata.DefineAsmSymbol(_class.vmt_mangledname,AB_GLOBAL,AT_DATA),
tcb.end_anonymous_record,sec_rodata,_class.vmt_mangledname,const_align(sizeof(pint))
)
);
tcb.free;
{$ifdef vtentry} {$ifdef vtentry}
{ write vtinherit symbol to notify the linker of the class inheritance tree } { write vtinherit symbol to notify the linker of the class inheritance tree }
hs:='VTINHERIT'+'_'+_class.vmt_mangledname+'$$'; hs:='VTINHERIT'+'_'+_class.vmt_mangledname+'$$';
@ -1173,9 +1194,6 @@ implementation
hs:=hs+_class.vmt_mangledname; hs:=hs+_class.vmt_mangledname;
current_asmdata.asmlists[al_globals].concat(tai_symbol.CreateName(hs,AT_DATA,0)); current_asmdata.asmlists[al_globals].concat(tai_symbol.CreateName(hs,AT_DATA,0));
{$endif vtentry} {$endif vtentry}
if is_class(_class) then
current_asmdata.asmlists[al_globals].concatlist(templist);
templist.Free;
symtablestack.pop(current_module.localsymtable); symtablestack.pop(current_module.localsymtable);
end; end;