diff options
Diffstat (limited to 'gcc-4.7/gcc/ada/a-tigeau.adb')
| -rw-r--r-- | gcc-4.7/gcc/ada/a-tigeau.adb | 474 |
1 files changed, 0 insertions, 474 deletions
diff --git a/gcc-4.7/gcc/ada/a-tigeau.adb b/gcc-4.7/gcc/ada/a-tigeau.adb deleted file mode 100644 index 24d753b04..000000000 --- a/gcc-4.7/gcc/ada/a-tigeau.adb +++ /dev/null @@ -1,474 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT RUN-TIME COMPONENTS -- --- -- --- A D A . 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.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; - - ---------- - -- Getc -- - ---------- - - function Getc (File : File_Type) return int is - ch : int; - - begin - ch := fgetc (File.Stream); - - if ch = EOF and then ferror (File.Stream) /= 0 then - raise Device_Error; - else - return ch; - end if; - end Getc; - - -------------- - -- 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 - 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 Load; - - procedure Load - (File : File_Type; - Buf : out String; - Ptr : in out Integer; - Char : Character) - is - ch : int; - - begin - ch := Getc (File); - - if ch = Character'Pos (Char) then - Store_Char (File, ch, Buf, Ptr); - else - Ungetc (ch, File); - 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 - 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 Load; - - procedure Load - (File : File_Type; - Buf : out String; - Ptr : in out Integer; - Char1 : Character; - Char2 : Character) - is - ch : int; - - begin - 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 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 - 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 Load_Digits; - - procedure Load_Digits - (File : File_Type; - Buf : out String; - Ptr : in out Integer) - is - ch : int; - After_Digit : Boolean; - - begin - 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 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 - 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 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)); - - -- Loop till we find a non-blank character (note that as usual in - -- Text_IO, blank includes horizontal tab). Note that Get deals with - -- the Before_LM and Before_LM_PM flags appropriately. - - loop - Get (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; - - 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 - ch := Getc (File); - - if ch = EOF then - return; - - elsif ch = LM then - Ungetc (ch, File); - return; - - else - Store_Char (File, ch, Buf, Ptr); - end if; - end loop; - end if; - end Load_Width; - - ----------- - -- Nextc -- - ----------- - - function Nextc (File : File_Type) return int is - ch : int; - - begin - ch := fgetc (File.Stream); - - if ch = EOF then - if ferror (File.Stream) /= 0 then - raise Device_Error; - else - return EOF; - end if; - - else - Ungetc (ch, File); - return ch; - end if; - end Nextc; - - -------------- - -- Put_Item -- - -------------- - - procedure Put_Item (File : File_Type; Str : String) is - begin - Check_On_One_Line (File, Str'Length); - Put (File, Str); - end Put_Item; - - ---------------- - -- Store_Char -- - ---------------- - - procedure Store_Char - (File : File_Type; - ch : int; - Buf : in out String; - Ptr : in out Integer) - is - begin - File.Col := File.Col + 1; - - if Ptr < Buf'Last then - Ptr := Ptr + 1; - end if; - - Buf (Ptr) := Character'Val (ch); - 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.Text_IO.Generic_Aux; |