1 ------------------------------------------------------------------------------
3 -- GNAT RUN-TIME COMPONENTS --
5 -- A D A . T E X T _ I O . M O D U L A R _ I O --
9 -- Copyright (C) 1992-2024, Free Software Foundation, Inc. --
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. --
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. --
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/>. --
27 -- GNAT was originally developed by the GNAT team at New York University. --
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
30 ------------------------------------------------------------------------------
32 with Ada
.Text_IO
.Integer_Aux
;
33 with System
.Img_BIU
; use System
.Img_BIU
;
34 with System
.Img_Uns
; use System
.Img_Uns
;
35 with System
.Img_LLB
; use System
.Img_LLB
;
36 with System
.Img_LLU
; use System
.Img_LLU
;
37 with System
.Img_LLW
; use System
.Img_LLW
;
38 with System
.Img_WIU
; use System
.Img_WIU
;
39 with System
.Unsigned_Types
;
40 with System
.Val_Uns
; use System
.Val_Uns
;
41 with System
.Val_LLU
; use System
.Val_LLU
;
43 package body Ada
.Text_IO
.Modular_IO
is
45 subtype Unsigned
is System
.Unsigned_Types
.Unsigned
;
47 package Aux_Uns
is new
48 Ada
.Text_IO
.Integer_Aux
52 Set_Image_Width_Unsigned
,
53 Set_Image_Based_Unsigned
);
55 subtype Long_Long_Unsigned
is System
.Unsigned_Types
.Long_Long_Unsigned
;
57 package Aux_LLU
is new
58 Ada
.Text_IO
.Integer_Aux
60 Scan_Long_Long_Unsigned
,
61 Set_Image_Long_Long_Unsigned
,
62 Set_Image_Width_Long_Long_Unsigned
,
63 Set_Image_Based_Long_Long_Unsigned
);
65 Need_LLU
: constant Boolean := Num
'Base'Size > Unsigned'Size;
66 -- Throughout this generic body, we distinguish between the case where type
67 -- Unsigned is acceptable, and where a Long_Long_Unsigned is needed. This
68 -- Boolean is used to test for these cases and since it is a constant, only
69 -- code for the relevant case will be included in the instance.
80 -- We depend on a range check to get Data_Error
82 pragma Unsuppress (Range_Check);
86 Aux_LLU.Get (File, Long_Long_Unsigned (Item), Width);
88 Aux_Uns.Get (File, Unsigned (Item), Width);
92 when Constraint_Error => raise Data_Error;
100 Get (Current_In, Item, Width);
108 -- We depend on a range check to get Data_Error
110 pragma Unsuppress (Range_Check);
114 Aux_LLU.Gets (From, Long_Long_Unsigned (Item), Last);
116 Aux_Uns.Gets (From, Unsigned (Item), Last);
120 when Constraint_Error => raise Data_Error;
130 Width : Field := Default_Width;
131 Base : Number_Base := Default_Base)
135 Aux_LLU.Put (File, Long_Long_Unsigned (Item), Width, Base);
137 Aux_Uns.Put (File, Unsigned (Item), Width, Base);
143 Width : Field := Default_Width;
144 Base : Number_Base := Default_Base)
147 Put (Current_Out, Item, Width, Base);
153 Base : Number_Base := Default_Base)
157 Aux_LLU.Puts (To, Long_Long_Unsigned (Item), Base);
159 Aux_Uns.Puts (To, Unsigned (Item), Base);
163 end Ada.Text_IO.Modular_IO;