procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

[Ada] Support of the Ada.Text_IO hierarchy for 128-bit types

Browse source 
gcc/ada/

	* Makefile.rtl (GNATRTL_NONTASKING_OBJS): Add a-llltio, a-lllwti,
	a-lllzti and remove a-timoau, a-wtmoau and a-ztmoau.
	(GNATRTL_128BIT_PAIRS): Add a-tiinio.adb, a-timoio.adb, a-wtinio.adb,
	a-wtmoio.adb, a-ztinio.adb and a-ztmoio.adb.
	* impunit.adb (Non_Imp_File_Names_95): Add a-llltio, a-lllwti and
	a-lllzti.
	* krunch.ads: Document trick for Ada.Long_Long_Long_Integer_*_IO.
	* krunch.adb (Krunch): Add trick for Ada.Long_Long_Long_Integer_*_IO.
	* libgnat/a-llltio.ads: Instantiate Ada.Text_IO.Integer_IO.
	* libgnat/a-lllwti.ads: Instantiate Ada.Wide_Text_IO.Integer_IO.
	* libgnat/a-lllzti.ads: Instantiate Ada.Wide_Wide_Text_IO.Integer_IO.
	* libgnat/a-tigeau.ads (Load_Integer): New procedure.
	* libgnat/a-tigeau.adb (Load_Integer): Likewise.
	* libgnat/a-tiinau.ads, libgnat/a-tiinau.adb: Change to generic
	package.
	* libgnat/a-tiinio.adb: Instantiate it.
	* libgnat/a-tiinio__128.adb: Likewise.
	* libgnat/a-timoau.ads, libgnat/a-timoau.adb: Change to generic
	package.
	* libgnat/a-timoio.adb: Instantiate it.
	* libgnat/a-timoio__128.adb: Likewise.
	* libgnat/a-wtgeau.ads (Load_Integer): New procedure.
	* libgnat/a-wtgeau.adb (Load_Integer): Likewise.
	* libgnat/a-wtinau.ads, libgnat/a-wtinau.adb: Change to generic
	package.
	* libgnat/a-wtinio.adb: Instantiate it.
	* libgnat/a-wtinio__128.adb: Likewise.
	* libgnat/a-wtmoau.ads, libgnat/a-wtmoau.adb: Change to generic
	package.
	* libgnat/a-wtmoio.adb: Instantiate it.
	* libgnat/a-wtmoio__128.adb: Likewise.
	* libgnat/a-ztgeau.ads (Load_Integer): New procedure.
	* libgnat/a-ztgeau.adb (Load_Integer): Likewise.
	* libgnat/a-ztinau.ads, libgnat/a-ztinau.adb: Change to generic
	package.
	* libgnat/a-ztinio.adb: Instantiate it.
	* libgnat/a-ztinio__128.adb: Likewise.
	* libgnat/a-ztmoau.ads, libgnat/a-ztmoau.adb: Change to generic
	package.
	* libgnat/a-ztmoio.adb: Instantiate it.
	* libgnat/a-ztmoio__128.adb: Likewise.
This commit is contained in:
Eric Botcazou 2020-06-27 12:43:32 +02:00 • committed by Pierre-Marie de Rodat
parent 4cd2e6f249
commit 38aca14a43
37 changed files with 1868 additions and 1996 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

12
gcc/ada/Makefile.rtl
View file

@ -206,6 +206,9 @@ GNATRTL_NONTASKING_OBJS= \
a-llitio$(objext) \
a-lliwti$(objext) \
a-llizti$(objext) \
a-llltio$(objext) \
a-lllwti$(objext) \
a-lllzti$(objext) \
a-locale$(objext) \
a-nbnbin$(objext) \
a-nbnbre$(objext) \
@ -347,7 +350,6 @@ GNATRTL_NONTASKING_OBJS= \
a-tigeau$(objext) \
a-tiinau$(objext) \
a-tiinio$(objext) \
a-timoau$(objext) \
a-timoio$(objext) \
a-tiocst$(objext) \
a-tirsfi$(objext) \
@ -375,7 +377,6 @@ GNATRTL_NONTASKING_OBJS= \
a-wtgeau$(objext) \
a-wtinau$(objext) \
a-wtinio$(objext) \
a-wtmoau$(objext) \
a-wtmoio$(objext) \
a-wttest$(objext) \
a-wwboio$(objext) \
@ -399,7 +400,6 @@ GNATRTL_NONTASKING_OBJS= \
a-ztgeau$(objext) \
a-ztinau$(objext) \
a-ztinio$(objext) \
a-ztmoau$(objext) \
a-ztmoio$(objext) \
a-zttest$(objext) \
a-zzboio$(objext) \
@ -882,6 +882,12 @@ TRASYM_DWARF_UNIX_OBJS = $(TRASYM_DWARF_COMMON_OBJS) s-mmauni$(objext)
TRASYM_DWARF_MINGW_OBJS = $(TRASYM_DWARF_COMMON_OBJS)
GNATRTL_128BIT_PAIRS = \
a-tiinio.adb<libgnat/a-tiinio__128.adb \
a-timoio.adb<libgnat/a-timoio__128.adb \
a-wtinio.adb<libgnat/a-wtinio__128.adb \
a-wtmoio.adb<libgnat/a-wtmoio__128.adb \
a-ztinio.adb<libgnat/a-ztinio__128.adb \
a-ztmoio.adb<libgnat/a-ztmoio__128.adb \
s-scaval.ads<libgnat/s-scaval__128.ads \
s-scaval.adb<libgnat/s-scaval__128.adb

3
gcc/ada/impunit.adb
View file

@ -146,6 +146,8 @@ package body Impunit is
("a-llfwti", T), -- Ada.Long_Long_Float_Wide_Text_IO
("a-llitio", T), -- Ada.Long_Long_Integer_Text_IO
("a-lliwti", F), -- Ada.Long_Long_Integer_Wide_Text_IO
("a-llltio", T), -- Ada.Long_Long_Long_Integer_Text_IO
("a-lllwti", F), -- Ada.Long_Long_Long_Integer_Wide_Text_IO
("a-nlcefu", F), -- Ada.Long_Complex_Elementary_Functions
("a-nlcoty", T), -- Ada.Numerics.Long_Complex_Types
("a-nlelfu", T), -- Ada.Numerics.Long_Elementary_Functions
@ -502,6 +504,7 @@ package body Impunit is
("a-llctio", T), -- Ada.Long_Long_Complex_Text_IO
("a-llfzti", T), -- Ada.Long_Long_Float_Wide_Wide_Text_IO
("a-llizti", T), -- Ada.Long_Long_Integer_Wide_Wide_Text_IO
("a-lllzti", T), -- Ada.Long_Long_Long_Integer_Wide_Wide_Text_IO
("a-nlcoar", T), -- Ada.Numerics.Long_Complex_Arrays
("a-nllcar", T), -- Ada.Numerics.Long_Long_Complex_Arrays
("a-nllrar", T), -- Ada.Numerics.Long_Long_Real_Arrays

9
gcc/ada/krunch.adb
View file

@ -73,6 +73,15 @@ begin
Curlen := Len - 17;
Krlen := 8;
elsif Len >= 27
and then Buffer (1 .. 27) = "ada-long_long_long_integer_"
then
Startloc := 3;
Buffer (2 .. Len - 2) := Buffer (4 .. Len);
Buffer (18 .. Len - 10) := Buffer (26 .. Len - 2);
Curlen := Len - 10;
Krlen := 8;
elsif Len >= 4 and then Buffer (1 .. 4) = "ada-" then
Startloc := 3;
Buffer (2 .. Len - 2) := Buffer (4 .. Len);

3
gcc/ada/krunch.ads
View file

@ -114,6 +114,9 @@
-- we replace the prefix ada.wide_wide_text_io- by a-zt- and then
-- the normal crunching rules are applied.
-- An additional trick is used for Ada.Long_Long_Long_Integer_*_IO, where
-- the Integer word is dropped.
-- The units implementing the support of 128-bit types are crunched to 9 and
-- System.Compare_Array_* is replaced with System.CA_* before crunching.

19
gcc/ada/libgnat/a-llltio.ads Normal file
View file

@ -0,0 +1,19 @@
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- A D A . L O N G _ L O N G _ L O N G _ I N T E G E R _ T E X T _ I O --
-- --
-- S p e c --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
------------------------------------------------------------------------------
with Ada.Text_IO;
package Ada.Long_Long_Long_Integer_Text_IO is
new Ada.Text_IO.Integer_IO (Long_Long_Long_Integer);

19
gcc/ada/libgnat/a-lllwti.ads Normal file
View file

@ -0,0 +1,19 @@
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- A D A . L O N G _ L O N G _ I N T E G E R _ W I D E _ T E X T _ I O --
-- --
-- S p e c --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
------------------------------------------------------------------------------
with Ada.Wide_Text_IO;
package Ada.Long_Long_Long_Integer_Wide_Text_IO is
new Ada.Wide_Text_IO.Integer_IO (Long_Long_Long_Integer);

19
gcc/ada/libgnat/a-lllzti.ads Normal file
View file

@ -0,0 +1,19 @@
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- A D A . L O N G _ L O N G _ I N T E G E R _ W I D E _ T E X T _ I O --
-- --
-- S p e c --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
------------------------------------------------------------------------------
with Ada.Wide_Wide_Text_IO;
package Ada.Long_Long_Long_Integer_Wide_Wide_Text_IO is
new Ada.Wide_Wide_Text_IO.Integer_IO (Long_Long_Long_Integer);

54
gcc/ada/libgnat/a-tigeau.adb
View file

@ -322,6 +322,60 @@ package body Ada.Text_IO.Generic_Aux is
Load_Extended_Digits (File, Buf, Ptr, Junk);
end Load_Extended_Digits;
------------------
-- Load_Integer --
------------------
procedure Load_Integer
(File : File_Type;
Buf : out String;
Ptr : in out Natural)
is
Hash_Loc : Natural;
Loaded : Boolean;
begin
Load_Skip (File);
-- Note: it is a bit strange to allow a minus sign here, but it seems
-- consistent with the general behavior expected by the ACVC tests
-- which is to scan past junk and then signal data error, see ACVC
-- test CE3704F, case (6), which is for signed integer exponents,
-- which seems a similar case.
Load (File, Buf, Ptr, '+', '-');
Load_Digits (File, Buf, Ptr, Loaded);
if Loaded then
-- Deal with based literal. We recognize either the standard '#' or
-- the allowed alternative replacement ':' (see RM J.2(3)).
Load (File, Buf, Ptr, '#', ':', Loaded);
if Loaded then
Hash_Loc := Ptr;
Load_Extended_Digits (File, Buf, Ptr);
Load (File, Buf, Ptr, Buf (Hash_Loc));
end if;
-- Deal with exponent
Load (File, Buf, Ptr, 'E', 'e', Loaded);
if Loaded then
-- Note: it is strange to allow a minus sign, since the syntax
-- does not, but that is what ACVC test CE3704F, case (6) wants
-- for the signed case, and there seems no good reason to treat
-- exponents differently for the signed and unsigned cases.
Load (File, Buf, Ptr, '+', '-');
Load_Digits (File, Buf, Ptr);
end if;
end if;
end Load_Integer;
---------------
-- Load_Skip --
---------------

6
gcc/ada/libgnat/a-tigeau.ads
View file

@ -150,6 +150,12 @@ private package Ada.Text_IO.Generic_Aux is
Ptr : in out Integer);
-- Same as above, but no indication if character is loaded
procedure Load_Integer
(File : File_Type;
Buf : out String;
Ptr : in out Natural);
-- Loads a possibly signed integer literal value
function Nextc (File : File_Type) return Integer;
-- Like Getc, but includes a call to Ungetc, so that the file
-- pointer is not moved by the call.

228
gcc/ada/libgnat/a-tiinau.adb
View file

