URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [ada/] [s-ststop.adb] - Blame information for rev 706

Details | Compare with Previous | View Log


------------------------------------------------------------------------------
--                                                                          --
--                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
--                                                                          --
--              S Y S T E M . S T R I N G S . S T R E A M _ O P S           --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--          Copyright (C) 2008-2010, 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- --
-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
--                                                                          --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception,   --
-- version 3.1, as published by the Free Software Foundation.               --
--                                                                          --
-- You should have received a copy of the GNU General Public License and    --
-- a copy of the GCC Runtime Library Exception along with this program;     --
-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
-- <http://www.gnu.org/licenses/>.                                          --
--                                                                          --
-- GNAT was originally developed  by the GNAT team at  New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc.      --
--                                                                          --
------------------------------------------------------------------------------
 
pragma Compiler_Unit;
 
with Ada.Streams;              use Ada.Streams;
with Ada.Streams.Stream_IO;    use Ada.Streams.Stream_IO;
with Ada.Unchecked_Conversion;
 
with System.Stream_Attributes; use System;
 
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
   --  IO or character-by-character IO.
 
   generic
      type Character_Type is private;
      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;
         IO   : IO_Kind);
 
      procedure Write
        (Strm : access Root_Stream_Type'Class;
         Item : String_Type;
         IO   : IO_Kind);
   end Stream_Ops_Internal;
 
   -------------------------
   -- Stream_Ops_Internal --
   -------------------------
 
   package body Stream_Ops_Internal is
 
      --  The following value represents the number of BITS allocated for the
      --  default block used in string IO. The sizes of all other types are
      --  calculated relative to this value.
 
      Default_Block_Size : constant := 512 * 8;
 
      --  Shorthand notation for stream element and character sizes
 
      C_Size  : constant Integer := Character_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.
 
      C_In_Default_Block  : constant Integer := Default_Block_Size / C_Size;
      SE_In_Default_Block : constant Integer := Default_Block_Size / SE_Size;
 
      --  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);
 
      --  Conversions to and from Default_Block
 
      function To_Default_Block is
        new Ada.Unchecked_Conversion (String_Block, Default_Block);
 
      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;
         IO   : IO_Kind)
      is
      begin
         if Strm = null then
            raise Constraint_Error;
         end if;
 
         --  Nothing to do if the desired string is empty
 
         if Item'Length = 0 then
            return;
         end if;
 
         --  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.
 
               Block_Size : constant Natural :=
                              (Item'Last - Item'First + 1) * C_Size;
 
               --  Item can be larger than what the default block can store,
               --  determine the number of whole reads necessary to read the
               --  string.
 
               Blocks : constant Natural := Block_Size / Default_Block_Size;
 
               --  The size of Item may not be a multiple of the default block
               --  size, determine the size of the remaining chunk in BITS.
 
               Rem_Size : constant Natural :=
                            Block_Size mod Default_Block_Size;
 
               --  String indexes
 
               Low  : Positive := Item'First;
               High : Positive := Low + C_In_Default_Block - 1;
 
               --  End of stream error detection
 
               Last : Stream_Element_Offset := 0;
               Sum  : Stream_Element_Offset := 0;
 
            begin
               --  Step 1: If the string is too large, read in individual
               --  chunks the size of the default block.
 
               if Blocks > 0 then
                  declare
                     Block : Default_Block;
 
                  begin
                     for Counter in 1 .. Blocks loop
                        Read (Strm.all, Block, Last);
                        Item (Low .. High) := To_String_Block (Block);
 
                        Low  := High + 1;
                        High := Low + C_In_Default_Block - 1;
                        Sum  := Sum + Last;
                        Last := 0;
                     end loop;
                  end;
               end if;
 
               --  Step 2: Read in any remaining elements
 
               if Rem_Size > 0 then
                  declare
                     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);
 
                     function To_Rem_String_Block is new
                       Ada.Unchecked_Conversion (Rem_Block, Rem_String_Block);
 
                     Block : Rem_Block;
 
                  begin
                     Read (Strm.all, Block, Last);
                     Item (Low .. Item'Last) := To_Rem_String_Block (Block);
 
                     Sum := Sum + Last;
                  end;
               end if;
 
               --  Step 3: Potential error detection. The sum of all the
               --  chunks is less than we initially wanted to read. In other
               --  words, the stream does not contain enough elements to fully
               --  populate Item.
 
               if (Integer (Sum) * SE_Size) / C_Size < Item'Length then
                  raise End_Error;
               end if;
            end;
 
         --  Byte IO
 
         else
            declare
               C : Character_Type;
 
            begin
               for Index in Item'First .. Item'Last loop
                  Character_Type'Read (Strm, C);
                  Item (Index) := C;
               end loop;
            end;
         end if;
      end Read;
 
      -----------
      -- Write --
      -----------
 
      procedure Write
        (Strm : access Root_Stream_Type'Class;
         Item : String_Type;
         IO   : IO_Kind)
      is
      begin
         if Strm = null then
            raise Constraint_Error;
         end if;
 
         --  Nothing to do if the input string is empty
 
         if Item'Length = 0 then
            return;
         end if;
 
         --  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.
 
               Block_Size : constant Natural := Item'Length * C_Size;
 
               --  Item can be larger than what the default block can store,
               --  determine the number of whole writes necessary to output the
               --  string.
 
               Blocks : constant Natural := Block_Size / Default_Block_Size;
 
               --  The size of Item may not be a multiple of the default block
               --  size, determine the size of the remaining chunk.
 
               Rem_Size : constant Natural :=
                            Block_Size mod Default_Block_Size;
 
               --  String indexes
 
               Low  : Positive := Item'First;
               High : Positive := Low + C_In_Default_Block - 1;
 
            begin
               --  Step 1: If the string is too large, write out individual
               --  chunks the size of the default block.
 
               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;
               end loop;
 
               --  Step 2: Write out any remaining elements
 
               if Rem_Size > 0 then
                  declare
                     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);
 
                     function To_Rem_Block is new
                       Ada.Unchecked_Conversion (Rem_String_Block, Rem_Block);
 
                  begin
                     Write (Strm.all, To_Rem_Block (Item (Low .. Item'Last)));
                  end;
               end if;
            end;
 
         --  Byte IO
 
         else
            for Index in Item'First .. Item'Last loop
               Character_Type'Write (Strm, Item (Index));
            end loop;
         end if;
      end Write;
   end Stream_Ops_Internal;
 
   --  Specific instantiations for all Ada string types
 
   package String_Ops is
     new Stream_Ops_Internal
       (Character_Type => Character,
        String_Type    => String);
 
   package Wide_String_Ops is
     new Stream_Ops_Internal
       (Character_Type => Wide_Character,
        String_Type    => Wide_String);
 
   package Wide_Wide_String_Ops is
     new Stream_Ops_Internal
       (Character_Type => Wide_Wide_Character,
        String_Type    => Wide_Wide_String);
 
   ------------------
   -- String_Input --
   ------------------
 
   function String_Input
     (Strm : access Ada.Streams.Root_Stream_Type'Class) return String
   is
   begin
      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 --
   -------------------
 
   procedure String_Output
     (Strm : access Ada.Streams.Root_Stream_Type'Class;
      Item : String)
   is
   begin
      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 --
   -----------------
 
   procedure String_Read
     (Strm : access Ada.Streams.Root_Stream_Type'Class;
      Item : out String)
   is
   begin
      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 --
   ------------------
 
   procedure String_Write
     (Strm : access Ada.Streams.Root_Stream_Type'Class;
      Item : String)
   is
   begin
      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
   is
   begin
      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 --
   ------------------------
 
   procedure Wide_String_Output
     (Strm : access Ada.Streams.Root_Stream_Type'Class;
      Item : Wide_String)
   is
   begin
      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 --
   ----------------------
 
   procedure Wide_String_Read
     (Strm : access Ada.Streams.Root_Stream_Type'Class;
      Item : out Wide_String)
   is
   begin
      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 --
   -----------------------
 
   procedure Wide_String_Write
     (Strm : access Ada.Streams.Root_Stream_Type'Class;
      Item : Wide_String)
   is
   begin
      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
   is
   begin
      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 --
   -----------------------------
 
   procedure Wide_Wide_String_Output
     (Strm : access Ada.Streams.Root_Stream_Type'Class;
      Item : Wide_Wide_String)
   is
   begin
      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 --
   ---------------------------
 
   procedure Wide_Wide_String_Read
     (Strm : access Ada.Streams.Root_Stream_Type'Class;
      Item : out Wide_Wide_String)
   is
   begin
      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 --
   ----------------------------
 
   procedure Wide_Wide_String_Write
     (Strm : access Ada.Streams.Root_Stream_Type'Class;
      Item : Wide_Wide_String)
   is
   begin
      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;

Browse

Tools

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [ada/] [s-ststop.adb] - Blame information for rev 706

Line No.	Rev	Author	Line
1	706	jeremybenn	`------------------------------------------------------------------------------`
2			`-- --`
3			`-- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --`
4			`-- --`
5			`-- S Y S T E M . S T R I N G S . S T R E A M _ O P S --`
6			`-- --`
7			`-- B o d y --`
8			`-- --`
9			`-- Copyright (C) 2008-2010, Free Software Foundation, Inc. --`
10			`-- --`
11			`-- GNAT is free software; you can redistribute it and/or modify it under --`
12			`-- terms of the GNU General Public License as published by the Free Soft- --`
13			`-- ware Foundation; either version 3, or (at your option) any later ver- --`
14			`-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --`
15			`-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --`
16			`-- or FITNESS FOR A PARTICULAR PURPOSE. --`
17			`-- --`
18			`-- As a special exception under Section 7 of GPL version 3, you are granted --`
19			`-- additional permissions described in the GCC Runtime Library Exception, --`
20			`-- version 3.1, as published by the Free Software Foundation. --`
21			`-- --`
22			`-- You should have received a copy of the GNU General Public License and --`
23			`-- a copy of the GCC Runtime Library Exception along with this program; --`
24			`-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --`
25			`-- <http://www.gnu.org/licenses/>. --`
26			`-- --`
27			`-- GNAT was originally developed by the GNAT team at New York University. --`
28			`-- Extensive contributions were provided by Ada Core Technologies Inc. --`
29			`-- --`
30			`------------------------------------------------------------------------------`
31
32			`pragma Compiler_Unit;`
33
34			`with Ada.Streams; use Ada.Streams;`
35			`with Ada.Streams.Stream_IO; use Ada.Streams.Stream_IO;`
36			`with Ada.Unchecked_Conversion;`
37
38			`with System.Stream_Attributes; use System;`
39
40			`package body System.Strings.Stream_Ops is`
41
42			`-- The following type describes the low-level IO mechanism used in package`
43			`-- Stream_Ops_Internal.`
44
45			`type IO_Kind is (Byte_IO, Block_IO);`
46
47			`-- The following package provides an IO framework for strings. Depending`
48			`-- on the version of System.Stream_Attributes as well as the size of`
49			`-- formal parameter Character_Type, the package will either utilize block`
50			`-- IO or character-by-character IO.`
51
52			`generic`
53			`type Character_Type is private;`
54			`type String_Type is array (Positive range <>) of Character_Type;`
55
56			`package Stream_Ops_Internal is`
57			`function Input`
58			`(Strm : access Root_Stream_Type'Class;`
59			`IO : IO_Kind) return String_Type;`
60
61			`procedure Output`
62			`(Strm : access Root_Stream_Type'Class;`
63			`Item : String_Type;`
64			`IO : IO_Kind);`
65
66			`procedure Read`
67			`(Strm : access Root_Stream_Type'Class;`
68			`Item : out String_Type;`
69			`IO : IO_Kind);`
70
71			`procedure Write`
72			`(Strm : access Root_Stream_Type'Class;`
73			`Item : String_Type;`
74			`IO : IO_Kind);`
75			`end Stream_Ops_Internal;`
76
77			`-------------------------`
78			`-- Stream_Ops_Internal --`
79			`-------------------------`
80
81			`package body Stream_Ops_Internal is`
82
83			`-- The following value represents the number of BITS allocated for the`
84			`-- default block used in string IO. The sizes of all other types are`
85			`-- calculated relative to this value.`
86
87			`Default_Block_Size : constant := 512 * 8;`
88
89			`-- Shorthand notation for stream element and character sizes`
90
91			`C_Size : constant Integer := Character_Type'Size;`
92			`SE_Size : constant Integer := Stream_Element'Size;`
93
94			`-- The following constants describe the number of stream elements or`
95			`-- characters that can fit into a default block.`
96
97			`C_In_Default_Block : constant Integer := Default_Block_Size / C_Size;`
98			`SE_In_Default_Block : constant Integer := Default_Block_Size / SE_Size;`
99
100			`-- Buffer types`
101
102			`subtype Default_Block is Stream_Element_Array`
103			`(1 .. Stream_Element_Offset (SE_In_Default_Block));`
104
105			`subtype String_Block is String_Type (1 .. C_In_Default_Block);`
106
107			`-- Conversions to and from Default_Block`
108
109			`function To_Default_Block is`
110			`new Ada.Unchecked_Conversion (String_Block, Default_Block);`
111
112			`function To_String_Block is`
113			`new Ada.Unchecked_Conversion (Default_Block, String_Block);`
114
115			`-----------`
116			`-- Input --`
117			`-----------`
118
119			`function Input`
120			`(Strm : access Root_Stream_Type'Class;`
121			`IO : IO_Kind) return String_Type`
122			`is`
123			`begin`
124			`if Strm = null then`
125			`raise Constraint_Error;`
126			`end if;`
127
128			`declare`
129			`Low : Positive;`
130			`High : Positive;`
131
132			`begin`
133			`-- Read the bounds of the string`
134
135			`Positive'Read (Strm, Low);`
136			`Positive'Read (Strm, High);`
137
138			`declare`
139			`Item : String_Type (Low .. High);`
140
141			`begin`
142			`-- Read the character content of the string`
143
144			`Read (Strm, Item, IO);`
145
146			`return Item;`
147			`end;`
148			`end;`
149			`end Input;`
150
151			`------------`
152			`-- Output --`
153			`------------`
154
155			`procedure Output`
156			`(Strm : access Root_Stream_Type'Class;`
157			`Item : String_Type;`
158			`IO : IO_Kind)`
159			`is`
160			`begin`
161			`if Strm = null then`
162			`raise Constraint_Error;`
163			`end if;`
164
165			`-- Write the bounds of the string`
166
167			`Positive'Write (Strm, Item'First);`
168			`Positive'Write (Strm, Item'Last);`
169
170			`-- Write the character content of the string`
171
172			`Write (Strm, Item, IO);`
173			`end Output;`
174
175			`----------`
176			`-- Read --`
177			`----------`
178
179			`procedure Read`
180			`(Strm : access Root_Stream_Type'Class;`
181			`Item : out String_Type;`
182			`IO : IO_Kind)`
183			`is`
184			`begin`
185			`if Strm = null then`
186			`raise Constraint_Error;`
187			`end if;`
188
189			`-- Nothing to do if the desired string is empty`
190
191			`if Item'Length = 0 then`
192			`return;`
193			`end if;`
194
195			`-- Block IO`
196
197			`if IO = Block_IO`
198			`and then Stream_Attributes.Block_IO_OK`
199			`then`
200			`declare`
201			`-- Determine the size in BITS of the block necessary to contain`
202			`-- the whole string.`
203
204			`Block_Size : constant Natural :=`
205			`(Item'Last - Item'First + 1) * C_Size;`
206
207			`-- Item can be larger than what the default block can store,`
208			`-- determine the number of whole reads necessary to read the`
209			`-- string.`
210
211			`Blocks : constant Natural := Block_Size / Default_Block_Size;`
212
213			`-- The size of Item may not be a multiple of the default block`
214			`-- size, determine the size of the remaining chunk in BITS.`
215
216			`Rem_Size : constant Natural :=`
217			`Block_Size mod Default_Block_Size;`
218
219			`-- String indexes`
220
221			`Low : Positive := Item'First;`
222			`High : Positive := Low + C_In_Default_Block - 1;`
223
224			`-- End of stream error detection`
225
226			`Last : Stream_Element_Offset := 0;`
227			`Sum : Stream_Element_Offset := 0;`
228
229			`begin`
230			`-- Step 1: If the string is too large, read in individual`
231			`-- chunks the size of the default block.`
232
233			`if Blocks > 0 then`
234			`declare`
235			`Block : Default_Block;`
236
237			`begin`
238			`for Counter in 1 .. Blocks loop`
239			`Read (Strm.all, Block, Last);`
240			`Item (Low .. High) := To_String_Block (Block);`
241
242			`Low := High + 1;`
243			`High := Low + C_In_Default_Block - 1;`
244			`Sum := Sum + Last;`
245			`Last := 0;`
246			`end loop;`
247			`end;`
248			`end if;`
249
250			`-- Step 2: Read in any remaining elements`
251
252			`if Rem_Size > 0 then`
253			`declare`
254			`subtype Rem_Block is Stream_Element_Array`
255			`(1 .. Stream_Element_Offset (Rem_Size / SE_Size));`
256
257			`subtype Rem_String_Block is`
258			`String_Type (1 .. Rem_Size / C_Size);`
259
260			`function To_Rem_String_Block is new`
261			`Ada.Unchecked_Conversion (Rem_Block, Rem_String_Block);`
262
263			`Block : Rem_Block;`
264
265			`begin`
266			`Read (Strm.all, Block, Last);`
267			`Item (Low .. Item'Last) := To_Rem_String_Block (Block);`
268
269			`Sum := Sum + Last;`
270			`end;`
271			`end if;`
272
273			`-- Step 3: Potential error detection. The sum of all the`
274			`-- chunks is less than we initially wanted to read. In other`
275			`-- words, the stream does not contain enough elements to fully`
276			`-- populate Item.`
277
278			`if (Integer (Sum) * SE_Size) / C_Size < Item'Length then`
279			`raise End_Error;`
280			`end if;`
281			`end;`
282
283			`-- Byte IO`
284
285			`else`
286			`declare`
287			`C : Character_Type;`
288
289			`begin`
290			`for Index in Item'First .. Item'Last loop`
291			`Character_Type'Read (Strm, C);`
292			`Item (Index) := C;`
293			`end loop;`
294			`end;`
295			`end if;`
296			`end Read;`
297
298			`-----------`
299			`-- Write --`
300			`-----------`
301
302			`procedure Write`
303			`(Strm : access Root_Stream_Type'Class;`
304			`Item : String_Type;`
305			`IO : IO_Kind)`
306			`is`
307			`begin`
308			`if Strm = null then`
309			`raise Constraint_Error;`
310			`end if;`
311
312			`-- Nothing to do if the input string is empty`
313
314			`if Item'Length = 0 then`
315			`return;`
316			`end if;`
317
318			`-- Block IO`
319
320			`if IO = Block_IO`
321			`and then Stream_Attributes.Block_IO_OK`
322			`then`
323			`declare`
324			`-- Determine the size in BITS of the block necessary to contain`
325			`-- the whole string.`
326
327			`Block_Size : constant Natural := Item'Length * C_Size;`
328
329			`-- Item can be larger than what the default block can store,`
330			`-- determine the number of whole writes necessary to output the`
331			`-- string.`
332
333			`Blocks : constant Natural := Block_Size / Default_Block_Size;`
334
335			`-- The size of Item may not be a multiple of the default block`
336			`-- size, determine the size of the remaining chunk.`
337
338			`Rem_Size : constant Natural :=`
339			`Block_Size mod Default_Block_Size;`
340
341			`-- String indexes`
342
343			`Low : Positive := Item'First;`
344			`High : Positive := Low + C_In_Default_Block - 1;`
345
346			`begin`
347			`-- Step 1: If the string is too large, write out individual`
348			`-- chunks the size of the default block.`
349
350			`for Counter in 1 .. Blocks loop`
351			`Write (Strm.all, To_Default_Block (Item (Low .. High)));`
352
353			`Low := High + 1;`
354			`High := Low + C_In_Default_Block - 1;`
355			`end loop;`
356
357			`-- Step 2: Write out any remaining elements`
358
359			`if Rem_Size > 0 then`
360			`declare`
361			`subtype Rem_Block is Stream_Element_Array`
362			`(1 .. Stream_Element_Offset (Rem_Size / SE_Size));`
363
364			`subtype Rem_String_Block is`
365			`String_Type (1 .. Rem_Size / C_Size);`
366
367			`function To_Rem_Block is new`
368			`Ada.Unchecked_Conversion (Rem_String_Block, Rem_Block);`
369
370			`begin`
371			`Write (Strm.all, To_Rem_Block (Item (Low .. Item'Last)));`
372			`end;`
373			`end if;`
374			`end;`
375
376			`-- Byte IO`
377
378			`else`
379			`for Index in Item'First .. Item'Last loop`
380			`Character_Type'Write (Strm, Item (Index));`
381			`end loop;`
382			`end if;`
383			`end Write;`
384			`end Stream_Ops_Internal;`
385
386			`-- Specific instantiations for all Ada string types`
387
388			`package String_Ops is`
389			`new Stream_Ops_Internal`
390			`(Character_Type => Character,`
391			`String_Type => String);`
392
393			`package Wide_String_Ops is`
394			`new Stream_Ops_Internal`
395			`(Character_Type => Wide_Character,`
396			`String_Type => Wide_String);`
397
398			`package Wide_Wide_String_Ops is`
399			`new Stream_Ops_Internal`
400			`(Character_Type => Wide_Wide_Character,`
401			`String_Type => Wide_Wide_String);`
402
403			`------------------`
404			`-- String_Input --`
405			`------------------`
406
407			`function String_Input`
408			`(Strm : access Ada.Streams.Root_Stream_Type'Class) return String`
409			`is`
410			`begin`
411			`return String_Ops.Input (Strm, Byte_IO);`
412			`end String_Input;`
413
414			`-------------------------`
415			`-- String_Input_Blk_IO --`
416			`-------------------------`
417
418			`function String_Input_Blk_IO`
419			`(Strm : access Ada.Streams.Root_Stream_Type'Class) return String`
420			`is`
421			`begin`
422			`return String_Ops.Input (Strm, Block_IO);`
423			`end String_Input_Blk_IO;`
424
425			`-------------------`
426			`-- String_Output --`
427			`-------------------`
428
429			`procedure String_Output`
430			`(Strm : access Ada.Streams.Root_Stream_Type'Class;`
431			`Item : String)`
432			`is`
433			`begin`
434			`String_Ops.Output (Strm, Item, Byte_IO);`
435			`end String_Output;`
436
437			`--------------------------`
438			`-- String_Output_Blk_IO --`
439			`--------------------------`
440
441			`procedure String_Output_Blk_IO`
442			`(Strm : access Ada.Streams.Root_Stream_Type'Class;`
443			`Item : String)`
444			`is`
445			`begin`
446			`String_Ops.Output (Strm, Item, Block_IO);`
447			`end String_Output_Blk_IO;`
448
449			`-----------------`
450			`-- String_Read --`
451			`-----------------`
452
453			`procedure String_Read`
454			`(Strm : access Ada.Streams.Root_Stream_Type'Class;`
455			`Item : out String)`
456			`is`
457			`begin`
458			`String_Ops.Read (Strm, Item, Byte_IO);`
459			`end String_Read;`
460
461			`------------------------`
462			`-- String_Read_Blk_IO --`
463			`------------------------`
464
465			`procedure String_Read_Blk_IO`
466			`(Strm : access Ada.Streams.Root_Stream_Type'Class;`
467			`Item : out String)`
468			`is`
469			`begin`
470			`String_Ops.Read (Strm, Item, Block_IO);`
471			`end String_Read_Blk_IO;`
472
473			`------------------`
474			`-- String_Write --`
475			`------------------`
476
477			`procedure String_Write`
478			`(Strm : access Ada.Streams.Root_Stream_Type'Class;`
479			`Item : String)`
480			`is`
481			`begin`
482			`String_Ops.Write (Strm, Item, Byte_IO);`
483			`end String_Write;`
484
485			`-------------------------`
486			`-- String_Write_Blk_IO --`
487			`-------------------------`
488
489			`procedure String_Write_Blk_IO`
490			`(Strm : access Ada.Streams.Root_Stream_Type'Class;`
491			`Item : String)`
492			`is`
493			`begin`
494			`String_Ops.Write (Strm, Item, Block_IO);`
495			`end String_Write_Blk_IO;`
496
497			`-----------------------`
498			`-- Wide_String_Input --`
499			`-----------------------`
500
501			`function Wide_String_Input`
502			`(Strm : access Ada.Streams.Root_Stream_Type'Class) return Wide_String`
503			`is`
504			`begin`
505			`return Wide_String_Ops.Input (Strm, Byte_IO);`
506			`end Wide_String_Input;`
507
508			`------------------------------`
509			`-- Wide_String_Input_Blk_IO --`
510			`------------------------------`
511
512			`function Wide_String_Input_Blk_IO`
513			`(Strm : access Ada.Streams.Root_Stream_Type'Class) return Wide_String`
514			`is`
515			`begin`
516			`return Wide_String_Ops.Input (Strm, Block_IO);`
517			`end Wide_String_Input_Blk_IO;`
518
519			`------------------------`
520			`-- Wide_String_Output --`
521			`------------------------`
522
523			`procedure Wide_String_Output`
524			`(Strm : access Ada.Streams.Root_Stream_Type'Class;`
525			`Item : Wide_String)`
526			`is`
527			`begin`
528			`Wide_String_Ops.Output (Strm, Item, Byte_IO);`
529			`end Wide_String_Output;`
530
531			`-------------------------------`
532			`-- Wide_String_Output_Blk_IO --`
533			`-------------------------------`
534
535			`procedure Wide_String_Output_Blk_IO`
536			`(Strm : access Ada.Streams.Root_Stream_Type'Class;`
537			`Item : Wide_String)`
538			`is`
539			`begin`
540			`Wide_String_Ops.Output (Strm, Item, Block_IO);`
541			`end Wide_String_Output_Blk_IO;`
542
543			`----------------------`
544			`-- Wide_String_Read --`
545			`----------------------`
546
547			`procedure Wide_String_Read`
548			`(Strm : access Ada.Streams.Root_Stream_Type'Class;`
549			`Item : out Wide_String)`
550			`is`
551			`begin`
552			`Wide_String_Ops.Read (Strm, Item, Byte_IO);`
553			`end Wide_String_Read;`
554
555			`-----------------------------`
556			`-- Wide_String_Read_Blk_IO --`
557			`-----------------------------`
558
559			`procedure Wide_String_Read_Blk_IO`
560			`(Strm : access Ada.Streams.Root_Stream_Type'Class;`
561			`Item : out Wide_String)`
562			`is`
563			`begin`
564			`Wide_String_Ops.Read (Strm, Item, Block_IO);`
565			`end Wide_String_Read_Blk_IO;`
566
567			`-----------------------`
568			`-- Wide_String_Write --`
569			`-----------------------`
570
571			`procedure Wide_String_Write`
572			`(Strm : access Ada.Streams.Root_Stream_Type'Class;`
573			`Item : Wide_String)`
574			`is`
575			`begin`
576			`Wide_String_Ops.Write (Strm, Item, Byte_IO);`
577			`end Wide_String_Write;`
578
579			`------------------------------`
580			`-- Wide_String_Write_Blk_IO --`
581			`------------------------------`
582
583			`procedure Wide_String_Write_Blk_IO`
584			`(Strm : access Ada.Streams.Root_Stream_Type'Class;`
585			`Item : Wide_String)`
586			`is`
587			`begin`
588			`Wide_String_Ops.Write (Strm, Item, Block_IO);`
589			`end Wide_String_Write_Blk_IO;`
590
591			`----------------------------`
592			`-- Wide_Wide_String_Input --`
593			`----------------------------`
594
595			`function Wide_Wide_String_Input`
596			`(Strm : access Ada.Streams.Root_Stream_Type'Class) return Wide_Wide_String`
597			`is`
598			`begin`
599			`return Wide_Wide_String_Ops.Input (Strm, Byte_IO);`
600			`end Wide_Wide_String_Input;`
601
602			`-----------------------------------`
603			`-- Wide_Wide_String_Input_Blk_IO --`
604			`-----------------------------------`
605
606			`function Wide_Wide_String_Input_Blk_IO`
607			`(Strm : access Ada.Streams.Root_Stream_Type'Class) return Wide_Wide_String`
608			`is`
609			`begin`
610			`return Wide_Wide_String_Ops.Input (Strm, Block_IO);`
611			`end Wide_Wide_String_Input_Blk_IO;`
612
613			`-----------------------------`
614			`-- Wide_Wide_String_Output --`
615			`-----------------------------`
616
617			`procedure Wide_Wide_String_Output`
618			`(Strm : access Ada.Streams.Root_Stream_Type'Class;`
619			`Item : Wide_Wide_String)`
620			`is`
621			`begin`
622			`Wide_Wide_String_Ops.Output (Strm, Item, Byte_IO);`
623			`end Wide_Wide_String_Output;`
624
625			`------------------------------------`
626			`-- Wide_Wide_String_Output_Blk_IO --`
627			`------------------------------------`
628
629			`procedure Wide_Wide_String_Output_Blk_IO`
630			`(Strm : access Ada.Streams.Root_Stream_Type'Class;`
631			`Item : Wide_Wide_String)`
632			`is`
633			`begin`
634			`Wide_Wide_String_Ops.Output (Strm, Item, Block_IO);`
635			`end Wide_Wide_String_Output_Blk_IO;`
636
637			`---------------------------`
638			`-- Wide_Wide_String_Read --`
639			`---------------------------`
640
641			`procedure Wide_Wide_String_Read`
642			`(Strm : access Ada.Streams.Root_Stream_Type'Class;`
643			`Item : out Wide_Wide_String)`
644			`is`
645			`begin`
646			`Wide_Wide_String_Ops.Read (Strm, Item, Byte_IO);`
647			`end Wide_Wide_String_Read;`
648
649			`----------------------------------`
650			`-- Wide_Wide_String_Read_Blk_IO --`
651			`----------------------------------`
652
653			`procedure Wide_Wide_String_Read_Blk_IO`
654			`(Strm : access Ada.Streams.Root_Stream_Type'Class;`
655			`Item : out Wide_Wide_String)`
656			`is`
657			`begin`
658			`Wide_Wide_String_Ops.Read (Strm, Item, Block_IO);`
659			`end Wide_Wide_String_Read_Blk_IO;`
660
661			`----------------------------`
662			`-- Wide_Wide_String_Write --`
663			`----------------------------`
664
665			`procedure Wide_Wide_String_Write`
666			`(Strm : access Ada.Streams.Root_Stream_Type'Class;`
667			`Item : Wide_Wide_String)`
668			`is`
669			`begin`
670			`Wide_Wide_String_Ops.Write (Strm, Item, Byte_IO);`
671			`end Wide_Wide_String_Write;`
672
673			`-----------------------------------`
674			`-- Wide_Wide_String_Write_Blk_IO --`
675			`-----------------------------------`
676
677			`procedure Wide_Wide_String_Write_Blk_IO`
678			`(Strm : access Ada.Streams.Root_Stream_Type'Class;`
679			`Item : Wide_Wide_String)`
680			`is`
681			`begin`
682			`Wide_Wide_String_Ops.Write (Strm, Item, Block_IO);`
683			`end Wide_Wide_String_Write_Blk_IO;`
684
685			`end System.Strings.Stream_Ops;`