|
@@ -17,12 +17,18 @@
|
|
{$R- no range checking }
|
|
{$R- no range checking }
|
|
|
|
|
|
type
|
|
type
|
|
- qwordrec = packed record
|
|
|
|
|
|
+ tqwordrec = packed record
|
|
low : dword;
|
|
low : dword;
|
|
high : dword;
|
|
high : dword;
|
|
end;
|
|
end;
|
|
|
|
|
|
- function count_leading_zero(q : qword) : longint;
|
|
|
|
|
|
+ procedure int_overflow;
|
|
|
|
+
|
|
|
|
+ begin
|
|
|
|
+ runerror(201);
|
|
|
|
+ end;
|
|
|
|
+
|
|
|
|
+ function count_leading_zeros(q : qword) : longint;
|
|
|
|
|
|
var
|
|
var
|
|
r,i : longint;
|
|
r,i : longint;
|
|
@@ -31,26 +37,26 @@
|
|
r:=0;
|
|
r:=0;
|
|
for i:=0 to 31 do
|
|
for i:=0 to 31 do
|
|
begin
|
|
begin
|
|
- if (qwordrec(q).high and ($80000000 shr i))<>0 then
|
|
|
|
|
|
+ if (tqwordrec(q).high and ($80000000 shr i))<>0 then
|
|
begin
|
|
begin
|
|
- count_leading_zero:=r;
|
|
|
|
|
|
+ count_leading_zeros:=r;
|
|
exit;
|
|
exit;
|
|
end;
|
|
end;
|
|
inc(r);
|
|
inc(r);
|
|
end;
|
|
end;
|
|
for i:=0 to 31 do
|
|
for i:=0 to 31 do
|
|
begin
|
|
begin
|
|
- if (qwordrec(q).low and ($80000000 shr i))<>0 then
|
|
|
|
|
|
+ if (tqwordrec(q).low and ($80000000 shr i))<>0 then
|
|
begin
|
|
begin
|
|
- count_leading_zero:=r;
|
|
|
|
|
|
+ count_leading_zeros:=r;
|
|
exit;
|
|
exit;
|
|
end;
|
|
end;
|
|
inc(r);
|
|
inc(r);
|
|
end;
|
|
end;
|
|
- count_leading_zero:=r;
|
|
|
|
|
|
+ count_leading_zeros:=r;
|
|
end;
|
|
end;
|
|
|
|
|
|
- function divqword(z,n : qword) : qword;safecall;
|
|
|
|
|
|
+ function divqword(z,n : qword) : qword;[public,alias: 'FPC_DIV_QWORD'];
|
|
|
|
|
|
var
|
|
var
|
|
shift,lzz,lzn : longint;
|
|
shift,lzz,lzn : longint;
|
|
@@ -77,7 +83,7 @@
|
|
until shift<=0;
|
|
until shift<=0;
|
|
end;
|
|
end;
|
|
|
|
|
|
- function modqword(z,n : qword) : qword;safecall;
|
|
|
|
|
|
+ function modqword(z,n : qword) : qword;[public,alias: 'FPC_MOD_QWORD'];
|
|
|
|
|
|
var
|
|
var
|
|
shift,lzz,lzn : longint;
|
|
shift,lzz,lzn : longint;
|
|
@@ -101,11 +107,11 @@
|
|
modqword:=z;
|
|
modqword:=z;
|
|
end;
|
|
end;
|
|
|
|
|
|
- function divint64(z,n : int64) : int64;safecall;
|
|
|
|
|
|
+ function divint64(z,n : int64) : int64;[public,alias: 'FPC_DIV_INT64'];
|
|
|
|
|
|
var
|
|
var
|
|
sign : boolean;
|
|
sign : boolean;
|
|
- q1,q2,q3 : qword;
|
|
|
|
|
|
+ q1,q2 : qword;
|
|
|
|
|
|
begin
|
|
begin
|
|
sign:=false;
|
|
sign:=false;
|
|
@@ -116,52 +122,49 @@
|
|
end
|
|
end
|
|
else
|
|
else
|
|
q1:=z;
|
|
q1:=z;
|
|
- if q<0 then
|
|
|
|
|
|
+ if n<0 then
|
|
begin
|
|
begin
|
|
sign:=not(sign);
|
|
sign:=not(sign);
|
|
- q2:=qword(-q);
|
|
|
|
|
|
+ q2:=qword(-n);
|
|
end
|
|
end
|
|
else
|
|
else
|
|
- q2:=q;
|
|
|
|
-
|
|
|
|
- { is coded by the compiler as call to divqword }
|
|
|
|
- q3:=q1 div q2;
|
|
|
|
|
|
+ q2:=n;
|
|
|
|
|
|
|
|
+ { the div is coded by the compiler as call to divqword }
|
|
if sign then
|
|
if sign then
|
|
- divint64:=-q3
|
|
|
|
|
|
+ divint64:=-q1 div q2
|
|
else
|
|
else
|
|
- divint64:=q3;
|
|
|
|
|
|
+ divint64:=q1 div q2;
|
|
end;
|
|
end;
|
|
|
|
|
|
{ multiplies two qwords }
|
|
{ multiplies two qwords }
|
|
- function mulqword(f1,f2 : qword;checkoverflow : boolean) : qword;safecall;
|
|
|
|
|
|
+ function mulqword(f1,f2 : qword;checkoverflow : boolean) : qword;[public,alias: 'FPC_MUL_QWORD'];
|
|
|
|
|
|
var
|
|
var
|
|
- res,bitpos : qword;
|
|
|
|
|
|
+ bitpos64 : qword;
|
|
l : longint;
|
|
l : longint;
|
|
|
|
|
|
begin
|
|
begin
|
|
- res:=0;
|
|
|
|
- bitpos:=1;
|
|
|
|
-
|
|
|
|
|
|
+ mulqword:=0;
|
|
{ we can't write currently qword constants directly :( }
|
|
{ we can't write currently qword constants directly :( }
|
|
- bitpos64:=1 shl 63;
|
|
|
|
|
|
+ tqwordrec(bitpos64).high:=$80000000;
|
|
|
|
+ tqwordrec(bitpos64).low:=0;
|
|
|
|
|
|
for l:=0 to 63 do
|
|
for l:=0 to 63 do
|
|
begin
|
|
begin
|
|
- if (f2 and bitpos)<>0 then
|
|
|
|
|
|
+ if (f2 and bitpos64)<>0 then
|
|
if checkoverflow then
|
|
if checkoverflow then
|
|
{$Q+}
|
|
{$Q+}
|
|
- res:=res+f1
|
|
|
|
|
|
+ mulqword:=mulqword+f1
|
|
{$Q-}
|
|
{$Q-}
|
|
else
|
|
else
|
|
- res:=res+f1;
|
|
|
|
|
|
+ mulqword:=mulqword+f1;
|
|
|
|
|
|
if ((f1 and bitpos64)<>0) and checkoverflow then
|
|
if ((f1 and bitpos64)<>0) and checkoverflow then
|
|
int_overflow;
|
|
int_overflow;
|
|
|
|
|
|
f1:=f1 shl 1;
|
|
f1:=f1 shl 1;
|
|
- bitpos:=bitpos shl 1;
|
|
|
|
|
|
+ bitpos64:=bitpos64 shl 1;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
@@ -171,7 +174,7 @@
|
|
fpuint64 = true:
|
|
fpuint64 = true:
|
|
... using the comp multiplication
|
|
... using the comp multiplication
|
|
}
|
|
}
|
|
- function mulint64(f1,f2 : int64;checkoverflow : boolean) : int64;safecall;
|
|
|
|
|
|
+ function mulint64(f1,f2 : int64;checkoverflow : boolean) : int64;[public,alias: 'FPC_MUL_INT64'];
|
|
|
|
|
|
var
|
|
var
|
|
sign : boolean;
|
|
sign : boolean;
|
|
@@ -199,7 +202,7 @@
|
|
q3:=q1*q2
|
|
q3:=q1*q2
|
|
else
|
|
else
|
|
{$Q-}
|
|
{$Q-}
|
|
- q3:=q1*q2
|
|
|
|
|
|
+ q3:=q1*q2;
|
|
|
|
|
|
if sign then
|
|
if sign then
|
|
mulint64:=-q3
|
|
mulint64:=-q3
|
|
@@ -240,7 +243,10 @@
|
|
|
|
|
|
{
|
|
{
|
|
$Log$
|
|
$Log$
|
|
- Revision 1.3 1999-05-23 20:27:27 florian
|
|
|
|
|
|
+ Revision 1.4 1999-05-24 08:43:46 florian
|
|
|
|
+ * fixed a couple of syntax errors
|
|
|
|
+
|
|
|
|
+ Revision 1.3 1999/05/23 20:27:27 florian
|
|
+ routines for qword div and mod
|
|
+ routines for qword div and mod
|
|
|
|
|
|
Revision 1.2 1999/01/06 12:25:03 florian
|
|
Revision 1.2 1999/01/06 12:25:03 florian
|
|
@@ -249,5 +255,4 @@
|
|
|
|
|
|
Revision 1.1 1998/12/12 12:15:41 florian
|
|
Revision 1.1 1998/12/12 12:15:41 florian
|
|
+ first implementation
|
|
+ first implementation
|
|
-
|
|
|
|
}
|
|
}
|