m68k: add support register calling convention properly in the interface wrapper generation

git-svn-id: trunk@36499 -

compiler/m68k/hlcgcpu.pas

@@ -114,6 +114,15 @@ implementation
 
   procedure thlcgcpu.g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);
 
+    procedure putselfa0tostack(offs: longint);
+      var
+        href: treference;
+      begin
+        { move a0 which is self out of the way to the stack }
+        reference_reset_base(href,voidpointertype,NR_STACK_POINTER_REG,offs,4,[]);
+        list.concat(taicpu.op_reg_ref(A_MOVE,S_L,NR_A0,href));
+      end;
+
     procedure getselftoa0(offs:longint);
       var
         href : treference;
@@ -139,6 +148,36 @@ implementation
         cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_A0);
       end;
 
+    procedure op_onmethodaddrviastack(offs: longint);
+      var
+        href : treference;
+        href2 : treference;
+      begin
+        if (procdef.extnumber=$ffff) then
+          internalerror(2017061401);
+        reference_reset_base(href,voidpointertype,NR_A0,tobjectdef(procdef.struct).vmtmethodoffset(procdef.extnumber),4,[]);
+
+        { handle-too-large-for-68k offsets }
+        { I'm not even sure this is handled elsewhere in the compiler for VMTs, but lets play safe... (KB) }
+        if href.offset >= high(smallint) then
+          begin
+            list.concat(taicpu.op_const_reg(A_ADD,S_L,href.offset,NR_A0));
+            href.offset:=0;
+          end;
+
+        { push the method address to the stack }
+        reference_reset_base(href2,voidpointertype,NR_STACK_POINTER_REG,0,4,[]);
+        href2.direction:=dir_dec;
+        list.concat(taicpu.op_ref_ref(A_MOVE,S_L,href,href2));
+
+        { restore A0 from the stack }
+        reference_reset_base(href2,voidpointertype,NR_STACK_POINTER_REG,offs+4,4,[]); { offs+4, because we used dir_dec above }
+        list.concat(taicpu.op_ref_reg(A_MOVE,S_L,href2,NR_A0));
+
+        { pop the method address from the stack, and jump to it }
+        list.concat(taicpu.op_none(A_RTS,S_NO));
+      end;
+
     procedure op_ona0methodaddr;
       var
         href : treference;
@@ -181,9 +220,18 @@ implementation
       if (po_virtualmethod in procdef.procoptions) and
           not is_objectpascal_helper(procdef.struct) then
         begin
-          getselftoa0(4);
-          loadvmttoa0;
-          op_ona0methodaddr;
+          if (procdef.proccalloption in [pocall_register]) then
+            begin
+              putselfa0tostack(-8);
+              loadvmttoa0;
+              op_onmethodaddrviastack(-8);
+            end
+          else
+            begin
+              getselftoa0(4);
+              loadvmttoa0;
+              op_ona0methodaddr;
+            end;
         end
       { case 0 }
       else