From 38aca14a437d9adefe9d7f526aafa53a8e868749 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Sat, 27 Jun 2020 12:43:32 +0200 Subject: [PATCH] [Ada] Support of the Ada.Text_IO hierarchy for 128-bit types 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. --- gcc/ada/Makefile.rtl | 12 +- gcc/ada/impunit.adb | 3 + gcc/ada/krunch.adb | 9 + gcc/ada/krunch.ads | 3 + gcc/ada/libgnat/a-llltio.ads | 19 ++ gcc/ada/libgnat/a-lllwti.ads | 19 ++ gcc/ada/libgnat/a-lllzti.ads | 19 ++ gcc/ada/libgnat/a-tigeau.adb | 54 ++++++ gcc/ada/libgnat/a-tigeau.ads | 6 + gcc/ada/libgnat/a-tiinau.adb | 228 ++++------------------ gcc/ada/libgnat/a-tiinau.ads | 64 +++---- gcc/ada/libgnat/a-tiinio.adb | 60 +++--- gcc/ada/libgnat/a-tiinio__128.adb | 182 ++++++++++++++++++ gcc/ada/libgnat/a-timoau.adb | 305 ------------------------------ gcc/ada/libgnat/a-timoau.ads | 87 --------- gcc/ada/libgnat/a-timoio.adb | 79 +++++--- gcc/ada/libgnat/a-timoio__128.adb | 180 ++++++++++++++++++ gcc/ada/libgnat/a-wtgeau.adb | 54 ++++++ gcc/ada/libgnat/a-wtgeau.ads | 8 +- gcc/ada/libgnat/a-wtinau.adb | 230 ++++------------------ gcc/ada/libgnat/a-wtinau.ads | 60 +++--- gcc/ada/libgnat/a-wtinio.adb | 52 ++++- gcc/ada/libgnat/a-wtinio__128.adb | 199 +++++++++++++++++++ gcc/ada/libgnat/a-wtmoau.adb | 305 ------------------------------ gcc/ada/libgnat/a-wtmoau.ads | 87 --------- gcc/ada/libgnat/a-wtmoio.adb | 72 +++++-- gcc/ada/libgnat/a-wtmoio__128.adb | 197 +++++++++++++++++++ gcc/ada/libgnat/a-ztgeau.adb | 54 ++++++ gcc/ada/libgnat/a-ztgeau.ads | 8 +- gcc/ada/libgnat/a-ztinau.adb | 228 ++++------------------ gcc/ada/libgnat/a-ztinau.ads | 62 +++--- gcc/ada/libgnat/a-ztinio.adb | 52 ++++- gcc/ada/libgnat/a-ztinio__128.adb | 199 +++++++++++++++++++ gcc/ada/libgnat/a-ztmoau.adb | 305 ------------------------------ gcc/ada/libgnat/a-ztmoau.ads | 88 --------- gcc/ada/libgnat/a-ztmoio.adb | 72 +++++-- gcc/ada/libgnat/a-ztmoio__128.adb | 197 +++++++++++++++++++ 37 files changed, 1865 insertions(+), 1993 deletions(-) create mode 100644 gcc/ada/libgnat/a-llltio.ads create mode 100644 gcc/ada/libgnat/a-lllwti.ads create mode 100644 gcc/ada/libgnat/a-lllzti.ads create mode 100644 gcc/ada/libgnat/a-tiinio__128.adb delete mode 100644 gcc/ada/libgnat/a-timoau.adb delete mode 100644 gcc/ada/libgnat/a-timoau.ads create mode 100644 gcc/ada/libgnat/a-timoio__128.adb create mode 100644 gcc/ada/libgnat/a-wtinio__128.adb delete mode 100644 gcc/ada/libgnat/a-wtmoau.adb delete mode 100644 gcc/ada/libgnat/a-wtmoau.ads create mode 100644 gcc/ada/libgnat/a-wtmoio__128.adb create mode 100644 gcc/ada/libgnat/a-ztinio__128.adb delete mode 100644 gcc/ada/libgnat/a-ztmoau.adb delete mode 100644 gcc/ada/libgnat/a-ztmoau.ads create mode 100644 gcc/ada/libgnat/a-ztmoio__128.adb diff --git a/gcc/ada/Makefile.rtl b/gcc/ada/Makefile.rtl index 61da47bb330..898eb5d7d76 100644 --- a/gcc/ada/Makefile.rtl +++ b/gcc/ada/Makefile.rtl @@ -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= 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); diff --git a/gcc/ada/krunch.ads b/gcc/ada/krunch.ads index d5fdf84cf38..3188d818b85 100644 --- a/gcc/ada/krunch.ads +++ b/gcc/ada/krunch.ads @@ -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. diff --git a/gcc/ada/libgnat/a-llltio.ads b/gcc/ada/libgnat/a-llltio.ads new file mode 100644 index 00000000000..f107d4310c9 --- /dev/null +++ b/gcc/ada/libgnat/a-llltio.ads @@ -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); diff --git a/gcc/ada/libgnat/a-lllwti.ads b/gcc/ada/libgnat/a-lllwti.ads new file mode 100644 index 00000000000..942fac0d83c --- /dev/null +++ b/gcc/ada/libgnat/a-lllwti.ads @@ -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); diff --git a/gcc/ada/libgnat/a-lllzti.ads b/gcc/ada/libgnat/a-lllzti.ads new file mode 100644 index 00000000000..40be9653514 --- /dev/null +++ b/gcc/ada/libgnat/a-lllzti.ads @@ -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); diff --git a/gcc/ada/libgnat/a-tigeau.adb b/gcc/ada/libgnat/a-tigeau.adb index c7f719aef4c..f1ba60a6839 100644 --- a/gcc/ada/libgnat/a-tigeau.adb +++ b/gcc/ada/libgnat/a-tigeau.adb @@ -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 -- --------------- diff --git a/gcc/ada/libgnat/a-tigeau.ads b/gcc/ada/libgnat/a-tigeau.ads index 32b5fe38345..09334b371dd 100644 --- a/gcc/ada/libgnat/a-tigeau.ads +++ b/gcc/ada/libgnat/a-tigeau.ads @@ -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. diff --git a/gcc/ada/libgnat/a-tiinau.adb b/gcc/ada/libgnat/a-tiinau.adb index d09b45653c8..a0bb5c6aa24 100644 --- a/gcc/ada/libgnat/a-tiinau.adb +++ b/gcc/ada/libgnat/a-tiinau.adb @@ -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,61 +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 -- - ----------------------- - - 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 - (File : File_Type; - Item : out 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_Integer (Buf, Ptr'Access, Stop); - Check_End_Of_Field (Buf, Stop, Ptr, Width); - end Get_Int; + --------- + -- Get -- + --------- - ------------- - -- Get_LLI -- - ------------- - - procedure Get_LLI + procedure Get (File : File_Type; - Item : out Long_Long_Integer; + Item : out Num; Width : Field) is Buf : String (1 .. Field'Last); @@ -100,130 +54,38 @@ package body Ada.Text_IO.Integer_Aux is Load_Integer (File, Buf, Stop); end if; - Item := Scan_Long_Long_Integer (Buf, Ptr'Access, Stop); + Item := Scan (Buf, Ptr'Access, Stop); Check_End_Of_Field (Buf, Stop, Ptr, Width); - end Get_LLI; + end Get; - -------------- - -- Gets_Int -- - -------------- + ---------- + -- Gets -- + ---------- - 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; - - -------------- - -- Gets_LLI -- - -------------- - - 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)). + end Gets; - Load (File, Buf, Ptr, '#', ':', Loaded); + --------- + -- Put -- + --------- - 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 - (File : File_Type; - Item : 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_Integer (Item, Buf, Ptr); - elsif Base = 10 then - Set_Image_Width_Integer (Item, Width, Buf, Ptr); - else - Set_Image_Based_Integer (Item, Base, Width, Buf, Ptr); - end if; - - Put_Item (File, Buf (1 .. Ptr)); - end Put_Int; - - ------------- - -- Put_LLI -- - ------------- - - procedure Put_LLI + procedure Put (File : File_Type; - Item : Long_Long_Integer; + Item : Num; Width : Field; Base : Number_Base) is @@ -232,49 +94,23 @@ package body Ada.Text_IO.Integer_Aux is begin if Base = 10 and then Width = 0 then - Set_Image_Long_Long_Integer (Item, Buf, Ptr); + Set_Image (Item, Buf, Ptr); elsif Base = 10 then - Set_Image_Width_Long_Long_Integer (Item, Width, Buf, Ptr); + Set_Image_Width (Item, Width, Buf, Ptr); else - Set_Image_Based_Long_Long_Integer (Item, Base, Width, Buf, Ptr); + Set_Image_Based (Item, Base, Width, Buf, Ptr); end if; Put_Item (File, Buf (1 .. Ptr)); - end Put_LLI; - - -------------- - -- Puts_Int -- - -------------- - - procedure Puts_Int - (To : out String; - Item : 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_Integer (Item, To'Length, Buf, Ptr); - else - Set_Image_Based_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_Int; + end Put; - -------------- - -- Puts_LLI -- - -------------- + ---------- + -- Puts -- + ---------- - procedure Puts_LLI + procedure Puts (To : out String; - Item : Long_Long_Integer; + Item : Num; Base : Number_Base) is Buf : String (1 .. Integer'Max (Field'Last, To'Length)); @@ -282,9 +118,9 @@ package body Ada.Text_IO.Integer_Aux is begin if Base = 10 then - Set_Image_Width_Long_Long_Integer (Item, To'Length, Buf, Ptr); + Set_Image_Width (Item, To'Length, Buf, Ptr); else - Set_Image_Based_Long_Long_Integer (Item, Base, To'Length, Buf, Ptr); + Set_Image_Based (Item, Base, To'Length, Buf, Ptr); end if; if Ptr > To'Length then @@ -292,6 +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_LLI; + end Puts; end Ada.Text_IO.Integer_Aux; diff --git a/gcc/ada/libgnat/a-tiinau.ads b/gcc/ada/libgnat/a-tiinau.ads index fda5b68ae7a..e1492211ea2 100644 --- a/gcc/ada/libgnat/a-tiinau.ads +++ b/gcc/ada/libgnat/a-tiinau.ads @@ -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 - (File : File_Type; - Item : out Integer; - Width : Field); + 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_LLI + procedure Get (File : File_Type; - Item : out Long_Long_Integer; + Item : out Num; Width : Field); - procedure Put_Int - (File : File_Type; - Item : Integer; - Width : Field; - Base : Number_Base); + procedure Gets + (From : String; + Item : out Num; + Last : out Positive); - procedure Put_LLI + procedure Put (File : File_Type; - Item : Long_Long_Integer; + Item : Num; 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 - (To : out String; - Item : Integer; - Base : Number_Base); - - procedure Puts_LLI + procedure Puts (To : out String; - Item : Long_Long_Integer; + Item : Num; Base : Number_Base); end Ada.Text_IO.Integer_Aux; diff --git a/gcc/ada/libgnat/a-tiinio.adb b/gcc/ada/libgnat/a-tiinio.adb index c71b4bf23db..4133bec6787 100644 --- a/gcc/ada/libgnat/a-tiinio.adb +++ b/gcc/ada/libgnat/a-tiinio.adb @@ -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; diff --git a/gcc/ada/libgnat/a-tiinio__128.adb b/gcc/ada/libgnat/a-tiinio__128.adb new file mode 100644 index 00000000000..e82b447804c --- /dev/null +++ b/gcc/ada/libgnat/a-tiinio__128.adb @@ -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 -- +-- . -- +-- -- +-- 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; diff --git a/gcc/ada/libgnat/a-timoau.adb b/gcc/ada/libgnat/a-timoau.adb deleted file mode 100644 index 050b9c88fb6..00000000000 --- a/gcc/ada/libgnat/a-timoau.adb +++ /dev/null @@ -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 -- --- . -- --- -- --- 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; diff --git a/gcc/ada/libgnat/a-timoau.ads b/gcc/ada/libgnat/a-timoau.ads deleted file mode 100644 index 247eb146b18..00000000000 --- a/gcc/ada/libgnat/a-timoau.ads +++ /dev/null @@ -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 -- --- . -- --- -- --- 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; diff --git a/gcc/ada/libgnat/a-timoio.adb b/gcc/ada/libgnat/a-timoio.adb index 0cdeef1e4bc..83dbafa742a 100644 --- a/gcc/ada/libgnat/a-timoio.adb +++ b/gcc/ada/libgnat/a-timoio.adb @@ -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; diff --git a/gcc/ada/libgnat/a-timoio__128.adb b/gcc/ada/libgnat/a-timoio__128.adb new file mode 100644 index 00000000000..45856e23dd7 --- /dev/null +++ b/gcc/ada/libgnat/a-timoio__128.adb @@ -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 -- +-- . -- +-- -- +-- 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; diff --git a/gcc/ada/libgnat/a-wtgeau.adb b/gcc/ada/libgnat/a-wtgeau.adb index 45eef9255d9..9d24070e98d 100644 --- a/gcc/ada/libgnat/a-wtgeau.adb +++ b/gcc/ada/libgnat/a-wtgeau.adb @@ -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 -- --------------- diff --git a/gcc/ada/libgnat/a-wtgeau.ads b/gcc/ada/libgnat/a-wtgeau.ads index ba8509b2bc9..9577ac2bd33 100644 --- a/gcc/ada/libgnat/a-wtgeau.ads +++ b/gcc/ada/libgnat/a-wtgeau.ads @@ -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); diff --git a/gcc/ada/libgnat/a-wtinau.adb b/gcc/ada/libgnat/a-wtinau.adb index 53e81630363..b614b39577c 100644 --- a/gcc/ada/libgnat/a-wtinau.adb +++ b/gcc/ada/libgnat/a-wtinau.adb @@ -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,61 +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 -- - ----------------------- - - 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 - (File : File_Type; - Item : out 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_Integer (Buf, Ptr'Access, Stop); - Check_End_Of_Field (Buf, Stop, Ptr, Width); - end Get_Int; - - ------------- - -- Get_LLI -- - ------------- + --------- + -- Get -- + --------- - procedure Get_LLI + procedure Get (File : File_Type; - Item : out Long_Long_Integer; + Item : out Num; Width : Field) is Buf : String (1 .. Field'Last); @@ -100,189 +54,73 @@ package body Ada.Wide_Text_IO.Integer_Aux is Load_Integer (File, Buf, Stop); end if; - Item := Scan_Long_Long_Integer (Buf, Ptr'Access, Stop); + Item := Scan (Buf, Ptr'Access, Stop); Check_End_Of_Field (Buf, Stop, Ptr, Width); - end Get_LLI; + end Get; - -------------- - -- Gets_Int -- - -------------- + ---------- + -- Gets -- + ---------- - 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; - - -------------- - -- Gets_LLI -- - -------------- - - 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); + end Gets; - if Loaded then + --------- + -- Put -- + --------- - -- 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; - - ------------- - -- Put_LLI -- - ------------- - - 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 - (To : out String; - Item : Integer; - Base : Number_Base) - is - Buf : String (1 .. Field'Last); - Ptr : Natural := 0; - - begin - if Base = 10 then - Set_Image_Width_Integer (Item, To'Length, Buf, Ptr); - else - Set_Image_Based_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_Int; + end Put; - -------------- - -- Puts_LLI -- - -------------- + ---------- + -- Puts -- + ---------- - procedure Puts_LLI + procedure Puts (To : out String; - Item : Long_Long_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_Long_Long_Integer (Item, To'Length, Buf, Ptr); + Set_Image_Width (Item, To'Length, Buf, Ptr); else - Set_Image_Based_Long_Long_Integer (Item, Base, To'Length, Buf, Ptr); + Set_Image_Based (Item, Base, To'Length, Buf, Ptr); end if; if Ptr > To'Length then @@ -290,6 +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_LLI; + end Puts; end Ada.Wide_Text_IO.Integer_Aux; diff --git a/gcc/ada/libgnat/a-wtinau.ads b/gcc/ada/libgnat/a-wtinau.ads index 691a877eb96..f139f77d503 100644 --- a/gcc/ada/libgnat/a-wtinau.ads +++ b/gcc/ada/libgnat/a-wtinau.ads @@ -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 - (File : File_Type; - Item : out Integer; - Width : Field); + 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); - procedure Get_LLI +package Ada.Wide_Text_IO.Integer_Aux is + + procedure Get (File : File_Type; - Item : out Long_Long_Integer; + Item : out Num; 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 - (To : out String; - Item : Integer; - Base : Number_Base); - - procedure Puts_LLI + procedure Puts (To : out String; - Item : Long_Long_Integer; + Item : Num; Base : Number_Base); end Ada.Wide_Text_IO.Integer_Aux; diff --git a/gcc/ada/libgnat/a-wtinio.adb b/gcc/ada/libgnat/a-wtinio.adb index bc032272380..a3f666e1ccd 100644 --- a/gcc/ada/libgnat/a-wtinio.adb +++ b/gcc/ada/libgnat/a-wtinio.adb @@ -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 diff --git a/gcc/ada/libgnat/a-wtinio__128.adb b/gcc/ada/libgnat/a-wtinio__128.adb new file mode 100644 index 00000000000..edc78c3614e --- /dev/null +++ b/gcc/ada/libgnat/a-wtinio__128.adb @@ -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 -- +-- . -- +-- -- +-- 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; diff --git a/gcc/ada/libgnat/a-wtmoau.adb b/gcc/ada/libgnat/a-wtmoau.adb deleted file mode 100644 index 90397980bc5..00000000000 --- a/gcc/ada/libgnat/a-wtmoau.adb +++ /dev/null @@ -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 -- --- . -- --- -- --- 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; diff --git a/gcc/ada/libgnat/a-wtmoau.ads b/gcc/ada/libgnat/a-wtmoau.ads deleted file mode 100644 index 9fe444e6b88..00000000000 --- a/gcc/ada/libgnat/a-wtmoau.ads +++ /dev/null @@ -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 -- --- . -- --- -- --- 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; diff --git a/gcc/ada/libgnat/a-wtmoio.adb b/gcc/ada/libgnat/a-wtmoio.adb index 629f95d588c..702dcbb68ca 100644 --- a/gcc/ada/libgnat/a-wtmoio.adb +++ b/gcc/ada/libgnat/a-wtmoio.adb @@ -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 diff --git a/gcc/ada/libgnat/a-wtmoio__128.adb b/gcc/ada/libgnat/a-wtmoio__128.adb new file mode 100644 index 00000000000..661faecf016 --- /dev/null +++ b/gcc/ada/libgnat/a-wtmoio__128.adb @@ -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 -- +-- . -- +-- -- +-- 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; diff --git a/gcc/ada/libgnat/a-ztgeau.adb b/gcc/ada/libgnat/a-ztgeau.adb index dbd89269843..be7aecc9ecf 100644 --- a/gcc/ada/libgnat/a-ztgeau.adb +++ b/gcc/ada/libgnat/a-ztgeau.adb @@ -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 -- --------------- diff --git a/gcc/ada/libgnat/a-ztgeau.ads b/gcc/ada/libgnat/a-ztgeau.ads index 2c5c306fc30..68d4a33cb37 100644 --- a/gcc/ada/libgnat/a-ztgeau.ads +++ b/gcc/ada/libgnat/a-ztgeau.ads @@ -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); diff --git a/gcc/ada/libgnat/a-ztinau.adb b/gcc/ada/libgnat/a-ztinau.adb index e7e290ee745..f7b49a11029 100644 --- a/gcc/ada/libgnat/a-ztinau.adb +++ b/gcc/ada/libgnat/a-ztinau.adb @@ -31,61 +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 -- - ----------------------- - - 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 - (File : File_Type; - Item : out 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_Integer (Buf, Ptr'Access, Stop); - Check_End_Of_Field (Buf, Stop, Ptr, Width); - end Get_Int; - - ------------- - -- Get_LLI -- - ------------- + --------- + -- Get -- + --------- - procedure Get_LLI + procedure Get (File : File_Type; - Item : out Long_Long_Integer; + Item : out Num; Width : Field) is Buf : String (1 .. Field'Last); @@ -100,189 +54,73 @@ package body Ada.Wide_Wide_Text_IO.Integer_Aux is Load_Integer (File, Buf, Stop); end if; - Item := Scan_Long_Long_Integer (Buf, Ptr'Access, Stop); + Item := Scan (Buf, Ptr'Access, Stop); Check_End_Of_Field (Buf, Stop, Ptr, Width); - end Get_LLI; + end Get; - -------------- - -- Gets_Int -- - -------------- + ---------- + -- Gets -- + ---------- - 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; - - -------------- - -- Gets_LLI -- - -------------- - - 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); + end Gets; - if Loaded then + --------- + -- Put -- + --------- - -- 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; - - ------------- - -- Put_LLI -- - ------------- - - 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 - (To : out String; - Item : Integer; - Base : Number_Base) - is - Buf : String (1 .. Field'Last); - Ptr : Natural := 0; - - begin - if Base = 10 then - Set_Image_Width_Integer (Item, To'Length, Buf, Ptr); - else - Set_Image_Based_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_Int; + end Put; - -------------- - -- Puts_LLI -- - -------------- + ---------- + -- Puts -- + ---------- - procedure Puts_LLI + procedure Puts (To : out String; - Item : Long_Long_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_Long_Long_Integer (Item, To'Length, Buf, Ptr); + Set_Image_Width (Item, To'Length, Buf, Ptr); else - Set_Image_Based_Long_Long_Integer (Item, Base, To'Length, Buf, Ptr); + Set_Image_Based (Item, Base, To'Length, Buf, Ptr); end if; if Ptr > To'Length then @@ -290,6 +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_LLI; + end Puts; end Ada.Wide_Wide_Text_IO.Integer_Aux; diff --git a/gcc/ada/libgnat/a-ztinau.ads b/gcc/ada/libgnat/a-ztinau.ads index 49eb3c5106c..914f12013a3 100644 --- a/gcc/ada/libgnat/a-ztinau.ads +++ b/gcc/ada/libgnat/a-ztinau.ads @@ -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 - (File : File_Type; - Item : out Integer; - Width : Field); + 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); - procedure Get_LLI +package Ada.Wide_Wide_Text_IO.Integer_Aux is + + procedure Get (File : File_Type; - Item : out Long_Long_Integer; + Item : out Num; 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 - (To : out String; - Item : Integer; - Base : Number_Base); - - procedure Puts_LLI + procedure Puts (To : out String; - Item : Long_Long_Integer; + Item : Num; Base : Number_Base); end Ada.Wide_Wide_Text_IO.Integer_Aux; diff --git a/gcc/ada/libgnat/a-ztinio.adb b/gcc/ada/libgnat/a-ztinio.adb index c0726cec106..ab8741ee027 100644 --- a/gcc/ada/libgnat/a-ztinio.adb +++ b/gcc/ada/libgnat/a-ztinio.adb @@ -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 diff --git a/gcc/ada/libgnat/a-ztinio__128.adb b/gcc/ada/libgnat/a-ztinio__128.adb new file mode 100644 index 00000000000..c809eebd8a4 --- /dev/null +++ b/gcc/ada/libgnat/a-ztinio__128.adb @@ -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 -- +-- . -- +-- -- +-- 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; diff --git a/gcc/ada/libgnat/a-ztmoau.adb b/gcc/ada/libgnat/a-ztmoau.adb deleted file mode 100644 index 2f179e2785e..00000000000 --- a/gcc/ada/libgnat/a-ztmoau.adb +++ /dev/null @@ -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 -- --- . -- --- -- --- 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; diff --git a/gcc/ada/libgnat/a-ztmoau.ads b/gcc/ada/libgnat/a-ztmoau.ads deleted file mode 100644 index 9d531541705..00000000000 --- a/gcc/ada/libgnat/a-ztmoau.ads +++ /dev/null @@ -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 -- --- . -- --- -- --- 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; diff --git a/gcc/ada/libgnat/a-ztmoio.adb b/gcc/ada/libgnat/a-ztmoio.adb index bf9d42b54cd..d2f81e2380c 100644 --- a/gcc/ada/libgnat/a-ztmoio.adb +++ b/gcc/ada/libgnat/a-ztmoio.adb @@ -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 diff --git a/gcc/ada/libgnat/a-ztmoio__128.adb b/gcc/ada/libgnat/a-ztmoio__128.adb new file mode 100644 index 00000000000..e6e11defa7a --- /dev/null +++ b/gcc/ada/libgnat/a-ztmoio__128.adb @@ -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 -- +-- . -- +-- -- +-- 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; -- 2.30.2