1 ------------------------------------------------------------------------------
3 -- GNAT RUNTIME COMPONENTS --
5 -- A D A . T E X T _ I O . G E N E R I C _ A U X --
10 -- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
12 -- GNAT is free software; you can redistribute it and/or modify it under --
13 -- terms of the GNU General Public License as published by the Free Soft- --
14 -- ware Foundation; either version 2, or (at your option) any later ver- --
15 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
16 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
17 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
18 -- for more details. You should have received a copy of the GNU General --
19 -- Public License distributed with GNAT; see file COPYING. If not, write --
20 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
21 -- MA 02111-1307, USA. --
23 -- As a special exception, if other files instantiate generics from this --
24 -- unit, or you link this unit with other files to produce an executable, --
25 -- this unit does not by itself cause the resulting executable to be --
26 -- covered by the GNU General Public License. This exception does not --
27 -- however invalidate any other reasons why the executable file might be --
28 -- covered by the GNU Public License. --
30 -- GNAT was originally developed by the GNAT team at New York University. --
31 -- Extensive contributions were provided by Ada Core Technologies Inc. --
33 ------------------------------------------------------------------------------
35 with Interfaces
.C_Streams
; use Interfaces
.C_Streams
;
37 with System
.File_Control_Block
;
39 package body Ada
.Text_IO
.Generic_Aux
is
41 package FIO
renames System
.File_IO
;
42 package FCB
renames System
.File_Control_Block
;
43 subtype AP
is FCB
.AFCB_Ptr
;
45 ------------------------
46 -- Check_End_Of_Field --
47 ------------------------
49 procedure Check_End_Of_Field
63 for J
in Ptr
.. Stop
loop
64 if not Is_Blank
(Buf
(J
)) then
69 end Check_End_Of_Field
;
71 -----------------------
72 -- Check_On_One_Line --
73 -----------------------
75 procedure Check_On_One_Line
80 FIO
.Check_Write_Status
(AP
(File
));
82 if File
.Line_Length
/= 0 then
83 if Count
(Length
) > File
.Line_Length
then
85 elsif File
.Col
+ Count
(Length
) > File
.Line_Length
+ 1 then
89 end Check_On_One_Line
;
95 function Getc
(File
: File_Type
) return int
is
99 ch
:= fgetc
(File
.Stream
);
101 if ch
= EOF
and then ferror
(File
.Stream
) /= 0 then
112 function Is_Blank
(C
: Character) return Boolean is
114 return C
= ' ' or else C
= ASCII
.HT
;
124 Ptr
: in out Integer;
126 Loaded
: out Boolean)
133 if ch
= Character'Pos (Char
) then
134 Store_Char
(File
, ch
, Buf
, Ptr
);
145 Ptr
: in out Integer;
153 if ch
= Character'Pos (Char
) then
154 Store_Char
(File
, ch
, Buf
, Ptr
);
163 Ptr
: in out Integer;
166 Loaded
: out Boolean)
173 if ch
= Character'Pos (Char1
) or else ch
= Character'Pos (Char2
) then
174 Store_Char
(File
, ch
, Buf
, Ptr
);
185 Ptr
: in out Integer;
194 if ch
= Character'Pos (Char1
) or else ch
= Character'Pos (Char2
) then
195 Store_Char
(File
, ch
, Buf
, Ptr
);
205 procedure Load_Digits
208 Ptr
: in out Integer;
209 Loaded
: out Boolean)
212 After_Digit
: Boolean;
217 if ch
not in Character'Pos ('0') .. Character'Pos ('9') then
225 Store_Char
(File
, ch
, Buf
, Ptr
);
228 if ch
in Character'Pos ('0') .. Character'Pos ('9') then
231 elsif ch
= Character'Pos ('_') and then After_Digit
then
232 After_Digit
:= False;
243 procedure Load_Digits
246 Ptr
: in out Integer)
249 After_Digit
: Boolean;
254 if ch
in Character'Pos ('0') .. Character'Pos ('9') then
258 Store_Char
(File
, ch
, Buf
, Ptr
);
261 if ch
in Character'Pos ('0') .. Character'Pos ('9') then
264 elsif ch
= Character'Pos ('_') and then After_Digit
then
265 After_Digit
:= False;
276 --------------------------
277 -- Load_Extended_Digits --
278 --------------------------
280 procedure Load_Extended_Digits
283 Ptr
: in out Integer;
284 Loaded
: out Boolean)
287 After_Digit
: Boolean := False;
295 if ch
in Character'Pos ('0') .. Character'Pos ('9')
297 ch
in Character'Pos ('a') .. Character'Pos ('f')
299 ch
in Character'Pos ('A') .. Character'Pos ('F')
303 elsif ch
= Character'Pos ('_') and then After_Digit
then
304 After_Digit
:= False;
310 Store_Char
(File
, ch
, Buf
, Ptr
);
315 end Load_Extended_Digits
;
317 procedure Load_Extended_Digits
320 Ptr
: in out Integer)
325 Load_Extended_Digits
(File
, Buf
, Ptr
, Junk
);
326 end Load_Extended_Digits
;
332 procedure Load_Skip
(File
: File_Type
) is
336 FIO
.Check_Read_Status
(AP
(File
));
338 -- Loop till we find a non-blank character (note that as usual in
339 -- Text_IO, blank includes horizontal tab). Note that Get deals with
340 -- the Before_LM and Before_LM_PM flags appropriately.
344 exit when not Is_Blank
(C
);
347 Ungetc
(Character'Pos (C
), File
);
348 File
.Col
:= File
.Col
- 1;
359 Ptr
: in out Integer)
364 FIO
.Check_Read_Status
(AP
(File
));
366 -- If we are immediately before a line mark, then we have no characters.
367 -- This is always a data error, so we may as well raise it right away.
369 if File
.Before_LM
then
373 for J
in 1 .. Width
loop
384 Store_Char
(File
, ch
, Buf
, Ptr
);
394 function Nextc
(File
: File_Type
) return int
is
398 ch
:= fgetc
(File
.Stream
);
401 if ferror
(File
.Stream
) /= 0 then
417 procedure Put_Item
(File
: File_Type
; Str
: String) is
419 Check_On_One_Line
(File
, Str
'Length);
431 Ptr
: in out Integer)
434 File
.Col
:= File
.Col
+ 1;
436 if Ptr
= Buf
'Last then
440 Buf
(Ptr
) := Character'Val (ch
);
448 procedure String_Skip
(Str
: String; Ptr
: out Integer) is
453 if Ptr
> Str
'Last then
456 elsif not Is_Blank
(Str
(Ptr
)) then
469 procedure Ungetc
(ch
: int
; File
: File_Type
) is
472 if ungetc
(ch
, File
.Stream
) = EOF
then
478 end Ada
.Text_IO
.Generic_Aux
;