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

* IID and IIDStr references of the VMT's interface table need to be indirect

Browse Source 
git-svn-id: trunk@34338 -
This commit is contained in:
svenbarth 2016-08-19 13:06:26 +00:00
parent 77de5dd968
commit fb6546972b
3 changed files with 59 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
compiler/ncgvmt.pas
View File

@ -742,12 +742,18 @@ implementation
procedure TVMTWriter.intf_gen_intf_ref(tcb: ttai_typedconstbuilder; AImplIntf: TImplementedInterface; intfindex: longint; interfaceentrydef, interfaceentrytypedef: tdef);
var
pd: tprocdef;
siid,
siidstr: tsymstr;
begin
tcb.maybe_begin_aggregate(interfaceentrydef);
{ GUID (or nil for Corba interfaces) }
siid:='';
if AImplIntf.IntfDef.objecttype in [odt_interfacecom] then
tcb.emit_tai(Tai_const.CreateName(
make_mangledname('IID',AImplIntf.IntfDef.owner,AImplIntf.IntfDef.objname^),AT_DATA,0),cpointerdef.getreusable(rec_tguid))
begin
siid:=make_mangledname('IID',AImplIntf.IntfDef.owner,AImplIntf.IntfDef.objname^);
tcb.emit_tai(Tai_const.Create_sym_offset(
current_asmdata.RefAsmSymbol(siid,AT_DATA,true),0),cpointerdef.getreusable(rec_tguid));
end
else
tcb.emit_tai(Tai_const.Create_nil_dataptr,cpointerdef.getreusable(rec_tguid));
@ -775,15 +781,24 @@ implementation
end;
{ IIDStr }
siidstr:=make_mangledname('IIDSTR',AImplIntf.IntfDef.owner,AImplIntf.IntfDef.objname^);
tcb.queue_init(cpointerdef.getreusable(cshortstringtype));
tcb.queue_emit_asmsym(
current_asmdata.RefAsmSymbol(
make_mangledname('IIDSTR',AImplIntf.IntfDef.owner,AImplIntf.IntfDef.objname^),
AT_DATA),
siidstr,
AT_DATA,
true),
cpointerdef.getreusable(carraydef.getreusable(cansichartype,length(AImplIntf.IntfDef.iidstr^)+1)));
{ IType }
tcb.emit_ord_const(aint(AImplIntf.VtblImplIntf.IType),interfaceentrytypedef);
tcb.maybe_end_aggregate(interfaceentrydef);
if findunitsymtable(AImplIntf.IntfDef.owner).moduleid<>findunitsymtable(_Class.owner).moduleid then
begin
if siid<>'' then
current_module.add_extern_asmsym(siid,AB_EXTERNAL,AT_DATA);
current_module.add_extern_asmsym(siidstr,AB_EXTERNAL,AT_DATA);
end;
end;

31
rtl/inc/objpas.inc
View File

@ -285,6 +285,37 @@
end;
{****************************************************************************
TINTERFACEENTRY
****************************************************************************}
function tinterfaceentry.GetIID: pguid;
begin
{$ifdef VER3_0}
GetIID:=IIDRef;
{$else VER3_0}
if Assigned(IIDRef) then
GetIID:=IIDRef^
else
GetIID:=Nil;
{$endif VER3_0}
end;
function tinterfaceentry.GetIIDStr: pshortstring;
begin
{$ifdef VER3_0}
GetIIDStr:=IIDStrRef;
{$else VER3_0}
if Assigned(IIDStrRef) then
GetIIDStr:=IIDStrRef^
else
GetIIDStr:=Nil;
{$endif VER3_0}
end;
{****************************************************************************
TOBJECT
****************************************************************************}

11
rtl/inc/objpash.inc
View File

@ -167,10 +167,17 @@
pinterfaceentry = ^tinterfaceentry;
tinterfaceentry = record
IID : pguid; { if assigned(IID) then Com else Corba}
private
function GetIID: pguid; inline;
function GetIIDStr: pshortstring; inline;
public
property IID: pguid read GetIID;
property IIDStr: pshortstring read GetIIDStr;
public
IIDRef : {$IFNDEF VER3_0}^{$ENDIF}pguid; { if assigned(IID) then Com else Corba}
VTable : Pointer;
IOffset : sizeuint;
IIDStr : pshortstring; { never nil. Com: upper(GuidToString(IID^)) }
IIDStrRef : {$IFNDEF VER3_0}^{$ENDIF}pshortstring; { never nil. Com: upper(GuidToString(IID^)) }
{$ifdef VER2_6}
case boolean of
{$ifdef ENDIAN_BIG}