1 ------------------------------------------------------------------------------
3 -- GNAT RUN-TIME COMPONENTS --
5 -- A D A . T E X T _ I O . G E N E R I C _ A U X --
9 -- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
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. --
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. --
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/>. --
27 -- GNAT was originally developed by the GNAT team at New York University. --
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
30 ------------------------------------------------------------------------------
32 with Interfaces.C_Streams; use Interfaces.C_Streams;
34 with System.File_Control_Block;
36 package body Ada.Text_IO.Generic_Aux is
38 package FIO renames System.File_IO;
39 package FCB renames System.File_Control_Block;
40 subtype AP is FCB.AFCB_Ptr;
42 ------------------------
43 -- Check_End_Of_Field --
44 ------------------------
46 procedure Check_End_Of_Field
60 for J in Ptr .. Stop loop
61 if not Is_Blank (Buf (J)) then
66 end Check_End_Of_Field;
68 -----------------------
69 -- Check_On_One_Line --
70 -----------------------
72 procedure Check_On_One_Line
77 FIO.Check_Write_Status (AP (File));
79 if File.Line_Length /= 0 then
80 if Count (Length) > File.Line_Length then
82 elsif File.Col + Count (Length) > File.Line_Length + 1 then
86 end Check_On_One_Line;
92 function Getc (File : File_Type) return int is
96 ch := fgetc (File.Stream);
98 if ch = EOF and then ferror (File.Stream) /= 0 then
109 function Is_Blank (C : Character) return Boolean is
111 return C = ' ' or else C = ASCII.HT;
121 Ptr : in out Integer;
123 Loaded : out Boolean)
130 if ch = Character'Pos (Char) then
131 Store_Char (File, ch, Buf, Ptr);
142 Ptr : in out Integer;
150 if ch = Character'Pos (Char) then
151 Store_Char (File, ch, Buf, Ptr);
160 Ptr : in out Integer;
163 Loaded : out Boolean)
170 if ch = Character'Pos (Char1) or else ch = Character'Pos (Char2) then
171 Store_Char (File, ch, Buf, Ptr);
182 Ptr : in out Integer;
191 if ch = Character'Pos (Char1) or else ch = Character'Pos (Char2) then
192 Store_Char (File, ch, Buf, Ptr);
202 procedure Load_Digits
205 Ptr : in out Integer;
206 Loaded : out Boolean)
209 After_Digit : Boolean;
214 if ch not in Character'Pos ('0') .. Character'Pos ('9') then
222 Store_Char (File, ch, Buf, Ptr);
225 if ch in Character'Pos ('0') .. Character'Pos ('9') then
228 elsif ch = Character'Pos ('_') and then After_Digit then
229 After_Digit := False;
240 procedure Load_Digits
243 Ptr : in out Integer)
246 After_Digit : Boolean;
251 if ch in Character'Pos ('0') .. Character'Pos ('9') then
255 Store_Char (File, ch, Buf, Ptr);
258 if ch in Character'Pos ('0') .. Character'Pos ('9') then
261 elsif ch = Character'Pos ('_') and then After_Digit then
262 After_Digit := False;
273 --------------------------
274 -- Load_Extended_Digits --
275 --------------------------
277 procedure Load_Extended_Digits
280 Ptr : in out Integer;
281 Loaded : out Boolean)
284 After_Digit : Boolean := False;
292 if ch in Character'Pos ('0') .. Character'Pos ('9')
294 ch in Character'Pos ('a') .. Character'Pos ('f')
296 ch in Character'Pos ('A') .. Character'Pos ('F')
300 elsif ch = Character'Pos ('_') and then After_Digit then
301 After_Digit := False;
307 Store_Char (File, ch, Buf, Ptr);
312 end Load_Extended_Digits;
314 procedure Load_Extended_Digits
317 Ptr : in out Integer)
320 pragma Unreferenced (Junk);
322 Load_Extended_Digits (File, Buf, Ptr, Junk);
323 end Load_Extended_Digits;
329 procedure Load_Skip (File : File_Type) is
333 FIO.Check_Read_Status (AP (File));
335 -- Loop till we find a non-blank character (note that as usual in
336 -- Text_IO, blank includes horizontal tab). Note that Get deals with
337 -- the Before_LM and Before_LM_PM flags appropriately.
341 exit when not Is_Blank (C);
344 Ungetc (Character'Pos (C), File);
345 File.Col := File.Col - 1;
356 Ptr : in out Integer)
361 FIO.Check_Read_Status (AP (File));
363 -- If we are immediately before a line mark, then we have no characters.
364 -- This is always a data error, so we may as well raise it right away.
366 if File.Before_LM then
370 for J in 1 .. Width loop
381 Store_Char (File, ch, Buf, Ptr);
391 function Nextc (File : File_Type) return int is
395 ch := fgetc (File.Stream);
398 if ferror (File.Stream) /= 0 then
414 procedure Put_Item (File : File_Type; Str : String) is
416 Check_On_One_Line (File, Str'Length);
428 Ptr : in out Integer)
431 File.Col := File.Col + 1;
433 if Ptr < Buf'Last then
437 Buf (Ptr) := Character'Val (ch);
444 procedure String_Skip (Str : String; Ptr : out Integer) is
449 if Ptr > Str'Last then
452 elsif not Is_Blank (Str (Ptr)) then
465 procedure Ungetc (ch : int; File : File_Type) is
468 if ungetc (ch, File.Stream) = EOF then
474 end Ada.Text_IO.Generic_Aux;