* refactor implemented interfaces

git-svn-id: trunk@5134 -

compiler/aasmdata.pas

@@ -133,10 +133,10 @@ interface
         function  RefAsmSymbol(const s : string) : tasmsymbol;
         function  getasmsymbol(const s : string) : tasmsymbol;
         { create new assembler label }
-        procedure getlabel(var l : tasmlabel;alt:tasmlabeltype);
-        procedure getjumplabel(var l : tasmlabel);
-        procedure getaddrlabel(var l : tasmlabel);
-        procedure getdatalabel(var l : tasmlabel);
+        procedure getlabel(out l : tasmlabel;alt:tasmlabeltype);
+        procedure getjumplabel(out l : tasmlabel);
+        procedure getaddrlabel(out l : tasmlabel);
+        procedure getdatalabel(out l : tasmlabel);
         { generate an alternative (duplicate) symbol }
         procedure GenerateAltSymbol(p:tasmsymbol);
         procedure ResetAltSymbols;
@@ -386,7 +386,7 @@ implementation
       end;
 
 
-    procedure TAsmData.getlabel(var l : tasmlabel;alt:tasmlabeltype);
+    procedure TAsmData.getlabel(out l : tasmlabel;alt:tasmlabeltype);
       begin
         l:=tasmlabel.createlocal(FNextLabelNr[alt],alt);
         inc(FNextLabelNr[alt]);
@@ -394,7 +394,7 @@ implementation
       end;
 
 
-    procedure TAsmData.getjumplabel(var l : tasmlabel);
+    procedure TAsmData.getjumplabel(out l : tasmlabel);
       begin
         l:=tasmlabel.createlocal(FNextLabelNr[alt_jump],alt_jump);
         inc(FNextLabelNr[alt_jump]);
@@ -402,7 +402,7 @@ implementation
       end;
 
 
-    procedure TAsmData.getdatalabel(var l : tasmlabel);
+    procedure TAsmData.getdatalabel(out l : tasmlabel);
       begin
         l:=tasmlabel.createglobal(name,FNextLabelNr[alt_data],alt_data);
         inc(FNextLabelNr[alt_data]);
@@ -410,7 +410,7 @@ implementation
       end;
 
 
-    procedure TAsmData.getaddrlabel(var l : tasmlabel);
+    procedure TAsmData.getaddrlabel(out l : tasmlabel);
       begin
         l:=tasmlabel.createlocal(FNextLabelNr[alt_addr],alt_addr);
         inc(FNextLabelNr[alt_addr]);

compiler/dbgdwarf.pas

@@ -2658,11 +2658,11 @@ end;
         end;
 
         { add implemented interfaces }
-        if assigned(def.implementedinterfaces) then
-          for n := 1 to def.implementedinterfaces.count do
+        if assigned(def.ImplementedInterfaces) then
+          for n := 0 to def.ImplementedInterfaces.count-1 do
             begin
               append_entry(DW_TAG_inheritance,false,[]);
-              append_labelentry_ref(DW_AT_type,def_dwarf_lab(def.implementedinterfaces.interfaces(n)));
+              append_labelentry_ref(DW_AT_type,def_dwarf_lab(TImplementedInterface(def.ImplementedInterfaces[n]).IntfDef));
               finish_entry;
             end;
 

compiler/defcmp.pas

@@ -166,7 +166,7 @@ implementation
          subeq,eq : tequaltype;
          hd1,hd2 : tdef;
          hct : tconverttype;
-         hd3 : tobjectdef;
+         hobjdef : tobjectdef;
          hpd : tprocdef;
       begin
          eq:=te_incompatible;
@@ -1149,21 +1149,21 @@ implementation
                      end
                    { classes can be assigned to interfaces }
                    else if is_interface(def_to) and
-                     is_class(def_from) and
-                     assigned(tobjectdef(def_from).implementedinterfaces) then
+                           is_class(def_from) and
+                           assigned(tobjectdef(def_from).ImplementedInterfaces) then
                      begin
                         { we've to search in parent classes as well }
-                        hd3:=tobjectdef(def_from);
-                        while assigned(hd3) do
+                        hobjdef:=tobjectdef(def_from);
+                        while assigned(hobjdef) do
                           begin
-                             if hd3.implementedinterfaces.searchintf(def_to)<>-1 then
+                             if hobjdef.find_implemented_interface(tobjectdef(def_to))<>nil then
                                begin
                                   doconv:=tc_class_2_intf;
                                   { don't prefer this over objectdef->objectdef }
                                   eq:=te_convert_l2;
                                   break;
                                end;
-                             hd3:=hd3.childof;
+                             hobjdef:=hobjdef.childof;
                           end;
                      end
                    { Interface 2 GUID handling }

compiler/ncgcnv.pas

@@ -448,6 +448,7 @@ interface
       var
          l1 : tasmlabel;
          hd : tobjectdef;
+         ImplIntf : TImplementedInterface;
       begin
          location_reset(location,LOC_REGISTER,OS_ADDR);
          case left.location.loc of
@@ -473,14 +474,13 @@ interface
          hd:=tobjectdef(left.resultdef);
          while assigned(hd) do
            begin
-              if hd.implementedinterfaces.searchintf(resultdef)<>-1 then
-                begin
-                   cg.a_op_const_reg(current_asmdata.CurrAsmList,OP_ADD,OS_ADDR,
-                     hd.implementedinterfaces.ioffsets(
-                       hd.implementedinterfaces.searchintf(resultdef)),location.register);
-                   break;
-                end;
-              hd:=hd.childof;
+             ImplIntf:=hd.find_implemented_interface(tobjectdef(resultdef));
+             if assigned(ImplIntf) then
+               begin
+                 cg.a_op_const_reg(current_asmdata.CurrAsmList,OP_ADD,OS_ADDR,ImplIntf.ioffset,location.register);
+                 break;
+               end;
+             hd:=hd.childof;
            end;
          if hd=nil then
            internalerror(2002081301);

compiler/ncgutil.pas

@@ -2722,25 +2722,26 @@ implementation
 
     procedure gen_intf_wrapper(list:TAsmList;_class:tobjectdef);
       var
-        i,j,
-        proccount : longint;
+        i,j  : longint;
         tmps : string;
+        pd   : TProcdef;
+        ImplIntf : TImplementedInterface;
       begin
-        for i:=1 to _class.implementedinterfaces.count do
+        for i:=0 to _class.ImplementedInterfaces.count-1 do
           begin
-            { only if implemented by this class }
-            if _class.implementedinterfaces.implindex(i)=i then
+            ImplIntf:=TImplementedInterface(_class.ImplementedInterfaces[i]);
+            if (ImplIntf=ImplIntf.VtblImplIntf) and
+               assigned(ImplIntf.ProcDefs) then
               begin
-                proccount:=_class.implementedinterfaces.implproccount(i);
-                for j:=1 to proccount do
+                for j:=0 to ImplIntf.ProcDefs.Count-1 do
                   begin
+                    pd:=TProcdef(ImplIntf.ProcDefs[j]);
                     tmps:=make_mangledname('WRPR',_class.owner,_class.objname^+'_$_'+
-                      _class.implementedinterfaces.interfaces(i).objname^+'_$_'+
-                      tostr(j)+'_$_'+_class.implementedinterfaces.implprocs(i,j).mangledname);
+                      ImplIntf.IntfDef.objname^+'_$_'+tostr(j)+'_$_'+pd.mangledname);
                     { create wrapper code }
-                    new_section(list,sec_code,lower(tmps),0);
+                    new_section(list,sec_code,tmps,0);
                     cg.init_register_allocators;
-                    cg.g_intf_wrapper(list,_class.implementedinterfaces.implprocs(i,j),tmps,_class.implementedinterfaces.ioffsets(i));
+                    cg.g_intf_wrapper(list,pd,tmps,ImplIntf.ioffset);
                     cg.done_register_allocators;
                   end;
               end;

compiler/ncnv.pas

@@ -2766,9 +2766,8 @@ implementation
             { left is a class }
             if is_class(left.resultdef) then
              begin
-               { the operands must be related }
-               if not(assigned(tobjectdef(left.resultdef).implementedinterfaces) and
-                      (tobjectdef(left.resultdef).implementedinterfaces.searchintf(right.resultdef)<>-1)) then
+               { the class must implement the interface }
+               if tobjectdef(left.resultdef).find_implemented_interface(tobjectdef(right.resultdef))=nil then
                  CGMessage2(type_e_classes_not_related,
                     FullTypeName(left.resultdef,right.resultdef),
                     FullTypeName(right.resultdef,left.resultdef))

compiler/nobj.pas

@@ -95,14 +95,14 @@ interface
         procedure writevirtualmethods(List:TAsmList);
       private
         { interface tables }
-        function  gintfgetvtbllabelname(intfindex: integer): string;
-        procedure gintfcreatevtbl(intfindex: integer; rawdata: TAsmList);
-        procedure gintfgenentry(intfindex, contintfindex: integer; rawdata: TAsmList);
-        procedure gintfoptimizevtbls;
-        procedure gintfwritedata;
-        function  gintfgetcprocdef(proc: tprocdef;const name: string): tprocdef;
-        procedure gintfdoonintf(intf: tobjectdef; intfindex: longint);
-        procedure gintfwalkdowninterface(intf: tobjectdef; intfindex: longint);
+        function  intf_get_vtbl_name(AImplIntf:TImplementedInterface): string;
+        procedure intf_create_vtbl(rawdata: TAsmList;AImplIntf:TImplementedInterface);
+        procedure intf_gen_intf_ref(rawdata: TAsmList;AImplIntf:TImplementedInterface);
+        procedure intf_optimize_vtbls;
+        procedure intf_write_data;
+        function  intf_search_procdef_by_name(proc: tprocdef;const name: string): tprocdef;
+        procedure intf_get_procdefs(ImplIntf:TImplementedInterface;IntfDef:TObjectDef);
+        procedure intf_get_procdefs_recursive(ImplIntf:TImplementedInterface;IntfDef:TObjectDef);
       public
         constructor create(c:tobjectdef);
         destructor destroy;override;
@@ -129,7 +129,7 @@ implementation
     uses
        SysUtils,
        globals,verbose,systems,
-       symtable,symconst,symtype,defcmp,defutil,
+       symtable,symconst,symtype,defcmp,
        dbgbase
        ;
 
@@ -256,7 +256,7 @@ implementation
     procedure tclassheader.writenames(p : pprocdeftree);
       var
         ca : pchar;
-        len : longint;
+        len : byte;
       begin
          current_asmdata.getdatalabel(p^.nl);
          if assigned(p^.l) then
@@ -290,7 +290,6 @@ implementation
 
     function tclassheader.genstrmsgtab : tasmlabel;
       var
-         r : tasmlabel;
          count : aint;
       begin
          root:=nil;
@@ -303,10 +302,9 @@ implementation
            writenames(root);
 
          { now start writing of the message string table }
-         current_asmdata.getdatalabel(r);
+         current_asmdata.getdatalabel(result);
          current_asmdata.asmlists[al_globals].concat(cai_align.create(const_align(sizeof(aint))));
-         current_asmdata.asmlists[al_globals].concat(Tai_label.Create(r));
-         genstrmsgtab:=r;
+         current_asmdata.asmlists[al_globals].concat(Tai_label.Create(result));
          current_asmdata.asmlists[al_globals].concat(Tai_const.Create_aint(count));
          if assigned(root) then
            begin
@@ -859,60 +857,58 @@ implementation
            Interface tables
 **************************************}
 
