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 747

Go to most recent revision | 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.