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