View Issue Details

IDProjectCategoryView StatusLast Update
0026774FPCRTLpublic2019-07-27 20:05
ReporterArnaud Bouchez Assigned ToSven Barth  
PrioritynormalSeverityfeatureReproducibilityalways
Status resolvedResolutionfixed 
Product Version2.7.1 
Fixed in Version3.1.1 
Summary0026774: Missing RTTI for interface methods
DescriptionIn FPC, RTTI is generated only for properties, not methods.
Whereas since Delphi 6, RTTI is generated for methods, not properties.

This is a showstopper for any serious work with interfaces in FPC, including stub/mock, or services. Interface is the path to abstraction, and implementation of SOA/SOLID patterns. See http://blog.synopse.info/post/2012/10/14/Interfaces-in-practice%3A-dependency-injection,-stubs-and-mocks

Purpose of this bug report is to have the same RTTI level for interfaces as it was available since Delphi 6, since 2002.

BTW this issue is a showstopper for finishing to integrate our mORMot Open Source framework with FPC - remote ORM works well, but interface-based SOA needs RTTI for all methods.
Steps To ReproduceThere is no RTTI available, so we can't state which kind of RTTI is expected.

Perhaps the same information than with Delphi 6, in addition to existing property definition information.
Additional InformationCurrently, even the property information is not yet usable - see http://bugs.freepascal.org/view.php?id=25254

As far as I understood procedure objectdef_rtti_interface_full(def:tobjectdef) in ncgrtti.pas, the method-related RTTI is missing for IInvokable.

The same level of RTTI as with Delphi 6 is needed, i.e. nor only the method name (as with vmtMethodTable), but with all parameters information, calling convention and function result.
Tagsinterface, RTTI
Fixed in Revision35341
FPCOldBugId
FPCTarget
Attached Files

Activities

Arnaud Bouchez

2014-10-14 10:24

reporter   ~0078217

IMHO even if this may sound indeed like a feature from the FPC point of view, what we need is to have the RTTI available since Delphi 6, more than 12 years ago.

The FPC team did try to enhance compatibility with much newer versions of Delphi, so I guess having the same RTTI level than Delphi 6 may be seen as some kind of long standing issue.

Good support "Interface" type are necessary for any SOLID code, including SOA, stubs and mocks.

stocki

2014-10-19 12:07

reporter   ~0078367

related issue with interface: http://bugs.freepascal.org/view.php?id=26602

Florian

2014-10-19 15:59

administrator   ~0078373

Last edited: 2014-10-19 15:59

View 2 revisions

0026602 is not related in any way.

Necem

2014-11-05 14:28

reporter   ~0078915

It would be useful to have somebody provide a specification for the RTTI layout. I'm willing to supply a patch, since I have a working implementation with my own layout one top of the current trunk.

Arnaud Bouchez

2014-11-06 10:03

reporter   ~0078939

The RTTI layout is well defined by
http://hallvards.blogspot.fr/2006/06/simple-interface-rtti.html
http://hallvards.blogspot.fr/2006/08/extended-interface-rtti.html
Nice articles, back in 2006!
There is also included some code which may be able to test your implementation.

We could discuss further on our forum, at http://synopse.info/forum/viewtopic.php?id=2149

Michael Van Canneyt

2014-11-11 12:19

administrator   ~0079089

As a note:
The implementation is started by Steve Hildebrandt based on a description I sent him. Hopefully we'll have it in trunk soon. Note that the implementation will probably not match Delphi's RTTI 100% (as we're cross cpu) but the differences should be really minimal.

Michael Van Canneyt

2014-11-11 12:20

administrator   ~0079090

And to be correct, it is D7, not D6 which introduced IInvokable :-)

Arnaud Bouchez

2014-11-11 14:54

reporter   ~0079093

Thanks a lot for the initiative and prompt feedback!
No problem about differences (e.g. about alignment and so on): we already managed to use the FPC RTTI in cross-platform way in our units.

