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
|
{ %CPU=i386 }
{ this contains currently only a basic test of mmx support }
{ the following instructions are tested:
PSUBW
PSUBUSW
PADDW
PADDUSW
}
uses
mmx;
procedure do_error(l : longint);
begin
writeln('Error near number ',l);
halt(1);
end;
function equal(const v1,v2 : tmmxword) : boolean;
var
i : integer;
begin
equal:=false;
for i:=0 to 3 do
if v1[i]<>v2[i] then
exit;
equal:=true;
end;
procedure testmmxword;
var t1,t5 : tmmxword;
const
c0 : tmmxword = (0,0,0,0);
c1 : tmmxword = (1,1,1,1);
c2 : tmmxword = (1234,4321,1111,33333);
c3 : tmmxword = (1234,4321,2222,11111);
c4 : tmmxword = (2468,8642,3333,44444);
c5 : tmmxword = ($ffff,$ffff,$ffff,$ffff);
begin
{$mmx+}
{ Intel: paddw }
t1:=c2+c3;
if not(equal(t1,c4)) then
do_error(1000);
{ Intel: psubw }
t5:=t1-c2;
if not(equal(t5,c3)) then
do_error(1001);
t1:=not(c0);
{ does a not }
if not(equal(t1,c5)) then
do_error(1002);
{ test the saturation }
{$saturation+}
t1:=c5+c2+c3;
if not(equal(t1,c5)) then
do_error(1003);
t1:=c4-c5-t1;
if not(equal(t1,c0)) then
do_error(1004);
{$saturation-}
end;
begin
if not(is_mmx_cpu) then
begin
writeln('!!!! Warning: You need a mmx capable CPU to run this test !!!!');
halt(0);
end;
writeln('Testing basic tmmxword support');
testmmxword;
writeln('Test succesful');
writeln;
end.
|
