paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-20 07:39:25 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ only allocate a result variable for asm routines on i8086, if they are

Browse Source 
returned in a parameter. This improves TP7 compatibility.

git-svn-id: trunk@38246 -
This commit is contained in:
nickysn 2018-02-15 17:51:03 +00:00
parent f3391f81a5
commit f1b6be2d74
3 changed files with 82 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -12513,6 +12513,7 @@ tests/test/tasm18h.pp svneol=native#text/plain
tests/test/tasm19.pp svneol=native#text/plain
tests/test/tasm2.inc 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/tasm3.pp svneol=native#text/plain
tests/test/tasm4.pp svneol=native#text/plain

9
compiler/i8086/cpupara.pas
View File

@ -35,6 +35,7 @@ unit cpupara;
tcpuparamanager = class(tparamanager)
function param_use_paraloc(const cgpara:tcgpara):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 get_para_align(calloption : tproccalloption):byte;override;
function get_volatile_registers_int(calloption : tproccalloption):tcpuregisterset;override;
@ -115,6 +116,14 @@ unit cpupara;
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;
begin
result:=false;

72
tests/test/tasm20.pp Normal file
View 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.