paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-13 11:19:58 +02:00
Code Issues Packages Projects Releases Wiki Activity

* fixed a couple of syntax errors

Browse Source
This commit is contained in:
florian 1999-05-24 08:43:46 +00:00
parent d2b5850095
commit 15c8428f64
1 changed files with 38 additions and 33 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

71
rtl/inc/int64.inc
View File

@ -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; q2:=n;
{ is coded by the compiler as call to divqword }
q3:=q1 div q2;
{ 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; mulqword:=0;
bitpos:=1;
{ 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
} }