mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-03-25 19:11:21 +08:00
Code Issues Packages Projects Releases Wiki Activity

rtsfind.ads: Add block IO versions of stream routines for Strings.

Browse Source 
2008-08-01  Hristian Kirtchev  <kirtchev@adacore.com>

	* rtsfind.ads: Add block IO versions of stream routines for Strings.

	* bindgen.adb, gnat_rm.texi, gnat_ugn.texi, opt.ads,
	sem_prag.adb, snames.adb, snames.ads, snames.h,
	par-prag.adb: Undo Canonical_Streams related changes.

	* s-rident.ads: Add new restriction No_Stream_Optimizations.

	* s-ststop.ads, s-ststop.adb: Comment reformatting.
	Define enumeration type to designate different IO mechanisms.
	Enchance generic package Stream_Ops_Internal to include an
	implementation of Input and Output.

	* exp_attr.adb (Find_Stream_Subprogram): If restriction
	No_Stream_Optimization is active, choose the default byte IO
	implementations of stream attributes for Strings.
	Otherwise use the corresponding block IO version.

From-SVN: r138511
This commit is contained in:
Arnaud Charlet 2008-08-01 12:47:27 +02:00
parent 20b40e7b44
commit 585df50b0c
15 changed files with 1246 additions and 1079 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
gcc/ada/ChangeLog
View File

@ -1,7 +1,32 @@
2008-08-01 Hristian Kirtchev <kirtchev@adacore.com>
* rtsfind.ads: Add block IO versions of stream routines for Strings.
* bindgen.adb, gnat_rm.texi, gnat_ugn.texi, opt.ads,
sem_prag.adb, snames.adb, snames.ads, snames.h,
par-prag.adb: Undo previous stream related changes.
* s-rident.ads: Add new restriction No_Stream_Optimizations.
* s-ststop.ads, s-ststop.adb: Comment reformatting.
Define enumeration type to designate different IO mechanisms.
Enchance generic package Stream_Ops_Internal to include an
implementation of Input and Output.
* exp_attr.adb (Find_Stream_Subprogram): If restriction
No_Stream_Optimization is active, choose the default byte IO
implementations of stream attributes for Strings.
Otherwise use the corresponding block IO version.
2008-08-01 Olivier Hainque <hainque@adacore.com>
* decl.c (gnat_to_gnu_entity) <case E_Function>: Do not turn Ada
Pure into GCC const, now implicitely implying nothrow as well.
* gcc-interface/decl.c (gnat_to_gnu_entity) <case E_Function>: Do not
turn Ada Pure into GCC const, now implicitely implying nothrow as well.
2008-08-01 Robert Dewar <dewar@adacore.com>
* par-ch3.adb (P_Defining_Identifier): Avoid repeated attempt to
convert plain identifier into defining identifier.
2008-08-01 Robert Dewar <dewar@adacore.com>

31
gcc/ada/bindgen.adb
View File

@ -126,7 +126,6 @@ package body Bindgen is
-- Detect_Blocking : Integer;
-- Default_Stack_Size : Integer;
-- Leap_Seconds_Support : Integer;
-- Canonical_Streams : Integer;
-- Main_Priority is the priority value set by pragma Priority in the main
-- program. If no such pragma is present, the value is -1.
@ -212,10 +211,6 @@ package body Bindgen is
-- disabled. A value of zero indicates that leap seconds are turned "off",
-- while a value of one signifies "on" status.
-- Canonical_Streams indicates whether stream-related optimizations are
-- active. A value of zero indicates that all optimizations are active,
-- while a value of one signifies that they have been disabled.
-----------------------
-- Local Subprograms --
-----------------------
@ -596,9 +591,6 @@ package body Bindgen is
WBI (" Leap_Seconds_Support : Integer;");
WBI (" pragma Import (C, Leap_Seconds_Support, " &
"""__gl_leap_seconds_support"");");
WBI (" Canonical_Streams : Integer;");
WBI (" pragma Import (C, Canonical_Streams, " &
"""__gl_canonical_streams"");");
-- Import entry point for elaboration time signal handler
-- installation, and indication of if it's been called previously.
@ -767,17 +759,6 @@ package body Bindgen is
Set_String (";");
Write_Statement_Buffer;
Set_String (" Canonical_Streams := ");
if Canonical_Streams then
Set_Int (1);
else
Set_Int (0);
end if;
Set_String (";");
Write_Statement_Buffer;
-- Generate call to Install_Handler
WBI ("");
@ -1059,18 +1040,6 @@ package body Bindgen is
Set_String (";");
Write_Statement_Buffer;
WBI (" extern int __gl_canonical_streams;");
Set_String (" __gl_canonical_streams = ");
if Canonical_Streams then
Set_Int (1);
else
Set_Int (0);
end if;
Set_String (";");
Write_Statement_Buffer;
WBI ("");
-- Install elaboration time signal handler

97
gcc/ada/exp_attr.adb
View File

