1 ------------------------------------------------------------------------------
3 -- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --
5 -- S Y S T E M . S T R I N G S . S T R E A M _ O P S --
9 -- Copyright (C) 2008-2010, Free Software Foundation, Inc. --
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. --
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. --
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/>. --
27 -- GNAT was originally developed by the GNAT team at New York University. --
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
30 ------------------------------------------------------------------------------
34 with Ada.Streams; use Ada.Streams;
35 with Ada.Streams.Stream_IO; use Ada.Streams.Stream_IO;
36 with Ada.Unchecked_Conversion;
38 with System.Stream_Attributes; use System;
40 package body System.Strings.Stream_Ops is
42 -- The following type describes the low-level IO mechanism used in package
43 -- Stream_Ops_Internal.
45 type IO_Kind is (Byte_IO, Block_IO);
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.
53 type Character_Type is private;
54 type String_Type is array (Positive range <>) of Character_Type;
56 package Stream_Ops_Internal is
58 (Strm : access Root_Stream_Type'Class;
59 IO : IO_Kind) return String_Type;
62 (Strm : access Root_Stream_Type'Class;
67 (Strm : access Root_Stream_Type'Class;
68 Item : out String_Type;
72 (Strm : access Root_Stream_Type'Class;
75 end Stream_Ops_Internal;
77 -------------------------
78 -- Stream_Ops_Internal --
79 -------------------------
81 package body Stream_Ops_Internal is
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.
87 Default_Block_Size : constant := 512 * 8;
89 -- Shorthand notation for stream element and character sizes
91 C_Size : constant Integer := Character_Type'Size;
92 SE_Size : constant Integer := Stream_Element'Size;
94 -- The following constants describe the number of stream elements or
95 -- characters that can fit into a default block.
97 C_In_Default_Block : constant Integer := Default_Block_Size / C_Size;
98 SE_In_Default_Block : constant Integer := Default_Block_Size / SE_Size;
102 subtype Default_Block is Stream_Element_Array
103 (1 .. Stream_Element_Offset (SE_In_Default_Block));
105 subtype String_Block is String_Type (1 .. C_In_Default_Block);
107 -- Conversions to and from Default_Block
109 function To_Default_Block is
110 new Ada.Unchecked_Conversion (String_Block, Default_Block);
112 function To_String_Block is
113 new Ada.Unchecked_Conversion (Default_Block, String_Block);
120 (Strm : access Root_Stream_Type'Class;
121 IO : IO_Kind) return String_Type
125 raise Constraint_Error;
133 -- Read the bounds of the string
135 Positive'Read (Strm, Low);
136 Positive'Read (Strm, High);
139 Item : String_Type (Low .. High);
142 -- Read the character content of the string
144 Read (Strm, Item, IO);
156 (Strm : access Root_Stream_Type'Class;
162 raise Constraint_Error;
165 -- Write the bounds of the string
167 Positive'Write (Strm, Item'First);
168 Positive'Write (Strm, Item'Last);
170 -- Write the character content of the string
172 Write (Strm, Item, IO);
180 (Strm : access Root_Stream_Type'Class;
181 Item : out String_Type;
186 raise Constraint_Error;
189 -- Nothing to do if the desired string is empty
191 if Item'Length = 0 then
198 and then Stream_Attributes.Block_IO_OK
201 -- Determine the size in BITS of the block necessary to contain
204 Block_Size : constant Natural :=
205 (Item'Last - Item'First + 1) * C_Size;
207 -- Item can be larger than what the default block can store,
208 -- determine the number of whole reads necessary to read the
211 Blocks : constant Natural := Block_Size / Default_Block_Size;
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.
216 Rem_Size : constant Natural :=
217 Block_Size mod Default_Block_Size;
221 Low : Positive := Item'First;
222 High : Positive := Low + C_In_Default_Block - 1;
224 -- End of stream error detection
226 Last : Stream_Element_Offset := 0;
227 Sum : Stream_Element_Offset := 0;
230 -- Step 1: If the string is too large, read in individual
231 -- chunks the size of the default block.
235 Block : Default_Block;
238 for Counter in 1 .. Blocks loop
239 Read (Strm.all, Block, Last);
240 Item (Low .. High) := To_String_Block (Block);
243 High := Low + C_In_Default_Block - 1;
250 -- Step 2: Read in any remaining elements
254 subtype Rem_Block is Stream_Element_Array
255 (1 .. Stream_Element_Offset (Rem_Size / SE_Size));
257 subtype Rem_String_Block is
258 String_Type (1 .. Rem_Size / C_Size);
260 function To_Rem_String_Block is new
261 Ada.Unchecked_Conversion (Rem_Block, Rem_String_Block);
266 Read (Strm.all, Block, Last);
267 Item (Low .. Item'Last) := To_Rem_String_Block (Block);
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
278 if (Integer (Sum) * SE_Size) / C_Size < Item'Length then
290 for Index in Item'First .. Item'Last loop
291 Character_Type'Read (Strm, C);
303 (Strm : access Root_Stream_Type'Class;
309 raise Constraint_Error;
312 -- Nothing to do if the input string is empty
314 if Item'Length = 0 then
321 and then Stream_Attributes.Block_IO_OK
324 -- Determine the size in BITS of the block necessary to contain
327 Block_Size : constant Natural := Item'Length * C_Size;
329 -- Item can be larger than what the default block can store,
330 -- determine the number of whole writes necessary to output the
333 Blocks : constant Natural := Block_Size / Default_Block_Size;
335 -- The size of Item may not be a multiple of the default block
336 -- size, determine the size of the remaining chunk.
338 Rem_Size : constant Natural :=
339 Block_Size mod Default_Block_Size;
343 Low : Positive := Item'First;
344 High : Positive := Low + C_In_Default_Block - 1;
347 -- Step 1: If the string is too large, write out individual
348 -- chunks the size of the default block.
350 for Counter in 1 .. Blocks loop
351 Write (Strm.all, To_Default_Block (Item (Low .. High)));
354 High := Low + C_In_Default_Block - 1;
357 -- Step 2: Write out any remaining elements
361 subtype Rem_Block is Stream_Element_Array
362 (1 .. Stream_Element_Offset (Rem_Size / SE_Size));
364 subtype Rem_String_Block is
365 String_Type (1 .. Rem_Size / C_Size);
367 function To_Rem_Block is new
368 Ada.Unchecked_Conversion (Rem_String_Block, Rem_Block);
371 Write (Strm.all, To_Rem_Block (Item (Low .. Item'Last)));
379 for Index in Item'First .. Item'Last loop
380 Character_Type'Write (Strm, Item (Index));
384 end Stream_Ops_Internal;
386 -- Specific instantiations for all Ada string types
388 package String_Ops is
389 new Stream_Ops_Internal
390 (Character_Type => Character,
391 String_Type => String);
393 package Wide_String_Ops is
394 new Stream_Ops_Internal
395 (Character_Type => Wide_Character,
396 String_Type => Wide_String);
398 package Wide_Wide_String_Ops is
399 new Stream_Ops_Internal
400 (Character_Type => Wide_Wide_Character,
401 String_Type => Wide_Wide_String);
407 function String_Input
408 (Strm : access Ada.Streams.Root_Stream_Type'Class) return String
411 return String_Ops.Input (Strm, Byte_IO);
414 -------------------------
415 -- String_Input_Blk_IO --
416 -------------------------
418 function String_Input_Blk_IO
419 (Strm : access Ada.Streams.Root_Stream_Type'Class) return String
422 return String_Ops.Input (Strm, Block_IO);
423 end String_Input_Blk_IO;
429 procedure String_Output
430 (Strm : access Ada.Streams.Root_Stream_Type'Class;
434 String_Ops.Output (Strm, Item, Byte_IO);
437 --------------------------
438 -- String_Output_Blk_IO --
439 --------------------------
441 procedure String_Output_Blk_IO
442 (Strm : access Ada.Streams.Root_Stream_Type'Class;
446 String_Ops.Output (Strm, Item, Block_IO);
447 end String_Output_Blk_IO;
453 procedure String_Read
454 (Strm : access Ada.Streams.Root_Stream_Type'Class;
458 String_Ops.Read (Strm, Item, Byte_IO);
461 ------------------------
462 -- String_Read_Blk_IO --
463 ------------------------
465 procedure String_Read_Blk_IO
466 (Strm : access Ada.Streams.Root_Stream_Type'Class;
470 String_Ops.Read (Strm, Item, Block_IO);
471 end String_Read_Blk_IO;
477 procedure String_Write
478 (Strm : access Ada.Streams.Root_Stream_Type'Class;
482 String_Ops.Write (Strm, Item, Byte_IO);
485 -------------------------
486 -- String_Write_Blk_IO --
487 -------------------------
489 procedure String_Write_Blk_IO
490 (Strm : access Ada.Streams.Root_Stream_Type'Class;
494 String_Ops.Write (Strm, Item, Block_IO);
495 end String_Write_Blk_IO;
497 -----------------------
498 -- Wide_String_Input --
499 -----------------------
501 function Wide_String_Input
502 (Strm : access Ada.Streams.Root_Stream_Type'Class) return Wide_String
505 return Wide_String_Ops.Input (Strm, Byte_IO);
506 end Wide_String_Input;
508 ------------------------------
509 -- Wide_String_Input_Blk_IO --
510 ------------------------------
512 function Wide_String_Input_Blk_IO
513 (Strm : access Ada.Streams.Root_Stream_Type'Class) return Wide_String
516 return Wide_String_Ops.Input (Strm, Block_IO);
517 end Wide_String_Input_Blk_IO;
519 ------------------------
520 -- Wide_String_Output --
521 ------------------------
523 procedure Wide_String_Output
524 (Strm : access Ada.Streams.Root_Stream_Type'Class;
528 Wide_String_Ops.Output (Strm, Item, Byte_IO);
529 end Wide_String_Output;
531 -------------------------------
532 -- Wide_String_Output_Blk_IO --
533 -------------------------------
535 procedure Wide_String_Output_Blk_IO
536 (Strm : access Ada.Streams.Root_Stream_Type'Class;
540 Wide_String_Ops.Output (Strm, Item, Block_IO);
541 end Wide_String_Output_Blk_IO;
543 ----------------------
544 -- Wide_String_Read --
545 ----------------------
547 procedure Wide_String_Read
548 (Strm : access Ada.Streams.Root_Stream_Type'Class;
549 Item : out Wide_String)
552 Wide_String_Ops.Read (Strm, Item, Byte_IO);
553 end Wide_String_Read;
555 -----------------------------
556 -- Wide_String_Read_Blk_IO --
557 -----------------------------
559 procedure Wide_String_Read_Blk_IO
560 (Strm : access Ada.Streams.Root_Stream_Type'Class;
561 Item : out Wide_String)
564 Wide_String_Ops.Read (Strm, Item, Block_IO);
565 end Wide_String_Read_Blk_IO;
567 -----------------------
568 -- Wide_String_Write --
569 -----------------------
571 procedure Wide_String_Write
572 (Strm : access Ada.Streams.Root_Stream_Type'Class;
576 Wide_String_Ops.Write (Strm, Item, Byte_IO);
577 end Wide_String_Write;
579 ------------------------------
580 -- Wide_String_Write_Blk_IO --
581 ------------------------------
583 procedure Wide_String_Write_Blk_IO
584 (Strm : access Ada.Streams.Root_Stream_Type'Class;
588 Wide_String_Ops.Write (Strm, Item, Block_IO);
589 end Wide_String_Write_Blk_IO;
591 ----------------------------
592 -- Wide_Wide_String_Input --
593 ----------------------------
595 function Wide_Wide_String_Input
596 (Strm : access Ada.Streams.Root_Stream_Type'Class) return Wide_Wide_String
599 return Wide_Wide_String_Ops.Input (Strm, Byte_IO);
600 end Wide_Wide_String_Input;
602 -----------------------------------
603 -- Wide_Wide_String_Input_Blk_IO --
604 -----------------------------------
606 function Wide_Wide_String_Input_Blk_IO
607 (Strm : access Ada.Streams.Root_Stream_Type'Class) return Wide_Wide_String
610 return Wide_Wide_String_Ops.Input (Strm, Block_IO);
611 end Wide_Wide_String_Input_Blk_IO;
613 -----------------------------
614 -- Wide_Wide_String_Output --
615 -----------------------------
617 procedure Wide_Wide_String_Output
618 (Strm : access Ada.Streams.Root_Stream_Type'Class;
619 Item : Wide_Wide_String)
622 Wide_Wide_String_Ops.Output (Strm, Item, Byte_IO);
623 end Wide_Wide_String_Output;
625 ------------------------------------
626 -- Wide_Wide_String_Output_Blk_IO --
627 ------------------------------------
629 procedure Wide_Wide_String_Output_Blk_IO
630 (Strm : access Ada.Streams.Root_Stream_Type'Class;
631 Item : Wide_Wide_String)
634 Wide_Wide_String_Ops.Output (Strm, Item, Block_IO);
635 end Wide_Wide_String_Output_Blk_IO;
637 ---------------------------
638 -- Wide_Wide_String_Read --
639 ---------------------------
641 procedure Wide_Wide_String_Read
642 (Strm : access Ada.Streams.Root_Stream_Type'Class;
643 Item : out Wide_Wide_String)
646 Wide_Wide_String_Ops.Read (Strm, Item, Byte_IO);
647 end Wide_Wide_String_Read;
649 ----------------------------------
650 -- Wide_Wide_String_Read_Blk_IO --
651 ----------------------------------
653 procedure Wide_Wide_String_Read_Blk_IO
654 (Strm : access Ada.Streams.Root_Stream_Type'Class;
655 Item : out Wide_Wide_String)
658 Wide_Wide_String_Ops.Read (Strm, Item, Block_IO);
659 end Wide_Wide_String_Read_Blk_IO;
661 ----------------------------
662 -- Wide_Wide_String_Write --
663 ----------------------------
665 procedure Wide_Wide_String_Write
666 (Strm : access Ada.Streams.Root_Stream_Type'Class;
667 Item : Wide_Wide_String)
670 Wide_Wide_String_Ops.Write (Strm, Item, Byte_IO);
671 end Wide_Wide_String_Write;
673 -----------------------------------
674 -- Wide_Wide_String_Write_Blk_IO --
675 -----------------------------------
677 procedure Wide_Wide_String_Write_Blk_IO
678 (Strm : access Ada.Streams.Root_Stream_Type'Class;
679 Item : Wide_Wide_String)
682 Wide_Wide_String_Ops.Write (Strm, Item, Block_IO);
683 end Wide_Wide_String_Write_Blk_IO;
685 end System.Strings.Stream_Ops;