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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [ada/] [a-stwifi.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 COMPONENTS                         --
4
--                                                                          --
5
--               A D A . S T R I N G S . W I D E _ F I X E D                --
6
--                                                                          --
7
--                                 B o d y                                  --
8
--                                                                          --
9
--          Copyright (C) 1992-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
with Ada.Strings.Wide_Maps;   use Ada.Strings.Wide_Maps;
33
with Ada.Strings.Wide_Search;
34
 
35
package body Ada.Strings.Wide_Fixed is
36
 
37
   ------------------------
38
   -- Search Subprograms --
39
   ------------------------
40
 
41
   function Index
42
     (Source  : Wide_String;
43
      Pattern : Wide_String;
44
      Going   : Direction := Forward;
45
      Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity)
46
      return Natural
47
   renames Ada.Strings.Wide_Search.Index;
48
 
49
   function Index
50
     (Source  : Wide_String;
51
      Pattern : Wide_String;
52
      Going   : Direction := Forward;
53
      Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural
54
   renames Ada.Strings.Wide_Search.Index;
55
 
56
   function Index
57
     (Source : Wide_String;
58
      Set    : Wide_Maps.Wide_Character_Set;
59
      Test   : Membership := Inside;
60
      Going  : Direction  := Forward) return Natural
61
   renames Ada.Strings.Wide_Search.Index;
62
 
63
   function Index
64
     (Source  : Wide_String;
65
      Pattern : Wide_String;
66
      From    : Positive;
67
      Going   : Direction := Forward;
68
      Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity)
69
      return Natural
70
   renames Ada.Strings.Wide_Search.Index;
71
 
72
   function Index
73
     (Source  : Wide_String;
74
      Pattern : Wide_String;
75
      From    : Positive;
76
      Going   : Direction := Forward;
77
      Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural
78
   renames Ada.Strings.Wide_Search.Index;
79
 
80
   function Index
81
     (Source  : Wide_String;
82
      Set     : Wide_Maps.Wide_Character_Set;
83
      From    : Positive;
84
      Test    : Membership := Inside;
85
      Going   : Direction := Forward) return Natural
86
   renames Ada.Strings.Wide_Search.Index;
87
 
88
   function Index_Non_Blank
89
     (Source : Wide_String;
90
      Going  : Direction := Forward) return Natural
91
   renames Ada.Strings.Wide_Search.Index_Non_Blank;
92
 
93
   function Index_Non_Blank
94
     (Source : Wide_String;
95
      From   : Positive;
96
      Going  : Direction := Forward) return Natural
97
   renames Ada.Strings.Wide_Search.Index_Non_Blank;
98
 
99
   function Count
100
     (Source  : Wide_String;
101
      Pattern : Wide_String;
102
      Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity)
103
      return Natural
104
   renames Ada.Strings.Wide_Search.Count;
105
 
106
   function Count
107
     (Source  : Wide_String;
108
      Pattern : Wide_String;
109
      Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural
110
   renames Ada.Strings.Wide_Search.Count;
111
 
112
   function Count
113
     (Source : Wide_String;
114
      Set    : Wide_Maps.Wide_Character_Set) return Natural
115
   renames Ada.Strings.Wide_Search.Count;
116
 
117
   procedure Find_Token
118
     (Source : Wide_String;
119
      Set    : Wide_Maps.Wide_Character_Set;
120
      From   : Positive;
121
      Test   : Membership;
122
      First  : out Positive;
123
      Last   : out Natural)
124
   renames Ada.Strings.Wide_Search.Find_Token;
125
 
126
   procedure Find_Token
127
     (Source : Wide_String;
128
      Set    : Wide_Maps.Wide_Character_Set;
129
      Test   : Membership;
130
      First  : out Positive;
131
      Last   : out Natural)
132
   renames Ada.Strings.Wide_Search.Find_Token;
133
 
134
   ---------
135
   -- "*" --
136
   ---------
137
 
138
   function "*"
139
     (Left  : Natural;
140
      Right : Wide_Character) return Wide_String
141
   is
142
      Result : Wide_String (1 .. Left);
143
 
144
   begin
145
      for J in Result'Range loop
146
         Result (J) := Right;
147
      end loop;
148
 
149
      return Result;
150
   end "*";
151
 
152
   function "*"
153
     (Left  : Natural;
154
      Right : Wide_String) return Wide_String
155
   is
156
      Result : Wide_String (1 .. Left * Right'Length);
157
      Ptr    : Integer := 1;
158
 
159
   begin
160
      for J in 1 .. Left loop
161
         Result (Ptr .. Ptr + Right'Length - 1) := Right;
162
         Ptr := Ptr + Right'Length;
163
      end loop;
164
 
165
      return Result;
166
   end "*";
167
 
168
   ------------
169
   -- Delete --
170
   ------------
171
 
172
   function Delete
173
     (Source  : Wide_String;
174
      From    : Positive;
175
      Through : Natural) return Wide_String
176
   is
177
   begin
178
      if From not in Source'Range
179
        or else Through > Source'Last
180
      then
181
         raise Index_Error;
182
 
183
      elsif From > Through then
184
         return Source;
185
 
186
      else
187
         declare
188
            Len    : constant Integer := Source'Length - (Through - From + 1);
189
            Result : constant
190
                       Wide_String (Source'First .. Source'First + Len - 1) :=
191
                         Source (Source'First .. From - 1) &
192
                         Source (Through + 1 .. Source'Last);
193
         begin
194
            return Result;
195
         end;
196
      end if;
197
   end Delete;
198
 
199
   procedure Delete
200
     (Source  : in out Wide_String;
201
      From    : Positive;
202
      Through : Natural;
203
      Justify : Alignment := Left;
204
      Pad     : Wide_Character := Wide_Space)
205
   is
206
   begin
207
      Move (Source  => Delete (Source, From, Through),
208
            Target  => Source,
209
            Justify => Justify,
210
            Pad     => Pad);
211
   end Delete;
212
 
213
   ----------
214
   -- Head --
215
   ----------
216
 
217
   function Head
218
     (Source : Wide_String;
219
      Count  : Natural;
220
      Pad    : Wide_Character := Wide_Space) return Wide_String
221
   is
222
      Result : Wide_String (1 .. Count);
223
 
224
   begin
225
      if Count <= Source'Length then
226
         Result := Source (Source'First .. Source'First + Count - 1);
227
 
228
      else
229
         Result (1 .. Source'Length) := Source;
230
 
231
         for J in Source'Length + 1 .. Count loop
232
            Result (J) := Pad;
233
         end loop;
234
      end if;
235
 
236
      return Result;
237
   end Head;
238
 
239
   procedure Head
240
     (Source  : in out Wide_String;
241
      Count   : Natural;
242
      Justify : Alignment := Left;
243
      Pad     : Wide_Character := Ada.Strings.Wide_Space)
244
   is
245
   begin
246
      Move (Source  => Head (Source, Count, Pad),
247
            Target  => Source,
248
            Drop    => Error,
249
            Justify => Justify,
250
            Pad     => Pad);
251
   end Head;
252
 
253
   ------------
254
   -- Insert --
255
   ------------
256
 
257
   function Insert
258
     (Source   : Wide_String;
259
      Before   : Positive;
260
      New_Item : Wide_String) return Wide_String
261
   is
262
      Result : Wide_String (1 .. Source'Length + New_Item'Length);
263
 
264
   begin
265
      if Before < Source'First or else Before > Source'Last + 1 then
266
         raise Index_Error;
267
      end if;
268
 
269
      Result := Source (Source'First .. Before - 1) & New_Item &
270
                Source (Before .. Source'Last);
271
      return Result;
272
   end Insert;
273
 
274
   procedure Insert
275
     (Source   : in out Wide_String;
276
      Before   : Positive;
277
      New_Item : Wide_String;
278
      Drop     : Truncation := Error)
279
   is
280
   begin
281
      Move (Source => Insert (Source, Before, New_Item),
282
            Target => Source,
283
            Drop   => Drop);
284
   end Insert;
285
 
286
   ----------
287
   -- Move --
288
   ----------
289
 
290
   procedure Move
291
     (Source  : Wide_String;
292
      Target  : out Wide_String;
293
      Drop    : Truncation := Error;
294
      Justify : Alignment  := Left;
295
      Pad     : Wide_Character  := Wide_Space)
296
   is
297
      Sfirst  : constant Integer := Source'First;
298
      Slast   : constant Integer := Source'Last;
299
      Slength : constant Integer := Source'Length;
300
 
301
      Tfirst  : constant Integer := Target'First;
302
      Tlast   : constant Integer := Target'Last;
303
      Tlength : constant Integer := Target'Length;
304
 
305
      function Is_Padding (Item : Wide_String) return Boolean;
306
      --  Determine if all characters in Item are pad characters
307
 
308
      ----------------
309
      -- Is_Padding --
310
      ----------------
311
 
312
      function Is_Padding (Item : Wide_String) return Boolean is
313
      begin
314
         for J in Item'Range loop
315
            if Item (J) /= Pad then
316
               return False;
317
            end if;
318
         end loop;
319
 
320
         return True;
321
      end Is_Padding;
322
 
323
   --  Start of processing for Move
324
 
325
   begin
326
      if Slength = Tlength then
327
         Target := Source;
328
 
329
      elsif Slength > Tlength then
330
 
331
         case Drop is
332
            when Left =>
333
               Target := Source (Slast - Tlength + 1 .. Slast);
334
 
335
            when Right =>
336
               Target := Source (Sfirst .. Sfirst + Tlength - 1);
337
 
338
            when Error =>
339
               case Justify is
340
                  when Left =>
341
                     if Is_Padding (Source (Sfirst + Tlength .. Slast)) then
342
                        Target :=
343
                          Source (Sfirst .. Sfirst + Target'Length - 1);
344
                     else
345
                        raise Length_Error;
346
                     end if;
347
 
348
                  when Right =>
349
                     if Is_Padding (Source (Sfirst .. Slast - Tlength)) then
350
                        Target := Source (Slast - Tlength + 1 .. Slast);
351
                     else
352
                        raise Length_Error;
353
                     end if;
354
 
355
                  when Center =>
356
                     raise Length_Error;
357
               end case;
358
 
359
         end case;
360
 
361
      --  Source'Length < Target'Length
362
 
363
      else
364
         case Justify is
365
            when Left =>
366
               Target (Tfirst .. Tfirst + Slength - 1) := Source;
367
 
368
               for J in Tfirst + Slength .. Tlast loop
369
                  Target (J) := Pad;
370
               end loop;
371
 
372
            when Right =>
373
               for J in Tfirst .. Tlast - Slength loop
374
                  Target (J) := Pad;
375
               end loop;
376
 
377
               Target (Tlast - Slength + 1 .. Tlast) := Source;
378
 
379
            when Center =>
380
               declare
381
                  Front_Pad   : constant Integer := (Tlength - Slength) / 2;
382
                  Tfirst_Fpad : constant Integer := Tfirst + Front_Pad;
383
 
384
               begin
385
                  for J in Tfirst .. Tfirst_Fpad - 1 loop
386
                     Target (J) := Pad;
387
                  end loop;
388
 
389
                  Target (Tfirst_Fpad .. Tfirst_Fpad + Slength - 1) := Source;
390
 
391
                  for J in Tfirst_Fpad + Slength .. Tlast loop
392
                     Target (J) := Pad;
393
                  end loop;
394
               end;
395
         end case;
396
      end if;
397
   end Move;
398
 
399
   ---------------
400
   -- Overwrite --
401
   ---------------
402
 
403
   function Overwrite
404
     (Source   : Wide_String;
405
      Position : Positive;
406
      New_Item : Wide_String) return Wide_String
407
   is
408
   begin
409
      if Position not in Source'First .. Source'Last + 1 then
410
         raise Index_Error;
411
      else
412
         declare
413
            Result_Length : constant Natural :=
414
                              Natural'Max
415
                                (Source'Length,
416
                                 Position - Source'First + New_Item'Length);
417
 
418
            Result : Wide_String (1 .. Result_Length);
419
 
420
         begin
421
            Result := Source (Source'First .. Position - 1) & New_Item &
422
                        Source (Position + New_Item'Length .. Source'Last);
423
            return Result;
424
         end;
425
      end if;
426
   end Overwrite;
427
 
428
   procedure Overwrite
429
     (Source   : in out Wide_String;
430
      Position : Positive;
431
      New_Item : Wide_String;
432
      Drop     : Truncation := Right)
433
   is
434
   begin
435
      Move (Source => Overwrite (Source, Position, New_Item),
436
            Target => Source,
437
            Drop   => Drop);
438
   end Overwrite;
439
 
440
   -------------------
441
   -- Replace_Slice --
442
   -------------------
443
 
444
   function Replace_Slice
445
     (Source : Wide_String;
446
      Low    : Positive;
447
      High   : Natural;
448
      By     : Wide_String) return Wide_String
449
   is
450
   begin
451
      if Low > Source'Last + 1 or else High < Source'First - 1 then
452
         raise Index_Error;
453
      end if;
454
 
455
      if High >= Low then
456
         declare
457
            Front_Len : constant Integer :=
458
                          Integer'Max (0, Low - Source'First);
459
            --  Length of prefix of Source copied to result
460
 
461
            Back_Len : constant Integer :=
462
                         Integer'Max (0, Source'Last - High);
463
            --  Length of suffix of Source copied to result
464
 
465
            Result_Length : constant Integer :=
466
                              Front_Len + By'Length + Back_Len;
467
            --  Length of result
468
 
469
            Result : Wide_String (1 .. Result_Length);
470
 
471
         begin
472
            Result (1 .. Front_Len) := Source (Source'First .. Low - 1);
473
            Result (Front_Len + 1 .. Front_Len + By'Length) := By;
474
            Result (Front_Len + By'Length + 1 .. Result'Length) :=
475
              Source (High + 1 .. Source'Last);
476
            return Result;
477
         end;
478
 
479
      else
480
         return Insert (Source, Before => Low, New_Item => By);
481
      end if;
482
   end Replace_Slice;
483
 
484
   procedure Replace_Slice
485
     (Source   : in out Wide_String;
486
      Low      : Positive;
487
      High     : Natural;
488
      By       : Wide_String;
489
      Drop     : Truncation := Error;
490
      Justify  : Alignment  := Left;
491
      Pad      : Wide_Character  := Wide_Space)
492
   is
493
   begin
494
      Move (Replace_Slice (Source, Low, High, By), Source, Drop, Justify, Pad);
495
   end Replace_Slice;
496
 
497
   ----------
498
   -- Tail --
499
   ----------
500
 
501
   function Tail
502
     (Source : Wide_String;
503
      Count  : Natural;
504
      Pad    : Wide_Character := Wide_Space) return Wide_String
505
   is
506
      Result : Wide_String (1 .. Count);
507
 
508
   begin
509
      if Count < Source'Length then
510
         Result := Source (Source'Last - Count + 1 .. Source'Last);
511
 
512
      --  Pad on left
513
 
514
      else
515
         for J in 1 .. Count - Source'Length loop
516
            Result (J) := Pad;
517
         end loop;
518
 
519
         Result (Count - Source'Length + 1 .. Count) := Source;
520
      end if;
521
 
522
      return Result;
523
   end Tail;
524
 
525
   procedure Tail
526
     (Source  : in out Wide_String;
527
      Count   : Natural;
528
      Justify : Alignment := Left;
529
      Pad     : Wide_Character := Ada.Strings.Wide_Space)
530
   is
531
   begin
532
      Move (Source  => Tail (Source, Count, Pad),
533
            Target  => Source,
534
            Drop    => Error,
535
            Justify => Justify,
536
            Pad     => Pad);
537
   end Tail;
538
 
539
   ---------------
540
   -- Translate --
541
   ---------------
542
 
543
   function Translate
544
     (Source  : Wide_String;
545
      Mapping : Wide_Maps.Wide_Character_Mapping) return Wide_String
546
   is
547
      Result : Wide_String (1 .. Source'Length);
548
 
549
   begin
550
      for J in Source'Range loop
551
         Result (J - (Source'First - 1)) := Value (Mapping, Source (J));
552
      end loop;
553
 
554
      return Result;
555
   end Translate;
556
 
557
   procedure Translate
558
     (Source  : in out Wide_String;
559
      Mapping : Wide_Maps.Wide_Character_Mapping)
560
   is
561
   begin
562
      for J in Source'Range loop
563
         Source (J) := Value (Mapping, Source (J));
564
      end loop;
565
   end Translate;
566
 
567
   function Translate
568
     (Source  : Wide_String;
569
      Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Wide_String
570
   is
571
      Result : Wide_String (1 .. Source'Length);
572
 
573
   begin
574
      for J in Source'Range loop
575
         Result (J - (Source'First - 1)) := Mapping (Source (J));
576
      end loop;
577
 
578
      return Result;
579
   end Translate;
580
 
581
   procedure Translate
582
     (Source  : in out Wide_String;
583
      Mapping : Wide_Maps.Wide_Character_Mapping_Function)
584
   is
585
   begin
586
      for J in Source'Range loop
587
         Source (J) := Mapping (Source (J));
588
      end loop;
589
   end Translate;
590
 
591
   ----------
592
   -- Trim --
593
   ----------
594
 
595
   function Trim
596
     (Source : Wide_String;
597
      Side   : Trim_End) return Wide_String
598
   is
599
      Low  : Natural := Source'First;
600
      High : Natural := Source'Last;
601
 
602
   begin
603
      if Side = Left or else Side = Both then
604
         while Low <= High and then Source (Low) = Wide_Space loop
605
            Low := Low + 1;
606
         end loop;
607
      end if;
608
 
609
      if Side = Right or else Side = Both then
610
         while High >= Low and then Source (High) = Wide_Space loop
611
            High := High - 1;
612
         end loop;
613
      end if;
614
 
615
      --  All blanks case
616
 
617
      if Low > High then
618
         return "";
619
 
620
      --  At least one non-blank
621
 
622
      else
623
         declare
624
            Result : constant Wide_String (1 .. High - Low + 1) :=
625
                       Source (Low .. High);
626
 
627
         begin
628
            return Result;
629
         end;
630
      end if;
631
   end Trim;
632
 
633
   procedure Trim
634
     (Source  : in out Wide_String;
635
      Side    : Trim_End;
636
      Justify : Alignment      := Left;
637
      Pad     : Wide_Character := Wide_Space)
638
   is
639
   begin
640
      Move (Source  => Trim (Source, Side),
641
            Target  => Source,
642
            Justify => Justify,
643
            Pad     => Pad);
644
   end Trim;
645
 
646
   function Trim
647
      (Source : Wide_String;
648
       Left   : Wide_Maps.Wide_Character_Set;
649
       Right  : Wide_Maps.Wide_Character_Set) return Wide_String
650
   is
651
      Low  : Natural := Source'First;
652
      High : Natural := Source'Last;
653
 
654
   begin
655
      while Low <= High and then Is_In (Source (Low), Left) loop
656
         Low := Low + 1;
657
      end loop;
658
 
659
      while High >= Low and then Is_In (Source (High), Right) loop
660
         High := High - 1;
661
      end loop;
662
 
663
      --  Case where source comprises only characters in the sets
664
 
665
      if Low > High then
666
         return "";
667
      else
668
         declare
669
            subtype WS is Wide_String (1 .. High - Low + 1);
670
 
671
         begin
672
            return WS (Source (Low .. High));
673
         end;
674
      end if;
675
   end Trim;
676
 
677
   procedure Trim
678
      (Source  : in out Wide_String;
679
       Left    : Wide_Maps.Wide_Character_Set;
680
       Right   : Wide_Maps.Wide_Character_Set;
681
       Justify : Alignment      := Strings.Left;
682
       Pad     : Wide_Character := Wide_Space)
683
   is
684
   begin
685
      Move (Source  => Trim (Source, Left, Right),
686
            Target  => Source,
687
            Justify => Justify,
688
            Pad     => Pad);
689
   end Trim;
690
 
691
end Ada.Strings.Wide_Fixed;

powered by: WebSVN 2.1.0

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