@ -5365,53 +5365,100 @@ package body Exp_Attr is
and then
not Is_Predefined_File_Name (Unit_File_Name (Current_Sem_Unit))
then
-- String as defined in package Ada
if Base_Typ = Standard_String then
if Nam = TSS_Stream_Input then
return RTE (RE_String_Input);
if Restriction_Active (No_Stream_Optimizations) then
if Nam = TSS_Stream_Input then
return RTE (RE_String_Input);
elsif Nam = TSS_Stream_Output then
return RTE (RE_String_Output);
elsif Nam = TSS_Stream_Output then
return RTE (RE_String_Output);
elsif Nam = TSS_Stream_Read then
return RTE (RE_String_Read);
elsif Nam = TSS_Stream_Read then
return RTE (RE_String_Read);
else pragma Assert (Nam = TSS_Stream_Write);
return RTE (RE_String_Write);
else pragma Assert (Nam = TSS_Stream_Write);
return RTE (RE_String_Write);
end if;
else
if Nam = TSS_Stream_Input then
return RTE (RE_String_Input_Blk_IO);
elsif Nam = TSS_Stream_Output then
return RTE (RE_String_Output_Blk_IO);
elsif Nam = TSS_Stream_Read then
return RTE (RE_String_Read_Blk_IO);
else pragma Assert (Nam = TSS_Stream_Write);
return RTE (RE_String_Write_Blk_IO);
end if;
end if;
-- Wide_String as defined in package Ada
elsif Base_Typ = Standard_Wide_String then
if Nam = TSS_Stream_Input then
return RTE (RE_Wide_String_Input);
if Restriction_Active (No_Stream_Optimizations) then
if Nam = TSS_Stream_Input then
return RTE (RE_Wide_String_Input);
elsif Nam = TSS_Stream_Output then
return RTE (RE_Wide_String_Output);
elsif Nam = TSS_Stream_Output then
return RTE (RE_Wide_String_Output);
elsif Nam = TSS_Stream_Read then
return RTE (RE_Wide_String_Read);
elsif Nam = TSS_Stream_Read then
return RTE (RE_Wide_String_Read);
else pragma Assert (Nam = TSS_Stream_Write);
return RTE (RE_Wide_String_Write);
else pragma Assert (Nam = TSS_Stream_Write);
return RTE (RE_Wide_String_Write);
end if;
else
if Nam = TSS_Stream_Input then
return RTE (RE_Wide_String_Input_Blk_IO);
elsif Nam = TSS_Stream_Output then
return RTE (RE_Wide_String_Output_Blk_IO);
elsif Nam = TSS_Stream_Read then
return RTE (RE_Wide_String_Read_Blk_IO);
else pragma Assert (Nam = TSS_Stream_Write);
return RTE (RE_Wide_String_Write_Blk_IO);
end if;
end if;
-- Wide_Wide_String as defined in package Ada
elsif Base_Typ = Standard_Wide_Wide_String then
if Nam = TSS_Stream_Input then
return RTE (RE_Wide_Wide_String_Input);
if Restriction_Active (No_Stream_Optimizations) then
if Nam = TSS_Stream_Input then
return RTE (RE_Wide_Wide_String_Input);
elsif Nam = TSS_Stream_Output then
return RTE (RE_Wide_Wide_String_Output);
elsif Nam = TSS_Stream_Output then
return RTE (RE_Wide_Wide_String_Output);
elsif Nam = TSS_Stream_Read then
return RTE (RE_Wide_Wide_String_Read);
elsif Nam = TSS_Stream_Read then
return RTE (RE_Wide_Wide_String_Read);
else pragma Assert (Nam = TSS_Stream_Write);
return RTE (RE_Wide_Wide_String_Write);
else pragma Assert (Nam = TSS_Stream_Write);
return RTE (RE_Wide_Wide_String_Write);
end if;
else
if Nam = TSS_Stream_Input then
return RTE (RE_Wide_Wide_String_Input_Blk_IO);
elsif Nam = TSS_Stream_Output then
return RTE (RE_Wide_Wide_String_Output_Blk_IO);
elsif Nam = TSS_Stream_Read then
return RTE (RE_Wide_Wide_String_Read_Blk_IO);
else pragma Assert (Nam = TSS_Stream_Write);
return RTE (RE_Wide_Wide_String_Write_Blk_IO);
end if;
end if;
end if;
end if;

23
gcc/ada/gnat_rm.texi
View File

