* support for implementing interface method wrappers at the node tree

    level, used by LLVM

git-svn-id: trunk@31636 -

compiler/ncgvmt.pas

@@ -110,15 +110,14 @@ implementation
       cutils,cclasses,
       globtype,globals,verbose,constexp,
       systems,fmodule,
-      symsym,symtable,defutil,
+      symsym,symtable,symcreat,defutil,
+{$ifdef cpuhighleveltarget}
+      pparautl,
+{$endif cpuhighleveltarget}
       aasmtai,
       wpobase,
       nobj,
       cgbase,parabase,paramgr,cgobj,cgcpu,hlcgobj,hlcgcpu,
-{$ifdef llvm}
-      { override create_hlcodegen from hlcgcpu }
-      hlcgllvm,
-{$endif}
       ncgrtti;
 
 
@@ -1239,6 +1238,10 @@ implementation
         tmps : string;
         pd   : TProcdef;
         ImplIntf : TImplementedInterface;
+{$ifdef cpuhighleveltarget}
+        wrapperpd: tprocdef;
+        wrapperinfo: pskpara_interface_wrapper;
+{$endif cpuhighleveltarget}
       begin
         for i:=0 to _class.ImplementedInterfaces.count-1 do
           begin
@@ -1257,11 +1260,34 @@ implementation
                       tobjectdef(tprocdef(pd).struct).register_vmt_call(tprocdef(pd).extnumber);
                     tmps:=make_mangledname('WRPR',_class.owner,_class.objname^+'_$_'+
                       ImplIntf.IntfDef.objname^+'_$_'+tostr(j)+'_$_'+pd.mangledname);
+{$ifdef cpuhighleveltarget}
+                    { bare copy so we don't copy the aliasnames }
+                    wrapperpd:=tprocdef(pd.getcopyas(procdef,pc_bareproc));
+                    { set the mangled name to the wrapper name }
+                    wrapperpd.setmangledname(tmps);
+                    { insert the wrapper procdef in the current unit's local
+                      symbol table, but set the owning "struct" to the current
+                      class (so self will have the correct type) }
+                    finish_copied_procdef(wrapperpd,tmps,current_module.localsymtable,_class);
+                    { now insert self/vmt }
+                    insert_self_and_vmt_para(wrapperpd);
+                    { and the function result }
+                    insert_funcret_para(wrapperpd);
+                    { recalculate the parameters now that we've added the above }
+                    wrapperpd.calcparas;
+                    { set the info required to generate the implementation }
+                    wrapperpd.synthetickind:=tsk_interface_wrapper;
+                    new(wrapperinfo);
+                    wrapperinfo^.pd:=pd;
+                    wrapperinfo^.offset:=ImplIntf.ioffset;
+                    wrapperpd.skpara:=wrapperinfo;
+{$else cpuhighleveltarget}
                     { create wrapper code }
                     new_section(list,sec_code,tmps,target_info.alignment.procalign);
                     hlcg.init_register_allocators;
                     hlcg.g_intf_wrapper(list,pd,tmps,ImplIntf.ioffset);
                     hlcg.done_register_allocators;
+{$endif cpuhighleveltarget}
                   end;
               end;
           end;
@@ -1317,9 +1343,15 @@ implementation
 
     procedure write_vmts(st:tsymtable;is_global:boolean);
       begin
+        { high level targets use synthetic procdefs to create the inteface
+          wrappers }
+{$ifndef cpuhighleveltarget}
         create_hlcodegen;
+{$endif}
         do_write_vmts(st,is_global);
+{$ifndef cpuhighleveltarget}
         destroy_hlcodegen;
+{$endif}
       end;
 
 end.

compiler/symconst.pas

@@ -401,9 +401,17 @@ type
     tsk_jvm_virtual_clmethod,  // Java wrapper for virtual class method
     tsk_field_getter,          // getter for a field (callthrough property is passed in skpara)
     tsk_field_setter,          // Setter for a field (callthrough property is passed in skpara)
-    tsk_block_invoke_procvar   // Call a procvar to invoke inside a block
+    tsk_block_invoke_procvar,  // Call a procvar to invoke inside a block
+    tsk_interface_wrapper      // Call through to a method from an interface wrapper
   );
 
+  { synthetic procdef supplementary information (tprocdef.skpara) }
+  tskpara_interface_wrapper = record
+    pd: pointer;
+    offset: longint;
+  end;
+  pskpara_interface_wrapper = ^tskpara_interface_wrapper;
+
   { options for objects and classes }
   tobjecttyp = (odt_none,
     odt_class,

compiler/symcreat.pas

@@ -935,6 +935,32 @@ implementation
       str_parse_method_impl(str,pd,false);
     end;
 
+
+  procedure implement_interface_wrapper(pd: tprocdef);
+    var
+      wrapperinfo: pskpara_interface_wrapper;
+      callthroughpd: tprocdef;
+      str: ansistring;
+    begin
+      wrapperinfo:=pskpara_interface_wrapper(pd.skpara);
+      if not assigned(wrapperinfo) then
+        internalerror(2015090801);
+      callthroughpd:=tprocdef(wrapperinfo^.pd);
+      str:='begin ';
+      { self right now points to the VMT of interface inside the instance ->
+        adjust so it points to the start of the instance }
+      str:=str+'pointer(self):=pointer(self) - '+tostr(wrapperinfo^.offset)+';';
+      { now call through to the actual method }
+      if pd.returndef<>voidtype then
+        str:=str+'result:=';
+      str:=str+callthroughpd.procsym.realname+'(';
+      addvisibibleparameters(str,callthroughpd);
+      str:=str+') end;';
+      str_parse_method_impl(str,pd,false);
+      dispose(wrapperinfo);
+      pd.skpara:=nil;
+    end;
+
   procedure add_synthetic_method_implementations_for_st(st: tsymtable);
     var
       i   : longint;
@@ -1007,6 +1033,8 @@ implementation
               implement_field_setter(pd);
             tsk_block_invoke_procvar:
               implement_block_invoke_procvar(pd);
+            tsk_interface_wrapper:
+              implement_interface_wrapper(pd);
             else
               internalerror(2011032801);
           end;

compiler/utils/ppuutils/ppudump.pp

@@ -539,7 +539,8 @@ const
       'jvm enum fpcvalueof', 'jvm enum long2set',
       'jvm enum bitset2set', 'jvm enum set2set',
       'jvm procvar invoke', 'jvm procvar intf constructor',
-      'jvm virtual class method', 'jvm field getter', 'jvm field setter', 'block invoke');
+      'jvm virtual class method', 'jvm field getter', 'jvm field setter',
+      'block invoke','interface wrapper');
 begin
   if w<=ord(high(syntheticName)) then
     result:=syntheticName[tsynthetickind(w)]