paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-13 10:49:17 +02:00
Code Issues Packages Projects Releases Wiki Activity

* some bugs removed

Browse Source
This commit is contained in:
florian 1999-05-25 20:36:41 +00:00
parent 8d99f7a098
commit 7e183613ef
1 changed files with 32 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

45
rtl/inc/int64.inc
View File

@ -62,6 +62,7 @@
shift,lzz,lzn : longint; shift,lzz,lzn : longint;
begin begin
{!!!!!!!!
divqword:=0; divqword:=0;
lzz:=count_leading_zeros(z); lzz:=count_leading_zeros(z);
lzn:=count_leading_zeros(n); lzn:=count_leading_zeros(n);
@ -81,6 +82,7 @@
dec(shift); dec(shift);
n:=n shr 1; n:=n shr 1;
until shift<=0; until shift<=0;
}
end; end;
function modqword(z,n : qword) : qword;[public,alias: 'FPC_MOD_QWORD']; function modqword(z,n : qword) : qword;[public,alias: 'FPC_MOD_QWORD'];
@ -131,40 +133,52 @@
q2:=n; q2:=n;
{ the div is coded by the compiler as call to divqword } { the div is coded by the compiler as call to divqword }
{!!!!!!!
if sign then if sign then
divint64:=-q1 div q2 divint64:=-q1 div q2
else else
divint64:=q1 div q2; divint64:=q1 div q2;
}
end; end;
{ multiplies two qwords } { multiplies two qwords }
function mulqword(f1,f2 : qword;checkoverflow : boolean) : qword;[public,alias: 'FPC_MUL_QWORD']; function mulqword(f1,f2 : qword;checkoverflow : boolean) : qword;[public,alias: 'FPC_MUL_QWORD'];
var var
bitpos64 : qword; zero,bitpos64,bitpos : qword;
l : longint; l : longint;
begin begin
mulqword:=0;
{ we can't write currently qword constants directly :( } { we can't write currently qword constants directly :( }
zero:=zero xor zero;
mulqword:=zero;
tqwordrec(bitpos64).high:=$80000000; tqwordrec(bitpos64).high:=$80000000;
tqwordrec(bitpos64).low:=0; tqwordrec(bitpos64).low:=0;
tqwordrec(bitpos).high:=0;
tqwordrec(bitpos).low:=1;
for l:=0 to 63 do for l:=0 to 63 do
begin begin
if (f2 and bitpos64)<>0 then { if the highest bit of f1 is set and it isn't the
if checkoverflow then last run, then an overflow occcurs!
{$Q+} }
mulqword:=mulqword+f1 if checkoverflow and (l<>63) and
{$Q-} ((tqwordrec(f1).high and $80000000)<>0) then
else
mulqword:=mulqword+f1;
if ((f1 and bitpos64)<>0) and checkoverflow then
int_overflow; int_overflow;
if (f2 and bitpos)<>zero then
begin
if checkoverflow then
{$Q+}
mulqword:=mulqword+f1
{$Q-}
else
mulqword:=mulqword+f1;
end;
f1:=f1 shl 1; f1:=f1 shl 1;
bitpos64:=bitpos64 shl 1; bitpos:=bitpos shl 1;
end; end;
end; end;
@ -216,12 +230,14 @@
hs : string; hs : string;
begin begin
{!!!!!!!!!!!
hs:=''; hs:='';
repeat repeat
hs:=chr(longint(value mod 10)+48)+hs; hs:=chr(longint(value mod 10)+48)+hs;
value:=value div 10; value:=value div 10;
until value=0; until value=0;
s:=hs; s:=hs;
}
end; end;
procedure int_str(value : int64;var s : string); procedure int_str(value : int64;var s : string);
@ -243,7 +259,10 @@
{ {
$Log$ $Log$
Revision 1.4 1999-05-24 08:43:46 florian Revision 1.5 1999-05-25 20:36:41 florian
* some bugs removed
Revision 1.4 1999/05/24 08:43:46 florian
* fixed a couple of syntax errors * fixed a couple of syntax errors
Revision 1.3 1999/05/23 20:27:27 florian Revision 1.3 1999/05/23 20:27:27 florian