mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-07 20:08:12 +02:00

parameter doesn't get copied to a local variable in a pure asm routine git-svn-id: trunk@38249 -
141 lines
2.2 KiB
ObjectPascal
141 lines
2.2 KiB
ObjectPascal
{ %CPU=i8086 }
|
|
|
|
{$IFDEF FPC}
|
|
{$MODE TP}
|
|
{$ELSE}
|
|
{$DEFINE FPC_MM_LARGE}
|
|
{$ENDIF FPC}
|
|
|
|
{$IFDEF FPC_MM_TINY}
|
|
{$DEFINE NEAR_CODE}
|
|
{$DEFINE NEAR_DATA}
|
|
{$ENDIF}
|
|
{$IFDEF FPC_MM_SMALL}
|
|
{$DEFINE NEAR_CODE}
|
|
{$DEFINE NEAR_DATA}
|
|
{$ENDIF}
|
|
{$IFDEF FPC_MM_MEDIUM}
|
|
{$DEFINE FAR_CODE}
|
|
{$DEFINE NEAR_DATA}
|
|
{$ENDIF}
|
|
{$IFDEF FPC_MM_COMPACT}
|
|
{$DEFINE NEAR_CODE}
|
|
{$DEFINE FAR_DATA}
|
|
{$ENDIF}
|
|
{$IFDEF FPC_MM_LARGE}
|
|
{$DEFINE FAR_CODE}
|
|
{$DEFINE FAR_DATA}
|
|
{$ENDIF}
|
|
{$IFDEF FPC_MM_HUGE}
|
|
{$DEFINE FAR_CODE}
|
|
{$DEFINE FAR_DATA}
|
|
{$ENDIF}
|
|
|
|
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}
|
|
res4: string;
|
|
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}
|
|
|
|
function myfunc4: string; assembler;
|
|
asm
|
|
mov actual_sp, sp
|
|
cld
|
|
{$IFDEF FAR_DATA}
|
|
les di, @Result
|
|
{$ELSE}
|
|
mov di, @Result
|
|
push ds
|
|
pop es
|
|
{$ENDIF}
|
|
mov al, 7 { string length }
|
|
stosb
|
|
mov al, 'T'
|
|
stosb
|
|
mov al, 'r'
|
|
stosb
|
|
mov al, 'a'
|
|
stosb
|
|
mov al, 'l'
|
|
stosb
|
|
mov al, 'a'
|
|
stosb
|
|
mov al, 'l'
|
|
stosb
|
|
mov al, 'a'
|
|
stosb
|
|
end;
|
|
|
|
procedure myfunc5(s: string); assembler;
|
|
asm
|
|
mov actual_sp, sp
|
|
end;
|
|
|
|
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}
|
|
res4 := myfunc4;
|
|
if (res4 <> 'Tralala') and ((expect_sp - actual_sp) <> (2 + SizeOf(Pointer))) then
|
|
Error;
|
|
myfunc5('Test');
|
|
if (expect_sp - actual_sp) <> (2 + SizeOf(Pointer)) then
|
|
Error;
|
|
Writeln('Ok!');
|
|
end.
|