1------------------------------------------------------------------------------ 2-- -- 3-- GNAT RUN-TIME COMPONENTS -- 4-- -- 5-- A D A . W I D E _ T E X T _ I O . F L O A T _ A U X -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 1992-2021, 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 32with Ada.Wide_Text_IO.Generic_Aux; use Ada.Wide_Text_IO.Generic_Aux; 33 34with System.Img_Util; use System.Img_Util; 35 36package body Ada.Wide_Text_IO.Float_Aux is 37 38 --------- 39 -- Get -- 40 --------- 41 42 procedure Get 43 (File : File_Type; 44 Item : out Num; 45 Width : Field) 46 is 47 Buf : String (1 .. Field'Last); 48 Stop : Integer := 0; 49 Ptr : aliased Integer; 50 51 begin 52 if Width /= 0 then 53 Load_Width (File, Width, Buf, Stop); 54 String_Skip (Buf, Ptr); 55 else 56 Load_Real (File, Buf, Stop); 57 Ptr := 1; 58 end if; 59 60 Item := Scan (Buf, Ptr'Access, Stop); 61 Check_End_Of_Field (Buf, Stop, Ptr, Width); 62 end Get; 63 64 ---------- 65 -- Gets -- 66 ---------- 67 68 procedure Gets 69 (From : String; 70 Item : out Num; 71 Last : out Positive) 72 is 73 Pos : aliased Integer; 74 75 begin 76 String_Skip (From, Pos); 77 Item := Scan (From, Pos'Access, From'Last); 78 Last := Pos - 1; 79 80 exception 81 when Constraint_Error => raise Data_Error; 82 end Gets; 83 84 --------- 85 -- Put -- 86 --------- 87 88 procedure Put 89 (File : File_Type; 90 Item : Num; 91 Fore : Field; 92 Aft : Field; 93 Exp : Field) 94 is 95 Buf : String (1 .. Max_Real_Image_Length); 96 Ptr : Natural := 0; 97 98 begin 99 Set_Image (Item, Buf, Ptr, Fore, Aft, Exp); 100 Put_Item (File, Buf (1 .. Ptr)); 101 end Put; 102 103 ---------- 104 -- Puts -- 105 ---------- 106 107 procedure Puts 108 (To : out String; 109 Item : Num; 110 Aft : Field; 111 Exp : Field) 112 is 113 Buf : String (1 .. Max_Real_Image_Length); 114 Ptr : Natural := 0; 115 116 begin 117 Set_Image (Item, Buf, Ptr, Fore => 1, Aft => Aft, Exp => Exp); 118 119 if Ptr > To'Length then 120 raise Layout_Error; 121 122 else 123 for J in 1 .. Ptr loop 124 To (To'Last - Ptr + J) := Buf (J); 125 end loop; 126 127 for J in To'First .. To'Last - Ptr loop 128 To (J) := ' '; 129 end loop; 130 end if; 131 end Puts; 132 133end Ada.Wide_Text_IO.Float_Aux; 134