* make call by value stdcall for records and arrays delphi compatible

git-svn-id: trunk@9280 -
This commit is contained in:
peter 2007-11-18 12:53:55 +00:00
parent 9f04aad33e
commit 05e44101e8
3 changed files with 65 additions and 15 deletions
.gitattributes
compiler/i386
tests/webtbs

1
.gitattributes vendored
View File

@ -7776,6 +7776,7 @@ tests/webtbs/tw10002.pp svneol=native#text/plain
tests/webtbs/tw10009.pp svneol=native#text/plain
tests/webtbs/tw10013.pp svneol=native#text/plain
tests/webtbs/tw10072.pp svneol=native#text/plain
tests/webtbs/tw10203.pp svneol=native#text/plain
tests/webtbs/tw1021.pp svneol=native#text/plain
tests/webtbs/tw1023.pp svneol=native#text/plain
tests/webtbs/tw1041.pp svneol=native#text/plain

View File

@ -173,12 +173,10 @@ unit cpupara;
result:=true;
recorddef :
begin
{ Win32 stdcall passes small records on the stack for call by
value }
{ Delphi stdcall passes records on the stack for call by value }
if (target_info.system=system_i386_win32) and
(calloption=pocall_stdcall) and
(varspez=vs_value) and
(def.size<=16) then
(varspez=vs_value) then
result:=false
else
result:=
@ -189,19 +187,11 @@ unit cpupara;
end;
arraydef :
begin
{ Win32 stdcall passes arrays on the stack for call by
value }
if (target_info.system=system_i386_win32) and
(calloption=pocall_stdcall) and
(varspez=vs_value) and
(tarraydef(def).highrange>=tarraydef(def).lowrange) then
result:=false
else
{ array of const values are pushed on the stack as
well as dyn. arrays }
if (calloption in [pocall_cdecl,pocall_cppdecl]) then
result:=not(is_array_of_const(def) or
is_dynamic_array(def))
if (calloption in [pocall_cdecl,pocall_cppdecl]) then
result:=not(is_array_of_const(def) or
is_dynamic_array(def))
else
begin
result:=(

59
tests/webtbs/tw10203.pp Executable file
View File

@ -0,0 +1,59 @@
{ %cpu=i386 }
{ %target=win32 }
{compilation: fpc test.pp}
{$IFDEF FPC}
{$MODE DELPHI}
{$ASMMODE Intel}
{$ELSE}
{$APPTYPE CONSOLE}
{$ENDIF}
type
TBig=record
data:array[1..1000] of integer;
end;
TBig2=array[1..1000] of integer;
var
s,s1:integer;
x:TBig;
x2:TBig2;
err : boolean;
procedure temp(x:TBig);stdcall;
begin
asm
mov s,ebp
end;
end;
procedure temp2(x:TBig2);stdcall;
begin
asm
mov s,ebp
end;
end;
begin
asm
mov s1,esp
end;
writeln(s1);
temp(x);
writeln(s);
if (s1-s)<1000 then
begin
writeln('incompatible with Delphi: records');
err:=true;
end;
asm
mov s1,esp
end;
writeln(s1);
temp2(x2);
writeln(s);
if (s1-s)>1000 then
begin
writeln('incompatible with Delphi: arrays');
err:=true;
end;
if err then
halt(1);
end.