To be fair, both IInvokable and the RTTI were available in Delphi 6. The IInvokable type is well defined in Delphi 6's system.pas unit.
We do compile and run all mORMot regression tests, including interface-based features, with Delphi 6. :-)

Thanks again!
We could help testing Steve's implementation ASAP, on our own FPC trunk SVN copy.

Arnaud Bouchez

2015-01-07 12:40

reporter   ~0080178

No news since 2 months?
Do you need any help?

Cyrax

2015-03-02 08:46

reporter   ~0081551

See : http://lists.freepascal.org/fpc-devel/2015-February/035314.html

Leslie

2016-03-23 09:23

reporter   ~0091279

It would be really nice to be able to use mORMot inteface base services with FPC. As far as I understand, the solution already exists in an FPC branch Could this be committed to the main development branch?

Alfred

2016-03-23 14:18

reporter   ~0091291

I would like to support this request.

More, a patch is included to enable this feature for current trunk.
Its just the RTTI patch by Joost, with switch, hidded between defines, and adjusted for trunk.

I know that there are many arguments against, but I hope that it still could be allowed.

Alfred

2016-03-23 14:19

reporter  

REV33315.diff (25,363 bytes)   
Index: compiler/arm/cpupara.pas
===================================================================
--- compiler/arm/cpupara.pas	(revision 33315)
+++ compiler/arm/cpupara.pas	(working copy)
@@ -37,6 +37,7 @@
           function get_volatile_registers_int(calloption : tproccalloption):tcpuregisterset;override;
           function get_volatile_registers_fpu(calloption : tproccalloption):tcpuregisterset;override;
           function get_volatile_registers_mm(calloption : tproccalloption):tcpuregisterset;override;
+          procedure get_para_regoff(proccalloption: tproccalloption; paraloc: pcgparalocation; out reg: Byte; out off: LongInt);override;
           function push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;override;
           function ret_in_param(def:tdef;pd:tabstractprocdef):boolean;override;
           procedure getintparaloc(list: TAsmList; pd : tabstractprocdef; nr : longint; var cgpara : tcgpara);override;
@@ -74,7 +75,45 @@
         result:=VOLATILE_FPUREGISTERS;
       end;
 
+    procedure tcpuparamanager.get_para_regoff(proccalloption: tproccalloption; paraloc: pcgparalocation; out reg: Byte; out off: LongInt);
+    var
+      I : SizeInt;
+    begin
+      with paraloc^ do
+        case loc of
+          LOC_REGISTER:
+            begin
+              reg:=getsupreg(register)-RS_R0;
+              off:=0;
+            end;
+          LOC_FPUREGISTER:
+            begin
+              reg:=getsupreg(register)-RS_F0;
+              off:=0;
+            end;
+          LOC_MMREGISTER:
+            begin
+              reg:=getsupreg(register);
+              if reg < RS_S1 then
+                begin
+                  reg:=reg-RS_D0;
+                  off:=0;
+                end
+              else
+                begin
+                  reg:=reg-RS_S1;
+                  off:=4;
+                end;
+            end;
+          LOC_REFERENCE:
+            begin
+              reg:=255;
+              off:=reference.offset;
+            end;
+        end;
+    end;
 
+
     function tcpuparamanager.get_volatile_registers_mm(calloption: tproccalloption): tcpuregisterset;
       begin
         result:=VOLATILE_MMREGISTERS;
Index: compiler/i386/cpupara.pas
===================================================================
--- compiler/i386/cpupara.pas	(revision 33315)
+++ compiler/i386/cpupara.pas	(working copy)
@@ -40,6 +40,7 @@
           function get_volatile_registers_int(calloption : tproccalloption):tcpuregisterset;override;
           function get_volatile_registers_fpu(calloption : tproccalloption):tcpuregisterset;override;
           function get_volatile_registers_mm(calloption : tproccalloption):tcpuregisterset;override;
+          procedure get_para_regoff(proccalloption: tproccalloption; paraloc: pcgparalocation; out reg: Byte; out off: LongInt);override;
           function create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;override;
           function create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;override;
           procedure createtempparaloc(list: TAsmList;calloption : tproccalloption;parasym : tparavarsym;can_use_final_stack_loc : boolean;var cgpara:TCGPara);override;