-    function  tclassheader.gintfgetvtbllabelname(intfindex: integer): string;
+    function  tclassheader.intf_get_vtbl_name(AImplIntf:TImplementedInterface): string;
       begin
-        gintfgetvtbllabelname:=make_mangledname('VTBL',_class.owner,_class.objname^+
-                               '_$_'+_class.implementedinterfaces.interfaces(intfindex).objname^);
+        result:=make_mangledname('VTBL',_class.owner,_class.objname^+'_$_'+AImplIntf.IntfDef.objname^);
       end;
 
 
-    procedure tclassheader.gintfcreatevtbl(intfindex: integer; rawdata: TAsmList);
+    procedure tclassheader.intf_create_vtbl(rawdata: TAsmList;AImplIntf:TImplementedInterface);
       var
-        implintf: timplementedinterfaces;
-        curintf: tobjectdef;
-        proccount: integer;
-        tmps: string;
-        i: longint;
+        pd : tprocdef;
+        vtblstr,
+        hs : string;
+        i  : longint;
       begin
-        implintf:=_class.implementedinterfaces;
-        curintf:=implintf.interfaces(intfindex);
-
-        section_symbol_start(rawdata,gintfgetvtbllabelname(intfindex),AT_DATA,true,sec_data,const_align(sizeof(aint)));
-        proccount:=implintf.implproccount(intfindex);
-        for i:=1 to proccount do
+        vtblstr:=intf_get_vtbl_name(AImplIntf);
+        section_symbol_start(rawdata,vtblstr,AT_DATA,true,sec_data,const_align(sizeof(aint)));
+        if assigned(AImplIntf.procdefs) then
           begin
-            tmps:=make_mangledname('WRPR',_class.owner,_class.objname^+'_$_'+curintf.objname^+'_$_'+
-              tostr(i)+'_$_'+
-              implintf.implprocs(intfindex,i).mangledname);
-            { create reference }
-            rawdata.concat(Tai_const.Createname(tmps,0));
-          end;
-        section_symbol_end(rawdata,gintfgetvtbllabelname(intfindex));
+            for i:=0 to AImplIntf.procdefs.count-1 do
+              begin
+                pd:=tprocdef(AImplIntf.procdefs[i]);
+                hs:=make_mangledname('WRPR',_class.owner,_class.objname^+'_$_'+AImplIntf.IntfDef.objname^+'_$_'+
+                                     tostr(i)+'_$_'+pd.mangledname);
+                { create reference }
+                rawdata.concat(Tai_const.Createname(hs,0));
+              end;
+           end;
+        section_symbol_end(rawdata,vtblstr);
       end;
 
 
-    procedure tclassheader.gintfgenentry(intfindex, contintfindex: integer; rawdata: TAsmList);
+    procedure tclassheader.intf_gen_intf_ref(rawdata: TAsmList;AImplIntf:TImplementedInterface);
       var
-        implintf: timplementedinterfaces;
-        curintf: tobjectdef;
-        tmplabel: tasmlabel;
+        iidlabel,
+        guidlabel : tasmlabel;
         i: longint;
       begin
-        implintf:=_class.implementedinterfaces;
-        curintf:=implintf.interfaces(intfindex);
         { GUID }
-        if curintf.objecttype in [odt_interfacecom] then
+        if AImplIntf.IntfDef.objecttype in [odt_interfacecom] then
           begin
             { label for GUID }
-            current_asmdata.getdatalabel(tmplabel);
+            current_asmdata.getdatalabel(guidlabel);
             rawdata.concat(cai_align.create(const_align(sizeof(aint))));
