mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-18 16:49:20 +02:00
+ only allocate a result variable for asm routines on i8086, if they are
returned in a parameter. This improves TP7 compatibility. git-svn-id: trunk@38246 -
This commit is contained in:
parent
f3391f81a5
commit
f1b6be2d74
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -12513,6 +12513,7 @@ tests/test/tasm18h.pp svneol=native#text/plain
|
|||||||
tests/test/tasm19.pp svneol=native#text/plain
|
tests/test/tasm19.pp svneol=native#text/plain
|
||||||
tests/test/tasm2.inc svneol=native#text/plain
|
tests/test/tasm2.inc svneol=native#text/plain
|
||||||
tests/test/tasm2.pp svneol=native#text/plain
|
tests/test/tasm2.pp svneol=native#text/plain
|
||||||
|
tests/test/tasm20.pp svneol=native#text/plain
|
||||||
tests/test/tasm2a.pp svneol=native#text/plain
|
tests/test/tasm2a.pp svneol=native#text/plain
|
||||||
tests/test/tasm3.pp svneol=native#text/plain
|
tests/test/tasm3.pp svneol=native#text/plain
|
||||||
tests/test/tasm4.pp svneol=native#text/plain
|
tests/test/tasm4.pp svneol=native#text/plain
|
||||||
|
@ -35,6 +35,7 @@ unit cpupara;
|
|||||||
tcpuparamanager = class(tparamanager)
|
tcpuparamanager = class(tparamanager)
|
||||||
function param_use_paraloc(const cgpara:tcgpara):boolean;override;
|
function param_use_paraloc(const cgpara:tcgpara):boolean;override;
|
||||||
function ret_in_param(def:tdef;pd:tabstractprocdef):boolean;override;
|
function ret_in_param(def:tdef;pd:tabstractprocdef):boolean;override;
|
||||||
|
function asm_result_var(def:tdef;pd:tabstractprocdef):boolean;override;
|
||||||
function push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;override;
|
function push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;override;
|
||||||
function get_para_align(calloption : tproccalloption):byte;override;
|
function get_para_align(calloption : tproccalloption):byte;override;
|
||||||
function get_volatile_registers_int(calloption : tproccalloption):tcpuregisterset;override;
|
function get_volatile_registers_int(calloption : tproccalloption):tcpuregisterset;override;
|
||||||
@ -115,6 +116,14 @@ unit cpupara;
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function tcpuparamanager.asm_result_var(def:tdef;pd:tabstractprocdef):boolean;
|
||||||
|
begin
|
||||||
|
if not(po_assembler in pd.procoptions) then
|
||||||
|
internalerror(2018021501);
|
||||||
|
result:=ret_in_param(def,pd);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
function tcpuparamanager.push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;
|
function tcpuparamanager.push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;
|
||||||
begin
|
begin
|
||||||
result:=false;
|
result:=false;
|
||||||
|
72
tests/test/tasm20.pp
Normal file
72
tests/test/tasm20.pp
Normal file
@ -0,0 +1,72 @@
|
|||||||
|
{ %CPU=i8086 }
|
||||||
|
|
||||||
|
{$IFDEF FPC}
|
||||||
|
{$MODE TP}
|
||||||
|
{$ENDIF FPC}
|
||||||
|
|
||||||
|
program tasm20;
|
||||||
|
|
||||||
|
{$S-}
|
||||||
|
|
||||||
|
{ This test checks that assembler functions that return a value in register(s)
|
||||||
|
do not get allocated an extra $result variable on the stack }
|
||||||
|
|
||||||
|
var
|
||||||
|
res: integer;
|
||||||
|
res2: longint;
|
||||||
|
{$ifdef FPC}
|
||||||
|
res3: int64;
|
||||||
|
{$endif FPC}
|
||||||
|
expect_sp: word;
|
||||||
|
actual_sp: word;
|
||||||
|
|
||||||
|
procedure myproc; assembler;
|
||||||
|
asm
|
||||||
|
mov expect_sp, sp
|
||||||
|
end;
|
||||||
|
|
||||||
|
function myfunc: integer; assembler;
|
||||||
|
asm
|
||||||
|
mov actual_sp, sp
|
||||||
|
mov ax, $1234
|
||||||
|
end;
|
||||||
|
|
||||||
|
function myfunc2: longint; assembler;
|
||||||
|
asm
|
||||||
|
mov actual_sp, sp
|
||||||
|
mov ax, $5678
|
||||||
|
mov dx, $1234
|
||||||
|
end;
|
||||||
|
|
||||||
|
{$ifdef FPC}
|
||||||
|
function myfunc3: int64; assembler;
|
||||||
|
asm
|
||||||
|
mov actual_sp, sp
|
||||||
|
mov ax, $1234
|
||||||
|
mov bx, $5678
|
||||||
|
mov cx, $9ABC
|
||||||
|
mov dx, $DEF0
|
||||||
|
end;
|
||||||
|
{$endif FPC}
|
||||||
|
|
||||||
|
procedure Error;
|
||||||
|
begin
|
||||||
|
Writeln('Error!');
|
||||||
|
Halt(1);
|
||||||
|
end;
|
||||||
|
|
||||||
|
begin
|
||||||
|
myproc;
|
||||||
|
res := myfunc;
|
||||||
|
if (res <> $1234) or (expect_sp <> actual_sp) then
|
||||||
|
Error;
|
||||||
|
res2 := myfunc2;
|
||||||
|
if (res2 <> $12345678) or (expect_sp <> actual_sp) then
|
||||||
|
Error;
|
||||||
|
{$ifdef FPC}
|
||||||
|
res3 := myfunc3;
|
||||||
|
if (res3 <> $123456789ABCDEF0) or (expect_sp <> actual_sp) then
|
||||||
|
Error;
|
||||||
|
{$endif FPC}
|
||||||
|
Writeln('Ok!');
|
||||||
|
end.
|
Loading…
Reference in New Issue
Block a user