blob: e0a48720fc58ef572ad54f998bf4e1d1c8853469 (
plain)
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
|
{$q+}
{$mode objfpc}
uses
sysutils;
type
tqwordrec = packed record
{$ifndef ENDIAN_BIG}
low,high : dword;
{$else}
high, low : dword;
{$endif}
end;
procedure assignqword(h,l : dword;var q : qword);
begin
tqwordrec(q).high:=h;
tqwordrec(q).low:=l;
end;
procedure testmulqword;
var
q1, q2, q3, q4: qword;
c: cardinal;
loops: longint;
begin
assignqword(0,$1000,q1);
assignqword(0,$7fff,q2);
c := $1000 * $7fff;
q4 := c;
loops := 0;
try
repeat
q3 := q1 * q2;
if q3 <> q4 then
begin
writeln('qword multiplication of shift error');
halt(1);
end;
inc(loops);
if (loops >= 39) then
begin
writeln('qword multiplication overflow detection failed');
halt(1);
end;
q1 := q1 shl 1;
q4 := q4 shl 1;
writeln(loops,': ',q3);
until false;
except
on eintoverflow do
begin
if loops < 38 then
begin
writeln('false qword multiplication overflow detected');
halt(1);
end;
end;
end;
end;
begin
testmulqword;
end.
|
