Mercurial > hg > CbC > CbC_gcc
comparison gcc/ada/libgnat/a-witeio.ads @ 111:04ced10e8804
gcc 7
author | kono |
---|---|
date | Fri, 27 Oct 2017 22:46:09 +0900 |
parents | |
children | 84e7813d76e9 |
comparison
equal
deleted
inserted
replaced
68:561a7518be6b | 111:04ced10e8804 |
---|---|
1 ------------------------------------------------------------------------------ | |
2 -- -- | |
3 -- GNAT RUN-TIME COMPONENTS -- | |
4 -- -- | |
5 -- A D A . W I D E _ T E X T _ I O -- | |
6 -- -- | |
7 -- S p e c -- | |
8 -- -- | |
9 -- Copyright (C) 1992-2017, Free Software Foundation, Inc. -- | |
10 -- -- | |
11 -- This specification is derived from the Ada Reference Manual for use with -- | |
12 -- GNAT. The copyright notice above, and the license provisions that follow -- | |
13 -- apply solely to the contents of the part following the private keyword. -- | |
14 -- -- | |
15 -- GNAT is free software; you can redistribute it and/or modify it under -- | |
16 -- terms of the GNU General Public License as published by the Free Soft- -- | |
17 -- ware Foundation; either version 3, or (at your option) any later ver- -- | |
18 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- | |
19 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- | |
20 -- or FITNESS FOR A PARTICULAR PURPOSE. -- | |
21 -- -- | |
22 -- As a special exception under Section 7 of GPL version 3, you are granted -- | |
23 -- additional permissions described in the GCC Runtime Library Exception, -- | |
24 -- version 3.1, as published by the Free Software Foundation. -- | |
25 -- -- | |
26 -- You should have received a copy of the GNU General Public License and -- | |
27 -- a copy of the GCC Runtime Library Exception along with this program; -- | |
28 -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- | |
29 -- <http://www.gnu.org/licenses/>. -- | |
30 -- -- | |
31 -- GNAT was originally developed by the GNAT team at New York University. -- | |
32 -- Extensive contributions were provided by Ada Core Technologies Inc. -- | |
33 -- -- | |
34 ------------------------------------------------------------------------------ | |
35 | |
36 -- Note: the generic subpackages of Wide_Text_IO (Integer_IO, Float_IO, | |
37 -- Fixed_IO, Modular_IO, Decimal_IO and Enumeration_IO) appear as private | |
38 -- children in GNAT. These children are with'ed automatically if they are | |
39 -- referenced, so this rearrangement is invisible to user programs, but has | |
40 -- the advantage that only the needed parts of Wide_Text_IO are processed | |
41 -- and loaded. | |
42 | |
43 with Ada.IO_Exceptions; | |
44 with Ada.Streams; | |
45 | |
46 with Interfaces.C_Streams; | |
47 | |
48 with System; | |
49 with System.File_Control_Block; | |
50 with System.WCh_Con; | |
51 | |
52 package Ada.Wide_Text_IO is | |
53 | |
54 type File_Type is limited private; | |
55 type File_Mode is (In_File, Out_File, Append_File); | |
56 | |
57 -- The following representation clause allows the use of unchecked | |
58 -- conversion for rapid translation between the File_Mode type | |
59 -- used in this package and System.File_IO. | |
60 | |
61 for File_Mode use | |
62 (In_File => 0, -- System.FIle_IO.File_Mode'Pos (In_File) | |
63 Out_File => 2, -- System.File_IO.File_Mode'Pos (Out_File) | |
64 Append_File => 3); -- System.File_IO.File_Mode'Pos (Append_File) | |
65 | |
66 type Count is range 0 .. Natural'Last; | |
67 -- The value of Count'Last must be large enough so that the assumption that | |
68 -- the Line, Column and Page counts can never exceed this value is valid. | |
69 | |
70 subtype Positive_Count is Count range 1 .. Count'Last; | |
71 | |
72 Unbounded : constant Count := 0; | |
73 -- Line and page length | |
74 | |
75 subtype Field is Integer range 0 .. 255; | |
76 -- Note: if for any reason, there is a need to increase this value, then it | |
77 -- will be necessary to change the corresponding value in System.Img_Real | |
78 -- in file s-imgrea.adb. | |
79 | |
80 subtype Number_Base is Integer range 2 .. 16; | |
81 | |
82 type Type_Set is (Lower_Case, Upper_Case); | |
83 | |
84 --------------------- | |
85 -- File Management -- | |
86 --------------------- | |
87 | |
88 procedure Create | |
89 (File : in out File_Type; | |
90 Mode : File_Mode := Out_File; | |
91 Name : String := ""; | |
92 Form : String := ""); | |
93 | |
94 procedure Open | |
95 (File : in out File_Type; | |
96 Mode : File_Mode; | |
97 Name : String; | |
98 Form : String := ""); | |
99 | |
100 procedure Close (File : in out File_Type); | |
101 procedure Delete (File : in out File_Type); | |
102 procedure Reset (File : in out File_Type; Mode : File_Mode); | |
103 procedure Reset (File : in out File_Type); | |
104 | |
105 function Mode (File : File_Type) return File_Mode; | |
106 function Name (File : File_Type) return String; | |
107 function Form (File : File_Type) return String; | |
108 | |
109 function Is_Open (File : File_Type) return Boolean; | |
110 | |
111 ------------------------------------------------------ | |
112 -- Control of default input, output and error files -- | |
113 ------------------------------------------------------ | |
114 | |
115 procedure Set_Input (File : File_Type); | |
116 procedure Set_Output (File : File_Type); | |
117 procedure Set_Error (File : File_Type); | |
118 | |
119 function Standard_Input return File_Type; | |
120 function Standard_Output return File_Type; | |
121 function Standard_Error return File_Type; | |
122 | |
123 function Current_Input return File_Type; | |
124 function Current_Output return File_Type; | |
125 function Current_Error return File_Type; | |
126 | |
127 type File_Access is access constant File_Type; | |
128 | |
129 function Standard_Input return File_Access; | |
130 function Standard_Output return File_Access; | |
131 function Standard_Error return File_Access; | |
132 | |
133 function Current_Input return File_Access; | |
134 function Current_Output return File_Access; | |
135 function Current_Error return File_Access; | |
136 | |
137 -------------------- | |
138 -- Buffer control -- | |
139 -------------------- | |
140 | |
141 -- Note: The parameter file is in out in the RM, but as pointed out | |
142 -- in <<95-5166.a Tucker Taft 95-6-23>> this is clearly an oversight. | |
143 | |
144 procedure Flush (File : File_Type); | |
145 procedure Flush; | |
146 | |
147 -------------------------------------------- | |
148 -- Specification of line and page lengths -- | |
149 -------------------------------------------- | |
150 | |
151 procedure Set_Line_Length (File : File_Type; To : Count); | |
152 procedure Set_Line_Length (To : Count); | |
153 | |
154 procedure Set_Page_Length (File : File_Type; To : Count); | |
155 procedure Set_Page_Length (To : Count); | |
156 | |
157 function Line_Length (File : File_Type) return Count; | |
158 function Line_Length return Count; | |
159 | |
160 function Page_Length (File : File_Type) return Count; | |
161 function Page_Length return Count; | |
162 | |
163 ------------------------------------ | |
164 -- Column, Line, and Page Control -- | |
165 ------------------------------------ | |
166 | |
167 procedure New_Line (File : File_Type; Spacing : Positive_Count := 1); | |
168 procedure New_Line (Spacing : Positive_Count := 1); | |
169 | |
170 procedure Skip_Line (File : File_Type; Spacing : Positive_Count := 1); | |
171 procedure Skip_Line (Spacing : Positive_Count := 1); | |
172 | |
173 function End_Of_Line (File : File_Type) return Boolean; | |
174 function End_Of_Line return Boolean; | |
175 | |
176 procedure New_Page (File : File_Type); | |
177 procedure New_Page; | |
178 | |
179 procedure Skip_Page (File : File_Type); | |
180 procedure Skip_Page; | |
181 | |
182 function End_Of_Page (File : File_Type) return Boolean; | |
183 function End_Of_Page return Boolean; | |
184 | |
185 function End_Of_File (File : File_Type) return Boolean; | |
186 function End_Of_File return Boolean; | |
187 | |
188 procedure Set_Col (File : File_Type; To : Positive_Count); | |
189 procedure Set_Col (To : Positive_Count); | |
190 | |
191 procedure Set_Line (File : File_Type; To : Positive_Count); | |
192 procedure Set_Line (To : Positive_Count); | |
193 | |
194 function Col (File : File_Type) return Positive_Count; | |
195 function Col return Positive_Count; | |
196 | |
197 function Line (File : File_Type) return Positive_Count; | |
198 function Line return Positive_Count; | |
199 | |
200 function Page (File : File_Type) return Positive_Count; | |
201 function Page return Positive_Count; | |
202 | |
203 ---------------------------- | |
204 -- Character Input-Output -- | |
205 ---------------------------- | |
206 | |
207 procedure Get (File : File_Type; Item : out Wide_Character); | |
208 procedure Get (Item : out Wide_Character); | |
209 procedure Put (File : File_Type; Item : Wide_Character); | |
210 procedure Put (Item : Wide_Character); | |
211 | |
212 procedure Look_Ahead | |
213 (File : File_Type; | |
214 Item : out Wide_Character; | |
215 End_Of_Line : out Boolean); | |
216 | |
217 procedure Look_Ahead | |
218 (Item : out Wide_Character; | |
219 End_Of_Line : out Boolean); | |
220 | |
221 procedure Get_Immediate | |
222 (File : File_Type; | |
223 Item : out Wide_Character); | |
224 | |
225 procedure Get_Immediate | |
226 (Item : out Wide_Character); | |
227 | |
228 procedure Get_Immediate | |
229 (File : File_Type; | |
230 Item : out Wide_Character; | |
231 Available : out Boolean); | |
232 | |
233 procedure Get_Immediate | |
234 (Item : out Wide_Character; | |
235 Available : out Boolean); | |
236 | |
237 ------------------------- | |
238 -- String Input-Output -- | |
239 ------------------------- | |
240 | |
241 procedure Get (File : File_Type; Item : out Wide_String); | |
242 procedure Get (Item : out Wide_String); | |
243 procedure Put (File : File_Type; Item : Wide_String); | |
244 procedure Put (Item : Wide_String); | |
245 | |
246 procedure Get_Line | |
247 (File : File_Type; | |
248 Item : out Wide_String; | |
249 Last : out Natural); | |
250 | |
251 procedure Get_Line | |
252 (Item : out Wide_String; | |
253 Last : out Natural); | |
254 | |
255 function Get_Line (File : File_Type) return Wide_String; | |
256 pragma Ada_05 (Get_Line); | |
257 | |
258 function Get_Line return Wide_String; | |
259 pragma Ada_05 (Get_Line); | |
260 | |
261 procedure Put_Line | |
262 (File : File_Type; | |
263 Item : Wide_String); | |
264 | |
265 procedure Put_Line | |
266 (Item : Wide_String); | |
267 | |
268 --------------------------------------- | |
269 -- Generic packages for Input-Output -- | |
270 --------------------------------------- | |
271 | |
272 -- The generic packages: | |
273 | |
274 -- Ada.Wide_Text_IO.Integer_IO | |
275 -- Ada.Wide_Text_IO.Modular_IO | |
276 -- Ada.Wide_Text_IO.Float_IO | |
277 -- Ada.Wide_Text_IO.Fixed_IO | |
278 -- Ada.Wide_Text_IO.Decimal_IO | |
279 -- Ada.Wide_Text_IO.Enumeration_IO | |
280 | |
281 -- are implemented as separate child packages in GNAT, so the | |
282 -- spec and body of these packages are to be found in separate | |
283 -- child units. This implementation detail is hidden from the | |
284 -- Ada programmer by special circuitry in the compiler that | |
285 -- treats these child packages as though they were nested in | |
286 -- Text_IO. The advantage of this special processing is that | |
287 -- the subsidiary routines needed if these generics are used | |
288 -- are not loaded when they are not used. | |
289 | |
290 ---------------- | |
291 -- Exceptions -- | |
292 ---------------- | |
293 | |
294 Status_Error : exception renames IO_Exceptions.Status_Error; | |
295 Mode_Error : exception renames IO_Exceptions.Mode_Error; | |
296 Name_Error : exception renames IO_Exceptions.Name_Error; | |
297 Use_Error : exception renames IO_Exceptions.Use_Error; | |
298 Device_Error : exception renames IO_Exceptions.Device_Error; | |
299 End_Error : exception renames IO_Exceptions.End_Error; | |
300 Data_Error : exception renames IO_Exceptions.Data_Error; | |
301 Layout_Error : exception renames IO_Exceptions.Layout_Error; | |
302 | |
303 private | |
304 | |
305 -- The following procedures have a File_Type formal of mode IN OUT because | |
306 -- they may close the original file. The Close operation may raise an | |
307 -- exception, but in that case we want any assignment to the formal to | |
308 -- be effective anyway, so it must be passed by reference (or the caller | |
309 -- will be left with a dangling pointer). | |
310 | |
311 pragma Export_Procedure | |
312 (Internal => Close, | |
313 External => "", | |
314 Mechanism => Reference); | |
315 pragma Export_Procedure | |
316 (Internal => Delete, | |
317 External => "", | |
318 Mechanism => Reference); | |
319 pragma Export_Procedure | |
320 (Internal => Reset, | |
321 External => "", | |
322 Parameter_Types => (File_Type), | |
323 Mechanism => Reference); | |
324 pragma Export_Procedure | |
325 (Internal => Reset, | |
326 External => "", | |
327 Parameter_Types => (File_Type, File_Mode), | |
328 Mechanism => (File => Reference)); | |
329 | |
330 package WCh_Con renames System.WCh_Con; | |
331 | |
332 ----------------------------------- | |
333 -- Handling of Format Characters -- | |
334 ----------------------------------- | |
335 | |
336 -- Line marks are represented by the single character ASCII.LF (16#0A#). | |
337 -- In DOS and similar systems, underlying file translation takes care | |
338 -- of translating this to and from the standard CR/LF sequences used in | |
339 -- these operating systems to mark the end of a line. On output there is | |
340 -- always a line mark at the end of the last line, but on input, this | |
341 -- line mark can be omitted, and is implied by the end of file. | |
342 | |
343 -- Page marks are represented by the single character ASCII.FF (16#0C#), | |
344 -- The page mark at the end of the file may be omitted, and is normally | |
345 -- omitted on output unless an explicit New_Page call is made before | |
346 -- closing the file. No page mark is added when a file is appended to, | |
347 -- so, in accordance with the permission in (RM A.10.2(4)), there may | |
348 -- or may not be a page mark separating preexisting text in the file | |
349 -- from the new text to be written. | |
350 | |
351 -- A file mark is marked by the physical end of file. In DOS translation | |
352 -- mode on input, an EOF character (SUB = 16#1A#) gets translated to the | |
353 -- physical end of file, so in effect this character is recognized as | |
354 -- marking the end of file in DOS and similar systems. | |
355 | |
356 LM : constant := Character'Pos (ASCII.LF); | |
357 -- Used as line mark | |
358 | |
359 PM : constant := Character'Pos (ASCII.FF); | |
360 -- Used as page mark, except at end of file where it is implied | |
361 | |
362 ------------------------------------- | |
363 -- Wide_Text_IO File Control Block -- | |
364 ------------------------------------- | |
365 | |
366 Default_WCEM : WCh_Con.WC_Encoding_Method := WCh_Con.WCEM_UTF8; | |
367 -- This gets modified during initialization (see body) using | |
368 -- the default value established in the call to Set_Globals. | |
369 | |
370 package FCB renames System.File_Control_Block; | |
371 | |
372 type Wide_Text_AFCB is new FCB.AFCB with record | |
373 Page : Count := 1; | |
374 Line : Count := 1; | |
375 Col : Count := 1; | |
376 Line_Length : Count := 0; | |
377 Page_Length : Count := 0; | |
378 | |
379 Self : aliased File_Type; | |
380 -- Set to point to the containing Text_AFCB block. This is used to | |
381 -- implement the Current_{Error,Input,Output} functions which return | |
382 -- a File_Access, the file access value returned is a pointer to | |
383 -- the Self field of the corresponding file. | |
384 | |
385 Before_LM : Boolean := False; | |
386 -- This flag is used to deal with the anomalies introduced by the | |
387 -- peculiar definition of End_Of_File and End_Of_Page in Ada. These | |
388 -- functions require looking ahead more than one character. Since | |
389 -- there is no convenient way of backing up more than one character, | |
390 -- what we do is to leave ourselves positioned past the LM, but set | |
391 -- this flag, so that we know that from an Ada point of view we are | |
392 -- in front of the LM, not after it. A bit odd, but it works. | |
393 | |
394 Before_LM_PM : Boolean := False; | |
395 -- This flag similarly handles the case of being physically positioned | |
396 -- after a LM-PM sequence when logically we are before the LM-PM. This | |
397 -- flag can only be set if Before_LM is also set. | |
398 | |
399 WC_Method : WCh_Con.WC_Encoding_Method := Default_WCEM; | |
400 -- Encoding method to be used for this file | |
401 | |
402 Before_Wide_Character : Boolean := False; | |
403 -- This flag is set to indicate that a wide character in the input has | |
404 -- been read by Wide_Text_IO.Look_Ahead. If it is set to True, then it | |
405 -- means that the stream is logically positioned before the character | |
406 -- but is physically positioned after it. The character involved must | |
407 -- not be in the range 16#00#-16#7F#, i.e. if the flag is set, then | |
408 -- we know the next character has a code greater than 16#7F#, and the | |
409 -- value of this character is saved in Saved_Wide_Character. | |
410 | |
411 Saved_Wide_Character : Wide_Character; | |
412 -- This field is valid only if Before_Wide_Character is set. It | |
413 -- contains a wide character read by Look_Ahead. If Look_Ahead | |
414 -- reads a character in the range 16#0000# to 16#007F#, then it | |
415 -- can use ungetc to put it back, but ungetc cannot be called | |
416 -- more than once, so for characters above this range, we don't | |
417 -- try to back up the file. Instead we save the character in this | |
418 -- field and set the flag Before_Wide_Character to indicate that | |
419 -- we are logically positioned before this character even though | |
420 -- the stream is physically positioned after it. | |
421 | |
422 end record; | |
423 | |
424 type File_Type is access all Wide_Text_AFCB; | |
425 | |
426 function AFCB_Allocate (Control_Block : Wide_Text_AFCB) return FCB.AFCB_Ptr; | |
427 | |
428 procedure AFCB_Close (File : not null access Wide_Text_AFCB); | |
429 procedure AFCB_Free (File : not null access Wide_Text_AFCB); | |
430 | |
431 procedure Read | |
432 (File : in out Wide_Text_AFCB; | |
433 Item : out Ada.Streams.Stream_Element_Array; | |
434 Last : out Ada.Streams.Stream_Element_Offset); | |
435 -- Read operation used when Wide_Text_IO file is treated as a Stream | |
436 | |
437 procedure Write | |
438 (File : in out Wide_Text_AFCB; | |
439 Item : Ada.Streams.Stream_Element_Array); | |
440 -- Write operation used when Wide_Text_IO file is treated as a Stream | |
441 | |
442 ------------------------ | |
443 -- The Standard Files -- | |
444 ------------------------ | |
445 | |
446 Standard_Err_AFCB : aliased Wide_Text_AFCB; | |
447 Standard_In_AFCB : aliased Wide_Text_AFCB; | |
448 Standard_Out_AFCB : aliased Wide_Text_AFCB; | |
449 | |
450 Standard_Err : aliased File_Type := Standard_Err_AFCB'Access; | |
451 Standard_In : aliased File_Type := Standard_In_AFCB'Access; | |
452 Standard_Out : aliased File_Type := Standard_Out_AFCB'Access; | |
453 -- Standard files | |
454 | |
455 Current_In : aliased File_Type := Standard_In; | |
456 Current_Out : aliased File_Type := Standard_Out; | |
457 Current_Err : aliased File_Type := Standard_Err; | |
458 -- Current files | |
459 | |
460 procedure Initialize_Standard_Files; | |
461 -- Initializes the file control blocks for the standard files. Called from | |
462 -- the elaboration routine for this package, and from Reset_Standard_Files | |
463 -- in package Ada.Wide_Text_IO.Reset_Standard_Files. | |
464 | |
465 ----------------------- | |
466 -- Local Subprograms -- | |
467 ----------------------- | |
468 | |
469 -- These subprograms are in the private part of the spec so that they can | |
470 -- be shared by the children of Ada.Wide_Text_IO. | |
471 | |
472 function Getc (File : File_Type) return Interfaces.C_Streams.int; | |
473 -- Gets next character from file, which has already been checked for being | |
474 -- in read status, and returns the character read if no error occurs. The | |
475 -- result is EOF if the end of file was read. | |
476 | |
477 procedure Get_Character (File : File_Type; Item : out Character); | |
478 -- This is essentially a copy of the normal Get routine from Text_IO. It | |
479 -- obtains a single character from the input file File, and places it in | |
480 -- Item. This character may be the leading character of a Wide_Character | |
481 -- sequence, but that is up to the caller to deal with. | |
482 | |
483 function Get_Wide_Char | |
484 (C : Character; | |
485 File : File_Type) return Wide_Character; | |
486 -- This function is shared by Get and Get_Immediate to extract a wide | |
487 -- character value from the given File. The first byte has already been | |
488 -- read and is passed in C. The wide character value is returned as the | |
489 -- result, and the file pointer is bumped past the character. | |
490 | |
491 function Nextc (File : File_Type) return Interfaces.C_Streams.int; | |
492 -- Returns next character from file without skipping past it (i.e. it is a | |
493 -- combination of Getc followed by an Ungetc). | |
494 | |
495 end Ada.Wide_Text_IO; |