* patch by Max Nazhalov to improve real2str performance, resolves #21825

git-svn-id: trunk@21236 -

.gitattributes

@@ -11334,6 +11334,7 @@ tests/test/units/system/testmac.txt svneol=native#text/plain
 tests/test/units/system/testpc.txt svneol=native#text/plain
 tests/test/units/system/teststk.pp svneol=native#text/plain
 tests/test/units/system/testux.txt svneol=native#text/plain
+tests/test/units/system/tgenstr.pp svneol=native#text/pascal
 tests/test/units/system/tincdec.pp svneol=native#text/plain
 tests/test/units/system/tint.pp svneol=native#text/plain
 tests/test/units/system/tintstr.pp svneol=native#text/plain
@@ -11370,6 +11371,7 @@ tests/test/units/system/tsetstr.pp svneol=native#text/plain
 tests/test/units/system/tsetstr2.pp svneol=native#text/plain
 tests/test/units/system/tslice1.pp svneol=native#text/plain
 tests/test/units/system/tslice2.pp svneol=native#text/plain
+tests/test/units/system/tstr1.pp svneol=native#text/pascal
 tests/test/units/system/tstring.pp svneol=native#text/plain
 tests/test/units/system/ttrig.pas svneol=native#text/plain
 tests/test/units/system/ttrunc.pp svneol=native#text/plain

rtl/inc/real2str.inc

@@ -20,6 +20,10 @@ type
   );
   { corresponding to single   double   extended   fixed      comp for i386 }
 
+{$if not declared(mul_by_power10)}
+  function mul_by_power10 (x : ValReal; power : integer) : ValReal; forward;
+{$endif}
+
 Procedure str_real (len,f : longint; d : ValReal; real_type :treal_type; out s : string);
 {$ifdef SUPPORT_EXTENDED}
 type
@@ -68,6 +72,7 @@ var
   doublebits: int64;
 {$endif}
   roundCorr, corrVal, factor : valReal;
+  high_exp10_reduced,
   spos, endpos, fracCount: longint;
   correct, currprec: longint;
   temp : string;
@@ -186,6 +191,33 @@ const
 {$endif DEBUG_NASM}
   end;
 
+  function reduce_exponent (d : ValReal; out scaled : ValReal) : longint;
+  { Returns decimal exponent which was used for scaling, and a scaled value out }
+  const
+    C_LN10 = ln(10);
+  var
+    log10_d : longint;
+  begin
+    reduce_exponent := 0;
+    if d<>0 then
+      begin
+       // get exponent approximation ["d" is assumed to be non-negative]
+        log10_d:=trunc(ln(d)/C_LN10);
+       // trying to stay at least 1 digit away from introducing integer/fractional part
+        if log10_d > maxDigits+1 then
+          reduce_exponent := log10_d-maxDigits
+        else
+          if log10_d < -(maxDigits+1) then
+            reduce_exponent := log10_d+maxDigits
+       // else
+       //   the number is already suitable enough
+      end;
+    // do scaling if needed
+    if reduce_exponent<>0
+      then scaled := mul_by_power10(d,-reduce_exponent) // denormals should be handled properly by this call
+      else scaled := d;
+  end;
+
 begin
   case real_type of
     rt_s32real :
@@ -351,9 +383,31 @@ begin
       temp := ' 0';
       { position in the temporary output string }
       spos := 2;
+
+      // workaround to make follow-up things go somewhat faster
+      high_exp10_reduced := 0;
+      case real_type of
+      // blacklist, in order of increasing headache:
+//?     rt_s32real :;   
+          // ? needs additional testing to ensure any reasonable benefit
+          //   without lost of accuracy due to an extra conversion
+        rt_c64bit, rt_currency :;
+          // no much sense to touch them
+      else
+      // acceptable:
+      // ? rt_s32real [see above]
+      //   rt_s64real
+      //   rt_s80real, rt_sc80real
+      // ? rt_s128real [have not tried]
+        high_exp10_reduced := reduce_exponent(d,d);
+      end;
+  
       { get the integer part }
       correct := 0;
       GetIntPart(d);
+
+      inc(correct,high_exp10_reduced); // end of workaround
+
       { now process the fractional part }
       if d > 1.0- roundCorr then
         d := frac(d);

tests/test/units/system/tgenstr.pp

@@ -0,0 +1,36 @@
+{ %norun }
+uses
+  math;
+var
+  drec : record
+    d1,d2 : dword;
+  end;
+  i,j : longint;
+  s : string;
+  d : double absolute drec;
+begin
+  randomize;
+  SetExceptionMask([exInvalidOp,exDenormalized,exZeroDivide,exOverflow,exUnderflow,exPrecision]);
+  writeln('{ Generated by FPC ',{$I %FPCVERSION%},' using tgenstr.pp }');
+  writeln('uses math; procedure c(d : double;const s : string);');
+  writeln('var hs : string;begin str(d,hs); if hs<>s then begin writeln(d,'' '',hs); halt(1); end; end;');
+  for j:=1 to 1 do
+    begin
+      writeln('procedure p',j,'; begin');
+      for i:=1 to 5000 do
+        begin
+          drec.d1:=random(4294967296);
+          drec.d2:=random(4294967296);
+          str(d,s);
+          writeln('c(',d,',''',s,''');');
+        end;
+      writeln('end;');
+      writeln;
+    end;
+  writeln('begin');
+  writeln('SetExceptionMask([exInvalidOp,exDenormalized,exZeroDivide,exOverflow,exUnderflow,exPrecision]);');
+  for j:=1 to 1 do
+    writeln('p',j,';');
+  writeln('writeln(''ok'');');
+  writeln('end.');
+end.