mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-24 12:29:24 +02:00
- removed old float-to-string and string-to-float conversion code
git-svn-id: trunk@45401 -
This commit is contained in:
Jonas Maebe
parent
4c9fae1e35
commit
f9672b53a2
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -10956,7 +10956,6 @@ rtl/inc/pagemem.pp svneol=native#text/plain
|
|||||||
rtl/inc/psabieh.inc svneol=native#text/plain
|
rtl/inc/psabieh.inc svneol=native#text/plain
|
||||||
rtl/inc/psabiehh.inc svneol=native#text/plain
|
rtl/inc/psabiehh.inc svneol=native#text/plain
|
||||||
rtl/inc/readme -text
|
rtl/inc/readme -text
|
||||||
rtl/inc/real2str.inc svneol=native#text/plain
|
|
||||||
rtl/inc/resh.inc svneol=native#text/plain
|
rtl/inc/resh.inc svneol=native#text/plain
|
||||||
rtl/inc/rtti.inc svneol=native#text/plain
|
rtl/inc/rtti.inc svneol=native#text/plain
|
||||||
rtl/inc/rttidecl.inc svneol=native#text/plain
|
rtl/inc/rttidecl.inc svneol=native#text/plain
|
||||||
|
|||||||
@ -91,7 +91,9 @@ begin
|
|||||||
AddInclude('$(CPU).inc');
|
AddInclude('$(CPU).inc');
|
||||||
AddInclude('fastmove.inc',[i386],AllOSes);
|
AddInclude('fastmove.inc',[i386],AllOSes);
|
||||||
AddInclude('math.inc');
|
AddInclude('math.inc');
|
||||||
AddInclude('real2str.inc');
|
AddInclude('flt_conv.inc');
|
||||||
|
AddInclude('flt_core.inc');
|
||||||
|
AddInclude('flt_pack.inc');
|
||||||
AddInclude('systhrd.inc',AllWindowsOSes+[Netware,Netwlibc,EMX,OS2]);
|
AddInclude('systhrd.inc',AllWindowsOSes+[Netware,Netwlibc,EMX,OS2]);
|
||||||
// Unix implementations
|
// Unix implementations
|
||||||
AddInclude('osdefs.inc',AllUnixOSes);
|
AddInclude('osdefs.inc',AllUnixOSes);
|
||||||
|
|||||||
@ -4,7 +4,7 @@
|
|||||||
# System unit include files. These are composed from header and
|
# System unit include files. These are composed from header and
|
||||||
# implementation files.
|
# implementation files.
|
||||||
|
|
||||||
SYSNAMES=systemh heaph mathh filerec textrec system real2str sstrings innr \
|
SYSNAMES=systemh heaph mathh filerec textrec system flt_conv flt_core flt_pack sstrings innr \
|
||||||
file typefile text rtti heap astrings objpas objpash except int64 \
|
file typefile text rtti heap astrings objpas objpash except int64 \
|
||||||
generic dynarr varianth variant wstrings compproc
|
generic dynarr varianth variant wstrings compproc
|
||||||
|
|
||||||
|
|||||||
@ -13,7 +13,7 @@ innr.inc Internal function delcarations.
|
|||||||
int64.inc Support for 64-bit integer arithmetic.
|
int64.inc Support for 64-bit integer arithmetic.
|
||||||
lstrings.pp LongStrings routine implementation.
|
lstrings.pp LongStrings routine implementation.
|
||||||
mathh.inc Declarations of mathematical functions.
|
mathh.inc Declarations of mathematical functions.
|
||||||
real2str.inc Routine to convert floating point numbers to strings.
|
flt_*.inc Routines to convert floating point numbers to strings and vice versa.
|
||||||
rtti.inc Delphi like runtime type information
|
rtti.inc Delphi like runtime type information
|
||||||
sstrings.inc ShortStrings (TP/BP pascal like strings) implementation.
|
sstrings.inc ShortStrings (TP/BP pascal like strings) implementation.
|
||||||
system.inc OS and Processor independent implementation part of system unit.
|
system.inc OS and Processor independent implementation part of system unit.
|
||||||
|
|||||||
@ -1,543 +0,0 @@
|
|||||||
{
|
|
||||||
This file is part of the Free Pascal run time library.
|
|
||||||
Copyright (c) 1999-2000 by Michael Van Canneyt,
|
|
||||||
member of the Free Pascal development team
|
|
||||||
|
|
||||||
See the file COPYING.FPC, included in this distribution,
|
|
||||||
for details about the copyright.
|
|
||||||
|
|
||||||
This program is distributed in the hope that it will be useful,
|
|
||||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
||||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
|
||||||
|
|
||||||
**********************************************************************}
|
|
||||||
|
|
||||||
type
|
|
||||||
{ See symconst.pas tfloattype }
|
|
||||||
treal_type = (
|
|
||||||
rt_s32real,rt_s64real,rt_s80real,rt_sc80real,
|
|
||||||
rt_c64bit,rt_currency,rt_s128real
|
|
||||||
);
|
|
||||||
{ 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
|
|
||||||
TSplitExtended = packed record
|
|
||||||
case byte of
|
|
||||||
0: (bytes: Array[0..9] of byte);
|
|
||||||
1: (words: Array[0..4] of word);
|
|
||||||
2: (cards: Array[0..1] of cardinal; w: word);
|
|
||||||
end;
|
|
||||||
const
|
|
||||||
maxDigits = 17;
|
|
||||||
{$else}
|
|
||||||
{$ifdef SUPPORT_DOUBLE}
|
|
||||||
{$ifndef cpujvm}
|
|
||||||
type
|
|
||||||
TSplitDouble = packed record
|
|
||||||
case byte of
|
|
||||||
0: (bytes: Array[0..7] of byte);
|
|
||||||
1: (words: Array[0..3] of word);
|
|
||||||
2: (cards: Array[0..1] of cardinal);
|
|
||||||
end;
|
|
||||||
{$endif}
|
|
||||||
const
|
|
||||||
maxDigits = 15;
|
|
||||||
{$else}
|
|
||||||
{$ifdef SUPPORT_SINGLE}
|
|
||||||
type
|
|
||||||
TSplitSingle = packed record
|
|
||||||
case byte of
|
|
||||||
0: (bytes: Array[0..3] of byte);
|
|
||||||
1: (words: Array[0..1] of word);
|
|
||||||
2: (cards: Array[0..0] of cardinal);
|
|
||||||
end;
|
|
||||||
const
|
|
||||||
maxDigits = 9;
|
|
||||||
{$endif SUPPORT_SINGLE}
|
|
||||||
{$endif SUPPORT_DOUBLE}
|
|
||||||
{$endif SUPPORT_EXTENDED}
|
|
||||||
|
|
||||||
type
|
|
||||||
{ the value in the last position is used for rounding }
|
|
||||||
TIntPartStack = array[1..maxDigits+1] of valReal;
|
|
||||||
|
|
||||||
var
|
|
||||||
{$ifdef cpujvm}
|
|
||||||
doublebits: int64;
|
|
||||||
{$endif}
|
|
||||||
roundCorr, corrVal, factor : valReal;
|
|
||||||
high_exp10_reduced,
|
|
||||||
spos, endpos, fracCount: longint;
|
|
||||||
correct, currprec: longint;
|
|
||||||
temp : string;
|
|
||||||
power : string[10];
|
|
||||||
sign : boolean;
|
|
||||||
dot : byte;
|
|
||||||
fraczero, expMaximal: boolean;
|
|
||||||
|
|
||||||
|
|
||||||
maxlen : longint; { Maximal length of string for float }
|
|
||||||
minlen : longint; { Minimal length of string for float }
|
|
||||||
explen : longint; { Length of exponent, including E and sign.
|
|
||||||
Must be strictly larger than 2 }
|
|
||||||
const
|
|
||||||
maxexp = 1e+35; { Maximum value for decimal expressions }
|
|
||||||
minexp = 1e-35; { Minimum value for decimal expressions }
|
|
||||||
zero = '0000000000000000000000000000000000000000';
|
|
||||||
|
|
||||||
procedure RoundStr(var s: string; lastPos: byte);
|
|
||||||
var carry: longint;
|
|
||||||
begin
|
|
||||||
carry := 1;
|
|
||||||
repeat
|
|
||||||
s[lastPos] := chr(ord(s[lastPos])+carry);
|
|
||||||
carry := 0;
|
|
||||||
if s[lastPos] > '9' then
|
|
||||||
begin
|
|
||||||
s[lastPos] := '0';
|
|
||||||
carry := 1;
|
|
||||||
end;
|
|
||||||
dec(lastPos);
|
|
||||||
until carry = 0;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure getIntPart(d: valreal);
|
|
||||||
var
|
|
||||||
intPartStack: TIntPartStack;
|
|
||||||
intPart, stackPtr, endStackPtr, digits: longint;
|
|
||||||
overflow: boolean;
|
|
||||||
begin
|
|
||||||
{$ifdef DEBUG_NASM}
|
|
||||||
writeln(stderr,'getintpart(d) entry');
|
|
||||||
{$endif DEBUG_NASM}
|
|
||||||
{ position in the stack (gets increased before first write) }
|
|
||||||
stackPtr := 0;
|
|
||||||
{ number of digits processed }
|
|
||||||
digits := 0;
|
|
||||||
{ did we wrap around in the stack? Necessary to know whether we should round }
|
|
||||||
overflow :=false;
|
|
||||||
{ generate a list consisting of d, d/10, d/100, ... until d < 1.0 }
|
|
||||||
while d > 1.0-roundCorr do
|
|
||||||
begin
|
|
||||||
inc(stackPtr);
|
|
||||||
inc(digits);
|
|
||||||
if stackPtr > maxDigits+1 then
|
|
||||||
begin
|
|
||||||
stackPtr := 1;
|
|
||||||
overflow := true;
|
|
||||||
end;
|
|
||||||
intPartStack[stackPtr] := d;
|
|
||||||
d := d / 10.0;
|
|
||||||
end;
|
|
||||||
{ if no integer part, exit }
|
|
||||||
if digits = 0 then
|
|
||||||
exit;
|
|
||||||
endStackPtr := stackPtr+1;
|
|
||||||
if endStackPtr > maxDigits + 1 then
|
|
||||||
endStackPtr := 1;
|
|
||||||
{ now, all digits are calculated using trunc(d*10^(-n)-int(d*10^(-n-1))*10) }
|
|
||||||
corrVal := 0.0;
|
|
||||||
{ the power of 10 with which the resulting string has to be "multiplied" }
|
|
||||||
{ if the decimal point is placed after the first significant digit }
|
|
||||||
correct := digits-1;
|
|
||||||
{$ifdef DEBUG_NASM}
|
|
||||||
writeln(stderr,'endStackPtr = ',endStackPtr);
|
|
||||||
{$endif DEBUG_NASM}
|
|
||||||
repeat
|
|
||||||
if (currprec > 0) then
|
|
||||||
begin
|
|
||||||
intPart:= trunc(intPartStack[stackPtr]-corrVal);
|
|
||||||
dec(currPrec);
|
|
||||||
inc(spos);
|
|
||||||
temp[spos] := chr(intPart+ord('0'));
|
|
||||||
{$ifdef DEBUG_NASM}
|
|
||||||
writeln(stderr,'stackptr =',stackptr,' intpart = ',intpart);
|
|
||||||
{$endif DEBUG_NASM}
|
|
||||||
if temp[spos] > '9' then
|
|
||||||
begin
|
|
||||||
temp[spos] := chr(ord(temp[spos])-10);
|
|
||||||
roundStr(temp,spos-1);
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
corrVal := int(intPartStack[stackPtr]) * 10.0;
|
|
||||||
{$ifdef DEBUG_NASM}
|
|
||||||
writeln(stderr,'trunc(corrval) = ',trunc(corrval));
|
|
||||||
{$endif DEBUG_NASM}
|
|
||||||
dec(stackPtr);
|
|
||||||
if stackPtr = 0 then
|
|
||||||
stackPtr := maxDigits+1;
|
|
||||||
until (overflow and (stackPtr = endStackPtr)) or
|
|
||||||
(not overflow and (stackPtr = maxDigits+1)) or (currPrec = 0);
|
|
||||||
{ round if we didn't use all available digits yet and if the }
|
|
||||||
{ remainder is > 5 }
|
|
||||||
if (overflow or
|
|
||||||
(stackPtr < maxDigits+1)) then
|
|
||||||
begin
|
|
||||||
{ we didn't use all available digits of the whole part -> make sure }
|
|
||||||
{ the fractional part is not used for rounding later }
|
|
||||||
currprec := -1;
|
|
||||||
{ instead, round based on the next whole digit }
|
|
||||||
if (int(intPartStack[stackPtr]-corrVal) >= 5.0) then
|
|
||||||
roundStr(temp,spos);
|
|
||||||
end;
|
|
||||||
{$ifdef DEBUG_NASM}
|
|
||||||
writeln(stderr,'temp at getintpart exit is = ',temp);
|
|
||||||
{$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 :
|
|
||||||
begin
|
|
||||||
maxlen:=16;
|
|
||||||
minlen:=8;
|
|
||||||
explen:=4;
|
|
||||||
{ correction used with comparing to avoid rounding/precision errors }
|
|
||||||
roundCorr := 1.1920928955e-07;
|
|
||||||
end;
|
|
||||||
rt_s64real :
|
|
||||||
begin
|
|
||||||
maxlen := 22;
|
|
||||||
{ correction used with comparing to avoid rounding/precision errors }
|
|
||||||
roundCorr := 2.2204460493e-16;
|
|
||||||
minlen:=9;
|
|
||||||
explen:=5;
|
|
||||||
end;
|
|
||||||
rt_s80real,
|
|
||||||
rt_sc80real:
|
|
||||||
begin
|
|
||||||
{ Different in TP help, but this way the output is the same (JM) }
|
|
||||||
maxlen:=25;
|
|
||||||
minlen:=10;
|
|
||||||
explen:=6;
|
|
||||||
{ correction used with comparing to avoid rounding/precision errors }
|
|
||||||
roundCorr := 1.0842021725e-19;
|
|
||||||
end;
|
|
||||||
rt_c64bit :
|
|
||||||
begin
|
|
||||||
maxlen:=23;
|
|
||||||
minlen:=10;
|
|
||||||
{ according to TP (was 5) (FK) }
|
|
||||||
explen:=6;
|
|
||||||
{ correction used with comparing to avoid rounding/precision errors }
|
|
||||||
roundCorr := 2.2204460493e-16;
|
|
||||||
end;
|
|
||||||
rt_currency :
|
|
||||||
begin
|
|
||||||
{ Different in TP help, but this way the output is the same (JM) }
|
|
||||||
maxlen:=25;
|
|
||||||
minlen:=10;
|
|
||||||
explen:=0;
|
|
||||||
{ correction used with comparing to avoid rounding/precision errors }
|
|
||||||
roundCorr := 1.0842021725e-19;
|
|
||||||
end;
|
|
||||||
rt_s128real :
|
|
||||||
begin
|
|
||||||
{ Different in TP help, but this way the output is the same (JM) }
|
|
||||||
maxlen:=25;
|
|
||||||
minlen:=10;
|
|
||||||
explen:=6;
|
|
||||||
{ correction used with comparing to avoid rounding/precision errors }
|
|
||||||
roundCorr := 1.0842021725e-19;
|
|
||||||
end;
|
|
||||||
else
|
|
||||||
begin
|
|
||||||
{ keep JVM byte code verifier happy }
|
|
||||||
maxlen:=0;
|
|
||||||
minlen:=0;
|
|
||||||
explen:=0;
|
|
||||||
roundCorr:=0;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
{ check parameters }
|
|
||||||
{ default value for length is -32767 }
|
|
||||||
if len=-32767 then
|
|
||||||
len:=maxlen;
|
|
||||||
{ determine sign. before precision, needs 2 less calls to abs() }
|
|
||||||
{$ifndef endian_big}
|
|
||||||
{$ifdef SUPPORT_EXTENDED}
|
|
||||||
{ extended, format (MSB): 1 Sign bit, 15 bit exponent, 64 bit mantissa }
|
|
||||||
sign := (TSplitExtended(d).w and $8000) <> 0;
|
|
||||||
expMaximal := (TSplitExtended(d).w and $7fff) = 32767;
|
|
||||||
fraczero := (TSplitExtended(d).cards[0] = 0) and
|
|
||||||
((TSplitExtended(d).cards[1] and $7fffffff) = 0);
|
|
||||||
{$else SUPPORT_EXTENDED}
|
|
||||||
{$ifdef SUPPORT_DOUBLE}
|
|
||||||
{$ifdef FPC_DOUBLE_HILO_SWAPPED}
|
|
||||||
{ double, format (MSB): 1 Sign bit, 11 bit exponent, 52 bit mantissa }
|
|
||||||
{ high and low dword are swapped when using the arm fpa }
|
|
||||||
sign := ((TSplitDouble(d).cards[0] shr 20) and $800) <> 0;
|
|
||||||
expMaximal := ((TSplitDouble(d).cards[0] shr 20) and $7ff) = 2047;
|
|
||||||
fraczero:= (TSplitDouble(d).cards[0] and $fffff = 0) and
|
|
||||||
(TSplitDouble(d).cards[1] = 0);
|
|
||||||
{$else FPC_DOUBLE_HILO_SWAPPED}
|
|
||||||
{ double, format (MSB): 1 Sign bit, 11 bit exponent, 52 bit mantissa }
|
|
||||||
sign := ((TSplitDouble(d).cards[1] shr 20) and $800) <> 0;
|
|
||||||
expMaximal := ((TSplitDouble(d).cards[1] shr 20) and $7ff) = 2047;
|
|
||||||
fraczero := (TSplitDouble(d).cards[1] and $fffff = 0) and
|
|
||||||
(TSplitDouble(d).cards[0] = 0);
|
|
||||||
{$endif FPC_DOUBLE_HILO_SWAPPED}
|
|
||||||
{$else SUPPORT_DOUBLE}
|
|
||||||
{$ifdef SUPPORT_SINGLE}
|
|
||||||
{ single, format (MSB): 1 Sign bit, 8 bit exponent, 23 bit mantissa }
|
|
||||||
sign := ((TSplitSingle(d).words[1] shr 7) and $100) <> 0;
|
|
||||||
expMaximal := ((TSplitSingle(d).words[1] shr 7) and $ff) = 255;
|
|
||||||
fraczero := (TSplitSingle(d).cards[0] and $7fffff = 0);
|
|
||||||
{$else SUPPORT_SINGLE}
|
|
||||||
{$error No little endian floating type supported yet in real2str}
|
|
||||||
{$endif SUPPORT_SINGLE}
|
|
||||||
{$endif SUPPORT_DOUBLE}
|
|
||||||
{$endif SUPPORT_EXTENDED}
|
|
||||||
{$else endian_big}
|
|
||||||
{$ifdef SUPPORT_EXTENDED}
|
|
||||||
{$error sign/NaN/Inf not yet supported for big endian CPU's in str_real}
|
|
||||||
{$else SUPPORT_EXTENDED}
|
|
||||||
{$ifdef SUPPORT_DOUBLE}
|
|
||||||
{$ifdef cpujvm}
|
|
||||||
doublebits := JLDouble.doubleToLongBits(d);
|
|
||||||
sign := doublebits<0;
|
|
||||||
expMaximal := (doublebits shr (32+20)) and $7ff = 2047;
|
|
||||||
fraczero:= (((doublebits shr 32) and $fffff) = 0) and
|
|
||||||
(longint(doublebits)=0);
|
|
||||||
{$else cpujvm}
|
|
||||||
{ double, format (MSB): 1 Sign bit, 11 bit exponent, 52 bit mantissa }
|
|
||||||
sign := ((TSplitDouble(d).cards[0] shr 20) and $800) <> 0;
|
|
||||||
expMaximal := ((TSplitDouble(d).cards[0] shr 20) and $7ff) = 2047;
|
|
||||||
fraczero:= (TSplitDouble(d).cards[0] and $fffff = 0) and
|
|
||||||
(TSplitDouble(d).cards[1] = 0);
|
|
||||||
{$endif cpujvm}
|
|
||||||
{$else SUPPORT_DOUBLE}
|
|
||||||
{$ifdef SUPPORT_SINGLE}
|
|
||||||
{ single, format (MSB): 1 Sign bit, 8 bit exponent, 23 bit mantissa }
|
|
||||||
sign := ((TSplitSingle(d).bytes[0] and $80)) <> 0;
|
|
||||||
expMaximal := ((TSplitSingle(d).words[0] shr 7) and $ff) = 255;
|
|
||||||
fraczero:= (TSplitSingle(d).cards[0] and $7fffff = 0);
|
|
||||||
{$else SUPPORT_SINGLE}
|
|
||||||
{$error No big endian floating type supported yet in real2str}
|
|
||||||
{$endif SUPPORT_SINGLE}
|
|
||||||
{$endif SUPPORT_DOUBLE}
|
|
||||||
{$endif SUPPORT_EXTENDED}
|
|
||||||
{$endif endian}
|
|
||||||
if expMaximal then
|
|
||||||
if fraczero then
|
|
||||||
if sign then
|
|
||||||
temp := '-Inf'
|
|
||||||
else temp := '+Inf'
|
|
||||||
else temp := 'Nan'
|
|
||||||
else
|
|
||||||
begin
|
|
||||||
{ d:=abs(d); this converts d to double so we loose precision }
|
|
||||||
{ for the same reason I converted d:=frac(d) to d:=d-int(d); (PM) }
|
|
||||||
if sign then
|
|
||||||
d:=-d;
|
|
||||||
{ determine precision : maximal precision is : }
|
|
||||||
currPrec := maxlen-explen-2;
|
|
||||||
{ this is also the maximal number of decimals !!}
|
|
||||||
if f>currprec then
|
|
||||||
f:=currprec;
|
|
||||||
{ when doing a fixed-point, we need less characters.}
|
|
||||||
if (f<0) {or ((d<>0) and ((d>maxexp) and (d>minexp)))} then
|
|
||||||
begin
|
|
||||||
{ determine maximal number of decimals }
|
|
||||||
if (len>=0) and (len<minlen) then
|
|
||||||
len:=minlen;
|
|
||||||
if (len>0) and (len<maxlen) then
|
|
||||||
currprec:=len-explen-2;
|
|
||||||
end;
|
|
||||||
|
|
||||||
{ 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 }
|
|
||||||
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);
|
|
||||||
{ if we have to round earlier than the amount of available precision, }
|
|
||||||
{ only calculate digits up to that point }
|
|
||||||
if (f >= 0) and (currPrec > f) then
|
|
||||||
currPrec := f;
|
|
||||||
{ if integer part was zero, go to the first significant digit of the }
|
|
||||||
{ fractional part }
|
|
||||||
{ make sure we don't get an endless loop if d = 0 }
|
|
||||||
if (spos = 2) and (d <> 0.0) then
|
|
||||||
begin
|
|
||||||
{ take rounding errors into account }
|
|
||||||
while d < 0.1-roundCorr do
|
|
||||||
begin
|
|
||||||
d := d * 10.0;
|
|
||||||
dec(correct);
|
|
||||||
{ adjust the precision depending on how many digits we }
|
|
||||||
{ already "processed" by multiplying by 10, but only if }
|
|
||||||
{ the amount of precision is specified }
|
|
||||||
if f >= 0 then
|
|
||||||
dec(currPrec);
|
|
||||||
end;
|
|
||||||
dec(correct);
|
|
||||||
end;
|
|
||||||
{ current length of the output string in endPos }
|
|
||||||
endPos := spos;
|
|
||||||
{ always calculate at least 1 fractional digit for rounding }
|
|
||||||
if (currPrec >= 0) then
|
|
||||||
begin
|
|
||||||
corrVal := 0.5;
|
|
||||||
factor := 1;
|
|
||||||
for fracCount := 1 to currPrec do
|
|
||||||
factor := factor * 10.0;
|
|
||||||
corrval := corrval / factor;
|
|
||||||
{ for single, we may write more significant digits than are available,
|
|
||||||
so the rounding correction itself can show up -> don't round in that
|
|
||||||
case
|
|
||||||
}
|
|
||||||
if real_type<>rt_s32real then
|
|
||||||
d:=d+d*roundCorr;
|
|
||||||
if d >= corrVal then
|
|
||||||
d := d + corrVal;
|
|
||||||
if int(d) = 1 then
|
|
||||||
begin
|
|
||||||
roundStr(temp,spos);
|
|
||||||
d := frac(d);
|
|
||||||
end;
|
|
||||||
{ calculate the necessary fractional digits }
|
|
||||||
for fracCount := 1 to currPrec do
|
|
||||||
begin
|
|
||||||
if d > 1.0 then
|
|
||||||
d := frac(d) * 10.0
|
|
||||||
else d := d * 10.0;
|
|
||||||
inc(spos);
|
|
||||||
temp[spos] := chr(trunc(d)+ord('0'));
|
|
||||||
if temp[spos] > '9' then
|
|
||||||
{ possible because trunc and the "*10.0" aren't exact :( }
|
|
||||||
begin
|
|
||||||
temp[spos] := chr(ord(temp[spos]) - 10);
|
|
||||||
roundStr(temp,spos-1);
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
{ new length of string }
|
|
||||||
endPos := spos;
|
|
||||||
end;
|
|
||||||
setLength(temp,endPos);
|
|
||||||
{ delete leading zero if we didn't need it while rounding at the }
|
|
||||||
{ string level }
|
|
||||||
if temp[2] = '0' then
|
|
||||||
delete(temp,2,1)
|
|
||||||
{ the rounding caused an overflow to the next power of 10 }
|
|
||||||
else inc(correct);
|
|
||||||
if sign then
|
|
||||||
temp[1] := '-';
|
|
||||||
if (f<0) or (correct>(round(ln(maxexp)/ln(10)))) then
|
|
||||||
begin
|
|
||||||
insert ('.',temp,3);
|
|
||||||
str(abs(correct),power);
|
|
||||||
if length(power)<explen-2 then
|
|
||||||
power:=copy(zero,1,explen-2-length(power))+power;
|
|
||||||
if correct<0 then
|
|
||||||
power:='-'+power
|
|
||||||
else
|
|
||||||
power:='+'+power;
|
|
||||||
temp:=temp+'E'+power;
|
|
||||||
end
|
|
||||||
else
|
|
||||||
begin
|
|
||||||
if not sign then
|
|
||||||
begin
|
|
||||||
delete(temp,1,1);
|
|
||||||
dot := 2
|
|
||||||
end
|
|
||||||
else
|
|
||||||
dot := 3;
|
|
||||||
{ set zeroes and dot }
|
|
||||||
if correct>=0 then
|
|
||||||
begin
|
|
||||||
if length(temp)<correct+dot+f-1 then
|
|
||||||
temp:=temp+copy(zero,1,correct+dot+f-length(temp));
|
|
||||||
insert ('.',temp,correct+dot);
|
|
||||||
end
|
|
||||||
else
|
|
||||||
begin
|
|
||||||
correct:=abs(correct);
|
|
||||||
insert(copy(zero,1,correct),temp,dot-1);
|
|
||||||
insert ('.',temp,dot);
|
|
||||||
end;
|
|
||||||
{ correct length to fit precision }
|
|
||||||
if f>0 then
|
|
||||||
setlength(temp,pos('.',temp)+f)
|
|
||||||
else
|
|
||||||
setLength(temp,pos('.',temp)-1);
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
if length(temp)<len then
|
|
||||||
s:=space(len-length(temp))+temp
|
|
||||||
else s:=temp;
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
|
||||||
Procedure str_real_iso (len,f : longint; d : ValReal; real_type :treal_type; out s : string);
|
|
||||||
var
|
|
||||||
i : Integer;
|
|
||||||
begin
|
|
||||||
str_real(len,f,d,real_type,s);
|
|
||||||
for i:=1 to Length(s) do
|
|
||||||
if s[i]='E' then
|
|
||||||
s[i]:='e';
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
|
||||||
@ -490,11 +490,7 @@ end;
|
|||||||
{ compilerproc name will fail (JM) }
|
{ compilerproc name will fail (JM) }
|
||||||
|
|
||||||
{$ifndef FPUNONE}
|
{$ifndef FPUNONE}
|
||||||
{$ifdef FLOAT_ASCII_FALLBACK}
|
|
||||||
{$I real2str.inc}
|
|
||||||
{$else not FLOAT_ASCII_FALLBACK}
|
|
||||||
{$I flt_conv.inc}
|
{$I flt_conv.inc}
|
||||||
{$endif FLOAT_ASCII_FALLBACK}
|
|
||||||
{$endif}
|
{$endif}
|
||||||
|
|
||||||
{$ifndef FPUNONE}
|
{$ifndef FPUNONE}
|
||||||
@ -1566,349 +1562,6 @@ end;
|
|||||||
end;
|
end;
|
||||||
{$endif CPU16 or CPU8}
|
{$endif CPU16 or CPU8}
|
||||||
|
|
||||||
{$ifdef FLOAT_ASCII_FALLBACK}
|
|
||||||
{$ifndef FPUNONE}
|
|
||||||
const
|
|
||||||
{$ifdef FPC_HAS_TYPE_EXTENDED}
|
|
||||||
valmaxexpnorm=4932;
|
|
||||||
mantissabits=64;
|
|
||||||
{$else}
|
|
||||||
{$ifdef FPC_HAS_TYPE_DOUBLE}
|
|
||||||
valmaxexpnorm=308;
|
|
||||||
mantissabits=53;
|
|
||||||
{$else}
|
|
||||||
{$ifdef FPC_HAS_TYPE_SINGLE}
|
|
||||||
valmaxexpnorm=38;
|
|
||||||
mantissabits=24;
|
|
||||||
{$else}
|
|
||||||
{$error Unknown floating point precision }
|
|
||||||
{$endif}
|
|
||||||
{$endif}
|
|
||||||
{$endif}
|
|
||||||
{$endif}
|
|
||||||
|
|
||||||
{$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;"
|
|
||||||
//
|
|
||||||
const
|
|
||||||
C_MAX_POWER = 5119;
|
|
||||||
|
|
||||||
C_HIGH_EXPBITS_5TO8 = 15;
|
|
||||||
C_HIGH_EXPBITS_9ANDUP = 9;
|
|
||||||
|
|
||||||
{$ELSEIF SIZEOF(ValReal)=8}
|
|
||||||
//==================================
|
|
||||||
// assuming "type ValReal=double;"
|
|
||||||
//
|
|
||||||
const
|
|
||||||
C_MAX_POWER = 319;
|
|
||||||
|
|
||||||
C_HIGH_EXPBITS_5TO8 = 9;
|
|
||||||
|
|
||||||
{$ELSEIF SIZEOF(ValReal)=4}
|
|
||||||
//==================================
|
|
||||||
// assuming "type ValReal=single;"
|
|
||||||
//
|
|
||||||
const
|
|
||||||
C_MAX_POWER = 63;
|
|
||||||
|
|
||||||
{$ELSE}
|
|
||||||
//==================================
|
|
||||||
// assuming "ValReal=?"
|
|
||||||
//
|
|
||||||
{$ERROR Unsupported ValReal type}
|
|
||||||
{$ENDIF}
|
|
||||||
|
|
||||||
//==================================
|
|
||||||
const
|
|
||||||
C_INFTYP = ValReal( 1.0/0.0);
|
|
||||||
C_INFTYM = ValReal(-1.0/0.0);
|
|
||||||
|
|
||||||
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 else
|
|
||||||
if x>0 then mul_by_power10:=C_INFTYP 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;
|
|
||||||
var
|
|
||||||
hd,
|
|
||||||
sign : valreal;
|
|
||||||
esign,
|
|
||||||
exponent,
|
|
||||||
expstart,
|
|
||||||
decpoint : SizeInt;
|
|
||||||
nint,
|
|
||||||
nlz,
|
|
||||||
explimit,
|
|
||||||
explastdigit: SizeInt;
|
|
||||||
begin
|
|
||||||
fpc_Val_Real_ShortStr:=0.0;
|
|
||||||
code:=1;
|
|
||||||
exponent:=0;
|
|
||||||
decpoint:=0;
|
|
||||||
esign:=1;
|
|
||||||
hd:=0.0;
|
|
||||||
nlz:=0;
|
|
||||||
nint:=0;
|
|
||||||
sign:=1;
|
|
||||||
while (code<=length(s)) and (s[code] in [' ',#9]) do
|
|
||||||
inc(code);
|
|
||||||
if code<=length(s) then
|
|
||||||
case s[code] of
|
|
||||||
'+' : inc(code);
|
|
||||||
'-' : begin
|
|
||||||
sign:=-1;
|
|
||||||
inc(code);
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
{ leading zeroes do not influence result, skip all but one of them }
|
|
||||||
expstart:=code;
|
|
||||||
while (code<Length(s)) and (s[code]='0') do
|
|
||||||
inc(code);
|
|
||||||
if (code>expstart) then
|
|
||||||
dec(code);
|
|
||||||
expstart:=code;
|
|
||||||
while (Code<=Length(s)) do
|
|
||||||
begin
|
|
||||||
case s[code] of
|
|
||||||
'0':
|
|
||||||
begin
|
|
||||||
if (hd=0) then
|
|
||||||
inc(nlz,ord(decpoint<>0))
|
|
||||||
else
|
|
||||||
inc(nint,ord(decpoint=0));
|
|
||||||
hd:=hd*10;
|
|
||||||
end;
|
|
||||||
'1'..'9':
|
|
||||||
begin
|
|
||||||
if (decpoint=0) then
|
|
||||||
inc(nint);
|
|
||||||
hd:=hd*10+(ord(s[code])-ord('0'));
|
|
||||||
end;
|
|
||||||
'.':
|
|
||||||
if decpoint=0 then
|
|
||||||
decpoint:=code
|
|
||||||
else
|
|
||||||
exit;
|
|
||||||
else
|
|
||||||
break;
|
|
||||||
end;
|
|
||||||
inc(code);
|
|
||||||
end;
|
|
||||||
{ must have seen at least one digit }
|
|
||||||
if (code-expstart)<1+ord(decpoint<>0) then
|
|
||||||
exit;
|
|
||||||
|
|
||||||
if decpoint<>0 then
|
|
||||||
decpoint:=code-decpoint-1;
|
|
||||||
|
|
||||||
{ Exponent ? }
|
|
||||||
if (length(s)>=code) and (s[code] in ['e','E']) then
|
|
||||||
begin
|
|
||||||
inc(code);
|
|
||||||
if Length(s) >= code then
|
|
||||||
case s[code] of
|
|
||||||
'+': inc(code);
|
|
||||||
'-': begin
|
|
||||||
esign:=-1;
|
|
||||||
inc(code);
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
expstart:=code;
|
|
||||||
{ Limit the exponent, accounting for digits in integer part of mantissa
|
|
||||||
and leading zeros in fractional part, e.g 100.0e306 = 1.0e308, etc. }
|
|
||||||
if (esign<0) then
|
|
||||||
explimit:=valmaxexpnorm+mantissabits-1+nint
|
|
||||||
else if (nint>0) then
|
|
||||||
explimit:=valmaxexpnorm+1-nint
|
|
||||||
else
|
|
||||||
explimit:=valmaxexpnorm+1+nlz;
|
|
||||||
explastdigit:=(explimit mod 10)+ord('0');
|
|
||||||
explimit:=explimit div 10;
|
|
||||||
while (length(s)>=code) and (s[code] in ['0'..'9']) do
|
|
||||||
begin
|
|
||||||
{ Check commented out: since this code is used by compiler, it would error out
|
|
||||||
e.g. if compiling '1e3000' for non-x86 target. OTOH silently treating it
|
|
||||||
as infinity isn't a good option either. }
|
|
||||||
(*
|
|
||||||
if (exponent>explimit) or
|
|
||||||
((exponent=explimit) and (ord(s[code])>explastdigit)) then
|
|
||||||
begin
|
|
||||||
{ ignore exponent overflow for zero mantissa }
|
|
||||||
if hd<>0.0 then
|
|
||||||
exit;
|
|
||||||
end
|
|
||||||
else *)
|
|
||||||
exponent:=exponent*10+(ord(s[code])-ord('0'));
|
|
||||||
inc(code);
|
|
||||||
end;
|
|
||||||
if code=expstart then
|
|
||||||
exit;
|
|
||||||
end;
|
|
||||||
{ Not all characters are read ? }
|
|
||||||
if length(s)>=code then
|
|
||||||
exit;
|
|
||||||
|
|
||||||
{ adjust exponent based on decimal point }
|
|
||||||
dec(exponent,decpoint*esign);
|
|
||||||
if (exponent<0) then
|
|
||||||
begin
|
|
||||||
esign:=-1;
|
|
||||||
exponent:=-exponent;
|
|
||||||
end;
|
|
||||||
|
|
||||||
{ evaluate sign }
|
|
||||||
{ (before exponent, because the exponent may turn it into a denormal) }
|
|
||||||
fpc_Val_Real_ShortStr:=hd*sign;
|
|
||||||
|
|
||||||
{ Calculate Exponent }
|
|
||||||
hd:=1.0;
|
|
||||||
{ 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
|
|
||||||
hd:=mul_by_power10(hd,valmaxexpnorm-2);
|
|
||||||
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;
|
|
||||||
hd:=mul_by_power10(hd,exponent);
|
|
||||||
|
|
||||||
if esign>0 then
|
|
||||||
fpc_Val_Real_ShortStr:=fpc_Val_Real_ShortStr*hd
|
|
||||||
else
|
|
||||||
fpc_Val_Real_ShortStr:=fpc_Val_Real_ShortStr/hd;
|
|
||||||
|
|
||||||
{ success ! }
|
|
||||||
code:=0;
|
|
||||||
end;
|
|
||||||
{$endif}
|
|
||||||
|
|
||||||
{$else not FLOAT_ASCII_FALLBACK}
|
|
||||||
|
|
||||||
{$ifndef FPUNONE}
|
{$ifndef FPUNONE}
|
||||||
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;
|
||||||
begin
|
begin
|
||||||
@ -1916,8 +1569,6 @@ begin
|
|||||||
end;
|
end;
|
||||||
{$endif FPUNONE}
|
{$endif FPUNONE}
|
||||||
|
|
||||||
{$endif FLOAT_ASCII_FALLBACK}
|
|
||||||
|
|
||||||
{$ifndef FPC_STR_ENUM_INTERN}
|
{$ifndef FPC_STR_ENUM_INTERN}
|
||||||
function fpc_val_enum_shortstr(str2ordindex:pointer;const s:shortstring;out code:valsint):longint; [public, alias:'FPC_VAL_ENUM_SHORTSTR']; compilerproc;
|
function fpc_val_enum_shortstr(str2ordindex:pointer;const s:shortstring;out code:valsint):longint; [public, alias:'FPC_VAL_ENUM_SHORTSTR']; compilerproc;
|
||||||
|
|
||||||
|
|||||||
@ -117,9 +117,6 @@ Type
|
|||||||
Real = type Double;
|
Real = type Double;
|
||||||
{$endif}
|
{$endif}
|
||||||
|
|
||||||
{ Can be individually defined/undefined on a per-platform basis }
|
|
||||||
{ define FLOAT_ASCII_FALLBACK}
|
|
||||||
|
|
||||||
{$ifdef CPUI386}
|
{$ifdef CPUI386}
|
||||||
{$define CPU32}
|
{$define CPU32}
|
||||||
|
|
||||||
|
|||||||
@ -86,9 +86,6 @@ Type
|
|||||||
Real = type Double;
|
Real = type Double;
|
||||||
{$endif}
|
{$endif}
|
||||||
|
|
||||||
{ Can be individually defined/undefined on a per-platform basis }
|
|
||||||
{ define FLOAT_ASCII_FALLBACK}
|
|
||||||
|
|
||||||
{$ifdef CPUI386}
|
{$ifdef CPUI386}
|
||||||
{$define CPU32}
|
{$define CPU32}
|
||||||
|
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user