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

* fixed several VMT element types to correspond to the types used to

Browse Source 
construct the VMT def in the VMT builder in r30950

git-svn-id: trunk@31063 -
This commit is contained in:
Jonas Maebe 2015-06-13 22:48:46 +00:00
parent 4c11d34169
commit 3597e710b6
1 changed files with 27 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
compiler/ncgvmt.pas
View File

@ -769,8 +769,12 @@ implementation
end; end;
{ IIDStr } { IIDStr }
tcb.emit_tai(Tai_const.CreateName( tcb.queue_init(getpointerdef(cshortstringtype));
make_mangledname('IIDSTR',AImplIntf.IntfDef.owner,AImplIntf.IntfDef.objname^),AT_DATA,0),getpointerdef(getarraydef(cansichartype,length(AImplIntf.IntfDef.iidstr^)+1))); tcb.queue_emit_asmsym(
current_asmdata.RefAsmSymbol(
make_mangledname('IIDSTR',AImplIntf.IntfDef.owner,AImplIntf.IntfDef.objname^),
AT_DATA),
getpointerdef(getarraydef(cansichartype,length(AImplIntf.IntfDef.iidstr^)+1)));
{ IType } { IType }
tcb.emit_ord_const(aint(AImplIntf.VtblImplIntf.IType),interfaceentrytypedef); tcb.emit_ord_const(aint(AImplIntf.VtblImplIntf.IType),interfaceentrytypedef);
tcb.maybe_end_aggregate(interfaceentrydef); tcb.maybe_end_aggregate(interfaceentrydef);
@ -1037,6 +1041,9 @@ implementation
interfacetabledef, interfacetabledef,
strmessagetabledef, strmessagetabledef,
intmessagetabledef: trecorddef; intmessagetabledef: trecorddef;
parentvmtdef: tdef;
pinterfacetabledef,
pstringmessagetabledef: tdef;
begin begin
{$ifdef WITHDMT} {$ifdef WITHDMT}
dmtlabel:=gendmt; dmtlabel:=gendmt;
@ -1109,22 +1116,27 @@ implementation
{ but this is not used in FPC ? (PM) } { but this is not used in FPC ? (PM) }
{ it's not used yet, but the delphi-operators as and is need it (FK) } { it's not used yet, but the delphi-operators as and is need it (FK) }
{ 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 is_class(_class) then
parentvmtdef:=getpointerdef(search_system_type('TVMT').typedef)
else
parentvmtdef:=voidpointertype;
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
begin begin
tcb.queue_init(voidpointertype); tcb.queue_init(parentvmtdef);
tcb.queue_emit_asmsym( tcb.queue_emit_asmsym(
current_asmdata.RefAsmSymbol(_class.childof.vmt_mangledname,AT_DATA), current_asmdata.RefAsmSymbol(_class.childof.vmt_mangledname,AT_DATA),
tfieldvarsym(_class.childof.vmt_field).vardef); tfieldvarsym(_class.childof.vmt_field).vardef);
end end
else else
tcb.emit_tai(Tai_const.Create_nil_dataptr,voidpointertype); tcb.emit_tai(Tai_const.Create_nil_dataptr,parentvmtdef);
{ 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 }
tcb.emit_tai(Tai_const.Create_sym(classnamelabel),getpointerdef(classnamedef)); tcb.queue_init(getpointerdef(cshortstringtype));
tcb.queue_emit_asmsym(classnamelabel,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
begin begin
@ -1159,23 +1171,28 @@ implementation
{ auto table } { auto table }
tcb.emit_tai(Tai_const.Create_nil_dataptr,voidpointertype); tcb.emit_tai(Tai_const.Create_nil_dataptr,voidpointertype);
{ interface table } { interface table }
pinterfacetabledef:=search_system_type('PINTERFACETABLE').typedef;
if _class.ImplementedInterfaces.count>0 then if _class.ImplementedInterfaces.count>0 then
begin begin
tcb.queue_init(voidpointertype); tcb.queue_init(pinterfacetabledef);
tcb.queue_emit_asmsym(interfacetable,interfacetabledef) tcb.queue_emit_asmsym(interfacetable,interfacetabledef)
end end
else if _class.implements_any_interfaces then else if _class.implements_any_interfaces then
tcb.emit_tai(Tai_const.Create_nil_dataptr,voidpointertype) tcb.emit_tai(Tai_const.Create_nil_dataptr,pinterfacetabledef)
else else
tcb.emit_tai(Tai_const.Create_sym(current_asmdata.RefAsmSymbol('FPC_EMPTYINTF',AT_DATA)),voidpointertype); begin
tcb.queue_init(pinterfacetabledef);
tcb.queue_emit_asmsym(current_asmdata.RefAsmSymbol('FPC_EMPTYINTF',AT_DATA),ptruinttype);
end;
{ table for string messages } { table for string messages }
pstringmessagetabledef:=search_system_type('PSTRINGMESSAGETABLE').typedef;
if (oo_has_msgstr in _class.objectoptions) then if (oo_has_msgstr in _class.objectoptions) then
begin begin
tcb.queue_init(voidpointertype); tcb.queue_init(voidpointertype);
tcb.queue_emit_asmsym(strmessagetable,strmessagetabledef); tcb.queue_emit_asmsym(strmessagetable,pstringmessagetabledef);
end end
else else
tcb.emit_tai(Tai_const.Create_nil_dataptr,voidpointertype); tcb.emit_tai(Tai_const.Create_nil_dataptr,pstringmessagetabledef);
end; end;
{ write virtual methods } { write virtual methods }
writevirtualmethods(tcb); writevirtualmethods(tcb);