paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-05-31 09:22:38 +02:00
Code Issues Packages Projects Releases Wiki Activity

* TInterfaceEntry changed to a variant record, that overlays a CodePointer on

Browse Source 
top of the IOffset: SizeUInt field, because it is sometimes used as a
  CodePointer (for etStaticMethodResult and etStaticMethodClass) and sometimes
  as a SizeInt and these two types can be of different size in certain i8086
  memory models

git-svn-id: trunk@34645 -
This commit is contained in:
nickysn 2016-10-07 20:18:02 +00:00
parent 1ec64844c9
commit 7d15b688e8
3 changed files with 23 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
compiler/ncgvmt.pas
View File

@ -747,6 +747,7 @@ implementation
begin
tcb.maybe_begin_aggregate(interfaceentrydef);
{ GUID (or nil for Corba interfaces) }
tcb.next_field:=tabstractrecorddef(interfaceentrydef).symtable.Find('IIDREF') as tfieldvarsym;
siid:='';
if AImplIntf.IntfDef.objecttype in [odt_interfacecom] then
begin
@ -758,29 +759,36 @@ implementation
tcb.emit_tai(Tai_const.Create_nil_dataptr,cpointerdef.getreusable(rec_tguid));
{ VTable }
tcb.next_field:=tabstractrecorddef(interfaceentrydef).symtable.Find('VTABLE') as tfieldvarsym;
tcb.queue_init(voidpointertype);
tcb.queue_emit_asmsym(fintfvtablelabels[intfindex],AImplIntf.VtblImplIntf.IntfDef);
{ IOffset field }
case AImplIntf.VtblImplIntf.IType of
etFieldValue, etFieldValueClass,
etStandard:
tcb.emit_tai(Tai_const.Create_pint(AImplIntf.VtblImplIntf.IOffset),ptruinttype);
begin
tcb.next_field:=tabstractrecorddef(interfaceentrydef).symtable.Find('IOFFSET') as tfieldvarsym;
tcb.emit_tai(Tai_const.Create_sizeint(AImplIntf.VtblImplIntf.IOffset),sizeuinttype);
end;
etStaticMethodResult, etStaticMethodClass:
begin
tcb.next_field:=tabstractrecorddef(interfaceentrydef).symtable.Find('IOFFSETASCODEPTR') as tfieldvarsym;
pd:=tprocdef(tpropertysym(AImplIntf.ImplementsGetter).propaccesslist[palt_read].procdef);
tcb.queue_init(ptruinttype);
tcb.queue_init(codeptruinttype);
tcb.queue_emit_proc(pd);
end;
etVirtualMethodResult, etVirtualMethodClass:
begin
tcb.next_field:=tabstractrecorddef(interfaceentrydef).symtable.Find('IOFFSET') as tfieldvarsym;
pd:=tprocdef(tpropertysym(AImplIntf.ImplementsGetter).propaccesslist[palt_read].procdef);
tcb.emit_tai(Tai_const.Create_pint(tobjectdef(pd.struct).vmtmethodoffset(pd.extnumber)),ptruinttype);
tcb.emit_tai(Tai_const.Create_sizeint(tobjectdef(pd.struct).vmtmethodoffset(pd.extnumber)),sizeuinttype);
end;
else
internalerror(200802162);
end;
{ IIDStr }
tcb.next_field:=tabstractrecorddef(interfaceentrydef).symtable.Find('IIDSTRREF') as tfieldvarsym;
siidstr:=make_mangledname('IIDSTR',AImplIntf.IntfDef.owner,AImplIntf.IntfDef.objname^);
tcb.queue_init(cpointerdef.getreusable(cshortstringtype));
tcb.queue_emit_asmsym(
@ -790,6 +798,7 @@ implementation
true),
cpointerdef.getreusable(carraydef.getreusable(cansichartype,length(AImplIntf.IntfDef.iidstr^)+1)));
{ IType }
tcb.next_field:=tabstractrecorddef(interfaceentrydef).symtable.Find('ITYPE') as tfieldvarsym;
tcb.emit_ord_const(aint(AImplIntf.VtblImplIntf.IType),interfaceentrytypedef);
tcb.maybe_end_aggregate(interfaceentrydef);

4
rtl/inc/objpas.inc
View File

@ -779,12 +779,12 @@
end;
etStaticMethodResult:
begin
Getter.code := CodePointer(IEntry^.IOffset);
Getter.code := IEntry^.IOffsetAsCodePtr;
TInterfaceGetter(Getter)(obj);
end;
etStaticMethodClass:
begin
Getter.code := CodePointer(IEntry^.IOffset);
Getter.code := IEntry^.IOffsetAsCodePtr;
TObject(obj) := TClassGetter(Getter)();
end;
end;

12
rtl/inc/objpash.inc
View File

@ -176,9 +176,15 @@
public
IIDRef : {$IFNDEF VER3_0}^{$ENDIF}pguid; { if assigned(IID) then Com else Corba}
VTable : Pointer;
IOffset : sizeuint;
IIDStrRef : {$IFNDEF VER3_0}^{$ENDIF}pshortstring; { never nil. Com: upper(GuidToString(IID^)) }
IType : tinterfaceentrytype;
case integer of
1 : (
IOffset: sizeuint;
);
2 : (
IOffsetAsCodePtr: CodePointer;
IIDStrRef : {$IFNDEF VER3_0}^{$ENDIF}pshortstring; { never nil. Com: upper(GuidToString(IID^)) }
IType : tinterfaceentrytype;
);
end;
tinterfacetable = record