mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-23 04:49:26 +02:00
* make call by value stdcall for records and arrays delphi compatible
git-svn-id: trunk@9280 -
This commit is contained in:
parent
9f04aad33e
commit
05e44101e8
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -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
|
||||
|
@ -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
59
tests/webtbs/tw10203.pp
Executable 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.
|
Loading…
Reference in New Issue
Block a user