@ -104,7 +104,6 @@ Implementation Defined Pragmas
* Pragma Assert::
* Pragma Ast_Entry::
* Pragma C_Pass_By_Copy::
* Pragma Canonical_Streams::
* Pragma Check::
* Pragma Check_Name::
* Pragma Check_Policy::
@ -706,7 +705,6 @@ consideration, the use of these pragmas should be minimized.
* Pragma Assert::
* Pragma Ast_Entry::
* Pragma C_Pass_By_Copy::
* Pragma Canonical_Streams::
* Pragma Check::
* Pragma Check_Name::
* Pragma Check_Policy::
@ -1059,27 +1057,6 @@ You can also pass records by copy by specifying the convention
@code{Import} and @code{Export} pragmas, which allow specification of
passing mechanisms on a parameter by parameter basis.
@node Pragma Canonical_Streams
@unnumberedsec Canonical Streams
@cindex Canonical streams
@findex Canonical_Streams
@noindent
Syntax:
@smallexample @c ada
pragma Canonical_Streams;
@end smallexample
@noindent
This configuration pragma affects the behavior of stream attributes of any
@code{String}, @code{Wide_String} or @code{Wide_Wide_String} based type. When
this pragma is present, @code{'Input}, @code{'Output}, @code{'Read} and
@code{'Write} exibit Ada 95 canonical behavior, in other words, streaming of
values is done character by character.
@noindent
The use of this pragma is intended to bypass any implementation-related
optimizations allowed by Ada 2005 RM 13.13.2 (56/2) Implementation Permission.
@node Pragma Check
@unnumberedsec Pragma Check
@cindex Assertions

1
gcc/ada/gnat_ugn.texi
View File

@ -10925,7 +10925,6 @@ recognized by GNAT:
Ada_2005
Assertion_Policy
C_Pass_By_Copy
Canonical_Streams
Check_Name
Check_Policy
Compile_Time_Error

5
gcc/ada/opt.ads
View File

@ -283,11 +283,6 @@ package Opt is
-- is set True, or if pragma No_Run_Time is used. See the spec of Rtsfind
-- for details on the handling of the latter pragma.
Canonical_Streams : Boolean := False;
-- GNAT, GNATBIND
-- Set to True if configuration pragma Canonical_Streams is present. It
-- controls the canonical behaviour of stream operations for String types.
Constant_Condition_Warnings : Boolean := False;
-- GNAT
-- Set to True to activate warnings on constant conditions

1
gcc/ada/par-prag.adb
View File

@ -1058,7 +1058,6 @@ begin
Pragma_Atomic |
Pragma_Atomic_Components |
Pragma_Attach_Handler |
Pragma_Canonical_Streams |
Pragma_Check |
Pragma_Check_Name |
Pragma_Check_Policy |

24
gcc/ada/rtsfind.ads
View File

@ -1331,17 +1331,29 @@ package Rtsfind is
RE_Str_Concat_5, -- System.String_Ops_Concat_5
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_Output_Blk_IO, -- System.Strings.Stream_Ops
RE_String_Read, -- 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_Output_Blk_IO, -- 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
RE_Wide_Wide_String_Output, -- System.Strings.Stream_Ops
RE_Wide_Wide_String_Output_Blk_IO, -- System.Strings.Stream_Ops
RE_Wide_Wide_String_Read, -- System.Strings.Stream_Ops
RE_Wide_Wide_String_Read_Blk_IO, -- System.Strings.Stream_Ops
RE_Wide_Wide_String_Write, -- System.Strings.Stream_Ops
RE_Wide_Wide_String_Write_Blk_IO, -- System.Strings.Stream_Ops
RE_Task_Info_Type, -- System.Task_Info
RE_Unspecified_Task_Info, -- System.Task_Info
@ -2473,17 +2485,29 @@ package Rtsfind is
RE_Str_Concat_5 => System_String_Ops_Concat_5,
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_Output_Blk_IO => System_Strings_Stream_Ops,
RE_String_Read => 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_Output_Blk_IO => 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,
RE_Wide_Wide_String_Output => System_Strings_Stream_Ops,
RE_Wide_Wide_String_Output_Blk_IO => System_Strings_Stream_Ops,
RE_Wide_Wide_String_Read => System_Strings_Stream_Ops,
RE_Wide_Wide_String_Read_Blk_IO => System_Strings_Stream_Ops,
RE_Wide_Wide_String_Write => System_Strings_Stream_Ops,
RE_Wide_Wide_String_Write_Blk_IO => System_Strings_Stream_Ops,
RE_Task_Info_Type => System_Task_Info,
RE_Unspecified_Task_Info => System_Task_Info,

1
gcc/ada/s-rident.ads
View File

@ -102,6 +102,7 @@ package System.Rident is
No_Select_Statements, -- GNAT (Ravenscar)
No_Specific_Termination_Handlers, -- (RM D.7(10.7/2))
No_Standard_Storage_Pools, -- GNAT
No_Stream_Optimizations, -- GNAT
No_Streams, -- GNAT
No_Task_Allocators, -- (RM D.7(7))
No_Task_Attributes_Package, -- GNAT

402
gcc/ada/s-ststop.adb
View File

@ -43,6 +43,11 @@ with System.Stream_Attributes; use System;
package body System.Strings.Stream_Ops is
-- The following type describes the low-level IO mechanism used in package
-- Stream_Ops_Internal.
type IO_Kind is (Byte_IO, Block_IO);
-- 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
@ -53,13 +58,24 @@ package body System.Strings.Stream_Ops is
type String_Type is array (Positive range <>) of Character_Type;
package Stream_Ops_Internal is
function Input
(Strm : access Root_Stream_Type'Class;
IO : IO_Kind) return String_Type;
procedure Output
(Strm : access Root_Stream_Type'Class;
Item : String_Type;
IO : IO_Kind);
procedure Read
(Strm : access Root_Stream_Type'Class;
Item : out String_Type);
Item : out String_Type;
IO : IO_Kind);
procedure Write
(Strm : access Root_Stream_Type'Class;
Item : String_Type);
Item : String_Type;
IO : IO_Kind);
end Stream_Ops_Internal;
-------------------------
@ -92,28 +108,6 @@ package body System.Strings.Stream_Ops is
subtype String_Block is String_Type (1 .. C_In_Default_Block);
Flag : Integer;
pragma Import (C, Flag, "__gl_canonical_streams");
-- This imported value is used to determine whether configuration pragma
-- Canonical_Streams is present. A value of zero indicates whether any
-- stream-related optimizations are enabled, while a value of one
-- indicates a disabled status.
-- What is all this rubbish about C flags for a global config pragma???
Canonical_Streams : constant Boolean := Flag = 1;
-- This seems dubious, surely it should be (Flag /= 0) for normal
-- C semantics. Why not just import as a pragma Convention C Boolean
-- anyway, avoiding the need for junk flag ???
-- Block IO is used when the low level can support block IO, the size
-- of the character type is a multiple of the stream element type and
-- the compilation can use stream optimizations.
Use_Block_IO : constant Boolean :=
Stream_Attributes.Block_IO_OK
and then C_Size mod SE_Size = 0
and then not Canonical_Streams;
-- Conversions to and from Default_Block
function To_Default_Block is
@ -122,13 +116,74 @@ package body System.Strings.Stream_Ops is
function To_String_Block is
new Ada.Unchecked_Conversion (Default_Block, String_Block);
-----------
-- Input --
-----------
function Input
(Strm : access Root_Stream_Type'Class;
IO : IO_Kind) return String_Type
is
begin
if Strm = null then
raise Constraint_Error;
end if;
declare
Low : Positive;
High : Positive;
begin
-- Read the bounds of the string
Positive'Read (Strm, Low);
Positive'Read (Strm, High);
declare
Item : String_Type (Low .. High);
begin
-- Read the character content of the string
Read (Strm, Item, IO);
return Item;
end;
end;
end Input;
------------
-- Output --
------------
procedure Output
(Strm : access Root_Stream_Type'Class;
Item : String_Type;
IO : IO_Kind)
is
begin
if Strm = null then
raise Constraint_Error;
end if;
-- Write the bounds of the string
Positive'Write (Strm, Item'First);
Positive'Write (Strm, Item'Last);
-- Write the character content of the string
Write (Strm, Item, IO);
end Output;
----------
-- Read --
----------
procedure Read
(Strm : access Root_Stream_Type'Class;
Item : out String_Type)
Item : out String_Type;
IO : IO_Kind)
is
begin
if Strm = null then
@ -141,7 +196,11 @@ package body System.Strings.Stream_Ops is
return;
end if;
if Use_Block_IO then
-- Block IO
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.
@ -225,7 +284,7 @@ package body System.Strings.Stream_Ops is
end if;
end;
-- Character-by-character IO
-- Byte IO
else
declare
@ -246,7 +305,8 @@ package body System.Strings.Stream_Ops is
procedure Write
(Strm : access Root_Stream_Type'Class;
Item : String_Type)
Item : String_Type;
IO : IO_Kind)
is
begin
if Strm = null then
@ -259,7 +319,11 @@ package body System.Strings.Stream_Ops is
return;
end if;
if Use_Block_IO then
-- Block IO
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.
@ -313,7 +377,7 @@ package body System.Strings.Stream_Ops is
end if;
end;
-- Character-by-character IO
-- Byte IO
else
for Index in Item'First .. Item'Last loop
@ -323,7 +387,7 @@ package body System.Strings.Stream_Ops is
end Write;
end Stream_Ops_Internal;
-- Specific instantiations for different string types
-- Specific instantiations for all Ada string types
package String_Ops is
new Stream_Ops_Internal
@ -348,33 +412,20 @@ package body System.Strings.Stream_Ops is
(Strm : access Ada.Streams.Root_Stream_Type'Class) return String
is
begin
if Strm = null then
raise Constraint_Error;
end if;
declare
Low : Positive;
High : Positive;
begin
-- Read the bounds of the string
Positive'Read (Strm, Low);
Positive'Read (Strm, High);
declare
Item : String (Low .. High);
begin
-- Read the character content of the string
String_Read (Strm, Item);
return Item;
end;
end;
return String_Ops.Input (Strm, Byte_IO);
end String_Input;
-------------------------
-- String_Input_Blk_IO --
-------------------------
function String_Input_Blk_IO
(Strm : access Ada.Streams.Root_Stream_Type'Class) return String
is
begin
return String_Ops.Input (Strm, Block_IO);
end String_Input_Blk_IO;
-------------------
-- String_Output --
-------------------
@ -384,20 +435,21 @@ package body System.Strings.Stream_Ops is
Item : String)
is
begin
if Strm = null then
raise Constraint_Error;
end if;
-- Write the bounds of the string
Positive'Write (Strm, Item'First);
Positive'Write (Strm, Item'Last);
-- Write the character content of the string
String_Write (Strm, Item);
String_Ops.Output (Strm, Item, Byte_IO);
end String_Output;
--------------------------
-- String_Output_Blk_IO --
--------------------------
procedure String_Output_Blk_IO
(Strm : access Ada.Streams.Root_Stream_Type'Class;
Item : String)
is
begin
String_Ops.Output (Strm, Item, Block_IO);
end String_Output_Blk_IO;
-----------------
-- String_Read --
-----------------
@ -407,9 +459,21 @@ package body System.Strings.Stream_Ops is
Item : out String)
is
begin
String_Ops.Read (Strm, Item);
String_Ops.Read (Strm, Item, Byte_IO);
end String_Read;
------------------------
-- String_Read_Blk_IO --
------------------------
procedure String_Read_Blk_IO
(Strm : access Ada.Streams.Root_Stream_Type'Class;
Item : out String)
is
begin
String_Ops.Read (Strm, Item, Block_IO);
end String_Read_Blk_IO;
------------------
-- String_Write --
------------------
@ -419,45 +483,43 @@ package body System.Strings.Stream_Ops is
Item : String)
is
begin
String_Ops.Write (Strm, Item);
String_Ops.Write (Strm, Item, Byte_IO);
end String_Write;
-------------------------
-- String_Write_Blk_IO --
-------------------------
procedure String_Write_Blk_IO
(Strm : access Ada.Streams.Root_Stream_Type'Class;
Item : String)
is
begin
String_Ops.Write (Strm, Item, Block_IO);
end String_Write_Blk_IO;
-----------------------
-- Wide_String_Input --
-----------------------
function Wide_String_Input
(Strm : access Ada.Streams.Root_Stream_Type'Class)
return Wide_String
(Strm : access Ada.Streams.Root_Stream_Type'Class) return Wide_String
is
begin
if Strm = null then
raise Constraint_Error;
end if;
declare
Low : Positive;
High : Positive;
begin
-- Read the bounds of the string
Positive'Read (Strm, Low);
Positive'Read (Strm, High);
declare
Item : Wide_String (Low .. High);
begin
-- Read the character content of the string
Wide_String_Read (Strm, Item);
return Item;
end;
end;
return Wide_String_Ops.Input (Strm, Byte_IO);
end Wide_String_Input;
------------------------------
-- Wide_String_Input_Blk_IO --
------------------------------
function Wide_String_Input_Blk_IO
(Strm : access Ada.Streams.Root_Stream_Type'Class) return Wide_String
is
begin
return Wide_String_Ops.Input (Strm, Block_IO);
end Wide_String_Input_Blk_IO;
------------------------
-- Wide_String_Output --
------------------------
@ -467,20 +529,21 @@ package body System.Strings.Stream_Ops is
Item : Wide_String)
is
begin
if Strm = null then
raise Constraint_Error;
end if;
-- Write the bounds of the string
Positive'Write (Strm, Item'First);
Positive'Write (Strm, Item'Last);
-- Write the character content of the string
Wide_String_Write (Strm, Item);
Wide_String_Ops.Output (Strm, Item, Byte_IO);
end Wide_String_Output;
-------------------------------
-- Wide_String_Output_Blk_IO --
-------------------------------
procedure Wide_String_Output_Blk_IO
(Strm : access Ada.Streams.Root_Stream_Type'Class;
Item : Wide_String)
is
begin
Wide_String_Ops.Output (Strm, Item, Block_IO);
end Wide_String_Output_Blk_IO;
----------------------
-- Wide_String_Read --
----------------------
@ -490,9 +553,21 @@ package body System.Strings.Stream_Ops is
Item : out Wide_String)
is
begin
Wide_String_Ops.Read (Strm, Item);
Wide_String_Ops.Read (Strm, Item, Byte_IO);
end Wide_String_Read;
-----------------------------
-- Wide_String_Read_Blk_IO --
-----------------------------
procedure Wide_String_Read_Blk_IO
(Strm : access Ada.Streams.Root_Stream_Type'Class;
Item : out Wide_String)
is
begin
Wide_String_Ops.Read (Strm, Item, Block_IO);
end Wide_String_Read_Blk_IO;
-----------------------
-- Wide_String_Write --
-----------------------
@ -502,45 +577,43 @@ package body System.Strings.Stream_Ops is
Item : Wide_String)
is
begin
Wide_String_Ops.Write (Strm, Item);
Wide_String_Ops.Write (Strm, Item, Byte_IO);
end Wide_String_Write;
------------------------------
-- Wide_String_Write_Blk_IO --
------------------------------
procedure Wide_String_Write_Blk_IO
(Strm : access Ada.Streams.Root_Stream_Type'Class;
Item : Wide_String)
is
begin
Wide_String_Ops.Write (Strm, Item, Block_IO);
end Wide_String_Write_Blk_IO;
----------------------------
-- Wide_Wide_String_Input --
----------------------------
function Wide_Wide_String_Input
(Strm : access Ada.Streams.Root_Stream_Type'Class)
return Wide_Wide_String
(Strm : access Ada.Streams.Root_Stream_Type'Class) return Wide_Wide_String
is
begin
if Strm = null then
raise Constraint_Error;
end if;
declare
Low : Positive;
High : Positive;
begin
-- Read the bounds of the string
Positive'Read (Strm, Low);
Positive'Read (Strm, High);
declare
Item : Wide_Wide_String (Low .. High);
begin
-- Read the character content of the string
Wide_Wide_String_Read (Strm, Item);
return Item;
end;
end;
return Wide_Wide_String_Ops.Input (Strm, Byte_IO);
end Wide_Wide_String_Input;
-----------------------------------
-- Wide_Wide_String_Input_Blk_IO --
-----------------------------------
function Wide_Wide_String_Input_Blk_IO
(Strm : access Ada.Streams.Root_Stream_Type'Class) return Wide_Wide_String
is
begin
return Wide_Wide_String_Ops.Input (Strm, Block_IO);
end Wide_Wide_String_Input_Blk_IO;
-----------------------------
-- Wide_Wide_String_Output --
-----------------------------
@ -550,20 +623,21 @@ package body System.Strings.Stream_Ops is
Item : Wide_Wide_String)
is
begin
if Strm = null then
raise Constraint_Error;
end if;
-- Write the bounds of the string
Positive'Write (Strm, Item'First);
Positive'Write (Strm, Item'Last);
-- Write the character content of the string
Wide_Wide_String_Write (Strm, Item);
Wide_Wide_String_Ops.Output (Strm, Item, Byte_IO);
end Wide_Wide_String_Output;
------------------------------------
-- Wide_Wide_String_Output_Blk_IO --
------------------------------------
procedure Wide_Wide_String_Output_Blk_IO
(Strm : access Ada.Streams.Root_Stream_Type'Class;
Item : Wide_Wide_String)
is
begin
Wide_Wide_String_Ops.Output (Strm, Item, Block_IO);
end Wide_Wide_String_Output_Blk_IO;
---------------------------
-- Wide_Wide_String_Read --
---------------------------
@ -573,9 +647,21 @@ package body System.Strings.Stream_Ops is
Item : out Wide_Wide_String)
is
begin
Wide_Wide_String_Ops.Read (Strm, Item);
Wide_Wide_String_Ops.Read (Strm, Item, Byte_IO);
end Wide_Wide_String_Read;
----------------------------------
-- Wide_Wide_String_Read_Blk_IO --
----------------------------------
procedure Wide_Wide_String_Read_Blk_IO
(Strm : access Ada.Streams.Root_Stream_Type'Class;
Item : out Wide_Wide_String)
is
begin
Wide_Wide_String_Ops.Read (Strm, Item, Block_IO);
end Wide_Wide_String_Read_Blk_IO;
----------------------------
-- Wide_Wide_String_Write --
----------------------------
@ -585,7 +671,19 @@ package body System.Strings.Stream_Ops is
Item : Wide_Wide_String)
is
begin
Wide_Wide_String_Ops.Write (Strm, Item);
Wide_Wide_String_Ops.Write (Strm, Item, Byte_IO);
end Wide_Wide_String_Write;
-----------------------------------
-- Wide_Wide_String_Write_Blk_IO --
-----------------------------------
procedure Wide_Wide_String_Write_Blk_IO
(Strm : access Ada.Streams.Root_Stream_Type'Class;
Item : Wide_Wide_String)
is
begin
Wide_Wide_String_Ops.Write (Strm, Item, Block_IO);
end Wide_Wide_String_Write_Blk_IO;
end System.Strings.Stream_Ops;