-            rawdata.concat(Tai_label.Create(tmplabel));
-            rawdata.concat(Tai_const.Create_32bit(longint(curintf.iidguid^.D1)));
-            rawdata.concat(Tai_const.Create_16bit(curintf.iidguid^.D2));
-            rawdata.concat(Tai_const.Create_16bit(curintf.iidguid^.D3));
-            for i:=Low(curintf.iidguid^.D4) to High(curintf.iidguid^.D4) do
-              rawdata.concat(Tai_const.Create_8bit(curintf.iidguid^.D4[i]));
-            current_asmdata.asmlists[al_globals].concat(Tai_const.Create_sym(tmplabel));
+            rawdata.concat(Tai_label.Create(guidlabel));
+            with AImplIntf.IntfDef.iidguid^ do
+              begin
+                rawdata.concat(Tai_const.Create_32bit(longint(D1)));
+                rawdata.concat(Tai_const.Create_16bit(D2));
+                rawdata.concat(Tai_const.Create_16bit(D3));
+                for i:=Low(D4) to High(D4) do
+                  rawdata.concat(Tai_const.Create_8bit(D4[i]));
+              end;
+            current_asmdata.asmlists[al_globals].concat(Tai_const.Create_sym(guidlabel));
           end
         else
           begin
@@ -920,73 +916,77 @@ implementation
             current_asmdata.asmlists[al_globals].concat(Tai_const.Create_sym(nil));
           end;
         { VTable }
-        current_asmdata.asmlists[al_globals].concat(Tai_const.Createname(gintfgetvtbllabelname(contintfindex),0));
+        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(implintf.ioffsets(contintfindex)));
+        current_asmdata.asmlists[al_globals].concat(Tai_const.Create_aint(AImplIntf.VtblImplIntf.ioffset));
         { IIDStr }
-        current_asmdata.getdatalabel(tmplabel);
+        current_asmdata.getdatalabel(iidlabel);
         rawdata.concat(cai_align.create(const_align(sizeof(aint))));
-        rawdata.concat(Tai_label.Create(tmplabel));
-        rawdata.concat(Tai_const.Create_8bit(length(curintf.iidstr^)));
-        if curintf.objecttype=odt_interfacecom then
-          rawdata.concat(Tai_string.Create(upper(curintf.iidstr^)))
+        rawdata.concat(Tai_label.Create(iidlabel));
+        rawdata.concat(Tai_const.Create_8bit(length(AImplIntf.IntfDef.iidstr^)));
+        if AImplIntf.IntfDef.objecttype=odt_interfacecom then
+          rawdata.concat(Tai_string.Create(upper(AImplIntf.IntfDef.iidstr^)))
         else
-          rawdata.concat(Tai_string.Create(curintf.iidstr^));
-        current_asmdata.asmlists[al_globals].concat(Tai_const.Create_sym(tmplabel));
+          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(integer(curintf.iitype)));
+        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(integer(curintf.iioffset)));
+        current_asmdata.asmlists[al_globals].concat(Tai_const.Create_aint(aint(AImplIntf.IntfDef.iioffset)));
       end;
 
 
