1------------------------------------------------------------------------------
2--                                                                          --
3--                         GNAT RUN-TIME COMPONENTS                         --
4--                                                                          --
5--                              G N A T . I O                               --
6--                                                                          --
7--                                 B o d y                                  --
8--                                                                          --
9--                     Copyright (C) 1995-2018, AdaCore                     --
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
32package body GNAT.IO is
33
34   Current_Out : File_Type := Stdout;
35   pragma Atomic (Current_Out);
36   --  Current output file (modified by Set_Output)
37
38   ---------
39   -- Get --
40   ---------
41
42   procedure Get (X : out Integer) is
43      function Get_Int return Integer;
44      pragma Import (C, Get_Int, "get_int");
45   begin
46      X := Get_Int;
47   end Get;
48
49   procedure Get (C : out Character) is
50      function Get_Char return Character;
51      pragma Import (C, Get_Char, "get_char");
52   begin
53      C := Get_Char;
54   end Get;
55
56   --------------
57   -- Get_Line --
58   --------------
59
60   procedure Get_Line (Item : out String; Last : out Natural) is
61      C : Character;
62
63   begin
64      for Nstore in Item'Range loop
65         Get (C);
66
67         if C = ASCII.LF then
68            Last := Nstore - 1;
69            return;
70
71         else
72            Item (Nstore) := C;
73         end if;
74      end loop;
75
76      Last := Item'Last;
77   end Get_Line;
78
79   --------------
80   -- New_Line --
81   --------------
82
83   procedure New_Line (File : File_Type; Spacing : Positive := 1) is
84   begin
85      for J in 1 .. Spacing loop
86         Put (File, ASCII.LF);
87      end loop;
88   end New_Line;
89
90   procedure New_Line (Spacing : Positive := 1) is
91   begin
92      New_Line (Current_Out, Spacing);
93   end New_Line;
94
95   ---------
96   -- Put --
97   ---------
98
99   procedure Put (X : Integer) is
100   begin
101      Put (Current_Out, X);
102   end Put;
103
104   procedure Put (File : File_Type; X : Integer) is
105      procedure Put_Int (X : Integer);
106      pragma Import (C, Put_Int, "put_int");
107
108      procedure Put_Int_Stderr (X : Integer);
109      pragma Import (C, Put_Int_Stderr, "put_int_stderr");
110
111   begin
112      case File is
113         when Stdout => Put_Int (X);
114         when Stderr => Put_Int_Stderr (X);
115      end case;
116   end Put;
117
118   procedure Put (C : Character) is
119   begin
120      Put (Current_Out, C);
121   end Put;
122
123   procedure Put (File : File_Type; C : Character) is
124      procedure Put_Char (C : Character);
125      pragma Import (C, Put_Char, "put_char");
126
127      procedure Put_Char_Stderr (C : Character);
128      pragma Import (C, Put_Char_Stderr, "put_char_stderr");
129
130   begin
131      case File is
132         when Stdout => Put_Char (C);
133         when Stderr => Put_Char_Stderr (C);
134      end case;
135   end Put;
136
137   procedure Put (S : String) is
138   begin
139      Put (Current_Out, S);
140   end Put;
141
142   procedure Put (File : File_Type; S : String) is
143   begin
144      for J in S'Range loop
145         Put (File, S (J));
146      end loop;
147   end Put;
148
149   --------------
150   -- Put_Line --
151   --------------
152
153   procedure Put_Line (S : String) is
154   begin
155      Put_Line (Current_Out, S);
156   end Put_Line;
157
158   procedure Put_Line (File : File_Type; S : String) is
159   begin
160      Put (File, S);
161      New_Line (File);
162   end Put_Line;
163
164   ----------------
165   -- Set_Output --
166   ----------------
167
168   procedure Set_Output (File : File_Type) is
169   begin
170      Current_Out := File;
171   end Set_Output;
172
173   ---------------------
174   -- Standard_Output --
175   ---------------------
176
177   function Standard_Output return File_Type is
178   begin
179      return Stdout;
180   end Standard_Output;
181
182   --------------------
183   -- Standard_Error --
184   --------------------
185
186   function Standard_Error return File_Type is
187   begin
188      return Stderr;
189   end Standard_Error;
190
191end GNAT.IO;
192