URL
https://opencores.org/ocsvn/openrisc/openrisc/trunk
Subversion Repositories openrisc
[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [ada/] [a-tigeli.adb] - Rev 778
Go to most recent revision | Compare with Previous | Blame | View Log
------------------------------------------------------------------------------ -- -- -- 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;
Go to most recent revision | Compare with Previous | Blame | View Log