Skip to content

R
riscv-gcc-1
Commit 161c5cc5 by Arnaud Charlet
Options

[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
parent 2590ef12
Showing with 620 additions and 101 deletions
gcc/ada/ChangeLog
2013-10-14 Robert Dewar <dewar@adacore.com> 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. * sem_res.adb: Minor fix to error message text.
* errout.ads, erroutc.ads: Minor reformatting. * errout.ads, erroutc.ads: Minor reformatting.
* s-ststop.ads, s-stratt.ads: Clean up documentation of block IO * s-ststop.ads, s-stratt.ads: Clean up documentation of block IO
......
gcc/ada/a-except-2005.adb
...@@ -861,6 +861,16 @@ package body Ada.Exceptions is ...@@ -861,6 +861,16 @@ package body Ada.Exceptions is
-- in case we do not want any exception tracing support. This is -- in case we do not want any exception tracing support. This is
-- why this package is separated. -- 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 -- -- Image --
----------- -----------
......
gcc/ada/a-except-2005.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow -- -- GNAT. The copyright notice above, and the license provisions that follow --
...@@ -51,12 +51,8 @@ with System.Standard_Library; ...@@ -51,12 +51,8 @@ with System.Standard_Library;
with System.Traceback_Entries; with System.Traceback_Entries;
package Ada.Exceptions is package Ada.Exceptions is
pragma Warnings (Off);
pragma Preelaborate_05; 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; type Exception_Id is private;
pragma Preelaborable_Initialization (Exception_Id); pragma Preelaborable_Initialization (Exception_Id);
...@@ -337,6 +333,15 @@ private ...@@ -337,6 +333,15 @@ private
-- this, and it would not work right, because of the Msg and Tracebacks -- this, and it would not work right, because of the Msg and Tracebacks
-- fields which have unused entries not copied by Save_Occurrence. -- 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 EO_To_String (X : Exception_Occurrence) return String;
function String_To_EO (S : String) return Exception_Occurrence; function String_To_EO (S : String) return Exception_Occurrence;
pragma Stream_Convert (Exception_Occurrence, String_To_EO, EO_To_String); 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 ...@@ -6885,7 +6885,7 @@ package body Exp_Attr is
-- Function to check whether the specified run-time call is available -- 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 -- in the run time used. In the case of a configurable run time, it
-- is normal that some subprograms are not there. -- is normal that some subprograms are not there.
--
-- I don't understand this routine at all, why is this not just a -- 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 -- call to RTE_Available? And if for some reason we need a different
-- routine with different semantics, why is not in Rtsfind ??? -- routine with different semantics, why is not in Rtsfind ???
...@@ -6899,8 +6899,7 @@ package body Exp_Attr is ...@@ -6899,8 +6899,7 @@ package body Exp_Attr is
-- Assume that the unit will always be available when using a -- Assume that the unit will always be available when using a
-- "normal" (not configurable) run time. -- "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; end Is_Available;
-- Start of processing for Find_Stream_Subprogram -- Start of processing for Find_Stream_Subprogram
...@@ -6935,9 +6934,148 @@ package body Exp_Attr is ...@@ -6935,9 +6934,148 @@ package body Exp_Attr is
and then and then
not Is_Predefined_File_Name (Unit_File_Name (Current_Sem_Unit)) not Is_Predefined_File_Name (Unit_File_Name (Current_Sem_Unit))
then 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 -- 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 Restriction_Active (No_Stream_Optimizations) then
if Nam = TSS_Stream_Input if Nam = TSS_Stream_Input
and then Is_Available (RE_String_Input) and then Is_Available (RE_String_Input)
...@@ -6967,6 +7105,9 @@ package body Exp_Attr is ...@@ -6967,6 +7105,9 @@ package body Exp_Attr is
raise Program_Error; raise Program_Error;
end if; 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 else
if Nam = TSS_Stream_Input if Nam = TSS_Stream_Input
and then Is_Available (RE_String_Input_Blk_IO) and then Is_Available (RE_String_Input_Blk_IO)
...@@ -6988,9 +7129,9 @@ package body Exp_Attr is ...@@ -6988,9 +7129,9 @@ package body Exp_Attr is
then then
return RTE (RE_String_Write_Blk_IO); 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_Output and then
Nam /= TSS_Stream_Read and then Nam /= TSS_Stream_Read and then
Nam /= TSS_Stream_Write Nam /= TSS_Stream_Write
then then
raise Program_Error; raise Program_Error;
...@@ -7000,6 +7141,9 @@ package body Exp_Attr is ...@@ -7000,6 +7141,9 @@ package body Exp_Attr is
-- Wide_String as defined in package Ada -- Wide_String as defined in package Ada
elsif Base_Typ = Standard_Wide_String then elsif Base_Typ = Standard_Wide_String then
-- Case of No_Stream_Optimizations restriction active
if Restriction_Active (No_Stream_Optimizations) then if Restriction_Active (No_Stream_Optimizations) then
if Nam = TSS_Stream_Input if Nam = TSS_Stream_Input
and then Is_Available (RE_Wide_String_Input) and then Is_Available (RE_Wide_String_Input)
...@@ -7021,14 +7165,17 @@ package body Exp_Attr is ...@@ -7021,14 +7165,17 @@ package body Exp_Attr is
then then
return RTE (RE_Wide_String_Write); 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_Output and then
Nam /= TSS_Stream_Read and then Nam /= TSS_Stream_Read and then
Nam /= TSS_Stream_Write Nam /= TSS_Stream_Write
then then
raise Program_Error; raise Program_Error;
end if; 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 else
if Nam = TSS_Stream_Input if Nam = TSS_Stream_Input
and then Is_Available (RE_Wide_String_Input_Blk_IO) and then Is_Available (RE_Wide_String_Input_Blk_IO)
...@@ -7050,9 +7197,9 @@ package body Exp_Attr is ...@@ -7050,9 +7197,9 @@ package body Exp_Attr is
then then
return RTE (RE_Wide_String_Write_Blk_IO); 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_Output and then
Nam /= TSS_Stream_Read and then Nam /= TSS_Stream_Read and then
Nam /= TSS_Stream_Write Nam /= TSS_Stream_Write
then then
raise Program_Error; raise Program_Error;
...@@ -7062,6 +7209,9 @@ package body Exp_Attr is ...@@ -7062,6 +7209,9 @@ package body Exp_Attr is
-- Wide_Wide_String as defined in package Ada -- Wide_Wide_String as defined in package Ada
elsif Base_Typ = Standard_Wide_Wide_String then elsif Base_Typ = Standard_Wide_Wide_String then
-- Case of No_Stream_Optimizations restriction active
if Restriction_Active (No_Stream_Optimizations) then if Restriction_Active (No_Stream_Optimizations) then
if Nam = TSS_Stream_Input if Nam = TSS_Stream_Input
and then Is_Available (RE_Wide_Wide_String_Input) and then Is_Available (RE_Wide_Wide_String_Input)
...@@ -7083,14 +7233,17 @@ package body Exp_Attr is ...@@ -7083,14 +7233,17 @@ package body Exp_Attr is
then then
return RTE (RE_Wide_Wide_String_Write); 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_Output and then
Nam /= TSS_Stream_Read and then Nam /= TSS_Stream_Read and then
Nam /= TSS_Stream_Write Nam /= TSS_Stream_Write
then then
raise Program_Error; raise Program_Error;
end if; 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 else
if Nam = TSS_Stream_Input if Nam = TSS_Stream_Input
and then Is_Available (RE_Wide_Wide_String_Input_Blk_IO) and then Is_Available (RE_Wide_Wide_String_Input_Blk_IO)
...@@ -7112,9 +7265,9 @@ package body Exp_Attr is ...@@ -7112,9 +7265,9 @@ package body Exp_Attr is
then then
return RTE (RE_Wide_Wide_String_Write_Blk_IO); 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_Output and then
Nam /= TSS_Stream_Read and then Nam /= TSS_Stream_Read and then
Nam /= TSS_Stream_Write Nam /= TSS_Stream_Write
then then
raise Program_Error; raise Program_Error;
...@@ -7123,9 +7276,7 @@ package body Exp_Attr is ...@@ -7123,9 +7276,7 @@ package body Exp_Attr is
end if; end if;
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); return Find_Prim_Op (Typ, Nam);
else else
return Find_Inherited_TSS (Typ, Nam); 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, ...@@ -1463,3 +1463,10 @@ __gnat_personality_seh0 (PEXCEPTION_RECORD ms_exc, void *this_frame,
ms_disp, __gnat_personality_imp); ms_disp, __gnat_personality_imp);
} }
#endif /* SEH */ #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 ...@@ -591,6 +591,7 @@ package Rtsfind is
RE_Root_Stream_Type, -- Ada.Streams RE_Root_Stream_Type, -- Ada.Streams
RE_Stream_Element, -- Ada.Streams RE_Stream_Element, -- Ada.Streams
RE_Stream_Element_Array, -- Ada.Streams
RE_Stream_Element_Offset, -- Ada.Streams RE_Stream_Element_Offset, -- Ada.Streams
RE_Stream_Access, -- Ada.Streams.Stream_IO RE_Stream_Access, -- Ada.Streams.Stream_IO
...@@ -1477,6 +1478,24 @@ package Rtsfind is ...@@ -1477,6 +1478,24 @@ package Rtsfind is
RE_W_WC, -- System.Stream_Attributes RE_W_WC, -- System.Stream_Attributes
RE_W_WWC, -- 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, -- System.Strings.Stream_Ops
RE_String_Input_Blk_IO, -- System.Strings.Stream_Ops RE_String_Input_Blk_IO, -- System.Strings.Stream_Ops
RE_String_Output, -- System.Strings.Stream_Ops RE_String_Output, -- System.Strings.Stream_Ops
...@@ -1485,6 +1504,7 @@ package Rtsfind is ...@@ -1485,6 +1504,7 @@ package Rtsfind is
RE_String_Read_Blk_IO, -- System.Strings.Stream_Ops RE_String_Read_Blk_IO, -- System.Strings.Stream_Ops
RE_String_Write, -- System.Strings.Stream_Ops RE_String_Write, -- System.Strings.Stream_Ops
RE_String_Write_Blk_IO, -- 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, -- System.Strings.Stream_Ops
RE_Wide_String_Input_Blk_IO, -- 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_Output, -- System.Strings.Stream_Ops
...@@ -1493,6 +1513,7 @@ package Rtsfind is ...@@ -1493,6 +1513,7 @@ package Rtsfind is
RE_Wide_String_Read_Blk_IO, -- 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, -- System.Strings.Stream_Ops
RE_Wide_String_Write_Blk_IO, -- 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, -- System.Strings.Stream_Ops
RE_Wide_Wide_String_Input_Blk_IO, -- 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_Wide_Wide_String_Output, -- System.Strings.Stream_Ops
...@@ -1844,6 +1865,7 @@ package Rtsfind is ...@@ -1844,6 +1865,7 @@ package Rtsfind is
RE_Root_Stream_Type => Ada_Streams, RE_Root_Stream_Type => Ada_Streams,
RE_Stream_Element => Ada_Streams, RE_Stream_Element => Ada_Streams,
RE_Stream_Element_Array => Ada_Streams,
RE_Stream_Element_Offset => Ada_Streams, RE_Stream_Element_Offset => Ada_Streams,
RE_Stream_Access => Ada_Streams_Stream_IO, RE_Stream_Access => Ada_Streams_Stream_IO,
...@@ -2734,6 +2756,24 @@ package Rtsfind is ...@@ -2734,6 +2756,24 @@ package Rtsfind is
RE_W_WC => System_Stream_Attributes, RE_W_WC => System_Stream_Attributes,
RE_W_WWC => 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 => System_Strings_Stream_Ops,
RE_String_Input_Blk_IO => System_Strings_Stream_Ops, RE_String_Input_Blk_IO => System_Strings_Stream_Ops,
RE_String_Output => System_Strings_Stream_Ops, RE_String_Output => System_Strings_Stream_Ops,
...@@ -2742,6 +2782,7 @@ package Rtsfind is ...@@ -2742,6 +2782,7 @@ package Rtsfind is
RE_String_Read_Blk_IO => System_Strings_Stream_Ops, RE_String_Read_Blk_IO => System_Strings_Stream_Ops,
RE_String_Write => System_Strings_Stream_Ops, RE_String_Write => System_Strings_Stream_Ops,
RE_String_Write_Blk_IO => 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 => System_Strings_Stream_Ops,
RE_Wide_String_Input_Blk_IO => 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_Output => System_Strings_Stream_Ops,
...@@ -2749,6 +2790,7 @@ package Rtsfind is ...@@ -2749,6 +2790,7 @@ package Rtsfind is
RE_Wide_String_Read => 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_Read_Blk_IO => System_Strings_Stream_Ops,
RE_Wide_String_Write => System_Strings_Stream_Ops, RE_Wide_String_Write => System_Strings_Stream_Ops,
RE_Wide_String_Write_Blk_IO => 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 => System_Strings_Stream_Ops,
RE_Wide_Wide_String_Input_Blk_IO => System_Strings_Stream_Ops, RE_Wide_Wide_String_Input_Blk_IO => System_Strings_Stream_Ops,
......
gcc/ada/s-ststop.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -35,7 +35,9 @@ with Ada.Streams; use Ada.Streams; ...@@ -35,7 +35,9 @@ with Ada.Streams; use Ada.Streams;
with Ada.Streams.Stream_IO; use Ada.Streams.Stream_IO; with Ada.Streams.Stream_IO; use Ada.Streams.Stream_IO;
with Ada.Unchecked_Conversion; 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 package body System.Strings.Stream_Ops is
...@@ -46,31 +48,32 @@ 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 -- The following package provides an IO framework for strings. Depending
-- on the version of System.Stream_Attributes as well as the size of -- 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 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 package Stream_Ops_Internal is
function Input function Input
(Strm : access Root_Stream_Type'Class; (Strm : access Root_Stream_Type'Class;
IO : IO_Kind) return String_Type; IO : IO_Kind) return Array_Type;
procedure Output procedure Output
(Strm : access Root_Stream_Type'Class; (Strm : access Root_Stream_Type'Class;
Item : String_Type; Item : Array_Type;
IO : IO_Kind); IO : IO_Kind);
procedure Read procedure Read
(Strm : access Root_Stream_Type'Class; (Strm : access Root_Stream_Type'Class;
Item : out String_Type; Item : out Array_Type;
IO : IO_Kind); IO : IO_Kind);
procedure Write procedure Write
(Strm : access Root_Stream_Type'Class; (Strm : access Root_Stream_Type'Class;
Item : String_Type; Item : Array_Type;
IO : IO_Kind); IO : IO_Kind);
end Stream_Ops_Internal; end Stream_Ops_Internal;
...@@ -86,31 +89,36 @@ package body System.Strings.Stream_Ops is ...@@ -86,31 +89,36 @@ package body System.Strings.Stream_Ops is
Default_Block_Size : constant := 512 * 8; 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; 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; SE_In_Default_Block : constant Integer := Default_Block_Size / SE_Size;
-- Number of storage elements in a default block
-- Buffer types -- Buffer types
subtype Default_Block is Stream_Element_Array subtype Default_Block is Stream_Element_Array
(1 .. Stream_Element_Offset (SE_In_Default_Block)); (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 -- Conversions to and from Default_Block
function To_Default_Block is 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 -- -- Input --
...@@ -118,7 +126,7 @@ package body System.Strings.Stream_Ops is ...@@ -118,7 +126,7 @@ package body System.Strings.Stream_Ops is
function Input function Input
(Strm : access Root_Stream_Type'Class; (Strm : access Root_Stream_Type'Class;
IO : IO_Kind) return String_Type IO : IO_Kind) return Array_Type
is is
begin begin
if Strm = null then if Strm = null then
...@@ -126,23 +134,21 @@ package body System.Strings.Stream_Ops is ...@@ -126,23 +134,21 @@ package body System.Strings.Stream_Ops is
end if; end if;
declare declare
Low : Positive; Low : Index_Type;
High : Positive; High : Index_Type;
begin begin
-- Read the bounds of the string -- 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 -- Read the character content of the string
Item : String_Type (Low .. High);
declare
Item : Array_Type (Low .. High);
begin begin
-- Read the character content of the string
Read (Strm, Item, IO); Read (Strm, Item, IO);
return Item; return Item;
end; end;
end; end;
...@@ -154,7 +160,7 @@ package body System.Strings.Stream_Ops is ...@@ -154,7 +160,7 @@ package body System.Strings.Stream_Ops is
procedure Output procedure Output
(Strm : access Root_Stream_Type'Class; (Strm : access Root_Stream_Type'Class;
Item : String_Type; Item : Array_Type;
IO : IO_Kind) IO : IO_Kind)
is is
begin begin
...@@ -164,8 +170,8 @@ package body System.Strings.Stream_Ops is ...@@ -164,8 +170,8 @@ package body System.Strings.Stream_Ops is
-- Write the bounds of the string -- 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 -- Write the character content of the string
...@@ -178,7 +184,7 @@ package body System.Strings.Stream_Ops is ...@@ -178,7 +184,7 @@ package body System.Strings.Stream_Ops is
procedure Read procedure Read
(Strm : access Root_Stream_Type'Class; (Strm : access Root_Stream_Type'Class;
Item : out String_Type; Item : out Array_Type;
IO : IO_Kind) IO : IO_Kind)
is is
begin begin
...@@ -194,15 +200,13 @@ package body System.Strings.Stream_Ops is ...@@ -194,15 +200,13 @@ package body System.Strings.Stream_Ops is
-- Block IO -- 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 declare
-- Determine the size in BITS of the block necessary to contain -- Determine the size in BITS of the block necessary to contain
-- the whole string. -- the whole string.
Block_Size : constant Natural := 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, -- Item can be larger than what the default block can store,
-- determine the number of whole reads necessary to read the -- determine the number of whole reads necessary to read the
...@@ -218,8 +222,8 @@ package body System.Strings.Stream_Ops is ...@@ -218,8 +222,8 @@ package body System.Strings.Stream_Ops is
-- String indexes -- 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 -- End of stream error detection
...@@ -237,10 +241,10 @@ package body System.Strings.Stream_Ops is ...@@ -237,10 +241,10 @@ package body System.Strings.Stream_Ops is
begin begin
for Counter in 1 .. Blocks loop for Counter in 1 .. Blocks loop
Read (Strm.all, Block, Last); Read (Strm.all, Block, Last);
Item (Low .. High) := To_String_Block (Block); Item (Low .. High) := To_Array_Block (Block);
Low := High + 1; Low := High + 1;
High := Low + C_In_Default_Block - 1; High := Low + AE_In_Default_Block - 1;
Sum := Sum + Last; Sum := Sum + Last;
Last := 0; Last := 0;
end loop; end loop;
...@@ -254,17 +258,18 @@ package body System.Strings.Stream_Ops is ...@@ -254,17 +258,18 @@ package body System.Strings.Stream_Ops is
subtype Rem_Block is Stream_Element_Array subtype Rem_Block is Stream_Element_Array
(1 .. Stream_Element_Offset (Rem_Size / SE_Size)); (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; Block : Rem_Block;
begin begin
Read (Strm.all, Block, Last); 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; Sum := Sum + Last;
end; end;
...@@ -275,7 +280,7 @@ package body System.Strings.Stream_Ops is ...@@ -275,7 +280,7 @@ package body System.Strings.Stream_Ops is
-- words, the stream does not contain enough elements to fully -- words, the stream does not contain enough elements to fully
-- populate Item. -- 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; raise End_Error;
end if; end if;
end; end;
...@@ -284,12 +289,11 @@ package body System.Strings.Stream_Ops is ...@@ -284,12 +289,11 @@ package body System.Strings.Stream_Ops is
else else
declare declare
C : Character_Type; E : Element_Type;
begin begin
for Index in Item'First .. Item'Last loop 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 loop;
end; end;
end if; end if;
...@@ -301,7 +305,7 @@ package body System.Strings.Stream_Ops is ...@@ -301,7 +305,7 @@ package body System.Strings.Stream_Ops is
procedure Write procedure Write
(Strm : access Root_Stream_Type'Class; (Strm : access Root_Stream_Type'Class;
Item : String_Type; Item : Array_Type;
IO : IO_Kind) IO : IO_Kind)
is is
begin begin
...@@ -317,14 +321,12 @@ package body System.Strings.Stream_Ops is ...@@ -317,14 +321,12 @@ package body System.Strings.Stream_Ops is
-- Block IO -- 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 declare
-- Determine the size in BITS of the block necessary to contain -- Determine the size in BITS of the block necessary to contain
-- the whole string. -- 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, -- Item can be larger than what the default block can store,
-- determine the number of whole writes necessary to output the -- determine the number of whole writes necessary to output the
...@@ -340,8 +342,8 @@ package body System.Strings.Stream_Ops is ...@@ -340,8 +342,8 @@ package body System.Strings.Stream_Ops is
-- String indexes -- 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 begin
-- Step 1: If the string is too large, write out individual -- Step 1: If the string is too large, write out individual
...@@ -349,9 +351,8 @@ package body System.Strings.Stream_Ops is ...@@ -349,9 +351,8 @@ package body System.Strings.Stream_Ops is
for Counter in 1 .. Blocks loop for Counter in 1 .. Blocks loop
Write (Strm.all, To_Default_Block (Item (Low .. High))); Write (Strm.all, To_Default_Block (Item (Low .. High)));
Low := High + 1; Low := High + 1;
High := Low + C_In_Default_Block - 1; High := Low + AE_In_Default_Block - 1;
end loop; end loop;
-- Step 2: Write out any remaining elements -- Step 2: Write out any remaining elements
...@@ -361,11 +362,12 @@ package body System.Strings.Stream_Ops is ...@@ -361,11 +362,12 @@ package body System.Strings.Stream_Ops is
subtype Rem_Block is Stream_Element_Array subtype Rem_Block is Stream_Element_Array
(1 .. Stream_Element_Offset (Rem_Size / SE_Size)); (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 function To_Rem_Block is new
Ada.Unchecked_Conversion (Rem_String_Block, Rem_Block); Ada.Unchecked_Conversion (Rem_Array_Block, Rem_Block);
begin begin
Write (Strm.all, To_Rem_Block (Item (Low .. Item'Last))); Write (Strm.all, To_Rem_Block (Item (Low .. Item'Last)));
...@@ -377,28 +379,233 @@ package body System.Strings.Stream_Ops is ...@@ -377,28 +379,233 @@ package body System.Strings.Stream_Ops is
else else
for Index in Item'First .. Item'Last loop for Index in Item'First .. Item'Last loop
Character_Type'Write (Strm, Item (Index)); Element_Type'Write (Strm, Item (Index));
end loop; end loop;
end if; end if;
end Write; end Write;
end Stream_Ops_Internal; 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 package String_Ops is
new Stream_Ops_Internal new Stream_Ops_Internal
(Character_Type => Character, (Element_Type => Character,
String_Type => String); Index_Type => Positive,
Array_Type => String);
package Wide_String_Ops is package Wide_String_Ops is
new Stream_Ops_Internal 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 package Wide_Wide_String_Ops is
new Stream_Ops_Internal 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 -- -- String_Input --
......
gcc/ada/s-ststop.ads
...@@ -33,9 +33,14 @@ ...@@ -33,9 +33,14 @@
-- the following types using a "block IO" approach in which the entire data -- the following types using a "block IO" approach in which the entire data
-- item is written in one operation, instead of writing individual characters. -- item is written in one operation, instead of writing individual characters.
-- Ada.Stream_Element_Array
-- Ada.String -- Ada.String
-- Ada.Wide_String -- Ada.Wide_String
-- Ada.Wide_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 -- The compiler will generate references to the subprograms in this package
-- when expanding stream attributes for the above mentioned types. Example: -- when expanding stream attributes for the above mentioned types. Example:
...@@ -48,21 +53,96 @@ ...@@ -48,21 +53,96 @@
-- or -- or
-- String_Output_Blk_IO (Some_Stream, Some_String); -- 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; pragma Compiler_Unit;
with Ada.Streams; with Ada.Streams;
with System.Storage_Elements;
package System.Strings.Stream_Ops is 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 -- -- String stream operations --
------------------------------ ------------------------------
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment