[multiple changes]

2013-10-14  Robert Dewar  <dewar@adacore.com>

	* 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  <gingold@adacore.com>

	* 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

@@ -1,3 +1,20 @@
+2013-10-14  Robert Dewar  <dewar@adacore.com>
+
+	* 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  <gingold@adacore.com>
+
+	* 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  <dewar@adacore.com>
 
 	* sem_res.adb: Minor fix to error message text.

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 --
    -----------

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.
-   --  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.
 
    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);

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
+         return not Configurable_Run_Time_Mode or else RTE_Available (Entity);
-           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)
@@ -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)
@@ -7029,6 +7173,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_Wide_String_Input_Blk_IO)
@@ -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)
@@ -7091,6 +7241,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_Wide_Wide_String_Input_Blk_IO)
@@ -7123,9 +7276,7 @@ package body Exp_Attr is
          end if;
       end if;
 
-      if Is_Tagged_Type (Typ)
+      if Is_Tagged_Type (Typ) and then Is_Derived_Type (Typ) then
-        and then Is_Derived_Type (Typ)
-      then
          return Find_Prim_Op (Typ, Nam);
       else
          return Find_Inherited_TSS (Typ, Nam);

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

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,

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
+   --  formal parameter Element_Type, the package will either utilize block
-   --  IO or character-by-character IO.
+   --  IO or element-by-element IO.
 
    generic
-      type Character_Type is private;
+      type Element_Type is private;
-      type String_Type is array (Positive range <>) of Character_Type;
+      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
+      --  The following constants describe the number of array elements or
-      --  characters that can fit into a default block.
+      --  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
+      function To_Array_Block is
-        new Ada.Unchecked_Conversion (Default_Block, String_Block);
+        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;
+            Low  : Index_Type;
-            High : Positive;
+            High : Index_Type;
 
          begin
             --  Read the bounds of the string
 
-            Positive'Read (Strm, Low);
+            Index_Type'Read (Strm, Low);
-            Positive'Read (Strm, High);
+            Index_Type'Read (Strm, High);
 
-            declare
-               Item : String_Type (Low .. High);
-
-            begin
             --  Read the character content of the string
 
+            declare
+               Item : Array_Type (Low .. High);
+            begin
                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);
+         Index_Type'Write (Strm, Item'First);
-         Positive'Write (Strm, Item'Last);
+         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
+         if IO = Block_IO and then Stream_Attributes.Block_IO_OK then
-           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;
+               Low  : Index_Type := Item'First;
-               High : Positive := Low + C_In_Default_Block - 1;
+               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
+                     subtype Rem_Array_Block is
-                       String_Type (1 .. Rem_Size / C_Size);
+                       Array_Type (Index_Type range
+                                    1 .. Index_Type (Rem_Size / ET_Size));
 
-                     function To_Rem_String_Block is new
+                     function To_Rem_Array_Block is new
-                       Ada.Unchecked_Conversion (Rem_Block, Rem_String_Block);
+                       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);
+                  Element_Type'Read (Strm, E);
-                  Item (Index) := C;
+                  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
+         if IO = Block_IO and then Stream_Attributes.Block_IO_OK then
-           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;
+               Low  : Index_Type := Item'First;
-               High : Positive := Low + C_In_Default_Block - 1;
+               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
+                     subtype Rem_Array_Block is
-                       String_Type (1 .. Rem_Size / C_Size);
+                       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,
+       (Element_Type => Character,
-        String_Type    => String);
+        Index_Type   => Positive,
+        Array_Type   => String);
 
    package Wide_String_Ops is
      new Stream_Ops_Internal
-       (Character_Type => Wide_Character,
+       (Element_Type => Wide_Character,
-        String_Type    => Wide_String);
+        Index_Type   => Positive,
+        Array_Type   => Wide_String);
 
    package Wide_Wide_String_Ops is
      new Stream_Ops_Internal
-       (Character_Type => Wide_Wide_Character,
+       (Element_Type => Wide_Wide_Character,
-        String_Type    => Wide_Wide_String);
+        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 --

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
+--  String_Output form is used if pragma Restrictions (No_String_Optimziations)
---  True, indicating that this approach is compatible with the expectations of
+--  is active, which requires element by element operations. The BLK_IO form
---  System.Stream_Attributes. For the default implementation of this package,
+--  is used if this restriction is not set, allowing block optimization.
---  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.
 
---  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 --
    ------------------------------