@@ -285,6 +286,29 @@
         result:=[0..first_mm_imreg-1];
       end;
 
+    procedure tcpuparamanager.get_para_regoff(proccalloption: tproccalloption; paraloc: pcgparalocation; out reg: Byte; out off: LongInt);
+    var
+      I : SizeInt;
+    begin
+      with paraloc^ do
+        case loc of
+          LOC_REGISTER:
+            begin
+              for I := 0 to high(parasupregs) do
+                if getsupreg(register)=parasupregs[I] then
+                  begin
+                    reg:=I;
+                    break;
+                  end;
+              off:=0;
+            end;
+          LOC_REFERENCE:
+            begin
+              reg:=255;
+              off:=reference.offset;
+            end;
+        end;
+    end;
 
     function  tcpuparamanager.get_funcretloc(p : tabstractprocdef; side: tcallercallee; forcetempdef: tdef): TCGPara;
       var
Index: compiler/ncgrtti.pas
===================================================================
--- compiler/ncgrtti.pas	(revision 33315)
+++ compiler/ncgrtti.pas	(working copy)
@@ -28,7 +28,7 @@
     uses
       cclasses,constexp,
       aasmbase,aasmcnst,
-      symbase,symconst,symtype,symdef;
+      symbase,symconst,symtype,symdef,symsym;
 
     type
 
@@ -49,6 +49,8 @@
         procedure published_write_rtti(st:tsymtable;rt:trttitype);
         function  published_properties_count(st:tsymtable):longint;
         procedure published_properties_write_rtti_data(tcb: ttai_typedconstbuilder; propnamelist: TFPHashObjectList; st: tsymtable);
+        procedure write_param_flag(tcb: ttai_typedconstbuilder; parasym:tparavarsym);
+        procedure methods_write_rtti(tcb: ttai_typedconstbuilder; st:tsymtable);
         procedure collect_propnamelist(propnamelist:TFPHashObjectList;objdef:tobjectdef);
         function  ref_rtti(def:tdef;rt:trttitype):tasmsymbol;
         procedure write_rtti_name(tcb: ttai_typedconstbuilder; def: tdef);
@@ -77,10 +79,11 @@
        cutils,
        globals,globtype,verbose,systems,
        fmodule, procinfo,
-       symtable,symsym,
+       symtable,
        aasmtai,aasmdata,
        defutil,
-       wpobase
+       wpobase,
+       paramgr
        ;
 
 
@@ -91,6 +94,24 @@
          symconst.ds_none,symconst.ds_none,
          symconst.ds_none,symconst.ds_none);
 
+       ProcCallOptionToCallConv: array[tproccalloption] of byte = (
+        { pocall_none       } 0,
+        { pocall_cdecl      } 1,
+        { pocall_cppdecl    } 5,
+        { pocall_far16      } 6,
+        { pocall_oldfpccall } 7,
+        { pocall_internproc } 8,
+        { pocall_syscall    } 9,
+        { pocall_pascal     } 2,
+        { pocall_register   } 0,
+        { pocall_safecall   } 4,
+        { pocall_stdcall    } 3,
+        { pocall_softfloat  } 10,
+        { pocall_mwpascal   } 11,
+        { pocall_interrupt  } 12,
+        { pocall_hardfloat  } 13
+       );
+
     type
        TPropNameListItem = class(TFPHashObject)
          propindex : longint;
@@ -506,9 +527,117 @@
         tcb.end_anonymous_record;
       end;
 
