mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-14 17:29:33 +02:00
* patch by Max Nazhalov to improve performance of string to float conversion for numbers with large exponents, resolves #21183
git-svn-id: trunk@20701 -
This commit is contained in:
florian
parent
fecafd8bb7
commit
a8a8451527
@ -1160,10 +1160,222 @@ const
|
|||||||
{$endif}
|
{$endif}
|
||||||
|
|
||||||
{$ifndef FPUNONE}
|
{$ifndef FPUNONE}
|
||||||
|
|
||||||
|
(******************
|
||||||
|
|
||||||
|
Derived from: ".\Free Pascal\source\rtl\inc\genmath.inc"
|
||||||
|
|
||||||
|
Origin: "fast 10^n routine"
|
||||||
|
function FPower10(val: Extended; Power: Longint): Extended;
|
||||||
|
|
||||||
|
Changes:
|
||||||
|
> adapted to "ValReal", so float can be single/double/extended
|
||||||
|
> slightly changed arrays [redundant 58+2 float constants gone away]
|
||||||
|
> added some checks etc..
|
||||||
|
|
||||||
|
Notes:
|
||||||
|
> denormalization and overflow should go smooth if corresponding
|
||||||
|
FPU exceptions are masked [no external care needed by now]
|
||||||
|
> adaption to real48 and real128 is not hard if one needed
|
||||||
|
|
||||||
|
******************)
|
||||||
|
//
|
||||||
|
function mul_by_power10(x:ValReal;power:integer):ValReal;
|
||||||
|
//
|
||||||
|
// result:=X*(10^power)
|
||||||
|
//
|
||||||
|
// Routine achieves result with no more than 3 floating point mul/div's.
|
||||||
|
// Up to ABS(power)=31, only 1 floating point mul/div is needed.
|
||||||
|
//
|
||||||
|
// Limitations:
|
||||||
|
// for ValReal=extended : power=-5119..+5119
|
||||||
|
// for ValReal=double : power=-319..+319
|
||||||
|
// for ValReal=single : power=-63..+63
|
||||||
|
//
|
||||||
|
// If "power" is beyond this limits, routine gives up and returns 0/+INF/-INF.
|
||||||
|
// This is not generally correct, but should be ok when routine is used only
|
||||||
|
// as "VAL"-helper, since "x" exponent is reasonably close to 0 in this case.
|
||||||
|
//
|
||||||
|
//==================================
|
||||||
|
{$IF DECLARED(C_HIGH_EXPBITS_5TO8)}
|
||||||
|
{$ERROR C_HIGH_EXPBITS_5TO8 declared somewhere in scope}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IF DECLARED(C_HIGH_EXPBITS_9ANDUP)}
|
||||||
|
{$ERROR C_HIGH_EXPBITS_9ANDUP declared somewhere in scope}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IF SIZEOF(ValReal)=10}
|
||||||
|
//==================================
|
||||||
|
// assuming "type ValReal=extended;"
|
||||||
|
//
|
||||||
|
type
|
||||||
|
TValRealRec = packed record
|
||||||
|
case byte of
|
||||||
|
0: (
|
||||||
|
{$ifndef ENDIAN_BIG}
|
||||||
|
mant_lo, mant_hi : longword; expsign : word // little-endian/default
|
||||||
|
{$else}
|
||||||
|
expsign : word; mant_hi, mant_lo : longword // big-endian
|
||||||
|
{$endif}
|
||||||
|
);
|
||||||
|
1: (v : extended);
|
||||||
|
end;
|
||||||
|
|
||||||
|
const
|
||||||
|
{$ifndef ENDIAN_BIG}
|
||||||
|
// little-endian/default
|
||||||
|
C_INFTYP:TValRealRec=(mant_lo:0;mant_hi:$80000000;expsign:$7FFF); //+INF
|
||||||
|
C_INFTYM:TValRealRec=(mant_lo:0;mant_hi:$80000000;expsign:$FFFF); //-INF
|
||||||
|
{$else}
|
||||||
|
// big-endian
|
||||||
|
C_INFTYP:TValRealRec=(expsign:$7FFF;mant_hi:$80000000;mant_lo:0); //+INF
|
||||||
|
C_INFTYM:TValRealRec=(expsign:$FFFF;mant_hi:$80000000;mant_lo:0); //-INF
|
||||||
|
{$endif}
|
||||||
|
|
||||||
|
C_MAX_POWER = 5119;
|
||||||
|
|
||||||
|
C_HIGH_EXPBITS_5TO8 = 15;
|
||||||
|
C_HIGH_EXPBITS_9ANDUP = 9;
|
||||||
|
|
||||||
|
{$ELSEIF SIZEOF(ValReal)=8}
|
||||||
|
//==================================
|
||||||
|
// assuming "type ValReal=double;"
|
||||||
|
//
|
||||||
|
type
|
||||||
|
TValRealRec = packed record
|
||||||
|
case byte of
|
||||||
|
0: (
|
||||||
|
{$ifndef ENDIAN_BIG}
|
||||||
|
raw_lo, raw_hi : longword // little-endian/default
|
||||||
|
{$else}
|
||||||
|
raw_hi, raw_lo : longword // big-endian
|
||||||
|
{$endif}
|
||||||
|
);
|
||||||
|
1: (v : double);
|
||||||
|
end;
|
||||||
|
|
||||||
|
const
|
||||||
|
{$ifndef ENDIAN_BIG}
|
||||||
|
// little-endian/default
|
||||||
|
C_INFTYP:TValRealRec=(raw_lo:0;raw_hi:$7FF00000); //+INF
|
||||||
|
C_INFTYM:TValRealRec=(raw_lo:0;raw_hi:$FFF00000); //-INF
|
||||||
|
{$else}
|
||||||
|
// big-endian
|
||||||
|
C_INFTYP:TValRealRec=(raw_hi:$7FF00000;raw_lo:0); //+INF
|
||||||
|
C_INFTYM:TValRealRec=(raw_hi:$FFF00000;raw_lo:0); //-INF
|
||||||
|
{$endif}
|
||||||
|
|
||||||
|
C_MAX_POWER = 319;
|
||||||
|
|
||||||
|
C_HIGH_EXPBITS_5TO8 = 9;
|
||||||
|
|
||||||
|
{$ELSEIF SIZEOF(ValReal)=4}
|
||||||
|
//==================================
|
||||||
|
// assuming "type ValReal=single;"
|
||||||
|
//
|
||||||
|
type
|
||||||
|
TValRealRec = packed record
|
||||||
|
case byte of
|
||||||
|
0: (raw : longword);
|
||||||
|
1: (v : single);
|
||||||
|
end;
|
||||||
|
|
||||||
|
const
|
||||||
|
C_INFTYP:TValRealRec=(raw:$7F800000); //+INF
|
||||||
|
C_INFTYM:TValRealRec=(raw:$FF800000); //-INF
|
||||||
|
|
||||||
|
C_MAX_POWER = 63;
|
||||||
|
|
||||||
|
{$ELSE}
|
||||||
|
//==================================
|
||||||
|
// assuming "ValReal=?"
|
||||||
|
//
|
||||||
|
{$ERROR Unsupported ValReal type}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
//==================================
|
||||||
|
const
|
||||||
|
mul_expbits_0_to_4:packed array[0..31]of ValReal=(
|
||||||
|
1E0, 1E1, 1E2, 1E3,
|
||||||
|
1E4, 1E5, 1E6, 1E7,
|
||||||
|
1E8, 1E9, 1E10, 1E11,
|
||||||
|
1E12, 1E13, 1E14, 1E15,
|
||||||
|
1E16, 1E17, 1E18, 1E19,
|
||||||
|
1E20, 1E21, 1E22, 1E23,
|
||||||
|
1E24, 1E25, 1E26, 1E27,
|
||||||
|
1E28, 1E29, 1E30, 1E31);
|
||||||
|
|
||||||
|
{$IF DECLARED(C_HIGH_EXPBITS_5TO8)}
|
||||||
|
mul_expbits_5_to_8:packed array[1..C_HIGH_EXPBITS_5TO8]of ValReal=(
|
||||||
|
1E32, 1E64, 1E96, 1E128,
|
||||||
|
1E160, 1E192, 1E224, 1E256, 1E288
|
||||||
|
{$IF DECLARED(C_HIGH_EXPBITS_9ANDUP)},
|
||||||
|
1E320, 1E352, 1E384, 1E416, 1E448, 1E480
|
||||||
|
{$ENDIF});
|
||||||
|
{$ELSE}
|
||||||
|
mul_expbits_5_to_8:ValReal=1E32;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IF DECLARED(C_HIGH_EXPBITS_9ANDUP)}
|
||||||
|
mul_expbits_9_and_up:packed array[1..C_HIGH_EXPBITS_9ANDUP]of ValReal=(
|
||||||
|
1E512, 1E1024, 1E1536, 1E2048,
|
||||||
|
1E2560, 1E3072, 1E3584, 1E4096,
|
||||||
|
1E4608);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
begin
|
||||||
|
if power=0 then mul_by_power10:=x else
|
||||||
|
if power<-C_MAX_POWER then mul_by_power10:=0 else
|
||||||
|
if power>C_MAX_POWER then
|
||||||
|
if x<0 then mul_by_power10:=C_INFTYM.v else
|
||||||
|
if x>0 then mul_by_power10:=C_INFTYP.v else mul_by_power10:=0
|
||||||
|
else
|
||||||
|
if power<0 then
|
||||||
|
begin
|
||||||
|
power:=-power;
|
||||||
|
mul_by_power10:=x/mul_expbits_0_to_4[power and $1F];
|
||||||
|
power:=(power shr 5);
|
||||||
|
if power=0 then exit;
|
||||||
|
{$IF DECLARED(C_HIGH_EXPBITS_5TO8)}
|
||||||
|
if power and $F<>0 then
|
||||||
|
mul_by_power10:=
|
||||||
|
mul_by_power10/mul_expbits_5_to_8[power and $F];
|
||||||
|
{$ELSE} // "single", power<>0, so always div
|
||||||
|
mul_by_power10:=mul_by_power10/mul_expbits_5_to_8;
|
||||||
|
{$ENDIF}
|
||||||
|
{$IF DECLARED(C_HIGH_EXPBITS_9ANDUP)}
|
||||||
|
power:=(power shr 4);
|
||||||
|
if power<>0 then
|
||||||
|
mul_by_power10:=
|
||||||
|
mul_by_power10/mul_expbits_9_and_up[power];
|
||||||
|
{$ENDIF}
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
mul_by_power10:=x*mul_expbits_0_to_4[power and $1F];
|
||||||
|
power:=(power shr 5);
|
||||||
|
if power=0 then exit;
|
||||||
|
{$IF DECLARED(C_HIGH_EXPBITS_5TO8)}
|
||||||
|
if power and $F<>0 then
|
||||||
|
mul_by_power10:=
|
||||||
|
mul_by_power10*mul_expbits_5_to_8[power and $F];
|
||||||
|
{$ELSE} // "single", power<>0, so always mul
|
||||||
|
mul_by_power10:=mul_by_power10*mul_expbits_5_to_8;
|
||||||
|
{$ENDIF}
|
||||||
|
{$IF DECLARED(C_HIGH_EXPBITS_9ANDUP)}
|
||||||
|
power:=(power shr 4);
|
||||||
|
if power<>0 then
|
||||||
|
mul_by_power10:=
|
||||||
|
mul_by_power10*mul_expbits_9_and_up[power];
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
Function fpc_Val_Real_ShortStr(const s : shortstring; out Code : ValSInt): ValReal; [public, alias:'FPC_VAL_REAL_SHORTSTR']; compilerproc;
|
Function fpc_Val_Real_ShortStr(const s : shortstring; out Code : ValSInt): ValReal; [public, alias:'FPC_VAL_REAL_SHORTSTR']; compilerproc;
|
||||||
var
|
var
|
||||||
hd,
|
sign : valreal;
|
||||||
esign,sign : valreal;
|
esign,
|
||||||
exponent,
|
exponent,
|
||||||
decpoint,i : SizeInt;
|
decpoint,i : SizeInt;
|
||||||
flags : byte;
|
flags : byte;
|
||||||
@ -1253,28 +1465,7 @@ begin
|
|||||||
fpc_Val_Real_ShortStr:=fpc_Val_Real_ShortStr*sign;
|
fpc_Val_Real_ShortStr:=fpc_Val_Real_ShortStr*sign;
|
||||||
|
|
||||||
{ Calculate Exponent }
|
{ Calculate Exponent }
|
||||||
hd:=1.0;
|
fpc_Val_Real_ShortStr:=mul_by_power10(fpc_Val_Real_ShortStr,exponent*esign);
|
||||||
{ the magnitude range maximum (normal) is lower in absolute value than the }
|
|
||||||
{ the magnitude range minimum (denormal). E.g. an extended value can go }
|
|
||||||
{ up to 1E4932, but "down" to 1E-4951. So make sure that we don't try to }
|
|
||||||
{ calculate 1E4951 as factor, since that would overflow and result in 0. }
|
|
||||||
if (exponent>valmaxexpnorm-2) then
|
|
||||||
begin
|
|
||||||
for i:=1 to valmaxexpnorm-2 do
|
|
||||||
hd:=hd*10.0;
|
|
||||||
if esign>0 then
|
|
||||||
fpc_Val_Real_ShortStr:=fpc_Val_Real_ShortStr*hd
|
|
||||||
else
|
|
||||||
fpc_Val_Real_ShortStr:=fpc_Val_Real_ShortStr/hd;
|
|
||||||
dec(exponent,valmaxexpnorm-2);
|
|
||||||
hd:=1.0;
|
|
||||||
end;
|
|
||||||
for i:=1 to exponent do
|
|
||||||
hd:=hd*10.0;
|
|
||||||
if esign>0 then
|
|
||||||
fpc_Val_Real_ShortStr:=fpc_Val_Real_ShortStr*hd
|
|
||||||
else
|
|
||||||
fpc_Val_Real_ShortStr:=fpc_Val_Real_ShortStr/hd;
|
|
||||||
|
|
||||||
{ Not all characters are read ? }
|
{ Not all characters are read ? }
|
||||||
if length(s)>=code then
|
if length(s)>=code then
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user