├── Demo ├── JohnHerbster.jpeg ├── T_ExactFloatToStr_0.cfg ├── T_ExactFloatToStr_0.dof ├── T_ExactFloatToStr_0.dpr ├── T_ExactFloatToStr_0_Form.ddp ├── T_ExactFloatToStr_0_Form.dfm └── T_ExactFloatToStr_0_Form.pas ├── ExactFloatToStr_JH0.pas ├── LICENSE └── README.md /Demo/JohnHerbster.jpeg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/JackTrapper/Exact-Float-to-String-Routines/8d02ca730d405ed0aba3668bd51c653c0f41f8b2/Demo/JohnHerbster.jpeg -------------------------------------------------------------------------------- /Demo/T_ExactFloatToStr_0.cfg: -------------------------------------------------------------------------------- 1 | -$A+ 2 | -$B- 3 | -$C+ 4 | -$D+ 5 | -$E- 6 | -$F- 7 | -$G+ 8 | -$H+ 9 | -$I+ 10 | -$J+ 11 | -$K- 12 | -$L+ 13 | -$M- 14 | -$N+ 15 | -$O- 16 | -$P+ 17 | -$Q+ 18 | -$R+ 19 | -$S- 20 | -$T- 21 | -$U- 22 | -$V+ 23 | -$W- 24 | -$X+ 25 | -$YD 26 | -$Z1 27 | -GD 28 | -cg 29 | -AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; 30 | -H+ 31 | -W+ 32 | -M 33 | -$M16384,1048576 34 | -K$00400000 35 | -LE"c:\program files (x86)\borland\delphi5\Projects\Bpl" 36 | -LN"c:\program files (x86)\borland\delphi5\Projects\Bpl" 37 | -------------------------------------------------------------------------------- /Demo/T_ExactFloatToStr_0.dof: -------------------------------------------------------------------------------- 1 | [Compiler] 2 | A=8 3 | B=0 4 | C=1 5 | D=1 6 | E=0 7 | F=0 8 | G=1 9 | H=1 10 | I=1 11 | J=1 12 | K=0 13 | L=1 14 | M=0 15 | N=1 16 | O=0 17 | P=1 18 | Q=1 19 | R=1 20 | S=0 21 | T=0 22 | U=0 23 | V=1 24 | W=0 25 | X=1 26 | Y=1 27 | Z=1 28 | ShowHints=1 29 | ShowWarnings=1 30 | UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; 31 | [Linker] 32 | MapFile=3 33 | OutputObjs=0 34 | ConsoleApp=1 35 | DebugInfo=0 36 | RemoteSymbols=0 37 | MinStackSize=16384 38 | MaxStackSize=1048576 39 | ImageBase=4194304 40 | ExeDescription= 41 | [Directories] 42 | OutputDir= 43 | UnitOutputDir= 44 | PackageDLLOutputDir= 45 | PackageDCPOutputDir= 46 | SearchPath= 47 | Packages=VCL50;VCLX50;TEEQR50;VCLDB50;INET50;INETDB50;VCLBDE50;VCLDBX50;TEEUI50;TEEDB50;TEE50 48 | Conditionals= 49 | DebugSourceDirs= 50 | UsePackages=0 51 | [Parameters] 52 | RunParams= 53 | HostApplication= 54 | [Language] 55 | ActiveLang= 56 | ProjectLang=$00000409 57 | RootDir=C:\Documents and Settings\John Herbster\My Documents\Development\Numbers\ExactFloatToStr\ 58 | [Version Info] 59 | IncludeVerInfo=0 60 | AutoIncBuild=0 61 | MajorVer=1 62 | MinorVer=0 63 | Release=1 64 | Build=0 65 | Debug=0 66 | PreRelease=0 67 | Special=0 68 | Private=0 69 | DLL=0 70 | Locale=1033 71 | CodePage=1252 72 | [Version Info Keys] 73 | CompanyName= 74 | FileDescription= 75 | FileVersion=1.0.1.0 76 | InternalName= 77 | LegalCopyright= 78 | LegalTrademarks= 79 | OriginalFilename= 80 | ProductName= 81 | ProductVersion=1.0.0.0 82 | Comments= 83 | [Excluded Packages] 84 | C:\Program Files\BoldSoft\BfDR40D7Arch\Bin\Bold40D7ComGUI.bpl=Bold for Delphi 4.0 (COM GUI controls) 85 | C:\Program Files\BoldSoft\BfDR40D7Arch\Bin\Bold40D7OLLE.bpl=Bold for Delphi 4.0 Object Lending Library Extension (OLLE) 86 | -------------------------------------------------------------------------------- /Demo/T_ExactFloatToStr_0.dpr: -------------------------------------------------------------------------------- 1 | program T_ExactFloatToStr_0; 2 | 3 | uses 4 | Forms, 5 | T_ExactFloatToStr_0_Form in 'T_ExactFloatToStr_0_Form.pas' {Form1}, 6 | ExactFloatToStr_JH0 in 'ExactFloatToStr_JH0.pas'; 7 | 8 | {$R *.RES} 9 | 10 | begin 11 | Application.Initialize; 12 | Application.CreateForm(TForm1, Form1); 13 | Application.Run; 14 | end. 15 | -------------------------------------------------------------------------------- /Demo/T_ExactFloatToStr_0_Form.ddp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/JackTrapper/Exact-Float-to-String-Routines/8d02ca730d405ed0aba3668bd51c653c0f41f8b2/Demo/T_ExactFloatToStr_0_Form.ddp -------------------------------------------------------------------------------- /Demo/T_ExactFloatToStr_0_Form.dfm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/JackTrapper/Exact-Float-to-String-Routines/8d02ca730d405ed0aba3668bd51c653c0f41f8b2/Demo/T_ExactFloatToStr_0_Form.dfm -------------------------------------------------------------------------------- /Demo/T_ExactFloatToStr_0_Form.pas: -------------------------------------------------------------------------------- 1 | unit T_ExactFloatToStr_0_Form; 2 | 3 | (* ***************************************************************************** 4 | 5 | For Testing ExactFloatToStr and ParseFloat functions. 6 | 7 | Pgm. 12/24/2002 by John Herbster. 8 | 9 | ***************************************************************************** *) 10 | 11 | interface 12 | 13 | uses 14 | Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 15 | StdCtrls; 16 | 17 | type 18 | TForm1 = class(TForm) 19 | Edit1: TEdit; 20 | Convert_b: TButton; 21 | Memo1: TMemo; 22 | ShowDebug_ck: TCheckBox; 23 | CallExVer_ck: TCheckBox; 24 | CkSmallest_b: TButton; 25 | CkDenormal2_b: TButton; 26 | CkSpecials_b: TButton; 27 | SmallestD_b: TButton; 28 | Pi_b: TButton; 29 | CkAnalyzeFloat_b: TButton; 30 | procedure Convert_bClick(Sender: TObject); 31 | procedure FormCreate(Sender: TObject); 32 | procedure Edit1KeyPress(Sender: TObject; var Key: Char); 33 | procedure CkSmallest_bClick(Sender: TObject); 34 | procedure CkDenormal2_bClick(Sender: TObject); 35 | procedure CkSpecials_bClick(Sender: TObject); 36 | procedure SmallestD_bClick(Sender: TObject); 37 | procedure Pi_bClick(Sender: TObject); 38 | procedure CvtToHex_bClick(Sender: TObject); 39 | procedure CkAnalyzeFloat_bClick(Sender: TObject); 40 | private 41 | procedure TestNumber(Value: Extended); 42 | public 43 | procedure Log(const msg: string); 44 | procedure LogFmt(const Fmt: string; const Data: array of const); 45 | end; 46 | 47 | var 48 | Form1: TForm1; 49 | 50 | implementation 51 | 52 | {$R *.DFM} 53 | 54 | uses 55 | ExactFloatToStr_JH0; 56 | 57 | function GetCpuClockCycleCount: Int64; 58 | asm 59 | dw $310F // opcode for RDTSC 60 | end; 61 | 62 | procedure TForm1.Log(const msg: string); 63 | begin 64 | Memo1.Lines.Add(msg); 65 | end; 66 | 67 | procedure TForm1.LogFmt(const Fmt: string; const Data: array of const); 68 | begin 69 | Log(Format(Fmt,Data)); 70 | end; 71 | 72 | procedure TForm1.FormCreate(Sender: TObject); 73 | begin 74 | ShowDebug_ck.Enabled := ExactFloatToStr_JH0.Debug; 75 | Edit1.Text := FloatToStr(1); 76 | end; 77 | 78 | procedure TForm1.TestNumber(Value: Extended); 79 | var 80 | ExtX: packed record Man: Int64; Exp: word end absolute Value; 81 | cc: int64; ValE4K: extended; s: string; 82 | begin 83 | if ShowDebug_ck.Checked then 84 | ExactFloatToStr_JH0.LogFmtX := LogFmt 85 | else 86 | ExactFloatToStr_JH0.LogFmtX := nil; 87 | 88 | if Abs(Value) < 1E-4000 then 89 | begin 90 | ValE4K := Value * 1E4000; 91 | LogFmt('Calling: Exp=$%4.4x, Man=$%16.16x, G=%g, Ge4K=%g', [ExtX.Exp,ExtX.Man,Value,ValE4K]); 92 | end 93 | else 94 | LogFmt('Calling: Exp=$%4.4x, Man=$%16.16x, G=%g', [ExtX.Exp,ExtX.Man,Value]); 95 | 96 | try 97 | cc := GetCpuClockCycleCount; 98 | if CallExVer_ck.Checked then 99 | s := ExactFloatToStrEx(Value) 100 | else 101 | s := ExactFloatToStrEx(Value); 102 | 103 | cc := GetCpuClockCycleCount - cc; 104 | LogFmt(' Required %s clock cycles',[ExactFloatToStr(cc)]); 105 | Log(s); 106 | except 107 | on e:Exception do 108 | LogFmt('Exception: %s',[e.Message]); 109 | end; 110 | end; 111 | 112 | procedure StrToFloatProc(const Str: string; out Value: Extended); 113 | var 114 | s: string; i,j: integer; 115 | begin 116 | s := Str; 117 | j := 0; 118 | for i := 1 to length(s) do 119 | begin 120 | if s[i] in ['-','0'..'9','.','e','E'] then 121 | begin 122 | Inc(j); 123 | s[j] := s[i] 124 | end; 125 | end; 126 | SetLength(s,j); 127 | Value := StrToFloat(s); 128 | end; 129 | 130 | procedure TForm1.Convert_bClick(Sender: TObject); 131 | var 132 | ext: extended; 133 | begin 134 | Screen.Cursor := crHourGlass; 135 | Memo1.Lines.Add(''); 136 | try 137 | StrToFloatProc(Edit1.Text, {out}ext); 138 | TestNumber(ext); 139 | finally 140 | Screen.Cursor := crDefault; 141 | end; 142 | end; 143 | 144 | procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char); 145 | begin 146 | if Key <> ^M then 147 | Exit; 148 | Key := #0; 149 | Convert_bClick(Sender); 150 | end; 151 | 152 | procedure TForm1.CkSmallest_bClick(Sender: TObject); 153 | var 154 | ext: extended; 155 | i: integer; 156 | var 157 | ExtX: packed record Man: Int64; Exp: word end absolute ext; 158 | begin 159 | Memo1.Lines.Add(''); 160 | Screen.Cursor := crHourGlass; 161 | try 162 | ExtX.Exp := 0; ExtX.Man := $0000000000000001; 163 | for i := 1 to 2 do 164 | begin 165 | TestNumber(ext); 166 | ext := ext / 2; 167 | end; 168 | finally 169 | Screen.Cursor := crDefault; 170 | end; 171 | end; 172 | 173 | procedure TForm1.CkDenormal2_bClick(Sender: TObject); 174 | var 175 | ext: extended; i: integer; 176 | var 177 | ExtX: packed record Man: Int64; Exp: word end absolute ext; 178 | ext2: extended; 179 | begin 180 | Memo1.Lines.Add(''); 181 | Screen.Cursor := crHourGlass; 182 | try 183 | ExtX.Exp := 2; ExtX.Man := $8000000000000000; 184 | for i := 1 to 9 do 185 | begin 186 | ext2 := ext*1e4900; 187 | LogFmt('Test #%d: Exp=$%4.4x, Man=$%16.16x, G=%g, G2=%g', [i,ExtX.Exp,ExtX.Man,ext,ext2]); 188 | if (i in [2,3,4]) then 189 | TestNumber(ext); 190 | if i < 5 then 191 | ext := ext / 2 192 | else 193 | ext := ext * 2; 194 | end; 195 | finally 196 | Screen.Cursor := crDefault; 197 | end; 198 | end; 199 | 200 | procedure TForm1.CkSpecials_bClick(Sender: TObject); 201 | var 202 | ext: extended; dbl: double; 203 | ExtX: packed record Man: Int64; Exp: word end absolute ext; 204 | DblX: int64 absolute dbl; 205 | const 206 | NanX = 0/0; 207 | DblSgnX: Int64 = $8000000000000000; {1 bit} 208 | DblExpX: Int64 = $7FF0000000000000; {11 bits} 209 | DblManX: Int64 = $000FFFFFFFFFFFFF; {52 bits (+ 1 = 53)} 210 | begin 211 | Screen.Cursor := crHourGlass; 212 | try 213 | { Test infinities: } 214 | Log(''); 215 | ExtX.Exp := $7FFF; ExtX.Man := $0000000000000000; 216 | Log('+Inf response = ' + ExactFloatToStr(ext)); 217 | ExtX.Exp := $FFFF; ExtX.Man := $0000000000000000; 218 | Log('-Inf response = ' + ExactFloatToStr(ext)); 219 | 220 | { Test indefinite: } 221 | Log(''); 222 | ext := NanX; 223 | LogFmt('Exp=$%4.4x, Man=$%16.16x',[ExtX.Exp,ExtX.Man]); 224 | Log('Indefinite response = ' + ExactFloatToStr(ext)); 225 | dbl := ext; 226 | ext := dbl; 227 | LogFmt('Dbl: Exp=$%3.3x, Man=$%13.13x', [(DblX shr (13*4)),(DblX and DblManX)]); 228 | LogFmt('Ext: Exp=$%4.4x, Man=$%16.16x',[ExtX.Exp,ExtX.Man]); 229 | Log('Indefinite dbl rsp. = ' + ExactFloatToStr(ext)); 230 | 231 | { Test QNANs: } 232 | Log(''); 233 | ExtX.Exp := $7FFF; ExtX.Man := $C100000000000000; 234 | Log('QNAN(1) response = ' + ExactFloatToStr(ext)); 235 | ExtX.Exp := $7FFF; ExtX.Man := $8100000000000000; 236 | Log('SNAN(1) response = ' + ExactFloatToStr(ext)); 237 | finally 238 | Screen.Cursor := crDefault; 239 | end; 240 | end; 241 | 242 | procedure TForm1.SmallestD_bClick(Sender: TObject); 243 | var 244 | d1, d2: double; 245 | begin 246 | Memo1.Lines.Add(''); 247 | d1 := 1; 248 | repeat 249 | d2 := d1; 250 | d1 := d1 / 2; 251 | until d1 = 0; 252 | 253 | Edit1.Text := FloatToStr(d2); 254 | TestNumber(d2); 255 | end; 256 | 257 | procedure TForm1.Pi_bClick(Sender: TObject); 258 | var 259 | ext: extended; d: double; 260 | var 261 | ExtX: packed record Man: Int64; Exp: word end absolute ext; 262 | begin 263 | Memo1.Lines.Add(''); 264 | ext := pi; 265 | Edit1.Text := FloatToStr(ext); 266 | TestNumber(ext); 267 | d := pi; 268 | Edit1.Text := FloatToStr(d); 269 | TestNumber(d); 270 | end; 271 | 272 | procedure TForm1.CvtToHex_bClick(Sender: TObject); 273 | var 274 | ext: extended; 275 | var 276 | ExtX: packed record Man: Int64; Exp: word end absolute ext; 277 | begin 278 | end; 279 | 280 | procedure TForm1.CkAnalyzeFloat_bClick(Sender: TObject); 281 | var 282 | ext, ext2: Extended; 283 | dbl: Double; 284 | sgl: Single; 285 | i: integer; 286 | { Equivalence a record to var ext: } 287 | ExtX: packed record Man: Int64; Exp: word end absolute ext; 288 | DblX: Int64 absolute dbl; SglX: LongInt absolute sgl; s: string; 289 | begin 290 | Assert(SizeOf(ExtX) = SizeOf(ext)); 291 | Assert(SizeOf(DblX) = SizeOf(dbl)); 292 | Assert(SizeOf(SglX) = SizeOf(sgl)); 293 | for i := 0 to 20 do 294 | begin 295 | case i of 296 | 0: 297 | begin 298 | Memo1.Lines.Add(''); 299 | Memo1.Lines.Add('Check simple numbers.'); 300 | ext := 15; 301 | end; 302 | 3: 303 | begin 304 | Memo1.Lines.Add(''); 305 | Memo1.Lines.Add('Check crossover into sgl denormal.'); 306 | { Set ext = 2 * : } 307 | SglX := LongInt(2) shl 23; 308 | ext := sgl; 309 | end; 310 | 7: begin 311 | Memo1.Lines.Add(''); 312 | Memo1.Lines.Add('Check crossover into dbl denormal.'); 313 | { Set ext = 2 * : } 314 | DblX := Int64(2) shl 52; 315 | s := ParseFloat(dbl); 316 | ext := dbl; 317 | end; 318 | 11: 319 | begin 320 | Memo1.Lines.Add(''); 321 | Memo1.Lines.Add('Check crossover into ext denormal.'); 322 | { Set ext = 2 * : } 323 | ExtX.Exp := 2; 324 | ExtX.Man := $8000000000000000; 325 | end; 326 | 15: 327 | begin 328 | Memo1.Lines.Add(''); 329 | Memo1.Lines.Add('Check cross over into zero.'); 330 | { Set ext = 2 * : } 331 | ExtX.Exp := 0; 332 | ExtX.Man := $0000000000000002; 333 | end; 334 | { Divide the number to be analyzed by 2: } 335 | else 336 | ext := ext / 2; 337 | Memo1.Lines.Add(' divide by 2 and check'); 338 | end; 339 | 340 | dbl := ext; 341 | sgl := ext; 342 | 343 | { Set ext2 to same ext value times 10^4900: } 344 | ext2 := ext*1e4900; 345 | 346 | { Save the analysis to memo box: } 347 | Memo1.Lines.Add(Format(' %2.2d: Nbr=%g ((Nbr x 1e4900)=%g)',[i, ext, ext2])); 348 | Memo1.Lines.Add(' ' + ParseFloat(ext) + ' ' + ParseFloat(dbl) + ' ' + ParseFloat(sgl)); 349 | end{i-loop}; 350 | end; 351 | 352 | end. 353 | -------------------------------------------------------------------------------- /ExactFloatToStr_JH0.pas: -------------------------------------------------------------------------------- 1 | unit ExactFloatToStr_JH0; 2 | 3 | (* ***************************************************************************** 4 | 5 | This module includes 6 | (a) functions for converting a floating binary point number to its 7 | *exact* decimal representation in an AnsiString; 8 | (b) functions for parsing the floating point types into sign, exponent, 9 | and mantissa; and 10 | (c) function for analyzing a extended float number into its type (zero, 11 | normal, infinity, etc.) 12 | 13 | Its intended use is for trouble shooting problems with floating point numbers. 14 | 15 | This code uses dynamic arrays, overloaded calls, and optional parameters. 16 | 17 | These routines are not very optimized for speed or space. 18 | I plan to replace the individual bit-shifts and multiplies-by-ten with multiple versions of same. 19 | Consider making an object so that the arrays don't have to reallocated so often. 20 | And consider making an output buffer character array so that the Result will be allocated only once. 21 | 22 | Rev. 6/21/2018 Updated to Unicode strings and code cleanup 23 | Rev. 1/1/2003 by JFH to add the three ParseFloat functions. 24 | Rev. 12/26/2002 by JFH to bracket the DEBUG code with conditionals. 25 | Rev. 12/25/2002 by JFH to fix 1E20 (BinExp) problem and check for zero and other special values. 26 | Pgm. 12/24/2002 by John Herbster for Delphi programmers everywhere. 27 | 28 | ***************************************************************************** *) 29 | 30 | { Turn DEBUG on to make available detail debugging at expense of speed.} 31 | {DEFINE DEBUG} 32 | 33 | interface 34 | 35 | uses 36 | SysUtils, Winapi.Windows; 37 | 38 | 39 | // This call uses the global DecimalSeparator and ThousandSeparator. It can be slow for very large or very small extended numbers.) 40 | function ExactFloatToStr(const Value: Extended): string; overload; inline; 41 | function ExactFloatToStr(const Value: Extended; const AFormatSettings: TFormatSettings): string; overload; 42 | 43 | function ExactFloatToStrEx(const Value: Extended; DecimalPoint: string='.'; ThousandsSep: string=''; DigitGroups: Integer=0): string; 44 | 45 | 46 | // These calls parse a float value to its sign, exponent, and mantissa. 47 | function ParseFloat(const Value: Extended): string; overload; 48 | function ParseFloat(const Value: Double): string; overload; 49 | function ParseFloat(const Value: Single): string; overload; 50 | 51 | // This is the basic conversion engine. 52 | function FloatingBinPointToDecStr(const Value; const ValNbrBits, ValBinExp: integer; Negative: Boolean; 53 | DecimalPoint: string='.'; ThousandsSep: string=''; DigitGroups: Integer=0): string; 54 | 55 | type 56 | TTypeFloat = (tfUnknown, tfNormal, tfZero, tfDenormal, tfIndefinite, tfInfinity, tfQuietNan, tfSignalingNan); 57 | 58 | procedure AnalyzeFloat(const Value: Extended; out NumberType: TTypeFloat; out Negative: Boolean; out Exponent: Word; out Mantissa: Int64); 59 | 60 | 61 | const 62 | //Different spaces you can use for digit grouping. SI recommends ThinSpace 63 | ThinSpace: WideChar = #$2009; // U+2009 THIN SPACE 64 | NarrowNoBreakSpace: WideChar = #$202F; // U+202F NARROW NO-BREAK SPACE 65 | FigureSpace: WideChar = #$2007; // U+2007 FIGURE SPACE 66 | 67 | 68 | var 69 | LogFmtX: procedure(const Fmt: AnsiString; const Data: array of const) of object; 70 | 71 | implementation 72 | 73 | type 74 | TSglWord = Word; //Consider Byte or Word 75 | TDblWord = LongWord; //Consider Word or LongWord 76 | 77 | TExtendedFloat = packed record 78 | Man: Int64; //Mantissa 79 | Exp: Word; //Sign and Exponent 80 | end; 81 | 82 | const 83 | // SizeOfAryElem = SizeOf(TSglWord); 84 | BitsInBufElem = SizeOf(TSglWord) * 8; // SizeOfAryElem*8; 85 | 86 | var 87 | SPositiveSign: string = '+'; // LOCALE_SPOSITIVESIGN, at most 4 characters 88 | SNegativeSign: string = '-'; // LOCALE_SNEGATIVESIGN, at most 4 characters 89 | SPosInfinity: string = 'Infinity'; // LOCALE_SPOSINFINITY 90 | SNegInfinity: string = '-Infinity'; // LOCALE_SNEGINFINITY 91 | SNativeDigits: array[0..9] of Char = '0123456789'; // LOCALE_SNATIVEDIGITS 92 | INegNumber: Integer = 1; // LOCALE_INEGNUMBER 0 = "(1.1), 1 = "-1.1", 2 = "- 1.1", 3 = "1.1-", 4 = "1.1 -" 93 | SGrouping: string = '3;0'; // LOCALE_SGROUPING 94 | 95 | {$IFDEF DEBUG} 96 | 97 | procedure LogFmt(const Fmt: AnsiString; const Data: array of const); 98 | begin 99 | if Assigned(LogFmtX) then 100 | LogFmtX(Fmt, Data); 101 | end; 102 | {$ENDIF} 103 | 104 | procedure MultiplyAndAdd(Multiplican, Multiplier, CarryIn: TSglWord; var CarryOut, Product: TSglWord); 105 | var 106 | Tmp: packed record case byte of 0: (W: TDblWord); 1: (L, H: TSglWord); end; 107 | begin 108 | Tmp.W := Multiplican * Multiplier + CarryIn; 109 | CarryOut := Tmp.H; 110 | Product := Tmp.L; 111 | end; 112 | 113 | function DivideAndRemainder(NumeratorHi, NumeratorLo: TSglWord; Divisor: TSglWord; var Quotient, Remainder: TSglWord): Boolean; 114 | var 115 | Tmp1, Tmp2: packed record case byte of 0: (W: TDblWord); 1: (L, H: TSglWord); end; 116 | begin 117 | Result := (Divisor <> 0); 118 | if Result then 119 | begin 120 | Tmp1.H := NumeratorHi; 121 | Tmp1.L := NumeratorLo; 122 | Tmp2.W := Tmp1.W div Divisor; 123 | if (Tmp2.H <> 0) then 124 | Result := False 125 | else 126 | begin 127 | Quotient := Tmp2.L; 128 | Remainder := Tmp1.W mod Divisor; 129 | end; 130 | end; 131 | end; 132 | 133 | function AddSign(const s: string; IsNegative: Boolean): string; 134 | begin 135 | { 136 | LOCALE_INEGNUMBER 137 | 0 = "(1.1) 138 | 1 = "-1.1" 139 | 2 = "- 1.1" 140 | 3 = "1.1-" 141 | 4 = "1.1 -" 142 | } 143 | if IsNegative then 144 | begin 145 | case INegNumber of 146 | 0: Result := '(' + s + ')'; // "(1.1)" 147 | 1: Result := SNegativeSign + s; // "-1.1" 148 | 2: Result := SNegativeSign + ' ' + s; // "- 1.1" 149 | 3: Result := s + SNegativeSign; // "1.1-" 150 | 4: Result := s + ' ' + SNegativeSign; // "1.1 -" 151 | else 152 | Result := SNegativeSign + s; 153 | end 154 | end 155 | else 156 | begin 157 | case INegNumber of 158 | 0: Result := s; // "(1.1)" 159 | 1: Result := SPositiveSign + s; // "-1.1" 160 | 2: Result := SPositiveSign + ' ' + s; // "- 1.1" 161 | 3: Result := s + SPositiveSign; // "1.1-" 162 | 4: Result := s + ' ' + SPositiveSign; // "1.1 -" 163 | else 164 | Result := SPositiveSign + s; 165 | end 166 | end; 167 | end; 168 | 169 | function FloatingBinPointToDecStr(const Value; const ValNbrBits, ValBinExp: integer; Negative: Boolean; 170 | DecimalPoint: string = '.'; ThousandsSep: string = ''; DigitGroups: Integer=0): string; 171 | var 172 | Man: array of TSglWord; 173 | CryE: TSglWord; 174 | Cry: TDblWord; 175 | NbrManElem: Integer; 176 | BinExp: Integer; // neg of # binary fraction bits 177 | DecExp: Integer; // neg of # decimal fraction bits 178 | NbrDecFraDigits: Integer; 179 | i, j, Tmp: integer; 180 | c: Char; 181 | Tmp1: packed record case byte of 0: (W: TDblWord); 1: (L, H: TSglWord); end; 182 | 183 | {$IFDEF DEBUG} 184 | procedure LogManExp(const Rem: string); 185 | var 186 | s: string; 187 | k: integer; 188 | begin 189 | LogFmt('%s: BinExp=%d, DecExp=%d, NbrManElem=%d', [Rem, BinExp, DecExp, NbrManElem]); 190 | s := ''; 191 | for k := 0 to NbrManElem - 1 do 192 | s := Format(' %2.2x', [Man[k]]) + s; 193 | LogFmt(' %s', [s]); 194 | end; 195 | {$ENDIF} 196 | 197 | begin 198 | { 199 | Value = Mantissa * 2^BinExp * 10^DecExp 200 | } 201 | 202 | { Load Mantissa and binary exponent: } 203 | NbrManElem := (ValNbrBits + BitsInBufElem - 1) div BitsInBufElem; 204 | SetLength(Man, NbrManElem); 205 | Move(Value, Man[0], (ValNbrBits + 7) div 8); {Assuming little endian input} 206 | 207 | { Set exponents: (Value = Mantissa * 2^BinExp * 10^DecExp) } 208 | BinExp := ValBinExp; 209 | DecExp := 0; 210 | 211 | { Reduce mantissa to mininum number of bits (i.e. while mantissa is odd, div by 2 and inc binary exponent): } 212 | {$IFDEF DEBUG} 213 | LogManExp('Before trimming'); 214 | {$ENDIF} 215 | while (NbrManElem > 0) and (BinExp < 0) and not Odd(Man[0]) do 216 | begin 217 | Cry := 0; 218 | for i := NbrManElem - 1 downto 0 do 219 | begin 220 | Tmp := (Cry shl BitsInBufElem) or Man[i]; 221 | Man[i] := (Tmp shr 1); 222 | Cry := Tmp and 1; 223 | end; 224 | Inc(BinExp); 225 | {$IFDEF DEBUG} 226 | LogManExp('Shifting down'); 227 | {$ENDIF} 228 | if Man[NbrManElem - 1] = 0 then 229 | Dec(NbrManElem); 230 | end{while}; 231 | 232 | { Check for zero: } 233 | if NbrManElem = 0 then 234 | begin 235 | Result := AddSign(Result, Negative); 236 | Exit; 237 | end; 238 | 239 | { 240 | Repeatably multiply by 10 until there is no more fraction. Decrement the DecExp at the same time. 241 | Note that a multiply by 10 is same as mul. by 5 and inc of BinExp exponent. 242 | Also note that a multiply by 5 adds two or three bits to number of mantissa bits. 243 | } 244 | NbrDecFraDigits := -BinExp; {Observe! 0.5, 0.25, 0.125, 0.0625, 0.03125, ...} 245 | i := NbrManElem + (3 * NbrDecFraDigits + BitsInBufElem - 1) div BitsInBufElem; 246 | if length(Man) < i then 247 | SetLength(Man, i); 248 | {$IFDEF DEBUG} 249 | LogManExp('Prep mul out'); 250 | {$ENDIF} 251 | for i := 1 to NbrDecFraDigits do 252 | begin 253 | CryE := 0; 254 | for j := 0 to NbrManElem - 1 do 255 | MultiplyAndAdd(Man[j], 5, CryE, CryE, Man[j]); // MultiplyAndAdd(Multiplican, Multiplier, CryIn: tSglWord; var CryOut, Product: tSglWord); 256 | if CryE <> 0 then 257 | begin 258 | Inc(NbrManElem); 259 | Man[NbrManElem - 1] := CryE; 260 | end; 261 | Inc(BinExp); 262 | Dec(DecExp); 263 | {$IFDEF DEBUG} 264 | LogManExp('Mul out'); 265 | {$ENDIF} 266 | end{i-loop}; 267 | 268 | {$IFDEF DEBUG} 269 | LogManExp('Finished multiplies'); 270 | {$ENDIF} 271 | 272 | { Finish reducing BinExp to 0 by shifting mantissa up: } 273 | while (BinExp > 0) do 274 | begin 275 | Cry := 0; 276 | for i := 0 to NbrManElem - 1 do 277 | begin 278 | Tmp1.W := Man[i] shl 1; 279 | Man[i] := Tmp1.L + Cry; 280 | Cry := Tmp1.H; 281 | end; 282 | Dec(BinExp); 283 | if Cry <> 0 then 284 | begin 285 | Inc(NbrManElem); 286 | if length(Man) < NbrManElem then 287 | SetLength(Man, NbrManElem); 288 | Man[NbrManElem - 1] := Cry; 289 | end; 290 | {$IFDEF DEBUG} 291 | LogManExp('Shifting up'); 292 | {$ENDIF} 293 | end{while}; 294 | 295 | { Repeatably divide by 10 and use remainders to create decimal AnsiString: } 296 | Result := ''; {DEBUG} 297 | 298 | {$IFDEF DEBUG} 299 | LogManExp('Before division'); 300 | {$ENDIF} 301 | repeat 302 | { If not first then place separators: } 303 | if Result <> '' then 304 | begin 305 | if DecExp = 0 then 306 | Result := DecimalPoint + Result 307 | else if (DigitGroups = 5) and ((DecExp mod 5) = 0) then 308 | Result := ThousandsSep + Result 309 | else if (DigitGroups = 3) and ((DecExp mod 3) = 0) then 310 | Result := ThousandsSep + Result 311 | end; 312 | 313 | { DivideAndRemainder mantissa array by 10: } 314 | CryE := 0; 315 | for i := NbrManElem - 1 downto 0 do 316 | DivideAndRemainder(CryE, Man[i], 10, Man[i], CryE); // DivideAndRemainder(NumeratorHi, NumeratorLo: Byte; Divisor: Byte; var Quotient, Remainder: Byte): boolean; 317 | 318 | Inc(DecExp); 319 | c := SNativeDigits[CryE]; 320 | Result := c + Result; 321 | if (NbrManElem > 0) and (Man[NbrManElem - 1] = 0) then 322 | Dec(NbrManElem); 323 | until (DecExp > 0) and (NbrManElem = 0); 324 | 325 | Result := AddSign(Result, Negative); 326 | end; 327 | 328 | procedure AnalyzeFloat(const Value: Extended; out NumberType: TTypeFloat; out Negative: Boolean; out Exponent: Word; out Mantissa: Int64); 329 | var 330 | ValueRec: TExtendedFloat absolute Value; 331 | begin 332 | Mantissa := ValueRec.Man; 333 | Negative := (ValueRec.Exp and $8000) <> 0; 334 | Exponent := (ValueRec.Exp and $7FFF); 335 | 336 | if (Exponent = $7FFF) then 337 | begin 338 | if (Mantissa = 0) then 339 | NumberType := tfInfinity 340 | else 341 | begin 342 | Mantissa := (Mantissa and $3FFFFFFFFFFFFFFF); 343 | if ((ValueRec.Man and $4000000000000000) = 0) then 344 | NumberType := tfSignalingNan 345 | else if (Mantissa = 0) then 346 | NumberType := tfIndefinite 347 | else 348 | NumberType := tfQuietNan 349 | end 350 | end 351 | else if (Exponent = 0) then 352 | begin 353 | if (Mantissa = 0) then 354 | NumberType := tfZero 355 | else 356 | NumberType := tfDenormal 357 | end 358 | else 359 | NumberType := tfNormal; 360 | end; 361 | 362 | function ExactFloatToStrEx(const Value: Extended; DecimalPoint: string; ThousandsSep: string; DigitGroups: Integer): string; 363 | var 364 | NumberType: TTypeFloat; 365 | Negative: Boolean; 366 | Exponent: Word; 367 | Mantissa: Int64; 368 | const 369 | BIAS = $3FFF; 370 | 371 | function IsSpace(const s: string): Boolean; 372 | begin 373 | Result := False; 374 | if Length(s) <> 1 then 375 | Exit; 376 | 377 | case Word(s[1]) of 378 | $00A0, $1680, $2000, $2001, $2002, $2003, $2004, $2005, 379 | $2006, $2007, $2008, $2009, $200A, $202F, $205F, $3000: Result := True; 380 | end; 381 | end; 382 | 383 | begin 384 | { 385 | ThousandsSep: 386 | ' ': group digits in groups of 5 387 | '', #0: no digit grouping 388 | } 389 | AnalyzeFloat(Value, {out}NumberType, {out}Negative, {out}Exponent, {out}Mantissa); 390 | 391 | //Convert legacy #0 char to an actual empty string. 392 | if ThousandsSep = #0 then 393 | ThousandsSep := ''; 394 | 395 | // If a ThousandsSeparator is present, but the DigitGroups parameter is zero, then auto-guess grouping 396 | // (Because why else would you specify a separator if you didn't want one) 397 | if (DigitGroups=0) and (ThousandsSep <> '') then 398 | begin 399 | if IsSpace(ThousandsSep) then 400 | digitGroups := 5 401 | else 402 | digitGroups := 3; 403 | end; 404 | 405 | case NumberType of 406 | tfNormal: Result := FloatingBinPointToDecStr(Mantissa, {NbrBits}64, {BinExp}(Exponent - BIAS) - 63, Negative, DecimalPoint, ThousandsSep, DigitGroups); 407 | tfDenormal: Result := FloatingBinPointToDecStr(Mantissa, {NbrBits}64, {BinExp}(-BIAS - 62), Negative, DecimalPoint, ThousandsSep, DigitGroups); 408 | tfQuietNan: Result := Format('QNaN(%d)', [Mantissa]); 409 | tfSignalingNan: Result := Format('SNaN(%d)', [Mantissa]); 410 | tfZero: Result := AddSign('0', Negative); 411 | tfIndefinite: Result := 'Indefinite'; 412 | tfInfinity: 413 | begin 414 | if Negative then 415 | Result := SPosInfinity 416 | else 417 | Result := SNegInfinity; 418 | end; 419 | else 420 | Result := 'UnknownNumberType'; 421 | end; 422 | end; 423 | 424 | function ExactFloatToStr(const Value: Extended): string; 425 | begin 426 | Result := ExactFloatToStr(Value, FormatSettings); 427 | end; 428 | 429 | function ExactFloatToStr(const Value: Extended; const AFormatSettings: TFormatSettings): string; overload; 430 | var 431 | digitGroups: Integer; 432 | begin 433 | { 434 | Handling groups is fairly difficult. 435 | 436 | Specification Resulting string 437 | 3;0 3,000,000,000,000 438 | 3;2;0 30,00,00,00,00,000 439 | 3 3000000000,000 440 | 3;2 30000000,00,000 441 | 442 | We'll just read the first digit 443 | } 444 | digitGroups := 0; 445 | if SGrouping <> '' then 446 | begin 447 | case SGrouping[1] of 448 | '0'..'9': digitGroups := Ord(SGrouping[1]) - Ord('0'); 449 | end; 450 | end; 451 | 452 | Result := ExactFloatToStrEx(Value, AFormatSettings.DecimalSeparator, AFormatSettings.ThousandSeparator, digitGroups); 453 | end; 454 | 455 | function ParseFloat(const Value: Extended): string; 456 | var 457 | ValueRec: TExtendedFloat absolute Value; 458 | const 459 | PN: array[Boolean] of Char = '+-'; 460 | begin 461 | // This call parses an extended value to its sign, exponent, and mantissa. 462 | Result := Format('Ext(Sgn="%s",Exp=$%4.4x,Man=$%16.16x)', [ 463 | PN[(ValueRec.Exp and $8000) <> 0], 464 | ( ValueRec.Exp and $7FFF), 465 | ValueRec.Man]); 466 | end; 467 | 468 | function ParseFloat(const Value: Double): string; 469 | var 470 | ValueRec: Int64 absolute Value; 471 | const 472 | PN: array [Boolean] of Char = '+-'; 473 | begin 474 | // This call parses a double value to its sign, exponent, and mantissa. 475 | Result := Format('Dbl(Sgn="%s",Exp=$%3.3x,Man=$%13.13x)', [ 476 | PN[(ValueRec and $8000000000000000) <> 0], 477 | (( ValueRec and $7FF0000000000000) shr 52), 478 | ( ValueRec and $000FFFFFFFFFFFFF)]); 479 | end; 480 | 481 | function ParseFloat(const Value: Single): string; 482 | var 483 | ValueRec: LongInt absolute Value; 484 | const 485 | PN: array [Boolean] of Char = '+-'; 486 | begin 487 | { This call parses a single value to its sign, exponent, and mantissa. } 488 | Result := Format('Sgl(Sgn="%s",Exp=$%2.2x,Man=$%6.6x)', 489 | [PN[(ValueRec and $80000000) <> 0], 490 | (( ValueRec and $7F800000) shr 23), 491 | ( ValueRec and $007FFFFF)]); 492 | end; 493 | 494 | procedure InitFormatSettings; 495 | var 496 | localeID: LCID; 497 | s: string; 498 | const 499 | //Windows Vista 500 | LOCALE_SPOSINFINITY = $0000006a; // + Infinity, eg "infinity" 501 | LOCALE_SNEGINFINITY = $0000006b; // - Infinity, eg "-infinity" 502 | begin 503 | localeID := LOCALE_USER_DEFAULT; 504 | 505 | SPositiveSign := GetLocaleStr(localeID, LOCALE_SPOSITIVESIGN, '+'); // at most 4 characters 506 | SNegativeSign := GetLocaleStr(localeID, LOCALE_SNEGATIVESIGN, '-'); // at most 4 characters 507 | SPosInfinity := GetLocaleStr(localeID, LOCALE_SPOSINFINITY, 'Infinity'); // 508 | SNegInfinity := GetLocaleStr(localeID, LOCALE_SNEGINFINITY, '-Infinity'); // 509 | SGrouping := GetLocaleStr(localeID, LOCALE_SGROUPING, '3;0'); // 510 | 511 | INegNumber := StrToIntDef(GetLocaleStr(localeID, LOCALE_INEGNUMBER, '1'), 1); 512 | 513 | s := GetLocaleStr(localeID, LOCALE_SNATIVEDIGITS, '0123456789'); 514 | if Length(s) = 10 then 515 | Move(s[1], SNativeDigits[0], 10*SizeOf(Char)); 516 | end; 517 | 518 | initialization 519 | InitFormatSettings; 520 | 521 | end. 522 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | This is free and unencumbered software released into the public domain. 2 | 3 | Anyone is free to copy, modify, publish, use, compile, sell, or 4 | distribute this software, either in source code form or as a compiled 5 | binary, for any purpose, commercial or non-commercial, and by any 6 | means. 7 | 8 | In jurisdictions that recognize copyright laws, the author or authors 9 | of this software dedicate any and all copyright interest in the 10 | software to the public domain. We make this dedication for the benefit 11 | of the public at large and to the detriment of our heirs and 12 | successors. We intend this dedication to be an overt act of 13 | relinquishment in perpetuity of all present and future rights to this 14 | software under copyright law. 15 | 16 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 17 | EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 18 | MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. 19 | IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR 20 | OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, 21 | ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR 22 | OTHER DEALINGS IN THE SOFTWARE. 23 | 24 | For more information, please refer to 25 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Exact-Float-to-String-Routines 2 | Converts extended number to *exact* decimal representation. Other routines analyze and parse the sign, exponent, and mantissa into number type and hex string values. 3 | 4 | Description 5 | ------------ 6 | 7 | This module includes 8 | 9 | - functions for converting a floating binary point number to its *exact* decimal representation in an AnsiString; 10 | - functions for parsing the floating point types into sign, exponent, and mantissa; and 11 | - function for analyzing a extended float number into its type (zero, normal, infinity, etc.) 12 | 13 | Its intended use is for trouble shooting problems with floating point numbers. 14 | 15 | This code uses dynamic arrays, overloaded calls, and optional parameters 16 | 17 | Sample Usage 18 | ------------ 19 | 20 | ExactFloatToStr(0.28); //convert using current locale 21 | 22 | Returns *(for en-US)*: 23 | 24 | +0.280,000,000,000,000,000,001,084,202,172,485,504,434,007,452,800,869,941,711,425,781,25 25 | 26 | You can customize the digit separator, and the grouping: 27 | 28 | ExactFloatToStrEx(0.28, FormatSettings.DecimalSeparator, 0); 29 | +0.28000000000000000000108420217248550443400745280086994171142578125 30 | 31 | ExactFloatToStrEx(0.28, ' ', 5); 32 | +0.28000 00000 00000 00000 10842 02172 48550 44340 07452 80086 99417 11425 78125 33 | 34 | 35 | Created by [John Herbster](https://cc.embarcadero.com/Item.aspx?id=19421) 36 | --------------------------------------------------------------------------------