+    procedure TRTTIWriter.write_param_flag(tcb: ttai_typedconstbuilder; parasym:tparavarsym);
+    var
+      paraspec : byte;
+    begin
+      case parasym.varspez of
+        vs_value   : paraspec := 0;
+        vs_const   : paraspec := pfConst;
+        vs_var     : paraspec := pfVar;
+        vs_out     : paraspec := pfOut;
+        vs_constref: paraspec := pfConstRef;
+      else
+        internalerror(2013112904);
+      end;
+      { Kylix also seems to always add both pfArray and pfReference 
+        in this case
+      }
+      if is_open_array(parasym.vardef) then
+        paraspec:=paraspec or pfArray or pfReference;
+       { and these for classes and interfaces (maybe because they
+                 are themselves addresses?)
+       }
+       if is_class_or_interface(parasym.vardef) then
+         paraspec:=paraspec or pfAddress;
+         { set bits run from the highest to the lowest bit on
+           big endian systems
+         }
+       if (target_info.endian = endian_big) then
+         paraspec:=reverse_byte(paraspec);
+       { write flags for current parameter }
+       tcb.emit_ord_const(paraspec,u8inttype);
+    end;
 
+    procedure TRTTIWriter.methods_write_rtti(tcb: ttai_typedconstbuilder; st: tsymtable);
+    var
+      count: Word;
+      i,j,k: LongInt;
+
+      sym : tprocsym;
+      def : tabstractprocdef;
+      para : tparavarsym;
+
+      reg: Byte;
+      off: LongInt;
+    begin
+      tcb.begin_anonymous_record('',defaultpacking,reqalign,
+          targetinfos[target_info.system]^.alignment.recordalignmin,
+          targetinfos[target_info.system]^.alignment.maxCrecordalign);
+
+      count:=0;
+      for i:=0 to st.SymList.Count-1 do
+        if (tsym(st.SymList[i]).typ=procsym) then
+          inc(count, tprocsym(st.SymList[i]).ProcdefList.count);
+
+      tcb.emit_ord_const(count,u16inttype);
+      tcb.emit_ord_const(count,u16inttype);
+
+      for i:=0 to st.SymList.Count-1 do
+        if (tsym(st.SymList[i]).typ=procsym) then
+          begin
+            sym:=tprocsym(st.SymList[i]);
+            for j:=0 to sym.ProcdefList.count-1 do
+              begin
+                def:=tabstractprocdef(sym.ProcdefList[j]);
+                def.init_paraloc_info(callerside);
+
+                tcb.begin_anonymous_record('',defaultpacking,reqalign,
+                  targetinfos[target_info.system]^.alignment.recordalignmin,
+                  targetinfos[target_info.system]^.alignment.maxCrecordalign);
+
+                tcb.emit_shortstring_const(sym.realname);
+                tcb.emit_ord_const(3,u8inttype);
+                tcb.emit_ord_const(ProcCallOptionToCallConv[def.proccalloption],u8inttype);
+                write_rtti_reference(tcb,def.returndef,fullrtti);
+                tcb.emit_ord_const(def.callerargareasize,u16inttype);
+                tcb.emit_ord_const(def.maxparacount + 1,u8inttype);
+
+                for k:=0 to def.paras.count-1 do
+                  begin
+                    para:=tparavarsym(def.paras[k]);
+
+                    if (vo_is_hidden_para in para.varoptions) and not (vo_is_self in para.varoptions) then
+                      continue;
+
+                    tcb.begin_anonymous_record('',defaultpacking,reqalign,
+                      targetinfos[target_info.system]^.alignment.recordalignmin,
+                      targetinfos[target_info.system]^.alignment.maxCrecordalign);
+
+                    { write flags for current parameter }
+                    write_param_flag(tcb, para);
+                    { write param type }
+                    write_rtti_reference(tcb,para.vardef,fullrtti);
+
+                    paramanager.get_para_regoff(def.proccalloption, para.paraloc[callerside].location,reg,off);
+
+                    tcb.emit_ord_const(reg,u8inttype);
+                    tcb.emit_ord_const(off,u32inttype);
+
+                    { write name of current parameter }
+                    tcb.emit_shortstring_const(para.realname);
+
+                    tcb.end_anonymous_record;
+                  end;
+
+                tcb.end_anonymous_record;
+              end;
+          end;
+      tcb.end_anonymous_record;
+    end;
+
+
     procedure TRTTIWriter.write_rtti_data(tcb: ttai_typedconstbuilder; def: tdef; rt: trttitype);
