diff options
Diffstat (limited to 'gcc/ada/libgnat/a-ztinau.adb')
| -rw-r--r-- | gcc/ada/libgnat/a-ztinau.adb | 228 |
1 files changed, 33 insertions, 195 deletions
diff --git a/gcc/ada/libgnat/a-ztinau.adb b/gcc/ada/libgnat/a-ztinau.adb index e7e290e..f7b49a1 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; |