228 lines
7.7 KiB
Ada
228 lines
7.7 KiB
Ada
------------------------------------------------------------------------------
|
|
-- --
|
|
-- 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-2015, 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
|
|
-- on virtual machines).
|
|
|
|
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;
|