From bc9c4771c0a71e068a95a8ad71a6f98cd3d7f5f1 Mon Sep 17 00:00:00 2001 From: Jonas Maebe Date: Mon, 17 Jan 2000 13:00:51 +0000 Subject: [PATCH] + support for NaN's, cleaner support for Inf --- rtl/inc/real2str.inc | 352 +++++++++++++++++++++++++------------------ 1 file changed, 208 insertions(+), 144 deletions(-) diff --git a/rtl/inc/real2str.inc b/rtl/inc/real2str.inc index 9467f9926e..234d73f956 100644 --- a/rtl/inc/real2str.inc +++ b/rtl/inc/real2str.inc @@ -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,153 +153,191 @@ begin if len=-32767 then len:=maxlen; { determine sign. before precision, needs 2 less calls to abs() } - sign:=d<0; - { the creates a cannot determine which overloaded function to call - if d is extended !!! - we should prefer real_to_real on real_to_longint !! - corrected in compiler } - - { 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; - -{$ifdef FPC_INFINITY_FOR_REAL2STR} -{$ifndef FPC_HAS_INFINITY_CONST} - if d=ValReal(InfArray) then -{$else FPC_HAS_INFINITY_CONST} - if d=Inf then -{$endif FPC_HAS_INFINITY_CONST} - begin - if sign then - s:='-Inf' - else - s:='Inf'; - exit; - end; -{$endif FPC_INFINITY_FOR_REAL2STR} - { determine precision : maximal precision is : } - currprec:=maxlen-explen-3; - { 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) or (d=0) and (len0) and (len=i10 then - begin - il:=i1; - il2:=i10; - repeat - il:=il2; - il2:=il*i10; - inc(correct); - until (d 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 - if (d<1) and (d<>0) then begin - while d<1 do + { the creates a cannot determine which overloaded function to call + if d is extended !!! + we should prefer real_to_real on real_to_longint !! + corrected in compiler } + + { 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; +(* + {$ifdef FPC_INFINITY_FOR_REAL2STR} + {$ifndef FPC_HAS_INFINITY_CONST} + if d=ValReal(InfArray) then + {$else FPC_HAS_INFINITY_CONST} + if d=Inf then + {$endif FPC_HAS_INFINITY_CONST} + begin + if sign then + s:='-Inf' + else + s:='Inf'; + exit; + end; + {$endif FPC_INFINITY_FOR_REAL2STR} +*) + { determine precision : maximal precision is : } + currprec:=maxlen-explen-3; + { 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) or (d=0) and (len0) and (len=i10 then + begin + il:=i1; + il2:=i10; + repeat + il:=il2; + il2:=il*i10; + inc(correct); + until (d0) then + begin + while d<1 do + begin + d:=d*i10; + dec(correct); + end; + end; + { RoundOff } + roundcorr:=extended(i1)/extended(i2); + if f<0 then + for i:=1 to currprec do roundcorr:=roundcorr/i10 + else + begin + if correct+f<0 then + begin + for i:=1 to abs(correct+f) do + roundcorr:=roundcorr*i10; + end + else + begin + for i:=1 to correct+f do + roundcorr:=roundcorr/i10; + end; + end; + d:=d+roundcorr; + { 0.99 + 0.05 > 1.0 ! Fix this by dividing the results >=10 first (PV) } + while (d>=10.0) do + begin + d:=d/i10; + inc(correct); + end; + { Now we have a standard expression : sign d *10^correct + where 1maxexp) then + begin + insert ('.',temp,3); + str(abs(correct),power); + if length(power) 1.0 ! Fix this by dividing the results >=10 first (PV) } - while (d>=10.0) do - begin - d:=d/i10; - inc(correct); - end; - { Now we have a standard expression : sign d *10^correct - where 1maxexp) then - begin - insert ('.',temp,3); - str(abs(correct),power); - if length(power)=0 then - begin - if length(temp)0 then - temp[0]:=chr(pos('.',temp)+f) - else - temp[0]:=chr(pos('.',temp)-1); + 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)0 then + temp[0]:=chr(pos('.',temp)+f) + else + temp[0]:=chr(pos('.',temp)-1); + end; end; if length(temp)