diff options
Diffstat (limited to 'gcc-4.8/gcc/ada/a-tigeli.adb')
| -rw-r--r-- | gcc-4.8/gcc/ada/a-tigeli.adb | 227 |
1 files changed, 0 insertions, 227 deletions
diff --git a/gcc-4.8/gcc/ada/a-tigeli.adb b/gcc-4.8/gcc/ada/a-tigeli.adb deleted file mode 100644 index c23cd3478..000000000 --- a/gcc-4.8/gcc/ada/a-tigeli.adb +++ /dev/null @@ -1,227 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT RUN-TIME COMPONENTS -- --- -- --- A D A . T E X T _ I O . G E T _ L I N E -- --- -- --- B o d y -- --- -- --- Copyright (C) 1992-2010, 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. -- --- -- ------------------------------------------------------------------------------- - --- The implementation of Ada.Text_IO.Get_Line is split into a subunit so that --- different implementations can be used on different systems. This is the --- standard implementation (it uses low level features not suitable for use --- in the JVM or .NET implementations). - -with System; use System; -with System.Storage_Elements; use System.Storage_Elements; - -separate (Ada.Text_IO) -procedure Get_Line - (File : File_Type; - Item : out String; - Last : out Natural) -is - Chunk_Size : constant := 80; - -- We read into a fixed size auxiliary buffer. Because this buffer - -- needs to be pre-initialized, there is a trade-off between size and - -- speed. Experiments find returns are diminishing after 50 and this - -- size allows most lines to be processed with a single read. - - ch : int; - N : Natural; - - procedure memcpy (s1, s2 : chars; n : size_t); - pragma Import (C, memcpy); - - function memchr (s : chars; ch : int; n : size_t) return chars; - pragma Import (C, memchr); - - procedure memset (b : chars; ch : int; n : size_t); - pragma Import (C, memset); - - function Get_Chunk (N : Positive) return Natural; - -- Reads at most N - 1 characters into Item (Last + 1 .. Item'Last), - -- updating Last. Raises End_Error if nothing was read (End_Of_File). - -- Returns number of characters still to read (either 0 or 1) in - -- case of success. - - --------------- - -- Get_Chunk -- - --------------- - - function Get_Chunk (N : Positive) return Natural is - Buf : String (1 .. Chunk_Size); - S : constant chars := Buf (1)'Address; - P : chars; - - begin - if N = 1 then - return N; - end if; - - memset (S, 10, size_t (N)); - - if fgets (S, N, File.Stream) = Null_Address then - if ferror (File.Stream) /= 0 then - raise Device_Error; - - -- If incomplete last line, pretend we found a LM - - elsif Last >= Item'First then - return 0; - - else - raise End_Error; - end if; - end if; - - P := memchr (S, LM, size_t (N)); - - -- If no LM is found, the buffer got filled without reading a new - -- line. Otherwise, the LM is either one from the input, or else one - -- from the initialization, which means an incomplete end-of-line was - -- encountered. Only in first case the LM will be followed by a 0. - - if P = Null_Address then - pragma Assert (Buf (N) = ASCII.NUL); - memcpy (Item (Last + 1)'Address, - Buf (1)'Address, size_t (N - 1)); - Last := Last + N - 1; - - return 1; - - else - -- P points to the LM character. Set K so Buf (K) is the character - -- right before. - - declare - K : Natural := Natural (P - S); - - begin - -- Now Buf (K + 2) should be 0, or otherwise Buf (K) is the 0 - -- put in by fgets, so compensate. - - if K + 2 > Buf'Last or else Buf (K + 2) /= ASCII.NUL then - - -- Incomplete last line, so remove the extra 0 - - pragma Assert (Buf (K) = ASCII.NUL); - K := K - 1; - end if; - - memcpy (Item (Last + 1)'Address, - Buf (1)'Address, size_t (K)); - Last := Last + K; - end; - - return 0; - end if; - end Get_Chunk; - --- Start of processing for Get_Line - -begin - FIO.Check_Read_Status (AP (File)); - - -- Immediate exit for null string, this is a case in which we do not - -- need to test for end of file and we do not skip a line mark under - -- any circumstances. - - if Item'First > Item'Last then - return; - end if; - - N := Item'Last - Item'First + 1; - - Last := Item'First - 1; - - -- Here we have at least one character, if we are immediately before - -- a line mark, then we will just skip past it storing no characters. - - if File.Before_LM then - File.Before_LM := False; - File.Before_LM_PM := False; - - -- Otherwise we need to read some characters - - else - while N >= Chunk_Size loop - if Get_Chunk (Chunk_Size) = 0 then - N := 0; - else - N := N - Chunk_Size + 1; - end if; - end loop; - - if N > 1 then - N := Get_Chunk (N); - end if; - - -- Almost there, only a little bit more to read - - if N = 1 then - ch := Getc (File); - - -- If we get EOF after already reading data, this is an incomplete - -- last line, in which case no End_Error should be raised. - - if ch = EOF and then Last < Item'First then - raise End_Error; - - elsif ch /= LM then - - -- Buffer really is full without having seen LM, update col - - Last := Last + 1; - Item (Last) := Character'Val (ch); - File.Col := File.Col + Count (Last - Item'First + 1); - return; - end if; - end if; - end if; - - -- We have skipped past, but not stored, a line mark. Skip following - -- page mark if one follows, but do not do this for a non-regular file - -- (since otherwise we get annoying wait for an extra character) - - File.Line := File.Line + 1; - File.Col := 1; - - if File.Before_LM_PM then - File.Line := 1; - File.Before_LM_PM := False; - File.Page := File.Page + 1; - - elsif File.Is_Regular_File then - ch := Getc (File); - - if ch = PM and then File.Is_Regular_File then - File.Line := 1; - File.Page := File.Page + 1; - else - Ungetc (ch, File); - end if; - end if; -end Get_Line; |