mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-12-11 18:10:47 +01:00
+ support for NaN's, cleaner support for Inf
This commit is contained in:
Jonas Maebe
parent
81f2dbd175
commit
bc9c4771c0
@ -23,7 +23,7 @@ const
|
||||
i10 : longint = 10;
|
||||
i2 : longint = 2;
|
||||
i1 : longint = 1;
|
||||
|
||||
(*
|
||||
{ we can use this conditional if the Inf const is defined
|
||||
in processor specific code PM }
|
||||
{$ifdef FPC_HAS_INFINITY_CONST}
|
||||
@ -60,7 +60,7 @@ const
|
||||
{$warning don't know Infinity values }
|
||||
{$endif not FPC_INFINITY_FOR_REAL2STR}
|
||||
{$endif not FPC_HAS_INFINITY_CONST}
|
||||
|
||||
*)
|
||||
Procedure str_real (len,f : longint; d : ValReal; real_type :treal_type; var s : string);
|
||||
{
|
||||
These numbers are for the double type...
|
||||
@ -76,6 +76,28 @@ const
|
||||
minexp = 1e-35; { Minimum value for decimal expressions }
|
||||
zero = '0000000000000000000000000000000000000000';
|
||||
|
||||
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;
|
||||
|
||||
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;
|
||||
|
||||
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;
|
||||
|
||||
var correct : longint; { Power correction }
|
||||
currprec : longint;
|
||||
il,il2,roundcorr : Valreal;
|
||||
@ -85,6 +107,7 @@ var correct : longint; { Power correction }
|
||||
i : integer;
|
||||
dot : byte;
|
||||
currp : pchar;
|
||||
mantZero, expMaximal: boolean;
|
||||
begin
|
||||
case real_type of
|
||||
rt_s32real :
|
||||
@ -130,7 +153,43 @@ begin
|
||||
if len=-32767 then
|
||||
len:=maxlen;
|
||||
{ determine sign. before precision, needs 2 less calls to abs() }
|
||||
sign:=d<0;
|
||||
{ sign:=d<0;}
|
||||
{$ifndef big_endian}
|
||||
{$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;
|
||||
mantZero := (TSplitExtended(d).cards[0] = 0) and
|
||||
(TSplitExtended(d).cards[1] = 0);
|
||||
{$else SUPPORT_EXTENDED}
|
||||
{$ifdef SUPPORT_DOUBLE}
|
||||
{ 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;
|
||||
mantZero := (TSplitDouble(d).cards[1] and $fffff = 0) and
|
||||
(TSplitDouble(d).cards[0] = 0);
|
||||
{$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;
|
||||
mantZero := (TSplitSingle(d).cards[0] and $7fffff = 0);
|
||||
{$else SUPPORT_SINGLE}
|
||||
{$error No floating type supported for real2str}
|
||||
{$endif SUPPORT_SINGLE}
|
||||
{$endif SUPPORT_DOUBLE}
|
||||
{$endif SUPPORT_EXTENDED}
|
||||
{$else big_endian}
|
||||
{$error NaN/Inf not yet supported for big endian machines in str_real}
|
||||
{$endif big_endian}
|
||||
if expMaximal then
|
||||
if mantZero then
|
||||
if sign then
|
||||
temp := '-Inf'
|
||||
else temp := 'Inf'
|
||||
else temp := 'NaN'
|
||||
else
|
||||
begin
|
||||
{ the creates a cannot determine which overloaded function to call
|
||||
if d is extended !!!
|
||||
we should prefer real_to_real on real_to_longint !!
|
||||
@ -140,13 +199,13 @@ begin
|
||||
{ for the same reason I converted d:=frac(d) to d:=d-int(d); (PM) }
|
||||
if sign then
|
||||
d:=-d;
|
||||
|
||||
{$ifdef FPC_INFINITY_FOR_REAL2STR}
|
||||
{$ifndef FPC_HAS_INFINITY_CONST}
|
||||
(*
|
||||
{$ifdef FPC_INFINITY_FOR_REAL2STR}
|
||||
{$ifndef FPC_HAS_INFINITY_CONST}
|
||||
if d=ValReal(InfArray) then
|
||||
{$else FPC_HAS_INFINITY_CONST}
|
||||
{$else FPC_HAS_INFINITY_CONST}
|
||||
if d=Inf then
|
||||
{$endif FPC_HAS_INFINITY_CONST}
|
||||
{$endif FPC_HAS_INFINITY_CONST}
|
||||
begin
|
||||
if sign then
|
||||
s:='-Inf'
|
||||
@ -154,7 +213,8 @@ begin
|
||||
s:='Inf';
|
||||
exit;
|
||||
end;
|
||||
{$endif FPC_INFINITY_FOR_REAL2STR}
|
||||
{$endif FPC_INFINITY_FOR_REAL2STR}
|
||||
*)
|
||||
{ determine precision : maximal precision is : }
|
||||
currprec:=maxlen-explen-3;
|
||||
{ this is also the maximal number of decimals !!}
|
||||
@ -278,6 +338,7 @@ begin
|
||||
else
|
||||
temp[0]:=chr(pos('.',temp)-1);
|
||||
end;
|
||||
end;
|
||||
if length(temp)<len then
|
||||
s:=space(len-length(temp))+temp
|
||||
else
|
||||
@ -286,7 +347,10 @@ end;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.19 2000-01-07 16:41:36 daniel
|
||||
Revision 1.20 2000-01-17 13:00:51 jonas
|
||||
+ support for NaN's, cleaner support for Inf
|
||||
|
||||
Revision 1.19 2000/01/07 16:41:36 daniel
|
||||
* copyright 2000
|
||||
|
||||
Revision 1.18 1999/11/28 23:57:23 pierre
|
||||
|
||||
Loading…
Reference in New Issue
Block a user