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

+ added test for the i8086 compact model memory layout

Browse Source 
git-svn-id: trunk@28050 -
This commit is contained in:
nickysn 2014-06-24 19:48:37 +00:00
parent da4fc8aca2
commit 3952f8830c
2 changed files with 64 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -10855,6 +10855,7 @@ tests/test/cpu16/i8086/tfarptr3.pp svneol=native#text/pascal
tests/test/cpu16/i8086/tfarptr4.pp svneol=native#text/pascal
tests/test/cpu16/i8086/tintr1.pp svneol=native#text/pascal
tests/test/cpu16/i8086/tintr2.pp svneol=native#text/pascal
tests/test/cpu16/i8086/tmmc.pp svneol=native#text/pascal
tests/test/cpu16/i8086/tmml.pp svneol=native#text/pascal
tests/test/cpu16/i8086/tptrsize.pp svneol=native#text/pascal
tests/test/cpu16/taddint1.pp svneol=native#text/pascal

63
tests/test/cpu16/i8086/tmmc.pp Normal file
View File

@ -0,0 +1,63 @@
{ %cpu=i8086 }
{ Memory layout test for the compact memory model.
Note that this test is NOT compatible with Turbo Pascal 3, despite the fact
that TP3 uses the compact memory model. The difference is that TP3 puts the
heap before the stack (i.e. at lower addresses than the stack). FPC for i8086
in the compact memory model follows TP7's large memory model data layout,
which means stack goes before the heap. In practice, this shouldn't matter for
most programs. }
{$IFNDEF FPC_MM_COMPACT}
{$DEFINE SKIP_TEST}
{$ENDIF not FPC_MM_COMPACT}
{$IFDEF SKIP_TEST}
program tmml;
begin
Writeln('Test compiled for the wrong memory model. Goodbye!');
end
{$ELSE SKIP_TEST}
program tmml;
var
CS, DS, SS, HS: Word;
HeapP: Pointer;
ErrorsFound: Boolean;
procedure Error(const S: string);
begin
Writeln('Error! ', S);
ErrorsFound := True;
end;
begin
ErrorsFound := False;
GetMem(HeapP, 5);
CS := CSeg;
DS := DSeg;
SS := SSeg;
HS := Seg(HeapP^);
Writeln('CS=', CS);
Writeln('DS=', DS);
Writeln('SS=', SS);
Writeln('Heap Seg=', HS);
if not (CS < DS) then
Error('CS >= DS');
if not (DS < SS) then
Error('DS >= SS');
if not (SS < HS) then
Error('SS >= HeapSeg');
FreeMem(HeapP, 5);
if ErrorsFound then
begin
Writeln('Errors found!');
Halt(1);
end
else
Writeln('Ok!');
end
{$ENDIF SKIP_TEST}
.