-
         procedure unknown_rtti(def:tstoreddef);
         begin
           tcb.emit_ord_const(tkUnknown,u8inttype);
@@ -855,57 +984,7 @@
 
 
         procedure procvardef_rtti(def:tprocvardef);
-           const
-             ProcCallOptionToCallConv: array[tproccalloption] of byte = (
-              { pocall_none       } 0,
-              { pocall_cdecl      } 1,
-              { pocall_cppdecl    } 5,
-              { pocall_far16      } 6,
-              { pocall_oldfpccall } 7,
-              { pocall_internproc } 8,
-              { pocall_syscall    } 9,
-              { pocall_pascal     } 2,
-              { pocall_register   } 0,
-              { pocall_safecall   } 4,
-              { pocall_stdcall    } 3,
-              { pocall_softfloat  } 10,
-              { pocall_mwpascal   } 11,
-              { pocall_interrupt  } 12,
-              { pocall_hardfloat  } 13
-             );
 
-           procedure write_param_flag(parasym:tparavarsym);
-             var
-               paraspec : byte;
-             begin
-               case parasym.varspez of
-                 vs_value   : paraspec := 0;
-                 vs_const   : paraspec := pfConst;
-                 vs_var     : paraspec := pfVar;
-                 vs_out     : paraspec := pfOut;
-                 vs_constref: paraspec := pfConstRef;
-                 else
-                   internalerror(2013112904);
-               end;
-               { Kylix also seems to always add both pfArray and pfReference
-                 in this case
-               }
-               if is_open_array(parasym.vardef) then
-                 paraspec:=paraspec or pfArray or pfReference;
-               { and these for classes and interfaces (maybe because they
-                 are themselves addresses?)
-               }
-               if is_class_or_interface(parasym.vardef) then
-                 paraspec:=paraspec or pfAddress;
-               { set bits run from the highest to the lowest bit on
-                 big endian systems
-               }
-               if (target_info.endian = endian_big) then
-                 paraspec:=reverse_byte(paraspec);
-               { write flags for current parameter }
-               tcb.emit_ord_const(paraspec,u8inttype);
-             end;
-
            procedure write_para(parasym:tparavarsym);
              begin
                { only store user visible parameters }
@@ -912,7 +991,7 @@
                if not(vo_is_hidden_para in parasym.varoptions) then
                  begin
                    { write flags for current parameter }
-                   write_param_flag(parasym);
+                   write_param_flag(tcb, parasym);
                    { write name of current parameter }
                    tcb.emit_shortstring_const(parasym.realname);
                    { write name of type of current parameter }
@@ -932,7 +1011,7 @@
                      targetinfos[target_info.system]^.alignment.recordalignmin,
                      targetinfos[target_info.system]^.alignment.maxCrecordalign);
                    { write flags for current parameter }
-                   write_param_flag(parasym);
+                   write_param_flag(tcb,parasym);
                    { write param type }
                    write_rtti_reference(tcb,parasym.vardef,fullrtti);
                    { write name of current parameter }
@@ -1125,15 +1204,18 @@
             { write iidstr }
             if def.objecttype=odt_interfacecorba then
               begin
-                { prepareguid always allocates an empty string }
-                if not assigned(def.iidstr) then
-                  internalerror(2016021901);
+                if assigned(def.iidstr) then
                 tcb.emit_shortstring_const(def.iidstr^)
+                else
+                  tcb.emit_shortstring_const('');
               end;
 
             { write published properties for this object }
             published_properties_write_rtti_data(tcb,propnamelist,def.symtable);
 
+            { write methods for this object }
+            methods_write_rtti(tcb, def.symtable);
+
             tcb.end_anonymous_record;
             tcb.end_anonymous_record;
 
@@ -1461,6 +1543,8 @@
     end;
 
     procedure TRTTIWriter.write_child_rtti_data(def:tdef;rt:trttitype);