@ -2,7 +2,7 @@
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- A D A . T E X T _ I O . I N T E G E R _ A U X --
-- A D A . T E X T _ I O . I N T E G E R _ A U X --
-- --
-- B o d y --
-- --
@ -31,36 +31,15 @@
with Ada.Text_IO.Generic_Aux; use Ada.Text_IO.Generic_Aux;
with System.Img_BIU; use System.Img_BIU;
with System.Img_Int; use System.Img_Int;
with System.Img_LLB; use System.Img_LLB;
with System.Img_LLI; use System.Img_LLI;
with System.Img_LLW; use System.Img_LLW;
with System.Img_WIU; use System.Img_WIU;
with System.Val_Int; use System.Val_Int;
with System.Val_LLI; use System.Val_LLI;
package body Ada.Text_IO.Integer_Aux is
-----------------------
-- Local Subprograms --
-----------------------
---------
-- Get --
---------
procedure Load_Integer
(File : File_Type;
Buf : out String;
Ptr : in out Natural);
-- This is an auxiliary routine that is used to load a possibly signed
-- integer literal value from the input file into Buf, starting at Ptr + 1.
-- On return, Ptr is set to the last character stored.
-------------
-- Get_Int --
-------------
procedure Get_Int
procedure Get
(File : File_Type;
Item : out Integer;
Item : out Num;
Width : Field)
is
Buf : String (1 .. Field'Last);
@ -75,130 +54,38 @@ package body Ada.Text_IO.Integer_Aux is
Load_Integer (File, Buf, Stop);
end if;
Item := Scan_Integer (Buf, Ptr'Access, Stop);
Item := Scan (Buf, Ptr'Access, Stop);
Check_End_Of_Field (Buf, Stop, Ptr, Width);
end Get_Int;
end Get;
-------------
-- Get_LLI --
-------------
----------
-- Gets --
----------
procedure Get_LLI
(File : File_Type;
Item : out Long_Long_Integer;
Width : Field)
is
Buf : String (1 .. Field'Last);
Ptr : aliased Integer := 1;
Stop : Integer := 0;
begin
if Width /= 0 then
Load_Width (File, Width, Buf, Stop);
String_Skip (Buf, Ptr);
else
Load_Integer (File, Buf, Stop);
end if;
Item := Scan_Long_Long_Integer (Buf, Ptr'Access, Stop);
Check_End_Of_Field (Buf, Stop, Ptr, Width);
end Get_LLI;
--------------
-- Gets_Int --
--------------
procedure Gets_Int
procedure Gets
(From : String;
Item : out Integer;
Item : out Num;
Last : out Positive)
is
Pos : aliased Integer;
begin
String_Skip (From, Pos);
Item := Scan_Integer (From, Pos'Access, From'Last);
Item := Scan (From, Pos'Access, From'Last);
Last := Pos - 1;
exception
when Constraint_Error =>
raise Data_Error;
end Gets_Int;
end Gets;
--------------
-- Gets_LLI --
--------------
---------
-- Put --
---------
procedure Gets_LLI
(From : String;
Item : out Long_Long_Integer;
Last : out Positive)
is
Pos : aliased Integer;
begin
String_Skip (From, Pos);
Item := Scan_Long_Long_Integer (From, Pos'Access, From'Last);
Last := Pos - 1;
exception
when Constraint_Error =>
raise Data_Error;
end Gets_LLI;
------------------
-- Load_Integer --
------------------
procedure Load_Integer
(File : File_Type;
Buf : out String;
Ptr : in out Natural)
is
Hash_Loc : Natural;
Loaded : Boolean;
begin
Load_Skip (File);
Load (File, Buf, Ptr, '+', '-');
Load_Digits (File, Buf, Ptr, Loaded);
if Loaded then
-- Deal with based literal. We recognize either the standard '#' or
-- the allowed alternative replacement ':' (see RM J.2(3)).
Load (File, Buf, Ptr, '#', ':', Loaded);
if Loaded then
Hash_Loc := Ptr;
Load_Extended_Digits (File, Buf, Ptr);
Load (File, Buf, Ptr, Buf (Hash_Loc));
end if;
-- Deal with exponent
Load (File, Buf, Ptr, 'E', 'e', Loaded);
if Loaded then
-- Note: it is strange to allow a minus sign, since the syntax
-- does not, but that is what ACVC test CE3704F, case (6) wants.
Load (File, Buf, Ptr, '+', '-');
Load_Digits (File, Buf, Ptr);
end if;
end if;
end Load_Integer;
-------------
-- Put_Int --
-------------
procedure Put_Int
procedure Put
(File : File_Type;
Item : Integer;
Item : Num;
Width : Field;
Base : Number_Base)
is
@ -207,48 +94,23 @@ package body Ada.Text_IO.Integer_Aux is
begin
if Base = 10 and then Width = 0 then
Set_Image_Integer (Item, Buf, Ptr);
Set_Image (Item, Buf, Ptr);
elsif Base = 10 then
Set_Image_Width_Integer (Item, Width, Buf, Ptr);
Set_Image_Width (Item, Width, Buf, Ptr);
else
Set_Image_Based_Integer (Item, Base, Width, Buf, Ptr);
Set_Image_Based (Item, Base, Width, Buf, Ptr);
end if;
Put_Item (File, Buf (1 .. Ptr));
end Put_Int;
end Put;
-------------
-- Put_LLI --
-------------
----------
-- Puts --
----------
procedure Put_LLI
(File : File_Type;
Item : Long_Long_Integer;
Width : Field;
Base : Number_Base)
is
Buf : String (1 .. Integer'Max (Field'Last, Width));
Ptr : Natural := 0;
begin
if Base = 10 and then Width = 0 then
Set_Image_Long_Long_Integer (Item, Buf, Ptr);
elsif Base = 10 then
Set_Image_Width_Long_Long_Integer (Item, Width, Buf, Ptr);
else
Set_Image_Based_Long_Long_Integer (Item, Base, Width, Buf, Ptr);
end if;
Put_Item (File, Buf (1 .. Ptr));
end Put_LLI;
--------------
-- Puts_Int --
--------------
procedure Puts_Int
procedure Puts
(To : out String;
Item : Integer;
Item : Num;
Base : Number_Base)
is
Buf : String (1 .. Integer'Max (Field'Last, To'Length));
@ -256,9 +118,9 @@ package body Ada.Text_IO.Integer_Aux is
begin
if Base = 10 then
Set_Image_Width_Integer (Item, To'Length, Buf, Ptr);
Set_Image_Width (Item, To'Length, Buf, Ptr);
else
Set_Image_Based_Integer (Item, Base, To'Length, Buf, Ptr);
Set_Image_Based (Item, Base, To'Length, Buf, Ptr);
end if;
if Ptr > To'Length then
@ -266,32 +128,6 @@ package body Ada.Text_IO.Integer_Aux is
else
To (To'First .. To'First + Ptr - 1) := Buf (1 .. Ptr);
end if;
end Puts_Int;
--------------
-- Puts_LLI --
--------------
procedure Puts_LLI
(To : out String;
Item : Long_Long_Integer;
Base : Number_Base)
is
Buf : String (1 .. Integer'Max (Field'Last, To'Length));
Ptr : Natural := 0;
begin
if Base = 10 then
Set_Image_Width_Long_Long_Integer (Item, To'Length, Buf, Ptr);
else
Set_Image_Based_Long_Long_Integer (Item, Base, To'Length, Buf, Ptr);
end if;
if Ptr > To'Length then
raise Layout_Error;
else
To (To'First .. To'First + Ptr - 1) := Buf (1 .. Ptr);
end if;
end Puts_LLI;
end Puts;
end Ada.Text_IO.Integer_Aux;

66
gcc/ada/libgnat/a-tiinau.ads
View file

@ -29,55 +29,45 @@
-- --
------------------------------------------------------------------------------
-- This package contains the routines for Ada.Text_IO.Integer_IO that are
-- shared among separate instantiations of this package. The routines in
-- this package are identical semantically to those in Integer_IO itself,
-- except that the generic parameter Num has been replaced by Integer or
-- Long_Long_Integer, and the default parameters have been removed because
-- they are supplied explicitly by the calls from within the generic template.
-- This package contains the implementation for Ada.Text_IO.Integer_IO and
-- Ada.Text_IO.Modular_IO. The routines in this package are identical
-- semantically to those in Integer_IO and Modular_IO themselves, except that
-- the default parameters have been removed because they are supplied
-- explicitly by the calls from within these units.
private package Ada.Text_IO.Integer_Aux is
private generic
type Num is (<>);
procedure Get_Int
with function Scan
(Str : String; Ptr : not null access Integer; Max : Integer) return Num;
with procedure Set_Image
(V : Num; S : in out String; P : in out Natural);
with procedure Set_Image_Width
(V : Num; W : Integer; S : out String; P : in out Natural);
with procedure Set_Image_Based
(V : Num; B : Natural; W : Integer; S : out String; P : in out Natural);
package Ada.Text_IO.Integer_Aux is
procedure Get
(File : File_Type;
Item : out Integer;
Item : out Num;
Width : Field);
procedure Get_LLI
(File : File_Type;
Item : out Long_Long_Integer;
Width : Field);
procedure Gets
(From : String;
Item : out Num;
Last : out Positive);
procedure Put_Int
procedure Put
(File : File_Type;
Item : Integer;
Item : Num;
Width : Field;
Base : Number_Base);
procedure Put_LLI
(File : File_Type;
Item : Long_Long_Integer;
Width : Field;
Base : Number_Base);
procedure Gets_Int
(From : String;
Item : out Integer;
Last : out Positive);
procedure Gets_LLI
(From : String;
Item : out Long_Long_Integer;
Last : out Positive);
procedure Puts_Int
procedure Puts
(To : out String;
Item : Integer;
Base : Number_Base);
procedure Puts_LLI
(To : out String;
Item : Long_Long_Integer;
Item : Num;
Base : Number_Base);
end Ada.Text_IO.Integer_Aux;

60
gcc/ada/libgnat/a-tiinio.adb
View file

@ -30,10 +30,32 @@
------------------------------------------------------------------------------
with Ada.Text_IO.Integer_Aux;
with System.Img_BIU; use System.Img_BIU;
with System.Img_Int; use System.Img_Int;
with System.Img_LLB; use System.Img_LLB;
with System.Img_LLI; use System.Img_LLI;
with System.Img_LLW; use System.Img_LLW;
with System.Img_WIU; use System.Img_WIU;
with System.Val_Int; use System.Val_Int;
with System.Val_LLI; use System.Val_LLI;
package body Ada.Text_IO.Integer_IO is
package Aux renames Ada.Text_IO.Integer_Aux;
package Aux_Int is new
Ada.Text_IO.Integer_Aux
(Integer,
Scan_Integer,
Set_Image_Integer,
Set_Image_Width_Integer,
Set_Image_Based_Integer);
package Aux_LLI is new
Ada.Text_IO.Integer_Aux
(Long_Long_Integer,
Scan_Long_Long_Integer,
Set_Image_Long_Long_Integer,
Set_Image_Width_Long_Long_Integer,
Set_Image_Based_Long_Long_Integer);
Need_LLI : constant Boolean := Num'Base'Size > Integer'Size;
-- Throughout this generic body, we distinguish between the case where type
@ -57,9 +79,9 @@ package body Ada.Text_IO.Integer_IO is
begin
if Need_LLI then
Aux.Get_LLI (File, Long_Long_Integer (Item), Width);
Aux_LLI.Get (File, Long_Long_Integer (Item), Width);
else
Aux.Get_Int (File, Integer (Item), Width);
Aux_Int.Get (File, Integer (Item), Width);
end if;
exception
@ -70,20 +92,8 @@ package body Ada.Text_IO.Integer_IO is
(Item : out Num;
Width : Field := 0)
is
-- We depend on a range check to get Data_Error
pragma Unsuppress (Range_Check);
pragma Unsuppress (Overflow_Check);
begin
if Need_LLI then
Aux.Get_LLI (Current_In, Long_Long_Integer (Item), Width);
else
Aux.Get_Int (Current_In, Integer (Item), Width);
end if;
exception
when Constraint_Error => raise Data_Error;
Get (Current_In, Item, Width);
end Get;
procedure Get
@ -98,9 +108,9 @@ package body Ada.Text_IO.Integer_IO is
begin
if Need_LLI then
Aux.Gets_LLI (From, Long_Long_Integer (Item), Last);
Aux_LLI.Gets (From, Long_Long_Integer (Item), Last);
else
Aux.Gets_Int (From, Integer (Item), Last);
Aux_Int.Gets (From, Integer (Item), Last);
end if;
exception
@ -119,9 +129,9 @@ package body Ada.Text_IO.Integer_IO is
is
begin
if Need_LLI then
Aux.Put_LLI (File, Long_Long_Integer (Item), Width, Base);
Aux_LLI.Put (File, Long_Long_Integer (Item), Width, Base);
else
Aux.Put_Int (File, Integer (Item), Width, Base);
Aux_Int.Put (File, Integer (Item), Width, Base);
end if;
end Put;
@ -131,11 +141,7 @@ package body Ada.Text_IO.Integer_IO is
Base : Number_Base := Default_Base)
is
begin
if Need_LLI then
Aux.Put_LLI (Current_Out, Long_Long_Integer (Item), Width, Base);
else
Aux.Put_Int (Current_Out, Integer (Item), Width, Base);
end if;
Put (Current_Out, Item, Width, Base);
end Put;
procedure Put
@ -145,9 +151,9 @@ package body Ada.Text_IO.Integer_IO is
is
begin
if Need_LLI then
Aux.Puts_LLI (To, Long_Long_Integer (Item), Base);
Aux_LLI.Puts (To, Long_Long_Integer (Item), Base);
else
Aux.Puts_Int (To, Integer (Item), Base);
Aux_Int.Puts (To, Integer (Item), Base);
end if;
end Put;

182
gcc/ada/libgnat/a-tiinio__128.adb Normal file
View file

@ -0,0 +1,182 @@
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- A D A . T E X T _ I O . I N T E G E R _ I O --
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
with Ada.Text_IO.Integer_Aux;
with System.Img_BIU; use System.Img_BIU;
with System.Img_Int; use System.Img_Int;
with System.Img_LLB; use System.Img_LLB;
with System.Img_LLI; use System.Img_LLI;
with System.Img_LLW; use System.Img_LLW;
with System.Img_LLLB; use System.Img_LLLB;
with System.Img_LLLI; use System.Img_LLLI;
with System.Img_LLLW; use System.Img_LLLW;
with System.Img_WIU; use System.Img_WIU;
with System.Val_Int; use System.Val_Int;
with System.Val_LLI; use System.Val_LLI;
with System.Val_LLLI; use System.Val_LLLI;
package body Ada.Text_IO.Integer_IO is
package Aux_Int is new
Ada.Text_IO.Integer_Aux
(Integer,
Scan_Integer,
Set_Image_Integer,
Set_Image_Width_Integer,
Set_Image_Based_Integer);
package Aux_LLI is new
Ada.Text_IO.Integer_Aux
(Long_Long_Integer,
Scan_Long_Long_Integer,
Set_Image_Long_Long_Integer,
Set_Image_Width_Long_Long_Integer,
Set_Image_Based_Long_Long_Integer);
package Aux_LLLI is new
Ada.Text_IO.Integer_Aux
(Long_Long_Long_Integer,
Scan_Long_Long_Long_Integer,
Set_Image_Long_Long_Long_Integer,
Set_Image_Width_Long_Long_Long_Integer,
Set_Image_Based_Long_Long_Long_Integer);
Need_LLI : constant Boolean := Num'Base'Size > Integer'Size;
Need_LLLI : constant Boolean := Num'Base'Size > Long_Long_Integer'Size;
-- Throughout this generic body, we distinguish between cases where type
-- Integer is acceptable, where type Long_Long_Integer is acceptable and
-- where type Long_Long_Long_Integer is needed. These boolean constants
-- are used to test for these cases and since they are constant, only code
-- for the relevant case will be included in the instance.
---------
-- Get --
---------
procedure Get
(File : File_Type;
Item : out Num;
Width : Field := 0)
is
-- We depend on a range check to get Data_Error
pragma Unsuppress (Range_Check);
pragma Unsuppress (Overflow_Check);
begin
if Need_LLLI then
Aux_LLLI.Get (File, Long_Long_Long_Integer (Item), Width);
elsif Need_LLI then
Aux_LLI.Get (File, Long_Long_Integer (Item), Width);
else
Aux_Int.Get (File, Integer (Item), Width);
end if;
exception
when Constraint_Error => raise Data_Error;
end Get;
procedure Get
(Item : out Num;
Width : Field := 0)
is
begin
Get (Current_In, Item, Width);
end Get;
procedure Get
(From : String;
Item : out Num;
Last : out Positive)
is
-- We depend on a range check to get Data_Error
pragma Unsuppress (Range_Check);
pragma Unsuppress (Overflow_Check);
begin
if Need_LLLI then
Aux_LLLI.Gets (From, Long_Long_Long_Integer (Item), Last);
elsif Need_LLI then
Aux_LLI.Gets (From, Long_Long_Integer (Item), Last);
else
Aux_Int.Gets (From, Integer (Item), Last);
end if;
exception
when Constraint_Error => raise Data_Error;
end Get;
---------
-- Put --
---------
procedure Put
(File : File_Type;
Item : Num;
Width : Field := Default_Width;
Base : Number_Base := Default_Base)
is
begin
if Need_LLLI then
Aux_LLLI.Put (File, Long_Long_Long_Integer (Item), Width, Base);
elsif Need_LLI then
Aux_LLI.Put (File, Long_Long_Integer (Item), Width, Base);
else
Aux_Int.Put (File, Integer (Item), Width, Base);
end if;
end Put;
procedure Put
(Item : Num;
Width : Field := Default_Width;
Base : Number_Base := Default_Base)
is
begin
Put (Current_Out, Item, Width, Base);
end Put;
procedure Put
(To : out String;
Item : Num;
Base : Number_Base := Default_Base)
is
begin
if Need_LLLI then
Aux_LLLI.Puts (To, Long_Long_Long_Integer (Item), Base);
elsif Need_LLI then
Aux_LLI.Puts (To, Long_Long_Integer (Item), Base);
else
Aux_Int.Puts (To, Integer (Item), Base);
end if;
end Put;
end Ada.Text_IO.Integer_IO;

305
gcc/ada/libgnat/a-timoau.adb
View file

@ -1,305 +0,0 @@
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- A D A . T E X T _ I O . M O D U L A R _ A U X --
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
with Ada.Text_IO.Generic_Aux; use Ada.Text_IO.Generic_Aux;
with System.Img_BIU; use System.Img_BIU;
with System.Img_Uns; use System.Img_Uns;
with System.Img_LLB; use System.Img_LLB;
with System.Img_LLU; use System.Img_LLU;
with System.Img_LLW; use System.Img_LLW;
with System.Img_WIU; use System.Img_WIU;
with System.Val_Uns; use System.Val_Uns;
with System.Val_LLU; use System.Val_LLU;
package body Ada.Text_IO.Modular_Aux is
use System.Unsigned_Types;
-----------------------
-- Local Subprograms --
-----------------------
procedure Load_Modular
(File : File_Type;
Buf : out String;
Ptr : in out Natural);
-- This is an auxiliary routine that is used to load an possibly signed
-- modular literal value from the input file into Buf, starting at Ptr + 1.
-- Ptr is left set to the last character stored.
-------------
-- Get_LLU --
-------------
procedure Get_LLU
(File : File_Type;
Item : out Long_Long_Unsigned;
Width : Field)
is
Buf : String (1 .. Field'Last);
Stop : Integer := 0;
Ptr : aliased Integer := 1;
begin
if Width /= 0 then
Load_Width (File, Width, Buf, Stop);
String_Skip (Buf, Ptr);
else
Load_Modular (File, Buf, Stop);
end if;
Item := Scan_Long_Long_Unsigned (Buf, Ptr'Access, Stop);
Check_End_Of_Field (Buf, Stop, Ptr, Width);
end Get_LLU;
-------------
-- Get_Uns --
-------------
procedure Get_Uns
(File : File_Type;
Item : out Unsigned;
Width : Field)
is
Buf : String (1 .. Field'Last);
Stop : Integer := 0;
Ptr : aliased Integer := 1;
begin
if Width /= 0 then
Load_Width (File, Width, Buf, Stop);
String_Skip (Buf, Ptr);
else
Load_Modular (File, Buf, Stop);
end if;
Item := Scan_Unsigned (Buf, Ptr'Access, Stop);
Check_End_Of_Field (Buf, Stop, Ptr, Width);
end Get_Uns;
--------------
-- Gets_LLU --
--------------
procedure Gets_LLU
(From : String;
Item : out Long_Long_Unsigned;
Last : out Positive)
is
Pos : aliased Integer;
begin
String_Skip (From, Pos);
Item := Scan_Long_Long_Unsigned (From, Pos'Access, From'Last);
Last := Pos - 1;
exception
when Constraint_Error =>
raise Data_Error;
end Gets_LLU;
--------------
-- Gets_Uns --
--------------
procedure Gets_Uns
(From : String;
Item : out Unsigned;
Last : out Positive)
is
Pos : aliased Integer;
begin
String_Skip (From, Pos);
Item := Scan_Unsigned (From, Pos'Access, From'Last);
Last := Pos - 1;
exception
when Constraint_Error =>
raise Data_Error;
end Gets_Uns;
------------------
-- Load_Modular --
------------------
procedure Load_Modular
(File : File_Type;
Buf : out String;
Ptr : in out Natural)
is
Hash_Loc : Natural;
Loaded : Boolean;
begin
Load_Skip (File);
-- Note: it is a bit strange to allow a minus sign here, but it seems
-- consistent with the general behavior expected by the ACVC tests
-- which is to scan past junk and then signal data error, see ACVC
-- test CE3704F, case (6), which is for signed integer exponents,
-- which seems a similar case.
Load (File, Buf, Ptr, '+', '-');
Load_Digits (File, Buf, Ptr, Loaded);
if Loaded then
-- Deal with based case. We recognize either the standard '#' or the
-- allowed alternative replacement ':' (see RM J.2(3)).
Load (File, Buf, Ptr, '#', ':', Loaded);
if Loaded then
Hash_Loc := Ptr;
Load_Extended_Digits (File, Buf, Ptr);
Load (File, Buf, Ptr, Buf (Hash_Loc));
end if;
Load (File, Buf, Ptr, 'E', 'e', Loaded);
if Loaded then
-- Note: it is strange to allow a minus sign, since the syntax
-- does not, but that is what ACVC test CE3704F, case (6) wants
-- for the signed case, and there seems no good reason to treat
-- exponents differently for the signed and unsigned cases.
Load (File, Buf, Ptr, '+', '-');
Load_Digits (File, Buf, Ptr);
end if;
end if;
end Load_Modular;
-------------
-- Put_LLU --
-------------
procedure Put_LLU
(File : File_Type;
Item : Long_Long_Unsigned;
Width : Field;
Base : Number_Base)
is
Buf : String (1 .. Field'Last);
Ptr : Natural := 0;
begin
if Base = 10 and then Width = 0 then
Set_Image_Long_Long_Unsigned (Item, Buf, Ptr);
elsif Base = 10 then
Set_Image_Width_Long_Long_Unsigned (Item, Width, Buf, Ptr);
else
Set_Image_Based_Long_Long_Unsigned (Item, Base, Width, Buf, Ptr);
end if;
Put_Item (File, Buf (1 .. Ptr));
end Put_LLU;
-------------
-- Put_Uns --
-------------
procedure Put_Uns
(File : File_Type;
Item : Unsigned;
Width : Field;
Base : Number_Base)
is
Buf : String (1 .. Field'Last);
Ptr : Natural := 0;
begin
if Base = 10 and then Width = 0 then
Set_Image_Unsigned (Item, Buf, Ptr);
elsif Base = 10 then
Set_Image_Width_Unsigned (Item, Width, Buf, Ptr);
else
Set_Image_Based_Unsigned (Item, Base, Width, Buf, Ptr);
end if;
Put_Item (File, Buf (1 .. Ptr));
end Put_Uns;
--------------
-- Puts_LLU --
--------------
procedure Puts_LLU
(To : out String;
Item : Long_Long_Unsigned;
Base : Number_Base)
is
Buf : String (1 .. Field'Last);
Ptr : Natural := 0;
begin
if Base = 10 then
Set_Image_Width_Long_Long_Unsigned (Item, To'Length, Buf, Ptr);
else
Set_Image_Based_Long_Long_Unsigned (Item, Base, To'Length, Buf, Ptr);
end if;
if Ptr > To'Length then
raise Layout_Error;
else
To (To'First .. To'First + Ptr - 1) := Buf (1 .. Ptr);
end if;
end Puts_LLU;
--------------
-- Puts_Uns --
--------------
procedure Puts_Uns
(To : out String;
Item : Unsigned;
Base : Number_Base)
is
Buf : String (1 .. Field'Last);
Ptr : Natural := 0;
begin
if Base = 10 then
Set_Image_Width_Unsigned (Item, To'Length, Buf, Ptr);
else
Set_Image_Based_Unsigned (Item, Base, To'Length, Buf, Ptr);
end if;
if Ptr > To'Length then
raise Layout_Error;
else
To (To'First .. To'First + Ptr - 1) := Buf (1 .. Ptr);
end if;
end Puts_Uns;
end Ada.Text_IO.Modular_Aux;

87
gcc/ada/libgnat/a-timoau.ads
View file

@ -1,87 +0,0 @@
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- A D A . T E X T _ I O . M O D U L A R _ A U X --
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
-- This package contains the routines for Ada.Text_IO.Modular_IO that are
-- shared among separate instantiations of this package. The routines in
-- this package are identical semantically to those in Modular_IO itself,
-- except that the generic parameter Num has been replaced by Unsigned or
-- Long_Long_Unsigned, and the default parameters have been removed because
-- they are supplied explicitly by the calls from within the generic template.
with System.Unsigned_Types;
private package Ada.Text_IO.Modular_Aux is
package U renames System.Unsigned_Types;
procedure Get_Uns
(File : File_Type;
Item : out U.Unsigned;
Width : Field);
procedure Get_LLU
(File : File_Type;
Item : out U.Long_Long_Unsigned;
Width : Field);
procedure Put_Uns
(File : File_Type;
Item : U.Unsigned;
Width : Field;
Base : Number_Base);
procedure Put_LLU
(File : File_Type;
Item : U.Long_Long_Unsigned;
Width : Field;
Base : Number_Base);
procedure Gets_Uns
(From : String;
Item : out U.Unsigned;
Last : out Positive);
procedure Gets_LLU
(From : String;
Item : out U.Long_Long_Unsigned;
Last : out Positive);
procedure Puts_Uns
(To : out String;
Item : U.Unsigned;
Base : Number_Base);
procedure Puts_LLU
(To : out String;
Item : U.Long_Long_Unsigned;
Base : Number_Base);
end Ada.Text_IO.Modular_Aux;

79
gcc/ada/libgnat/a-timoio.adb
View file

@ -29,13 +29,39 @@
-- --
------------------------------------------------------------------------------
with Ada.Text_IO.Modular_Aux;
with System.Unsigned_Types; use System.Unsigned_Types;
with Ada.Text_IO.Integer_Aux;
with System.Img_BIU; use System.Img_BIU;
with System.Img_Uns; use System.Img_Uns;
with System.Img_LLB; use System.Img_LLB;
with System.Img_LLU; use System.Img_LLU;
with System.Img_LLW; use System.Img_LLW;
with System.Img_WIU; use System.Img_WIU;
with System.Val_Uns; use System.Val_Uns;
with System.Val_LLU; use System.Val_LLU;
package body Ada.Text_IO.Modular_IO is
package Aux renames Ada.Text_IO.Modular_Aux;
package Aux_Uns is new
Ada.Text_IO.Integer_Aux
(Unsigned,
Scan_Unsigned,
Set_Image_Unsigned,
Set_Image_Width_Unsigned,
Set_Image_Based_Unsigned);
package Aux_LLU is new
Ada.Text_IO.Integer_Aux
(Long_Long_Unsigned,
Scan_Long_Long_Unsigned,
Set_Image_Long_Long_Unsigned,
Set_Image_Width_Long_Long_Unsigned,
Set_Image_Based_Long_Long_Unsigned);
Need_LLU : constant Boolean := Num'Base'Size > Unsigned'Size;
-- Throughout this generic body, we distinguish between the case where type
-- Unsigned is acceptable, and where a Long_Long_Unsigned is needed. This
-- Boolean is used to test for these cases and since it is a constant, only
-- code for the relevant case will be included in the instance.
---------
-- Get --
@ -46,13 +72,15 @@ package body Ada.Text_IO.Modular_IO is
Item : out Num;
Width : Field := 0)
is
-- We depend on a range check to get Data_Error
pragma Unsuppress (Range_Check);
begin
if Num'Size > Unsigned'Size then
Aux.Get_LLU (File, Long_Long_Unsigned (Item), Width);
if Need_LLU then
Aux_LLU.Get (File, Long_Long_Unsigned (Item), Width);
else
Aux.Get_Uns (File, Unsigned (Item), Width);
Aux_Uns.Get (File, Unsigned (Item), Width);
end if;
exception
@ -63,17 +91,8 @@ package body Ada.Text_IO.Modular_IO is
(Item : out Num;
Width : Field := 0)
is
pragma Unsuppress (Range_Check);
begin
if Num'Size > Unsigned'Size then
Aux.Get_LLU (Current_In, Long_Long_Unsigned (Item), Width);
else
Aux.Get_Uns (Current_In, Unsigned (Item), Width);
end if;
exception
when Constraint_Error => raise Data_Error;
Get (Current_In, Item, Width);
end Get;
procedure Get
@ -81,13 +100,15 @@ package body Ada.Text_IO.Modular_IO is
Item : out Num;
Last : out Positive)
is
-- We depend on a range check to get Data_Error
pragma Unsuppress (Range_Check);
begin
if Num'Size > Unsigned'Size then
Aux.Gets_LLU (From, Long_Long_Unsigned (Item), Last);
if Need_LLU then
Aux_LLU.Gets (From, Long_Long_Unsigned (Item), Last);
else
Aux.Gets_Uns (From, Unsigned (Item), Last);
Aux_Uns.Gets (From, Unsigned (Item), Last);
end if;
exception
@ -105,10 +126,10 @@ package body Ada.Text_IO.Modular_IO is
Base : Number_Base := Default_Base)
is
begin
if Num'Size > Unsigned'Size then
Aux.Put_LLU (File, Long_Long_Unsigned (Item), Width, Base);
if Need_LLU then
Aux_LLU.Put (File, Long_Long_Unsigned (Item), Width, Base);
else
Aux.Put_Uns (File, Unsigned (Item), Width, Base);
Aux_Uns.Put (File, Unsigned (Item), Width, Base);
end if;
end Put;
@ -118,11 +139,7 @@ package body Ada.Text_IO.Modular_IO is
Base : Number_Base := Default_Base)
is
begin
if Num'Size > Unsigned'Size then
Aux.Put_LLU (Current_Out, Long_Long_Unsigned (Item), Width, Base);
else
Aux.Put_Uns (Current_Out, Unsigned (Item), Width, Base);
end if;
Put (Current_Out, Item, Width, Base);
end Put;
procedure Put
@ -131,10 +148,10 @@ package body Ada.Text_IO.Modular_IO is
Base : Number_Base := Default_Base)
is
begin
if Num'Size > Unsigned'Size then
Aux.Puts_LLU (To, Long_Long_Unsigned (Item), Base);
if Need_LLU then
Aux_LLU.Puts (To, Long_Long_Unsigned (Item), Base);
else
Aux.Puts_Uns (To, Unsigned (Item), Base);
Aux_Uns.Puts (To, Unsigned (Item), Base);
end if;
end Put;

180
gcc/ada/libgnat/a-timoio__128.adb Normal file
View file

@ -0,0 +1,180 @@
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- A D A . T E X T _ I O . M O D U L A R _ I O --
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
with Ada.Text_IO.Integer_Aux;
with System.Img_BIU; use System.Img_BIU;
with System.Img_Uns; use System.Img_Uns;
with System.Img_LLB; use System.Img_LLB;
with System.Img_LLU; use System.Img_LLU;
with System.Img_LLW; use System.Img_LLW;
with System.Img_LLLB; use System.Img_LLLB;
with System.Img_LLLU; use System.Img_LLLU;
with System.Img_LLLW; use System.Img_LLLW;
with System.Img_WIU; use System.Img_WIU;
with System.Val_Uns; use System.Val_Uns;
with System.Val_LLU; use System.Val_LLU;
with System.Val_LLLU; use System.Val_LLLU;
package body Ada.Text_IO.Modular_IO is
package Aux_Uns is new
Ada.Text_IO.Integer_Aux
(Unsigned,
Scan_Unsigned,
Set_Image_Unsigned,
Set_Image_Width_Unsigned,
Set_Image_Based_Unsigned);
package Aux_LLU is new
Ada.Text_IO.Integer_Aux
(Long_Long_Unsigned,
Scan_Long_Long_Unsigned,
Set_Image_Long_Long_Unsigned,
Set_Image_Width_Long_Long_Unsigned,
Set_Image_Based_Long_Long_Unsigned);
package Aux_LLLU is new
Ada.Text_IO.Integer_Aux
(Long_Long_Long_Unsigned,
Scan_Long_Long_Long_Unsigned,
Set_Image_Long_Long_Long_Unsigned,
Set_Image_Width_Long_Long_Long_Unsigned,
Set_Image_Based_Long_Long_Long_Unsigned);
Need_LLU : constant Boolean := Num'Base'Size > Unsigned'Size;
Need_LLLU : constant Boolean := Num'Base'Size > Long_Long_Unsigned'Size;
-- Throughout this generic body, we distinguish between cases where type
-- Unsigned is acceptable, where type Long_Long_Unsigned is acceptable and
-- where type Long_Long_Long_Unsigned is needed. These boolean constants
-- are used to test for these cases and since they are constant, only code
-- for the relevant case will be included in the instance.
---------
-- Get --
---------
procedure Get
(File : File_Type;
Item : out Num;
Width : Field := 0)
is
-- We depend on a range check to get Data_Error
pragma Unsuppress (Range_Check);
begin
if Need_LLLU then
Aux_LLLU.Get (File, Long_Long_Long_Unsigned (Item), Width);
elsif Need_LLU then
Aux_LLU.Get (File, Long_Long_Unsigned (Item), Width);
else
Aux_Uns.Get (File, Unsigned (Item), Width);
end if;
exception
when Constraint_Error => raise Data_Error;
end Get;
procedure Get
(Item : out Num;
Width : Field := 0)
is
begin
Get (Current_In, Item, Width);
end Get;
procedure Get
(From : String;
Item : out Num;
Last : out Positive)
is
-- We depend on a range check to get Data_Error
pragma Unsuppress (Range_Check);
begin
if Need_LLLU then
Aux_LLLU.Gets (From, Long_Long_Long_Unsigned (Item), Last);
elsif Need_LLU then
Aux_LLU.Gets (From, Long_Long_Unsigned (Item), Last);
else
Aux_Uns.Gets (From, Unsigned (Item), Last);
end if;
exception
when Constraint_Error => raise Data_Error;
end Get;
---------
-- Put --
---------
procedure Put
(File : File_Type;
Item : Num;
Width : Field := Default_Width;
Base : Number_Base := Default_Base)
is
begin
if Need_LLLU then
Aux_LLLU.Put (File, Long_Long_Long_Unsigned (Item), Width, Base);
elsif Need_LLU then
Aux_LLU.Put (File, Long_Long_Unsigned (Item), Width, Base);
else
Aux_Uns.Put (File, Unsigned (Item), Width, Base);
end if;
end Put;
procedure Put
(Item : Num;
Width : Field := Default_Width;
Base : Number_Base := Default_Base)
is
begin
Put (Current_Out, Item, Width, Base);
end Put;
procedure Put
(To : out String;
Item : Num;
Base : Number_Base := Default_Base)
is
begin
if Need_LLLU then
Aux_LLLU.Puts (To, Long_Long_Long_Unsigned (Item), Base);
elsif Need_LLU then
Aux_LLU.Puts (To, Long_Long_Unsigned (Item), Base);
else
Aux_Uns.Puts (To, Unsigned (Item), Base);
end if;
end Put;
end Ada.Text_IO.Modular_IO;

54
gcc/ada/libgnat/a-wtgeau.adb
View file

@ -348,6 +348,60 @@ package body Ada.Wide_Text_IO.Generic_Aux is
Load_Extended_Digits (File, Buf, Ptr, Junk);
end Load_Extended_Digits;
------------------
-- Load_Integer --
------------------
procedure Load_Integer
(File : File_Type;
Buf : out String;
Ptr : in out Natural)
is
Hash_Loc : Natural;
Loaded : Boolean;
begin
Load_Skip (File);
-- Note: it is a bit strange to allow a minus sign here, but it seems
-- consistent with the general behavior expected by the ACVC tests
-- which is to scan past junk and then signal data error, see ACVC
-- test CE3704F, case (6), which is for signed integer exponents,
-- which seems a similar case.
Load (File, Buf, Ptr, '+', '-');
Load_Digits (File, Buf, Ptr, Loaded);
if Loaded then
-- Deal with based literal. We recognize either the standard '#' or
-- the allowed alternative replacement ':' (see RM J.2(3)).
Load (File, Buf, Ptr, '#', ':', Loaded);
if Loaded then
Hash_Loc := Ptr;
Load_Extended_Digits (File, Buf, Ptr);
Load (File, Buf, Ptr, Buf (Hash_Loc));
end if;
-- Deal with exponent
Load (File, Buf, Ptr, 'E', 'e', Loaded);
if Loaded then
-- Note: it is strange to allow a minus sign, since the syntax
-- does not, but that is what ACVC test CE3704F, case (6) wants
-- for the signed case, and there seems no good reason to treat
-- exponents differently for the signed and unsigned cases.
Load (File, Buf, Ptr, '+', '-');
Load_Digits (File, Buf, Ptr);
end if;
end if;
end Load_Integer;
---------------
-- Load_Skip --
---------------

8
gcc/ada/libgnat/a-wtgeau.ads
View file

@ -149,6 +149,12 @@ package Ada.Wide_Text_IO.Generic_Aux is
Ptr : in out Integer);
-- Same as above, but no indication if character is loaded
procedure Load_Integer
(File : File_Type;
Buf : out String;
Ptr : in out Natural);
-- Loads a possibly signed integer literal value
procedure Put_Item (File : File_Type; Str : String);
-- This routine is like Wide_Text_IO.Put, except that it checks for
-- overflow of bounded lines, as described in (RM A.10.6(8)). It is used
@ -169,7 +175,7 @@ package Ada.Wide_Text_IO.Generic_Aux is
procedure String_Skip (Str : String; Ptr : out Integer);
-- Used in the Get from string procedures to skip leading blanks in the
-- string. Ptr is set to the index of the first non-blank. If the string
-- is all blanks, then the excption End_Error is raised, Note that blank
-- is all blanks, then the exception End_Error is raised, Note that blank
-- is defined as a space or horizontal tab (RM A.10.6(5)).
procedure Ungetc (ch : Integer; File : File_Type);

230
gcc/ada/libgnat/a-wtinau.adb
View file

@ -2,7 +2,7 @@
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- A D A . W I D E _ T E X T _ I O . I N T E G E R _ A U X --
-- A D A . W I D E _ T E X T _ I O . I N T E G E R _ A U X --
-- --
-- B o d y --
-- --
@ -31,36 +31,15 @@
with Ada.Wide_Text_IO.Generic_Aux; use Ada.Wide_Text_IO.Generic_Aux;
with System.Img_BIU; use System.Img_BIU;
with System.Img_Int; use System.Img_Int;
with System.Img_LLB; use System.Img_LLB;
with System.Img_LLI; use System.Img_LLI;
with System.Img_LLW; use System.Img_LLW;
with System.Img_WIU; use System.Img_WIU;
with System.Val_Int; use System.Val_Int;
with System.Val_LLI; use System.Val_LLI;
package body Ada.Wide_Text_IO.Integer_Aux is
-----------------------
-- Local Subprograms --
-----------------------
---------
-- Get --
---------
procedure Load_Integer
(File : File_Type;
Buf : out String;
Ptr : in out Natural);
-- This is an auxiliary routine that is used to load an possibly signed
-- integer literal value from the input file into Buf, starting at Ptr + 1.
-- On return, Ptr is set to the last character stored.
-------------
-- Get_Int --
-------------
procedure Get_Int
procedure Get
(File : File_Type;
Item : out Integer;
Item : out Num;
Width : Field)
is
Buf : String (1 .. Field'Last);
@ -75,188 +54,73 @@ package body Ada.Wide_Text_IO.Integer_Aux is
Load_Integer (File, Buf, Stop);
end if;
Item := Scan_Integer (Buf, Ptr'Access, Stop);
Item := Scan (Buf, Ptr'Access, Stop);
Check_End_Of_Field (Buf, Stop, Ptr, Width);
end Get_Int;
end Get;
-------------
-- Get_LLI --
-------------
----------
-- Gets --
----------
procedure Get_LLI
(File : File_Type;
Item : out Long_Long_Integer;
Width : Field)
is
Buf : String (1 .. Field'Last);
Ptr : aliased Integer := 1;
Stop : Integer := 0;
begin
if Width /= 0 then
Load_Width (File, Width, Buf, Stop);
String_Skip (Buf, Ptr);
else
Load_Integer (File, Buf, Stop);
end if;
Item := Scan_Long_Long_Integer (Buf, Ptr'Access, Stop);
Check_End_Of_Field (Buf, Stop, Ptr, Width);
end Get_LLI;
--------------
-- Gets_Int --
--------------
procedure Gets_Int
procedure Gets
(From : String;
Item : out Integer;
Item : out Num;
Last : out Positive)
is
Pos : aliased Integer;
begin
String_Skip (From, Pos);
Item := Scan_Integer (From, Pos'Access, From'Last);
Item := Scan (From, Pos'Access, From'Last);
Last := Pos - 1;
exception
when Constraint_Error =>
raise Data_Error;
end Gets_Int;
end Gets;
--------------
-- Gets_LLI --
--------------
---------
-- Put --
---------
procedure Gets_LLI
(From : String;
Item : out Long_Long_Integer;
Last : out Positive)
is
Pos : aliased Integer;
begin
String_Skip (From, Pos);
Item := Scan_Long_Long_Integer (From, Pos'Access, From'Last);
Last := Pos - 1;
exception
when Constraint_Error =>
raise Data_Error;
end Gets_LLI;
------------------
-- Load_Integer --
------------------
procedure Load_Integer
(File : File_Type;
Buf : out String;
Ptr : in out Natural)
is
Hash_Loc : Natural;
Loaded : Boolean;
begin
Load_Skip (File);
Load (File, Buf, Ptr, '+', '-');
Load_Digits (File, Buf, Ptr, Loaded);
if Loaded then
-- Deal with based case. We recognize either the standard '#' or the
-- allowed alternative replacement ':' (see RM J.2(3)).
Load (File, Buf, Ptr, '#', ':', Loaded);
if Loaded then
Hash_Loc := Ptr;
Load_Extended_Digits (File, Buf, Ptr);
Load (File, Buf, Ptr, Buf (Hash_Loc));
end if;
Load (File, Buf, Ptr, 'E', 'e', Loaded);
if Loaded then
-- Note: it is strange to allow a minus sign, since the syntax
-- does not, but that is what ACVC test CE3704F, case (6) wants.
Load (File, Buf, Ptr, '+', '-');
Load_Digits (File, Buf, Ptr);
end if;
end if;
end Load_Integer;
-------------
-- Put_Int --
-------------
procedure Put_Int
procedure Put
(File : File_Type;
Item : Integer;
Item : Num;
Width : Field;
Base : Number_Base)
is
Buf : String (1 .. Field'Last);
Buf : String (1 .. Integer'Max (Field'Last, Width));
Ptr : Natural := 0;
begin
if Base = 10 and then Width = 0 then
Set_Image_Integer (Item, Buf, Ptr);
Set_Image (Item, Buf, Ptr);
elsif Base = 10 then
Set_Image_Width_Integer (Item, Width, Buf, Ptr);
Set_Image_Width (Item, Width, Buf, Ptr);
else
Set_Image_Based_Integer (Item, Base, Width, Buf, Ptr);
Set_Image_Based (Item, Base, Width, Buf, Ptr);
end if;
Put_Item (File, Buf (1 .. Ptr));
end Put_Int;
end Put;
-------------
-- Put_LLI --
-------------
----------
-- Puts --
----------
procedure Put_LLI
(File : File_Type;
Item : Long_Long_Integer;
Width : Field;
Base : Number_Base)
is
Buf : String (1 .. Field'Last);
Ptr : Natural := 0;
begin
if Base = 10 and then Width = 0 then
Set_Image_Long_Long_Integer (Item, Buf, Ptr);
elsif Base = 10 then
Set_Image_Width_Long_Long_Integer (Item, Width, Buf, Ptr);
else
Set_Image_Based_Long_Long_Integer (Item, Base, Width, Buf, Ptr);
end if;
Put_Item (File, Buf (1 .. Ptr));
end Put_LLI;
--------------
-- Puts_Int --
--------------
procedure Puts_Int
procedure Puts
(To : out String;
Item : Integer;
Item : Num;
Base : Number_Base)
is
Buf : String (1 .. Field'Last);
Buf : String (1 .. Integer'Max (Field'Last, To'Length));
Ptr : Natural := 0;
begin
if Base = 10 then
Set_Image_Width_Integer (Item, To'Length, Buf, Ptr);
Set_Image_Width (Item, To'Length, Buf, Ptr);
else
Set_Image_Based_Integer (Item, Base, To'Length, Buf, Ptr);
Set_Image_Based (Item, Base, To'Length, Buf, Ptr);
end if;
if Ptr > To'Length then
@ -264,32 +128,6 @@ package body Ada.Wide_Text_IO.Integer_Aux is
else
To (To'First .. To'First + Ptr - 1) := Buf (1 .. Ptr);
end if;
end Puts_Int;
--------------
-- Puts_LLI --
--------------
procedure Puts_LLI
(To : out String;
Item : Long_Long_Integer;
Base : Number_Base)
is
Buf : String (1 .. Field'Last);
Ptr : Natural := 0;
begin
if Base = 10 then
Set_Image_Width_Long_Long_Integer (Item, To'Length, Buf, Ptr);
else
Set_Image_Based_Long_Long_Integer (Item, Base, To'Length, Buf, Ptr);
end if;
if Ptr > To'Length then
raise Layout_Error;
else
To (To'First .. To'First + Ptr - 1) := Buf (1 .. Ptr);
end if;
end Puts_LLI;
end Puts;
end Ada.Wide_Text_IO.Integer_Aux;

62
gcc/ada/libgnat/a-wtinau.ads
View file

@ -29,55 +29,45 @@
-- --
------------------------------------------------------------------------------
-- This package contains the routines for Ada.Wide_Text_IO.Integer_IO that
-- are shared among separate instantiations of this package. The routines
-- in this package are identical semantically to those in Integer_IO itself,
-- except that the generic parameter Num has been replaced by Integer or
-- Long_Long_Integer, and the default parameters have been removed because
-- they are supplied explicitly by the calls from within the generic template.
-- This package contains the implementation for Ada.Wide_Text_IO.Integer_IO
-- and Ada.Wide_Text_IO.Modular_IO. The routines in this package are identical
-- semantically to those in Integer_IO and Modular_IO themselves, except that
-- the default parameters have been removed because they are supplied
-- explicitly by the calls from within these units.
private package Ada.Wide_Text_IO.Integer_Aux is
private generic
type Num is (<>);
procedure Get_Int
with function Scan
(Str : String; Ptr : not null access Integer; Max : Integer) return Num;
with procedure Set_Image
(V : Num; S : in out String; P : in out Natural);
with procedure Set_Image_Width
(V : Num; W : Integer; S : out String; P : in out Natural);
with procedure Set_Image_Based
(V : Num; B : Natural; W : Integer; S : out String; P : in out Natural);
package Ada.Wide_Text_IO.Integer_Aux is
procedure Get
(File : File_Type;
Item : out Integer;
Item : out Num;
Width : Field);
procedure Get_LLI
(File : File_Type;
Item : out Long_Long_Integer;
Width : Field);
procedure Gets_Int
procedure Gets
(From : String;
Item : out Integer;
Item : out Num;
Last : out Positive);
procedure Gets_LLI
(From : String;
Item : out Long_Long_Integer;
Last : out Positive);
procedure Put_Int
procedure Put
(File : File_Type;
Item : Integer;
Item : Num;
Width : Field;
Base : Number_Base);
procedure Put_LLI
(File : File_Type;
Item : Long_Long_Integer;
Width : Field;
Base : Number_Base);
procedure Puts_Int
procedure Puts
(To : out String;
Item : Integer;
Base : Number_Base);
procedure Puts_LLI
(To : out String;
Item : Long_Long_Integer;
Item : Num;
Base : Number_Base);
end Ada.Wide_Text_IO.Integer_Aux;

52
gcc/ada/libgnat/a-wtinio.adb
View file

@ -30,11 +30,35 @@
------------------------------------------------------------------------------
with Ada.Wide_Text_IO.Integer_Aux;
with System.Img_BIU; use System.Img_BIU;
with System.Img_Int; use System.Img_Int;
with System.Img_LLB; use System.Img_LLB;
with System.Img_LLI; use System.Img_LLI;
with System.Img_LLW; use System.Img_LLW;
with System.Img_WIU; use System.Img_WIU;
with System.Val_Int; use System.Val_Int;
with System.Val_LLI; use System.Val_LLI;
with System.WCh_Con; use System.WCh_Con;
with System.WCh_WtS; use System.WCh_WtS;
package body Ada.Wide_Text_IO.Integer_IO is
package Aux_Int is new
Ada.Wide_Text_IO.Integer_Aux
(Integer,
Scan_Integer,
Set_Image_Integer,
Set_Image_Width_Integer,
Set_Image_Based_Integer);
package Aux_LLI is new
Ada.Wide_Text_IO.Integer_Aux
(Long_Long_Integer,
Scan_Long_Long_Integer,
Set_Image_Long_Long_Integer,
Set_Image_Width_Long_Long_Integer,
Set_Image_Based_Long_Long_Integer);
Need_LLI : constant Boolean := Num'Base'Size > Integer'Size;
-- Throughout this generic body, we distinguish between the case where type
-- Integer is acceptable, and where a Long_Long_Integer is needed. This
@ -44,8 +68,6 @@ package body Ada.Wide_Text_IO.Integer_IO is
subtype TFT is Ada.Wide_Text_IO.File_Type;
-- File type required for calls to routines in Aux
package Aux renames Ada.Wide_Text_IO.Integer_Aux;
---------
-- Get --
---------
@ -55,11 +77,16 @@ package body Ada.Wide_Text_IO.Integer_IO is
Item : out Num;
Width : Field := 0)
is
-- We depend on a range check to get Data_Error
pragma Unsuppress (Range_Check);
pragma Unsuppress (Overflow_Check);
begin
if Need_LLI then
Aux.Get_LLI (TFT (File), Long_Long_Integer (Item), Width);
Aux_LLI.Get (TFT (File), Long_Long_Integer (Item), Width);
else
Aux.Get_Int (TFT (File), Integer (Item), Width);
Aux_Int.Get (TFT (File), Integer (Item), Width);
end if;
exception
@ -79,6 +106,11 @@ package body Ada.Wide_Text_IO.Integer_IO is
Item : out Num;
Last : out Positive)
is
-- We depend on a range check to get Data_Error
pragma Unsuppress (Range_Check);
pragma Unsuppress (Overflow_Check);
S : constant String := Wide_String_To_String (From, WCEM_Upper);
-- String on which we do the actual conversion. Note that the method
-- used for wide character encoding is irrelevant, since if there is
@ -87,9 +119,9 @@ package body Ada.Wide_Text_IO.Integer_IO is
begin
if Need_LLI then
Aux.Gets_LLI (S, Long_Long_Integer (Item), Last);
Aux_LLI.Gets (S, Long_Long_Integer (Item), Last);
else
Aux.Gets_Int (S, Integer (Item), Last);
Aux_Int.Gets (S, Integer (Item), Last);
end if;
exception
@ -108,9 +140,9 @@ package body Ada.Wide_Text_IO.Integer_IO is
is
begin
if Need_LLI then
Aux.Put_LLI (TFT (File), Long_Long_Integer (Item), Width, Base);
Aux_LLI.Put (TFT (File), Long_Long_Integer (Item), Width, Base);
else
Aux.Put_Int (TFT (File), Integer (Item), Width, Base);
Aux_Int.Put (TFT (File), Integer (Item), Width, Base);
end if;
end Put;
@ -132,9 +164,9 @@ package body Ada.Wide_Text_IO.Integer_IO is
begin
if Need_LLI then
Aux.Puts_LLI (S, Long_Long_Integer (Item), Base);
Aux_LLI.Puts (S, Long_Long_Integer (Item), Base);
else
Aux.Puts_Int (S, Integer (Item), Base);
Aux_Int.Puts (S, Integer (Item), Base);
end if;
for J in S'Range loop

199
gcc/ada/libgnat/a-wtinio__128.adb Normal file
View file

@ -0,0 +1,199 @@
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- A D A . W I D E _ T E X T _ I O . I N T E G E R _ I O --
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
with Ada.Wide_Text_IO.Integer_Aux;
with System.Img_BIU; use System.Img_BIU;
with System.Img_Int; use System.Img_Int;
with System.Img_LLB; use System.Img_LLB;
with System.Img_LLI; use System.Img_LLI;
with System.Img_LLW; use System.Img_LLW;
with System.Img_LLLB; use System.Img_LLLB;
with System.Img_LLLI; use System.Img_LLLI;
with System.Img_LLLW; use System.Img_LLLW;
with System.Img_WIU; use System.Img_WIU;
with System.Val_Int; use System.Val_Int;
with System.Val_LLI; use System.Val_LLI;
with System.Val_LLLI; use System.Val_LLLI;
with System.WCh_Con; use System.WCh_Con;
with System.WCh_WtS; use System.WCh_WtS;
package body Ada.Wide_Text_IO.Integer_IO is
package Aux_Int is new
Ada.Wide_Text_IO.Integer_Aux
(Integer,
Scan_Integer,
Set_Image_Integer,
Set_Image_Width_Integer,
Set_Image_Based_Integer);
package Aux_LLI is new
Ada.Wide_Text_IO.Integer_Aux
(Long_Long_Integer,
Scan_Long_Long_Integer,
Set_Image_Long_Long_Integer,
Set_Image_Width_Long_Long_Integer,
Set_Image_Based_Long_Long_Integer);
package Aux_LLLI is new
Ada.Wide_Text_IO.Integer_Aux
(Long_Long_Long_Integer,
Scan_Long_Long_Long_Integer,
Set_Image_Long_Long_Long_Integer,
Set_Image_Width_Long_Long_Long_Integer,
Set_Image_Based_Long_Long_Long_Integer);
Need_LLI : constant Boolean := Num'Base'Size > Integer'Size;
Need_LLLI : constant Boolean := Num'Base'Size > Long_Long_Integer'Size;
-- Throughout this generic body, we distinguish between cases where type
-- Integer is acceptable, where type Long_Long_Integer is acceptable and
-- where type Long_Long_Long_Integer is needed. These boolean constants
-- are used to test for these cases and since they are constant, only code
-- for the relevant case will be included in the instance.
subtype TFT is Ada.Wide_Text_IO.File_Type;
-- File type required for calls to routines in Aux
---------
-- Get --
---------
procedure Get
(File : File_Type;
Item : out Num;
Width : Field := 0)
is
-- We depend on a range check to get Data_Error
pragma Unsuppress (Range_Check);
pragma Unsuppress (Overflow_Check);
begin
if Need_LLLI then
Aux_LLLI.Get (TFT (File), Long_Long_Long_Integer (Item), Width);
elsif Need_LLI then
Aux_LLI.Get (TFT (File), Long_Long_Integer (Item), Width);
else
Aux_Int.Get (TFT (File), Integer (Item), Width);
end if;
exception
when Constraint_Error => raise Data_Error;
end Get;
procedure Get
(Item : out Num;
Width : Field := 0)
is
begin
Get (Current_Input, Item, Width);
end Get;
procedure Get
(From : Wide_String;
Item : out Num;
Last : out Positive)
is
-- We depend on a range check to get Data_Error
pragma Unsuppress (Range_Check);
pragma Unsuppress (Overflow_Check);
S : constant String := Wide_String_To_String (From, WCEM_Upper);
-- String on which we do the actual conversion. Note that the method
-- used for wide character encoding is irrelevant, since if there is
-- a character outside the Standard.Character range then the call to
-- Aux.Gets will raise Data_Error in any case.
begin
if Need_LLLI then
Aux_LLLI.Gets (S, Long_Long_Long_Integer (Item), Last);
elsif Need_LLI then
Aux_LLI.Gets (S, Long_Long_Integer (Item), Last);
else
Aux_Int.Gets (S, Integer (Item), Last);
end if;
exception
when Constraint_Error => raise Data_Error;
end Get;
---------
-- Put --
---------
procedure Put
(File : File_Type;
Item : Num;
Width : Field := Default_Width;
Base : Number_Base := Default_Base)
is
begin
if Need_LLLI then
Aux_LLLI.Put (TFT (File), Long_Long_Long_Integer (Item), Width, Base);
elsif Need_LLI then
Aux_LLI.Put (TFT (File), Long_Long_Integer (Item), Width, Base);
else
Aux_Int.Put (TFT (File), Integer (Item), Width, Base);
end if;
end Put;
procedure Put
(Item : Num;
Width : Field := Default_Width;
Base : Number_Base := Default_Base)
is
begin
Put (Current_Output, Item, Width, Base);
end Put;
procedure Put
(To : out Wide_String;
Item : Num;
Base : Number_Base := Default_Base)
is
S : String (To'First .. To'Last);
begin
if Need_LLLI then
Aux_LLLI.Puts (S, Long_Long_Long_Integer (Item), Base);
elsif Need_LLI then
Aux_LLI.Puts (S, Long_Long_Integer (Item), Base);
else
Aux_Int.Puts (S, Integer (Item), Base);
end if;
for J in S'Range loop
To (J) := Wide_Character'Val (Character'Pos (S (J)));
end loop;
end Put;
end Ada.Wide_Text_IO.Integer_IO;

305
gcc/ada/libgnat/a-wtmoau.adb
View file

@ -1,305 +0,0 @@
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- A D A . W I D E _ T E X T _ I O . M O D U L A R _ A U X --
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
with Ada.Wide_Text_IO.Generic_Aux; use Ada.Wide_Text_IO.Generic_Aux;
with System.Img_BIU; use System.Img_BIU;
with System.Img_Uns; use System.Img_Uns;
with System.Img_LLB; use System.Img_LLB;
with System.Img_LLU; use System.Img_LLU;
with System.Img_LLW; use System.Img_LLW;
with System.Img_WIU; use System.Img_WIU;
with System.Val_Uns; use System.Val_Uns;
with System.Val_LLU; use System.Val_LLU;
package body Ada.Wide_Text_IO.Modular_Aux is
use System.Unsigned_Types;
-----------------------
-- Local Subprograms --
-----------------------
procedure Load_Modular
(File : File_Type;
Buf : out String;
Ptr : in out Natural);
-- This is an auxiliary routine that is used to load an possibly signed
-- modular literal value from the input file into Buf, starting at Ptr + 1.
-- Ptr is left set to the last character stored.
-------------
-- Get_LLU --
-------------
procedure Get_LLU
(File : File_Type;
Item : out Long_Long_Unsigned;
Width : Field)
is
Buf : String (1 .. Field'Last);
Stop : Integer := 0;
Ptr : aliased Integer := 1;
begin
if Width /= 0 then
Load_Width (File, Width, Buf, Stop);
String_Skip (Buf, Ptr);
else
Load_Modular (File, Buf, Stop);
end if;
Item := Scan_Long_Long_Unsigned (Buf, Ptr'Access, Stop);
Check_End_Of_Field (Buf, Stop, Ptr, Width);
end Get_LLU;
-------------
-- Get_Uns --
-------------
procedure Get_Uns
(File : File_Type;
Item : out Unsigned;
Width : Field)
is
Buf : String (1 .. Field'Last);
Stop : Integer := 0;
Ptr : aliased Integer := 1;
begin
if Width /= 0 then
Load_Width (File, Width, Buf, Stop);
String_Skip (Buf, Ptr);
else
Load_Modular (File, Buf, Stop);
end if;
Item := Scan_Unsigned (Buf, Ptr'Access, Stop);
Check_End_Of_Field (Buf, Stop, Ptr, Width);
end Get_Uns;
--------------
-- Gets_LLU --
--------------
procedure Gets_LLU
(From : String;
Item : out Long_Long_Unsigned;
Last : out Positive)
is
Pos : aliased Integer;
begin
String_Skip (From, Pos);
Item := Scan_Long_Long_Unsigned (From, Pos'Access, From'Last);
Last := Pos - 1;
exception
when Constraint_Error =>
raise Data_Error;
end Gets_LLU;
--------------
-- Gets_Uns --
--------------
procedure Gets_Uns
(From : String;
Item : out Unsigned;
Last : out Positive)
is
Pos : aliased Integer;
begin
String_Skip (From, Pos);
Item := Scan_Unsigned (From, Pos'Access, From'Last);
Last := Pos - 1;
exception
when Constraint_Error =>
raise Data_Error;
end Gets_Uns;
------------------
-- Load_Modular --
------------------
procedure Load_Modular
(File : File_Type;
Buf : out String;
Ptr : in out Natural)
is
Hash_Loc : Natural;
Loaded : Boolean;
begin
Load_Skip (File);
-- Note: it is a bit strange to allow a minus sign here, but it seems
-- consistent with the general behavior expected by the ACVC tests
-- which is to scan past junk and then signal data error, see ACVC
-- test CE3704F, case (6), which is for signed integer exponents,
-- which seems a similar case.
Load (File, Buf, Ptr, '+', '-');
Load_Digits (File, Buf, Ptr, Loaded);
if Loaded then
-- Deal with based case. We recognize either the standard '#' or the
-- allowed alternative replacement ':' (see RM J.2(3)).
Load (File, Buf, Ptr, '#', ':', Loaded);
if Loaded then
Hash_Loc := Ptr;
Load_Extended_Digits (File, Buf, Ptr);
Load (File, Buf, Ptr, Buf (Hash_Loc));
end if;
Load (File, Buf, Ptr, 'E', 'e', Loaded);
if Loaded then
-- Note: it is strange to allow a minus sign, since the syntax
-- does not, but that is what ACVC test CE3704F, case (6) wants
-- for the signed case, and there seems no good reason to treat
-- exponents differently for the signed and unsigned cases.
Load (File, Buf, Ptr, '+', '-');
Load_Digits (File, Buf, Ptr);
end if;
end if;
end Load_Modular;
-------------
-- Put_LLU --
-------------
procedure Put_LLU
(File : File_Type;
Item : Long_Long_Unsigned;
Width : Field;
Base : Number_Base)
is
Buf : String (1 .. Field'Last);
Ptr : Natural := 0;
begin
if Base = 10 and then Width = 0 then
Set_Image_Long_Long_Unsigned (Item, Buf, Ptr);
elsif Base = 10 then
Set_Image_Width_Long_Long_Unsigned (Item, Width, Buf, Ptr);
else
Set_Image_Based_Long_Long_Unsigned (Item, Base, Width, Buf, Ptr);
end if;
Put_Item (File, Buf (1 .. Ptr));
end Put_LLU;
-------------
-- Put_Uns --
-------------
procedure Put_Uns
(File : File_Type;
Item : Unsigned;
Width : Field;
Base : Number_Base)
is
Buf : String (1 .. Field'Last);
Ptr : Natural := 0;
begin
if Base = 10 and then Width = 0 then
Set_Image_Unsigned (Item, Buf, Ptr);
elsif Base = 10 then
Set_Image_Width_Unsigned (Item, Width, Buf, Ptr);
else
Set_Image_Based_Unsigned (Item, Base, Width, Buf, Ptr);
end if;
Put_Item (File, Buf (1 .. Ptr));
end Put_Uns;
--------------
-- Puts_LLU --
--------------
procedure Puts_LLU
(To : out String;
Item : Long_Long_Unsigned;
Base : Number_Base)
is
Buf : String (1 .. Field'Last);
Ptr : Natural := 0;
begin
if Base = 10 then
Set_Image_Width_Long_Long_Unsigned (Item, To'Length, Buf, Ptr);
else
Set_Image_Based_Long_Long_Unsigned (Item, Base, To'Length, Buf, Ptr);
end if;
if Ptr > To'Length then
raise Layout_Error;
else
To (To'First .. To'First + Ptr - 1) := Buf (1 .. Ptr);
end if;
end Puts_LLU;
--------------
-- Puts_Uns --
--------------
procedure Puts_Uns
(To : out String;
Item : Unsigned;
Base : Number_Base)
is
Buf : String (1 .. Field'Last);
Ptr : Natural := 0;
begin
if Base = 10 then
Set_Image_Width_Unsigned (Item, To'Length, Buf, Ptr);
else
Set_Image_Based_Unsigned (Item, Base, To'Length, Buf, Ptr);
end if;
if Ptr > To'Length then
raise Layout_Error;
else
To (To'First .. To'First + Ptr - 1) := Buf (1 .. Ptr);
end if;
end Puts_Uns;
end Ada.Wide_Text_IO.Modular_Aux;

87
gcc/ada/libgnat/a-wtmoau.ads
View file

@ -1,87 +0,0 @@
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- A D A . W I D E _ T E X T _ I O . M O D U L A R _ A U X --
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
-- This package contains the routines for Ada.Wide_Text_IO.Modular_IO that
-- are shared among separate instantiations of this package. The routines
-- in this package are identical semantically to those in Modular_IO itself,
-- except that the generic parameter Num has been replaced by Unsigned or
-- Long_Long_Unsigned, and the default parameters have been removed because
-- they are supplied explicitly by the calls from within the generic template.
with System.Unsigned_Types;
private package Ada.Wide_Text_IO.Modular_Aux is
package U renames System.Unsigned_Types;
procedure Get_Uns
(File : File_Type;
Item : out U.Unsigned;
Width : Field);
procedure Get_LLU
(File : File_Type;
Item : out U.Long_Long_Unsigned;
Width : Field);
procedure Gets_Uns
(From : String;
Item : out U.Unsigned;
Last : out Positive);
procedure Gets_LLU
(From : String;
Item : out U.Long_Long_Unsigned;
Last : out Positive);
procedure Put_Uns
(File : File_Type;
Item : U.Unsigned;
Width : Field;
Base : Number_Base);
procedure Put_LLU
(File : File_Type;
Item : U.Long_Long_Unsigned;
Width : Field;
Base : Number_Base);
procedure Puts_Uns
(To : out String;
Item : U.Unsigned;
Base : Number_Base);
procedure Puts_LLU
(To : out String;
Item : U.Long_Long_Unsigned;
Base : Number_Base);
end Ada.Wide_Text_IO.Modular_Aux;

72
gcc/ada/libgnat/a-wtmoio.adb
View file

@ -29,19 +29,45 @@
-- --
------------------------------------------------------------------------------
with Ada.Wide_Text_IO.Modular_Aux;
with System.Unsigned_Types; use System.Unsigned_Types;
with System.WCh_Con; use System.WCh_Con;
with System.WCh_WtS; use System.WCh_WtS;
with Ada.Wide_Text_IO.Integer_Aux;
with System.Img_BIU; use System.Img_BIU;
with System.Img_Uns; use System.Img_Uns;
with System.Img_LLB; use System.Img_LLB;
with System.Img_LLU; use System.Img_LLU;
with System.Img_LLW; use System.Img_LLW;
with System.Img_WIU; use System.Img_WIU;
with System.Val_Uns; use System.Val_Uns;
with System.Val_LLU; use System.Val_LLU;
with System.WCh_Con; use System.WCh_Con;
with System.WCh_WtS; use System.WCh_WtS;
package body Ada.Wide_Text_IO.Modular_IO is
package Aux_Uns is new
Ada.Wide_Text_IO.Integer_Aux
(Unsigned,
Scan_Unsigned,
Set_Image_Unsigned,
Set_Image_Width_Unsigned,
Set_Image_Based_Unsigned);
package Aux_LLU is new
Ada.Wide_Text_IO.Integer_Aux
(Long_Long_Unsigned,
Scan_Long_Long_Unsigned,
Set_Image_Long_Long_Unsigned,
Set_Image_Width_Long_Long_Unsigned,
Set_Image_Based_Long_Long_Unsigned);
Need_LLU : constant Boolean := Num'Base'Size > Unsigned'Size;
-- Throughout this generic body, we distinguish between the case where type
-- Unsigned is acceptable, and where a Long_Long_Unsigned is needed. This
-- Boolean is used to test for these cases and since it is a constant, only
-- code for the relevant case will be included in the instance.
subtype TFT is Ada.Wide_Text_IO.File_Type;
-- File type required for calls to routines in Aux
package Aux renames Ada.Wide_Text_IO.Modular_Aux;
---------
-- Get --
---------
@ -51,11 +77,15 @@ package body Ada.Wide_Text_IO.Modular_IO is
Item : out Num;
Width : Field := 0)
is
-- We depend on a range check to get Data_Error
pragma Unsuppress (Range_Check);
begin
if Num'Size > Unsigned'Size then
Aux.Get_LLU (TFT (File), Long_Long_Unsigned (Item), Width);
if Need_LLU then
Aux_LLU.Get (TFT (File), Long_Long_Unsigned (Item), Width);
else
Aux.Get_Uns (TFT (File), Unsigned (Item), Width);
Aux_Uns.Get (TFT (File), Unsigned (Item), Width);
end if;
exception
@ -75,6 +105,10 @@ package body Ada.Wide_Text_IO.Modular_IO is
Item : out Num;
Last : out Positive)
is
-- We depend on a range check to get Data_Error
pragma Unsuppress (Range_Check);
S : constant String := Wide_String_To_String (From, WCEM_Upper);
-- String on which we do the actual conversion. Note that the method
-- used for wide character encoding is irrelevant, since if there is
@ -82,10 +116,10 @@ package body Ada.Wide_Text_IO.Modular_IO is
-- Aux.Gets will raise Data_Error in any case.
begin
if Num'Size > Unsigned'Size then
Aux.Gets_LLU (S, Long_Long_Unsigned (Item), Last);
if Need_LLU then
Aux_LLU.Gets (S, Long_Long_Unsigned (Item), Last);
else
Aux.Gets_Uns (S, Unsigned (Item), Last);
Aux_Uns.Gets (S, Unsigned (Item), Last);
end if;
exception
@ -103,10 +137,10 @@ package body Ada.Wide_Text_IO.Modular_IO is
Base : Number_Base := Default_Base)
is
begin
if Num'Size > Unsigned'Size then
Aux.Put_LLU (TFT (File), Long_Long_Unsigned (Item), Width, Base);
if Need_LLU then
Aux_LLU.Put (TFT (File), Long_Long_Unsigned (Item), Width, Base);
else
Aux.Put_Uns (TFT (File), Unsigned (Item), Width, Base);
Aux_Uns.Put (TFT (File), Unsigned (Item), Width, Base);
end if;
end Put;
@ -127,10 +161,10 @@ package body Ada.Wide_Text_IO.Modular_IO is
S : String (To'First .. To'Last);
begin
if Num'Size > Unsigned'Size then
Aux.Puts_LLU (S, Long_Long_Unsigned (Item), Base);
if Need_LLU then
Aux_LLU.Puts (S, Long_Long_Unsigned (Item), Base);
else
Aux.Puts_Uns (S, Unsigned (Item), Base);
Aux_Uns.Puts (S, Unsigned (Item), Base);
end if;
for J in S'Range loop

197
gcc/ada/libgnat/a-wtmoio__128.adb Normal file
View file

@ -0,0 +1,197 @@
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- A D A . W I D E _ T E X T _ I O . M O D U L A R _ I O --
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
with Ada.Wide_Text_IO.Integer_Aux;
with System.Img_BIU; use System.Img_BIU;
with System.Img_Uns; use System.Img_Uns;
with System.Img_LLB; use System.Img_LLB;
with System.Img_LLU; use System.Img_LLU;
with System.Img_LLW; use System.Img_LLW;
with System.Img_LLLB; use System.Img_LLLB;
with System.Img_LLLU; use System.Img_LLLU;
with System.Img_LLLW; use System.Img_LLLW;
with System.Img_WIU; use System.Img_WIU;
with System.Val_Uns; use System.Val_Uns;
with System.Val_LLU; use System.Val_LLU;
with System.Val_LLLU; use System.Val_LLLU;
with System.WCh_Con; use System.WCh_Con;
with System.WCh_WtS; use System.WCh_WtS;
package body Ada.Wide_Text_IO.Modular_IO is
package Aux_Uns is new
Ada.Wide_Text_IO.Integer_Aux
(Unsigned,
Scan_Unsigned,
Set_Image_Unsigned,
Set_Image_Width_Unsigned,
Set_Image_Based_Unsigned);
package Aux_LLU is new
Ada.Wide_Text_IO.Integer_Aux
(Long_Long_Unsigned,
Scan_Long_Long_Unsigned,
Set_Image_Long_Long_Unsigned,
Set_Image_Width_Long_Long_Unsigned,
Set_Image_Based_Long_Long_Unsigned);
package Aux_LLLU is new
Ada.Wide_Text_IO.Integer_Aux
(Long_Long_Long_Unsigned,
Scan_Long_Long_Long_Unsigned,
Set_Image_Long_Long_Long_Unsigned,
Set_Image_Width_Long_Long_Long_Unsigned,
Set_Image_Based_Long_Long_Long_Unsigned);
Need_LLU : constant Boolean := Num'Base'Size > Unsigned'Size;
Need_LLLU : constant Boolean := Num'Base'Size > Long_Long_Unsigned'Size;
-- Throughout this generic body, we distinguish between cases where type
-- Unsigned is acceptable, where type Long_Long_Unsigned is acceptable and
-- where type Long_Long_Long_Unsigned is needed. These boolean constants
-- are used to test for these cases and since they are constant, only code
-- for the relevant case will be included in the instance.
subtype TFT is Ada.Wide_Text_IO.File_Type;
-- File type required for calls to routines in Aux
---------
-- Get --
---------
procedure Get
(File : File_Type;
Item : out Num;
Width : Field := 0)
is
-- We depend on a range check to get Data_Error
pragma Unsuppress (Range_Check);
begin
if Need_LLLU then
Aux_LLLU.Get (File, Long_Long_Long_Unsigned (Item), Width);
elsif Need_LLU then
Aux_LLU.Get (TFT (File), Long_Long_Unsigned (Item), Width);
else
Aux_Uns.Get (TFT (File), Unsigned (Item), Width);
end if;
exception
when Constraint_Error => raise Data_Error;
end Get;
procedure Get
(Item : out Num;
Width : Field := 0)
is
begin
Get (Current_Input, Item, Width);
end Get;
procedure Get
(From : Wide_String;
Item : out Num;
Last : out Positive)
is
-- We depend on a range check to get Data_Error
pragma Unsuppress (Range_Check);
S : constant String := Wide_String_To_String (From, WCEM_Upper);
-- String on which we do the actual conversion. Note that the method
-- used for wide character encoding is irrelevant, since if there is
-- a character outside the Standard.Character range then the call to
-- Aux.Gets will raise Data_Error in any case.
begin
if Need_LLLU then
Aux_LLLU.Gets (S, Long_Long_Long_Unsigned (Item), Last);
elsif Need_LLU then
Aux_LLU.Gets (S, Long_Long_Unsigned (Item), Last);
else
Aux_Uns.Gets (S, Unsigned (Item), Last);
end if;
exception
when Constraint_Error => raise Data_Error;
end Get;
---------
-- Put --
---------
procedure Put
(File : File_Type;
Item : Num;
Width : Field := Default_Width;
Base : Number_Base := Default_Base)
is
begin
if Need_LLLU then
Aux_LLLU.Put (File, Long_Long_Long_Unsigned (Item), Width, Base);
elsif Need_LLU then
Aux_LLU.Put (TFT (File), Long_Long_Unsigned (Item), Width, Base);
else
Aux_Uns.Put (TFT (File), Unsigned (Item), Width, Base);
end if;
end Put;
procedure Put
(Item : Num;
Width : Field := Default_Width;
Base : Number_Base := Default_Base)
is
begin
Put (Current_Output, Item, Width, Base);
end Put;
procedure Put
(To : out Wide_String;
Item : Num;
Base : Number_Base := Default_Base)
is
S : String (To'First .. To'Last);
begin
if Need_LLLU then
Aux_LLLU.Puts (S, Long_Long_Long_Unsigned (Item), Base);
elsif Need_LLU then
Aux_LLU.Puts (S, Long_Long_Unsigned (Item), Base);
else
Aux_Uns.Puts (S, Unsigned (Item), Base);
end if;
for J in S'Range loop
To (J) := Wide_Character'Val (Character'Pos (S (J)));
end loop;
end Put;
end Ada.Wide_Text_IO.Modular_IO;

54
gcc/ada/libgnat/a-ztgeau.adb
View file

@ -348,6 +348,60 @@ package body Ada.Wide_Wide_Text_IO.Generic_Aux is
Load_Extended_Digits (File, Buf, Ptr, Junk);
end Load_Extended_Digits;
------------------
-- Load_Integer --
------------------
procedure Load_Integer
(File : File_Type;
Buf : out String;
Ptr : in out Natural)
is
Hash_Loc : Natural;
Loaded : Boolean;
begin
Load_Skip (File);
-- Note: it is a bit strange to allow a minus sign here, but it seems
-- consistent with the general behavior expected by the ACVC tests
-- which is to scan past junk and then signal data error, see ACVC
-- test CE3704F, case (6), which is for signed integer exponents,
-- which seems a similar case.
Load (File, Buf, Ptr, '+', '-');
Load_Digits (File, Buf, Ptr, Loaded);
if Loaded then
-- Deal with based literal. We recognize either the standard '#' or
-- the allowed alternative replacement ':' (see RM J.2(3)).
Load (File, Buf, Ptr, '#', ':', Loaded);
if Loaded then
Hash_Loc := Ptr;
Load_Extended_Digits (File, Buf, Ptr);
Load (File, Buf, Ptr, Buf (Hash_Loc));
end if;
-- Deal with exponent
Load (File, Buf, Ptr, 'E', 'e', Loaded);
if Loaded then
-- Note: it is strange to allow a minus sign, since the syntax
-- does not, but that is what ACVC test CE3704F, case (6) wants
-- for the signed case, and there seems no good reason to treat
-- exponents differently for the signed and unsigned cases.
Load (File, Buf, Ptr, '+', '-');
Load_Digits (File, Buf, Ptr);
end if;
end if;
end Load_Integer;
---------------
-- Load_Skip --
---------------

8
gcc/ada/libgnat/a-ztgeau.ads
View file

@ -149,6 +149,12 @@ package Ada.Wide_Wide_Text_IO.Generic_Aux is
Ptr : in out Integer);
-- Same as above, but no indication if character is loaded
procedure Load_Integer
(File : File_Type;
Buf : out String;
Ptr : in out Natural);
-- Loads a possibly signed integer literal value
procedure Put_Item (File : File_Type; Str : String);
-- This routine is like Wide_Wide_Text_IO.Put, except that it checks for
-- overflow of bounded lines, as described in (RM A.10.6(8)). It is used
@ -169,7 +175,7 @@ package Ada.Wide_Wide_Text_IO.Generic_Aux is
procedure String_Skip (Str : String; Ptr : out Integer);
-- Used in the Get from string procedures to skip leading blanks in the
-- string. Ptr is set to the index of the first non-blank. If the string
-- is all blanks, then the excption End_Error is raised, Note that blank
-- is all blanks, then the exception End_Error is raised, Note that blank
-- is defined as a space or horizontal tab (RM A.10.6(5)).
procedure Ungetc (ch : Integer; File : File_Type);

228
gcc/ada/libgnat/a-ztinau.adb
View file

@ -31,36 +31,15 @@
with Ada.Wide_Wide_Text_IO.Generic_Aux; use Ada.Wide_Wide_Text_IO.Generic_Aux;
with System.Img_BIU; use System.Img_BIU;
with System.Img_Int; use System.Img_Int;
with System.Img_LLB; use System.Img_LLB;
with System.Img_LLI; use System.Img_LLI;
with System.Img_LLW; use System.Img_LLW;
with System.Img_WIU; use System.Img_WIU;
with System.Val_Int; use System.Val_Int;
with System.Val_LLI; use System.Val_LLI;
package body Ada.Wide_Wide_Text_IO.Integer_Aux is
-----------------------
-- Local Subprograms --
-----------------------
---------
-- Get --
---------
procedure Load_Integer
(File : File_Type;
Buf : out String;
Ptr : in out Natural);
-- This is an auxiliary routine that is used to load an possibly signed
-- integer literal value from the input file into Buf, starting at Ptr + 1.
-- On return, Ptr is set to the last character stored.
-------------
-- Get_Int --
-------------
procedure Get_Int
procedure Get
(File : File_Type;
Item : out Integer;
Item : out Num;
Width : Field)
is
Buf : String (1 .. Field'Last);
@ -75,188 +54,73 @@ package body Ada.Wide_Wide_Text_IO.Integer_Aux is
Load_Integer (File, Buf, Stop);
end if;
Item := Scan_Integer (Buf, Ptr'Access, Stop);
Item := Scan (Buf, Ptr'Access, Stop);
Check_End_Of_Field (Buf, Stop, Ptr, Width);
end Get_Int;
end Get;
-------------
-- Get_LLI --
-------------
----------
-- Gets --
----------
procedure Get_LLI
(File : File_Type;
Item : out Long_Long_Integer;
Width : Field)
is
Buf : String (1 .. Field'Last);
Ptr : aliased Integer := 1;
Stop : Integer := 0;
begin
if Width /= 0 then
Load_Width (File, Width, Buf, Stop);
String_Skip (Buf, Ptr);
else
Load_Integer (File, Buf, Stop);
end if;
Item := Scan_Long_Long_Integer (Buf, Ptr'Access, Stop);
Check_End_Of_Field (Buf, Stop, Ptr, Width);
end Get_LLI;
--------------
-- Gets_Int --
--------------
procedure Gets_Int
procedure Gets
(From : String;
Item : out Integer;
Item : out Num;
Last : out Positive)
is
Pos : aliased Integer;
begin
String_Skip (From, Pos);
Item := Scan_Integer (From, Pos'Access, From'Last);
Item := Scan (From, Pos'Access, From'Last);
Last := Pos - 1;
exception
when Constraint_Error =>
raise Data_Error;
end Gets_Int;
end Gets;
--------------
-- Gets_LLI --
--------------
---------
-- Put --
---------
procedure Gets_LLI
(From : String;
Item : out Long_Long_Integer;
Last : out Positive)
is
Pos : aliased Integer;
begin
String_Skip (From, Pos);
Item := Scan_Long_Long_Integer (From, Pos'Access, From'Last);
Last := Pos - 1;
exception
when Constraint_Error =>
raise Data_Error;
end Gets_LLI;
------------------
-- Load_Integer --
------------------
procedure Load_Integer
(File : File_Type;
Buf : out String;
Ptr : in out Natural)
is
Hash_Loc : Natural;
Loaded : Boolean;
begin
Load_Skip (File);
Load (File, Buf, Ptr, '+', '-');
Load_Digits (File, Buf, Ptr, Loaded);
if Loaded then
-- Deal with based case. We recognize either the standard '#' or the
-- allowed alternative replacement ':' (see RM J.2(3)).
Load (File, Buf, Ptr, '#', ':', Loaded);
if Loaded then
Hash_Loc := Ptr;
Load_Extended_Digits (File, Buf, Ptr);
Load (File, Buf, Ptr, Buf (Hash_Loc));
end if;
Load (File, Buf, Ptr, 'E', 'e', Loaded);
if Loaded then
-- Note: it is strange to allow a minus sign, since the syntax
-- does not, but that is what ACVC test CE3704F, case (6) wants.
Load (File, Buf, Ptr, '+', '-');
Load_Digits (File, Buf, Ptr);
end if;
end if;
end Load_Integer;
-------------
-- Put_Int --
-------------
procedure Put_Int
procedure Put
(File : File_Type;
Item : Integer;
Item : Num;
Width : Field;
Base : Number_Base)
is
Buf : String (1 .. Field'Last);
Buf : String (1 .. Integer'Max (Field'Last, Width));
Ptr : Natural := 0;
begin
if Base = 10 and then Width = 0 then
Set_Image_Integer (Item, Buf, Ptr);
Set_Image (Item, Buf, Ptr);
elsif Base = 10 then
Set_Image_Width_Integer (Item, Width, Buf, Ptr);
Set_Image_Width (Item, Width, Buf, Ptr);
else
Set_Image_Based_Integer (Item, Base, Width, Buf, Ptr);
Set_Image_Based (Item, Base, Width, Buf, Ptr);
end if;
Put_Item (File, Buf (1 .. Ptr));
end Put_Int;
end Put;
-------------
-- Put_LLI --
-------------
----------
-- Puts --
----------
procedure Put_LLI
(File : File_Type;
Item : Long_Long_Integer;
Width : Field;
Base : Number_Base)
is
Buf : String (1 .. Field'Last);
Ptr : Natural := 0;
begin
if Base = 10 and then Width = 0 then
Set_Image_Long_Long_Integer (Item, Buf, Ptr);
elsif Base = 10 then
Set_Image_Width_Long_Long_Integer (Item, Width, Buf, Ptr);
else
Set_Image_Based_Long_Long_Integer (Item, Base, Width, Buf, Ptr);
end if;
Put_Item (File, Buf (1 .. Ptr));
end Put_LLI;
--------------
-- Puts_Int --
--------------
procedure Puts_Int
procedure Puts
(To : out String;
Item : Integer;
Item : Num;
Base : Number_Base)
is
Buf : String (1 .. Field'Last);
Buf : String (1 .. Integer'Max (Field'Last, To'Length));
Ptr : Natural := 0;
begin
if Base = 10 then
Set_Image_Width_Integer (Item, To'Length, Buf, Ptr);
Set_Image_Width (Item, To'Length, Buf, Ptr);
else
Set_Image_Based_Integer (Item, Base, To'Length, Buf, Ptr);
Set_Image_Based (Item, Base, To'Length, Buf, Ptr);
end if;
if Ptr > To'Length then
@ -264,32 +128,6 @@ package body Ada.Wide_Wide_Text_IO.Integer_Aux is
else
To (To'First .. To'First + Ptr - 1) := Buf (1 .. Ptr);
end if;
end Puts_Int;
--------------
-- Puts_LLI --
--------------
procedure Puts_LLI
(To : out String;
Item : Long_Long_Integer;
Base : Number_Base)
is
Buf : String (1 .. Field'Last);
Ptr : Natural := 0;
begin
if Base = 10 then
Set_Image_Width_Long_Long_Integer (Item, To'Length, Buf, Ptr);
else
Set_Image_Based_Long_Long_Integer (Item, Base, To'Length, Buf, Ptr);
end if;
if Ptr > To'Length then
raise Layout_Error;
else
To (To'First .. To'First + Ptr - 1) := Buf (1 .. Ptr);
end if;
end Puts_LLI;
end Puts;
end Ada.Wide_Wide_Text_IO.Integer_Aux;

64
gcc/ada/libgnat/a-ztinau.ads
View file

@ -2,7 +2,7 @@
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- A D A . W I D E _ W I D E _ T E X T _ I O . I N T E G E R _ A U X --
-- A D A . W I D E _ W I D E _ T E X T _ I O . I N T E G E R _ A U X --
-- --
-- S p e c --
-- --
@ -29,55 +29,45 @@
-- --
------------------------------------------------------------------------------
-- This package contains the routines for Ada.Wide_Wide_Text_IO.Integer_IO
-- that are shared among separate instantiations of this package. The routines
-- in this package are identical semantically to those in Integer_IO itself,
-- except that the generic parameter Num has been replaced by Integer or
-- Long_Long_Integer, and the default parameters have been removed because
-- they are supplied explicitly by the calls from within the generic template.
-- This package contains implementation for Ada.Wide_Wide.Text_IO.Integer_IO
-- and Ada.Wide_Wide_Text_IO.Modular_IO. The routines in this package are
-- identical semantically to those in Integer_IO and Modular_IO themselves,
-- except that the default parameters have been removed because they are
-- supplied explicitly by the calls from within these units.
private package Ada.Wide_Wide_Text_IO.Integer_Aux is
private generic
type Num is (<>);
procedure Get_Int
with function Scan
(Str : String; Ptr : not null access Integer; Max : Integer) return Num;
with procedure Set_Image
(V : Num; S : in out String; P : in out Natural);
with procedure Set_Image_Width
(V : Num; W : Integer; S : out String; P : in out Natural);
with procedure Set_Image_Based
(V : Num; B : Natural; W : Integer; S : out String; P : in out Natural);
package Ada.Wide_Wide_Text_IO.Integer_Aux is
procedure Get
(File : File_Type;
Item : out Integer;
Item : out Num;
Width : Field);
procedure Get_LLI
(File : File_Type;
Item : out Long_Long_Integer;
Width : Field);
procedure Gets_Int
procedure Gets
(From : String;
Item : out Integer;
Item : out Num;
Last : out Positive);
procedure Gets_LLI
(From : String;
Item : out Long_Long_Integer;
Last : out Positive);
procedure Put_Int
procedure Put
(File : File_Type;
Item : Integer;
Item : Num;
Width : Field;
Base : Number_Base);
procedure Put_LLI
(File : File_Type;
Item : Long_Long_Integer;
Width : Field;
Base : Number_Base);
procedure Puts_Int
procedure Puts
(To : out String;
Item : Integer;
Base : Number_Base);
procedure Puts_LLI
(To : out String;
Item : Long_Long_Integer;
Item : Num;
Base : Number_Base);
end Ada.Wide_Wide_Text_IO.Integer_Aux;

52
gcc/ada/libgnat/a-ztinio.adb
View file

@ -30,11 +30,35 @@
------------------------------------------------------------------------------
with Ada.Wide_Wide_Text_IO.Integer_Aux;
with System.Img_BIU; use System.Img_BIU;
with System.Img_Int; use System.Img_Int;
with System.Img_LLB; use System.Img_LLB;
with System.Img_LLI; use System.Img_LLI;
with System.Img_LLW; use System.Img_LLW;
with System.Img_WIU; use System.Img_WIU;
with System.Val_Int; use System.Val_Int;
with System.Val_LLI; use System.Val_LLI;
with System.WCh_Con; use System.WCh_Con;
with System.WCh_WtS; use System.WCh_WtS;
package body Ada.Wide_Wide_Text_IO.Integer_IO is
package Aux_Int is new
Ada.Wide_Wide_Text_IO.Integer_Aux
(Integer,
Scan_Integer,
Set_Image_Integer,
Set_Image_Width_Integer,
Set_Image_Based_Integer);
package Aux_LLI is new
Ada.Wide_Wide_Text_IO.Integer_Aux
(Long_Long_Integer,
Scan_Long_Long_Integer,
Set_Image_Long_Long_Integer,
Set_Image_Width_Long_Long_Integer,
Set_Image_Based_Long_Long_Integer);
Need_LLI : constant Boolean := Num'Base'Size > Integer'Size;
-- Throughout this generic body, we distinguish between the case where type
-- Integer is acceptable, and where a Long_Long_Integer is needed. This
@ -44,8 +68,6 @@ package body Ada.Wide_Wide_Text_IO.Integer_IO is
subtype TFT is Ada.Wide_Wide_Text_IO.File_Type;
-- File type required for calls to routines in Aux
package Aux renames Ada.Wide_Wide_Text_IO.Integer_Aux;
---------
-- Get --
---------
@ -55,11 +77,16 @@ package body Ada.Wide_Wide_Text_IO.Integer_IO is
Item : out Num;
Width : Field := 0)
is
-- We depend on a range check to get Data_Error
pragma Unsuppress (Range_Check);
pragma Unsuppress (Overflow_Check);
begin
if Need_LLI then
Aux.Get_LLI (TFT (File), Long_Long_Integer (Item), Width);
Aux_LLI.Get (TFT (File), Long_Long_Integer (Item), Width);
else
Aux.Get_Int (TFT (File), Integer (Item), Width);
Aux_Int.Get (TFT (File), Integer (Item), Width);
end if;
exception
@ -79,6 +106,11 @@ package body Ada.Wide_Wide_Text_IO.Integer_IO is
Item : out Num;
Last : out Positive)
is
-- We depend on a range check to get Data_Error
pragma Unsuppress (Range_Check);
pragma Unsuppress (Overflow_Check);
S : constant String := Wide_Wide_String_To_String (From, WCEM_Upper);
-- String on which we do the actual conversion. Note that the method
-- used for wide character encoding is irrelevant, since if there is
@ -87,9 +119,9 @@ package body Ada.Wide_Wide_Text_IO.Integer_IO is
begin
if Need_LLI then
Aux.Gets_LLI (S, Long_Long_Integer (Item), Last);
Aux_LLI.Gets (S, Long_Long_Integer (Item), Last);
else
Aux.Gets_Int (S, Integer (Item), Last);
Aux_Int.Gets (S, Integer (Item), Last);
end if;
exception
@ -108,9 +140,9 @@ package body Ada.Wide_Wide_Text_IO.Integer_IO is
is
begin
if Need_LLI then
Aux.Put_LLI (TFT (File), Long_Long_Integer (Item), Width, Base);
Aux_LLI.Put (TFT (File), Long_Long_Integer (Item), Width, Base);
else
Aux.Put_Int (TFT (File), Integer (Item), Width, Base);
Aux_Int.Put (TFT (File), Integer (Item), Width, Base);
end if;
end Put;
@ -132,9 +164,9 @@ package body Ada.Wide_Wide_Text_IO.Integer_IO is
begin
if Need_LLI then
Aux.Puts_LLI (S, Long_Long_Integer (Item), Base);
Aux_LLI.Puts (S, Long_Long_Integer (Item), Base);
else
Aux.Puts_Int (S, Integer (Item), Base);
Aux_Int.Puts (S, Integer (Item), Base);
end if;
for J in S'Range loop

199
gcc/ada/libgnat/a-ztinio__128.adb Normal file
View file

@ -0,0 +1,199 @@
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- A D A . W I D E _ W I D E _ T E X T _ I O . I N T E G E R _ I O --
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
with Ada.Wide_Wide_Text_IO.Integer_Aux;
with System.Img_BIU; use System.Img_BIU;
with System.Img_Int; use System.Img_Int;
with System.Img_LLB; use System.Img_LLB;
with System.Img_LLI; use System.Img_LLI;
with System.Img_LLW; use System.Img_LLW;
with System.Img_LLLB; use System.Img_LLLB;
with System.Img_LLLI; use System.Img_LLLI;
with System.Img_LLLW; use System.Img_LLLW;
with System.Img_WIU; use System.Img_WIU;
with System.Val_Int; use System.Val_Int;
with System.Val_LLI; use System.Val_LLI;
with System.Val_LLLI; use System.Val_LLLI;
with System.WCh_Con; use System.WCh_Con;
with System.WCh_WtS; use System.WCh_WtS;
package body Ada.Wide_Wide_Text_IO.Integer_IO is
package Aux_Int is new
Ada.Wide_Wide_Text_IO.Integer_Aux
(Integer,
Scan_Integer,
Set_Image_Integer,
Set_Image_Width_Integer,
Set_Image_Based_Integer);
package Aux_LLI is new
Ada.Wide_Wide_Text_IO.Integer_Aux
(Long_Long_Integer,
Scan_Long_Long_Integer,
Set_Image_Long_Long_Integer,
Set_Image_Width_Long_Long_Integer,
Set_Image_Based_Long_Long_Integer);
package Aux_LLLI is new
Ada.Wide_Wide_Text_IO.Integer_Aux
(Long_Long_Long_Integer,
Scan_Long_Long_Long_Integer,
Set_Image_Long_Long_Long_Integer,
Set_Image_Width_Long_Long_Long_Integer,
Set_Image_Based_Long_Long_Long_Integer);
Need_LLI : constant Boolean := Num'Base'Size > Integer'Size;
Need_LLLI : constant Boolean := Num'Base'Size > Long_Long_Integer'Size;
-- Throughout this generic body, we distinguish between cases where type
-- Integer is acceptable, where type Long_Long_Integer is acceptable and
-- where type Long_Long_Long_Integer is needed. These boolean constants
-- are used to test for these cases and since they are constant, only code
-- for the relevant case will be included in the instance.
subtype TFT is Ada.Wide_Wide_Text_IO.File_Type;
-- File type required for calls to routines in Aux
---------
-- Get --
---------
procedure Get
(File : File_Type;
Item : out Num;
Width : Field := 0)
is
-- We depend on a range check to get Data_Error
pragma Unsuppress (Range_Check);
pragma Unsuppress (Overflow_Check);
begin
if Need_LLLI then
Aux_LLLI.Get (TFT (File), Long_Long_Long_Integer (Item), Width);
elsif Need_LLI then
Aux_LLI.Get (TFT (File), Long_Long_Integer (Item), Width);
else
Aux_Int.Get (TFT (File), Integer (Item), Width);
end if;
exception
when Constraint_Error => raise Data_Error;
end Get;
procedure Get
(Item : out Num;
Width : Field := 0)
is
begin
Get (Current_Input, Item, Width);
end Get;
procedure Get
(From : Wide_Wide_String;
Item : out Num;
Last : out Positive)
is
-- We depend on a range check to get Data_Error
pragma Unsuppress (Range_Check);
pragma Unsuppress (Overflow_Check);
S : constant String := Wide_Wide_String_To_String (From, WCEM_Upper);
-- String on which we do the actual conversion. Note that the method
-- used for wide character encoding is irrelevant, since if there is
-- a character outside the Standard.Character range then the call to
-- Aux.Gets will raise Data_Error in any case.
begin
if Need_LLLI then
Aux_LLLI.Gets (S, Long_Long_Long_Integer (Item), Last);
elsif Need_LLI then
Aux_LLI.Gets (S, Long_Long_Integer (Item), Last);
else
Aux_Int.Gets (S, Integer (Item), Last);
end if;
exception
when Constraint_Error => raise Data_Error;
end Get;
---------
-- Put --
---------
procedure Put
(File : File_Type;
Item : Num;
Width : Field := Default_Width;
Base : Number_Base := Default_Base)
is
begin
if Need_LLLI then
Aux_LLLI.Put (TFT (File), Long_Long_Long_Integer (Item), Width, Base);
elsif Need_LLI then
Aux_LLI.Put (TFT (File), Long_Long_Integer (Item), Width, Base);
else
Aux_Int.Put (TFT (File), Integer (Item), Width, Base);
end if;
end Put;
procedure Put
(Item : Num;
Width : Field := Default_Width;
Base : Number_Base := Default_Base)
is
begin
Put (Current_Output, Item, Width, Base);
end Put;
procedure Put
(To : out Wide_Wide_String;
Item : Num;
Base : Number_Base := Default_Base)
is
S : String (To'First .. To'Last);
begin
if Need_LLLI then
Aux_LLLI.Puts (S, Long_Long_Long_Integer (Item), Base);
elsif Need_LLI then
Aux_LLI.Puts (S, Long_Long_Integer (Item), Base);
else
Aux_Int.Puts (S, Integer (Item), Base);
end if;
for J in S'Range loop
To (J) := Wide_Wide_Character'Val (Character'Pos (S (J)));
end loop;
end Put;
end Ada.Wide_Wide_Text_IO.Integer_IO;

305
gcc/ada/libgnat/a-ztmoau.adb
View file

@ -1,305 +0,0 @@
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- A D A . W I D E _ W I D E _ T E X T _ I O . M O D U L A R _ A U X --
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
with Ada.Wide_Wide_Text_IO.Generic_Aux; use Ada.Wide_Wide_Text_IO.Generic_Aux;
with System.Img_BIU; use System.Img_BIU;
with System.Img_Uns; use System.Img_Uns;
with System.Img_LLB; use System.Img_LLB;
with System.Img_LLU; use System.Img_LLU;
with System.Img_LLW; use System.Img_LLW;
with System.Img_WIU; use System.Img_WIU;
with System.Val_Uns; use System.Val_Uns;
with System.Val_LLU; use System.Val_LLU;
package body Ada.Wide_Wide_Text_IO.Modular_Aux is
use System.Unsigned_Types;
-----------------------
-- Local Subprograms --
-----------------------
procedure Load_Modular
(File : File_Type;
Buf : out String;
Ptr : in out Natural);
-- This is an auxiliary routine that is used to load an possibly signed
-- modular literal value from the input file into Buf, starting at Ptr + 1.
-- Ptr is left set to the last character stored.
-------------
-- Get_LLU --
-------------
procedure Get_LLU
(File : File_Type;
Item : out Long_Long_Unsigned;
Width : Field)
is
Buf : String (1 .. Field'Last);
Stop : Integer := 0;
Ptr : aliased Integer := 1;
begin
if Width /= 0 then
Load_Width (File, Width, Buf, Stop);
String_Skip (Buf, Ptr);
else
Load_Modular (File, Buf, Stop);
end if;
Item := Scan_Long_Long_Unsigned (Buf, Ptr'Access, Stop);
Check_End_Of_Field (Buf, Stop, Ptr, Width);
end Get_LLU;
-------------
-- Get_Uns --
-------------
procedure Get_Uns
(File : File_Type;
Item : out Unsigned;
Width : Field)
is
Buf : String (1 .. Field'Last);
Stop : Integer := 0;
Ptr : aliased Integer := 1;
begin
if Width /= 0 then
Load_Width (File, Width, Buf, Stop);
String_Skip (Buf, Ptr);
else
Load_Modular (File, Buf, Stop);
end if;
Item := Scan_Unsigned (Buf, Ptr'Access, Stop);
Check_End_Of_Field (Buf, Stop, Ptr, Width);
end Get_Uns;
--------------
-- Gets_LLU --
--------------
procedure Gets_LLU
(From : String;
Item : out Long_Long_Unsigned;
Last : out Positive)
is
Pos : aliased Integer;
begin
String_Skip (From, Pos);
Item := Scan_Long_Long_Unsigned (From, Pos'Access, From'Last);
Last := Pos - 1;
exception
when Constraint_Error =>
raise Data_Error;
end Gets_LLU;
--------------
-- Gets_Uns --
--------------
procedure Gets_Uns
(From : String;
Item : out Unsigned;
Last : out Positive)
is
Pos : aliased Integer;
begin
String_Skip (From, Pos);
Item := Scan_Unsigned (From, Pos'Access, From'Last);
Last := Pos - 1;
exception
when Constraint_Error =>
raise Data_Error;
end Gets_Uns;
------------------
-- Load_Modular --
------------------
procedure Load_Modular
(File : File_Type;
Buf : out String;
Ptr : in out Natural)
is
Hash_Loc : Natural;
Loaded : Boolean;
begin
Load_Skip (File);
-- Note: it is a bit strange to allow a minus sign here, but it seems
-- consistent with the general behavior expected by the ACVC tests
-- which is to scan past junk and then signal data error, see ACVC
-- test CE3704F, case (6), which is for signed integer exponents,
-- which seems a similar case.
Load (File, Buf, Ptr, '+', '-');
Load_Digits (File, Buf, Ptr, Loaded);
if Loaded then
-- Deal with based case. We recognize either the standard '#' or the
-- allowed alternative replacement ':' (see RM J.2(3)).
Load (File, Buf, Ptr, '#', ':', Loaded);
if Loaded then
Hash_Loc := Ptr;
Load_Extended_Digits (File, Buf, Ptr);
Load (File, Buf, Ptr, Buf (Hash_Loc));
end if;
Load (File, Buf, Ptr, 'E', 'e', Loaded);
if Loaded then
-- Note: it is strange to allow a minus sign, since the syntax
-- does not, but that is what ACVC test CE3704F, case (6) wants
-- for the signed case, and there seems no good reason to treat
-- exponents differently for the signed and unsigned cases.
Load (File, Buf, Ptr, '+', '-');
Load_Digits (File, Buf, Ptr);
end if;
end if;
end Load_Modular;
-------------
-- Put_LLU --
-------------
procedure Put_LLU
(File : File_Type;
Item : Long_Long_Unsigned;
Width : Field;
Base : Number_Base)
is
Buf : String (1 .. Field'Last);
Ptr : Natural := 0;
begin
if Base = 10 and then Width = 0 then
Set_Image_Long_Long_Unsigned (Item, Buf, Ptr);
elsif Base = 10 then
Set_Image_Width_Long_Long_Unsigned (Item, Width, Buf, Ptr);
else
Set_Image_Based_Long_Long_Unsigned (Item, Base, Width, Buf, Ptr);
end if;
Put_Item (File, Buf (1 .. Ptr));
end Put_LLU;
-------------
-- Put_Uns --
-------------
procedure Put_Uns
(File : File_Type;
Item : Unsigned;
Width : Field;
Base : Number_Base)
is
Buf : String (1 .. Field'Last);
Ptr : Natural := 0;
begin
if Base = 10 and then Width = 0 then
Set_Image_Unsigned (Item, Buf, Ptr);
elsif Base = 10 then
Set_Image_Width_Unsigned (Item, Width, Buf, Ptr);
else
Set_Image_Based_Unsigned (Item, Base, Width, Buf, Ptr);
end if;
Put_Item (File, Buf (1 .. Ptr));
end Put_Uns;
--------------
-- Puts_LLU --
--------------
procedure Puts_LLU
(To : out String;
Item : Long_Long_Unsigned;
Base : Number_Base)
is
Buf : String (1 .. Field'Last);
Ptr : Natural := 0;
begin
if Base = 10 then
Set_Image_Width_Long_Long_Unsigned (Item, To'Length, Buf, Ptr);
else
Set_Image_Based_Long_Long_Unsigned (Item, Base, To'Length, Buf, Ptr);
end if;
if Ptr > To'Length then
raise Layout_Error;
else
To (To'First .. To'First + Ptr - 1) := Buf (1 .. Ptr);
end if;
end Puts_LLU;
--------------
-- Puts_Uns --
--------------
procedure Puts_Uns
(To : out String;
Item : Unsigned;
Base : Number_Base)
is
Buf : String (1 .. Field'Last);
Ptr : Natural := 0;
begin
if Base = 10 then
Set_Image_Width_Unsigned (Item, To'Length, Buf, Ptr);
else
Set_Image_Based_Unsigned (Item, Base, To'Length, Buf, Ptr);
end if;
if Ptr > To'Length then
raise Layout_Error;
else
To (To'First .. To'First + Ptr - 1) := Buf (1 .. Ptr);
end if;
end Puts_Uns;
end Ada.Wide_Wide_Text_IO.Modular_Aux;

88
gcc/ada/libgnat/a-ztmoau.ads
View file

@ -1,88 +0,0 @@
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- A D A . W I D E _ W I D E _ T E X T _ I O . M O D U L A R _ A U X --
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
-- This package contains the routines for Ada.Wide_Wide_Text_IO.Modular_IO
-- that are shared among separate instantiations of this package. The
-- routines in this package are identical semantically to those in Modular_IO
-- itself, except that the generic parameter Num has been replaced by
-- Unsigned or Long_Long_Unsigned, and the default parameters have been
-- removed because they are supplied explicitly by the calls from within the
-- generic template.
with System.Unsigned_Types;
private package Ada.Wide_Wide_Text_IO.Modular_Aux is
package U renames System.Unsigned_Types;
procedure Get_Uns
(File : File_Type;
Item : out U.Unsigned;
Width : Field);
procedure Get_LLU
(File : File_Type;
Item : out U.Long_Long_Unsigned;
Width : Field);
procedure Gets_Uns
(From : String;
Item : out U.Unsigned;
Last : out Positive);
procedure Gets_LLU
(From : String;
Item : out U.Long_Long_Unsigned;
Last : out Positive);
procedure Put_Uns
(File : File_Type;
Item : U.Unsigned;
Width : Field;
Base : Number_Base);
procedure Put_LLU
(File : File_Type;
Item : U.Long_Long_Unsigned;
Width : Field;
Base : Number_Base);
procedure Puts_Uns
(To : out String;
Item : U.Unsigned;
Base : Number_Base);
procedure Puts_LLU
(To : out String;
Item : U.Long_Long_Unsigned;
Base : Number_Base);
end Ada.Wide_Wide_Text_IO.Modular_Aux;

72
gcc/ada/libgnat/a-ztmoio.adb
View file

@ -29,19 +29,45 @@
-- --
------------------------------------------------------------------------------
with Ada.Wide_Wide_Text_IO.Modular_Aux;
with System.Unsigned_Types; use System.Unsigned_Types;
with System.WCh_Con; use System.WCh_Con;
with System.WCh_WtS; use System.WCh_WtS;
with Ada.Wide_Wide_Text_IO.Integer_Aux;
with System.Img_BIU; use System.Img_BIU;
with System.Img_Uns; use System.Img_Uns;
with System.Img_LLB; use System.Img_LLB;
with System.Img_LLU; use System.Img_LLU;
with System.Img_LLW; use System.Img_LLW;
with System.Img_WIU; use System.Img_WIU;
with System.Val_Uns; use System.Val_Uns;
with System.Val_LLU; use System.Val_LLU;
with System.WCh_Con; use System.WCh_Con;
with System.WCh_WtS; use System.WCh_WtS;
package body Ada.Wide_Wide_Text_IO.Modular_IO is
package Aux_Uns is new
Ada.Wide_Wide_Text_IO.Integer_Aux
(Unsigned,
Scan_Unsigned,
Set_Image_Unsigned,
Set_Image_Width_Unsigned,
Set_Image_Based_Unsigned);
package Aux_LLU is new
Ada.Wide_Wide_Text_IO.Integer_Aux
(Long_Long_Unsigned,
Scan_Long_Long_Unsigned,
Set_Image_Long_Long_Unsigned,
Set_Image_Width_Long_Long_Unsigned,
Set_Image_Based_Long_Long_Unsigned);
Need_LLU : constant Boolean := Num'Base'Size > Unsigned'Size;
-- Throughout this generic body, we distinguish between the case where type
-- Unsigned is acceptable, and where a Long_Long_Unsigned is needed. This
-- Boolean is used to test for these cases and since it is a constant, only
-- code for the relevant case will be included in the instance.
subtype TFT is Ada.Wide_Wide_Text_IO.File_Type;
-- File type required for calls to routines in Aux
package Aux renames Ada.Wide_Wide_Text_IO.Modular_Aux;
---------
-- Get --
---------
@ -51,11 +77,15 @@ package body Ada.Wide_Wide_Text_IO.Modular_IO is
Item : out Num;
Width : Field := 0)
is
-- We depend on a range check to get Data_Error
pragma Unsuppress (Range_Check);
begin
if Num'Size > Unsigned'Size then
Aux.Get_LLU (TFT (File), Long_Long_Unsigned (Item), Width);
if Need_LLU then
Aux_LLU.Get (TFT (File), Long_Long_Unsigned (Item), Width);
else
Aux.Get_Uns (TFT (File), Unsigned (Item), Width);
Aux_Uns.Get (TFT (File), Unsigned (Item), Width);
end if;
exception
@ -75,6 +105,10 @@ package body Ada.Wide_Wide_Text_IO.Modular_IO is
Item : out Num;
Last : out Positive)
is
-- We depend on a range check to get Data_Error
pragma Unsuppress (Range_Check);
S : constant String := Wide_Wide_String_To_String (From, WCEM_Upper);
-- String on which we do the actual conversion. Note that the method
-- used for wide character encoding is irrelevant, since if there is
@ -82,10 +116,10 @@ package body Ada.Wide_Wide_Text_IO.Modular_IO is
-- Aux.Gets will raise Data_Error in any case.
begin
if Num'Size > Unsigned'Size then
Aux.Gets_LLU (S, Long_Long_Unsigned (Item), Last);
if Need_LLU then
Aux_LLU.Gets (S, Long_Long_Unsigned (Item), Last);
else
Aux.Gets_Uns (S, Unsigned (Item), Last);
Aux_Uns.Gets (S, Unsigned (Item), Last);
end if;
exception
@ -103,10 +137,10 @@ package body Ada.Wide_Wide_Text_IO.Modular_IO is
Base : Number_Base := Default_Base)
is
begin
if Num'Size > Unsigned'Size then
Aux.Put_LLU (TFT (File), Long_Long_Unsigned (Item), Width, Base);
if Need_LLU then
Aux_LLU.Put (TFT (File), Long_Long_Unsigned (Item), Width, Base);
else
Aux.Put_Uns (TFT (File), Unsigned (Item), Width, Base);
Aux_Uns.Put (TFT (File), Unsigned (Item), Width, Base);
end if;
end Put;
@ -127,10 +161,10 @@ package body Ada.Wide_Wide_Text_IO.Modular_IO is
S : String (To'First .. To'Last);
begin
if Num'Size > Unsigned'Size then
Aux.Puts_LLU (S, Long_Long_Unsigned (Item), Base);
if Need_LLU then
Aux_LLU.Puts (S, Long_Long_Unsigned (Item), Base);
else
Aux.Puts_Uns (S, Unsigned (Item), Base);
Aux_Uns.Puts (S, Unsigned (Item), Base);
end if;
for J in S'Range loop

197
gcc/ada/libgnat/a-ztmoio__128.adb Normal file
View file

@ -0,0 +1,197 @@
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- A D A . W I D E _ W I D E _ T E X T _ I O . M O D U L A R _ I O --
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
with Ada.Wide_Wide_Text_IO.Integer_Aux;
with System.Img_BIU; use System.Img_BIU;
with System.Img_Uns; use System.Img_Uns;
with System.Img_LLB; use System.Img_LLB;
with System.Img_LLU; use System.Img_LLU;
with System.Img_LLW; use System.Img_LLW;
with System.Img_LLLB; use System.Img_LLLB;
with System.Img_LLLU; use System.Img_LLLU;
with System.Img_LLLW; use System.Img_LLLW;
with System.Img_WIU; use System.Img_WIU;
with System.Val_Uns; use System.Val_Uns;
with System.Val_LLU; use System.Val_LLU;
with System.Val_LLLU; use System.Val_LLLU;
with System.WCh_Con; use System.WCh_Con;
with System.WCh_WtS; use System.WCh_WtS;
package body Ada.Wide_Wide_Text_IO.Modular_IO is
package Aux_Uns is new
Ada.Wide_Wide_Text_IO.Integer_Aux
(Unsigned,
Scan_Unsigned,
Set_Image_Unsigned,
Set_Image_Width_Unsigned,
Set_Image_Based_Unsigned);
package Aux_LLU is new
Ada.Wide_Wide_Text_IO.Integer_Aux
(Long_Long_Unsigned,
Scan_Long_Long_Unsigned,
Set_Image_Long_Long_Unsigned,
Set_Image_Width_Long_Long_Unsigned,
Set_Image_Based_Long_Long_Unsigned);
package Aux_LLLU is new
Ada.Wide_Wide_Text_IO.Integer_Aux
(Long_Long_Long_Unsigned,
Scan_Long_Long_Long_Unsigned,
Set_Image_Long_Long_Long_Unsigned,
Set_Image_Width_Long_Long_Long_Unsigned,
Set_Image_Based_Long_Long_Long_Unsigned);
Need_LLU : constant Boolean := Num'Base'Size > Unsigned'Size;
Need_LLLU : constant Boolean := Num'Base'Size > Long_Long_Unsigned'Size;
-- Throughout this generic body, we distinguish between cases where type
-- Unsigned is acceptable, where type Long_Long_Unsigned is acceptable and
-- where type Long_Long_Long_Unsigned is needed. These boolean constants
-- are used to test for these cases and since they are constant, only code
-- for the relevant case will be included in the instance.
subtype TFT is Ada.Wide_Wide_Text_IO.File_Type;
-- File type required for calls to routines in Aux
---------
-- Get --
---------
procedure Get
(File : File_Type;
Item : out Num;
Width : Field := 0)
is
-- We depend on a range check to get Data_Error
pragma Unsuppress (Range_Check);
begin
if Need_LLLU then
Aux_LLLU.Get (File, Long_Long_Long_Unsigned (Item), Width);
elsif Need_LLU then
Aux_LLU.Get (TFT (File), Long_Long_Unsigned (Item), Width);
else
Aux_Uns.Get (TFT (File), Unsigned (Item), Width);
end if;
exception
when Constraint_Error => raise Data_Error;
end Get;
procedure Get
(Item : out Num;
Width : Field := 0)
is
begin
Get (Current_Input, Item, Width);
end Get;
procedure Get
(From : Wide_Wide_String;
Item : out Num;
Last : out Positive)
is
-- We depend on a range check to get Data_Error
pragma Unsuppress (Range_Check);
S : constant String := Wide_Wide_String_To_String (From, WCEM_Upper);
-- String on which we do the actual conversion. Note that the method
-- used for wide character encoding is irrelevant, since if there is
-- a character outside the Standard.Character range then the call to
-- Aux.Gets will raise Data_Error in any case.
begin
if Need_LLLU then
Aux_LLLU.Gets (S, Long_Long_Long_Unsigned (Item), Last);
elsif Need_LLU then
Aux_LLU.Gets (S, Long_Long_Unsigned (Item), Last);
else
Aux_Uns.Gets (S, Unsigned (Item), Last);
end if;
exception
when Constraint_Error => raise Data_Error;
end Get;
---------
-- Put --
---------
procedure Put
(File : File_Type;
Item : Num;
Width : Field := Default_Width;
Base : Number_Base := Default_Base)
is
begin
if Need_LLLU then
Aux_LLLU.Put (File, Long_Long_Long_Unsigned (Item), Width, Base);
elsif Need_LLU then
Aux_LLU.Put (TFT (File), Long_Long_Unsigned (Item), Width, Base);
else
Aux_Uns.Put (TFT (File), Unsigned (Item), Width, Base);
end if;
end Put;
procedure Put
(Item : Num;
Width : Field := Default_Width;
Base : Number_Base := Default_Base)
is
begin
Put (Current_Output, Item, Width, Base);
end Put;
procedure Put
(To : out Wide_Wide_String;
Item : Num;
Base : Number_Base := Default_Base)
is
S : String (To'First .. To'Last);
begin
if Need_LLLU then
Aux_LLLU.Puts (S, Long_Long_Long_Unsigned (Item), Base);
elsif Need_LLU then
Aux_LLU.Puts (S, Long_Long_Unsigned (Item), Base);
else
Aux_Uns.Puts (S, Unsigned (Item), Base);
end if;
for J in S'Range loop
To (J) := Wide_Wide_Character'Val (Character'Pos (S (J)));
end loop;
end Put;
end Ada.Wide_Wide_Text_IO.Modular_IO;