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-2013, 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 ------------------------------------------------------------------------------
32 pragma Compiler_Unit_Warning
;
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
; use System
;
39 with System
.Storage_Elements
; use System
.Storage_Elements
;
40 with System
.Stream_Attributes
;
42 package body System
.Strings
.Stream_Ops
is
44 -- The following type describes the low-level IO mechanism used in package
45 -- Stream_Ops_Internal.
47 type IO_Kind
is (Byte_IO
, Block_IO
);
49 -- The following package provides an IO framework for strings. Depending
50 -- on the version of System.Stream_Attributes as well as the size of
51 -- formal parameter Element_Type, the package will either utilize block
52 -- IO or element-by-element IO.
55 type Element_Type
is private;
56 type Index_Type
is range <>;
57 type Array_Type
is array (Index_Type
range <>) of Element_Type
;
59 package Stream_Ops_Internal
is
61 (Strm
: access Root_Stream_Type
'Class;
62 IO
: IO_Kind
) return Array_Type
;
65 (Strm
: access Root_Stream_Type
'Class;
70 (Strm
: access Root_Stream_Type
'Class;
71 Item
: out Array_Type
;
75 (Strm
: access Root_Stream_Type
'Class;
78 end Stream_Ops_Internal
;
80 -------------------------
81 -- Stream_Ops_Internal --
82 -------------------------
84 package body Stream_Ops_Internal
is
86 -- The following value represents the number of BITS allocated for the
87 -- default block used in string IO. The sizes of all other types are
88 -- calculated relative to this value.
90 Default_Block_Size
: constant := 512 * 8;
92 -- Shorthand notation for stream element and element type sizes
94 ET_Size
: constant Integer := Element_Type
'Size;
95 SE_Size
: constant Integer := Stream_Element
'Size;
97 -- The following constants describe the number of array elements or
98 -- stream elements that can fit into a default block.
100 AE_In_Default_Block
: constant Index_Type
:=
101 Index_Type
(Default_Block_Size
/ ET_Size
);
102 -- Number of array elements in a default block
104 SE_In_Default_Block
: constant Integer := Default_Block_Size
/ SE_Size
;
105 -- Number of storage elements in a default block
109 subtype Default_Block
is Stream_Element_Array
110 (1 .. Stream_Element_Offset
(SE_In_Default_Block
));
112 subtype Array_Block
is
113 Array_Type
(Index_Type
range 1 .. AE_In_Default_Block
);
115 -- Conversions to and from Default_Block
117 function To_Default_Block
is
118 new Ada
.Unchecked_Conversion
(Array_Block
, Default_Block
);
120 function To_Array_Block
is
121 new Ada
.Unchecked_Conversion
(Default_Block
, Array_Block
);
128 (Strm
: access Root_Stream_Type
'Class;
129 IO
: IO_Kind
) return Array_Type
133 raise Constraint_Error
;
141 -- Read the bounds of the string
143 Index_Type
'Read (Strm
, Low
);
144 Index_Type
'Read (Strm
, High
);
146 -- Read the character content of the string
149 Item
: Array_Type
(Low
.. High
);
151 Read
(Strm
, Item
, IO
);
162 (Strm
: access Root_Stream_Type
'Class;
168 raise Constraint_Error
;
171 -- Write the bounds of the string
173 Index_Type
'Write (Strm
, Item
'First);
174 Index_Type
'Write (Strm
, Item
'Last);
176 -- Write the character content of the string
178 Write
(Strm
, Item
, IO
);
186 (Strm
: access Root_Stream_Type
'Class;
187 Item
: out Array_Type
;
192 raise Constraint_Error
;
195 -- Nothing to do if the desired string is empty
197 if Item
'Length = 0 then
203 if IO
= Block_IO
and then Stream_Attributes
.Block_IO_OK
then
205 -- Determine the size in BITS of the block necessary to contain
208 Block_Size
: constant Natural :=
209 Integer (Item
'Last - Item
'First + 1) * ET_Size
;
211 -- Item can be larger than what the default block can store,
212 -- determine the number of whole reads necessary to read the
215 Blocks
: constant Natural := Block_Size
/ Default_Block_Size
;
217 -- The size of Item may not be a multiple of the default block
218 -- size, determine the size of the remaining chunk in BITS.
220 Rem_Size
: constant Natural :=
221 Block_Size
mod Default_Block_Size
;
225 Low
: Index_Type
:= Item
'First;
226 High
: Index_Type
:= Low
+ AE_In_Default_Block
- 1;
228 -- End of stream error detection
230 Last
: Stream_Element_Offset
:= 0;
231 Sum
: Stream_Element_Offset
:= 0;
234 -- Step 1: If the string is too large, read in individual
235 -- chunks the size of the default block.
239 Block
: Default_Block
;
242 for Counter
in 1 .. Blocks
loop
243 Read
(Strm
.all, Block
, Last
);
244 Item
(Low
.. High
) := To_Array_Block
(Block
);
247 High
:= Low
+ AE_In_Default_Block
- 1;
254 -- Step 2: Read in any remaining elements
258 subtype Rem_Block
is Stream_Element_Array
259 (1 .. Stream_Element_Offset
(Rem_Size
/ SE_Size
));
261 subtype Rem_Array_Block
is
262 Array_Type
(Index_Type
range
263 1 .. Index_Type
(Rem_Size
/ ET_Size
));
265 function To_Rem_Array_Block
is new
266 Ada
.Unchecked_Conversion
(Rem_Block
, Rem_Array_Block
);
271 Read
(Strm
.all, Block
, Last
);
272 Item
(Low
.. Item
'Last) := To_Rem_Array_Block
(Block
);
278 -- Step 3: Potential error detection. The sum of all the
279 -- chunks is less than we initially wanted to read. In other
280 -- words, the stream does not contain enough elements to fully
283 if (Integer (Sum
) * SE_Size
) / ET_Size
< Item
'Length then
294 for Index
in Item
'First .. Item
'Last loop
295 Element_Type
'Read (Strm
, E
);
307 (Strm
: access Root_Stream_Type
'Class;
313 raise Constraint_Error
;
316 -- Nothing to do if the input string is empty
318 if Item
'Length = 0 then
324 if IO
= Block_IO
and then Stream_Attributes
.Block_IO_OK
then
326 -- Determine the size in BITS of the block necessary to contain
329 Block_Size
: constant Natural := Item
'Length * ET_Size
;
331 -- Item can be larger than what the default block can store,
332 -- determine the number of whole writes necessary to output the
335 Blocks
: constant Natural := Block_Size
/ Default_Block_Size
;
337 -- The size of Item may not be a multiple of the default block
338 -- size, determine the size of the remaining chunk.
340 Rem_Size
: constant Natural :=
341 Block_Size
mod Default_Block_Size
;
345 Low
: Index_Type
:= Item
'First;
346 High
: Index_Type
:= Low
+ AE_In_Default_Block
- 1;
349 -- Step 1: If the string is too large, write out individual
350 -- chunks the size of the default block.
352 for Counter
in 1 .. Blocks
loop
353 Write
(Strm
.all, To_Default_Block
(Item
(Low
.. High
)));
355 High
:= Low
+ AE_In_Default_Block
- 1;
358 -- Step 2: Write out any remaining elements
362 subtype Rem_Block
is Stream_Element_Array
363 (1 .. Stream_Element_Offset
(Rem_Size
/ SE_Size
));
365 subtype Rem_Array_Block
is
366 Array_Type
(Index_Type
range
367 1 .. Index_Type
(Rem_Size
/ ET_Size
));
369 function To_Rem_Block
is new
370 Ada
.Unchecked_Conversion
(Rem_Array_Block
, Rem_Block
);
373 Write
(Strm
.all, To_Rem_Block
(Item
(Low
.. Item
'Last)));
381 for Index
in Item
'First .. Item
'Last loop
382 Element_Type
'Write (Strm
, Item
(Index
));
386 end Stream_Ops_Internal
;
388 -- Specific instantiations for all Ada array types handled
390 package Storage_Array_Ops
is
391 new Stream_Ops_Internal
392 (Element_Type
=> Storage_Element
,
393 Index_Type
=> Storage_Offset
,
394 Array_Type
=> Storage_Array
);
396 package Stream_Element_Array_Ops
is
397 new Stream_Ops_Internal
398 (Element_Type
=> Stream_Element
,
399 Index_Type
=> Stream_Element_Offset
,
400 Array_Type
=> Stream_Element_Array
);
402 package String_Ops
is
403 new Stream_Ops_Internal
404 (Element_Type
=> Character,
405 Index_Type
=> Positive,
406 Array_Type
=> String);
408 package Wide_String_Ops
is
409 new Stream_Ops_Internal
410 (Element_Type
=> Wide_Character,
411 Index_Type
=> Positive,
412 Array_Type
=> Wide_String);
414 package Wide_Wide_String_Ops
is
415 new Stream_Ops_Internal
416 (Element_Type
=> Wide_Wide_Character
,
417 Index_Type
=> Positive,
418 Array_Type
=> Wide_Wide_String
);
420 -------------------------
421 -- Storage_Array_Input --
422 -------------------------
424 function Storage_Array_Input
425 (Strm
: access Ada
.Streams
.Root_Stream_Type
'Class) return Storage_Array
428 return Storage_Array_Ops
.Input
(Strm
, Byte_IO
);
429 end Storage_Array_Input
;
431 --------------------------------
432 -- Storage_Array_Input_Blk_IO --
433 --------------------------------
435 function Storage_Array_Input_Blk_IO
436 (Strm
: access Ada
.Streams
.Root_Stream_Type
'Class) return Storage_Array
439 return Storage_Array_Ops
.Input
(Strm
, Block_IO
);
440 end Storage_Array_Input_Blk_IO
;
442 --------------------------
443 -- Storage_Array_Output --
444 --------------------------
446 procedure Storage_Array_Output
447 (Strm
: access Ada
.Streams
.Root_Stream_Type
'Class;
448 Item
: Storage_Array
)
451 Storage_Array_Ops
.Output
(Strm
, Item
, Byte_IO
);
452 end Storage_Array_Output
;
454 ---------------------------------
455 -- Storage_Array_Output_Blk_IO --
456 ---------------------------------
458 procedure Storage_Array_Output_Blk_IO
459 (Strm
: access Ada
.Streams
.Root_Stream_Type
'Class;
460 Item
: Storage_Array
)
463 Storage_Array_Ops
.Output
(Strm
, Item
, Block_IO
);
464 end Storage_Array_Output_Blk_IO
;
466 ------------------------
467 -- Storage_Array_Read --
468 ------------------------
470 procedure Storage_Array_Read
471 (Strm
: access Ada
.Streams
.Root_Stream_Type
'Class;
472 Item
: out Storage_Array
)
475 Storage_Array_Ops
.Read
(Strm
, Item
, Byte_IO
);
476 end Storage_Array_Read
;
478 -------------------------------
479 -- Storage_Array_Read_Blk_IO --
480 -------------------------------
482 procedure Storage_Array_Read_Blk_IO
483 (Strm
: access Ada
.Streams
.Root_Stream_Type
'Class;
484 Item
: out Storage_Array
)
487 Storage_Array_Ops
.Read
(Strm
, Item
, Block_IO
);
488 end Storage_Array_Read_Blk_IO
;
490 -------------------------
491 -- Storage_Array_Write --
492 -------------------------
494 procedure Storage_Array_Write
495 (Strm
: access Ada
.Streams
.Root_Stream_Type
'Class;
496 Item
: Storage_Array
)
499 Storage_Array_Ops
.Write
(Strm
, Item
, Byte_IO
);
500 end Storage_Array_Write
;
502 --------------------------------
503 -- Storage_Array_Write_Blk_IO --
504 --------------------------------
506 procedure Storage_Array_Write_Blk_IO
507 (Strm
: access Ada
.Streams
.Root_Stream_Type
'Class;
508 Item
: Storage_Array
)
511 Storage_Array_Ops
.Write
(Strm
, Item
, Block_IO
);
512 end Storage_Array_Write_Blk_IO
;
514 --------------------------------
515 -- Stream_Element_Array_Input --
516 --------------------------------
518 function Stream_Element_Array_Input
519 (Strm
: access Ada
.Streams
.Root_Stream_Type
'Class)
520 return Stream_Element_Array
523 return Stream_Element_Array_Ops
.Input
(Strm
, Byte_IO
);
524 end Stream_Element_Array_Input
;
526 ---------------------------------------
527 -- Stream_Element_Array_Input_Blk_IO --
528 ---------------------------------------
530 function Stream_Element_Array_Input_Blk_IO
531 (Strm
: access Ada
.Streams
.Root_Stream_Type
'Class)
532 return Stream_Element_Array
535 return Stream_Element_Array_Ops
.Input
(Strm
, Block_IO
);
536 end Stream_Element_Array_Input_Blk_IO
;
538 ---------------------------------
539 -- Stream_Element_Array_Output --
540 ---------------------------------
542 procedure Stream_Element_Array_Output
543 (Strm
: access Ada
.Streams
.Root_Stream_Type
'Class;
544 Item
: Stream_Element_Array
)
547 Stream_Element_Array_Ops
.Output
(Strm
, Item
, Byte_IO
);
548 end Stream_Element_Array_Output
;
550 ----------------------------------------
551 -- Stream_Element_Array_Output_Blk_IO --
552 ----------------------------------------
554 procedure Stream_Element_Array_Output_Blk_IO
555 (Strm
: access Ada
.Streams
.Root_Stream_Type
'Class;
556 Item
: Stream_Element_Array
)
559 Stream_Element_Array_Ops
.Output
(Strm
, Item
, Block_IO
);
560 end Stream_Element_Array_Output_Blk_IO
;
562 -------------------------------
563 -- Stream_Element_Array_Read --
564 -------------------------------
566 procedure Stream_Element_Array_Read
567 (Strm
: access Ada
.Streams
.Root_Stream_Type
'Class;
568 Item
: out Stream_Element_Array
)
571 Stream_Element_Array_Ops
.Read
(Strm
, Item
, Byte_IO
);
572 end Stream_Element_Array_Read
;
574 --------------------------------------
575 -- Stream_Element_Array_Read_Blk_IO --
576 --------------------------------------
578 procedure Stream_Element_Array_Read_Blk_IO
579 (Strm
: access Ada
.Streams
.Root_Stream_Type
'Class;
580 Item
: out Stream_Element_Array
)
583 Stream_Element_Array_Ops
.Read
(Strm
, Item
, Block_IO
);
584 end Stream_Element_Array_Read_Blk_IO
;
586 --------------------------------
587 -- Stream_Element_Array_Write --
588 --------------------------------
590 procedure Stream_Element_Array_Write
591 (Strm
: access Ada
.Streams
.Root_Stream_Type
'Class;
592 Item
: Stream_Element_Array
)
595 Stream_Element_Array_Ops
.Write
(Strm
, Item
, Byte_IO
);
596 end Stream_Element_Array_Write
;
598 ---------------------------------------
599 -- Stream_Element_Array_Write_Blk_IO --
600 ---------------------------------------
602 procedure Stream_Element_Array_Write_Blk_IO
603 (Strm
: access Ada
.Streams
.Root_Stream_Type
'Class;
604 Item
: Stream_Element_Array
)
607 Stream_Element_Array_Ops
.Write
(Strm
, Item
, Block_IO
);
608 end Stream_Element_Array_Write_Blk_IO
;
614 function String_Input
615 (Strm
: access Ada
.Streams
.Root_Stream_Type
'Class) return String
618 return String_Ops
.Input
(Strm
, Byte_IO
);
621 -------------------------
622 -- String_Input_Blk_IO --
623 -------------------------
625 function String_Input_Blk_IO
626 (Strm
: access Ada
.Streams
.Root_Stream_Type
'Class) return String
629 return String_Ops
.Input
(Strm
, Block_IO
);
630 end String_Input_Blk_IO
;
636 procedure String_Output
637 (Strm
: access Ada
.Streams
.Root_Stream_Type
'Class;
641 String_Ops
.Output
(Strm
, Item
, Byte_IO
);
644 --------------------------
645 -- String_Output_Blk_IO --
646 --------------------------
648 procedure String_Output_Blk_IO
649 (Strm
: access Ada
.Streams
.Root_Stream_Type
'Class;
653 String_Ops
.Output
(Strm
, Item
, Block_IO
);
654 end String_Output_Blk_IO
;
660 procedure String_Read
661 (Strm
: access Ada
.Streams
.Root_Stream_Type
'Class;
665 String_Ops
.Read
(Strm
, Item
, Byte_IO
);
668 ------------------------
669 -- String_Read_Blk_IO --
670 ------------------------
672 procedure String_Read_Blk_IO
673 (Strm
: access Ada
.Streams
.Root_Stream_Type
'Class;
677 String_Ops
.Read
(Strm
, Item
, Block_IO
);
678 end String_Read_Blk_IO
;
684 procedure String_Write
685 (Strm
: access Ada
.Streams
.Root_Stream_Type
'Class;
689 String_Ops
.Write
(Strm
, Item
, Byte_IO
);
692 -------------------------
693 -- String_Write_Blk_IO --
694 -------------------------
696 procedure String_Write_Blk_IO
697 (Strm
: access Ada
.Streams
.Root_Stream_Type
'Class;
701 String_Ops
.Write
(Strm
, Item
, Block_IO
);
702 end String_Write_Blk_IO
;
704 -----------------------
705 -- Wide_String_Input --
706 -----------------------
708 function Wide_String_Input
709 (Strm
: access Ada
.Streams
.Root_Stream_Type
'Class) return Wide_String
712 return Wide_String_Ops
.Input
(Strm
, Byte_IO
);
713 end Wide_String_Input
;
715 ------------------------------
716 -- Wide_String_Input_Blk_IO --
717 ------------------------------
719 function Wide_String_Input_Blk_IO
720 (Strm
: access Ada
.Streams
.Root_Stream_Type
'Class) return Wide_String
723 return Wide_String_Ops
.Input
(Strm
, Block_IO
);
724 end Wide_String_Input_Blk_IO
;
726 ------------------------
727 -- Wide_String_Output --
728 ------------------------
730 procedure Wide_String_Output
731 (Strm
: access Ada
.Streams
.Root_Stream_Type
'Class;
735 Wide_String_Ops
.Output
(Strm
, Item
, Byte_IO
);
736 end Wide_String_Output
;
738 -------------------------------
739 -- Wide_String_Output_Blk_IO --
740 -------------------------------
742 procedure Wide_String_Output_Blk_IO
743 (Strm
: access Ada
.Streams
.Root_Stream_Type
'Class;
747 Wide_String_Ops
.Output
(Strm
, Item
, Block_IO
);
748 end Wide_String_Output_Blk_IO
;
750 ----------------------
751 -- Wide_String_Read --
752 ----------------------
754 procedure Wide_String_Read
755 (Strm
: access Ada
.Streams
.Root_Stream_Type
'Class;
756 Item
: out Wide_String)
759 Wide_String_Ops
.Read
(Strm
, Item
, Byte_IO
);
760 end Wide_String_Read
;
762 -----------------------------
763 -- Wide_String_Read_Blk_IO --
764 -----------------------------
766 procedure Wide_String_Read_Blk_IO
767 (Strm
: access Ada
.Streams
.Root_Stream_Type
'Class;
768 Item
: out Wide_String)
771 Wide_String_Ops
.Read
(Strm
, Item
, Block_IO
);
772 end Wide_String_Read_Blk_IO
;
774 -----------------------
775 -- Wide_String_Write --
776 -----------------------
778 procedure Wide_String_Write
779 (Strm
: access Ada
.Streams
.Root_Stream_Type
'Class;
783 Wide_String_Ops
.Write
(Strm
, Item
, Byte_IO
);
784 end Wide_String_Write
;
786 ------------------------------
787 -- Wide_String_Write_Blk_IO --
788 ------------------------------
790 procedure Wide_String_Write_Blk_IO
791 (Strm
: access Ada
.Streams
.Root_Stream_Type
'Class;
795 Wide_String_Ops
.Write
(Strm
, Item
, Block_IO
);
796 end Wide_String_Write_Blk_IO
;
798 ----------------------------
799 -- Wide_Wide_String_Input --
800 ----------------------------
802 function Wide_Wide_String_Input
803 (Strm
: access Ada
.Streams
.Root_Stream_Type
'Class) return Wide_Wide_String
806 return Wide_Wide_String_Ops
.Input
(Strm
, Byte_IO
);
807 end Wide_Wide_String_Input
;
809 -----------------------------------
810 -- Wide_Wide_String_Input_Blk_IO --
811 -----------------------------------
813 function Wide_Wide_String_Input_Blk_IO
814 (Strm
: access Ada
.Streams
.Root_Stream_Type
'Class) return Wide_Wide_String
817 return Wide_Wide_String_Ops
.Input
(Strm
, Block_IO
);
818 end Wide_Wide_String_Input_Blk_IO
;
820 -----------------------------
821 -- Wide_Wide_String_Output --
822 -----------------------------
824 procedure Wide_Wide_String_Output
825 (Strm
: access Ada
.Streams
.Root_Stream_Type
'Class;
826 Item
: Wide_Wide_String
)
829 Wide_Wide_String_Ops
.Output
(Strm
, Item
, Byte_IO
);
830 end Wide_Wide_String_Output
;
832 ------------------------------------
833 -- Wide_Wide_String_Output_Blk_IO --
834 ------------------------------------
836 procedure Wide_Wide_String_Output_Blk_IO
837 (Strm
: access Ada
.Streams
.Root_Stream_Type
'Class;
838 Item
: Wide_Wide_String
)
841 Wide_Wide_String_Ops
.Output
(Strm
, Item
, Block_IO
);
842 end Wide_Wide_String_Output_Blk_IO
;
844 ---------------------------
845 -- Wide_Wide_String_Read --
846 ---------------------------
848 procedure Wide_Wide_String_Read
849 (Strm
: access Ada
.Streams
.Root_Stream_Type
'Class;
850 Item
: out Wide_Wide_String
)
853 Wide_Wide_String_Ops
.Read
(Strm
, Item
, Byte_IO
);
854 end Wide_Wide_String_Read
;
856 ----------------------------------
857 -- Wide_Wide_String_Read_Blk_IO --
858 ----------------------------------
860 procedure Wide_Wide_String_Read_Blk_IO
861 (Strm
: access Ada
.Streams
.Root_Stream_Type
'Class;
862 Item
: out Wide_Wide_String
)
865 Wide_Wide_String_Ops
.Read
(Strm
, Item
, Block_IO
);
866 end Wide_Wide_String_Read_Blk_IO
;
868 ----------------------------
869 -- Wide_Wide_String_Write --
870 ----------------------------
872 procedure Wide_Wide_String_Write
873 (Strm
: access Ada
.Streams
.Root_Stream_Type
'Class;
874 Item
: Wide_Wide_String
)
877 Wide_Wide_String_Ops
.Write
(Strm
, Item
, Byte_IO
);
878 end Wide_Wide_String_Write
;
880 -----------------------------------
881 -- Wide_Wide_String_Write_Blk_IO --
882 -----------------------------------
884 procedure Wide_Wide_String_Write_Blk_IO
885 (Strm
: access Ada
.Streams
.Root_Stream_Type
'Class;
886 Item
: Wide_Wide_String
)
889 Wide_Wide_String_Ops
.Write
(Strm
, Item
, Block_IO
);
890 end Wide_Wide_String_Write_Blk_IO
;
892 end System
.Strings
.Stream_Ops
;