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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [ada/] [a-tiboio.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 . T E X T _ I O . B O U N D E D _ I O                --
6
--                                                                          --
7
--                                 B o d y                                  --
8
--                                                                          --
9
--          Copyright (C) 1997-2009, 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.Text_IO; use Ada.Text_IO;
33
with Ada.Unchecked_Deallocation;
34
 
35
package body Ada.Text_IO.Bounded_IO is
36
 
37
   type String_Access is access all String;
38
 
39
   procedure Free (SA : in out String_Access);
40
   --  Perform an unchecked deallocation of a non-null string
41
 
42
   ----------
43
   -- Free --
44
   ----------
45
 
46
   procedure Free (SA : in out String_Access) is
47
      Null_String : constant String := "";
48
 
49
      procedure Deallocate is
50
        new Ada.Unchecked_Deallocation (String, String_Access);
51
 
52
   begin
53
      --  Do not try to free statically allocated null string
54
 
55
      if SA.all /= Null_String then
56
         Deallocate (SA);
57
      end if;
58
   end Free;
59
 
60
   --------------
61
   -- Get_Line --
62
   --------------
63
 
64
   function Get_Line return Bounded.Bounded_String is
65
   begin
66
      return Bounded.To_Bounded_String (Get_Line);
67
   end Get_Line;
68
 
69
   --------------
70
   -- Get_Line --
71
   --------------
72
 
73
   function Get_Line
74
     (File : File_Type) return Bounded.Bounded_String
75
   is
76
   begin
77
      return Bounded.To_Bounded_String (Get_Line (File));
78
   end Get_Line;
79
 
80
   --------------
81
   -- Get_Line --
82
   --------------
83
 
84
   procedure Get_Line
85
     (Item : out Bounded.Bounded_String)
86
   is
87
      Buffer : String (1 .. 1000);
88
      Last   : Natural;
89
      Str1   : String_Access;
90
      Str2   : String_Access;
91
 
92
   begin
93
      Get_Line (Buffer, Last);
94
      Str1 := new String'(Buffer (1 .. Last));
95
 
96
      while Last = Buffer'Last loop
97
         Get_Line (Buffer, Last);
98
         Str2 := new String'(Str1.all & Buffer (1 .. Last));
99
         Free (Str1);
100
         Str1 := Str2;
101
      end loop;
102
 
103
      Item := Bounded.To_Bounded_String (Str1.all);
104
   end Get_Line;
105
 
106
   --------------
107
   -- Get_Line --
108
   --------------
109
 
110
   procedure Get_Line
111
     (File : File_Type;
112
      Item : out Bounded.Bounded_String)
113
   is
114
      Buffer : String (1 .. 1000);
115
      Last   : Natural;
116
      Str1   : String_Access;
117
      Str2   : String_Access;
118
 
119
   begin
120
      Get_Line (File, Buffer, Last);
121
      Str1 := new String'(Buffer (1 .. Last));
122
 
123
      while Last = Buffer'Last loop
124
         Get_Line (File, Buffer, Last);
125
         Str2 := new String'(Str1.all & Buffer (1 .. Last));
126
         Free (Str1);
127
         Str1 := Str2;
128
      end loop;
129
 
130
      Item := Bounded.To_Bounded_String (Str1.all);
131
   end Get_Line;
132
 
133
   ---------
134
   -- Put --
135
   ---------
136
 
137
   procedure Put
138
     (Item : Bounded.Bounded_String)
139
   is
140
   begin
141
      Put (Bounded.To_String (Item));
142
   end Put;
143
 
144
   ---------
145
   -- Put --
146
   ---------
147
 
148
   procedure Put
149
     (File : File_Type;
150
      Item : Bounded.Bounded_String)
151
   is
152
   begin
153
      Put (File, Bounded.To_String (Item));
154
   end Put;
155
 
156
   --------------
157
   -- Put_Line --
158
   --------------
159
 
160
   procedure Put_Line
161
     (Item : Bounded.Bounded_String)
162
   is
163
   begin
164
      Put_Line (Bounded.To_String (Item));
165
   end Put_Line;
166
 
167
   --------------
168
   -- Put_Line --
169
   --------------
170
 
171
   procedure Put_Line
172
     (File : File_Type;
173
      Item : Bounded.Bounded_String)
174
   is
175
   begin
176
      Put_Line (File, Bounded.To_String (Item));
177
   end Put_Line;
178
 
179
end Ada.Text_IO.Bounded_IO;

powered by: WebSVN 2.1.0

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