50
gcc/ada/s-ststop.ads
View File

@ -45,6 +45,8 @@
-- will be expanded into:
--
-- String_Output (Some_Stream, Some_String);
-- or
-- String_Output_Blk_IO (Some_Stream, Some_String);
pragma Warnings (Off);
pragma Compiler_Unit;
@ -62,18 +64,34 @@ package System.Strings.Stream_Ops is
(Strm : access Ada.Streams.Root_Stream_Type'Class)
return String;
function String_Input_Blk_IO
(Strm : access Ada.Streams.Root_Stream_Type'Class)
return String;
procedure String_Output
(Strm : access Ada.Streams.Root_Stream_Type'Class;
Item : String);
procedure String_Output_Blk_IO
(Strm : access Ada.Streams.Root_Stream_Type'Class;
Item : String);
procedure String_Read
(Strm : access Ada.Streams.Root_Stream_Type'Class;
Item : out String);
procedure String_Read_Blk_IO
(Strm : access Ada.Streams.Root_Stream_Type'Class;
Item : out String);
procedure String_Write
(Strm : access Ada.Streams.Root_Stream_Type'Class;
Item : String);
procedure String_Write_Blk_IO
(Strm : access Ada.Streams.Root_Stream_Type'Class;
Item : String);
-----------------------------------
-- Wide_String stream operations --
-----------------------------------
@ -82,18 +100,34 @@ package System.Strings.Stream_Ops is
(Strm : access Ada.Streams.Root_Stream_Type'Class)
return Wide_String;
function Wide_String_Input_Blk_IO
(Strm : access Ada.Streams.Root_Stream_Type'Class)
return Wide_String;
procedure Wide_String_Output
(Strm : access Ada.Streams.Root_Stream_Type'Class;
Item : Wide_String);
procedure Wide_String_Output_Blk_IO
(Strm : access Ada.Streams.Root_Stream_Type'Class;
Item : Wide_String);
procedure Wide_String_Read
(Strm : access Ada.Streams.Root_Stream_Type'Class;
Item : out Wide_String);
procedure Wide_String_Read_Blk_IO
(Strm : access Ada.Streams.Root_Stream_Type'Class;
Item : out Wide_String);
procedure Wide_String_Write
(Strm : access Ada.Streams.Root_Stream_Type'Class;
Item : Wide_String);
procedure Wide_String_Write_Blk_IO
(Strm : access Ada.Streams.Root_Stream_Type'Class;
Item : Wide_String);
----------------------------------------
-- Wide_Wide_String stream operations --
----------------------------------------
@ -102,16 +136,32 @@ package System.Strings.Stream_Ops is
(Strm : access Ada.Streams.Root_Stream_Type'Class)
return Wide_Wide_String;
function Wide_Wide_String_Input_Blk_IO
(Strm : access Ada.Streams.Root_Stream_Type'Class)
return Wide_Wide_String;
procedure Wide_Wide_String_Output
(Strm : access Ada.Streams.Root_Stream_Type'Class;
Item : Wide_Wide_String);
procedure Wide_Wide_String_Output_Blk_IO
(Strm : access Ada.Streams.Root_Stream_Type'Class;
Item : Wide_Wide_String);
procedure Wide_Wide_String_Read
(Strm : access Ada.Streams.Root_Stream_Type'Class;
Item : out Wide_Wide_String);
procedure Wide_Wide_String_Read_Blk_IO
(Strm : access Ada.Streams.Root_Stream_Type'Class;
Item : out Wide_Wide_String);
procedure Wide_Wide_String_Write
(Strm : access Ada.Streams.Root_Stream_Type'Class;
Item : Wide_Wide_String);
procedure Wide_Wide_String_Write_Blk_IO
(Strm : access Ada.Streams.Root_Stream_Type'Class;
Item : Wide_Wide_String);
end System.Strings.Stream_Ops;

13
gcc/ada/sem_prag.adb
View File

@ -5646,18 +5646,6 @@ package body Sem_Prag is
end if;
end C_Pass_By_Copy;
-----------------------
-- Canonical_Streams --
-----------------------
-- pragma Canonical_Streams;
when Pragma_Canonical_Streams =>
GNAT_Pragma;
Check_Arg_Count (0);
Check_Valid_Configuration_Pragma;
Canonical_Streams := True;
-----------
-- Check --
-----------
@ -12214,7 +12202,6 @@ package body Sem_Prag is
Pragma_Atomic => 0,
Pragma_Atomic_Components => 0,
Pragma_Attach_Handler => -1,
Pragma_Canonical_Streams => -1,
Pragma_Check => 99,
Pragma_Check_Name => 0,
Pragma_Check_Policy => 0,

1
gcc/ada/snames.adb
View File

@ -183,7 +183,6 @@ package body Snames is
"ada_2005#" &
"assertion_policy#" &
"c_pass_by_copy#" &
"canonical_streams#" &
"check_name#" &
"check_policy#" &
"compile_time_error#" &

1318
gcc/ada/snames.ads
View File

File diff suppressed because it is too large Load Diff

329
gcc/ada/snames.h
View File

@ -227,170 +227,169 @@ extern unsigned char Get_Pragma_Id (int);
#define Pragma_Ada_2005 3
#define Pragma_Assertion_Policy 4
#define Pragma_C_Pass_By_Copy 5
#define Pragma_Canonical_Streams 6
#define Pragma_Check_Name 7
#define Pragma_Check_Policy 8
#define Pragma_Compile_Time_Error 9
#define Pragma_Compile_Time_Warning 10
#define Pragma_Compiler_Unit 11
#define Pragma_Component_Alignment 12
#define Pragma_Convention_Identifier 13
#define Pragma_Debug_Policy 14
#define Pragma_Detect_Blocking 15
#define Pragma_Discard_Names 16
#define Pragma_Elaboration_Checks 17
#define Pragma_Eliminate 18
#define Pragma_Extend_System 19
#define Pragma_Extensions_Allowed 20
#define Pragma_External_Name_Casing 21
#define Pragma_Favor_Top_Level 22
#define Pragma_Float_Representation 23
#define Pragma_Implicit_Packing 24
#define Pragma_Initialize_Scalars 25
#define Pragma_Interrupt_State 26
#define Pragma_License 27
#define Pragma_Locking_Policy 28
#define Pragma_Long_Float 29
#define Pragma_No_Run_Time 30
#define Pragma_No_Strict_Aliasing 31
#define Pragma_Normalize_Scalars 32
#define Pragma_Optimize_Alignment 33
#define Pragma_Persistent_BSS 34
#define Pragma_Polling 35
#define Pragma_Priority_Specific_Dispatching 36
#define Pragma_Profile 37
#define Pragma_Profile_Warnings 38
#define Pragma_Propagate_Exceptions 39
#define Pragma_Queuing_Policy 40
#define Pragma_Ravenscar 41
#define Pragma_Restricted_Run_Time 42
#define Pragma_Restrictions 43
#define Pragma_Restriction_Warnings 44
#define Pragma_Reviewable 45
#define Pragma_Source_File_Name 46
#define Pragma_Source_File_Name_Project 47
#define Pragma_Style_Checks 48
#define Pragma_Suppress 49
#define Pragma_Suppress_Exception_Locations 50
#define Pragma_Task_Dispatching_Policy 51
#define Pragma_Universal_Data 52
#define Pragma_Unsuppress 53
#define Pragma_Use_VADS_Size 54
#define Pragma_Validity_Checks 55
#define Pragma_Warnings 56
#define Pragma_Wide_Character_Encoding 57
#define Pragma_Abort_Defer 58
#define Pragma_All_Calls_Remote 59
#define Pragma_Annotate 60
#define Pragma_Assert 61
#define Pragma_Asynchronous 62
#define Pragma_Atomic 63
#define Pragma_Atomic_Components 64
#define Pragma_Attach_Handler 65
#define Pragma_Check 66
#define Pragma_CIL_Constructor 67
#define Pragma_Comment 68
#define Pragma_Common_Object 69
#define Pragma_Complete_Representation 70
#define Pragma_Complex_Representation 71
#define Pragma_Controlled 72
#define Pragma_Convention 73
#define Pragma_CPP_Class 74
#define Pragma_CPP_Constructor 75
#define Pragma_CPP_Virtual 76
#define Pragma_CPP_Vtable 77
#define Pragma_Debug 78
#define Pragma_Elaborate 79
#define Pragma_Elaborate_All 80
#define Pragma_Elaborate_Body 81
#define Pragma_Export 82
#define Pragma_Export_Exception 83
#define Pragma_Export_Function 84
#define Pragma_Export_Object 85
#define Pragma_Export_Procedure 86
#define Pragma_Export_Value 87
#define Pragma_Export_Valued_Procedure 88
#define Pragma_External 89
#define Pragma_Finalize_Storage_Only 90
#define Pragma_Ident 91
#define Pragma_Implemented_By_Entry 92
#define Pragma_Import 93
#define Pragma_Import_Exception 94
#define Pragma_Import_Function 95
#define Pragma_Import_Object 96
#define Pragma_Import_Procedure 97
#define Pragma_Import_Valued_Procedure 98
#define Pragma_Inline 99
#define Pragma_Inline_Always 100
#define Pragma_Inline_Generic 101
#define Pragma_Inspection_Point 102
#define Pragma_Interface_Name 103
#define Pragma_Interrupt_Handler 104
#define Pragma_Interrupt_Priority 105
#define Pragma_Java_Constructor 106
#define Pragma_Java_Interface 107
#define Pragma_Keep_Names 108
#define Pragma_Link_With 109
#define Pragma_Linker_Alias 110
#define Pragma_Linker_Constructor 111
#define Pragma_Linker_Destructor 112
#define Pragma_Linker_Options 113
#define Pragma_Linker_Section 114
#define Pragma_List 115
#define Pragma_Machine_Attribute 116
#define Pragma_Main 117
#define Pragma_Main_Storage 118
#define Pragma_Memory_Size 119
#define Pragma_No_Body 120
#define Pragma_No_Return 121
#define Pragma_Obsolescent 122
#define Pragma_Optimize 123
#define Pragma_Pack 124
#define Pragma_Page 125
#define Pragma_Passive 126
#define Pragma_Postcondition 127
#define Pragma_Precondition 128
#define Pragma_Preelaborable_Initialization 129
#define Pragma_Preelaborate 130
#define Pragma_Preelaborate_05 131
#define Pragma_Psect_Object 132
#define Pragma_Pure 133
#define Pragma_Pure_05 134
#define Pragma_Pure_Function 135
#define Pragma_Relative_Deadline 136
#define Pragma_Remote_Call_Interface 137
#define Pragma_Remote_Types 138
#define Pragma_Share_Generic 139
#define Pragma_Shared 140
#define Pragma_Shared_Passive 141
#define Pragma_Source_Reference 142
#define Pragma_Static_Elaboration_Desired 143
#define Pragma_Stream_Convert 144
#define Pragma_Subtitle 145
#define Pragma_Suppress_All 146
#define Pragma_Suppress_Debug_Info 147
#define Pragma_Suppress_Initialization 148
#define Pragma_System_Name 149
#define Pragma_Task_Info 150
#define Pragma_Task_Name 151
#define Pragma_Task_Storage 152
#define Pragma_Time_Slice 153
#define Pragma_Title 154
#define Pragma_Unchecked_Union 155
#define Pragma_Unimplemented_Unit 156
#define Pragma_Universal_Aliasing 157
#define Pragma_Unmodified 158
#define Pragma_Unreferenced 159
#define Pragma_Unreferenced_Objects 160
#define Pragma_Unreserve_All_Interrupts 161
#define Pragma_Volatile 162
#define Pragma_Volatile_Components 163
#define Pragma_Weak_External 164
#define Pragma_AST_Entry 165
#define Pragma_Fast_Math 166
#define Pragma_Interface 167
#define Pragma_Priority 168
#define Pragma_Storage_Size 169
#define Pragma_Storage_Unit 170
#define Pragma_Check_Name 6
#define Pragma_Check_Policy 7
#define Pragma_Compile_Time_Error 8
#define Pragma_Compile_Time_Warning 9
#define Pragma_Compiler_Unit 10
#define Pragma_Component_Alignment 11
#define Pragma_Convention_Identifier 12
#define Pragma_Debug_Policy 13
#define Pragma_Detect_Blocking 14
#define Pragma_Discard_Names 15
#define Pragma_Elaboration_Checks 16
#define Pragma_Eliminate 17
#define Pragma_Extend_System 18
#define Pragma_Extensions_Allowed 19
#define Pragma_External_Name_Casing 20
#define Pragma_Favor_Top_Level 21
#define Pragma_Float_Representation 22
#define Pragma_Implicit_Packing 23
#define Pragma_Initialize_Scalars 24
#define Pragma_Interrupt_State 25
#define Pragma_License 26
#define Pragma_Locking_Policy 27
#define Pragma_Long_Float 28
#define Pragma_No_Run_Time 29
#define Pragma_No_Strict_Aliasing 30
#define Pragma_Normalize_Scalars 31
#define Pragma_Optimize_Alignment 32
#define Pragma_Persistent_BSS 33
#define Pragma_Polling 34
#define Pragma_Priority_Specific_Dispatching 35
#define Pragma_Profile 36
#define Pragma_Profile_Warnings 37
#define Pragma_Propagate_Exceptions 38
#define Pragma_Queuing_Policy 39
#define Pragma_Ravenscar 40
#define Pragma_Restricted_Run_Time 41
#define Pragma_Restrictions 42
#define Pragma_Restriction_Warnings 43
#define Pragma_Reviewable 44
#define Pragma_Source_File_Name 45
#define Pragma_Source_File_Name_Project 46
#define Pragma_Style_Checks 47
#define Pragma_Suppress 48
#define Pragma_Suppress_Exception_Locations 49
#define Pragma_Task_Dispatching_Policy 50
#define Pragma_Universal_Data 51
#define Pragma_Unsuppress 52
#define Pragma_Use_VADS_Size 53
#define Pragma_Validity_Checks 54
#define Pragma_Warnings 55
#define Pragma_Wide_Character_Encoding 56
#define Pragma_Abort_Defer 57
#define Pragma_All_Calls_Remote 58
#define Pragma_Annotate 59
#define Pragma_Assert 60
#define Pragma_Asynchronous 61
#define Pragma_Atomic 62
#define Pragma_Atomic_Components 63
#define Pragma_Attach_Handler 64
#define Pragma_Check 65
#define Pragma_CIL_Constructor 66
#define Pragma_Comment 67
#define Pragma_Common_Object 68
#define Pragma_Complete_Representation 69
#define Pragma_Complex_Representation 70
#define Pragma_Controlled 71
#define Pragma_Convention 72
#define Pragma_CPP_Class 73
#define Pragma_CPP_Constructor 74
#define Pragma_CPP_Virtual 75
#define Pragma_CPP_Vtable 76
#define Pragma_Debug 77
#define Pragma_Elaborate 78
#define Pragma_Elaborate_All 79
#define Pragma_Elaborate_Body 80
#define Pragma_Export 81
#define Pragma_Export_Exception 82
#define Pragma_Export_Function 83
#define Pragma_Export_Object 84
#define Pragma_Export_Procedure 85
#define Pragma_Export_Value 86
#define Pragma_Export_Valued_Procedure 87
#define Pragma_External 88
#define Pragma_Finalize_Storage_Only 89
#define Pragma_Ident 90
#define Pragma_Implemented_By_Entry 91
#define Pragma_Import 92
#define Pragma_Import_Exception 93
#define Pragma_Import_Function 94
#define Pragma_Import_Object 95
#define Pragma_Import_Procedure 96
#define Pragma_Import_Valued_Procedure 97
#define Pragma_Inline 98
#define Pragma_Inline_Always 99
#define Pragma_Inline_Generic 100
#define Pragma_Inspection_Point 101
#define Pragma_Interface_Name 102
#define Pragma_Interrupt_Handler 103
#define Pragma_Interrupt_Priority 104
#define Pragma_Java_Constructor 105
#define Pragma_Java_Interface 106
#define Pragma_Keep_Names 107
#define Pragma_Link_With 108
#define Pragma_Linker_Alias 109
#define Pragma_Linker_Constructor 110
#define Pragma_Linker_Destructor 111
#define Pragma_Linker_Options 112
#define Pragma_Linker_Section 113
#define Pragma_List 114
#define Pragma_Machine_Attribute 115
#define Pragma_Main 116
#define Pragma_Main_Storage 117
#define Pragma_Memory_Size 118
#define Pragma_No_Body 119
#define Pragma_No_Return 120
#define Pragma_Obsolescent 121
#define Pragma_Optimize 122
#define Pragma_Pack 123
#define Pragma_Page 124
#define Pragma_Passive 125
#define Pragma_Postcondition 126
#define Pragma_Precondition 127
#define Pragma_Preelaborable_Initialization 128
#define Pragma_Preelaborate 129
#define Pragma_Preelaborate_05 130
#define Pragma_Psect_Object 131
#define Pragma_Pure 132
#define Pragma_Pure_05 133
#define Pragma_Pure_Function 134
#define Pragma_Relative_Deadline 135
#define Pragma_Remote_Call_Interface 136
#define Pragma_Remote_Types 137
#define Pragma_Share_Generic 138
#define Pragma_Shared 139
#define Pragma_Shared_Passive 140
#define Pragma_Source_Reference 141
#define Pragma_Static_Elaboration_Desired 142
#define Pragma_Stream_Convert 143
#define Pragma_Subtitle 144
#define Pragma_Suppress_All 145
#define Pragma_Suppress_Debug_Info 146
#define Pragma_Suppress_Initialization 147
#define Pragma_System_Name 148
#define Pragma_Task_Info 149
#define Pragma_Task_Name 150
#define Pragma_Task_Storage 151
#define Pragma_Time_Slice 152
#define Pragma_Title 153
#define Pragma_Unchecked_Union 154
#define Pragma_Unimplemented_Unit 155
#define Pragma_Universal_Aliasing 156
#define Pragma_Unmodified 157
#define Pragma_Unreferenced 158
#define Pragma_Unreferenced_Objects 159
#define Pragma_Unreserve_All_Interrupts 160
#define Pragma_Volatile 161
#define Pragma_Volatile_Components 162
#define Pragma_Weak_External 163
#define Pragma_AST_Entry 164
#define Pragma_Fast_Math 165
#define Pragma_Interface 166
#define Pragma_Priority 167
#define Pragma_Storage_Size 168
#define Pragma_Storage_Unit 169
/* End of snames.h (C version of Snames package spec) */