Browse Source

* str and val for extended use now int constants to minimize
rounding error

florian 26 years ago
parent
commit
d10d8cb5fd
2 changed files with 33 additions and 18 deletions
  1. 20 12
      rtl/inc/real2str.inc
  2. 13 6
      rtl/inc/sstrings.inc

+ 20 - 12
rtl/inc/real2str.inc

@@ -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
-    while d>=10.0 do
+  if d>=i10 then
+    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

+ 13 - 6
rtl/inc/sstrings.inc

@@ -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