From 161c5cc509e5e8abd70ec84848c43f51a9b1cbcb Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Mon, 14 Oct 2013 15:53:02 +0200 Subject: [PATCH] [multiple changes] 2013-10-14 Robert Dewar * exp_attr.adb (Find_Stream_Subprogram): Optimize Storage_Array stream handling. (Find_Stream_Subprogram): Optimize Stream_Element_Array stream handling * rtsfind.ads: Add entry for Stream_Element_Array Add entries for RE_Storage_Array subprograms Add entries for RE_Stream_Element_Array subprograms * s-ststop.ads, s-ststop.adb: Add processing for System.Storage_Array. Add processing for Ada.Stream_Element_Array. 2013-10-14 Tristan Gingold * a-except-2005.ads, a-except-2005.adb: (Get_Exception_Machine_Occurrence): New function. * raise-gcc.c (__gnat_unwind_exception_size): New constant. From-SVN: r203560 --- gcc/ada/ChangeLog | 17 ++ gcc/ada/a-except-2005.adb | 10 ++ gcc/ada/a-except-2005.ads | 17 +- gcc/ada/exp_attr.adb | 185 ++++++++++++++++++-- gcc/ada/raise-gcc.c | 7 + gcc/ada/rtsfind.ads | 42 +++++ gcc/ada/s-ststop.adb | 349 ++++++++++++++++++++++++++++++-------- gcc/ada/s-ststop.ads | 94 +++++++++- 8 files changed, 620 insertions(+), 101 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 8cd9a9dd98d..aa7004b15e2 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,20 @@ +2013-10-14 Robert Dewar + + * exp_attr.adb (Find_Stream_Subprogram): Optimize + Storage_Array stream handling. + (Find_Stream_Subprogram): Optimize Stream_Element_Array stream handling + * rtsfind.ads: Add entry for Stream_Element_Array Add + entries for RE_Storage_Array subprograms Add entries for + RE_Stream_Element_Array subprograms + * s-ststop.ads, s-ststop.adb: Add processing for System.Storage_Array. + Add processing for Ada.Stream_Element_Array. + +2013-10-14 Tristan Gingold + + * a-except-2005.ads, a-except-2005.adb: + (Get_Exception_Machine_Occurrence): New function. + * raise-gcc.c (__gnat_unwind_exception_size): New constant. + 2013-10-14 Robert Dewar * sem_res.adb: Minor fix to error message text. diff --git a/gcc/ada/a-except-2005.adb b/gcc/ada/a-except-2005.adb index 3453eae90ab..29ecf391d80 100644 --- a/gcc/ada/a-except-2005.adb +++ b/gcc/ada/a-except-2005.adb @@ -861,6 +861,16 @@ package body Ada.Exceptions is -- in case we do not want any exception tracing support. This is -- why this package is separated. + -------------------------------------- + -- Get_Exception_Machine_Occurrence -- + -------------------------------------- + + function Get_Exception_Machine_Occurrence (X : Exception_Occurrence) + return System.Address is + begin + return X.Machine_Occurrence; + end Get_Exception_Machine_Occurrence; + ----------- -- Image -- ----------- diff --git a/gcc/ada/a-except-2005.ads b/gcc/ada/a-except-2005.ads index bb597ed0982..ecc5ca8ad1c 100644 --- a/gcc/ada/a-except-2005.ads +++ b/gcc/ada/a-except-2005.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2013, Free Software Foundation, Inc. -- -- -- -- This specification is derived from the Ada Reference Manual for use with -- -- GNAT. The copyright notice above, and the license provisions that follow -- @@ -51,12 +51,8 @@ with System.Standard_Library; with System.Traceback_Entries; package Ada.Exceptions is - pragma Warnings (Off); pragma Preelaborate_05; - pragma Warnings (On); - -- In accordance with Ada 2005 AI-362. The warnings pragmas are so that we - -- can compile this using older compiler versions, which will ignore the - -- pragma, which is fine for the bootstrap. + -- In accordance with Ada 2005 AI-362. type Exception_Id is private; pragma Preelaborable_Initialization (Exception_Id); @@ -337,6 +333,15 @@ private -- this, and it would not work right, because of the Msg and Tracebacks -- fields which have unused entries not copied by Save_Occurrence. + function Get_Exception_Machine_Occurrence (X : Exception_Occurrence) + return System.Address; + pragma Export (Ada, Get_Exception_Machine_Occurrence, + "__gnat_get_exception_machine_occurrence"); + -- Get the machine occurrence corresponding to an exception occurrence. + -- It is Null_Address if there is no machine occurrence (in runtimes that + -- doesn't use GCC mechanism) or if it has been lost (Save_Occurrence + -- doesn't save the machine occurrence). + function EO_To_String (X : Exception_Occurrence) return String; function String_To_EO (S : String) return Exception_Occurrence; pragma Stream_Convert (Exception_Occurrence, String_To_EO, EO_To_String); diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index e039fadfda0..7458ddf4a80 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -6885,7 +6885,7 @@ package body Exp_Attr is -- Function to check whether the specified run-time call is available -- in the run time used. In the case of a configurable run time, it -- is normal that some subprograms are not there. - + -- -- I don't understand this routine at all, why is this not just a -- call to RTE_Available? And if for some reason we need a different -- routine with different semantics, why is not in Rtsfind ??? @@ -6899,8 +6899,7 @@ package body Exp_Attr is -- Assume that the unit will always be available when using a -- "normal" (not configurable) run time. - return not Configurable_Run_Time_Mode - or else RTE_Available (Entity); + return not Configurable_Run_Time_Mode or else RTE_Available (Entity); end Is_Available; -- Start of processing for Find_Stream_Subprogram @@ -6935,9 +6934,148 @@ package body Exp_Attr is and then not Is_Predefined_File_Name (Unit_File_Name (Current_Sem_Unit)) then + -- Storage_Array as defined in package System.Storage_Elements + + if Is_RTE (Base_Typ, RE_Storage_Array) then + + -- Case of No_Stream_Optimizations restriction active + + if Restriction_Active (No_Stream_Optimizations) then + if Nam = TSS_Stream_Input + and then Is_Available (RE_Storage_Array_Input) + then + return RTE (RE_Storage_Array_Input); + + elsif Nam = TSS_Stream_Output + and then Is_Available (RE_Storage_Array_Output) + then + return RTE (RE_Storage_Array_Output); + + elsif Nam = TSS_Stream_Read + and then Is_Available (RE_Storage_Array_Read) + then + return RTE (RE_Storage_Array_Read); + + elsif Nam = TSS_Stream_Write + and then Is_Available (RE_Storage_Array_Write) + then + return RTE (RE_Storage_Array_Write); + + elsif Nam /= TSS_Stream_Input and then + Nam /= TSS_Stream_Output and then + Nam /= TSS_Stream_Read and then + Nam /= TSS_Stream_Write + then + raise Program_Error; + end if; + + -- Restriction No_Stream_Optimizations is not set, so we can go + -- ahead and optimize using the block IO forms of the routines. + + else + if Nam = TSS_Stream_Input + and then Is_Available (RE_Storage_Array_Input_Blk_IO) + then + return RTE (RE_Storage_Array_Input_Blk_IO); + + elsif Nam = TSS_Stream_Output + and then Is_Available (RE_Storage_Array_Output_Blk_IO) + then + return RTE (RE_Storage_Array_Output_Blk_IO); + + elsif Nam = TSS_Stream_Read + and then Is_Available (RE_Storage_Array_Read_Blk_IO) + then + return RTE (RE_Storage_Array_Read_Blk_IO); + + elsif Nam = TSS_Stream_Write + and then Is_Available (RE_Storage_Array_Write_Blk_IO) + then + return RTE (RE_Storage_Array_Write_Blk_IO); + + elsif Nam /= TSS_Stream_Input and then + Nam /= TSS_Stream_Output and then + Nam /= TSS_Stream_Read and then + Nam /= TSS_Stream_Write + then + raise Program_Error; + end if; + end if; + + -- Stream_Element_Array as defined in package Ada.Streams + + elsif Is_RTE (Base_Typ, RE_Stream_Element_Array) then + + -- Case of No_Stream_Optimizations restriction active + + if Restriction_Active (No_Stream_Optimizations) then + if Nam = TSS_Stream_Input + and then Is_Available (RE_Stream_Element_Array_Input) + then + return RTE (RE_Stream_Element_Array_Input); + + elsif Nam = TSS_Stream_Output + and then Is_Available (RE_Stream_Element_Array_Output) + then + return RTE (RE_Stream_Element_Array_Output); + + elsif Nam = TSS_Stream_Read + and then Is_Available (RE_Stream_Element_Array_Read) + then + return RTE (RE_Stream_Element_Array_Read); + + elsif Nam = TSS_Stream_Write + and then Is_Available (RE_Stream_Element_Array_Write) + then + return RTE (RE_Stream_Element_Array_Write); + + elsif Nam /= TSS_Stream_Input and then + Nam /= TSS_Stream_Output and then + Nam /= TSS_Stream_Read and then + Nam /= TSS_Stream_Write + then + raise Program_Error; + end if; + + -- Restriction No_Stream_Optimizations is not set, so we can go + -- ahead and optimize using the block IO forms of the routines. + + else + if Nam = TSS_Stream_Input + and then Is_Available (RE_Stream_Element_Array_Input_Blk_IO) + then + return RTE (RE_Stream_Element_Array_Input_Blk_IO); + + elsif Nam = TSS_Stream_Output + and then Is_Available (RE_Stream_Element_Array_Output_Blk_IO) + then + return RTE (RE_Stream_Element_Array_Output_Blk_IO); + + elsif Nam = TSS_Stream_Read + and then Is_Available (RE_Stream_Element_Array_Read_Blk_IO) + then + return RTE (RE_Stream_Element_Array_Read_Blk_IO); + + elsif Nam = TSS_Stream_Write + and then Is_Available (RE_Stream_Element_Array_Write_Blk_IO) + then + return RTE (RE_Stream_Element_Array_Write_Blk_IO); + + elsif Nam /= TSS_Stream_Input and then + Nam /= TSS_Stream_Output and then + Nam /= TSS_Stream_Read and then + Nam /= TSS_Stream_Write + then + raise Program_Error; + end if; + end if; + -- String as defined in package Ada - if Base_Typ = Standard_String then + elsif Base_Typ = Standard_String then + + -- Case of No_Stream_Optimizations restriction active + if Restriction_Active (No_Stream_Optimizations) then if Nam = TSS_Stream_Input and then Is_Available (RE_String_Input) @@ -6967,6 +7105,9 @@ package body Exp_Attr is raise Program_Error; end if; + -- Restriction No_Stream_Optimizations is not set, so we can go + -- ahead and optimize using the block IO forms of the routines. + else if Nam = TSS_Stream_Input and then Is_Available (RE_String_Input_Blk_IO) @@ -6988,9 +7129,9 @@ package body Exp_Attr is then return RTE (RE_String_Write_Blk_IO); - elsif Nam /= TSS_Stream_Input and then + elsif Nam /= TSS_Stream_Input and then Nam /= TSS_Stream_Output and then - Nam /= TSS_Stream_Read and then + Nam /= TSS_Stream_Read and then Nam /= TSS_Stream_Write then raise Program_Error; @@ -7000,6 +7141,9 @@ package body Exp_Attr is -- Wide_String as defined in package Ada elsif Base_Typ = Standard_Wide_String then + + -- Case of No_Stream_Optimizations restriction active + if Restriction_Active (No_Stream_Optimizations) then if Nam = TSS_Stream_Input and then Is_Available (RE_Wide_String_Input) @@ -7021,14 +7165,17 @@ package body Exp_Attr is then return RTE (RE_Wide_String_Write); - elsif Nam /= TSS_Stream_Input and then + elsif Nam /= TSS_Stream_Input and then Nam /= TSS_Stream_Output and then - Nam /= TSS_Stream_Read and then + Nam /= TSS_Stream_Read and then Nam /= TSS_Stream_Write then raise Program_Error; end if; + -- Restriction No_Stream_Optimizations is not set, so we can go + -- ahead and optimize using the block IO forms of the routines. + else if Nam = TSS_Stream_Input and then Is_Available (RE_Wide_String_Input_Blk_IO) @@ -7050,9 +7197,9 @@ package body Exp_Attr is then return RTE (RE_Wide_String_Write_Blk_IO); - elsif Nam /= TSS_Stream_Input and then + elsif Nam /= TSS_Stream_Input and then Nam /= TSS_Stream_Output and then - Nam /= TSS_Stream_Read and then + Nam /= TSS_Stream_Read and then Nam /= TSS_Stream_Write then raise Program_Error; @@ -7062,6 +7209,9 @@ package body Exp_Attr is -- Wide_Wide_String as defined in package Ada elsif Base_Typ = Standard_Wide_Wide_String then + + -- Case of No_Stream_Optimizations restriction active + if Restriction_Active (No_Stream_Optimizations) then if Nam = TSS_Stream_Input and then Is_Available (RE_Wide_Wide_String_Input) @@ -7083,14 +7233,17 @@ package body Exp_Attr is then return RTE (RE_Wide_Wide_String_Write); - elsif Nam /= TSS_Stream_Input and then + elsif Nam /= TSS_Stream_Input and then Nam /= TSS_Stream_Output and then - Nam /= TSS_Stream_Read and then + Nam /= TSS_Stream_Read and then Nam /= TSS_Stream_Write then raise Program_Error; end if; + -- Restriction No_Stream_Optimizations is not set, so we can go + -- ahead and optimize using the block IO forms of the routines. + else if Nam = TSS_Stream_Input and then Is_Available (RE_Wide_Wide_String_Input_Blk_IO) @@ -7112,9 +7265,9 @@ package body Exp_Attr is then return RTE (RE_Wide_Wide_String_Write_Blk_IO); - elsif Nam /= TSS_Stream_Input and then + elsif Nam /= TSS_Stream_Input and then Nam /= TSS_Stream_Output and then - Nam /= TSS_Stream_Read and then + Nam /= TSS_Stream_Read and then Nam /= TSS_Stream_Write then raise Program_Error; @@ -7123,9 +7276,7 @@ package body Exp_Attr is end if; end if; - if Is_Tagged_Type (Typ) - and then Is_Derived_Type (Typ) - then + if Is_Tagged_Type (Typ) and then Is_Derived_Type (Typ) then return Find_Prim_Op (Typ, Nam); else return Find_Inherited_TSS (Typ, Nam); diff --git a/gcc/ada/raise-gcc.c b/gcc/ada/raise-gcc.c index a207e524d8a..ca1e84afa9a 100644 --- a/gcc/ada/raise-gcc.c +++ b/gcc/ada/raise-gcc.c @@ -1463,3 +1463,10 @@ __gnat_personality_seh0 (PEXCEPTION_RECORD ms_exc, void *this_frame, ms_disp, __gnat_personality_imp); } #endif /* SEH */ + +#if !defined (__USING_SJLJ_EXCEPTIONS__) +/* Size of the _Unwind_Exception structure. This is used by g-cppexc to get + the offset to the C++ object. */ + +const int __gnat_unwind_exception_size = sizeof (_Unwind_Exception); +#endif diff --git a/gcc/ada/rtsfind.ads b/gcc/ada/rtsfind.ads index d863e1cdd35..5ae85f32b96 100644 --- a/gcc/ada/rtsfind.ads +++ b/gcc/ada/rtsfind.ads @@ -591,6 +591,7 @@ package Rtsfind is RE_Root_Stream_Type, -- Ada.Streams RE_Stream_Element, -- Ada.Streams + RE_Stream_Element_Array, -- Ada.Streams RE_Stream_Element_Offset, -- Ada.Streams RE_Stream_Access, -- Ada.Streams.Stream_IO @@ -1477,6 +1478,24 @@ package Rtsfind is RE_W_WC, -- System.Stream_Attributes RE_W_WWC, -- System.Stream_Attributes + RE_Storage_Array_Input, -- System.Strings.Stream_Ops + RE_Storage_Array_Input_Blk_IO, -- System.Strings.Stream_Ops + RE_Storage_Array_Output, -- System.Strings.Stream_Ops + RE_Storage_Array_Output_Blk_IO, -- System.Strings.Stream_Ops + RE_Storage_Array_Read, -- System.Strings.Stream_Ops + RE_Storage_Array_Read_Blk_IO, -- System.Strings.Stream_Ops + RE_Storage_Array_Write, -- System.Strings.Stream_Ops + RE_Storage_Array_Write_Blk_IO, -- System.Strings.Stream_Ops + + RE_Stream_Element_Array_Input, -- System.Strings.Stream_Ops + RE_Stream_Element_Array_Input_Blk_IO, -- System.Strings.Stream_Ops + RE_Stream_Element_Array_Output, -- System.Strings.Stream_Ops + RE_Stream_Element_Array_Output_Blk_IO, -- System.Strings.Stream_Ops + RE_Stream_Element_Array_Read, -- System.Strings.Stream_Ops + RE_Stream_Element_Array_Read_Blk_IO, -- System.Strings.Stream_Ops + RE_Stream_Element_Array_Write, -- System.Strings.Stream_Ops + RE_Stream_Element_Array_Write_Blk_IO, -- System.Strings.Stream_Ops + RE_String_Input, -- System.Strings.Stream_Ops RE_String_Input_Blk_IO, -- System.Strings.Stream_Ops RE_String_Output, -- System.Strings.Stream_Ops @@ -1485,6 +1504,7 @@ package Rtsfind is RE_String_Read_Blk_IO, -- System.Strings.Stream_Ops RE_String_Write, -- System.Strings.Stream_Ops RE_String_Write_Blk_IO, -- System.Strings.Stream_Ops + RE_Wide_String_Input, -- System.Strings.Stream_Ops RE_Wide_String_Input_Blk_IO, -- System.Strings.Stream_Ops RE_Wide_String_Output, -- System.Strings.Stream_Ops @@ -1493,6 +1513,7 @@ package Rtsfind is RE_Wide_String_Read_Blk_IO, -- System.Strings.Stream_Ops RE_Wide_String_Write, -- System.Strings.Stream_Ops RE_Wide_String_Write_Blk_IO, -- System.Strings.Stream_Ops + RE_Wide_Wide_String_Input, -- System.Strings.Stream_Ops RE_Wide_Wide_String_Input_Blk_IO, -- System.Strings.Stream_Ops RE_Wide_Wide_String_Output, -- System.Strings.Stream_Ops @@ -1844,6 +1865,7 @@ package Rtsfind is RE_Root_Stream_Type => Ada_Streams, RE_Stream_Element => Ada_Streams, + RE_Stream_Element_Array => Ada_Streams, RE_Stream_Element_Offset => Ada_Streams, RE_Stream_Access => Ada_Streams_Stream_IO, @@ -2734,6 +2756,24 @@ package Rtsfind is RE_W_WC => System_Stream_Attributes, RE_W_WWC => System_Stream_Attributes, + RE_Storage_Array_Input => System_Strings_Stream_Ops, + RE_Storage_Array_Input_Blk_IO => System_Strings_Stream_Ops, + RE_Storage_Array_Output => System_Strings_Stream_Ops, + RE_Storage_Array_Output_Blk_IO => System_Strings_Stream_Ops, + RE_Storage_Array_Read => System_Strings_Stream_Ops, + RE_Storage_Array_Read_Blk_IO => System_Strings_Stream_Ops, + RE_Storage_Array_Write => System_Strings_Stream_Ops, + RE_Storage_Array_Write_Blk_IO => System_Strings_Stream_Ops, + + RE_Stream_Element_Array_Input => System_Strings_Stream_Ops, + RE_Stream_Element_Array_Input_Blk_IO => System_Strings_Stream_Ops, + RE_Stream_Element_Array_Output => System_Strings_Stream_Ops, + RE_Stream_Element_Array_Output_Blk_IO => System_Strings_Stream_Ops, + RE_Stream_Element_Array_Read => System_Strings_Stream_Ops, + RE_Stream_Element_Array_Read_Blk_IO => System_Strings_Stream_Ops, + RE_Stream_Element_Array_Write => System_Strings_Stream_Ops, + RE_Stream_Element_Array_Write_Blk_IO => System_Strings_Stream_Ops, + RE_String_Input => System_Strings_Stream_Ops, RE_String_Input_Blk_IO => System_Strings_Stream_Ops, RE_String_Output => System_Strings_Stream_Ops, @@ -2742,6 +2782,7 @@ package Rtsfind is RE_String_Read_Blk_IO => System_Strings_Stream_Ops, RE_String_Write => System_Strings_Stream_Ops, RE_String_Write_Blk_IO => System_Strings_Stream_Ops, + RE_Wide_String_Input => System_Strings_Stream_Ops, RE_Wide_String_Input_Blk_IO => System_Strings_Stream_Ops, RE_Wide_String_Output => System_Strings_Stream_Ops, @@ -2749,6 +2790,7 @@ package Rtsfind is RE_Wide_String_Read => System_Strings_Stream_Ops, RE_Wide_String_Read_Blk_IO => System_Strings_Stream_Ops, RE_Wide_String_Write => System_Strings_Stream_Ops, + RE_Wide_String_Write_Blk_IO => System_Strings_Stream_Ops, RE_Wide_Wide_String_Input => System_Strings_Stream_Ops, RE_Wide_Wide_String_Input_Blk_IO => System_Strings_Stream_Ops, diff --git a/gcc/ada/s-ststop.adb b/gcc/ada/s-ststop.adb index d9f8d0f8ed9..f57ff09fa6a 100644 --- a/gcc/ada/s-ststop.adb +++ b/gcc/ada/s-ststop.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2008-2010, Free Software Foundation, Inc. -- +-- Copyright (C) 2008-2013, 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- -- @@ -35,7 +35,9 @@ with Ada.Streams; use Ada.Streams; with Ada.Streams.Stream_IO; use Ada.Streams.Stream_IO; with Ada.Unchecked_Conversion; -with System.Stream_Attributes; use System; +with System; use System; +with System.Storage_Elements; use System.Storage_Elements; +with System.Stream_Attributes; package body System.Strings.Stream_Ops is @@ -46,31 +48,32 @@ package body System.Strings.Stream_Ops is -- The following package provides an IO framework for strings. Depending -- on the version of System.Stream_Attributes as well as the size of - -- formal parameter Character_Type, the package will either utilize block - -- IO or character-by-character IO. + -- formal parameter Element_Type, the package will either utilize block + -- IO or element-by-element IO. generic - type Character_Type is private; - type String_Type is array (Positive range <>) of Character_Type; + type Element_Type is private; + type Index_Type is range <>; + type Array_Type is array (Index_Type range <>) of Element_Type; package Stream_Ops_Internal is function Input (Strm : access Root_Stream_Type'Class; - IO : IO_Kind) return String_Type; + IO : IO_Kind) return Array_Type; procedure Output (Strm : access Root_Stream_Type'Class; - Item : String_Type; + Item : Array_Type; IO : IO_Kind); procedure Read (Strm : access Root_Stream_Type'Class; - Item : out String_Type; + Item : out Array_Type; IO : IO_Kind); procedure Write (Strm : access Root_Stream_Type'Class; - Item : String_Type; + Item : Array_Type; IO : IO_Kind); end Stream_Ops_Internal; @@ -86,31 +89,36 @@ package body System.Strings.Stream_Ops is Default_Block_Size : constant := 512 * 8; - -- Shorthand notation for stream element and character sizes + -- Shorthand notation for stream element and element type sizes - C_Size : constant Integer := Character_Type'Size; + ET_Size : constant Integer := Element_Type'Size; SE_Size : constant Integer := Stream_Element'Size; - -- The following constants describe the number of stream elements or - -- characters that can fit into a default block. + -- The following constants describe the number of array elements or + -- stream elements that can fit into a default block. + + AE_In_Default_Block : constant Index_Type := + Index_Type (Default_Block_Size / ET_Size); + -- Number of array elements in a default block - C_In_Default_Block : constant Integer := Default_Block_Size / C_Size; SE_In_Default_Block : constant Integer := Default_Block_Size / SE_Size; + -- Number of storage elements in a default block -- Buffer types subtype Default_Block is Stream_Element_Array (1 .. Stream_Element_Offset (SE_In_Default_Block)); - subtype String_Block is String_Type (1 .. C_In_Default_Block); + subtype Array_Block is + Array_Type (Index_Type range 1 .. AE_In_Default_Block); -- Conversions to and from Default_Block function To_Default_Block is - new Ada.Unchecked_Conversion (String_Block, Default_Block); + new Ada.Unchecked_Conversion (Array_Block, Default_Block); - function To_String_Block is - new Ada.Unchecked_Conversion (Default_Block, String_Block); + function To_Array_Block is + new Ada.Unchecked_Conversion (Default_Block, Array_Block); ----------- -- Input -- @@ -118,7 +126,7 @@ package body System.Strings.Stream_Ops is function Input (Strm : access Root_Stream_Type'Class; - IO : IO_Kind) return String_Type + IO : IO_Kind) return Array_Type is begin if Strm = null then @@ -126,23 +134,21 @@ package body System.Strings.Stream_Ops is end if; declare - Low : Positive; - High : Positive; + Low : Index_Type; + High : Index_Type; begin -- Read the bounds of the string - Positive'Read (Strm, Low); - Positive'Read (Strm, High); + Index_Type'Read (Strm, Low); + Index_Type'Read (Strm, High); - declare - Item : String_Type (Low .. High); + -- Read the character content of the string + declare + Item : Array_Type (Low .. High); begin - -- Read the character content of the string - Read (Strm, Item, IO); - return Item; end; end; @@ -154,7 +160,7 @@ package body System.Strings.Stream_Ops is procedure Output (Strm : access Root_Stream_Type'Class; - Item : String_Type; + Item : Array_Type; IO : IO_Kind) is begin @@ -164,8 +170,8 @@ package body System.Strings.Stream_Ops is -- Write the bounds of the string - Positive'Write (Strm, Item'First); - Positive'Write (Strm, Item'Last); + Index_Type'Write (Strm, Item'First); + Index_Type'Write (Strm, Item'Last); -- Write the character content of the string @@ -178,7 +184,7 @@ package body System.Strings.Stream_Ops is procedure Read (Strm : access Root_Stream_Type'Class; - Item : out String_Type; + Item : out Array_Type; IO : IO_Kind) is begin @@ -194,15 +200,13 @@ package body System.Strings.Stream_Ops is -- Block IO - if IO = Block_IO - and then Stream_Attributes.Block_IO_OK - then + if IO = Block_IO and then Stream_Attributes.Block_IO_OK then declare -- Determine the size in BITS of the block necessary to contain -- the whole string. Block_Size : constant Natural := - (Item'Last - Item'First + 1) * C_Size; + Integer (Item'Last - Item'First + 1) * ET_Size; -- Item can be larger than what the default block can store, -- determine the number of whole reads necessary to read the @@ -218,8 +222,8 @@ package body System.Strings.Stream_Ops is -- String indexes - Low : Positive := Item'First; - High : Positive := Low + C_In_Default_Block - 1; + Low : Index_Type := Item'First; + High : Index_Type := Low + AE_In_Default_Block - 1; -- End of stream error detection @@ -237,10 +241,10 @@ package body System.Strings.Stream_Ops is begin for Counter in 1 .. Blocks loop Read (Strm.all, Block, Last); - Item (Low .. High) := To_String_Block (Block); + Item (Low .. High) := To_Array_Block (Block); Low := High + 1; - High := Low + C_In_Default_Block - 1; + High := Low + AE_In_Default_Block - 1; Sum := Sum + Last; Last := 0; end loop; @@ -254,17 +258,18 @@ package body System.Strings.Stream_Ops is subtype Rem_Block is Stream_Element_Array (1 .. Stream_Element_Offset (Rem_Size / SE_Size)); - subtype Rem_String_Block is - String_Type (1 .. Rem_Size / C_Size); + subtype Rem_Array_Block is + Array_Type (Index_Type range + 1 .. Index_Type (Rem_Size / ET_Size)); - function To_Rem_String_Block is new - Ada.Unchecked_Conversion (Rem_Block, Rem_String_Block); + function To_Rem_Array_Block is new + Ada.Unchecked_Conversion (Rem_Block, Rem_Array_Block); Block : Rem_Block; begin Read (Strm.all, Block, Last); - Item (Low .. Item'Last) := To_Rem_String_Block (Block); + Item (Low .. Item'Last) := To_Rem_Array_Block (Block); Sum := Sum + Last; end; @@ -275,7 +280,7 @@ package body System.Strings.Stream_Ops is -- words, the stream does not contain enough elements to fully -- populate Item. - if (Integer (Sum) * SE_Size) / C_Size < Item'Length then + if (Integer (Sum) * SE_Size) / ET_Size < Item'Length then raise End_Error; end if; end; @@ -284,12 +289,11 @@ package body System.Strings.Stream_Ops is else declare - C : Character_Type; - + E : Element_Type; begin for Index in Item'First .. Item'Last loop - Character_Type'Read (Strm, C); - Item (Index) := C; + Element_Type'Read (Strm, E); + Item (Index) := E; end loop; end; end if; @@ -301,7 +305,7 @@ package body System.Strings.Stream_Ops is procedure Write (Strm : access Root_Stream_Type'Class; - Item : String_Type; + Item : Array_Type; IO : IO_Kind) is begin @@ -317,14 +321,12 @@ package body System.Strings.Stream_Ops is -- Block IO - if IO = Block_IO - and then Stream_Attributes.Block_IO_OK - then + if IO = Block_IO and then Stream_Attributes.Block_IO_OK then declare -- Determine the size in BITS of the block necessary to contain -- the whole string. - Block_Size : constant Natural := Item'Length * C_Size; + Block_Size : constant Natural := Item'Length * ET_Size; -- Item can be larger than what the default block can store, -- determine the number of whole writes necessary to output the @@ -340,8 +342,8 @@ package body System.Strings.Stream_Ops is -- String indexes - Low : Positive := Item'First; - High : Positive := Low + C_In_Default_Block - 1; + Low : Index_Type := Item'First; + High : Index_Type := Low + AE_In_Default_Block - 1; begin -- Step 1: If the string is too large, write out individual @@ -349,9 +351,8 @@ package body System.Strings.Stream_Ops is for Counter in 1 .. Blocks loop Write (Strm.all, To_Default_Block (Item (Low .. High))); - Low := High + 1; - High := Low + C_In_Default_Block - 1; + High := Low + AE_In_Default_Block - 1; end loop; -- Step 2: Write out any remaining elements @@ -361,11 +362,12 @@ package body System.Strings.Stream_Ops is subtype Rem_Block is Stream_Element_Array (1 .. Stream_Element_Offset (Rem_Size / SE_Size)); - subtype Rem_String_Block is - String_Type (1 .. Rem_Size / C_Size); + subtype Rem_Array_Block is + Array_Type (Index_Type range + 1 .. Index_Type (Rem_Size / ET_Size)); function To_Rem_Block is new - Ada.Unchecked_Conversion (Rem_String_Block, Rem_Block); + Ada.Unchecked_Conversion (Rem_Array_Block, Rem_Block); begin Write (Strm.all, To_Rem_Block (Item (Low .. Item'Last))); @@ -377,28 +379,233 @@ package body System.Strings.Stream_Ops is else for Index in Item'First .. Item'Last loop - Character_Type'Write (Strm, Item (Index)); + Element_Type'Write (Strm, Item (Index)); end loop; end if; end Write; end Stream_Ops_Internal; - -- Specific instantiations for all Ada string types + -- Specific instantiations for all Ada array types handled + + package Storage_Array_Ops is + new Stream_Ops_Internal + (Element_Type => Storage_Element, + Index_Type => Storage_Offset, + Array_Type => Storage_Array); + + package Stream_Element_Array_Ops is + new Stream_Ops_Internal + (Element_Type => Stream_Element, + Index_Type => Stream_Element_Offset, + Array_Type => Stream_Element_Array); package String_Ops is new Stream_Ops_Internal - (Character_Type => Character, - String_Type => String); + (Element_Type => Character, + Index_Type => Positive, + Array_Type => String); package Wide_String_Ops is new Stream_Ops_Internal - (Character_Type => Wide_Character, - String_Type => Wide_String); + (Element_Type => Wide_Character, + Index_Type => Positive, + Array_Type => Wide_String); package Wide_Wide_String_Ops is new Stream_Ops_Internal - (Character_Type => Wide_Wide_Character, - String_Type => Wide_Wide_String); + (Element_Type => Wide_Wide_Character, + Index_Type => Positive, + Array_Type => Wide_Wide_String); + + ------------------------- + -- Storage_Array_Input -- + ------------------------- + + function Storage_Array_Input + (Strm : access Ada.Streams.Root_Stream_Type'Class) return Storage_Array + is + begin + return Storage_Array_Ops.Input (Strm, Byte_IO); + end Storage_Array_Input; + + -------------------------------- + -- Storage_Array_Input_Blk_IO -- + -------------------------------- + + function Storage_Array_Input_Blk_IO + (Strm : access Ada.Streams.Root_Stream_Type'Class) return Storage_Array + is + begin + return Storage_Array_Ops.Input (Strm, Block_IO); + end Storage_Array_Input_Blk_IO; + + -------------------------- + -- Storage_Array_Output -- + -------------------------- + + procedure Storage_Array_Output + (Strm : access Ada.Streams.Root_Stream_Type'Class; + Item : Storage_Array) + is + begin + Storage_Array_Ops.Output (Strm, Item, Byte_IO); + end Storage_Array_Output; + + --------------------------------- + -- Storage_Array_Output_Blk_IO -- + --------------------------------- + + procedure Storage_Array_Output_Blk_IO + (Strm : access Ada.Streams.Root_Stream_Type'Class; + Item : Storage_Array) + is + begin + Storage_Array_Ops.Output (Strm, Item, Block_IO); + end Storage_Array_Output_Blk_IO; + + ------------------------ + -- Storage_Array_Read -- + ------------------------ + + procedure Storage_Array_Read + (Strm : access Ada.Streams.Root_Stream_Type'Class; + Item : out Storage_Array) + is + begin + Storage_Array_Ops.Read (Strm, Item, Byte_IO); + end Storage_Array_Read; + + ------------------------------- + -- Storage_Array_Read_Blk_IO -- + ------------------------------- + + procedure Storage_Array_Read_Blk_IO + (Strm : access Ada.Streams.Root_Stream_Type'Class; + Item : out Storage_Array) + is + begin + Storage_Array_Ops.Read (Strm, Item, Block_IO); + end Storage_Array_Read_Blk_IO; + + ------------------------- + -- Storage_Array_Write -- + ------------------------- + + procedure Storage_Array_Write + (Strm : access Ada.Streams.Root_Stream_Type'Class; + Item : Storage_Array) + is + begin + Storage_Array_Ops.Write (Strm, Item, Byte_IO); + end Storage_Array_Write; + + -------------------------------- + -- Storage_Array_Write_Blk_IO -- + -------------------------------- + + procedure Storage_Array_Write_Blk_IO + (Strm : access Ada.Streams.Root_Stream_Type'Class; + Item : Storage_Array) + is + begin + Storage_Array_Ops.Write (Strm, Item, Block_IO); + end Storage_Array_Write_Blk_IO; + + -------------------------------- + -- Stream_Element_Array_Input -- + -------------------------------- + + function Stream_Element_Array_Input + (Strm : access Ada.Streams.Root_Stream_Type'Class) + return Stream_Element_Array + is + begin + return Stream_Element_Array_Ops.Input (Strm, Byte_IO); + end Stream_Element_Array_Input; + + --------------------------------------- + -- Stream_Element_Array_Input_Blk_IO -- + --------------------------------------- + + function Stream_Element_Array_Input_Blk_IO + (Strm : access Ada.Streams.Root_Stream_Type'Class) + return Stream_Element_Array + is + begin + return Stream_Element_Array_Ops.Input (Strm, Block_IO); + end Stream_Element_Array_Input_Blk_IO; + + --------------------------------- + -- Stream_Element_Array_Output -- + --------------------------------- + + procedure Stream_Element_Array_Output + (Strm : access Ada.Streams.Root_Stream_Type'Class; + Item : Stream_Element_Array) + is + begin + Stream_Element_Array_Ops.Output (Strm, Item, Byte_IO); + end Stream_Element_Array_Output; + + ---------------------------------------- + -- Stream_Element_Array_Output_Blk_IO -- + ---------------------------------------- + + procedure Stream_Element_Array_Output_Blk_IO + (Strm : access Ada.Streams.Root_Stream_Type'Class; + Item : Stream_Element_Array) + is + begin + Stream_Element_Array_Ops.Output (Strm, Item, Block_IO); + end Stream_Element_Array_Output_Blk_IO; + + ------------------------------- + -- Stream_Element_Array_Read -- + ------------------------------- + + procedure Stream_Element_Array_Read + (Strm : access Ada.Streams.Root_Stream_Type'Class; + Item : out Stream_Element_Array) + is + begin + Stream_Element_Array_Ops.Read (Strm, Item, Byte_IO); + end Stream_Element_Array_Read; + + -------------------------------------- + -- Stream_Element_Array_Read_Blk_IO -- + -------------------------------------- + + procedure Stream_Element_Array_Read_Blk_IO + (Strm : access Ada.Streams.Root_Stream_Type'Class; + Item : out Stream_Element_Array) + is + begin + Stream_Element_Array_Ops.Read (Strm, Item, Block_IO); + end Stream_Element_Array_Read_Blk_IO; + + -------------------------------- + -- Stream_Element_Array_Write -- + -------------------------------- + + procedure Stream_Element_Array_Write + (Strm : access Ada.Streams.Root_Stream_Type'Class; + Item : Stream_Element_Array) + is + begin + Stream_Element_Array_Ops.Write (Strm, Item, Byte_IO); + end Stream_Element_Array_Write; + + --------------------------------------- + -- Stream_Element_Array_Write_Blk_IO -- + --------------------------------------- + + procedure Stream_Element_Array_Write_Blk_IO + (Strm : access Ada.Streams.Root_Stream_Type'Class; + Item : Stream_Element_Array) + is + begin + Stream_Element_Array_Ops.Write (Strm, Item, Block_IO); + end Stream_Element_Array_Write_Blk_IO; ------------------ -- String_Input -- diff --git a/gcc/ada/s-ststop.ads b/gcc/ada/s-ststop.ads index 0c7813ffb9a..a3fb3c6e6b2 100644 --- a/gcc/ada/s-ststop.ads +++ b/gcc/ada/s-ststop.ads @@ -33,9 +33,14 @@ -- the following types using a "block IO" approach in which the entire data -- item is written in one operation, instead of writing individual characters. +-- Ada.Stream_Element_Array -- Ada.String -- Ada.Wide_String -- Ada.Wide_Wide_String +-- System.Storage_Array + +-- Note: this routine is in Ada.Strings because historically it handled only +-- the string types. It is not worth moving it at this stage. -- The compiler will generate references to the subprograms in this package -- when expanding stream attributes for the above mentioned types. Example: @@ -48,21 +53,96 @@ -- or -- String_Output_Blk_IO (Some_Stream, Some_String); --- This expansion occurs only if System.Stream_Attributes.Block_IO_OK returns --- True, indicating that this approach is compatible with the expectations of --- System.Stream_Attributes. For the default implementation of this package, --- there is no difference between writing the elements one by one using the --- default output routine for the element type and writing the whole array --- using block IO. +-- String_Output form is used if pragma Restrictions (No_String_Optimziations) +-- is active, which requires element by element operations. The BLK_IO form +-- is used if this restriction is not set, allowing block optimization. --- In addition, +-- Note that if System.Stream_Attributes.Block_IO_OK is False, then the BLK_IO +-- form is treated as equivalent to the normal case, so that the optimization +-- is inhibited anyway, regardless of the setting of the restriction. This +-- handles versions of System.Stream_Attributes (in particular the XDR version +-- found in s-stratt-xdr) which do not permit block io optimization. pragma Compiler_Unit; with Ada.Streams; +with System.Storage_Elements; + package System.Strings.Stream_Ops is + ------------------------------------- + -- Storage_Array stream operations -- + ------------------------------------- + + function Storage_Array_Input + (Strm : access Ada.Streams.Root_Stream_Type'Class) + return System.Storage_Elements.Storage_Array; + + function Storage_Array_Input_Blk_IO + (Strm : access Ada.Streams.Root_Stream_Type'Class) + return System.Storage_Elements.Storage_Array; + + procedure Storage_Array_Output + (Strm : access Ada.Streams.Root_Stream_Type'Class; + Item : System.Storage_Elements.Storage_Array); + + procedure Storage_Array_Output_Blk_IO + (Strm : access Ada.Streams.Root_Stream_Type'Class; + Item : System.Storage_Elements.Storage_Array); + + procedure Storage_Array_Read + (Strm : access Ada.Streams.Root_Stream_Type'Class; + Item : out System.Storage_Elements.Storage_Array); + + procedure Storage_Array_Read_Blk_IO + (Strm : access Ada.Streams.Root_Stream_Type'Class; + Item : out System.Storage_Elements.Storage_Array); + + procedure Storage_Array_Write + (Strm : access Ada.Streams.Root_Stream_Type'Class; + Item : System.Storage_Elements.Storage_Array); + + procedure Storage_Array_Write_Blk_IO + (Strm : access Ada.Streams.Root_Stream_Type'Class; + Item : System.Storage_Elements.Storage_Array); + + -------------------------------------------- + -- Stream_Element_Array stream operations -- + -------------------------------------------- + + function Stream_Element_Array_Input + (Strm : access Ada.Streams.Root_Stream_Type'Class) + return Ada.Streams.Stream_Element_Array; + + function Stream_Element_Array_Input_Blk_IO + (Strm : access Ada.Streams.Root_Stream_Type'Class) + return Ada.Streams.Stream_Element_Array; + + procedure Stream_Element_Array_Output + (Strm : access Ada.Streams.Root_Stream_Type'Class; + Item : Ada.Streams.Stream_Element_Array); + + procedure Stream_Element_Array_Output_Blk_IO + (Strm : access Ada.Streams.Root_Stream_Type'Class; + Item : Ada.Streams.Stream_Element_Array); + + procedure Stream_Element_Array_Read + (Strm : access Ada.Streams.Root_Stream_Type'Class; + Item : out Ada.Streams.Stream_Element_Array); + + procedure Stream_Element_Array_Read_Blk_IO + (Strm : access Ada.Streams.Root_Stream_Type'Class; + Item : out Ada.Streams.Stream_Element_Array); + + procedure Stream_Element_Array_Write + (Strm : access Ada.Streams.Root_Stream_Type'Class; + Item : Ada.Streams.Stream_Element_Array); + + procedure Stream_Element_Array_Write_Blk_IO + (Strm : access Ada.Streams.Root_Stream_Type'Class; + Item : Ada.Streams.Stream_Element_Array); + ------------------------------ -- String stream operations -- ------------------------------ -- 2.30.2