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
;