paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-12 22:14:25 +02:00
Code Issues Packages Projects Releases Wiki Activity

* multiplication overflow checking fixed

Browse Source
This commit is contained in:
florian 1999-07-02 17:01:29 +00:00
parent fc18497f19
commit 9540e26f9f
1 changed files with 10 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
rtl/inc/int64.inc
View File

@ -154,21 +154,20 @@
function mulqword(f1,f2 : qword;checkoverflow : longbool) : qword;[public,alias: 'FPC_MUL_QWORD']; function mulqword(f1,f2 : qword;checkoverflow : longbool) : qword;[public,alias: 'FPC_MUL_QWORD'];
var var
zero,bitpos64,bitpos : qword; _f1,bitpos : qword;
l : longint; l : longint;
begin begin
zero:=0;
mulqword:=0; mulqword:=0;
{ we can't write currently qword constants directly :( }
tqwordrec(bitpos64).high:=$80000000;
tqwordrec(bitpos64).low:=0;
bitpos:=1; bitpos:=1;
// store f1 for overflow checking
_f1:=f1;
for l:=0 to 63 do for l:=0 to 63 do
begin begin
if (f2 and bitpos)<>zero then if (f2 and bitpos)<>0 then
mulqword:=mulqword+f1; mulqword:=mulqword+f1;
f1:=f1 shl 1; f1:=f1 shl 1;
@ -177,7 +176,7 @@
{ if one of the operands is greater than the result an } { if one of the operands is greater than the result an }
{ overflow occurs } { overflow occurs }
if checkoverflow and ((f1>mulqword) or (f2>mulqword)) then if checkoverflow and ((_f1>mulqword) or (f2>mulqword)) then
HandleErrorFrame(215,get_frame); HandleErrorFrame(215,get_frame);
end; end;
@ -266,7 +265,10 @@
{ {
$Log$ $Log$
Revision 1.10 1999-07-01 15:39:50 florian Revision 1.11 1999-07-02 17:01:29 florian
* multiplication overflow checking fixed
Revision 1.10 1999/07/01 15:39:50 florian
+ qword/int64 type released + qword/int64 type released
Revision 1.9 1999/06/30 22:12:40 florian Revision 1.9 1999/06/30 22:12:40 florian