+    var
+      i,j: SizeInt;
       begin
         case def.typ of
           enumdef :
@@ -1482,8 +1566,21 @@
               if (rt=initrtti) or (tobjectdef(def).objecttype=odt_object) then
                 fields_write_rtti(tobjectdef(def).symtable,rt)
               else
+                begin
                 published_write_rtti(tobjectdef(def).symtable,rt);
+
+                  if is_any_interface_kind(def) then
+                    with tobjectdef(def).symtable do
+                      for i := 0 to SymList.Count-1 do
+                        if (tsym(SymList[i]).typ=procsym) then
+                          with tprocsym(tobjectdef(def).symtable.SymList[i]) do
+                            for j := 0 to ProcdefList.Count - 1 do
+                              begin
+                                write_rtti(tabstractprocdef(ProcdefList[j]).returndef,rt);
+                                params_write_rtti(tabstractprocdef(ProcdefList[j]),rt);
             end;
+                end;
+            end;
           classrefdef,
           pointerdef:
             if not is_objc_class_or_protocol(tabstractpointerdef(def).pointeddef) then
Index: compiler/options.pas
===================================================================
--- compiler/options.pas	(revision 33315)
+++ compiler/options.pas	(working copy)
@@ -3280,6 +3280,10 @@
   def_system_macro('FPC_HAS_INTERNAL_ABS_INT64');
 {$endif x86_64 or powerpc64 or aarch64}
 
+{$if defined(x86_64) or defined(i386) or defined(arm)}
+  def_system_macro('FPC_HAS_EXTENDEDINTERFACERTTI');
+{$endif x86_64 or i386 or arm}
+
   def_system_macro('FPC_HAS_UNICODESTRING');
   def_system_macro('FPC_RTTI_PACKSET1');
   def_system_macro('FPC_HAS_CPSTRING');
Index: compiler/paramgr.pas
===================================================================
--- compiler/paramgr.pas	(revision 33315)
+++ compiler/paramgr.pas	(working copy)
@@ -81,6 +81,8 @@
           function get_volatile_registers_flags(calloption : tproccalloption):tcpuregisterset;virtual;
           function get_volatile_registers_mm(calloption : tproccalloption):tcpuregisterset;virtual;
 
