1------------------------------------------------------------------------------
2--                                                                          --
3--                         GNAT RUN-TIME COMPONENTS                         --
4--                                                                          --
5--               A D A . T E X T _ I O . I N T E G E R _ I O                --
6--                                                                          --
7--                                 B o d y                                  --
8--                                                                          --
9--          Copyright (C) 1992-2009, 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.Text_IO.Integer_Aux;
33
34package body Ada.Text_IO.Integer_IO is
35
36   package Aux renames Ada.Text_IO.Integer_Aux;
37
38   Need_LLI : constant Boolean := Num'Base'Size > Integer'Size;
39   --  Throughout this generic body, we distinguish between the case where type
40   --  Integer is acceptable, and where a Long_Long_Integer is needed. This
41   --  Boolean is used to test for these cases and since it is a constant, only
42   --  code for the relevant case will be included in the instance.
43
44   ---------
45   -- Get --
46   ---------
47
48   procedure Get
49     (File  : File_Type;
50      Item  : out Num;
51      Width : Field := 0)
52   is
53      --  We depend on a range check to get Data_Error
54
55      pragma Unsuppress (Range_Check);
56      pragma Unsuppress (Overflow_Check);
57
58   begin
59      if Need_LLI then
60         Aux.Get_LLI (File, Long_Long_Integer (Item), Width);
61      else
62         Aux.Get_Int (File, Integer (Item), Width);
63      end if;
64
65   exception
66      when Constraint_Error => raise Data_Error;
67   end Get;
68
69   procedure Get
70     (Item  : out Num;
71      Width : Field := 0)
72   is
73      --  We depend on a range check to get Data_Error
74
75      pragma Unsuppress (Range_Check);
76      pragma Unsuppress (Overflow_Check);
77
78   begin
79      if Need_LLI then
80         Aux.Get_LLI (Current_In, Long_Long_Integer (Item), Width);
81      else
82         Aux.Get_Int (Current_In, Integer (Item), Width);
83      end if;
84
85   exception
86      when Constraint_Error => raise Data_Error;
87   end Get;
88
89   procedure Get
90     (From : String;
91      Item : out Num;
92      Last : out Positive)
93   is
94      --  We depend on a range check to get Data_Error
95
96      pragma Unsuppress (Range_Check);
97      pragma Unsuppress (Overflow_Check);
98
99   begin
100      if Need_LLI then
101         Aux.Gets_LLI (From, Long_Long_Integer (Item), Last);
102      else
103         Aux.Gets_Int (From, Integer (Item), Last);
104      end if;
105
106   exception
107      when Constraint_Error => raise Data_Error;
108   end Get;
109
110   ---------
111   -- Put --
112   ---------
113
114   procedure Put
115     (File  : File_Type;
116      Item  : Num;
117      Width : Field := Default_Width;
118      Base  : Number_Base := Default_Base)
119   is
120   begin
121      if Need_LLI then
122         Aux.Put_LLI (File, Long_Long_Integer (Item), Width, Base);
123      else
124         Aux.Put_Int (File, Integer (Item), Width, Base);
125      end if;
126   end Put;
127
128   procedure Put
129     (Item  : Num;
130      Width : Field := Default_Width;
131      Base  : Number_Base := Default_Base)
132   is
133   begin
134      if Need_LLI then
135         Aux.Put_LLI (Current_Out, Long_Long_Integer (Item), Width, Base);
136      else
137         Aux.Put_Int (Current_Out, Integer (Item), Width, Base);
138      end if;
139   end Put;
140
141   procedure Put
142     (To   : out String;
143      Item : Num;
144      Base : Number_Base := Default_Base)
145   is
146   begin
147      if Need_LLI then
148         Aux.Puts_LLI (To, Long_Long_Integer (Item), Base);
149      else
150         Aux.Puts_Int (To, Integer (Item), Base);
151      end if;
152   end Put;
153
154end Ada.Text_IO.Integer_IO;
155