+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.
-- 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 --
-----------
-- --
-- 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 --
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);
-- 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);
-- 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 ???
-- 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
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)
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)
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;
-- 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)
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)
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;
-- 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)
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)
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;
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);
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
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
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
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
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
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,
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,
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,
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,
-- --
-- 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- --
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
-- 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;
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 --
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
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;
procedure Output
(Strm : access Root_Stream_Type'Class;
- Item : String_Type;
+ Item : Array_Type;
IO : IO_Kind)
is
begin
-- 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
procedure Read
(Strm : access Root_Stream_Type'Class;
- Item : out String_Type;
+ Item : out Array_Type;
IO : IO_Kind)
is
begin
-- 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
-- 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
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;
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;
-- 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;
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;
procedure Write
(Strm : access Root_Stream_Type'Class;
- Item : String_Type;
+ Item : Array_Type;
IO : IO_Kind)
is
begin
-- 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
-- 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
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
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)));
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 --
-- 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:
-- 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 --
------------------------------
projects / thirdparty / gcc.git / commitdiff
