|
@@ -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 }
|
|
|
|
+ inc ax
|
|
|
|
+NoBug1:
|
|
|
|
+ mov Bug, al
|
|
|
|
+ pop bx { pop the saved CS }
|
|
|
|
+ sti
|
|
|
|
+ end;
|
|
|
|
+ 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 }
|
|
mov sp, SavedSP { restore the broken SP }
|
|
inc ax
|
|
inc ax
|
|
-NoBug:
|
|
|
|
|
|
+NoBug2:
|
|
mov Bug, al
|
|
mov Bug, al
|
|
pop bx { pop the saved CS }
|
|
pop bx { pop the saved CS }
|
|
sti
|
|
sti
|
|
end;
|
|
end;
|
|
- CheckBug;
|
|
|
|
|
|
+ CheckBug(2);
|
|
end;
|
|
end;
|
|
|
|
|
|
begin
|
|
begin
|