OSDN Git Service

Fix PR42186.
[pf3gnuchains/gcc-fork.git] / gcc / ada / output.ads
1 ------------------------------------------------------------------------------
2 --                                                                          --
3 --                         GNAT COMPILER COMPONENTS                         --
4 --                                                                          --
5 --                               O U T P U T                                --
6 --                                                                          --
7 --                                 S p e c                                  --
8 --                                                                          --
9 --          Copyright (C) 1992-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 --  This package contains low level output routines used by the compiler
33 --  for writing error messages and informational output. It is also used
34 --  by the debug source file output routines (see Sprintf.Print_Eol).
35
36 with Hostparm; use Hostparm;
37 with Types;    use Types;
38
39 package Output is
40    pragma Elaborate_Body;
41
42    type Output_Proc is access procedure (S : String);
43    --  This type is used for the Set_Special_Output procedure. If this
44    --  procedure is called, then instead of lines being written to
45    --  standard error or standard output, a call is made to the given
46    --  procedure for each line, passing the line with an end of line
47    --  character (which is a single ASCII.LF character, even in systems
48    --  which normally use CR/LF or some other sequence for line end).
49
50    -----------------
51    -- Subprograms --
52    -----------------
53
54    procedure Set_Special_Output (P : Output_Proc);
55    --  Sets subsequent output to call procedure P. If P is null, then
56    --  the call cancels the effect of a previous call, reverting the
57    --  output to standard error or standard output depending on the
58    --  mode at the time of previous call. Any exception generated by
59    --  by calls to P is simply propagated to the caller of the routine
60    --  causing the write operation.
61
62    procedure Cancel_Special_Output;
63    --  Cancels the effect of a call to Set_Special_Output, if any.
64    --  The output is then directed to standard error or standard output
65    --  depending on the last call to Set_Standard_Error or Set_Standard_Output.
66    --  It is never an error to call Cancel_Special_Output. It has the same
67    --  effect as calling Set_Special_Output (null).
68
69    procedure Ignore_Output (S : String);
70    --  Does nothing. To disable output, pass Ignore_Output'Access to
71    --  Set_Special_Output.
72
73    procedure Set_Standard_Error;
74    --  Sets subsequent output to appear on the standard error file (whatever
75    --  that might mean for the host operating system, if anything) when
76    --  no special output is in effect. When a special output is in effect,
77    --  the output will appear on standard error only after special output
78    --  has been cancelled.
79
80    procedure Set_Standard_Output;
81    --  Sets subsequent output to appear on the standard output file (whatever
82    --  that might mean for the host operating system, if anything) when
83    --  no special output is in effect. When a special output is in effect,
84    --  the output will appear on standard output only after special output
85    --  has been cancelled. Output to standard output is the default mode
86    --  before any call to either of the Set procedures.
87
88    procedure Indent;
89    --  Increases the current indentation level. Whenever a line is written
90    --  (triggered by Eol), an appropriate amount of whitespace is added to the
91    --  beginning of the line, wrapping around if it gets too long.
92
93    procedure Outdent;
94    --  Decreases the current indentation level
95
96    procedure Write_Char (C : Character);
97    --  Write one character to the standard output file. If the character is LF,
98    --  this is equivalent to Write_Eol.
99
100    procedure Write_Erase_Char (C : Character);
101    --  If last character in buffer matches C, erase it, otherwise no effect
102
103    procedure Write_Eol;
104    --  Write an end of line (whatever is required by the system in use,
105    --  e.g. CR/LF for DOS, or LF for Unix) to the standard output file.
106    --  This routine also empties the line buffer, actually writing it
107    --  to the file. Note that Write_Eol is the only routine that causes
108    --  any actual output to be written. Trailing spaces are removed.
109
110    procedure Write_Eol_Keep_Blanks;
111    --  Similar as Write_Eol, except that trailing spaces are not removed
112
113    procedure Write_Int (Val : Int);
114    --  Write an integer value with no leading blanks or zeroes. Negative
115    --  values are preceded by a minus sign).
116
117    procedure Write_Spaces (N : Nat);
118    --  Write N spaces
119
120    procedure Write_Str (S : String);
121    --  Write a string of characters to the standard output file. Note that
122    --  end of line is normally handled separately using WRITE_EOL, but it
123    --  is allowed for the string to contain LF (but not CR) characters,
124    --  which are properly interpreted as end of line characters. The string
125    --  may also contain horizontal tab characters.
126
127    procedure Write_Line (S : String);
128    --  Equivalent to Write_Str (S) followed by Write_Eol;
129
130    function Column return Pos;
131    pragma Inline (Column);
132    --  Returns the number of the column about to be written (e.g. a value
133    --  of 1 means the current line is empty).
134
135    -------------------------
136    -- Buffer Save/Restore --
137    -------------------------
138
139    --  This facility allows the current line buffer to be saved and restored
140
141    type Saved_Output_Buffer is private;
142    --  Type used for Save/Restore_Buffer
143
144    Buffer_Max : constant := Hostparm.Max_Line_Length;
145    --  Maximal size of a buffered output line
146
147    function Save_Output_Buffer return Saved_Output_Buffer;
148    --  Save current line buffer and reset line buffer to empty
149
150    procedure Restore_Output_Buffer (S : Saved_Output_Buffer);
151    --  Restore previously saved output buffer. The value in S is not affected
152    --  so it is legitimate to restore a buffer more than once.
153
154    --------------------------
155    -- Debugging Procedures --
156    --------------------------
157
158    --  The following procedures are intended only for debugging purposes,
159    --  for temporary insertion into the text in environments where a debugger
160    --  is not available. They all have non-standard very short lower case
161    --  names, precisely to make sure that they are only used for debugging!
162
163    procedure w (C : Character);
164    --  Dump quote, character, quote, followed by line return
165
166    procedure w (S : String);
167    --  Dump string followed by line return
168
169    procedure w (V : Int);
170    --  Dump integer followed by line return
171
172    procedure w (B : Boolean);
173    --  Dump Boolean followed by line return
174
175    procedure w (L : String; C : Character);
176    --  Dump contents of string followed by blank, quote, character, quote
177
178    procedure w (L : String; S : String);
179    --  Dump two strings separated by blanks, followed by line return
180
181    procedure w (L : String; V : Int);
182    --  Dump contents of string followed by blank, integer, line return
183
184    procedure w (L : String; B : Boolean);
185    --  Dump contents of string followed by blank, Boolean, line return
186
187 private
188    --  Note: the following buffer and column position are maintained by the
189    --  subprograms defined in this package, and cannot be directly modified or
190    --  accessed by a client.
191
192    Buffer : String (1 .. Buffer_Max + 1) := (others => '*');
193    for Buffer'Alignment use 4;
194    --  Buffer used to build output line. We do line buffering because it
195    --  is needed for the support of the debug-generated-code option (-gnatD).
196    --  Historically it was first added because on VMS, line buffering is
197    --  needed with certain file formats. So in any case line buffering must
198    --  be retained for this purpose, even if other reasons disappear. Note
199    --  any attempt to write more output to a line than can fit in the buffer
200    --  will be silently ignored. The alignment clause improves the efficiency
201    --  of the save/restore procedures.
202
203    Next_Col : Positive range 1 .. Buffer'Length + 1 := 1;
204    --  Column about to be written
205
206    type Saved_Output_Buffer is record
207       Buffer          : String (1 .. Buffer_Max + 1);
208       Next_Col        : Positive;
209       Cur_Indentation : Natural;
210    end record;
211
212 end Output;