File : s-io-xi.adb
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT RUN-TIME COMPONENTS --
4 -- --
5 -- S Y S T E M . I O --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 1992-2013, 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 -- --
19 -- --
20 -- --
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 -- This is a bare board implementation of this body
33
34 with System.Text_IO;
35
36 package body System.IO is
37
38 procedure Put_Char_Stderr (C : Character);
39 pragma Export (C, Put_Char_Stderr, "put_char_stderr");
40 -- Called by Ada.Exception to display message
41
42 --------------
43 -- New_Line --
44 --------------
45
46 procedure New_Line (Spacing : Positive := 1) is
47 begin
48 for J in 1 .. Spacing loop
49 if System.Text_IO.Use_Cr_Lf_For_New_Line then
50 Put (ASCII.CR);
51 end if;
52
53 Put (ASCII.LF);
54 end loop;
55 end New_Line;
56
57 ---------
58 -- Put --
59 ---------
60
61 procedure Put (X : Integer) is
62 begin
63 Put (Integer'Image (X));
64 end Put;
65
66 procedure Put (C : Character) is
67 use System.Text_IO;
68 -- Only this procedure calls procedures in System.Text_IO
69
70 begin
71 -- Be sure the service is set up
72
73 if not Initialized then
74 Initialize;
75 end if;
76
77 while not Is_Tx_Ready loop
78 null;
79 end loop;
80
81 System.Text_IO.Put (C);
82 end Put;
83
84 procedure Put (S : String) is
85 begin
86 for J in S'Range loop
87 Put (S (J));
88 end loop;
89 end Put;
90
91 ---------------------
92 -- Put_Char_Stderr --
93 ---------------------
94
95 procedure Put_Char_Stderr (C : Character) is
96 begin
97 Put (C);
98 end Put_Char_Stderr;
99
100 --------------
101 -- Put_Line --
102 --------------
103
104 procedure Put_Line (S : String) is
105 begin
106 Put (S);
107 New_Line;
108 end Put_Line;
109
110 ---------------------
111 -- Standard_Output --
112 ---------------------
113
114 function Standard_Output return File_Type is
115 begin
116 return Stdout;
117 end Standard_Output;
118
119 --------------------
120 -- Standard_Error --
121 --------------------
122
123 function Standard_Error return File_Type is
124 begin
125 return Stderr;
126 end Standard_Error;
127
128 ----------------
129 -- Set_Output --
130 ----------------
131
132 -- No distinction between standard output and error output
133
134 procedure Set_Output (File : File_Type) is
135 pragma Unreferenced (File);
136 begin
137 null;
138 end Set_Output;
139
140 end System.IO;