فهرست منبع

+ $maxfpuregisters 0 for i386 in systemh (to avoid requiring too much
empty FPU registers for sysstem routines
* fixed bug in str_real when using :x:0
* str_real now doesn't call exp() anymore at runtime, so it should
require less free FPU registers now (and be slightly faster)

Jonas Maebe 25 سال پیش
والد
کامیت
d9c608a373
2فایلهای تغییر یافته به همراه46 افزوده شده و 21 حذف شده
  1. 31 18
      rtl/inc/real2str.inc
  2. 15 3
      rtl/inc/systemh.inc

+ 31 - 18
rtl/inc/real2str.inc

@@ -62,7 +62,7 @@ type
 var
 var
   roundCorr, corrVal: valReal;
   roundCorr, corrVal: valReal;
   intPart, spos, endpos, fracCount: longint;
   intPart, spos, endpos, fracCount: longint;
-  correct, currprec, maxPrec: longint;
+  correct, currprec: longint;
   temp : string;
   temp : string;
   power : string[10];
   power : string[10];
   sign : boolean;
   sign : boolean;
@@ -85,7 +85,6 @@ var
     until carry = 0;
     until carry = 0;
   end;
   end;
 
 
-
   procedure getIntPart(d: extended);
   procedure getIntPart(d: extended);
   var
   var
     intPartStack: TIntPartStack;
     intPartStack: TIntPartStack;
@@ -164,6 +163,8 @@ begin
          maxlen:=16;
          maxlen:=16;
          minlen:=8;
          minlen:=8;
          explen:=4;
          explen:=4;
+         { correction used with comparing to avoid rounding/precision errors }
+         roundCorr := (1/exp((16-4-3)*ln(10)));
       end;
       end;
     rt_s64real :
     rt_s64real :
       begin
       begin
@@ -172,9 +173,13 @@ begin
 { 0.99999999999e-400 (JM)                                              }
 { 0.99999999999e-400 (JM)                                              }
 {$ifdef support_extended}
 {$ifdef support_extended}
          maxlen:=23;
          maxlen:=23;
+         { correction used with comparing to avoid rounding/precision errors }
+         roundCorr := (1/exp((23-5-3)*ln(10)));
 {$else support_extended}
 {$else support_extended}
 {$ifdef support_double}
 {$ifdef support_double}
          maxlen := 22;
          maxlen := 22;
+         { correction used with comparing to avoid rounding/precision errors }
+         roundCorr := (1/exp((22-4-3)*ln(10)));
 {$endif support_double}
 {$endif support_double}
 {$endif support_extended}
 {$endif support_extended}
          minlen:=9;
          minlen:=9;
@@ -185,6 +190,8 @@ begin
          maxlen:=26;
          maxlen:=26;
          minlen:=10;
          minlen:=10;
          explen:=6;
          explen:=6;
+         { correction used with comparing to avoid rounding/precision errors }
+         roundCorr := (1/exp((26-6-3)*ln(10)));
       end;
       end;
     rt_c64bit  :
     rt_c64bit  :
       begin
       begin
@@ -192,18 +199,24 @@ begin
          minlen:=9;
          minlen:=9;
          { according to TP (was 5) (FK) }
          { according to TP (was 5) (FK) }
          explen:=6;
          explen:=6;
+         { correction used with comparing to avoid rounding/precision errors }
+         roundCorr := (1/exp((22-6-3)*ln(10)));
       end;
       end;
     rt_f16bit  :
     rt_f16bit  :
       begin
       begin
          maxlen:=16;
          maxlen:=16;
          minlen:=8;
          minlen:=8;
          explen:=4;
          explen:=4;
+         { correction used with comparing to avoid rounding/precision errors }
+         roundCorr := (1/exp((16-4-3)*ln(10)));
       end;
       end;
     rt_f32bit  :
     rt_f32bit  :
       begin
       begin
          maxlen:=16;
          maxlen:=16;
          minlen:=8;
          minlen:=8;
          explen:=4;
          explen:=4;
+         { correction used with comparing to avoid rounding/precision errors }
+         roundCorr := (1/exp((16-4-3)*ln(10)));
       end;
       end;
     end;
     end;
   { check parameters }
   { check parameters }
@@ -253,7 +266,6 @@ begin
         d:=-d;
         d:=-d;
       { determine precision : maximal precision is : }
       { determine precision : maximal precision is : }
       currPrec := maxlen-explen-2;
       currPrec := maxlen-explen-2;
-      maxPrec := currPrec;
       { this is also the maximal number of decimals !!}
       { this is also the maximal number of decimals !!}
       if f>currprec then
       if f>currprec then
         f:=currprec;
         f:=currprec;
@@ -270,8 +282,6 @@ begin
       { leading zero, may be necessary for things like str(9.999:0:2) to }
       { leading zero, may be necessary for things like str(9.999:0:2) to }
       { be able to insert an extra character at the start of the string  }
       { be able to insert an extra character at the start of the string  }
       temp := ' 0';
       temp := ' 0';
-      { correction used with comparing to avoid rounding/precision errors }
-      roundCorr := (1/exp(maxPrec*ln(10)));
       { position in the temporary output string }
       { position in the temporary output string }
       spos := 2;
       spos := 2;
       { get the integer part }
       { get the integer part }
@@ -306,19 +316,15 @@ begin
       { always calculate at least 1 fractional digit for rounding }
       { always calculate at least 1 fractional digit for rounding }
       if (currPrec >= 0) then
       if (currPrec >= 0) then
         begin
         begin
-          if (currPrec > 0) then
-            { round }
+          corrVal := 0.5;
+          for fracCount := 1 to currPrec do
+            corrVal := corrVal / 10.0;
+          if d >= corrVal then
+            d := d + corrVal;
+          if int(d) = 1 then
             begin
             begin
-              corrVal := 0.5;
-              for fracCount := 1 to currPrec do
-                corrVal := corrVal / 10.0;
-              if d > corrVal then
-                d := d + corrVal;
-              if int(d) = 1 then
-                begin
-                  roundStr(temp,spos);
-                  d := frac(d);
-                end;
+              roundStr(temp,spos);
+              d := frac(d);
             end;
             end;
           { calculate the necessary fractional digits }
           { calculate the necessary fractional digits }
           for fracCount := 1 to currPrec do
           for fracCount := 1 to currPrec do
@@ -393,7 +399,14 @@ end;
 
 
 {
 {
   $Log$
   $Log$
-  Revision 1.29  2000-03-21 12:00:30  jonas
+  Revision 1.30  2000-03-26 11:36:28  jonas
+    + $maxfpuregisters 0 for i386 in systemh (to avoid requiring too much
+      empty FPU registers for sysstem routines
+    * fixed bug in str_real when using :x:0
+    * str_real now doesn't call exp() anymore at runtime, so it should
+      require less free FPU registers now (and be slightly faster)
+
+  Revision 1.29  2000/03/21 12:00:30  jonas
     * fixed more bugs due to inexact nature of FPU
     * fixed more bugs due to inexact nature of FPU
 
 
   Revision 1.28  2000/03/17 20:20:33  jonas
   Revision 1.28  2000/03/17 20:20:33  jonas

+ 15 - 3
rtl/inc/systemh.inc

@@ -27,6 +27,11 @@
 {$I-,Q-,H-,R-,V-}
 {$I-,Q-,H-,R-,V-}
 {$mode objfpc}
 {$mode objfpc}
 
 
+{ don't use FPU registervariables on the i386 }
+{$ifdef i386}
+  {$maxfpuregisters 0}
+{$endif i386}
+
 { needed for insert,delete,readln }
 { needed for insert,delete,readln }
 {$P+}
 {$P+}
 
 
@@ -79,11 +84,11 @@ Type
 { Zero - terminated strings }
 { Zero - terminated strings }
   PChar       = ^Char;
   PChar       = ^Char;
   PPChar      = ^PChar;
   PPChar      = ^PChar;
-{ Delphi types }  
+{ Delphi types }
   TAnsiChar   = Char;
   TAnsiChar   = Char;
   AnsiChar    = TAnsiChar;
   AnsiChar    = TAnsiChar;
   PAnsiChar   = PChar;
   PAnsiChar   = PChar;
-  
+
 {$ifdef HASWIDECHAR}
 {$ifdef HASWIDECHAR}
   PWideChar   = ^WideChar;
   PWideChar   = ^WideChar;
 {$endif HASWIDECHAR}
 {$endif HASWIDECHAR}
@@ -433,7 +438,14 @@ const
 
 
 {
 {
   $Log$
   $Log$
-  Revision 1.79  2000-03-14 10:20:18  michael
+  Revision 1.80  2000-03-26 11:36:28  jonas
+    + $maxfpuregisters 0 for i386 in systemh (to avoid requiring too much
+      empty FPU registers for sysstem routines
+    * fixed bug in str_real when using :x:0
+    * str_real now doesn't call exp() anymore at runtime, so it should
+      require less free FPU registers now (and be slightly faster)
+
+  Revision 1.79  2000/03/14 10:20:18  michael
   + Added constants and types for Delphi compatibility
   + Added constants and types for Delphi compatibility
 
 
   Revision 1.78  2000/02/09 16:59:31  peter
   Revision 1.78  2000/02/09 16:59:31  peter