OpenCores
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

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;

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.