1------------------------------------------------------------------------------ 2-- -- 3-- GNAT RUNTIME COMPONENTS -- 4-- -- 5-- A D A . T E X T _ I O . F I X E D _ I O -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 1992-2003 Free Software Foundation, Inc. -- 10-- -- 11-- GNAT is free software; you can redistribute it and/or modify it under -- 12-- terms of the GNU General Public License as published by the Free Soft- -- 13-- ware Foundation; either version 2, or (at your option) any later ver- -- 14-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- 15-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- 16-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- 17-- for more details. You should have received a copy of the GNU General -- 18-- Public License distributed with GNAT; see file COPYING. If not, write -- 19-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- 20-- MA 02111-1307, USA. -- 21-- -- 22-- As a special exception, if other files instantiate generics from this -- 23-- unit, or you link this unit with other files to produce an executable, -- 24-- this unit does not by itself cause the resulting executable to be -- 25-- covered by the GNU General Public License. This exception does not -- 26-- however invalidate any other reasons why the executable file might be -- 27-- covered by the GNU Public License. -- 28-- -- 29-- GNAT was originally developed by the GNAT team at New York University. -- 30-- Extensive contributions were provided by Ada Core Technologies Inc. -- 31-- -- 32------------------------------------------------------------------------------ 33 34-- Fixed point I/O 35-- --------------- 36 37-- The following documents implementation details of the fixed point 38-- input/output routines in the GNAT run time. The first part describes 39-- general properties of fixed point types as defined by the Ada 95 standard, 40-- including the Information Systems Annex. 41 42-- Subsequently these are reduced to implementation constraints and the impact 43-- of these constraints on a few possible approaches to I/O are given. 44-- Based on this analysis, a specific implementation is selected for use in 45-- the GNAT run time. Finally, the chosen algorithm is analyzed numerically in 46-- order to provide user-level documentation on limits for range and precision 47-- of fixed point types as well as accuracy of input/output conversions. 48 49-- ------------------------------------------- 50-- - General Properties of Fixed Point Types - 51-- ------------------------------------------- 52 53-- Operations on fixed point values, other than input and output, are not 54-- important for the purposes of this document. Only the set of values that a 55-- fixed point type can represent and the input and output operations are 56-- significant. 57 58-- Values 59-- ------ 60 61-- Set set of values of a fixed point type comprise the integral 62-- multiples of a number called the small of the type. The small can 63-- either be a power of ten, a power of two or (if the implementation 64-- allows) an arbitrary strictly positive real value. 65 66-- Implementations need to support fixed-point types with a precision 67-- of at least 24 bits, and (in order to comply with the Information 68-- Systems Annex) decimal types need to support at least digits 18. 69-- For the rest, however, no requirements exist for the minimal small 70-- and range that need to be supported. 71 72-- Operations 73-- ---------- 74 75-- 'Image and 'Wide_Image (see RM 3.5(34)) 76 77-- These attributes return a decimal real literal best approximating 78-- the value (rounded away from zero if halfway between) with a 79-- single leading character that is either a minus sign or a space, 80-- one or more digits before the decimal point (with no redundant 81-- leading zeros), a decimal point, and N digits after the decimal 82-- point. For a subtype S, the value of N is S'Aft, the smallest 83-- positive integer such that (10**N)*S'Delta is greater or equal to 84-- one, see RM 3.5.10(5). 85 86-- For an arbitrary small, this means large number arithmetic needs 87-- to be performed. 88 89-- Put (see RM A.10.9(22-26)) 90 91-- The requirements for Put add no extra constraints over the image 92-- attributes, although it would be nice to be able to output more 93-- than S'Aft digits after the decimal point for values of subtype S. 94 95-- 'Value and 'Wide_Value attribute (RM 3.5(40-55)) 96 97-- Since the input can be given in any base in the range 2..16, 98-- accurate conversion to a fixed point number may require 99-- arbitrary precision arithmetic if there is no limit on the 100-- magnitude of the small of the fixed point type. 101 102-- Get (see RM A.10.9(12-21)) 103 104-- The requirements for Get are identical to those of the Value 105-- attribute. 106 107-- ------------------------------ 108-- - Implementation Constraints - 109-- ------------------------------ 110 111-- The requirements listed above for the input/output operations lead to 112-- significant complexity, if no constraints are put on supported smalls. 113 114-- Implementation Strategies 115-- ------------------------- 116 117-- * Float arithmetic 118-- * Arbitrary-precision integer arithmetic 119-- * Fixed-precision integer arithmetic 120 121-- Although it seems convenient to convert fixed point numbers to floating- 122-- point and then print them, this leads to a number of restrictions. 123-- The first one is precision. The widest floating-point type generally 124-- available has 53 bits of mantissa. This means that Fine_Delta cannot 125-- be less than 2.0**(-53). 126 127-- In GNAT, Fine_Delta is 2.0**(-63), and Duration for example is a 128-- 64-bit type. It would still be possible to use multi-precision 129-- floating-point to perform calculations using longer mantissas, 130-- but this is a much harder approach. 131 132-- The base conversions needed for input and output of (non-decimal) 133-- fixed point types can be seen as pairs of integer multiplications 134-- and divisions. 135 136-- Arbitrary-precision integer arithmetic would be suitable for the job 137-- at hand, but has the draw-back that it is very heavy implementation-wise. 138-- Especially in embedded systems, where fixed point types are often used, 139-- it may not be desirable to require large amounts of storage and time 140-- for fixed I/O operations. 141 142-- Fixed-precision integer arithmetic has the advantage of simplicity and 143-- speed. For the most common fixed point types this would be a perfect 144-- solution. The downside however may be a too limited set of acceptable 145-- fixed point types. 146 147-- Extra Precision 148-- --------------- 149 150-- Using a scaled divide which truncates and returns a remainder R, 151-- another E trailing digits can be calculated by computing the value 152-- (R * (10.0**E)) / Z using another scaled divide. This procedure 153-- can be repeated to compute an arbitrary number of digits in linear 154-- time and storage. The last scaled divide should be rounded, with 155-- a possible carry propagating to the more significant digits, to 156-- ensure correct rounding of the unit in the last place. 157 158-- An extension of this technique is to limit the value of Q to 9 decimal 159-- digits, since 32-bit integers can be much more efficient than 64-bit 160-- integers to output. 161 162with Interfaces; use Interfaces; 163with System.Arith_64; use System.Arith_64; 164with System.Img_Real; use System.Img_Real; 165with Ada.Text_IO; use Ada.Text_IO; 166with Ada.Text_IO.Float_Aux; 167with Ada.Text_IO.Generic_Aux; 168 169package body Ada.Text_IO.Fixed_IO is 170 171 -- Note: we still use the floating-point I/O routines for input of 172 -- ordinary fixed-point and output using exponent format. This will 173 -- result in inaccuracies for fixed point types with a small that is 174 -- not a power of two, and for types that require more precision than 175 -- is available in Long_Long_Float. 176 177 package Aux renames Ada.Text_IO.Float_Aux; 178 179 Extra_Layout_Space : constant Field := 5 + Num'Fore; 180 -- Extra space that may be needed for output of sign, decimal point, 181 -- exponent indication and mandatory decimals after and before the 182 -- decimal point. A string with length 183 184 -- Fore + Aft + Exp + Extra_Layout_Space 185 186 -- is always long enough for formatting any fixed point number. 187 188 -- Implementation of Put routines 189 190 -- The following section describes a specific implementation choice for 191 -- performing base conversions needed for output of values of a fixed 192 -- point type T with small T'Small. The goal is to be able to output 193 -- all values of types with a precision of 64 bits and a delta of at 194 -- least 2.0**(-63), as these are current GNAT limitations already. 195 196 -- The chosen algorithm uses fixed precision integer arithmetic for 197 -- reasons of simplicity and efficiency. It is important to understand 198 -- in what ways the most simple and accurate approach to fixed point I/O 199 -- is limiting, before considering more complicated schemes. 200 201 -- Without loss of generality assume T has a range (-2.0**63) * T'Small 202 -- .. (2.0**63 - 1) * T'Small, and is output with Aft digits after the 203 -- decimal point and T'Fore - 1 before. If T'Small is integer, or 204 -- 1.0 / T'Small is integer, let S = T'Small and E = 0. For other T'Small, 205 -- let S and E be integers such that S / 10**E best approximates T'Small 206 -- and S is in the range 10**17 .. 10**18 - 1. The extra decimal scaling 207 -- factor 10**E can be trivially handled during final output, by adjusting 208 -- the decimal point or exponent. 209 210 -- Convert a value X * S of type T to a 64-bit integer value Q equal 211 -- to 10.0**D * (X * S) rounded to the nearest integer. 212 -- This conversion is a scaled integer divide of the form 213 214 -- Q := (X * Y) / Z, 215 216 -- where all variables are 64-bit signed integers using 2's complement, 217 -- and both the multiplication and division are done using full 218 -- intermediate precision. The final decimal value to be output is 219 220 -- Q * 10**(E-D) 221 222 -- This value can be written to the output file or to the result string 223 -- according to the format described in RM A.3.10. The details of this 224 -- operation are omitted here. 225 226 -- A 64-bit value can contain all integers with 18 decimal digits, but 227 -- not all with 19 decimal digits. If the total number of requested output 228 -- digits (Fore - 1) + Aft is greater than 18, for purposes of the 229 -- conversion Aft is adjusted to 18 - (Fore - 1). In that case, or 230 -- when Fore > 19, trailing zeros can complete the output after writing 231 -- the first 18 significant digits, or the technique described in the 232 -- next section can be used. 233 234 -- The final expression for D is 235 236 -- D := Integer'Max (-18, Integer'Min (Aft, 18 - (Fore - 1))); 237 238 -- For Y and Z the following expressions can be derived: 239 240 -- Q / (10.0**D) = X * S 241 242 -- Q = X * S * (10.0**D) = (X * Y) / Z 243 244 -- S * 10.0**D = Y / Z; 245 246 -- If S is an integer greater than or equal to one, then Fore must be at 247 -- least 20 in order to print T'First, which is at most -2.0**63. 248 -- This means D < 0, so use 249 250 -- (1) Y = -S and Z = -10**(-D). 251 252 -- If 1.0 / S is an integer greater than one, use 253 254 -- (2) Y = -10**D and Z = -(1.0 / S), for D >= 0 255 256 -- or 257 258 -- (3) Y = 1 and Z = (1.0 / S) * 10**(-D), for D < 0 259 260 -- Negative values are used for nominator Y and denominator Z, so that S 261 -- can have a maximum value of 2.0**63 and a minimum of 2.0**(-63). 262 -- For Z in -1 .. -9, Fore will still be 20, and D will be negative, as 263 -- (-2.0**63) / -9 is greater than 10**18. In these cases there is room 264 -- in the denominator for the extra decimal scaling required, so case (3) 265 -- will not overflow. 266 267 pragma Assert (System.Fine_Delta >= 2.0**(-63)); 268 pragma Assert (Num'Small in 2.0**(-63) .. 2.0**63); 269 pragma Assert (Num'Fore <= 37); 270 -- These assertions need to be relaxed to allow for a Small of 271 -- 2.0**(-64) at least, since there is an ACATS test for this ??? 272 273 Max_Digits : constant := 18; 274 -- Maximum number of decimal digits that can be represented in a 275 -- 64-bit signed number, see above 276 277 -- The constants E0 .. E5 implement a binary search for the appropriate 278 -- power of ten to scale the small so that it has one digit before the 279 -- decimal point. 280 281 subtype Int is Integer; 282 E0 : constant Int := -20 * Boolean'Pos (Num'Small >= 1.0E1); 283 E1 : constant Int := E0 + 10 * Boolean'Pos (Num'Small * 10.0**E0 < 1.0E-10); 284 E2 : constant Int := E1 + 5 * Boolean'Pos (Num'Small * 10.0**E1 < 1.0E-5); 285 E3 : constant Int := E2 + 3 * Boolean'Pos (Num'Small * 10.0**E2 < 1.0E-3); 286 E4 : constant Int := E3 + 2 * Boolean'Pos (Num'Small * 10.0**E3 < 1.0E-1); 287 E5 : constant Int := E4 + 1 * Boolean'Pos (Num'Small * 10.0**E4 < 1.0E-0); 288 289 Scale : constant Integer := E5; 290 291 pragma Assert (Num'Small * 10.0**Scale >= 1.0 292 and then Num'Small * 10.0**Scale < 10.0); 293 294 Exact : constant Boolean := 295 Float'Floor (Num'Small) = Float'Ceiling (Num'Small) 296 or Float'Floor (1.0 / Num'Small) = Float'Ceiling (1.0 / Num'Small) 297 or Num'Small >= 10.0**Max_Digits; 298 -- True iff a numerator and denominator can be calculated such that 299 -- their ratio exactly represents the small of Num 300 301 -- Local Subprograms 302 303 procedure Put 304 (To : out String; 305 Last : out Natural; 306 Item : Num; 307 Fore : Field; 308 Aft : Field; 309 Exp : Field); 310 -- Actual output function, used internally by all other Put routines 311 312 --------- 313 -- Get -- 314 --------- 315 316 procedure Get 317 (File : in File_Type; 318 Item : out Num; 319 Width : in Field := 0) 320 is 321 pragma Unsuppress (Range_Check); 322 323 begin 324 Aux.Get (File, Long_Long_Float (Item), Width); 325 326 exception 327 when Constraint_Error => raise Data_Error; 328 end Get; 329 330 procedure Get 331 (Item : out Num; 332 Width : in Field := 0) 333 is 334 pragma Unsuppress (Range_Check); 335 336 begin 337 Aux.Get (Current_In, Long_Long_Float (Item), Width); 338 339 exception 340 when Constraint_Error => raise Data_Error; 341 end Get; 342 343 procedure Get 344 (From : in String; 345 Item : out Num; 346 Last : out Positive) 347 is 348 pragma Unsuppress (Range_Check); 349 350 begin 351 Aux.Gets (From, Long_Long_Float (Item), Last); 352 353 exception 354 when Constraint_Error => raise Data_Error; 355 end Get; 356 357 --------- 358 -- Put -- 359 --------- 360 361 procedure Put 362 (File : in File_Type; 363 Item : in Num; 364 Fore : in Field := Default_Fore; 365 Aft : in Field := Default_Aft; 366 Exp : in Field := Default_Exp) 367 is 368 S : String (1 .. Fore + Aft + Exp + Extra_Layout_Space); 369 Last : Natural; 370 begin 371 Put (S, Last, Item, Fore, Aft, Exp); 372 Generic_Aux.Put_Item (File, S (1 .. Last)); 373 end Put; 374 375 procedure Put 376 (Item : in Num; 377 Fore : in Field := Default_Fore; 378 Aft : in Field := Default_Aft; 379 Exp : in Field := Default_Exp) 380 is 381 S : String (1 .. Fore + Aft + Exp + Extra_Layout_Space); 382 Last : Natural; 383 begin 384 Put (S, Last, Item, Fore, Aft, Exp); 385 Generic_Aux.Put_Item (Text_IO.Current_Out, S (1 .. Last)); 386 end Put; 387 388 procedure Put 389 (To : out String; 390 Item : in Num; 391 Aft : in Field := Default_Aft; 392 Exp : in Field := Default_Exp) 393 is 394 Fore : constant Integer := To'Length 395 - 1 -- Decimal point 396 - Field'Max (1, Aft) -- Decimal part 397 - Boolean'Pos (Exp /= 0) -- Exponent indicator 398 - Exp; -- Exponent 399 Last : Natural; 400 401 begin 402 if Fore not in Field'Range then 403 raise Layout_Error; 404 end if; 405 406 Put (To, Last, Item, Fore, Aft, Exp); 407 408 if Last /= To'Last then 409 raise Layout_Error; 410 end if; 411 end Put; 412 413 procedure Put 414 (To : out String; 415 Last : out Natural; 416 Item : Num; 417 Fore : Field; 418 Aft : Field; 419 Exp : Field) 420 is 421 subtype Digit is Int64 range 0 .. 9; 422 X : constant Int64 := Int64'Integer_Value (Item); 423 A : constant Field := Field'Max (Aft, 1); 424 Neg : constant Boolean := (Item < 0.0); 425 Pos : Integer; -- Next digit X has value X * 10.0**Pos; 426 427 Y, Z : Int64; 428 E : constant Integer := Boolean'Pos (not Exact) 429 * (Max_Digits - 1 + Scale); 430 D : constant Integer := Boolean'Pos (Exact) 431 * Integer'Min (A, Max_Digits - (Num'Fore - 1)) 432 + Boolean'Pos (not Exact) 433 * (Scale - 1); 434 435 436 procedure Put_Character (C : Character); 437 pragma Inline (Put_Character); 438 -- Add C to the output string To, updating Last 439 440 procedure Put_Digit (X : Digit); 441 -- Add digit X to the output string (going from left to right), 442 -- updating Last and Pos, and inserting the sign, leading zeroes 443 -- or a decimal point when necessary. After outputting the first 444 -- digit, Pos must not be changed outside Put_Digit anymore 445 446 procedure Put_Int64 (X : Int64; Scale : Integer); 447 -- Output the decimal number X * 10**Scale 448 449 procedure Put_Scaled 450 (X, Y, Z : Int64; 451 A : Field; 452 E : Integer); 453 -- Output the decimal number (X * Y / Z) * 10**E, producing A digits 454 -- after the decimal point and rounding the final digit. The value 455 -- X * Y / Z is computed with full precision, but must be in the 456 -- range of Int64. 457 458 ------------------- 459 -- Put_Character -- 460 ------------------- 461 462 procedure Put_Character (C : Character) is 463 begin 464 Last := Last + 1; 465 To (Last) := C; 466 end Put_Character; 467 468 --------------- 469 -- Put_Digit -- 470 --------------- 471 472 procedure Put_Digit (X : Digit) is 473 Digs : constant array (Digit) of Character := "0123456789"; 474 begin 475 if Last = 0 then 476 if X /= 0 or Pos <= 0 then 477 -- Before outputting first digit, include leading space, 478 -- posible minus sign and, if the first digit is fractional, 479 -- decimal seperator and leading zeros. 480 481 -- The Fore part has Pos + 1 + Boolean'Pos (Neg) characters, 482 -- if Pos >= 0 and otherwise has a single zero digit plus minus 483 -- sign if negative. Add leading space if necessary. 484 485 for J in Integer'Max (0, Pos) + 2 + Boolean'Pos (Neg) .. Fore 486 loop 487 Put_Character (' '); 488 end loop; 489 490 -- Output minus sign, if number is negative 491 492 if Neg then 493 Put_Character ('-'); 494 end if; 495 496 -- If starting with fractional digit, output leading zeros 497 498 if Pos < 0 then 499 Put_Character ('0'); 500 Put_Character ('.'); 501 502 for J in Pos .. -2 loop 503 Put_Character ('0'); 504 end loop; 505 end if; 506 507 Put_Character (Digs (X)); 508 end if; 509 510 else 511 -- This is not the first digit to be output, so the only 512 -- special handling is that for the decimal point 513 514 if Pos = -1 then 515 Put_Character ('.'); 516 end if; 517 518 Put_Character (Digs (X)); 519 end if; 520 521 Pos := Pos - 1; 522 end Put_Digit; 523 524 --------------- 525 -- Put_Int64 -- 526 --------------- 527 528 procedure Put_Int64 (X : Int64; Scale : Integer) is 529 begin 530 if X = 0 then 531 return; 532 end if; 533 534 Pos := Scale; 535 536 if X not in -9 .. 9 then 537 Put_Int64 (X / 10, Scale + 1); 538 end if; 539 540 Put_Digit (abs (X rem 10)); 541 end Put_Int64; 542 543 ---------------- 544 -- Put_Scaled -- 545 ---------------- 546 547 procedure Put_Scaled 548 (X, Y, Z : Int64; 549 A : Field; 550 E : Integer) 551 is 552 N : constant Natural := (A + Max_Digits - 1) / Max_Digits + 1; 553 pragma Debug (Put_Line ("N =" & N'Img)); 554 Q : array (1 .. N) of Int64 := (others => 0); 555 556 XX : Int64 := X; 557 YY : Int64 := Y; 558 AA : Field := A; 559 560 begin 561 for J in Q'Range loop 562 exit when XX = 0; 563 564 Scaled_Divide (XX, YY, Z, Q (J), XX, Round => AA = 0); 565 566 -- As the last block of digits is rounded, a carry may have to 567 -- be propagated to the more significant digits. Since the last 568 -- block may have less than Max_Digits, the test for this block 569 -- is specialized. 570 571 -- The absolute value of the left-most digit block may equal 572 -- 10*Max_Digits, as no carry can be propagated from there. 573 -- The final output routines need to be prepared to handle 574 -- this specific case. 575 576 if (Q (J) = YY or -Q (J) = YY) and then J > Q'First then 577 if Q (J) < 0 then 578 Q (J - 1) := Q (J - 1) + 1; 579 else 580 Q (J - 1) := Q (J - 1) - 1; 581 end if; 582 583 Q (J) := 0; 584 585 Propagate_Carry : 586 for J in reverse Q'First + 1 .. Q'Last loop 587 if Q (J) >= 10**Max_Digits then 588 Q (J - 1) := Q (J - 1) + 1; 589 Q (J) := Q (J) - 10**Max_Digits; 590 591 elsif Q (J) <= -10**Max_Digits then 592 Q (J - 1) := Q (J - 1) - 1; 593 Q (J) := Q (J) + 10**Max_Digits; 594 end if; 595 end loop Propagate_Carry; 596 end if; 597 598 YY := -10**Integer'Min (Max_Digits, AA); 599 AA := AA - Integer'Min (Max_Digits, AA); 600 end loop; 601 602 for J in Q'First .. Q'Last - 1 loop 603 Put_Int64 (Q (J), E - (J - Q'First) * Max_Digits); 604 end loop; 605 606 Put_Int64 (Q (Q'Last), E - A); 607 end Put_Scaled; 608 609 -- Start of processing for Put 610 611 begin 612 Last := To'First - 1; 613 614 if Exp /= 0 then 615 616 -- With the Exp format, it is not known how many output digits to 617 -- generate, as leading zeros must be ignored. Computing too many 618 -- digits and then truncating the output will not give the closest 619 -- output, it is necessary to round at the correct digit. 620 621 -- The general approach is as follows: as long as no digits have 622 -- been generated, compute the Aft next digits (without rounding). 623 -- Once a non-zero digit is generated, determine the exact number 624 -- of digits remaining and compute them with rounding. 625 -- Since a large number of iterations might be necessary in case 626 -- of Aft = 1, the following optimization would be desirable. 627 -- Count the number Z of leading zero bits in the integer 628 -- representation of X, and start with producing 629 -- Aft + Z * 1000 / 3322 digits in the first scaled division. 630 631 -- However, the floating-point routines are still used now ??? 632 633 System.Img_Real.Set_Image_Real (Long_Long_Float (Item), To, Last, 634 Fore, Aft, Exp); 635 return; 636 end if; 637 638 if Exact then 639 Y := Int64'Min (Int64 (-Num'Small), -1) * 10**Integer'Max (0, D); 640 Z := Int64'Min (Int64 (-1.0 / Num'Small), -1) 641 * 10**Integer'Max (0, -D); 642 else 643 Y := Int64 (-Num'Small * 10.0**E); 644 Z := -10**Max_Digits; 645 end if; 646 647 Put_Scaled (X, Y, Z, A - D, -D); 648 649 -- If only zero digits encountered, unit digit has not been output yet 650 651 if Last < To'First then 652 Pos := 0; 653 end if; 654 655 -- Always output digits up to the first one after the decimal point 656 657 while Pos >= -A loop 658 Put_Digit (0); 659 end loop; 660 end Put; 661 662end Ada.Text_IO.Fixed_IO; 663