+          procedure get_para_regoff(proccalloption: tproccalloption; paraloc: pcgparalocation; out reg: Byte; out off: LongInt);virtual;
+
           procedure getintparaloc(list: TAsmList; pd: tabstractprocdef; nr : longint; var cgpara: tcgpara);virtual;
 
           {# allocate an individual pcgparalocation that's part of a tcgpara
@@ -278,6 +280,12 @@
         result:=[];
       end;
 
+    procedure tparamanager.get_para_regoff(proccalloption: tproccalloption; paraloc: pcgparalocation; out reg: Byte; out off: LongInt);
+    begin
+      reg:=0;
+      off:=0;
+    end;
+
 {$if first_mm_imreg = 0}
   {$WARN 4044 OFF} { Comparison might be always false ... }
 {$endif}
Index: compiler/x86_64/cpupara.pas
===================================================================
--- compiler/x86_64/cpupara.pas	(revision 33315)
+++ compiler/x86_64/cpupara.pas	(working copy)
@@ -44,6 +44,7 @@
           function get_volatile_registers_int(calloption : tproccalloption):tcpuregisterset;override;
           function get_volatile_registers_mm(calloption : tproccalloption):tcpuregisterset;override;
           function get_volatile_registers_fpu(calloption : tproccalloption):tcpuregisterset;override;
+          procedure get_para_regoff(proccalloption: tproccalloption; paraloc: pcgparalocation; out reg: Byte; out off: LongInt);override;
           function create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;override;
           function create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;override;
           function get_funcretloc(p : tabstractprocdef; side: tcallercallee; forcetempdef: tdef): tcgpara;override;
@@ -906,7 +907,6 @@
           result:=[RS_XMM0..RS_XMM15];
       end;
 
-
     function tcpuparamanager.get_volatile_registers_fpu(calloption : tproccalloption):tcpuregisterset;
       begin
         result:=[RS_ST0..RS_ST7];
@@ -913,6 +913,65 @@
       end;
 
 
+    procedure tcpuparamanager.get_para_regoff(proccalloption: tproccalloption; paraloc: pcgparalocation; out reg: Byte; out off: LongInt);
+    var
+      I : SizeInt;
+    begin
+      with paraloc^ do
+        case loc of
+          LOC_REGISTER:
+            begin
+              reg:=getsupreg(register);
+              { winx64 uses different registers }
+              if target_info.system=system_x86_64_win64 then
+                begin
+                  for I := 0 to high(paraintsupregs_winx64) do
+                    if reg=paraintsupregs_winx64[I] then
+                      begin
+                        reg:=I;
+                        break;
+                      end;
+                end
+              else
+                for I := 0 to high(paraintsupregs) do
+                  if reg=paraintsupregs[I] then
+                    begin
+                      reg:=I;
+                      break;
+                    end;
+              off:=0;
+            end;
+          LOC_MMREGISTER:
+            begin
+              reg:=getsupreg(register);
+              { winx64 uses different registers }
+              if target_info.system=system_x86_64_win64 then
+                begin
+                  for I := 0 to high(parammsupregs_winx64) do
+                    if reg=parammsupregs_winx64[I] then
+                      begin
+                        reg:=I;
+                        break;
+                      end;
+                end
+              else
+                for I := 0 to high(parammsupregs) do
+                  if reg=parammsupregs[I] then
+                    begin
+                      reg:=I;
+                      break;
+                    end;
+              off:=0;
+            end;
+          LOC_REFERENCE:
+            begin
+              reg:=255;
+              off:=reference.offset;
+            end;
+        end;
+    end;
+
+
     function tcpuparamanager.get_funcretloc(p : tabstractprocdef; side: tcallercallee; forcetempdef: tdef): tcgpara;
       const
         intretregs: array[0..1] of tregister = (NR_FUNCTION_RETURN_REG,NR_FUNCTION_RETURN_REG_HIGH);
Index: rtl/objpas/typinfo.pp
===================================================================
--- rtl/objpas/typinfo.pp	(revision 33315)
+++ rtl/objpas/typinfo.pp	(working copy)
@@ -54,7 +54,7 @@
        TMethodKind = (mkProcedure,mkFunction,mkConstructor,mkDestructor,
                       mkClassProcedure,mkClassFunction,mkClassConstructor,
                       mkClassDestructor,mkOperatorOverload);
-       TParamFlag     = (pfVar,pfConst,pfArray,pfAddress,pfReference,pfOut);
+       TParamFlag     = (pfVar,pfConst,pfArray,pfAddress,pfReference,pfOut,pfConstRef);
        TParamFlags    = set of TParamFlag;
        TIntfFlag      = (ifHasGuid,ifDispInterface,ifDispatch,ifHasStrGUID);
        TIntfFlags     = set of TIntfFlag;
@@ -63,6 +63,7 @@
        // don't rely on integer values of TCallConv since it includes all conventions
        // which both delphi and fpc support. In the future delphi can support more and
        // fpc own conventions will be shifted/reordered accordinly
+       PCallConv = ^TCallConv;
        TCallConv = (ccReg, ccCdecl, ccPascal, ccStdCall, ccSafeCall,
                     ccCppdecl, ccFar16, ccOldFPCCall, ccInternProc,
                     ccSysCall, ccSoftFloat, ccMWPascal);
@@ -161,6 +162,49 @@
         function GetParam(ParamIndex: Integer): PProcedureParam;
       end;
 
+      PVmtMethodParam = ^TVmtMethodParam;
+      TVmtMethodParam =
+      {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
+      packed
+      {$endif FPC_REQUIRES_PROPER_ALIGNMENT}
+      record
+        Flags: TParamFlags;
+        ParamType: PTypeInfo;
+        ParReg: Byte;
+        ParOff: LongInt;
+        Name: ShortString;
+        {Attribute data TODO}
+      end;
+
+      PIntfMethodEntry = ^TIntfMethodEntry;
+      TIntfMethodEntry =
+      {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
+      packed
+      {$endif FPC_REQUIRES_PROPER_ALIGNMENT}
+      record
+        Name: ShortString;
+        {
+        Version: Byte;
+        CC: TCallConv;
+        ResultType: PTypeInfo;
+        StackSize: Word;
+        ParamCount: Byte;
+        Params: array[0..ParamCount - 1] of TVmtMethodParam;
+        }
+        {Attribute data TODO}
+      end;
+
+      PIntfMethodTable = ^TIntfMethodTable;
+      TIntfMethodTable =
+      {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
+      packed
+      {$endif FPC_REQUIRES_PROPER_ALIGNMENT}
+      record
+        Count: Word;
+        RTTICount: Word;//$FFFF if there is no further info, or the value of Count
+        {Entry: array[0..Count - 1] of TIntfMethodEntry}
+      end;
+
       PTypeData = ^TTypeData;
       TTypeData =
 {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
@@ -241,7 +285,11 @@
                IntfFlags : TIntfFlagsBase;
                GUID: TGUID;
                IntfUnit: ShortString;
-               { here the properties follow as Word Count & array of TPropInfo }
+               {
+               IntfPropCount: Word;
+               IntfProps: array[0..IntfPropCount-1] of TPropInfo;
+               IntfMethTable : TIntfMethodTable;
+               }
               );
             tkInterfaceRaw:
               (
@@ -250,7 +298,11 @@
                IID: TGUID;
                RawIntfUnit: ShortString;
                IIDStr: ShortString;
-               { here the properties follow as Word Count & array of TPropInfo }
+               {
+               RawIntfPropCount: Word;
+               RawIntfProps: array[0..IntfPropCount-1] of TPropInfo;
+               IntfMethTable : TIntfMethodTable;
+               }
               );
             tkArray:
               (ArrayData: TArrayTypeData);
REV33315.diff (25,363 bytes)   

Sven Barth

2017-01-28 14:22

manager   ~0097763

Interface RTTI has now been implemented for COM-style interfaces in r35241. See also here for more information: http://lists.freepascal.org/pipermail/fpc-pascal/2017-January/050021.html

Issue History

Date Modified Username Field Change
2014-09-24 18:38 Arnaud Bouchez New Issue
2014-09-24 18:44 Arnaud Bouchez Tag Attached: interface
2014-09-24 18:44 Arnaud Bouchez Tag Attached: RTTI
2014-09-25 21:53 Florian Severity minor => feature
2014-10-14 10:24 Arnaud Bouchez Note Added: 0078217
2014-10-19 12:07 stocki Note Added: 0078367
2014-10-19 15:59 Florian Note Added: 0078373
2014-10-19 15:59 Florian Note Edited: 0078373 View Revisions
2014-11-05 14:28 Necem Note Added: 0078915
2014-11-06 10:03 Arnaud Bouchez Note Added: 0078939
2014-11-11 12:19 Michael Van Canneyt Note Added: 0079089
2014-11-11 12:20 Michael Van Canneyt Note Added: 0079090
2014-11-11 14:54 Arnaud Bouchez Note Added: 0079093
2015-01-07 12:40 Arnaud Bouchez Note Added: 0080178
2015-03-02 08:46 Cyrax Note Added: 0081551
2016-03-23 09:23 Leslie Note Added: 0091279
2016-03-23 14:18 Alfred Note Added: 0091291
2016-03-23 14:19 Alfred File Added: REV33315.diff
2017-01-28 14:22 Sven Barth Fixed in Revision => 35341
2017-01-28 14:22 Sven Barth Note Added: 0097763
2017-01-28 14:22 Sven Barth Status new => resolved
2017-01-28 14:22 Sven Barth Fixed in Version => 3.1.1
2017-01-28 14:22 Sven Barth Resolution open => fixed
2017-01-28 14:22 Sven Barth Assigned To => Sven Barth