1------------------------------------------------------------------------------
2--                                                                          --
3--                         GNAT RUN-TIME COMPONENTS                         --
4--                                                                          --
5--             A D A . W I D E _ T E X T _ I O . F I X E D _ I O            --
6--                                                                          --
7--                                 B o d y                                  --
8--                                                                          --
9--            Copyright (C) 2020, 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
34package body Ada.Wide_Text_IO.Fixed_Aux is
35
36   ---------
37   -- Get --
38   ---------
39
40   function Get
41     (File  : File_Type;
42      Width : Field;
43      Num   : Int;
44      Den   : Int) return Int
45   is
46      Buf  : String (1 .. Field'Last);
47      Ptr  : aliased Integer;
48      Stop : Integer := 0;
49      Item : Int;
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, Num, Den);
61      Check_End_Of_Field (Buf, Stop, Ptr, Width);
62      return Item;
63   end Get;
64
65   ----------
66   -- Gets --
67   ----------
68
69   function Gets
70     (From : String;
71      Last : out Positive;
72      Num  : Int;
73      Den  : Int) return Int
74   is
75      Pos  : aliased Integer;
76      Item : Int;
77
78   begin
79      String_Skip (From, Pos);
80      Item := Scan (From, Pos'Access, From'Last, Num, Den);
81      Last := Pos - 1;
82      return Item;
83
84   exception
85      when Constraint_Error =>
86         Last := Pos - 1;
87         raise Data_Error;
88   end Gets;
89
90   ---------
91   -- Put --
92   ---------
93
94   procedure Put
95     (File : File_Type;
96      Item : Int;
97      Fore : Field;
98      Aft  : Field;
99      Exp  : Natural;
100      Num  : Int;
101      Den  : Int;
102      For0 : Natural;
103      Aft0 : Natural)
104   is
105      Buf : String (1 .. Field'Last);
106      Ptr : Natural := 0;
107
108   begin
109      Set_Image (Item, Buf, Ptr, Num, Den, For0, Aft0, Fore, Aft, Exp);
110      Put_Item (File, Buf (1 .. Ptr));
111   end Put;
112
113   ----------
114   -- Puts --
115   ----------
116
117   procedure Puts
118     (To   : out String;
119      Item : Int;
120      Aft  : Field;
121      Exp  : Natural;
122      Num  : Int;
123      Den  : Int;
124      For0 : Natural;
125      Aft0 : Natural)
126   is
127      Buf  : String (1 .. Positive'Max (Field'Last, To'Length));
128      Fore : Integer;
129      Ptr  : Natural := 0;
130
131   begin
132      --  Compute Fore, allowing for the decimal dot and Aft digits
133
134      Fore := To'Length - 1 - Field'Max (1, Aft);
135
136      --  Allow for Exp and one more for E if exponent present
137
138      if Exp /= 0 then
139         Fore := Fore - 1 - Field'Max (2, Exp);
140      end if;
141
142      --  Make sure we have enough room
143
144      if Fore < 1 + Boolean'Pos (Item < 0) then
145         raise Layout_Error;
146      end if;
147
148      --  Do the conversion and check length of result
149
150      Set_Image (Item, Buf, Ptr, Num, Den, For0, Aft0, Fore, Aft, Exp);
151
152      if Ptr > To'Length then
153         raise Layout_Error;
154      else
155         To := Buf (1 .. Ptr);
156      end if;
157   end Puts;
158
159end Ada.Wide_Text_IO.Fixed_Aux;
160