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

* better precisio by dividing only once with a calculated longint

Browse Source 
instead of multiple times by 10
This commit is contained in:
peter 1999-11-02 15:05:53 +00:00
parent be22c241fb
commit 1829357f4e
1 changed files with 24 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
rtl/inc/real2str.inc
View File

@ -20,9 +20,9 @@ type
const const
{ do not use real constants else you get rouding errors } { do not use real constants else you get rouding errors }
i10 = 10; i10 : longint = 10;
i2 = 2; i2 : longint = 2;
i1 = 1; i1 : longint = 1;
Procedure str_real (len,f : longint; d : ValReal; real_type :treal_type; var s : string); Procedure str_real (len,f : longint; d : ValReal; real_type :treal_type; var s : string);
{ {
@ -48,6 +48,7 @@ var correct : longint; { Power correction }
i : integer; i : integer;
dot : byte; dot : byte;
currp : pchar; currp : pchar;
il : longint;
begin begin
case real_type of case real_type of
rt_s32real : rt_s32real :
@ -120,17 +121,24 @@ begin
{ convert to standard form. } { convert to standard form. }
correct:=0; correct:=0;
if d>=i10 then if d>=i10 then
while d>=i10 do
begin begin
d:=d/i10; il:=10;
while (d>il) do
begin
il:=il*10;
inc(correct); inc(correct);
end;
d:=d/il;
end end
else if (d<1) and (d<>0) then else
if (d<1) and (d<>0) then
begin
while d<1 do while d<1 do
begin begin
d:=d*i10; d:=d*i10;
dec(correct); dec(correct);
end; end;
end;
{ RoundOff } { RoundOff }
roundcorr:=extended(i1)/extended(i2); roundcorr:=extended(i1)/extended(i2);
if f<0 then if f<0 then
@ -226,7 +234,11 @@ end;
{ {
$Log$ $Log$
Revision 1.14 1999-08-03 21:58:44 peter Revision 1.15 1999-11-02 15:05:53 peter
* better precisio by dividing only once with a calculated longint
instead of multiple times by 10
Revision 1.14 1999/08/03 21:58:44 peter
* small speed improvements * small speed improvements
Revision 1.13 1999/05/06 09:05:12 peter Revision 1.13 1999/05/06 09:05:12 peter