mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-13 23:42:34 +02:00
* str and val for extended use now int constants to minimize
rounding error
This commit is contained in:
parent
f198ef8a45
commit
d10d8cb5fd
@ -27,7 +27,11 @@ type
|
|||||||
{$else i386}
|
{$else i386}
|
||||||
bestreal = single;
|
bestreal = single;
|
||||||
{$endif i386}
|
{$endif i386}
|
||||||
|
const
|
||||||
|
{ do not use real constants else you get rouding errors }
|
||||||
|
i10 = 10;
|
||||||
|
i2 = 2;
|
||||||
|
i1 = 1;
|
||||||
Procedure str_real (len,f : longint; d : bestreal; real_type :treal_type; var s : string);
|
Procedure str_real (len,f : longint; d : bestreal; real_type :treal_type; var s : string);
|
||||||
{
|
{
|
||||||
These numbers are for the double type...
|
These numbers are for the double type...
|
||||||
@ -113,40 +117,40 @@ begin
|
|||||||
end;
|
end;
|
||||||
{ convert to standard form. }
|
{ convert to standard form. }
|
||||||
correct:=0;
|
correct:=0;
|
||||||
if d>=10.0 then
|
if d>=i10 then
|
||||||
while d>=10.0 do
|
while d>=i10 do
|
||||||
begin
|
begin
|
||||||
d:=d/10.0;
|
d:=d/i10;
|
||||||
inc(correct);
|
inc(correct);
|
||||||
end
|
end
|
||||||
else if (d<1) and (d<>0) then
|
else if (d<1) and (d<>0) then
|
||||||
while d<1 do
|
while d<1 do
|
||||||
begin
|
begin
|
||||||
d:=d*10.0;
|
d:=d*i10;
|
||||||
dec(correct);
|
dec(correct);
|
||||||
end;
|
end;
|
||||||
{ RoundOff }
|
{ RoundOff }
|
||||||
roundcorr:=0.5;
|
roundcorr:=extended(i1)/extended(i2);
|
||||||
if f<0 then
|
if f<0 then
|
||||||
for i:=1 to currprec do roundcorr:=roundcorr/10
|
for i:=1 to currprec do roundcorr:=roundcorr/i10
|
||||||
else
|
else
|
||||||
begin
|
begin
|
||||||
if correct+f<0 then
|
if correct+f<0 then
|
||||||
begin
|
begin
|
||||||
for i:=1 to abs(correct+f) do
|
for i:=1 to abs(correct+f) do
|
||||||
roundcorr:=roundcorr*10;
|
roundcorr:=roundcorr*i10;
|
||||||
end
|
end
|
||||||
else
|
else
|
||||||
begin
|
begin
|
||||||
for i:=1 to correct+f do
|
for i:=1 to correct+f do
|
||||||
roundcorr:=roundcorr/10;
|
roundcorr:=roundcorr/i10;
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
d:=d+roundcorr;
|
d:=d+roundcorr;
|
||||||
{ 0.99 + 0.05 > 1.0 ! Fix this by dividing the results >=10 first (PV) }
|
{ 0.99 + 0.05 > 1.0 ! Fix this by dividing the results >=10 first (PV) }
|
||||||
while (d>=10.0) do
|
while (d>=10.0) do
|
||||||
begin
|
begin
|
||||||
d:=d/10.0;
|
d:=d/i10;
|
||||||
inc(correct);
|
inc(correct);
|
||||||
end;
|
end;
|
||||||
{ Now we have a standard expression : sign d *10^correct
|
{ Now we have a standard expression : sign d *10^correct
|
||||||
@ -161,7 +165,7 @@ begin
|
|||||||
{ Start making the string }
|
{ Start making the string }
|
||||||
for i:=1 to currprec do
|
for i:=1 to currprec do
|
||||||
begin
|
begin
|
||||||
d:=d*10.0;
|
d:=d*i10;
|
||||||
temp:=temp+chr(ord('0')+trunc(d));
|
temp:=temp+chr(ord('0')+trunc(d));
|
||||||
d:=d-int(d);
|
d:=d-int(d);
|
||||||
end;
|
end;
|
||||||
@ -212,7 +216,11 @@ end;
|
|||||||
|
|
||||||
{
|
{
|
||||||
$Log$
|
$Log$
|
||||||
Revision 1.11 1999-02-16 00:49:20 peter
|
Revision 1.12 1999-03-10 21:49:02 florian
|
||||||
|
* str and val for extended use now int constants to minimize
|
||||||
|
rounding error
|
||||||
|
|
||||||
|
Revision 1.11 1999/02/16 00:49:20 peter
|
||||||
* fixed rounding when correct+f < 0
|
* fixed rounding when correct+f < 0
|
||||||
|
|
||||||
Revision 1.10 1998/08/11 21:39:06 peter
|
Revision 1.10 1998/08/11 21:39:06 peter
|
||||||
|
@ -640,6 +640,9 @@ var
|
|||||||
esign,sign : valreal;
|
esign,sign : valreal;
|
||||||
exponent,i : longint;
|
exponent,i : longint;
|
||||||
flags : byte;
|
flags : byte;
|
||||||
|
const
|
||||||
|
i10 = 10;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
d:=0;
|
d:=0;
|
||||||
code:=1;
|
code:=1;
|
||||||
@ -660,14 +663,14 @@ begin
|
|||||||
begin
|
begin
|
||||||
{ Read integer part }
|
{ Read integer part }
|
||||||
flags:=flags or 1;
|
flags:=flags or 1;
|
||||||
d:=d*10;
|
d:=d*i10;
|
||||||
d:=d+(ord(s[code])-ord('0'));
|
d:=d+(ord(s[code])-ord('0'));
|
||||||
inc(code);
|
inc(code);
|
||||||
end;
|
end;
|
||||||
{ Decimal ? }
|
{ Decimal ? }
|
||||||
if (s[code]='.') and (length(s)>=code) then
|
if (s[code]='.') and (length(s)>=code) then
|
||||||
begin
|
begin
|
||||||
hd:=0.1;
|
hd:=extended(i1)/extended(i10);
|
||||||
inc(code);
|
inc(code);
|
||||||
{ After dot, a number is required. }
|
{ After dot, a number is required. }
|
||||||
if not(s[code] in ['0'..'9']) or (length(s)<code) then
|
if not(s[code] in ['0'..'9']) or (length(s)<code) then
|
||||||
@ -709,7 +712,7 @@ begin
|
|||||||
end;
|
end;
|
||||||
while (s[code] in ['0'..'9']) and (length(s)>=code) do
|
while (s[code] in ['0'..'9']) and (length(s)>=code) do
|
||||||
begin
|
begin
|
||||||
exponent:=exponent*10;
|
exponent:=exponent*i10;
|
||||||
exponent:=exponent+ord(s[code])-ord('0');
|
exponent:=exponent+ord(s[code])-ord('0');
|
||||||
inc(code);
|
inc(code);
|
||||||
end;
|
end;
|
||||||
@ -717,10 +720,10 @@ begin
|
|||||||
{ Calculate Exponent }
|
{ Calculate Exponent }
|
||||||
if esign>0 then
|
if esign>0 then
|
||||||
for i:=1 to exponent do
|
for i:=1 to exponent do
|
||||||
d:=d*10
|
d:=d*i10
|
||||||
else
|
else
|
||||||
for i:=1 to exponent do
|
for i:=1 to exponent do
|
||||||
d:=d/10;
|
d:=d/i10;
|
||||||
{ Not all characters are read ? }
|
{ Not all characters are read ? }
|
||||||
if length(s)>=code then
|
if length(s)>=code then
|
||||||
begin
|
begin
|
||||||
@ -977,7 +980,11 @@ end;
|
|||||||
|
|
||||||
{
|
{
|
||||||
$Log$
|
$Log$
|
||||||
Revision 1.20 1999-03-03 15:23:57 michael
|
Revision 1.21 1999-03-10 21:49:03 florian
|
||||||
|
* str and val for extended use now int constants to minimize
|
||||||
|
rounding error
|
||||||
|
|
||||||
|
Revision 1.20 1999/03/03 15:23:57 michael
|
||||||
+ Added setstring for Delphi compatibility
|
+ Added setstring for Delphi compatibility
|
||||||
|
|
||||||
Revision 1.19 1999/01/25 20:24:28 peter
|
Revision 1.19 1999/01/25 20:24:28 peter
|
||||||
|
Loading…
Reference in New Issue
Block a user