URL https://opencores.org/ocsvn/openrisc_me/openrisc_me/trunk

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [ada/] [a-ztgeau.adb] - Blame information for rev 307

Go to most recent revision | Details | Compare with Previous | View Log


------------------------------------------------------------------------------
--                                                                          --
--                         GNAT RUN-TIME COMPONENTS                         --
--                                                                          --
--    A D A . W I D E _ W I D E _ T E X T _ I O . G E N E R I C _ A U X     --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
--                                                                          --
-- GNAT is free software;  you can  redistribute it  and/or modify it under --
-- terms of the  GNU General Public License as published  by the Free Soft- --
-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
--                                                                          --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception,   --
-- version 3.1, as published by the Free Software Foundation.               --
--                                                                          --
-- You should have received a copy of the GNU General Public License and    --
-- a copy of the GCC Runtime Library Exception along with this program;     --
-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
-- <http://www.gnu.org/licenses/>.                                          --
--                                                                          --
-- GNAT was originally developed  by the GNAT team at  New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc.      --
--                                                                          --
------------------------------------------------------------------------------
 
with Interfaces.C_Streams; use Interfaces.C_Streams;
with System.File_IO;
with System.File_Control_Block;
 
package body Ada.Wide_Wide_Text_IO.Generic_Aux is
 
   package FIO renames System.File_IO;
   package FCB renames System.File_Control_Block;
   subtype AP is FCB.AFCB_Ptr;
 
   ------------------------
   -- Check_End_Of_Field --
   ------------------------
 
   procedure Check_End_Of_Field
     (Buf   : String;
      Stop  : Integer;
      Ptr   : Integer;
      Width : Field)
   is
   begin
      if Ptr > Stop then
         return;
 
      elsif Width = 0 then
         raise Data_Error;
 
      else
         for J in Ptr .. Stop loop
            if not Is_Blank (Buf (J)) then
               raise Data_Error;
            end if;
         end loop;
      end if;
   end Check_End_Of_Field;
 
   -----------------------
   -- Check_On_One_Line --
   -----------------------
 
   procedure Check_On_One_Line
     (File   : File_Type;
      Length : Integer)
   is
   begin
      FIO.Check_Write_Status (AP (File));
 
      if File.Line_Length /= 0 then
         if Count (Length) > File.Line_Length then
            raise Layout_Error;
         elsif File.Col + Count (Length) > File.Line_Length + 1 then
            New_Line (File);
         end if;
      end if;
   end Check_On_One_Line;
 
   --------------
   -- Is_Blank --
   --------------
 
   function Is_Blank (C : Character) return Boolean is
   begin
      return C = ' ' or else C = ASCII.HT;
   end Is_Blank;
 
   ----------
   -- Load --
   ----------
 
   procedure Load
     (File   : File_Type;
      Buf    : out String;
      Ptr    : in out Integer;
      Char   : Character;
      Loaded : out Boolean)
   is
      ch : int;
 
   begin
      if File.Before_Wide_Wide_Character then
         Loaded := False;
         return;
 
      else
         ch := Getc (File);
 
         if ch = Character'Pos (Char) then
            Store_Char (File, ch, Buf, Ptr);
            Loaded := True;
         else
            Ungetc (ch, File);
            Loaded := False;
         end if;
      end if;
   end Load;
 
   procedure Load
     (File   : File_Type;
      Buf    : out String;
      Ptr    : in out Integer;
      Char   : Character)
   is
      ch : int;
 
   begin
      if File.Before_Wide_Wide_Character then
         null;
 
      else
         ch := Getc (File);
 
         if ch = Character'Pos (Char) then
            Store_Char (File, ch, Buf, Ptr);
         else
            Ungetc (ch, File);
         end if;
      end if;
   end Load;
 
   procedure Load
     (File   : File_Type;
      Buf    : out String;
      Ptr    : in out Integer;
      Char1  : Character;
      Char2  : Character;
      Loaded : out Boolean)
   is
      ch : int;
 
   begin
      if File.Before_Wide_Wide_Character then
         Loaded := False;
         return;
 
      else
         ch := Getc (File);
 
         if ch = Character'Pos (Char1)
           or else ch = Character'Pos (Char2)
         then
            Store_Char (File, ch, Buf, Ptr);
            Loaded := True;
         else
            Ungetc (ch, File);
            Loaded := False;
         end if;
      end if;
   end Load;
 
   procedure Load
     (File   : File_Type;
      Buf    : out String;
      Ptr    : in out Integer;
      Char1  : Character;
      Char2  : Character)
   is
      ch : int;
 
   begin
      if File.Before_Wide_Wide_Character then
         null;
 
      else
         ch := Getc (File);
 
         if ch = Character'Pos (Char1)
           or else ch = Character'Pos (Char2)
         then
            Store_Char (File, ch, Buf, Ptr);
         else
            Ungetc (ch, File);
         end if;
      end if;
   end Load;
 
   -----------------
   -- Load_Digits --
   -----------------
 
   procedure Load_Digits
     (File   : File_Type;
      Buf    : out String;
      Ptr    : in out Integer;
      Loaded : out Boolean)
   is
      ch          : int;
      After_Digit : Boolean;
 
   begin
      if File.Before_Wide_Wide_Character then
         Loaded := False;
         return;
 
      else
         ch := Getc (File);
 
         if ch not in Character'Pos ('0') .. Character'Pos ('9') then
            Loaded := False;
 
         else
            Loaded := True;
            After_Digit := True;
 
            loop
               Store_Char (File, ch, Buf, Ptr);
               ch := Getc (File);
 
               if ch in Character'Pos ('0') .. Character'Pos ('9') then
                  After_Digit := True;
 
               elsif ch = Character'Pos ('_') and then After_Digit then
                  After_Digit := False;
 
               else
                  exit;
               end if;
            end loop;
         end if;
 
         Ungetc (ch, File);
      end if;
   end Load_Digits;
 
   procedure Load_Digits
     (File   : File_Type;
      Buf    : out String;
      Ptr    : in out Integer)
   is
      ch          : int;
      After_Digit : Boolean;
 
   begin
      if File.Before_Wide_Wide_Character then
         return;
 
      else
         ch := Getc (File);
 
         if ch in Character'Pos ('0') .. Character'Pos ('9') then
            After_Digit := True;
 
            loop
               Store_Char (File, ch, Buf, Ptr);
               ch := Getc (File);
 
               if ch in Character'Pos ('0') .. Character'Pos ('9') then
                  After_Digit := True;
 
               elsif ch = Character'Pos ('_') and then After_Digit then
                  After_Digit := False;
 
               else
                  exit;
               end if;
            end loop;
         end if;
 
         Ungetc (ch, File);
      end if;
   end Load_Digits;
 
   --------------------------
   -- Load_Extended_Digits --
   --------------------------
 
   procedure Load_Extended_Digits
     (File   : File_Type;
      Buf    : out String;
      Ptr    : in out Integer;
      Loaded : out Boolean)
   is
      ch          : int;
      After_Digit : Boolean := False;
 
   begin
      if File.Before_Wide_Wide_Character then
         Loaded := False;
         return;
 
      else
         Loaded := False;
 
         loop
            ch := Getc (File);
 
            if ch in Character'Pos ('0') .. Character'Pos ('9')
                 or else
               ch in Character'Pos ('a') .. Character'Pos ('f')
                 or else
               ch in Character'Pos ('A') .. Character'Pos ('F')
            then
               After_Digit := True;
 
            elsif ch = Character'Pos ('_') and then After_Digit then
               After_Digit := False;
 
            else
               exit;
            end if;
 
            Store_Char (File, ch, Buf, Ptr);
            Loaded := True;
         end loop;
 
         Ungetc (ch, File);
      end if;
   end Load_Extended_Digits;
 
   procedure Load_Extended_Digits
     (File   : File_Type;
      Buf    : out String;
      Ptr    : in out Integer)
   is
      Junk : Boolean;
      pragma Unreferenced (Junk);
   begin
      Load_Extended_Digits (File, Buf, Ptr, Junk);
   end Load_Extended_Digits;
 
   ---------------
   -- Load_Skip --
   ---------------
 
   procedure Load_Skip (File  : File_Type) is
      C : Character;
 
   begin
      FIO.Check_Read_Status (AP (File));
 
      --  We need to explicitly test for the case of being before a wide
      --  character (greater than 16#7F#). Since no such character can
      --  ever legitimately be a valid numeric character, we can
      --  immediately signal Data_Error.
 
      if File.Before_Wide_Wide_Character then
         raise Data_Error;
      end if;
 
      --  Otherwise loop till we find a non-blank character (note that as
      --  usual in Wide_Wide_Text_IO, blank includes horizontal tab). Note that
      --  Get_Character deals with Before_LM/Before_LM_PM flags appropriately.
 
      loop
         Get_Character (File, C);
         exit when not Is_Blank (C);
      end loop;
 
      Ungetc (Character'Pos (C), File);
      File.Col := File.Col - 1;
   end Load_Skip;
 
   ----------------
   -- Load_Width --
   ----------------
 
   procedure Load_Width
     (File  : File_Type;
      Width : Field;
      Buf   : out String;
      Ptr   : in out Integer)
   is
      ch : int;
      WC : Wide_Wide_Character;
 
      Bad_Wide_Wide_C : Boolean := False;
      --  Set True if one of the characters read is not in range of type
      --  Character. This is always a Data_Error, but we do not signal it
      --  right away, since we have to read the full number of characters.
 
   begin
      FIO.Check_Read_Status (AP (File));
 
      --  If we are immediately before a line mark, then we have no characters.
      --  This is always a data error, so we may as well raise it right away.
 
      if File.Before_LM then
         raise Data_Error;
 
      else
         for J in 1 .. Width loop
            if File.Before_Wide_Wide_Character then
               Bad_Wide_Wide_C := True;
               Store_Char (File, 0, Buf, Ptr);
               File.Before_Wide_Wide_Character := False;
 
            else
               ch := Getc (File);
 
               if ch = EOF then
                  exit;
 
               elsif ch = LM then
                  Ungetc (ch, File);
                  exit;
 
               else
                  WC := Get_Wide_Wide_Char (Character'Val (ch), File);
                  ch := Wide_Wide_Character'Pos (WC);
 
                  if ch > 255 then
                     Bad_Wide_Wide_C := True;
                     ch := 0;
                  end if;
 
                  Store_Char (File, ch, Buf, Ptr);
               end if;
            end if;
         end loop;
 
         if Bad_Wide_Wide_C then
            raise Data_Error;
         end if;
      end if;
   end Load_Width;
 
   --------------
   -- Put_Item --
   --------------
 
   procedure Put_Item (File : File_Type; Str : String) is
   begin
      Check_On_One_Line (File, Str'Length);
 
      for J in Str'Range loop
         Put (File, Wide_Wide_Character'Val (Character'Pos (Str (J))));
      end loop;
   end Put_Item;
 
   ----------------
   -- Store_Char --
   ----------------
 
   procedure Store_Char
     (File : File_Type;
      ch   : Integer;
      Buf  : out String;
      Ptr  : in out Integer)
   is
   begin
      File.Col := File.Col + 1;
 
      if Ptr = Buf'Last then
         raise Data_Error;
      else
         Ptr := Ptr + 1;
         Buf (Ptr) := Character'Val (ch);
      end if;
   end Store_Char;
 
   -----------------
   -- String_Skip --
   -----------------
 
   procedure String_Skip (Str : String; Ptr : out Integer) is
   begin
      Ptr := Str'First;
 
      loop
         if Ptr > Str'Last then
            raise End_Error;
 
         elsif not Is_Blank (Str (Ptr)) then
            return;
 
         else
            Ptr := Ptr + 1;
         end if;
      end loop;
   end String_Skip;
 
   ------------
   -- Ungetc --
   ------------
 
   procedure Ungetc (ch : int; File : File_Type) is
   begin
      if ch /= EOF then
         if ungetc (ch, File.Stream) = EOF then
            raise Device_Error;
         end if;
      end if;
   end Ungetc;
 
end Ada.Wide_Wide_Text_IO.Generic_Aux;

Browse

Tools

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [ada/] [a-ztgeau.adb] - Blame information for rev 307

Line No.	Rev	Author	Line
1	281	jeremybenn	`------------------------------------------------------------------------------`
2			`-- --`
3			`-- GNAT RUN-TIME COMPONENTS --`
4			`-- --`
5			`-- A D A . W I D E _ W I D E _ T E X T _ I O . G E N E R I C _ A U X --`
6			`-- --`
7			`-- B o d y --`
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			`with Interfaces.C_Streams; use Interfaces.C_Streams;`
33			`with System.File_IO;`
34			`with System.File_Control_Block;`
35
36			`package body Ada.Wide_Wide_Text_IO.Generic_Aux is`
37
38			`package FIO renames System.File_IO;`
39			`package FCB renames System.File_Control_Block;`
40			`subtype AP is FCB.AFCB_Ptr;`
41
42			`------------------------`
43			`-- Check_End_Of_Field --`
44			`------------------------`
45
46			`procedure Check_End_Of_Field`
47			`(Buf : String;`
48			`Stop : Integer;`
49			`Ptr : Integer;`
50			`Width : Field)`
51			`is`
52			`begin`
53			`if Ptr > Stop then`
54			`return;`
55
56			`elsif Width = 0 then`
57			`raise Data_Error;`
58
59			`else`
60			`for J in Ptr .. Stop loop`
61			`if not Is_Blank (Buf (J)) then`
62			`raise Data_Error;`
63			`end if;`
64			`end loop;`
65			`end if;`
66			`end Check_End_Of_Field;`
67
68			`-----------------------`
69			`-- Check_On_One_Line --`
70			`-----------------------`
71
72			`procedure Check_On_One_Line`
73			`(File : File_Type;`
74			`Length : Integer)`
75			`is`
76			`begin`
77			`FIO.Check_Write_Status (AP (File));`
78
79			`if File.Line_Length /= 0 then`
80			`if Count (Length) > File.Line_Length then`
81			`raise Layout_Error;`
82			`elsif File.Col + Count (Length) > File.Line_Length + 1 then`
83			`New_Line (File);`
84			`end if;`
85			`end if;`
86			`end Check_On_One_Line;`
87
88			`--------------`
89			`-- Is_Blank --`
90			`--------------`
91
92			`function Is_Blank (C : Character) return Boolean is`
93			`begin`
94			`return C = ' ' or else C = ASCII.HT;`
95			`end Is_Blank;`
96
97			`----------`
98			`-- Load --`
99			`----------`
100
101			`procedure Load`
102			`(File : File_Type;`
103			`Buf : out String;`
104			`Ptr : in out Integer;`
105			`Char : Character;`
106			`Loaded : out Boolean)`
107			`is`
108			`ch : int;`
109
110			`begin`
111			`if File.Before_Wide_Wide_Character then`
112			`Loaded := False;`
113			`return;`
114
115			`else`
116			`ch := Getc (File);`
117
118			`if ch = Character'Pos (Char) then`
119			`Store_Char (File, ch, Buf, Ptr);`
120			`Loaded := True;`
121			`else`
122			`Ungetc (ch, File);`
123			`Loaded := False;`
124			`end if;`
125			`end if;`
126			`end Load;`
127
128			`procedure Load`
129			`(File : File_Type;`
130			`Buf : out String;`
131			`Ptr : in out Integer;`
132			`Char : Character)`
133			`is`
134			`ch : int;`
135
136			`begin`
137			`if File.Before_Wide_Wide_Character then`
138			`null;`
139
140			`else`
141			`ch := Getc (File);`
142
143			`if ch = Character'Pos (Char) then`
144			`Store_Char (File, ch, Buf, Ptr);`
145			`else`
146			`Ungetc (ch, File);`
147			`end if;`
148			`end if;`
149			`end Load;`
150
151			`procedure Load`
152			`(File : File_Type;`
153			`Buf : out String;`
154			`Ptr : in out Integer;`
155			`Char1 : Character;`
156			`Char2 : Character;`
157			`Loaded : out Boolean)`
158			`is`
159			`ch : int;`
160
161			`begin`
162			`if File.Before_Wide_Wide_Character then`
163			`Loaded := False;`
164			`return;`
165
166			`else`
167			`ch := Getc (File);`
168
169			`if ch = Character'Pos (Char1)`
170			`or else ch = Character'Pos (Char2)`
171			`then`
172			`Store_Char (File, ch, Buf, Ptr);`
173			`Loaded := True;`
174			`else`
175			`Ungetc (ch, File);`
176			`Loaded := False;`
177			`end if;`
178			`end if;`
179			`end Load;`
180
181			`procedure Load`
182			`(File : File_Type;`
183			`Buf : out String;`
184			`Ptr : in out Integer;`
185			`Char1 : Character;`
186			`Char2 : Character)`
187			`is`
188			`ch : int;`
189
190			`begin`
191			`if File.Before_Wide_Wide_Character then`
192			`null;`
193
194			`else`
195			`ch := Getc (File);`
196
197			`if ch = Character'Pos (Char1)`
198			`or else ch = Character'Pos (Char2)`
199			`then`
200			`Store_Char (File, ch, Buf, Ptr);`
201			`else`
202			`Ungetc (ch, File);`
203			`end if;`
204			`end if;`
205			`end Load;`
206
207			`-----------------`
208			`-- Load_Digits --`
209			`-----------------`
210
211			`procedure Load_Digits`
212			`(File : File_Type;`
213			`Buf : out String;`
214			`Ptr : in out Integer;`
215			`Loaded : out Boolean)`
216			`is`
217			`ch : int;`
218			`After_Digit : Boolean;`
219
220			`begin`
221			`if File.Before_Wide_Wide_Character then`
222			`Loaded := False;`
223			`return;`
224
225			`else`
226			`ch := Getc (File);`
227
228			`if ch not in Character'Pos ('0') .. Character'Pos ('9') then`
229			`Loaded := False;`
230
231			`else`
232			`Loaded := True;`
233			`After_Digit := True;`
234
235			`loop`
236			`Store_Char (File, ch, Buf, Ptr);`
237			`ch := Getc (File);`
238
239			`if ch in Character'Pos ('0') .. Character'Pos ('9') then`
240			`After_Digit := True;`
241
242			`elsif ch = Character'Pos ('_') and then After_Digit then`
243			`After_Digit := False;`
244
245			`else`
246			`exit;`
247			`end if;`
248			`end loop;`
249			`end if;`
250
251			`Ungetc (ch, File);`
252			`end if;`
253			`end Load_Digits;`
254
255			`procedure Load_Digits`
256			`(File : File_Type;`
257			`Buf : out String;`
258			`Ptr : in out Integer)`
259			`is`
260			`ch : int;`
261			`After_Digit : Boolean;`
262
263			`begin`
264			`if File.Before_Wide_Wide_Character then`
265			`return;`
266
267			`else`
268			`ch := Getc (File);`
269
270			`if ch in Character'Pos ('0') .. Character'Pos ('9') then`
271			`After_Digit := True;`
272
273			`loop`
274			`Store_Char (File, ch, Buf, Ptr);`
275			`ch := Getc (File);`
276
277			`if ch in Character'Pos ('0') .. Character'Pos ('9') then`
278			`After_Digit := True;`
279
280			`elsif ch = Character'Pos ('_') and then After_Digit then`
281			`After_Digit := False;`
282
283			`else`
284			`exit;`
285			`end if;`
286			`end loop;`
287			`end if;`
288
289			`Ungetc (ch, File);`
290			`end if;`
291			`end Load_Digits;`
292
293			`--------------------------`
294			`-- Load_Extended_Digits --`
295			`--------------------------`
296
297			`procedure Load_Extended_Digits`
298			`(File : File_Type;`
299			`Buf : out String;`
300			`Ptr : in out Integer;`
301			`Loaded : out Boolean)`
302			`is`
303			`ch : int;`
304			`After_Digit : Boolean := False;`
305
306			`begin`
307			`if File.Before_Wide_Wide_Character then`
308			`Loaded := False;`
309			`return;`
310
311			`else`
312			`Loaded := False;`
313
314			`loop`
315			`ch := Getc (File);`
316
317			`if ch in Character'Pos ('0') .. Character'Pos ('9')`
318			`or else`
319			`ch in Character'Pos ('a') .. Character'Pos ('f')`
320			`or else`
321			`ch in Character'Pos ('A') .. Character'Pos ('F')`
322			`then`
323			`After_Digit := True;`
324
325			`elsif ch = Character'Pos ('_') and then After_Digit then`
326			`After_Digit := False;`
327
328			`else`
329			`exit;`
330			`end if;`
331
332			`Store_Char (File, ch, Buf, Ptr);`
333			`Loaded := True;`
334			`end loop;`
335
336			`Ungetc (ch, File);`
337			`end if;`
338			`end Load_Extended_Digits;`
339
340			`procedure Load_Extended_Digits`
341			`(File : File_Type;`
342			`Buf : out String;`
343			`Ptr : in out Integer)`
344			`is`
345			`Junk : Boolean;`
346			`pragma Unreferenced (Junk);`
347			`begin`
348			`Load_Extended_Digits (File, Buf, Ptr, Junk);`
349			`end Load_Extended_Digits;`
350
351			`---------------`
352			`-- Load_Skip --`
353			`---------------`
354
355			`procedure Load_Skip (File : File_Type) is`
356			`C : Character;`
357
358			`begin`
359			`FIO.Check_Read_Status (AP (File));`
360
361			`-- We need to explicitly test for the case of being before a wide`
362			`-- character (greater than 16#7F#). Since no such character can`
363			`-- ever legitimately be a valid numeric character, we can`
364			`-- immediately signal Data_Error.`
365
366			`if File.Before_Wide_Wide_Character then`
367			`raise Data_Error;`
368			`end if;`
369
370			`-- Otherwise loop till we find a non-blank character (note that as`
371			`-- usual in Wide_Wide_Text_IO, blank includes horizontal tab). Note that`
372			`-- Get_Character deals with Before_LM/Before_LM_PM flags appropriately.`
373
374			`loop`
375			`Get_Character (File, C);`
376			`exit when not Is_Blank (C);`
377			`end loop;`
378
379			`Ungetc (Character'Pos (C), File);`
380			`File.Col := File.Col - 1;`
381			`end Load_Skip;`
382
383			`----------------`
384			`-- Load_Width --`
385			`----------------`
386
387			`procedure Load_Width`
388			`(File : File_Type;`
389			`Width : Field;`
390			`Buf : out String;`
391			`Ptr : in out Integer)`
392			`is`
393			`ch : int;`
394			`WC : Wide_Wide_Character;`
395
396			`Bad_Wide_Wide_C : Boolean := False;`
397			`-- Set True if one of the characters read is not in range of type`
398			`-- Character. This is always a Data_Error, but we do not signal it`
399			`-- right away, since we have to read the full number of characters.`
400
401			`begin`
402			`FIO.Check_Read_Status (AP (File));`
403
404			`-- If we are immediately before a line mark, then we have no characters.`
405			`-- This is always a data error, so we may as well raise it right away.`
406
407			`if File.Before_LM then`
408			`raise Data_Error;`
409
410			`else`
411			`for J in 1 .. Width loop`
412			`if File.Before_Wide_Wide_Character then`
413			`Bad_Wide_Wide_C := True;`
414			`Store_Char (File, 0, Buf, Ptr);`
415			`File.Before_Wide_Wide_Character := False;`
416
417			`else`
418			`ch := Getc (File);`
419
420			`if ch = EOF then`
421			`exit;`
422
423			`elsif ch = LM then`
424			`Ungetc (ch, File);`
425			`exit;`
426
427			`else`
428			`WC := Get_Wide_Wide_Char (Character'Val (ch), File);`
429			`ch := Wide_Wide_Character'Pos (WC);`
430
431			`if ch > 255 then`
432			`Bad_Wide_Wide_C := True;`
433			`ch := 0;`
434			`end if;`
435
436			`Store_Char (File, ch, Buf, Ptr);`
437			`end if;`
438			`end if;`
439			`end loop;`
440
441			`if Bad_Wide_Wide_C then`
442			`raise Data_Error;`
443			`end if;`
444			`end if;`
445			`end Load_Width;`
446
447			`--------------`
448			`-- Put_Item --`
449			`--------------`
450
451			`procedure Put_Item (File : File_Type; Str : String) is`
452			`begin`
453			`Check_On_One_Line (File, Str'Length);`
454
455			`for J in Str'Range loop`
456			`Put (File, Wide_Wide_Character'Val (Character'Pos (Str (J))));`
457			`end loop;`
458			`end Put_Item;`
459
460			`----------------`
461			`-- Store_Char --`
462			`----------------`
463
464			`procedure Store_Char`
465			`(File : File_Type;`
466			`ch : Integer;`
467			`Buf : out String;`
468			`Ptr : in out Integer)`
469			`is`
470			`begin`
471			`File.Col := File.Col + 1;`
472
473			`if Ptr = Buf'Last then`
474			`raise Data_Error;`
475			`else`
476			`Ptr := Ptr + 1;`
477			`Buf (Ptr) := Character'Val (ch);`
478			`end if;`
479			`end Store_Char;`
480
481			`-----------------`
482			`-- String_Skip --`
483			`-----------------`
484
485			`procedure String_Skip (Str : String; Ptr : out Integer) is`
486			`begin`
487			`Ptr := Str'First;`
488
489			`loop`
490			`if Ptr > Str'Last then`
491			`raise End_Error;`
492
493			`elsif not Is_Blank (Str (Ptr)) then`
494			`return;`
495
496			`else`
497			`Ptr := Ptr + 1;`
498			`end if;`
499			`end loop;`
500			`end String_Skip;`
501
502			`------------`
503			`-- Ungetc --`
504			`------------`
505
506			`procedure Ungetc (ch : int; File : File_Type) is`
507			`begin`
508			`if ch /= EOF then`
509			`if ungetc (ch, File.Stream) = EOF then`
510			`raise Device_Error;`
511			`end if;`
512			`end if;`
513			`end Ungetc;`
514
515			`end Ada.Wide_Wide_Text_IO.Generic_Aux;`