paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-11 09:26:15 +02:00
Code Issues Packages Projects Releases Wiki Activity

Modify test to take into account the specific prologue for Huge model

Browse Source 
git-svn-id: trunk@34016 -
This commit is contained in:
pierre 2016-06-24 15:13:37 +00:00
parent 7efce7f121
commit dfeadf89e9
1 changed files with 48 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

54
tests/test/cpu16/i8086/tfarcal1.pp
View File

@ -15,6 +15,7 @@
{$endif} {$endif}
{$ifdef FPC_MM_HUGE} {$ifdef FPC_MM_HUGE}
{$define TEST_ENABLED} {$define TEST_ENABLED}
{$define NEED_POP_DS}
{$endif} {$endif}
{$ELSE FPC} {$ELSE FPC}
{$define TEST_ENABLED} {$define TEST_ENABLED}
@ -33,12 +34,12 @@ var
SavedSP: Word; SavedSP: Word;
Bug: Boolean; Bug: Boolean;
procedure CheckBug; procedure CheckBug(i : byte);
begin begin
if Bug then if Bug then
begin begin
Writeln('FAIL!!!'); Writeln('FAIL!!!');
halt(1); halt(i);
end end
else else
Writeln('OK'); Writeln('OK');
@ -46,14 +47,31 @@ end;
procedure farretproc; assembler; procedure farretproc; assembler;
asm asm
{ Huge mode generates:
push ds
mov ax,TFARCAL1_DATA
mov ds,ax
sequence }
{$ifdef NEED_POP_DS}
pop ds
{$endif def NEED_POP_DS}
{ hardcode it with db, because the compiler could generate a near ret, due { hardcode it with db, because the compiler could generate a near ret, due
to some bug } to some bug }
db $CB { RETF } db $CB { RETF }
end; end;
procedure farretproc2; assembler; {$ifdef FPC} nostackframe;{$endif FPC}
asm
{ hardcode it with db, because the compiler could generate a near ret, due
to some bug }
{ For huge mode, the sequence described above
is not generated here }
db $CB { RETF }
end;
procedure testfarcall; procedure testfarcall;
label label
NoBug; NoBug1, NoBug2;
begin begin
Write('Testing call farretproc...'); Write('Testing call farretproc...');
asm asm
@ -70,15 +88,39 @@ begin
xor ax, ax xor ax, ax
cmp SavedSP, sp cmp SavedSP, sp
je NoBug je NoBug1
mov sp, SavedSP { restore the broken SP } mov sp, SavedSP { restore the broken SP }
inc ax inc ax
NoBug: NoBug1:
mov Bug, al mov Bug, al
pop bx { pop the saved CS } pop bx { pop the saved CS }
sti sti
end; end;
CheckBug; CheckBug(1);
Write('Testing call farretproc2 with nostackframe modifier ...');
asm
cli
{ in case of a near call, the retf will pop this word and we'll detect the
bug without crashing }
push cs
mov SavedSP, sp
{ this should emit a far call }
call farretproc2
xor ax, ax
cmp SavedSP, sp
je NoBug2
mov sp, SavedSP { restore the broken SP }
inc ax
NoBug2:
mov Bug, al
pop bx { pop the saved CS }
sti
end;
CheckBug(2);
end; end;
begin begin