* fixed bug related to IMPLEMENTS keyword. The interface type was stored inside the interface defintion what was wrong! now it's set per TImplementedInterface$

    * merged IOffset and EntryOffset of TInterfaceEntry. The meaning of IOffset depends now on IType
    * to optimize: IOffset and FieldOffset of TImplementedInterface can be merged also! fpc still generate an interfacetable entry even for interfaces that aren't implemented in the current class (redirected by IMPLEMENTS keyword)

git-svn-id: trunk@6206 -

compiler/nobj.pas

@@ -521,7 +521,7 @@ implementation
                     ImplIntf.AddImplProc(implprocdef)
                   end
                 else
-                  if ImplIntf.IntfDef.iitype = etStandard then
+                  if ImplIntf.VtblImplIntf.itype = etStandard then
                     Message1(sym_e_no_matching_implementation_found,tprocdef(def).fullprocname(false));
               end;
           end;
@@ -1221,7 +1221,10 @@ implementation
         { VTable }
         current_asmdata.asmlists[al_globals].concat(Tai_const.Createname(intf_get_vtbl_name(AImplIntf.VtblImplIntf),0));
         { IOffset field }
-        current_asmdata.asmlists[al_globals].concat(Tai_const.Create_aint(AImplIntf.VtblImplIntf.ioffset));
+        if AImplIntf.VtblImplIntf.itype = etStandard then
+          current_asmdata.asmlists[al_globals].concat(Tai_const.Create_aint(AImplIntf.VtblImplIntf.ioffset))
+        else
+          current_asmdata.asmlists[al_globals].concat(Tai_const.Create_aint(AImplIntf.VtblImplIntf.fieldoffset));
         { IIDStr }
         current_asmdata.getdatalabel(iidlabel);
         rawdata.concat(cai_align.create(const_align(sizeof(aint))));
@@ -1232,10 +1235,8 @@ implementation
         else
           rawdata.concat(Tai_string.Create(AImplIntf.IntfDef.iidstr^));
         current_asmdata.asmlists[al_globals].concat(Tai_const.Create_sym(iidlabel));
-        { EntryType }
-        current_asmdata.asmlists[al_globals].concat(Tai_const.Create_aint(aint(AImplIntf.IntfDef.iitype)));
-        { EntryOffset }
-        current_asmdata.asmlists[al_globals].concat(Tai_const.Create_aint(aint(AImplIntf.IntfDef.iioffset)));
+        { IType }
+        current_asmdata.asmlists[al_globals].concat(Tai_const.Create_aint(aint(AImplIntf.VtblImplIntf.itype)));
       end;
 
 

compiler/pdecvar.pas

@@ -632,8 +632,8 @@ implementation
                end;
              if found then
                begin
-                 ImplIntf.IntfDef.iitype := etFieldValue;
-                 ImplIntf.IntfDef.iioffset := tfieldvarsym(p.propaccesslist[palt_read].firstsym^.sym).fieldoffset;
+                 ImplIntf.itype := etFieldValue;
+                 ImplIntf.fieldoffset := tfieldvarsym(p.propaccesslist[palt_read].firstsym^.sym).fieldoffset;
                end
              else
                Comment(V_Error,'Implements-property used on unimplemented interface');

compiler/symdef.pas

@@ -199,10 +199,14 @@ interface
        TImplementedInterface = class
          IntfDef      : tobjectdef;
          IntfDefDeref : tderef;
+         IType        : tinterfaceentrytype;
          IOffset      : longint;
-         VtblImplIntf   : TImplementedInterface;
+         VtblImplIntf : TImplementedInterface;
          NameMappings : TFPHashList;
          ProcDefs     : TFPObjectList;
+         FieldOffset  : longint;
+         // FieldOffset can be merged with IOffset. But then, fpc is not allowed to genrate a vmtentry.
+         // Right now, fpc generate an entry for all implemented interfaces (but it should just for etStandard ones)
          constructor create(aintf: tobjectdef);
          constructor create_deref(d:tderef);
          destructor  destroy; override;
