X-Git-Url: https://oss.titaniummirror.com/gitweb?a=blobdiff_plain;f=gcc%2Fada%2Fa-wtgeau.adb;fp=gcc%2Fada%2Fa-wtgeau.adb;h=0000000000000000000000000000000000000000;hb=6fed43773c9b0ce596dca5686f37ac3fc0fa11c0;hp=da4b8d1d19cacf11da092690d6a374435d0d874f;hpb=27b11d56b743098deb193d510b337ba22dc52e5c;p=msp430-gcc.git diff --git a/gcc/ada/a-wtgeau.adb b/gcc/ada/a-wtgeau.adb deleted file mode 100644 index da4b8d1d..00000000 --- a/gcc/ada/a-wtgeau.adb +++ /dev/null @@ -1,520 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT RUNTIME COMPONENTS -- --- -- --- A D A . W I D E _ T E X T _ I O . G E N E R I C _ A U X -- --- -- --- B o d y -- --- -- --- $Revision: 1.1.16.1 $ --- -- --- Copyright (C) 1992-2000 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 2, 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. See the GNU General Public License -- --- for more details. You should have received a copy of the GNU General -- --- Public License distributed with GNAT; see file COPYING. If not, write -- --- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- --- MA 02111-1307, USA. -- --- -- --- As a special exception, if other files instantiate generics from this -- --- unit, or you link this unit with other files to produce an executable, -- --- this unit does not by itself cause the resulting executable to be -- --- covered by the GNU General Public License. This exception does not -- --- however invalidate any other reasons why the executable file might be -- --- covered by the GNU Public License. -- --- -- --- 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_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 - (File : File_Type; - 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_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_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_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_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_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_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_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; - - 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_Character then - raise Data_Error; - end if; - - -- Otherwise loop till we find a non-blank character (note that as - -- usual in 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_Character; - - Bad_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_Character then - Bad_Wide_C := True; - Store_Char (File, 0, Buf, Ptr); - File.Before_Wide_Character := False; - - else - ch := Getc (File); - - if ch = EOF then - exit; - - elsif ch = LM then - Ungetc (ch, File); - exit; - - else - WC := Get_Wide_Char (Character'Val (ch), File); - ch := Wide_Character'Pos (WC); - - if ch > 255 then - Bad_Wide_C := True; - ch := 0; - end if; - - Store_Char (File, ch, Buf, Ptr); - end if; - end if; - end loop; - - if Bad_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_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_Text_IO.Generic_Aux;