1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
|
{ %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;
HeapOrgSeg, HeapOrgOfs, HeapEndSeg, HeapEndOfs: Word;
ErrorsFound: Boolean;
procedure Error(const S: string);
begin
Writeln('Error! ', S);
ErrorsFound := True;
end;
var
ProcVar: Procedure;
begin
ErrorsFound := False;
Writeln('SizeOf(Pointer)=', SizeOf(Pointer));
if SizeOf(Pointer) <> 4 then
Error('SizeOf(Pointer) <> 4');
Writeln('SizeOf(ProcVar)=', SizeOf(ProcVar));
if SizeOf(ProcVar) <> 2 then
Error('SizeOf(ProcVar) <> 2');
GetMem(HeapP, 5);
CS := CSeg;
DS := DSeg;
SS := SSeg;
HS := Seg(HeapP^);
HeapOrgSeg := Seg(HeapOrg^);
HeapOrgOfs := Ofs(HeapOrg^);
HeapEndSeg := Seg(HeapEnd^);
HeapEndOfs := Ofs(HeapEnd^);
Writeln('PrefixSeg=', PrefixSeg);
Writeln('CS=', CS);
Writeln('DS=', DS);
Writeln('SS=', SS);
Writeln('HeapOrg=', HeapOrgSeg, ':', HeapOrgOfs);
Writeln('HeapEnd=', HeapEndSeg, ':', HeapEndOfs);
Writeln('Heap Seg=', HS);
if not (PrefixSeg < CS) then
Error('PrefixSeg >= CS');
if (CS - PrefixSeg) <> 16 then
Error('(CS - PrefixSeg) <> 16');
if not (CS < DS) then
Error('CS >= DS');
if not (DS < SS) then
Error('DS >= SS');
if not (SS < HS) then
Error('SS >= HeapSeg');
if HeapOrgOfs <> 0 then
Error('HeapOrg offset <> 0');
if HeapEndOfs <> 0 then
Error('HeapEnd offset <> 0');
if (HeapOrgSeg - SS) <> 1024 then
Error('HeapOrgSeg <> SS+1024 (16kb stack)');
if (PrefixSeg + MemW[PrefixSeg-1:3]) <> HeapEndSeg then
Error('HeapEnd segment <> end_of_current_program_MCB');
FreeMem(HeapP, 5);
if ErrorsFound then
begin
Writeln('Errors found!');
Halt(1);
end
else
Writeln('Ok!');
end
{$ENDIF SKIP_TEST}
.
|
