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-2005 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 2, 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. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING. If not, write --
19 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
20 -- MA 02111-1307, USA. --
22 -- As a special exception, if other files instantiate generics from this --
23 -- unit, or you link this unit with other files to produce an executable, --
24 -- this unit does not by itself cause the resulting executable to be --
25 -- covered by the GNU General Public License. This exception does not --
26 -- however invalidate any other reasons why the executable file might be --
27 -- covered by the GNU Public License. --
29 -- GNAT was originally developed by the GNAT team at New York University. --
30 -- Extensive contributions were provided by Ada Core Technologies Inc. --
32 ------------------------------------------------------------------------------
34 with Interfaces.C_Streams; use Interfaces.C_Streams;
36 with System.File_Control_Block;
38 package body Ada.Text_IO.Generic_Aux is
40 package FIO renames System.File_IO;
41 package FCB renames System.File_Control_Block;
42 subtype AP is FCB.AFCB_Ptr;
44 ------------------------
45 -- Check_End_Of_Field --
46 ------------------------
48 procedure Check_End_Of_Field
62 for J in Ptr .. Stop loop
63 if not Is_Blank (Buf (J)) then
68 end Check_End_Of_Field;
70 -----------------------
71 -- Check_On_One_Line --
72 -----------------------
74 procedure Check_On_One_Line
79 FIO.Check_Write_Status (AP (File));
81 if File.Line_Length /= 0 then
82 if Count (Length) > File.Line_Length then
84 elsif File.Col + Count (Length) > File.Line_Length + 1 then
88 end Check_On_One_Line;
94 function Getc (File : File_Type) return int is
98 ch := fgetc (File.Stream);
100 if ch = EOF and then ferror (File.Stream) /= 0 then
111 function Is_Blank (C : Character) return Boolean is
113 return C = ' ' or else C = ASCII.HT;
123 Ptr : in out Integer;
125 Loaded : out Boolean)
132 if ch = Character'Pos (Char) then
133 Store_Char (File, ch, Buf, Ptr);
144 Ptr : in out Integer;
152 if ch = Character'Pos (Char) then
153 Store_Char (File, ch, Buf, Ptr);
162 Ptr : in out Integer;
165 Loaded : out Boolean)
172 if ch = Character'Pos (Char1) or else ch = Character'Pos (Char2) then
173 Store_Char (File, ch, Buf, Ptr);
184 Ptr : in out Integer;
193 if ch = Character'Pos (Char1) or else ch = Character'Pos (Char2) then
194 Store_Char (File, ch, Buf, Ptr);
204 procedure Load_Digits
207 Ptr : in out Integer;
208 Loaded : out Boolean)
211 After_Digit : Boolean;
216 if ch not in Character'Pos ('0') .. Character'Pos ('9') then
224 Store_Char (File, ch, Buf, Ptr);
227 if ch in Character'Pos ('0') .. Character'Pos ('9') then
230 elsif ch = Character'Pos ('_') and then After_Digit then
231 After_Digit := False;
242 procedure Load_Digits
245 Ptr : in out Integer)
248 After_Digit : Boolean;
253 if ch in Character'Pos ('0') .. Character'Pos ('9') then
257 Store_Char (File, ch, Buf, Ptr);
260 if ch in Character'Pos ('0') .. Character'Pos ('9') then
263 elsif ch = Character'Pos ('_') and then After_Digit then
264 After_Digit := False;
275 --------------------------
276 -- Load_Extended_Digits --
277 --------------------------
279 procedure Load_Extended_Digits
282 Ptr : in out Integer;
283 Loaded : out Boolean)
286 After_Digit : Boolean := False;
294 if ch in Character'Pos ('0') .. Character'Pos ('9')
296 ch in Character'Pos ('a') .. Character'Pos ('f')
298 ch in Character'Pos ('A') .. Character'Pos ('F')
302 elsif ch = Character'Pos ('_') and then After_Digit then
303 After_Digit := False;
309 Store_Char (File, ch, Buf, Ptr);
314 end Load_Extended_Digits;
316 procedure Load_Extended_Digits
319 Ptr : in out Integer)
324 Load_Extended_Digits (File, Buf, Ptr, Junk);
325 end Load_Extended_Digits;
331 procedure Load_Skip (File : File_Type) is
335 FIO.Check_Read_Status (AP (File));
337 -- Loop till we find a non-blank character (note that as usual in
338 -- Text_IO, blank includes horizontal tab). Note that Get deals with
339 -- the Before_LM and Before_LM_PM flags appropriately.
343 exit when not Is_Blank (C);
346 Ungetc (Character'Pos (C), File);
347 File.Col := File.Col - 1;
358 Ptr : in out Integer)
363 FIO.Check_Read_Status (AP (File));
365 -- If we are immediately before a line mark, then we have no characters.
366 -- This is always a data error, so we may as well raise it right away.
368 if File.Before_LM then
372 for J in 1 .. Width loop
383 Store_Char (File, ch, Buf, Ptr);
393 function Nextc (File : File_Type) return int is
397 ch := fgetc (File.Stream);
400 if ferror (File.Stream) /= 0 then
416 procedure Put_Item (File : File_Type; Str : String) is
418 Check_On_One_Line (File, Str'Length);
430 Ptr : in out Integer)
433 File.Col := File.Col + 1;
435 if Ptr < Buf'Last then
439 Buf (Ptr) := Character'Val (ch);
446 procedure String_Skip (Str : String; Ptr : out Integer) is
451 if Ptr > Str'Last then
454 elsif not Is_Blank (Str (Ptr)) then
467 procedure Ungetc (ch : int; File : File_Type) is
470 if ungetc (ch, File.Stream) = EOF then
476 end Ada.Text_IO.Generic_Aux;