mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-12 17:09:35 +02:00
* Write extended RTTI info
This commit is contained in:
Ryan Joseph
Michaël Van Canneyt
parent
d5cc58a0a2
commit
08cd7e9146
@ -50,9 +50,8 @@ interface
|
||||
procedure methods_write_rtti(st:tsymtable;rt:trttitype;visibilities:tvisibilities;allow_hidden:boolean);
|
||||
procedure write_rtti_extrasyms(def:Tdef;rt:Trttitype;mainrtti:Tasmsymbol);
|
||||
procedure published_write_rtti(st:tsymtable;rt:trttitype);
|
||||
function published_properties_count(st:tsymtable):longint;
|
||||
procedure published_properties_write_rtti_data(tcb: ttai_typedconstbuilder; propnamelist: TFPHashObjectList; st: tsymtable);
|
||||
procedure collect_propnamelist(propnamelist:TFPHashObjectList;objdef:tobjectdef);
|
||||
procedure properties_write_rtti_data(tcb:ttai_typedconstbuilder;propnamelist:TFPHashObjectList;st:tsymtable;extended_rtti:boolean;visibilities:tvisibilities);
|
||||
procedure collect_propnamelist(propnamelist:TFPHashObjectList;def:tabstractrecorddef;visibilities:tvisibilities);
|
||||
{ only use a direct reference if the referenced type can *only* reside
|
||||
in the same unit as the current one }
|
||||
function ref_rtti(def:tdef;rt:trttitype;indirect:boolean;suffix:tsymstr):tasmsymbol;
|
||||
@ -62,7 +61,7 @@ interface
|
||||
procedure write_attribute_data(tcb: ttai_typedconstbuilder;attr_list:trtti_attribute_list);
|
||||
procedure write_child_rtti_data(def:tdef;rt:trttitype);
|
||||
procedure write_rtti_reference(tcb: ttai_typedconstbuilder; def: tdef; rt: trttitype);
|
||||
procedure write_methods(tcb:ttai_typedconstbuilder;st:tsymtable;visibilities:tvisibilities);
|
||||
procedure write_methods(tcb:ttai_typedconstbuilder;st:tsymtable;extended_rtti:boolean;visibilities:tvisibilities);
|
||||
procedure write_header(tcb: ttai_typedconstbuilder; def: tdef; typekind: byte);
|
||||
function write_methodkind(tcb:ttai_typedconstbuilder;def:tabstractprocdef):byte;
|
||||
procedure write_callconv(tcb:ttai_typedconstbuilder;def:tabstractprocdef);
|
||||
@ -73,6 +72,8 @@ interface
|
||||
public
|
||||
constructor create;
|
||||
procedure write_rtti(def:tdef;rt:trttitype);
|
||||
procedure write_extended_method_table(tcb:ttai_typedconstbuilder;def:tabstractrecorddef;packrecords:longint);
|
||||
procedure write_extended_field_table(tcb:ttai_typedconstbuilder;def:tabstractrecorddef;packrecords:longint);
|
||||
function get_rtti_label(def:tdef;rt:trttitype;indirect:boolean):tasmsymbol; inline;
|
||||
function get_rtti_label_ord2str(def:tdef;rt:trttitype;indirect:boolean):tasmsymbol; inline;
|
||||
function get_rtti_label_str2ord(def:tdef;rt:trttitype;indirect:boolean):tasmsymbol; inline;
|
||||
@ -117,6 +118,35 @@ implementation
|
||||
end;
|
||||
|
||||
|
||||
function visibility_to_rtti_flags(vis: tvisibility): byte;
|
||||
begin
|
||||
case vis of
|
||||
vis_private:
|
||||
result:=byte(rv_private);
|
||||
vis_strictprivate:
|
||||
begin
|
||||
result:=byte(rv_private);
|
||||
// add bit to indicate "strict"
|
||||
result:=result or (1 shl 2);
|
||||
end;
|
||||
vis_protected:
|
||||
result:=byte(rv_protected);
|
||||
vis_strictprotected:
|
||||
begin
|
||||
result:=byte(rv_protected);
|
||||
// add bit to indicate "strict"
|
||||
result:=result or (1 shl 2);
|
||||
end;
|
||||
vis_public:
|
||||
result:=byte(rv_public);
|
||||
vis_published:
|
||||
result:=byte(rv_published);
|
||||
otherwise
|
||||
internalerror(2021061301);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure write_persistent_type_info(st: tsymtable; is_global: boolean);
|
||||
var
|
||||
i : longint;
|
||||
@ -207,11 +237,12 @@ implementation
|
||||
result:=ref_rtti(def,rt,indirect,'_s2o');
|
||||
end;
|
||||
|
||||
procedure TRTTIWriter.write_methods(tcb:ttai_typedconstbuilder;st:tsymtable;visibilities:tvisibilities);
|
||||
procedure TRTTIWriter.write_methods(tcb:ttai_typedconstbuilder;st:tsymtable;extended_rtti:boolean;visibilities:tvisibilities);
|
||||
var
|
||||
rtticount,
|
||||
totalcount,
|
||||
i,j,k : longint;
|
||||
vmt_index : integer;
|
||||
sym : tprocsym;
|
||||
def : tprocdef;
|
||||
para : tparavarsym;
|
||||
@ -232,83 +263,109 @@ implementation
|
||||
inc(rtticount);
|
||||
end;
|
||||
|
||||
maybe_add_comment(tcb,#9'count');
|
||||
tcb.emit_ord_const(totalcount,u16inttype);
|
||||
maybe_add_comment(tcb,#9'RTTI count');
|
||||
if rtticount = 0 then
|
||||
tcb.emit_ord_const($FFFF,u16inttype)
|
||||
else
|
||||
{ write the count section for non-extended methods }
|
||||
if not extended_rtti then
|
||||
begin
|
||||
tcb.emit_ord_const(rtticount,u16inttype);
|
||||
|
||||
for i:=0 to st.symlist.count-1 do
|
||||
if tsym(st.symlist[i]).typ=procsym then
|
||||
begin
|
||||
sym:=tprocsym(st.symlist[i]);
|
||||
for j:=0 to sym.procdeflist.count-1 do
|
||||
begin
|
||||
def:=tprocdef(sym.procdeflist[j]);
|
||||
|
||||
if not (def.visibility in visibilities) then
|
||||
continue;
|
||||
|
||||
def.init_paraloc_info(callerside);
|
||||
|
||||
maybe_add_comment(tcb,'RTTI: begin method '+def.fullprocname(false));
|
||||
tcb.begin_anonymous_record('',defaultpacking,min(reqalign,SizeOf(PInt)),
|
||||
targetinfos[target_info.system]^.alignment.recordalignmin);
|
||||
|
||||
maybe_add_comment(tcb,#9'return type');
|
||||
write_rtti_reference(tcb,def.returndef,fullrtti);
|
||||
maybe_add_comment(tcb,#9'calling convention');
|
||||
write_callconv(tcb,def);
|
||||
maybe_add_comment(tcb,#9'method kind');
|
||||
write_methodkind(tcb,def);
|
||||
maybe_add_comment(tcb,#9'param count');
|
||||
tcb.emit_ord_const(def.paras.count,u16inttype);
|
||||
maybe_add_comment(tcb,#9'caller args size');
|
||||
tcb.emit_ord_const(def.callerargareasize,ptrsinttype);
|
||||
maybe_add_comment(tcb,#9'name');
|
||||
tcb.emit_pooled_shortstring_const_ref(sym.realname);
|
||||
|
||||
for k:=0 to def.paras.count-1 do
|
||||
begin
|
||||
para:=tparavarsym(def.paras[k]);
|
||||
maybe_add_comment(tcb,'RTTI: begin param '+para.prettyname);
|
||||
tcb.begin_anonymous_record('',defaultpacking,min(reqalign,SizeOf(PInt)),
|
||||
targetinfos[target_info.system]^.alignment.recordalignmin);
|
||||
|
||||
maybe_add_comment(tcb,#9'type');
|
||||
if is_open_array(para.vardef) or is_array_of_const(para.vardef) then
|
||||
write_rtti_reference(tcb,tarraydef(para.vardef).elementdef,fullrtti)
|
||||
else if para.vardef=cformaltype then
|
||||
write_rtti_reference(tcb,nil,fullrtti)
|
||||
else
|
||||
write_rtti_reference(tcb,para.vardef,fullrtti);
|
||||
maybe_add_comment(tcb,#9'flags');
|
||||
write_param_flag(tcb,para);
|
||||
|
||||
maybe_add_comment(tcb,#9'name');
|
||||
tcb.emit_pooled_shortstring_const_ref(para.realname);
|
||||
|
||||
maybe_add_comment(tcb,#9'locs');
|
||||
write_paralocs(tcb,@para.paraloc[callerside]);
|
||||
|
||||
tcb.end_anonymous_record;
|
||||
maybe_add_comment(tcb,'RTTI: end param '+para.prettyname);
|
||||
end;
|
||||
|
||||
if not is_void(def.returndef) then
|
||||
begin
|
||||
maybe_add_comment(tcb,#9'return loc');
|
||||
write_paralocs(tcb,@def.funcretloc[callerside]);
|
||||
end;
|
||||
|
||||
tcb.end_anonymous_record;
|
||||
end;
|
||||
end;
|
||||
maybe_add_comment(tcb,#9'count');
|
||||
tcb.emit_ord_const(totalcount,u16inttype);
|
||||
maybe_add_comment(tcb,#9'RTTI count');
|
||||
if rtticount=0 then
|
||||
tcb.emit_ord_const($FFFF,u16inttype)
|
||||
else
|
||||
tcb.emit_ord_const(rtticount,u16inttype);
|
||||
end;
|
||||
|
||||
if rtticount>0 then
|
||||
for i:=0 to st.symlist.count-1 do
|
||||
if tsym(st.symlist[i]).typ=procsym then
|
||||
begin
|
||||
sym:=tprocsym(st.symlist[i]);
|
||||
for j:=0 to sym.procdeflist.count-1 do
|
||||
begin
|
||||
def:=tprocdef(sym.procdeflist[j]);
|
||||
|
||||
if not (def.visibility in visibilities) then
|
||||
continue;
|
||||
|
||||
def.init_paraloc_info(callerside);
|
||||
maybe_add_comment(tcb,'RTTI: begin method '+def.fullprocname(false));
|
||||
tcb.begin_anonymous_record('',defaultpacking,min(reqalign,SizeOf(PInt)),
|
||||
targetinfos[target_info.system]^.alignment.recordalignmin);
|
||||
|
||||
maybe_add_comment(tcb,#9'return type');
|
||||
write_rtti_reference(tcb,def.returndef,fullrtti);
|
||||
maybe_add_comment(tcb,#9'calling convention');
|
||||
write_callconv(tcb,def);
|
||||
maybe_add_comment(tcb,#9'method kind');
|
||||
write_methodkind(tcb,def);
|
||||
maybe_add_comment(tcb,#9'param count');
|
||||
tcb.emit_ord_const(def.paras.count,u16inttype);
|
||||
maybe_add_comment(tcb,#9'caller args size');
|
||||
tcb.emit_ord_const(def.callerargareasize,ptrsinttype);
|
||||
maybe_add_comment(tcb,#9'name');
|
||||
tcb.emit_pooled_shortstring_const_ref(sym.realname);
|
||||
|
||||
if extended_rtti then
|
||||
begin
|
||||
{ write visibility section for extended RTTI }
|
||||
maybe_add_comment(tcb,#9'visibility');
|
||||
tcb.emit_ord_const(visibility_to_rtti_flags(def.visibility),u8inttype);
|
||||
{ for classes write a VMT index }
|
||||
if st.defowner.typ=objectdef then
|
||||
begin
|
||||
vmt_index:=-1;
|
||||
if po_virtualmethod in def.procoptions then
|
||||
for k:=0 to tobjectdef(st.defowner).vmtentries.count-1 do
|
||||
if pvmtentry(tobjectdef(st.defowner).vmtentries[k])^.procdef=def then
|
||||
begin
|
||||
vmt_index:=k;
|
||||
break;
|
||||
end;
|
||||
maybe_add_comment(tcb,#9'VMT index');
|
||||
tcb.emit_ord_const(vmt_index,s16inttype);
|
||||
end;
|
||||
end;
|
||||
|
||||
for k:=0 to def.paras.count-1 do
|
||||
begin
|
||||
para:=tparavarsym(def.paras[k]);
|
||||
|
||||
maybe_add_comment(tcb,'RTTI: begin param '+para.prettyname);
|
||||
tcb.begin_anonymous_record('',defaultpacking,min(reqalign,SizeOf(PInt)),
|
||||
targetinfos[target_info.system]^.alignment.recordalignmin);
|
||||
|
||||
maybe_add_comment(tcb,#9'type');
|
||||
if is_open_array(para.vardef) or is_array_of_const(para.vardef) then
|
||||
write_rtti_reference(tcb,tarraydef(para.vardef).elementdef,fullrtti)
|
||||
else if para.vardef=cformaltype then
|
||||
write_rtti_reference(tcb,nil,fullrtti)
|
||||
else
|
||||
write_rtti_reference(tcb,para.vardef,fullrtti);
|
||||
maybe_add_comment(tcb,#9'flags');
|
||||
write_param_flag(tcb,para);
|
||||
|
||||
maybe_add_comment(tcb,#9'name');
|
||||
tcb.emit_pooled_shortstring_const_ref(para.realname);
|
||||
|
||||
maybe_add_comment(tcb,#9'locs');
|
||||
write_paralocs(tcb,@para.paraloc[callerside]);
|
||||
|
||||
tcb.end_anonymous_record;
|
||||
maybe_add_comment(tcb,'RTTI: end param '+para.prettyname);
|
||||
end;
|
||||
|
||||
if not is_void(def.returndef) then
|
||||
begin
|
||||
if addcomments then
|
||||
tcb.emit_comment(#9'return loc');
|
||||
write_paralocs(tcb,@def.funcretloc[callerside]);
|
||||
end;
|
||||
|
||||
tcb.end_anonymous_record;
|
||||
maybe_add_comment(tcb,'RTTI: end method '+def.fullprocname(false));
|
||||
end;
|
||||
end;
|
||||
|
||||
tcb.end_anonymous_record;
|
||||
maybe_add_comment(tcb,'RTTI: end methods');
|
||||
end;
|
||||
@ -719,6 +776,84 @@ implementation
|
||||
end;
|
||||
|
||||
|
||||
procedure TRTTIWriter.write_extended_method_table(tcb:ttai_typedconstbuilder;def:tabstractrecorddef;packrecords:longint);
|
||||
var
|
||||
methodcount,
|
||||
i, j: longint;
|
||||
sym: tprocsym;
|
||||
begin
|
||||
{ count methods }
|
||||
methodcount:=0;
|
||||
for i:=0 to def.symtable.symlist.count-1 do
|
||||
if tsym(def.symtable.symlist[i]).typ=procsym then
|
||||
begin
|
||||
sym:=tprocsym(def.symtable.symlist[i]);
|
||||
for j:=0 to sym.procdeflist.count-1 do
|
||||
if def.is_visible_for_rtti(ro_methods,tprocdef(sym.procdeflist[j]).visibility) then
|
||||
inc(methodcount);
|
||||
end;
|
||||
|
||||
tcb.begin_anonymous_record('',packrecords,min(reqalign,SizeOf(PInt)),
|
||||
targetinfos[target_info.system]^.alignment.recordalignmin);
|
||||
{ emit method count }
|
||||
tcb.emit_ord_const(methodcount,u16inttype);
|
||||
{ emit method entries (array) }
|
||||
if methodcount>0 then
|
||||
write_methods(tcb,def.symtable,true,def.rtti_visibilities_for_option(ro_methods));
|
||||
tcb.end_anonymous_record;
|
||||
end;
|
||||
|
||||
|
||||
procedure TRTTIWriter.write_extended_field_table(tcb:ttai_typedconstbuilder;def:tabstractrecorddef;packrecords:longint);
|
||||
var
|
||||
i: integer;
|
||||
sym: tsym;
|
||||
list: TFPList;
|
||||
begin
|
||||
list:=TFPList.Create;
|
||||
{ build list of visible fields }
|
||||
for i:=0 to def.symtable.symlist.Count-1 do
|
||||
begin
|
||||
sym:=tsym(def.symtable.symlist[i]);
|
||||
if (sym.typ=fieldvarsym) and
|
||||
not(sp_static in sym.symoptions) and
|
||||
def.is_visible_for_rtti(ro_fields, sym.visibility) then
|
||||
list.add(sym);
|
||||
end;
|
||||
{
|
||||
TExtendedFieldTable = record
|
||||
FieldCount: Word;
|
||||
Fields: array[0..0] of TExtendedFieldInfo;
|
||||
end;
|
||||
}
|
||||
tcb.begin_anonymous_record(internaltypeprefixName[itp_extended_rtti_table]+tostr(list.count),packrecords,min(reqalign,SizeOf(PInt)),targetinfos[target_info.system]^.alignment.recordalignmin);
|
||||
tcb.emit_ord_const(list.count,u16inttype);
|
||||
for i := 0 to list.count-1 do
|
||||
begin
|
||||
sym:=tsym(list[i]);
|
||||
{
|
||||
TExtendedFieldInfo = record
|
||||
FieldOffset: SizeUInt;
|
||||
FieldType: Pointer;
|
||||
FieldVisibility: Byte;
|
||||
Name: PShortString;
|
||||
end;
|
||||
}
|
||||
tcb.begin_anonymous_record(internaltypeprefixName[itp_extended_rtti_field]+tostr(tfieldvarsym(sym).fieldoffset),packrecords,min(reqalign,SizeOf(PInt)),targetinfos[target_info.system]^.alignment.recordalignmin);
|
||||
{ FieldOffset }
|
||||
tcb.emit_tai(Tai_const.Create_sizeint(tfieldvarsym(sym).fieldoffset),sizeuinttype);
|
||||
{ FieldType: PPTypeInfo }
|
||||
tcb.emit_tai(Tai_const.Create_sym(RTTIWriter.get_rtti_label(tfieldvarsym(sym).vardef,fullrtti,true)),voidpointertype);
|
||||
{ FieldVisibility }
|
||||
tcb.emit_ord_const(visibility_to_rtti_flags(tfieldvarsym(sym).visibility),u8inttype);
|
||||
{ Name }
|
||||
tcb.emit_pooled_shortstring_const_ref(sym.realname);
|
||||
tcb.end_anonymous_record;
|
||||
end;
|
||||
tcb.end_anonymous_record;
|
||||
list.free;
|
||||
end;
|
||||
|
||||
procedure TRTTIWriter.published_write_rtti(st:tsymtable;rt:trttitype);
|
||||
var
|
||||
i : longint;
|
||||
@ -742,35 +877,23 @@ implementation
|
||||
end;
|
||||
|
||||
|
||||
function TRTTIWriter.published_properties_count(st:tsymtable):longint;
|
||||
var
|
||||
i : longint;
|
||||
sym : tsym;
|
||||
begin
|
||||
result:=0;
|
||||
for i:=0 to st.SymList.Count-1 do
|
||||
begin
|
||||
sym:=tsym(st.SymList[i]);
|
||||
if (tsym(sym).typ=propertysym) and
|
||||
(sym.visibility=vis_published) then
|
||||
inc(result);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure TRTTIWriter.collect_propnamelist(propnamelist:TFPHashObjectList;objdef:tobjectdef);
|
||||
procedure TRTTIWriter.collect_propnamelist(propnamelist:TFPHashObjectList;def:tabstractrecorddef;visibilities:tvisibilities);
|
||||
var
|
||||
i : longint;
|
||||
sym : tsym;
|
||||
pn : tpropnamelistitem;
|
||||
begin
|
||||
if assigned(objdef.childof) then
|
||||
collect_propnamelist(propnamelist,objdef.childof);
|
||||
for i:=0 to objdef.symtable.SymList.Count-1 do
|
||||
{ search into parent for objects }
|
||||
if def.typ=objectdef then
|
||||
begin
|
||||
sym:=tsym(objdef.symtable.SymList[i]);
|
||||
if assigned(tobjectdef(def).childof) then
|
||||
collect_propnamelist(propnamelist,tobjectdef(def).childof,visibilities);
|
||||
end;
|
||||
for i:=0 to def.symtable.SymList.Count-1 do
|
||||
begin
|
||||
sym:=tsym(def.symtable.SymList[i]);
|
||||
if (tsym(sym).typ=propertysym) and
|
||||
(sym.visibility=vis_published) then
|
||||
(sym.visibility in visibilities) then
|
||||
begin
|
||||
pn:=TPropNameListItem(propnamelist.Find(tsym(sym).name));
|
||||
if not assigned(pn) then
|
||||
@ -784,15 +907,18 @@ implementation
|
||||
end;
|
||||
|
||||
|
||||
procedure TRTTIWriter.published_properties_write_rtti_data(tcb: ttai_typedconstbuilder; propnamelist:TFPHashObjectList;st:tsymtable);
|
||||
procedure TRTTIWriter.properties_write_rtti_data(tcb: ttai_typedconstbuilder; propnamelist:TFPHashObjectList; st:tsymtable; extended_rtti:boolean; visibilities:tvisibilities);
|
||||
var
|
||||
i : longint;
|
||||
sym : tsym;
|
||||
proctypesinfo : byte;
|
||||
propnameitem : tpropnamelistitem;
|
||||
propdefname : string;
|
||||
tbltcb : ttai_typedconstbuilder;
|
||||
tbllab : tasmlabel;
|
||||
tbldef : tdef;
|
||||
|
||||
procedure writeaccessproc(pap:tpropaccesslisttypes; shiftvalue : byte; unsetvalue: byte);
|
||||
procedure writeaccessproc(tcb: ttai_typedconstbuilder; pap:tpropaccesslisttypes; shiftvalue : byte; unsetvalue: byte);
|
||||
var
|
||||
typvalue : byte;
|
||||
hp : ppropaccesslistitem;
|
||||
@ -888,73 +1014,134 @@ implementation
|
||||
proctypesinfo:=proctypesinfo or (typvalue shl shiftvalue);
|
||||
end;
|
||||
|
||||
function properties_count(st:tsymtable):longint;
|
||||
var
|
||||
i : longint;
|
||||
sym : tsym;
|
||||
begin
|
||||
result:=0;
|
||||
for i:=0 to st.SymList.Count-1 do
|
||||
begin
|
||||
sym:=tsym(st.SymList[i]);
|
||||
if (tsym(sym).typ=propertysym) and
|
||||
(sym.visibility in visibilities) then
|
||||
inc(result);
|
||||
end;
|
||||
end;
|
||||
|
||||
function write_propinfo_data(tcb: ttai_typedconstbuilder; sym: tpropertysym): tdef;
|
||||
begin
|
||||
{ we can only easily reuse defs if the property is not stored,
|
||||
because otherwise the rtti layout depends on how the "stored"
|
||||
is defined (field, indexed expression, virtual method, ...) }
|
||||
if not(ppo_stored in sym.propoptions) then
|
||||
propdefname:=internaltypeprefixName[itp_rtti_prop]+tostr(length(sym.realname))
|
||||
else
|
||||
propdefname:='';
|
||||
{ TPropInfo is a packed record (even on targets that require
|
||||
alignment), but it starts aligned }
|
||||
if addcomments then
|
||||
tcb.emit_comment('RTTI: begin propinfo record '+sym.realname);
|
||||
tcb.begin_anonymous_record(
|
||||
propdefname,
|
||||
1,min(reqalign,SizeOf(PInt)),
|
||||
targetinfos[target_info.system]^.alignment.recordalignmin);
|
||||
if ppo_indexed in sym.propoptions then
|
||||
proctypesinfo:=$40
|
||||
else
|
||||
proctypesinfo:=0;
|
||||
if addcomments then
|
||||
tcb.emit_comment(#9'type info');
|
||||
write_rtti_reference(tcb,sym.propdef,fullrtti);
|
||||
if addcomments then
|
||||
tcb.emit_comment(#9'read access');
|
||||
writeaccessproc(tcb,palt_read,0,0);
|
||||
if addcomments then
|
||||
tcb.emit_comment(#9'write access');
|
||||
writeaccessproc(tcb,palt_write,2,0);
|
||||
{ is it stored ? }
|
||||
if addcomments then
|
||||
tcb.emit_comment(#9'stored ?');
|
||||
if not(ppo_stored in sym.propoptions) then
|
||||
begin
|
||||
{ no, so put a constant zero }
|
||||
tcb.emit_tai(Tai_const.Create_nil_codeptr,codeptruinttype);
|
||||
proctypesinfo:=proctypesinfo or (3 shl 4);
|
||||
end
|
||||
else
|
||||
writeaccessproc(tcb,palt_stored,4,1); { maybe; if no procedure put a constant 1 (=true) }
|
||||
if addcomments then
|
||||
tcb.emit_comment(#9'Index');
|
||||
tcb.emit_ord_const(sym.index,u32inttype);
|
||||
if addcomments then
|
||||
tcb.emit_comment(#9'default');
|
||||
tcb.emit_ord_const(sym.default,u32inttype);
|
||||
propnameitem:=TPropNameListItem(propnamelist.Find(sym.name));
|
||||
if not assigned(propnameitem) then
|
||||
internalerror(200512201);
|
||||
if addcomments then
|
||||
tcb.emit_comment(#9'property index');
|
||||
tcb.emit_ord_const(propnameitem.propindex,u16inttype);
|
||||
if addcomments then
|
||||
tcb.emit_comment(#9'proc types');
|
||||
tcb.emit_ord_const(proctypesinfo,u8inttype);
|
||||
{ write reference to attribute table }
|
||||
if addcomments then
|
||||
tcb.emit_comment(#9'attributes');
|
||||
write_attribute_data(tcb,sym.rtti_attribute_list);
|
||||
{ write property name }
|
||||
if addcomments then
|
||||
tcb.emit_comment(#9'name');
|
||||
tcb.emit_shortstring_const(sym.realname);
|
||||
result:=tcb.end_anonymous_record;
|
||||
if addcomments then
|
||||
tcb.emit_comment('RTTI: End propinfo record '+sym.realname);
|
||||
end;
|
||||
|
||||
begin
|
||||
tcb.begin_anonymous_record('',defaultpacking,min(reqalign,SizeOf(PInt)),
|
||||
targetinfos[target_info.system]^.alignment.recordalignmin);
|
||||
tcb.emit_ord_const(published_properties_count(st),u16inttype);
|
||||
tcb.emit_ord_const(properties_count(st),u16inttype);
|
||||
for i:=0 to st.SymList.Count-1 do
|
||||
begin
|
||||
sym:=tsym(st.SymList[i]);
|
||||
if (sym.typ=propertysym) and
|
||||
(sym.visibility=vis_published) then
|
||||
(sym.visibility in visibilities) then
|
||||
begin
|
||||
{ we can only easily reuse defs if the property is not stored,
|
||||
because otherwise the rtti layout depends on how the "stored"
|
||||
is defined (field, indexed expression, virtual method, ...) }
|
||||
if not(ppo_stored in tpropertysym(sym).propoptions) then
|
||||
propdefname:=internaltypeprefixName[itp_rtti_prop]+tostr(length(tpropertysym(sym).realname))
|
||||
else
|
||||
propdefname:='';
|
||||
{ TPropInfo is a packed record (even on targets that require
|
||||
alignment), but it starts aligned }
|
||||
maybe_add_comment(tcb,'RTTI: begin property '+sym.prettyname);
|
||||
tcb.begin_anonymous_record(
|
||||
propdefname,
|
||||
1,min(reqalign,SizeOf(PInt)),
|
||||
targetinfos[target_info.system]^.alignment.recordalignmin);
|
||||
if ppo_indexed in tpropertysym(sym).propoptions then
|
||||
proctypesinfo:=$40
|
||||
else
|
||||
proctypesinfo:=0;
|
||||
maybe_add_comment(tcb,#9'type info');
|
||||
write_rtti_reference(tcb,tpropertysym(sym).propdef,fullrtti);
|
||||
maybe_add_comment(tcb,#9'read access');
|
||||
writeaccessproc(palt_read,0,0);
|
||||
maybe_add_comment(tcb,#9'write access');
|
||||
writeaccessproc(palt_write,2,0);
|
||||
{ is it stored ? }
|
||||
maybe_add_comment(tcb,#9'stored ?');
|
||||
if not(ppo_stored in tpropertysym(sym).propoptions) then
|
||||
if extended_rtti then
|
||||
begin
|
||||
{ no, so put a constant zero }
|
||||
tcb.emit_tai(Tai_const.Create_nil_codeptr,codeptruinttype);
|
||||
proctypesinfo:=proctypesinfo or (3 shl 4);
|
||||
{
|
||||
TPropInfoEx = record
|
||||
Flags: Byte;
|
||||
Info: PPropInfo;
|
||||
// AttrData: TAttrData
|
||||
end;
|
||||
}
|
||||
maybe_add_comment(tcb,'RTTI: begin property '+sym.prettyname);
|
||||
tcb.begin_anonymous_record('',defaultpacking,min(reqalign,SizeOf(PInt)),
|
||||
targetinfos[target_info.system]^.alignment.recordalignmin);
|
||||
{ write visiblity flags for extended RTTI }
|
||||
maybe_add_comment(tcb,#9'visibility flags');
|
||||
tcb.emit_ord_const(byte(visibility_to_rtti_flags(sym.visibility)),u8inttype);
|
||||
{ create separate constant builder }
|
||||
current_asmdata.getglobaldatalabel(tbllab);
|
||||
tbltcb:=ctai_typedconstbuilder.create([tcalo_is_lab,tcalo_make_dead_strippable]);
|
||||
{ write TPropInfo record }
|
||||
tbldef:=write_propinfo_data(tbltcb,tpropertysym(sym));
|
||||
current_asmdata.asmlists[al_rtti].concatlist(
|
||||
tbltcb.get_final_asmlist(tbllab,tbldef,sec_rodata,tbllab.name,const_align(sizeof(pint)))
|
||||
);
|
||||
tbltcb.free;
|
||||
{ write the pointer to the prop info }
|
||||
maybe_add_comment(tcb,#9'property info reference');
|
||||
tcb.emit_tai(Tai_const.Create_sym(tbllab),voidpointertype);
|
||||
{ end record }
|
||||
tcb.end_anonymous_record;
|
||||
maybe_add_comment(tcb,'RTTI: end property '+sym.prettyname);
|
||||
end
|
||||
else
|
||||
writeaccessproc(palt_stored,4,1); { maybe; if no procedure put a constant 1 (=true) }
|
||||
maybe_add_comment(tcb,#9'index');
|
||||
tcb.emit_ord_const(tpropertysym(sym).index,u32inttype);
|
||||
maybe_add_comment(tcb,#9'default');
|
||||
tcb.emit_ord_const(tpropertysym(sym).default,u32inttype);
|
||||
maybe_add_comment(tcb,#9'property index');
|
||||
propnameitem:=TPropNameListItem(propnamelist.Find(tpropertysym(sym).name));
|
||||
if not assigned(propnameitem) then
|
||||
internalerror(200512201);
|
||||
tcb.emit_ord_const(propnameitem.propindex,u16inttype);
|
||||
maybe_add_comment(tcb,#9'proc types');
|
||||
tcb.emit_ord_const(proctypesinfo,u8inttype);
|
||||
|
||||
{ write reference to attribute table }
|
||||
maybe_add_comment(tcb,#9'attributes');
|
||||
write_attribute_data(tcb,tpropertysym(sym).rtti_attribute_list);
|
||||
|
||||
{ Write property name }
|
||||
maybe_add_comment(tcb,#9'name');
|
||||
tcb.emit_shortstring_const(tpropertysym(sym).realname);
|
||||
|
||||
tcb.end_anonymous_record;
|
||||
maybe_add_comment(tcb,'RTTI: end property '+sym.prettyname);
|
||||
end;
|
||||
write_propinfo_data(tcb,tpropertysym(sym));
|
||||
end;
|
||||
end;
|
||||
tcb.end_anonymous_record;
|
||||
end;
|
||||
@ -1438,8 +1625,22 @@ implementation
|
||||
tcb.free;
|
||||
end;
|
||||
|
||||
|
||||
procedure write_extended_property_table;
|
||||
var
|
||||
propnamelist: TFPHashObjectList;
|
||||
visibilities: tvisibilities;
|
||||
begin
|
||||
propnamelist:=TFPHashObjectList.Create;
|
||||
visibilities:=def.rtti_visibilities_for_option(ro_properties);
|
||||
collect_propnamelist(propnamelist,def,visibilities);
|
||||
properties_write_rtti_data(tcb,propnamelist,def.symtable,true,visibilities);
|
||||
propnamelist.free;
|
||||
end;
|
||||
|
||||
var
|
||||
oplab : tasmlabel;
|
||||
|
||||
begin
|
||||
write_header(tcb,def,tkRecord);
|
||||
{ need extra reqalign record, because otherwise the u32 int will
|
||||
@ -1484,6 +1685,13 @@ implementation
|
||||
end;
|
||||
|
||||
fields_write_rtti_data(tcb,def,rt);
|
||||
{ write extended rtti }
|
||||
if rt=fullrtti then
|
||||
begin
|
||||
write_extended_field_table(tcb,def,defaultpacking);
|
||||
write_extended_method_table(tcb,def,defaultpacking);
|
||||
write_extended_property_table;
|
||||
end;
|
||||
tcb.end_anonymous_record;
|
||||
tcb.end_anonymous_record;
|
||||
|
||||
@ -1653,13 +1861,25 @@ implementation
|
||||
tcb.emit_ord_const(def.size, u32inttype);
|
||||
end;
|
||||
|
||||
procedure objectdef_extended_rtti_class(def:tobjectdef);
|
||||
var
|
||||
propnamelist : TFPHashObjectList;
|
||||
visibilities : tvisibilities;
|
||||
begin
|
||||
propnamelist:=TFPHashObjectList.Create;
|
||||
visibilities:=def.rtti_visibilities_for_option(ro_properties);
|
||||
collect_propnamelist(propnamelist,def,visibilities);
|
||||
properties_write_rtti_data(tcb,propnamelist,def.symtable,true,visibilities);
|
||||
propnamelist.free;
|
||||
end;
|
||||
|
||||
procedure objectdef_rtti_class_full(def:tobjectdef);
|
||||
var
|
||||
propnamelist : TFPHashObjectList;
|
||||
begin
|
||||
{ Collect unique property names with nameindex }
|
||||
propnamelist:=TFPHashObjectList.Create;
|
||||
collect_propnamelist(propnamelist,def);
|
||||
collect_propnamelist(propnamelist,def,[vis_published]);
|
||||
|
||||
tcb.begin_anonymous_record('',defaultpacking,reqalign,
|
||||
targetinfos[target_info.system]^.alignment.recordalignmin);
|
||||
@ -1699,7 +1919,10 @@ implementation
|
||||
tcb.emit_shortstring_const(current_module.realmodulename^);
|
||||
|
||||
{ write published properties for this object }
|
||||
published_properties_write_rtti_data(tcb,propnamelist,def.symtable);
|
||||
properties_write_rtti_data(tcb,propnamelist,def.symtable,false,[vis_published]);
|
||||
|
||||
{ write extended properties }
|
||||
objectdef_extended_rtti_class(def);
|
||||
|
||||
tcb.end_anonymous_record;
|
||||
|
||||
@ -1716,7 +1939,7 @@ implementation
|
||||
begin
|
||||
{ Collect unique property names with nameindex }
|
||||
propnamelist:=TFPHashObjectList.Create;
|
||||
collect_propnamelist(propnamelist,def);
|
||||
collect_propnamelist(propnamelist,def,[vis_published]);
|
||||
|
||||
tcb.begin_anonymous_record('',defaultpacking,reqalign,
|
||||
targetinfos[target_info.system]^.alignment.recordalignmin);
|
||||
@ -1757,10 +1980,10 @@ implementation
|
||||
end;
|
||||
|
||||
{ write published properties for this object }
|
||||
published_properties_write_rtti_data(tcb,propnamelist,def.symtable);
|
||||
properties_write_rtti_data(tcb,propnamelist,def.symtable,false,[vis_published]);
|
||||
|
||||
{ write published methods for this interface }
|
||||
write_methods(tcb,def.symtable,[vis_published]);
|
||||
write_methods(tcb,def.symtable,false,[vis_published]);
|
||||
|
||||
tcb.end_anonymous_record;
|
||||
tcb.end_anonymous_record;
|
||||
|
||||
@ -527,10 +527,18 @@ implementation
|
||||
count : longint;
|
||||
lists : tvmtasmoutput;
|
||||
pubmethodsarraydef: tarraydef;
|
||||
datatcb: ttai_typedconstbuilder;
|
||||
packrecords: longint;
|
||||
begin
|
||||
// TODO(ryan): is extended method table packed?
|
||||
if (tf_requires_proper_alignment in target_info.flags) then
|
||||
packrecords:=0
|
||||
else
|
||||
packrecords:=1;
|
||||
|
||||
count:=0;
|
||||
_class.symtable.SymList.ForEachCall(@do_count_published_methods,@count);
|
||||
if count>0 then
|
||||
if (count>0) or (_class.rtti.options[ro_methods]<>[]) then
|
||||
begin
|
||||
{ in the list of the published methods (from objpas.inc):
|
||||
tmethodnamerec = packed record
|
||||
@ -551,14 +559,19 @@ implementation
|
||||
lists.pubmethodstcb.maybe_begin_aggregate(pubmethodsdef);
|
||||
{ emit count field }
|
||||
lists.pubmethodstcb.emit_tai(Tai_const.Create_32bit(count),u32inttype);
|
||||
{ begin entries field (array) }
|
||||
lists.pubmethodstcb.maybe_begin_aggregate(pubmethodsarraydef);
|
||||
{ add all entries elements }
|
||||
_class.symtable.SymList.ForEachCall(@do_gen_published_methods,@lists);
|
||||
{ end entries field (array) }
|
||||
lists.pubmethodstcb.maybe_end_aggregate(pubmethodsarraydef);
|
||||
if count>0 then
|
||||
begin
|
||||
{ begin entries field (array) }
|
||||
lists.pubmethodstcb.maybe_begin_aggregate(pubmethodsarraydef);
|
||||
{ add all entries elements }
|
||||
_class.symtable.SymList.ForEachCall(@do_gen_published_methods,@lists);
|
||||
{ end entries field (array) }
|
||||
lists.pubmethodstcb.maybe_end_aggregate(pubmethodsarraydef);
|
||||
end;
|
||||
{ end methodnametable }
|
||||
lists.pubmethodstcb.maybe_end_aggregate(pubmethodsdef);
|
||||
{ write extended method rtti }
|
||||
RTTIWriter.write_extended_method_table(lists.pubmethodstcb,_class,packrecords);
|
||||
tcb.finish_internal_data_builder(lists.pubmethodstcb,lab,pubmethodsdef,sizeof(pint));
|
||||
end
|
||||
else
|
||||
@ -582,7 +595,9 @@ implementation
|
||||
classdef: tobjectdef;
|
||||
classtabledef: trecorddef;
|
||||
begin
|
||||
classtable:=nil;
|
||||
classtablelist:=TFPList.Create;
|
||||
classtabledef:=nil;
|
||||
{ retrieve field info fields }
|
||||
fieldcount:=0;
|
||||
for i:=0 to _class.symtable.SymList.Count-1 do
|
||||
@ -601,7 +616,7 @@ implementation
|
||||
end;
|
||||
end;
|
||||
|
||||
if fieldcount>0 then
|
||||
if (fieldcount>0) or (_class.rtti.options[ro_fields]<>[]) then
|
||||
begin
|
||||
if (tf_requires_proper_alignment in target_info.flags) then
|
||||
packrecords:=0
|
||||
@ -609,23 +624,26 @@ implementation
|
||||
packrecords:=1;
|
||||
|
||||
{ generate the class table }
|
||||
tcb.start_internal_data_builder(current_asmdata.AsmLists[al_const],sec_rodata,_class.vmt_mangledname,datatcb,classtable);
|
||||
datatcb.begin_anonymous_record('$fpc_intern_classtable_'+tostr(classtablelist.Count-1),
|
||||
packrecords,1,
|
||||
targetinfos[target_info.system]^.alignment.recordalignmin);
|
||||
datatcb.emit_tai(Tai_const.Create_16bit(classtablelist.count),u16inttype);
|
||||
for i:=0 to classtablelist.Count-1 do
|
||||
if classtablelist.count>0 then
|
||||
begin
|
||||
classdef:=tobjectdef(classtablelist[i]);
|
||||
{ type of the field }
|
||||
datatcb.queue_init(voidpointertype);
|
||||
{ reference to the vmt }
|
||||
datatcb.queue_emit_asmsym(
|
||||
current_asmdata.RefAsmSymbol(classdef.vmt_mangledname,AT_DATA,true),
|
||||
tfieldvarsym(classdef.vmt_field).vardef);
|
||||
tcb.start_internal_data_builder(current_asmdata.AsmLists[al_const],sec_rodata,_class.vmt_mangledname,datatcb,classtable);
|
||||
datatcb.begin_anonymous_record('$fpc_intern_classtable_'+tostr(classtablelist.Count-1),
|
||||
packrecords,1,
|
||||
targetinfos[target_info.system]^.alignment.recordalignmin);
|
||||
datatcb.emit_tai(Tai_const.Create_16bit(classtablelist.count),u16inttype);
|
||||
for i:=0 to classtablelist.Count-1 do
|
||||
begin
|
||||
classdef:=tobjectdef(classtablelist[i]);
|
||||
{ type of the field }
|
||||
datatcb.queue_init(voidpointertype);
|
||||
{ reference to the vmt }
|
||||
datatcb.queue_emit_asmsym(
|
||||
current_asmdata.RefAsmSymbol(classdef.vmt_mangledname,AT_DATA,true),
|
||||
tfieldvarsym(classdef.vmt_field).vardef);
|
||||
end;
|
||||
classtabledef:=datatcb.end_anonymous_record;
|
||||
tcb.finish_internal_data_builder(datatcb,classtable,classtabledef,sizeof(pint));
|
||||
end;
|
||||
classtabledef:=datatcb.end_anonymous_record;
|
||||
tcb.finish_internal_data_builder(datatcb,classtable,classtabledef,sizeof(pint));
|
||||
|
||||
{ write fields }
|
||||
{
|
||||
@ -648,36 +666,47 @@ implementation
|
||||
datatcb.begin_anonymous_record('',packrecords,1,
|
||||
targetinfos[target_info.system]^.alignment.recordalignmin);
|
||||
datatcb.emit_tai(Tai_const.Create_16bit(fieldcount),u16inttype);
|
||||
datatcb.emit_tai(Tai_const.Create_sym(classtable),cpointerdef.getreusable(classtabledef));
|
||||
for i:=0 to _class.symtable.SymList.Count-1 do
|
||||
if classtable<>nil then
|
||||
datatcb.emit_tai(Tai_const.Create_sym(classtable),cpointerdef.getreusable(classtabledef))
|
||||
else
|
||||
datatcb.emit_tai(tai_const.Create_nil_codeptr,voidpointertype);
|
||||
if fieldcount>0 then
|
||||
begin
|
||||
sym:=tsym(_class.symtable.SymList[i]);
|
||||
if (sym.typ=fieldvarsym) and
|
||||
not(sp_static in sym.symoptions) and
|
||||
(sym.visibility=vis_published) then
|
||||
for i:=0 to _class.symtable.SymList.Count-1 do
|
||||
begin
|
||||
{
|
||||
TFieldInfo =
|
||||
$ifndef FPC_REQUIRES_PROPER_ALIGNMENT
|
||||
packed
|
||||
$endif FPC_REQUIRES_PROPER_ALIGNMENT
|
||||
record
|
||||
FieldOffset: SizeUInt;
|
||||
ClassTypeIndex: Word;
|
||||
Name: ShortString;
|
||||
sym:=tsym(_class.symtable.SymList[i]);
|
||||
if (sym.typ=fieldvarsym) and
|
||||
not(sp_static in sym.symoptions) and
|
||||
(sym.visibility=vis_published) then
|
||||
begin
|
||||
{ skip non-object defs for legacy rtti }
|
||||
if tfieldvarsym(sym).vardef.typ<>objectdef then
|
||||
continue;
|
||||
{
|
||||
TFieldInfo =
|
||||
$ifndef FPC_REQUIRES_PROPER_ALIGNMENT
|
||||
packed
|
||||
$endif FPC_REQUIRES_PROPER_ALIGNMENT
|
||||
record
|
||||
FieldOffset: SizeUInt;
|
||||
ClassTypeIndex: Word;
|
||||
Name: ShortString;
|
||||
end;
|
||||
}
|
||||
datatcb.begin_anonymous_record('$fpc_intern_fieldinfo_'+tostr(length(tfieldvarsym(sym).realname)),packrecords,1,
|
||||
targetinfos[target_info.system]^.alignment.recordalignmin);
|
||||
datatcb.emit_tai(Tai_const.Create_sizeint(tfieldvarsym(sym).fieldoffset),sizeuinttype);
|
||||
classindex:=classtablelist.IndexOf(tfieldvarsym(sym).vardef);
|
||||
if classindex=-1 then
|
||||
internalerror(200611033);
|
||||
datatcb.emit_tai(Tai_const.Create_16bit(classindex+1),u16inttype);
|
||||
datatcb.emit_shortstring_const(tfieldvarsym(sym).realname);
|
||||
datatcb.end_anonymous_record;
|
||||
end;
|
||||
}
|
||||
datatcb.begin_anonymous_record('$fpc_intern_fieldinfo_'+tostr(length(tfieldvarsym(sym).realname)),packrecords,1,
|
||||
targetinfos[target_info.system]^.alignment.recordalignmin);
|
||||
datatcb.emit_tai(Tai_const.Create_sizeint(tfieldvarsym(sym).fieldoffset),sizeuinttype);
|
||||
classindex:=classtablelist.IndexOf(tfieldvarsym(sym).vardef);
|
||||
if classindex=-1 then
|
||||
internalerror(200611033);
|
||||
datatcb.emit_tai(Tai_const.Create_16bit(classindex+1),u16inttype);
|
||||
datatcb.emit_shortstring_const(tfieldvarsym(sym).realname);
|
||||
datatcb.end_anonymous_record;
|
||||
end;
|
||||
end;
|
||||
{ append the extended rtti table }
|
||||
RTTIWriter.write_extended_field_table(datatcb,_class,packrecords);
|
||||
fieldtabledef:=datatcb.end_anonymous_record;
|
||||
tcb.finish_internal_data_builder(datatcb,lab,fieldtabledef,sizeof(pint));
|
||||
end
|
||||
|
||||
@ -823,7 +823,9 @@ type
|
||||
itb_objc_fr_category,
|
||||
itb_objc_fr_meta_class,
|
||||
itb_objc_fr_class,
|
||||
itp_vardisp_calldesc
|
||||
itp_vardisp_calldesc,
|
||||
itp_extended_rtti_table,
|
||||
itp_extended_rtti_field
|
||||
);
|
||||
|
||||
{ The order is from low priority to high priority,
|
||||
@ -976,7 +978,9 @@ inherited_objectoptions : tobjectoptions = [oo_has_virtual,oo_has_private,oo_has
|
||||
'$objc_fr_category$',
|
||||
'$objc_fr_meta_class$',
|
||||
'$objc_fr_class$',
|
||||
'$itp_vardisp_calldesc$'
|
||||
'$itp_vardisp_calldesc$',
|
||||
'$extended_rtti_table$',
|
||||
'$extended_rtti_field$'
|
||||
);
|
||||
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user