Browse Source

+ added an i8086 test tfarcal1.pp, which tests calling a far procedure from within inline asm code

git-svn-id: trunk@25435 -
nickysn 12 years ago
parent
commit
5a42a8d707
2 changed files with 92 additions and 0 deletions
  1. 1 0
      .gitattributes
  2. 91 0
      tests/test/cpu16/i8086/tfarcal1.pp

+ 1 - 0
.gitattributes

@@ -10631,6 +10631,7 @@ tests/test/cg/variants/tvarol9.pp svneol=native#text/plain
 tests/test/cg/variants/tvarol91.pp svneol=native#text/plain
 tests/test/cg/variants/tvarol94.pp svneol=native#text/plain
 tests/test/cg/variants/tvarol96.pp svneol=native#text/plain
+tests/test/cpu16/i8086/tfarcal1.pp svneol=native#text/pascal
 tests/test/cpu16/i8086/tfarptr1.pp svneol=native#text/pascal
 tests/test/cpu16/i8086/tfarptr2.pp svneol=native#text/pascal
 tests/test/cpu16/i8086/tptrsize.pp svneol=native#text/pascal

+ 91 - 0
tests/test/cpu16/i8086/tfarcal1.pp

@@ -0,0 +1,91 @@
+{ %cpu=i8086 }
+
+{ This test is Turbo Pascal 7 compatible }
+
+{$IFDEF FPC}
+  {$asmmode intel}
+
+  { this test only applies to memory models with far code }
+  {$ifdef FPC_MM_MEDIUM}
+    {$define TEST_ENABLED}
+  {$endif}
+  {$ifdef FPC_MM_LARGE}
+    {$define TEST_ENABLED}
+  {$endif}
+  {$ifdef FPC_MM_HUGE}
+    {$define TEST_ENABLED}
+  {$endif}
+{$ELSE FPC}
+  {$define TEST_ENABLED}
+{$ENDIF FPC}
+
+{$IFDEF TP}
+  {$define TEST_ENABLED}
+{$ENDIF TP}
+
+{$IFDEF TEST_ENABLED}
+program tfarcal1;
+
+{$F+}
+
+var
+  SavedSP: Word;
+  Bug: Boolean;
+
+procedure CheckBug;
+begin
+  if Bug then
+  begin
+    Writeln('FAIL!!!');
+    halt(1);
+  end
+  else
+    Writeln('OK');
+end;
+
+procedure farretproc; assembler;
+asm
+  { hardcode it with db, because the compiler could generate a near ret, due
+    to some bug }
+  db $CB  { RETF }
+end;
+
+procedure testfarcall;
+label
+  NoBug;
+begin
+  Write('Testing call farretproc...');
+  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 farretproc
+
+    xor ax, ax
+    cmp SavedSP, sp
+    je NoBug
+    mov sp, SavedSP  { restore the broken SP }
+    inc ax
+NoBug:
+    mov Bug, al
+    pop bx  { pop the saved CS }
+    sti
+  end;
+  CheckBug;
+end;
+
+begin
+  testfarcall;
+end
+{$ELSE TEST_ENABLED}
+program tfarcal1;
+begin
+end
+{$ENDIF TEST_ENABLED}
+.