-    procedure tclassheader.gintfoptimizevtbls;
+    procedure tclassheader.intf_optimize_vtbls;
       type
         tcompintfentry = record
           weight: longint;
           compintf: longint;
         end;
         { Max 1000 interface in the class header interfaces it's enough imho }
-        tcompintfs = array[1..1000] of tcompintfentry;
+        tcompintfs = array[0..1000] of tcompintfentry;
         pcompintfs = ^tcompintfs;
-        tequals    = array[1..1000] of longint;
+        tequals    = array[0..1000] of longint;
         pequals    = ^tequals;
-        timpls    = array[1..1000] of longint;
+        timpls    = array[0..1000] of longint;
         pimpls    = ^timpls;
       var
-        max: longint;
         equals: pequals;
         compats: pcompintfs;
         impls: pimpls;
+        ImplIntfCount,
         w,i,j,k: longint;
+        ImplIntfI,
+        ImplIntfJ  : TImplementedInterface;
         cij: boolean;
         cji: boolean;
       begin
-        max:=_class.implementedinterfaces.count;
-        if max>High(tequals) then
+        ImplIntfCount:=_class.ImplementedInterfaces.count;
+        if ImplIntfCount>=High(tequals) then
           Internalerror(200006135);
-        getmem(compats,sizeof(tcompintfentry)*max);
-        getmem(equals,sizeof(longint)*max);
-        getmem(impls,sizeof(longint)*max);
-        fillchar(compats^,sizeof(tcompintfentry)*max,0);
-        fillchar(equals^,sizeof(longint)*max,0);
-        fillchar(impls^,sizeof(longint)*max,0);
+        getmem(compats,sizeof(tcompintfentry)*ImplIntfCount);
+        getmem(equals,sizeof(longint)*ImplIntfCount);
+        getmem(impls,sizeof(longint)*ImplIntfCount);
+        filldword(compats^,(sizeof(tcompintfentry) div sizeof(dword))*ImplIntfCount,dword(-1));
+        filldword(equals^,ImplIntfCount,dword(-1));
+        filldword(impls^,ImplIntfCount,dword(-1));
         { ismergepossible is a containing relation
           meaning of ismergepossible(a,b,w) =
           if implementorfunction map of a is contained implementorfunction map of b
           imp(a,b) and imp(b,c) => imp(a,c) ; imp(a,b) and imp(b,a) => a == b
         }
         { the order is very important for correct allocation }
-        for i:=1 to max do
+        for i:=0 to ImplIntfCount-1 do
           begin
-            for j:=i+1 to max do
+            for j:=i+1 to ImplIntfCount-1 do
               begin
-                cij:=_class.implementedinterfaces.isimplmergepossible(i,j,w);
-                cji:=_class.implementedinterfaces.isimplmergepossible(j,i,w);
+                ImplIntfI:=TImplementedInterface(_class.ImplementedInterfaces[i]);
+                ImplIntfJ:=TImplementedInterface(_class.ImplementedInterfaces[j]);
+                cij:=ImplIntfI.IsImplMergePossible(ImplIntfJ,w);
+                cji:=ImplIntfJ.IsImplMergePossible(ImplIntfI,w);
                 if cij and cji then { i equal j }
                   begin
                     { get minimum index of equal }
-                    if equals^[j]=0 then
+                    if equals^[j]=-1 then
                       equals^[j]:=i;
                   end
                 else if cij then
@@ -1010,7 +1010,7 @@ implementation
               end;
           end;
         { Reset, no replacements by default }
-        for i:=1 to max do
+        for i:=0 to ImplIntfCount-1 do
           impls^[i]:=i;
         { Replace vtbls when equal or compat, repeat
           until there are no replacements possible anymore. This is
@@ -1020,64 +1020,70 @@ implementation
         }
         repeat
           k:=0;
-          for i:=1 to max do
+          for i:=0 to ImplIntfCount-1 do
             begin
-              if compats^[impls^[i]].compintf<>0 then
+              if compats^[impls^[i]].compintf<>-1 then
                 impls^[i]:=compats^[impls^[i]].compintf
-              else if equals^[impls^[i]]<>0 then
+              else if equals^[impls^[i]]<>-1 then
                 impls^[i]:=equals^[impls^[i]]
               else
                 inc(k);
             end;
-        until k=max;
-        { Update the implindex }
-        for i:=1 to max do
-          _class.implementedinterfaces.setimplindex(i,impls^[i]);
+        until k=ImplIntfCount;
+        { Update the VtblImplIntf }
+        for i:=0 to ImplIntfCount-1 do
+          begin
+            ImplIntfI:=TImplementedInterface(_class.ImplementedInterfaces[i]);
+            ImplIntfI.VtblImplIntf:=TImplementedInterface(_class.ImplementedInterfaces[impls^[i]]);
+          end;
         freemem(compats);
         freemem(equals);
         freemem(impls);
       end;
 
 
-    procedure tclassheader.gintfwritedata;
+    procedure tclassheader.intf_write_data;
       var
-        rawdata: TAsmList;
-        max,i,j : smallint;
+        rawdata  : TAsmList;
+        i        : longint;
+        ImplIntf : TImplementedInterface;
       begin
-        max:=_class.implementedinterfaces.count;
-
         rawdata:=TAsmList.Create;
         { Two pass, one for allocation and vtbl creation }
-        for i:=1 to max do
+        for i:=0 to _class.ImplementedInterfaces.count-1 do
           begin
-            if _class.implementedinterfaces.implindex(i)=i then { if implement itself }
+            ImplIntf:=TImplementedInterface(_class.ImplementedInterfaces[i]);
+            { if it implements itself }
+            if ImplIntf.VtblImplIntf=ImplIntf then
               begin
                 { allocate a pointer in the object memory }
                 with tobjectsymtable(_class.symtable) do
                   begin
                     datasize:=align(datasize,sizeof(aint));
-                    _class.implementedinterfaces.setioffsets(i,datasize);
+                    ImplIntf.Ioffset:=datasize;
                     inc(datasize,sizeof(aint));
                   end;
                 { write vtbl }
-                gintfcreatevtbl(i,rawdata);
+                intf_create_vtbl(rawdata,ImplIntf);
               end;
           end;
         { second pass: for fill interfacetable and remained ioffsets }
-        current_asmdata.asmlists[al_globals].concat(Tai_const.Create_aint(max));
-        for i:=1 to max do
+        current_asmdata.asmlists[al_globals].concat(Tai_const.Create_aint(_class.ImplementedInterfaces.count));
+        for i:=0 to _class.ImplementedInterfaces.count-1 do
           begin
-            j:=_class.implementedinterfaces.implindex(i);
-            if j<>i then
-              _class.implementedinterfaces.setioffsets(i,_class.implementedinterfaces.ioffsets(j));
-            gintfgenentry(i,j,rawdata);
+            ImplIntf:=TImplementedInterface(_class.ImplementedInterfaces[i]);
+            { Update ioffset of current interface with the ioffset from
+              the interface that is reused to implements this interface }
+            if ImplIntf.VtblImplIntf<>ImplIntf then
+              ImplIntf.Ioffset:=ImplIntf.VtblImplIntf.Ioffset;
+            intf_gen_intf_ref(rawdata,ImplIntf);
           end;
         current_asmdata.asmlists[al_globals].concatlist(rawdata);
         rawdata.free;
       end;
 
 
-    function tclassheader.gintfgetcprocdef(proc: tprocdef;const name: string): tprocdef;
+    function tclassheader.intf_search_procdef_by_name(proc: tprocdef;const name: string): tprocdef;
       const
         po_comp = [po_classmethod,po_staticmethod,po_interrupt,po_iocheck,po_msgstr,po_msgint,
                    po_exports,po_varargs,po_explicitparaloc,po_nostackframe];
@@ -1086,7 +1092,7 @@ implementation
         implprocdef : Tprocdef;
         i: cardinal;
       begin
-        gintfgetcprocdef:=nil;
+        result:=nil;
 
         sym:=tsym(search_class_member(_class,name));
         if assigned(sym) and
@@ -1108,7 +1114,7 @@ implementation
                    (proc.proctypeoption=implprocdef.proctypeoption) and
                    ((proc.procoptions*po_comp)=((implprocdef.procoptions+[po_virtualmethod])*po_comp)) then
                   begin
-                    gintfgetcprocdef:=implprocdef;
+                    result:=implprocdef;
                     exit;
                   end;
               end;
@@ -1116,35 +1122,35 @@ implementation
       end;
 
 
-    procedure tclassheader.gintfdoonintf(intf: tobjectdef; intfindex: longint);
+    procedure tclassheader.intf_get_procdefs(ImplIntf:TImplementedInterface;IntfDef:TObjectDef);
       var
         def: tdef;
         hs,
         prefix,
         mappedname: string;
-        nextexist: pointer;
         implprocdef: tprocdef;
       begin
-        prefix:=_class.implementedinterfaces.interfaces(intfindex).symtable.name^+'.';
-        def:=tdef(intf.symtable.defindex.first);
+        prefix:=ImplIntf.IntfDef.symtable.name^+'.';
+        def:=tdef(IntfDef.symtable.defindex.first);
         while assigned(def) do
           begin
             if def.deftype=procdef then
               begin
+                { Find implementing procdef
+                   1. Check for mapped name
+                   2. Use symbol name }
                 implprocdef:=nil;
-                nextexist:=nil;
-                repeat
-                  hs:=prefix+tprocdef(def).procsym.name;
-                  mappedname:=_class.implementedinterfaces.getmappings(intfindex,hs,nextexist);
-                  if mappedname<>'' then
-                    implprocdef:=gintfgetcprocdef(tprocdef(def),mappedname);
-                until assigned(implprocdef) or not assigned(nextexist);
+                hs:=prefix+tprocdef(def).procsym.name;
+                mappedname:=ImplIntf.GetMapping(hs);
+                if mappedname<>'' then
+                  implprocdef:=intf_search_procdef_by_name(tprocdef(def),mappedname);
                 if not assigned(implprocdef) then
-                  implprocdef:=gintfgetcprocdef(tprocdef(def),tprocdef(def).procsym.name);
+                  implprocdef:=intf_search_procdef_by_name(tprocdef(def),tprocdef(def).procsym.name);
+                { Add procdef to the implemented interface }
                 if assigned(implprocdef) then
-                  _class.implementedinterfaces.addimplproc(intfindex,implprocdef)
+                  ImplIntf.AddImplProc(implprocdef)
                 else
-                  if _class.implementedinterfaces.interfaces(intfindex).iitype = etStandard then
+                  if ImplIntf.IntfDef.iitype = etStandard then
                     Message1(sym_e_no_matching_implementation_found,tprocdef(def).fullprocname(false));
               end;
             def:=tdef(def.indexnext);
@@ -1152,33 +1158,33 @@ implementation
       end;
 
 
-    procedure tclassheader.gintfwalkdowninterface(intf: tobjectdef; intfindex: longint);
+    procedure tclassheader.intf_get_procdefs_recursive(ImplIntf:TImplementedInterface;IntfDef:TObjectDef);
       begin
-        if assigned(intf.childof) then
-          gintfwalkdowninterface(intf.childof,intfindex);
-        gintfdoonintf(intf,intfindex);
+        if assigned(IntfDef.childof) then
+          intf_get_procdefs_recursive(ImplIntf,IntfDef.childof);
+        intf_get_procdefs(ImplIntf,IntfDef);
       end;
 
 
     function tclassheader.genintftable: tasmlabel;
       var
-        intfindex: longint;
-        curintf: tobjectdef;
-        intftable: tasmlabel;
+        ImplIntf  : TImplementedInterface;
+        intftable : tasmlabel;
+        i : longint;
       begin
-        { 1. step collect implementor functions into the implementedinterfaces.implprocs }
-        for intfindex:=1 to _class.implementedinterfaces.count do
+        { 1. step collect implementor functions into the tImplementedInterface.procdefs }
+        for i:=0 to _class.ImplementedInterfaces.count-1 do
           begin
-            curintf:=_class.implementedinterfaces.interfaces(intfindex);
-            gintfwalkdowninterface(curintf,intfindex);
+            ImplIntf:=TImplementedInterface(_class.ImplementedInterfaces[i]);
+            intf_get_procdefs_recursive(ImplIntf,ImplIntf.IntfDef);
           end;
         { 2. Optimize interface tables to reuse wrappers }
-        gintfoptimizevtbls;
+        intf_optimize_vtbls;
         { 3. Calculate offsets in object map and Write interface tables }
         current_asmdata.getdatalabel(intftable);
         current_asmdata.asmlists[al_globals].concat(cai_align.create(const_align(sizeof(aint))));
         current_asmdata.asmlists[al_globals].concat(Tai_label.Create(intftable));
-        gintfwritedata;
+        intf_write_data;
         genintftable:=intftable;
       end;
 
@@ -1283,7 +1289,7 @@ implementation
             new_section(current_asmdata.asmlists[al_globals],sec_rodata,classnamelabel.name,const_align(sizeof(aint)));
 
             { interface table }
-            if _class.implementedinterfaces.count>0 then
+            if _class.ImplementedInterfaces.count>0 then
               interfacetable:=genintftable;
 
             methodnametable:=genpublishedmethodstable;
@@ -1355,7 +1361,7 @@ implementation
             { auto table }
             current_asmdata.asmlists[al_globals].concat(Tai_const.Create_sym(nil));
             { interface table }
-            if _class.implementedinterfaces.count>0 then
+            if _class.ImplementedInterfaces.count>0 then
               current_asmdata.asmlists[al_globals].concat(Tai_const.Create_sym(interfacetable))
             else
               current_asmdata.asmlists[al_globals].concat(Tai_const.Create_sym(nil));

compiler/pdecobj.pas

@@ -271,8 +271,8 @@ implementation
                       (((block_type=bt_type) and typecanbeforward) or
                        not(m_delphi in current_settings.modeswitches)) then
                      begin
-                        { a hack, but it's easy to handle }
-                        { class reference type }
+                        { a hack, but it's easy to handle
+                          class reference type }
                         consume(_OF);
                         single_type(hdef,typecanbeforward);
 
@@ -322,28 +322,27 @@ implementation
            end;
         end;
 
-      procedure handleimplementedinterface(implintf : tobjectdef);
+      procedure handleImplementedInterface(intfdef : tobjectdef);
 
         begin
-            if not is_interface(implintf) then
+            if not is_interface(intfdef) then
               begin
-                 Message1(type_e_interface_type_expected,implintf.typename);
+                 Message1(type_e_interface_type_expected,intfdef.typename);
                  exit;
               end;
-            if aktobjectdef.implementedinterfaces.searchintf(implintf)<>-1 then
-              Message1(sym_e_duplicate_id,implintf.name)
+            if aktobjectdef.find_implemented_interface(intfdef)<>nil then
+              Message1(sym_e_duplicate_id,intfdef.name)
             else
               begin
-                 { allocate and prepare the GUID only if the class
-                   implements some interfaces.
-                 }
-                 if aktobjectdef.implementedinterfaces.count = 0 then
-                   aktobjectdef.prepareguid;
-                 aktobjectdef.implementedinterfaces.addintf(implintf);
+                { allocate and prepare the GUID only if the class
+                  implements some interfaces. }
+                if aktobjectdef.ImplementedInterfaces.count = 0 then
+                  aktobjectdef.prepareguid;
+                aktobjectdef.ImplementedInterfaces.Add(TImplementedInterface.Create(intfdef));
               end;
         end;
 
-      procedure readimplementedinterfaces;
+      procedure readImplementedInterfaces;
         var
           hdef : tdef;
         begin
@@ -355,7 +354,7 @@ implementation
                     Message1(type_e_interface_type_expected,hdef.typename);
                     continue;
                  end;
-               handleimplementedinterface(tobjectdef(hdef));
+               handleImplementedInterface(tobjectdef(hdef));
             end;
         end;
 
@@ -473,8 +472,8 @@ implementation
               if aktobjectdef.objecttype=odt_class then
                 begin
                   if assigned(intfchildof) then
-                    handleimplementedinterface(intfchildof);
-                  readimplementedinterfaces;
+                    handleImplementedInterface(intfchildof);
+                  readImplementedInterfaces;
                 end;
               consume(_RKLAMMER);
             end;

compiler/pdecsub.pas

@@ -630,6 +630,7 @@ implementation
         st : tsymtable;
         aprocsym : tprocsym;
         popclass : boolean;
+        ImplIntf : TImplementedInterface;
       begin
         { Save the position where this procedure really starts }
         procstartfilepos:=current_tokenpos;
@@ -652,8 +653,8 @@ implementation
 
         { examine interface map: function/procedure iname.functionname=locfuncname }
         if assigned(aclass) and
-           assigned(aclass.implementedinterfaces) and
-           (aclass.implementedinterfaces.count>0) and
+           assigned(aclass.ImplementedInterfaces) and
+           (aclass.ImplementedInterfaces.count>0) and
            try_to_consume(_POINT) then
          begin
            storepos:=current_tokenpos;
@@ -667,20 +668,19 @@ implementation
             end;
            current_tokenpos:=storepos;
            { qualifier is interface? }
+           ImplIntf:=nil;
            if (srsym.typ=typesym) and
               (ttypesym(srsym).typedef.deftype=objectdef) then
-             i:=aclass.implementedinterfaces.searchintf(ttypesym(srsym).typedef)
-           else
-             i:=-1;
-           if (i=-1) then
+             ImplIntf:=aclass.find_implemented_interface(tobjectdef(ttypesym(srsym).typedef));
+           if ImplIntf=nil then
              Message(parser_e_interface_id_expected);
            consume(_ID);
            { Create unique name <interface>.<method> }
            hs:=sp+'.'+pattern;
            consume(_EQUAL);
-           if (i<>-1) and
+           if assigned(ImplIntf) and
               (token=_ID) then
-             aclass.implementedinterfaces.addmappings(i,hs,pattern);
+             ImplIntf.AddMapping(hs,pattern);
            consume(_ID);
            result:=true;
            exit;

compiler/pdecvar.pas

@@ -222,7 +222,8 @@ implementation
          sc : TFPObjectList;
          paranr : word;
          i      : longint;
-         intfidx: longint;
+         ImplIntf     : TImplementedInterface;
+         found        : boolean;
          hreadparavs,
          hparavs      : tparavarsym;
          storedprocdef,
@@ -609,38 +610,33 @@ implementation
            end;
          { Parse possible "implements" keyword }
          if try_to_consume(_IMPLEMENTS) then
-         begin
-           consume(_ID);
-           {$message warn unlocalized string}
-           if not is_interface(p.propdef) then
-           begin
-             writeln('Implements property must have interface type');
-             Message1(sym_e_illegal_field, pattern);
-           end;
-           if pattern <> p.propdef.mangledparaname() then
-           begin
-             writeln('Implements-property must implement interface of correct type');
-             Message1(sym_e_illegal_field, pattern);
-           end;
-           intfidx := 0;
-           with aclass.implementedinterfaces do
            begin
-             for i := 1 to count do
-               if interfaces(i).objname^ = pattern then
+             consume(_ID);
+             if not is_interface(p.propdef) then
                begin
-                 intfidx := i;
-                 break;
+                 Comment(V_Error,'Implements property must have interface type');
                end;
-             if intfidx > 0 then
-             begin
-               interfaces(intfidx).iitype := etFieldValue;
-               interfaces(intfidx).iioffset := tfieldvarsym(p.propaccesslist[palt_read].firstsym^.sym).fieldoffset;
-             end else
-             begin
-               writeln('Implements-property used on unimplemented interface');
-               Message1(sym_e_illegal_field, pattern);
-             end;
-           end;
+             if pattern <> p.propdef.mangledparaname() then
+               begin
+                 Comment(V_Error,'Implements-property must implement interface of correct type');
+               end;
+             found:=false;
+             for i:=0 to aclass.ImplementedInterfaces.Count-1 do
+               begin
+                 ImplIntf:=TImplementedInterface(aclass.ImplementedInterfaces[i]);
+                 if ImplIntf.IntfDef.Objname^=pattern then
+                   begin
+                     found:=true;
+                     break;
+                   end;
+               end;
+             if found then
+               begin
+                 ImplIntf.IntfDef.iitype := etFieldValue;
+                 ImplIntf.IntfDef.iioffset := tfieldvarsym(p.propaccesslist[palt_read].firstsym^.sym).fieldoffset;
+               end
+             else
+               Comment(V_Error,'Implements-property used on unimplemented interface');
          end;
 
          { remove temporary procvardefs }

compiler/symdef.pas

@@ -213,19 +213,29 @@ interface
 
        tprocdef = class;
        tobjectdef = class;
-       timplementedinterfaces = class;
-
-       timplintfentry = class(TNamedIndexItem)
-         intf         : tobjectdef;
-         intfderef    : tderef;
-         ioffset      : longint;
-         implindex    : longint;
-         namemappings : tdictionary;
-         procdefs     : TIndexArray;
+
+       { TImplementedInterface }
+
+       TImplementedInterface = class
+         IntfDef      : tobjectdef;
+         IntfDefDeref : tderef;
+         IOffset      : longint;
+         VtblImplIntf   : TImplementedInterface;
+         NameMappings : TFPHashList;
+         ProcDefs     : TFPObjectList;
          constructor create(aintf: tobjectdef);
          constructor create_deref(d:tderef);
          destructor  destroy; override;
+         function  getcopy:TImplementedInterface;
+         procedure buildderef;
+         procedure deref;
+         procedure AddMapping(const origname, newname: string);
+         function  GetMapping(const origname: string):string;
+         procedure AddImplProc(pd:tprocdef);
+         function  IsImplMergePossible(MergingIntf:TImplementedInterface;out weight: longint): boolean;
        end;
+       
+       { tobjectdef }
 
        tobjectdef = class(tabstractrecorddef)
        private
@@ -236,23 +246,23 @@ interface
           procedure count_published_fields(sym:tnamedindexitem;arg:pointer);
           procedure writefields(sym:tnamedindexitem;arg:pointer);
        public
-          childof  : tobjectdef;
-          childofderef  : tderef;
+          childof        : tobjectdef;
+          childofderef   : tderef;
           objname,
-          objrealname   : pshortstring;
-          objectoptions : tobjectoptions;
+          objrealname    : pshortstring;
+          objectoptions  : tobjectoptions;
           { to be able to have a variable vmt position }
           { and no vmt field for objects without virtuals }
-          vmt_offset : longint;
+          vmt_offset     : longint;
           writing_class_record_dbginfo : boolean;
-          objecttype : tobjectdeftype;
-          iidguid: pguid;
-          iidstr: pshortstring;
-          iitype: tinterfaceentrytype;
-          iioffset: longint;
+          objecttype     : tobjectdeftype;
+          iidguid        : pguid;
+          iidstr         : pshortstring;
+          iitype         : tinterfaceentrytype;
+          iioffset       : longint;
           lastvtableindex: longint;
           { store implemented interfaces defs and name mappings }
-          implementedinterfaces: timplementedinterfaces;
+          ImplementedInterfaces : TFPObjectList;
           constructor create(ot : tobjectdeftype;const n : string;c : tobjectdef);
           constructor ppuload(ppufile:tcompilerppufile);
           destructor  destroy;override;
@@ -266,6 +276,7 @@ interface
           function  alignment:shortint;override;
           function  vmtmethodoffset(index:longint):longint;
           function  members_need_inittable : boolean;
+          function  find_implemented_interface(aintfdef:tobjectdef):TImplementedInterface;
           { this should be called when this class implements an interface }
           procedure prepareguid;
           function  is_publishable : boolean;override;
@@ -283,41 +294,6 @@ interface
           function generate_field_table : tasmlabel;
        end;
 
-       timplementedinterfaces = class
-          constructor create;
-          destructor  destroy; override;
-
-          function  count: longint;
-          function  interfaces(intfindex: longint): tobjectdef;
-          function  interfacesderef(intfindex: longint): tderef;
-          function  ioffsets(intfindex: longint): longint;
-          procedure setioffsets(intfindex,iofs:longint);
-          function  implindex(intfindex:longint):longint;
-          procedure setimplindex(intfindex,implidx:longint);
-          function  searchintf(def: tdef): longint;
-          procedure addintf(def: tdef);
-
-          procedure buildderef;
-          procedure deref;
-          { add interface reference loaded from ppu }
-          procedure addintf_deref(const d:tderef;iofs:longint);
-          procedure addintf_ioffset(d:tdef;iofs:longint);
-
-          procedure clearmappings;
-          procedure addmappings(intfindex: longint; const origname, newname: string);
-          function  getmappings(intfindex: longint; const origname: string; var nextexist: pointer): string;
-
-          procedure addimplproc(intfindex: longint; procdef: tprocdef);
-          function  implproccount(intfindex: longint): longint;
-          function  implprocs(intfindex: longint; procindex: longint): tprocdef;
-          function  isimplmergepossible(intfindex, remainindex: longint; var weight: longint): boolean;
-
-       private
-          finterfaces: tindexarray;
-          procedure checkindex(intfindex: longint);
-       end;
-
-
        tclassrefdef = class(tabstractpointerdef)
           constructor create(def:tdef);
           constructor ppuload(ppufile:tcompilerppufile);
@@ -4380,9 +4356,9 @@ implementation
           prepareguid;
         { setup implemented interfaces }
         if objecttype in [odt_class,odt_interfacecorba] then
-          implementedinterfaces:=timplementedinterfaces.create
+          ImplementedInterfaces:=TFPObjectList.Create(true)
         else
-          implementedinterfaces:=nil;
+          ImplementedInterfaces:=nil;
         writing_class_record_dbginfo:=false;
         iitype := etStandard;
      end;
@@ -4390,8 +4366,10 @@ implementation
 
     constructor tobjectdef.ppuload(ppufile:tcompilerppufile);
       var
-         i,implintfcount: longint;
+         i,
+         implintfcount : longint;
          d : tderef;
+         ImplIntf : TImplementedInterface;
       begin
          inherited ppuload(objectdef,ppufile);
          objecttype:=tobjectdeftype(ppufile.getbyte);
@@ -4418,16 +4396,18 @@ implementation
          { load implemented interfaces }
          if objecttype in [odt_class,odt_interfacecorba] then
            begin
-             implementedinterfaces:=timplementedinterfaces.create;
+             ImplementedInterfaces:=TFPObjectList.Create(true);
              implintfcount:=ppufile.getlongint;
-             for i:=1 to implintfcount do
+             for i:=0 to implintfcount-1 do
                begin
-                  ppufile.getderef(d);
-                  implementedinterfaces.addintf_deref(d,ppufile.getlongint);
+                 ppufile.getderef(d);
+                 ImplIntf:=TImplementedInterface.Create_deref(d);
+                 ImplIntf.IOffset:=ppufile.getlongint;
+                 ImplementedInterfaces.Add(ImplIntf);
                end;
            end
          else
-           implementedinterfaces:=nil;
+           ImplementedInterfaces:=nil;
 
          tobjectsymtable(symtable).ppuload(ppufile);
 
@@ -4455,8 +4435,8 @@ implementation
          stringdispose(objrealname);
          if assigned(iidstr) then
            stringdispose(iidstr);
-         if assigned(implementedinterfaces) then
-           implementedinterfaces.free;
+         if assigned(ImplementedInterfaces) then
+           ImplementedInterfaces.free;
          if assigned(iidguid) then
            dispose(iidguid);
          inherited destroy;
@@ -4465,8 +4445,7 @@ implementation
 
     function tobjectdef.getcopy : tstoreddef;
       var
-        i,
-        implintfcount : longint;
+        i : longint;
       begin
         result:=tobjectdef.create(objecttype,objname^,childof);
         tobjectdef(result).symtable:=symtable.getcopy;
@@ -4484,22 +4463,18 @@ implementation
         if assigned(iidstr) then
           tobjectdef(result).iidstr:=stringdup(iidstr^);
         tobjectdef(result).lastvtableindex:=lastvtableindex;
-        if assigned(implementedinterfaces) then
+        if assigned(ImplementedInterfaces) then
           begin
-            implintfcount:=implementedinterfaces.count;
-            for i:=1 to implintfcount do
-              begin
-                tobjectdef(result).implementedinterfaces.addintf_ioffset(implementedinterfaces.interfaces(i),
-                    implementedinterfaces.ioffsets(i));
-              end;
+            for i:=0 to ImplementedInterfaces.count-1 do
+              tobjectdef(result).ImplementedInterfaces.Add(TImplementedInterface(ImplementedInterfaces[i]).Getcopy);
           end;
       end;
 
 
     procedure tobjectdef.ppuwrite(ppufile:tcompilerppufile);
       var
-         implintfcount : longint;
          i : longint;
+         ImplIntf : TImplementedInterface;
       begin
          inherited ppuwrite(ppufile);
          ppufile.putbyte(byte(objecttype));
@@ -4519,13 +4494,13 @@ implementation
 
          if objecttype in [odt_class,odt_interfacecorba] then
            begin
-              implintfcount:=implementedinterfaces.count;
-              ppufile.putlongint(implintfcount);
-              for i:=1 to implintfcount do
-                begin
-                   ppufile.putderef(implementedinterfaces.interfacesderef(i));
-                   ppufile.putlongint(implementedinterfaces.ioffsets(i));
-                end;
+             ppufile.putlongint(ImplementedInterfaces.Count);
+             for i:=0 to ImplementedInterfaces.Count-1 do
+               begin
+                 ImplIntf:=TImplementedInterface(ImplementedInterfaces[i]);
+                 ppufile.putderef(ImplIntf.intfdefderef);
+                 ppufile.putlongint(ImplIntf.Ioffset);
+               end;
            end;
 
          ppufile.writeentry(ibobjectdef);
@@ -4549,6 +4524,7 @@ implementation
 
     procedure tobjectdef.buildderef;
       var
+         i : longint;
          oldrecsyms : tsymtable;
       begin
          inherited buildderef;
@@ -4558,12 +4534,16 @@ implementation
          tstoredsymtable(symtable).buildderef;
          aktrecordsymtable:=oldrecsyms;
          if objecttype in [odt_class,odt_interfacecorba] then
-           implementedinterfaces.buildderef;
+           begin
+             for i:=0 to ImplementedInterfaces.count-1 do
+               TImplementedInterface(ImplementedInterfaces[i]).buildderef;
+           end;
       end;
 
 
     procedure tobjectdef.deref;
       var
+         i : longint;
          oldrecsyms : tsymtable;
       begin
          inherited deref;
@@ -4573,7 +4553,10 @@ implementation
          tstoredsymtable(symtable).deref;
          aktrecordsymtable:=oldrecsyms;
          if objecttype in [odt_class,odt_interfacecorba] then
-           implementedinterfaces.deref;
+           begin
+             for i:=0 to ImplementedInterfaces.count-1 do
+               TImplementedInterface(ImplementedInterfaces[i]).deref;
+           end;
       end;
 
 
@@ -4796,6 +4779,26 @@ implementation
       end;
 
 
+    function tobjectdef.find_implemented_interface(aintfdef:tobjectdef):TImplementedInterface;
+      var
+        ImplIntf : TImplementedInterface;
+        i : longint;
+      begin
+        result:=nil;
+        if not assigned(ImplementedInterfaces) then
+          exit;
+        for i:=0 to ImplementedInterfaces.Count-1 do
+          begin
+            ImplIntf:=TImplementedInterface(ImplementedInterfaces[i]);
+            if ImplIntf.intfdef=aintfdef then
+              begin
+                result:=ImplIntf;
+                exit;
+              end;
+          end;
+      end;
+
+
     procedure tobjectdef.collect_published_properties(sym:tnamedindexitem;arg:pointer);
       var
         hp : tpropnamelistitem;
@@ -5199,301 +5202,133 @@ implementation
 
 
 {****************************************************************************
-                             TIMPLEMENTEDINTERFACES
+                             TImplementedInterface
 ****************************************************************************}
-    type
-      tnamemap = class(TNamedIndexItem)
-        listnext : TNamedIndexItem;
-        newname: pshortstring;
-        constructor create(const aname, anewname: string);
-        destructor  destroy; override;
-      end;
-
-    constructor tnamemap.create(const aname, anewname: string);
-      begin
-        inherited createname(aname);
-        newname:=stringdup(anewname);
-      end;
-
-    destructor  tnamemap.destroy;
-      begin
-        stringdispose(newname);
-        inherited destroy;
-      end;
-
-
-    type
-      tprocdefstore = class(TNamedIndexItem)
-        procdef: tprocdef;
-        constructor create(aprocdef: tprocdef);
-      end;
-
-    constructor tprocdefstore.create(aprocdef: tprocdef);
-      begin
-        inherited create;
-        procdef:=aprocdef;
-      end;
-
 
-    constructor timplintfentry.create(aintf: tobjectdef);
+    constructor TImplementedInterface.create(aintf: tobjectdef);
       begin
         inherited create;
-        intf:=aintf;
+        intfdef:=aintf;
         ioffset:=-1;
-        namemappings:=nil;
+        NameMappings:=nil;
         procdefs:=nil;
       end;
 
 
-    constructor timplintfentry.create_deref(d:tderef);
+    constructor TImplementedInterface.create_deref(d:tderef);
       begin
         inherited create;
-        intf:=nil;
-        intfderef:=d;
+        intfdef:=nil;
+        intfdefderef:=d;
         ioffset:=-1;
-        namemappings:=nil;
+        NameMappings:=nil;
         procdefs:=nil;
       end;
 
 
-    destructor  timplintfentry.destroy;
+    destructor  TImplementedInterface.destroy;
+      var
+        i : longint;
+        mappedname : pshortstring;
       begin
-        if assigned(namemappings) then
-          namemappings.free;
+        if assigned(NameMappings) then
+          begin
+            for i:=0 to NameMappings.Count-1 do
+              begin
+                mappedname:=pshortstring(NameMappings[i]);
+                stringdispose(mappedname);
+              end;
+            NameMappings.free;
+          end;
         if assigned(procdefs) then
           procdefs.free;
         inherited destroy;
       end;
 
 
-    constructor timplementedinterfaces.create;
+    procedure TImplementedInterface.buildderef;
       begin
-        finterfaces:=tindexarray.create(1);
+        intfdefderef.build(intfdef);
       end;
 
-    destructor  timplementedinterfaces.destroy;
-      begin
-        finterfaces.destroy;
-      end;
 
-    function  timplementedinterfaces.count: longint;
+    procedure TImplementedInterface.deref;
       begin
-        count:=finterfaces.count;
+        intfdef:=tobjectdef(intfdefderef.resolve);
       end;
 
-    procedure timplementedinterfaces.checkindex(intfindex: longint);
-      begin
-        if (intfindex<1) or (intfindex>count) then
-          InternalError(200006123);
-      end;
-
-    function  timplementedinterfaces.interfaces(intfindex: longint): tobjectdef;
-      begin
-        checkindex(intfindex);
-        interfaces:=timplintfentry(finterfaces.search(intfindex)).intf;
-      end;
 
-    function  timplementedinterfaces.interfacesderef(intfindex: longint): tderef;
+    procedure TImplementedInterface.AddMapping(const origname,newname: string);
       begin
-        checkindex(intfindex);
-        interfacesderef:=timplintfentry(finterfaces.search(intfindex)).intfderef;
+        if not assigned(NameMappings) then
+          NameMappings:=TFPHashList.Create;
+        NameMappings.Add(origname,stringdup(newname));
       end;
 
-    function  timplementedinterfaces.ioffsets(intfindex: longint): longint;
-      begin
-        checkindex(intfindex);
-        ioffsets:=timplintfentry(finterfaces.search(intfindex)).ioffset;
-      end;
 
-    procedure timplementedinterfaces.setioffsets(intfindex,iofs:longint);
-      begin
-        checkindex(intfindex);
-        timplintfentry(finterfaces.search(intfindex)).ioffset:=iofs;
-      end;
-
-    function timplementedinterfaces.implindex(intfindex:longint):longint;
-      begin
-        checkindex(intfindex);
-        result:=timplintfentry(finterfaces.search(intfindex)).implindex;
-      end;
-
-    procedure timplementedinterfaces.setimplindex(intfindex,implidx:longint);
-      begin
-        checkindex(intfindex);
-        timplintfentry(finterfaces.search(intfindex)).implindex:=implidx;
-      end;
-
-    function  timplementedinterfaces.searchintf(def: tdef): longint;
-      begin
-        for result := 1 to count do
-          if tdef(interfaces(result)) = def then
-            exit;
-        result := -1;
-      end;
-
-
-    procedure timplementedinterfaces.buildderef;
+    function TImplementedInterface.GetMapping(const origname: string):string;
       var
-        i: longint;
+        mappedname : pshortstring;
       begin
-        for i:=1 to count do
-          with timplintfentry(finterfaces.search(i)) do
-            intfderef.build(intf);
-      end;
-
-
-    procedure timplementedinterfaces.deref;
-      var
-        i: longint;
-      begin
-        for i:=1 to count do
-          with timplintfentry(finterfaces.search(i)) do
-            intf:=tobjectdef(intfderef.resolve);
-      end;
-
-    procedure timplementedinterfaces.addintf_deref(const d:tderef;iofs:longint);
-      var
-        hintf : timplintfentry;
-      begin
-        hintf:=timplintfentry.create_deref(d);
-        hintf.ioffset:=iofs;
-        finterfaces.insert(hintf);
+        result:='';
+        if not assigned(NameMappings) then
+          exit;
+        mappedname:=PShortstring(NameMappings.Find(origname));
+        if assigned(mappedname) then
+          result:=mappedname^;
       end;
 
-    procedure timplementedinterfaces.addintf_ioffset(d:tdef;iofs:longint);
-      var
-        hintf : timplintfentry;
-      begin
-        hintf:=timplintfentry.create(tobjectdef(d));
-        hintf.ioffset:=iofs;
-        finterfaces.insert(hintf);
-      end;
 
-    procedure timplementedinterfaces.addintf(def: tdef);
-      begin
-        if not assigned(def) or (searchintf(def)<>-1) or (def.deftype<>objectdef) or
-           not (tobjectdef(def).objecttype in [odt_interfacecom,odt_interfacecorba]) then
-          internalerror(200006124);
-        finterfaces.insert(timplintfentry.create(tobjectdef(def)));
-      end;
-
-    procedure timplementedinterfaces.clearmappings;
+    procedure TImplementedInterface.AddImplProc(pd:tprocdef);
       var
-        i: longint;
+        i : longint;
+        found : boolean;
       begin
-        for i:=1 to count do
-          with timplintfentry(finterfaces.search(i)) do
+        if not assigned(procdefs) then
+          procdefs:=TFPObjectList.Create(false);
+        { No duplicate entries of the same procdef }
+        found:=false;
+        for i:=0 to procdefs.count-1 do
+          if tprocdef(procdefs[i])=pd then
             begin
-              if assigned(namemappings) then
-                namemappings.free;
-              namemappings:=nil;
+              found:=true;
+              break;
             end;
+        if not found then
+          procdefs.Add(pd);
       end;
 
-    procedure timplementedinterfaces.addmappings(intfindex: longint; const origname, newname: string);
-      begin
-        checkindex(intfindex);
-        with timplintfentry(finterfaces.search(intfindex)) do
-          begin
-            if not assigned(namemappings) then
-              namemappings:=tdictionary.create;
-            namemappings.insert(tnamemap.create(origname,newname));
-          end;
-      end;
 
-    function  timplementedinterfaces.getmappings(intfindex: longint; const origname: string; var nextexist: pointer): string;
-      begin
-        checkindex(intfindex);
-        if not assigned(nextexist) then
-          with timplintfentry(finterfaces.search(intfindex)) do
-            begin
-              if assigned(namemappings) then
-                nextexist:=namemappings.search(origname)
-              else
-                nextexist:=nil;
-            end;
-        if assigned(nextexist) then
-          begin
-            getmappings:=tnamemap(nextexist).newname^;
-            nextexist:=tnamemap(nextexist).listnext;
-          end
-        else
-          getmappings:='';
-      end;
-
-    procedure timplementedinterfaces.addimplproc(intfindex: longint; procdef: tprocdef);
+    function TImplementedInterface.IsImplMergePossible(MergingIntf:TImplementedInterface;out weight: longint): boolean;
       var
-        found : boolean;
-        i     : longint;
+        i : longint;
       begin
-        checkindex(intfindex);
-        with timplintfentry(finterfaces.search(intfindex)) do
+        result:=false;
+        weight:=0;
+        { empty interface is mergeable }
+        if ProcDefs.Count=0 then
           begin
-            if not assigned(procdefs) then
-              procdefs:=tindexarray.create(4);
-            { No duplicate entries of the same procdef }
-            found:=false;
-            for i:=1 to procdefs.count do
-              if tprocdefstore(procdefs.search(i)).procdef=procdef then
-                begin
-                  found:=true;
-                  break;
-                end;
-            if not found then
-              procdefs.insert(tprocdefstore.create(procdef));
+            result:=true;
+            exit;
+          end;
+        { The interface to merge must at least the number of
+          procedures of this interface }
+        if MergingIntf.ProcDefs.Count<ProcDefs.Count then
+          exit;
+        for i:=0 to ProcDefs.Count-1 do
+          begin
+            if MergingIntf.ProcDefs[i]<>ProcDefs[i] then
+              exit;
           end;
+        weight:=ProcDefs.Count;
+        result:=true;
       end;
 
-    function  timplementedinterfaces.implproccount(intfindex: longint): longint;
-      begin
-        checkindex(intfindex);
-        with timplintfentry(finterfaces.search(intfindex)) do
-          if assigned(procdefs) then
-            implproccount:=procdefs.count
-          else
-            implproccount:=0;
-      end;
 
-    function  timplementedinterfaces.implprocs(intfindex: longint; procindex: longint): tprocdef;
+    function TImplementedInterface.getcopy:TImplementedInterface;
       begin
-        checkindex(intfindex);
-        with timplintfentry(finterfaces.search(intfindex)) do
-          if assigned(procdefs) then
-            implprocs:=tprocdefstore(procdefs.search(procindex)).procdef
-          else
-            internalerror(200006131);
-      end;
-
-    function  timplementedinterfaces.isimplmergepossible(intfindex, remainindex: longint; var weight: longint): boolean;
-      var
-        possible: boolean;
-        i: longint;
-        iiep1: TIndexArray;
-        iiep2: TIndexArray;
-      begin
-        checkindex(intfindex);
-        checkindex(remainindex);
-        iiep1:=timplintfentry(finterfaces.search(intfindex)).procdefs;
-        iiep2:=timplintfentry(finterfaces.search(remainindex)).procdefs;
-        if not assigned(iiep1) then { empty interface is mergeable :-) }
-          begin
-            possible:=true;
-            weight:=0;
-          end
-        else
-          begin
-            possible:=assigned(iiep2) and (iiep1.count<=iiep2.count);
-            i:=1;
-            while (possible) and (i<=iiep1.count) do
-              begin
-                possible:=
-                  (tprocdefstore(iiep1.search(i)).procdef=tprocdefstore(iiep2.search(i)).procdef);
-                inc(i);
-              end;
-            if possible then
-              weight:=iiep1.count;
-          end;
-        isimplmergepossible:=possible;
+        Result:=TImplementedInterface.Create(nil);
+        Move(pointer(self)^,pointer(result)^,InstanceSize);
       end;