* Fixed passing parameters on the stack to cdecl interface-methods. The 'call'

shifted all the parameters on the stack. Now the 'self' parameter is
   declared as var, not const, restoring its original value is not necessary
   anymore 

git-svn-id: trunk@15744 -

.gitattributes

@@ -9235,6 +9235,8 @@ tests/test/tinterface4.pp svneol=native#text/plain
 tests/test/tinterface5.pp svneol=native#text/plain
 tests/test/tinterface6.pp svneol=native#text/plain
 tests/test/tinterrupt.pp svneol=native#text/plain
+tests/test/tintfcdecl1.pp svneol=native#text/plain
+tests/test/tintfcdecl2.pp svneol=native#text/plain
 tests/test/tintfdef.pp svneol=native#text/plain
 tests/test/tintuint.pp svneol=native#text/plain
 tests/test/tisogoto1.pp svneol=native#text/pascal

compiler/i386/cgcpu.pas

@@ -552,38 +552,20 @@ unit cgcpu;
       {
       possible calling conventions:
                     default stdcall cdecl pascal register
-      default(0):      OK     OK    OK(1)  OK       OK
+      default(0):      OK     OK    OK     OK       OK
-      virtual(2):      OK     OK    OK(3)  OK       OK
+      virtual(1):      OK     OK    OK     OK       OK(2)
 
       (0):
           set self parameter to correct value
           jmp mangledname
 
-      (1): The code is the following
+      (1): The wrapper code use %eax to reach the virtual method address
-           set self parameter to correct value
-           call mangledname
-           set self parameter to interface value
-           ret
-
-           This is different to case (0) because in theory, the caller
-           could reuse the data pushed on the stack so we've to return
-           it unmodified because self is const.
-
-      (2): The wrapper code use %eax to reach the virtual method address
            set self to correct value
            move self,%eax
            mov  0(%eax),%eax ; load vmt
            jmp  vmtoffs(%eax) ; method offs
 
-      (3): The wrapper code use %eax to reach the virtual method address
+      (2): Virtual use values pushed on stack to reach the method address
-           set self to correct value
-           move self,%eax
-           mov  0(%eax),%eax ; load vmt
-           jmp  vmtoffs(%eax) ; method offs
-           set self parameter to interface value
-
-
-      (4): Virtual use values pushed on stack to reach the method address
            so the following code be generated:
            set self to correct value
            push %ebx ; allocate space for function address
@@ -676,30 +658,11 @@ unit cgcpu;
         { set param1 interface to self  }
         g_adjust_self_value(list,procdef,ioffset);
 
-        { case 1 or 2 }
+        if po_virtualmethod in procdef.procoptions then
-        if (procdef.proccalloption in clearstack_pocalls) then
-          begin
-            if po_virtualmethod in procdef.procoptions then
-              begin
-                { case 2 }
-                getselftoeax(0);
-                loadvmttoeax;
-                op_oneaxmethodaddr(A_CALL);
-              end
-            else
-              begin
-                { case 1 }
-                cg.a_call_name(list,procdef.mangledname,false);
-              end;
-            { restore param1 value self to interface }
-            g_adjust_self_value(list,procdef,-ioffset);
-            list.concat(taicpu.op_none(A_RET,S_L));
-          end
-        else if po_virtualmethod in procdef.procoptions then
           begin
             if (procdef.proccalloption=pocall_register) then
               begin
-                { case 4 }
+                { case 2 }
                 list.concat(taicpu.op_reg(A_PUSH,S_L,NR_EBX)); { allocate space for address}
                 list.concat(taicpu.op_reg(A_PUSH,S_L,NR_EAX));
                 getselftoeax(8);
@@ -715,7 +678,7 @@ unit cgcpu;
               end
             else
               begin
-                { case 3 }
+                { case 1 }
                 getselftoeax(0);
                 loadvmttoeax;
                 op_oneaxmethodaddr(A_JMP);

tests/test/tintfcdecl1.pp

@@ -0,0 +1,42 @@
+program tinfcdecl1;
+
+{$mode objfpc}{$H+}
+
+type
+  IcdeclIntf = interface
+  ['{3C409C8B-3A15-44B2-B22D-6BAA2071CAAD}']
+    function DoSomething : longint; cdecl;
+  end;
+
+  { TcdeclClass }
+
+  TcdeclClass = class(TInterfacedObject,IcdeclIntf)
+  private
+    FCounter: integer;
+  public
+    function DoSomething : longint; cdecl;
+  end;
+
+{ TcdeclClass }
+
+function TcdeclClass.DoSomething: longint; cdecl;
+begin
+  inc(FCounter);
+  result := FCounter;
+end;
+
+var
+  js: TcdeclClass;
+  ji: IcdeclIntf;
+  i: longint;
+begin
+  js := TcdeclClass.Create;
+
+  i := js.DoSomething;
+
+  ji := IcdeclIntf(js);
+  i := ji.DoSomething;
+
+  if i <> 2 then halt(1);
+end.
+

tests/test/tintfcdecl2.pp

@@ -0,0 +1,42 @@
+program tintfcdecl2;
+
+{$mode objfpc}{$H+}
+
+type
+  IcdeclIntf = interface
+  ['{3C409C8B-3A15-44B2-B22D-6BAA2071CAAD}']
+    function DoSomething : longint; cdecl;
+  end;
+
+  { TcdeclClass }
+
+  TcdeclClass = class(TInterfacedObject,IcdeclIntf)
+  private
+    FCounter: integer;
+  public
+    function DoSomething : longint; cdecl; virtual;
+  end;
+
+{ TcdeclClass }
+
+function TcdeclClass.DoSomething: longint; cdecl;
+begin
+  inc(FCounter);
+  result := FCounter;
+end;
+
+var
+  js: TcdeclClass;
+  ji: IcdeclIntf;
+  i: longint;
+begin
+  js := TcdeclClass.Create;
+
+  i := js.DoSomething;
+
+  ji := IcdeclIntf(js);
+  i := ji.DoSomething;
+
+  if i <> 2 then halt(1);
+end.
+