@@ -232,8 +236,6 @@ interface
           objecttype     : tobjecttyp;
           iidguid        : pguid;
           iidstr         : pshortstring;
-          iitype         : tinterfaceentrytype;
-          iioffset       : longint;
           { store implemented interfaces defs and name mappings }
           ImplementedInterfaces : TFPObjectList;
           constructor create(ot : tobjecttyp;const n : string;c : tobjectdef);
@@ -3576,7 +3578,6 @@ implementation
         else
           ImplementedInterfaces:=nil;
         writing_class_record_dbginfo:=false;
-        iitype := etStandard;
      end;
 
 
@@ -4027,6 +4028,8 @@ implementation
         inherited create;
         intfdef:=aintf;
         ioffset:=-1;
+        itype:=etStandard;
+        fieldoffset:=-1;
         NameMappings:=nil;
         procdefs:=nil;
       end;
@@ -4038,6 +4041,8 @@ implementation
         intfdef:=nil;
         intfdefderef:=d;
         ioffset:=-1;
+        itype:=etStandard;
+        fieldoffset:=-1;
         NameMappings:=nil;
         procdefs:=nil;
       end;

rtl/inc/objpas.inc

@@ -173,7 +173,7 @@
                 i:=intftable^.EntryCount;
                 Res:=@intftable^.Entries[0];
                 while i>0 do begin
-                  if Res^.EntryType = etStandard then
+                  if Res^.IType = etStandard then
                     ppointer(@(pbyte(instance)[Res^.IOffset]))^:=
                       pointer(Res^.VTable);
                   inc(Res);
@@ -604,9 +604,9 @@
           Getter: function: IInterface of object;
         begin
           Pointer(Obj) := nil;
-          if Assigned(IEntry) then
+          if Assigned(IEntry) and Assigned(Instance) then
           begin
-            case IEntry^.EntryType of
+            case IEntry^.IType of
               etStandard:
                 begin
                   //writeln('Doing etStandard cast of ', TObject(Instance).classname(), ' with self = ', ptruint(Instance), ' and offset = ', IEntry^.IOffset);
@@ -614,21 +614,21 @@
                 end;
               etFieldValue:
                 begin
-                  //writeln('Doing etFieldValue cast of ', TObject(Instance).classname(), ' with offset = ', IEntry^.EntryOffset);
-                  Pointer(obj) := ppointer(Pointer(Instance)+IEntry^.EntryOffset)^;
+                  //writeln('Doing etFieldValue cast of ', TObject(Instance).classname(), ' with offset = ', IEntry^.IOffset);
+                  Pointer(obj) := ppointer(Pointer(Instance)+IEntry^.IOffset)^;
                 end;
               etVirtualMethodResult:
                 begin
                   //writeln('Doing etVirtualMethodResult cast of ', TObject(Instance).classname());
                   TMethod(Getter).data := Instance;
-                  TMethod(Getter).code := ppointer(ptrint(Instance) + IEntry^.EntryOffset)^;
+                  TMethod(Getter).code := ppointer(ptrint(Instance) + IEntry^.IOffset)^;
                   Pointer(obj) := Pointer(Getter());
                 end;
               etStaticMethodResult:
                 begin
                   //writeln('Doing etStaticMethodResult cast of ', TObject(Instance).classname());
                   TMethod(Getter).data := Instance;
-                  TMethod(Getter).code := pointer(IEntry^.EntryOffset);
+                  TMethod(Getter).code := pointer(IEntry^.IOffset);
                   Pointer(obj) := Pointer(Getter());
                 end;
             end;

rtl/inc/objpash.inc

@@ -124,8 +124,7 @@
          VTable      : Pointer;
          IOffset     : PtrInt;
          IIDStr      : pshortstring; { never nil. Com: upper(GuidToString(IID^)) }
-         EntryType   : tinterfaceentrytype;
-         EntryOffset : PtrInt;
+         IType       : tinterfaceentrytype;
        end;
 
        pinterfacetable = ^tinterfacetable;