1------------------------------------------------------------------------------
2--                                                                          --
3--                         GNAT RUNTIME COMPONENTS                          --
4--                                                                          --
5--               A D A . T E X T _ I O . M O D U L A R _ I O                --
6--                                                                          --
7--                                 B o d y                                  --
8--                                                                          --
9--   Copyright (C) 1992,1993,1994,1995,1996 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
34with Ada.Text_IO.Modular_Aux;
35
36with System.Unsigned_Types; use System.Unsigned_Types;
37
38package body Ada.Text_IO.Modular_IO is
39
40   package Aux renames Ada.Text_IO.Modular_Aux;
41
42   ---------
43   -- Get --
44   ---------
45
46   procedure Get
47     (File  : in File_Type;
48      Item  : out Num;
49      Width : in Field := 0)
50   is
51      pragma Unsuppress (Range_Check);
52
53   begin
54      if Num'Size > Unsigned'Size then
55         Aux.Get_LLU (File, Long_Long_Unsigned (Item), Width);
56      else
57         Aux.Get_Uns (File, Unsigned (Item), Width);
58      end if;
59
60   exception
61      when Constraint_Error => raise Data_Error;
62   end Get;
63
64   procedure Get
65     (Item  : out Num;
66      Width : in Field := 0)
67   is
68      pragma Unsuppress (Range_Check);
69
70   begin
71      if Num'Size > Unsigned'Size then
72         Aux.Get_LLU (Current_In, Long_Long_Unsigned (Item), Width);
73      else
74         Aux.Get_Uns (Current_In, Unsigned (Item), Width);
75      end if;
76
77   exception
78      when Constraint_Error => raise Data_Error;
79   end Get;
80
81   procedure Get
82     (From : in String;
83      Item : out Num;
84      Last : out Positive)
85   is
86      pragma Unsuppress (Range_Check);
87
88   begin
89      if Num'Size > Unsigned'Size then
90         Aux.Gets_LLU (From, Long_Long_Unsigned (Item), Last);
91      else
92         Aux.Gets_Uns (From, Unsigned (Item), Last);
93      end if;
94
95   exception
96      when Constraint_Error => raise Data_Error;
97   end Get;
98
99   ---------
100   -- Put --
101   ---------
102
103   procedure Put
104     (File  : in File_Type;
105      Item  : in Num;
106      Width : in Field := Default_Width;
107      Base  : in Number_Base := Default_Base)
108   is
109   begin
110      if Num'Size > Unsigned'Size then
111         Aux.Put_LLU (File, Long_Long_Unsigned (Item), Width, Base);
112      else
113         Aux.Put_Uns (File, Unsigned (Item), Width, Base);
114      end if;
115   end Put;
116
117   procedure Put
118     (Item  : in Num;
119      Width : in Field := Default_Width;
120      Base  : in Number_Base := Default_Base)
121   is
122   begin
123      if Num'Size > Unsigned'Size then
124         Aux.Put_LLU (Current_Out, Long_Long_Unsigned (Item), Width, Base);
125      else
126         Aux.Put_Uns (Current_Out, Unsigned (Item), Width, Base);
127      end if;
128   end Put;
129
130   procedure Put
131     (To   : out String;
132      Item : in Num;
133      Base : in Number_Base := Default_Base)
134   is
135   begin
136      if Num'Size > Unsigned'Size then
137         Aux.Puts_LLU (To, Long_Long_Unsigned (Item), Base);
138      else
139         Aux.Puts_Uns (To, Unsigned (Item), Base);
140      end if;
141   end Put;
142
143end Ada.Text_IO.Modular_IO;
144