From 181804e4b99392e09cd134bbd1379a419a2e5fd2 Mon Sep 17 00:00:00 2001
From: joost <joost@cnoc.nl>
Date: Sun, 8 Aug 2010 13:27:54 +0000
Subject: [PATCH] * 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 | 2 ++
compiler/i386/cgcpu.pas | 51 ++++++---------------------------------
tests/test/tintfcdecl1.pp | 42 ++++++++++++++++++++++++++++++++
tests/test/tintfcdecl2.pp | 42 ++++++++++++++++++++++++++++++++
4 files changed, 93 insertions(+), 44 deletions(-)
create mode 100644 tests/test/tintfcdecl1.pp
create mode 100644 tests/test/tintfcdecl2.pp
diff --git a/.gitattributes b/.gitattributes
index 027b677f58..70213ac393 100644
--- a/.gitattributes
+++ b/.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
diff --git a/compiler/i386/cgcpu.pas b/compiler/i386/cgcpu.pas
index faeedca2e6..94c840a5bb 100644
--- a/compiler/i386/cgcpu.pas
+++ b/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
- virtual(2): OK OK OK(3) OK OK
+ default(0): OK OK OK 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
- 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
+ (1): 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
- 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
+ (2): 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 (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
+ 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);
diff --git a/tests/test/tintfcdecl1.pp b/tests/test/tintfcdecl1.pp
new file mode 100644
index 0000000000..75a407cdd8
--- /dev/null
+++ b/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.
+
diff --git a/tests/test/tintfcdecl2.pp b/tests/test/tintfcdecl2.pp
new file mode 100644
index 0000000000..ec9b93607a
--- /dev/null
+++ b/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.
+