1------------------------------------------------------------------------------ 2-- -- 3-- GNAT RUN-TIME COMPONENTS -- 4-- -- 5-- A D A . T E X T _ I O . G E T _ L I N E -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 1992-2018, Free Software Foundation, Inc. -- 10-- -- 11-- GNAT is free software; you can redistribute it and/or modify it under -- 12-- terms of the GNU General Public License as published by the Free Soft- -- 13-- ware Foundation; either version 3, or (at your option) any later ver- -- 14-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- 15-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- 16-- or FITNESS FOR A PARTICULAR PURPOSE. -- 17-- -- 18-- As a special exception under Section 7 of GPL version 3, you are granted -- 19-- additional permissions described in the GCC Runtime Library Exception, -- 20-- version 3.1, as published by the Free Software Foundation. -- 21-- -- 22-- You should have received a copy of the GNU General Public License and -- 23-- a copy of the GCC Runtime Library Exception along with this program; -- 24-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 25-- <http://www.gnu.org/licenses/>. -- 26-- -- 27-- GNAT was originally developed by the GNAT team at New York University. -- 28-- Extensive contributions were provided by Ada Core Technologies Inc. -- 29-- -- 30------------------------------------------------------------------------------ 31 32-- The implementation of Ada.Text_IO.Get_Line is split into a subunit so that 33-- different implementations can be used on different systems. This is the 34-- standard implementation (it uses low level features not suitable for use 35-- on virtual machines). 36 37with System; use System; 38with System.Storage_Elements; use System.Storage_Elements; 39 40separate (Ada.Text_IO) 41procedure Get_Line 42 (File : File_Type; 43 Item : out String; 44 Last : out Natural) 45is 46 Chunk_Size : constant := 80; 47 -- We read into a fixed size auxiliary buffer. Because this buffer 48 -- needs to be pre-initialized, there is a trade-off between size and 49 -- speed. Experiments find returns are diminishing after 50 and this 50 -- size allows most lines to be processed with a single read. 51 52 ch : int; 53 N : Natural; 54 55 procedure memcpy (s1, s2 : chars; n : size_t); 56 pragma Import (C, memcpy); 57 58 function memchr (s : chars; ch : int; n : size_t) return chars; 59 pragma Import (C, memchr); 60 61 procedure memset (b : chars; ch : int; n : size_t); 62 pragma Import (C, memset); 63 64 function Get_Chunk (N : Positive) return Natural; 65 -- Reads at most N - 1 characters into Item (Last + 1 .. Item'Last), 66 -- updating Last. Raises End_Error if nothing was read (End_Of_File). 67 -- Returns number of characters still to read (either 0 or 1) in 68 -- case of success. 69 70 --------------- 71 -- Get_Chunk -- 72 --------------- 73 74 function Get_Chunk (N : Positive) return Natural is 75 Buf : String (1 .. Chunk_Size); 76 S : constant chars := Buf (1)'Address; 77 P : chars; 78 79 begin 80 if N = 1 then 81 return N; 82 end if; 83 84 memset (S, 10, size_t (N)); 85 86 if fgets (S, N, File.Stream) = Null_Address then 87 if ferror (File.Stream) /= 0 then 88 raise Device_Error; 89 90 -- If incomplete last line, pretend we found a LM 91 92 elsif Last >= Item'First then 93 return 0; 94 95 else 96 raise End_Error; 97 end if; 98 end if; 99 100 P := memchr (S, LM, size_t (N)); 101 102 -- If no LM is found, the buffer got filled without reading a new 103 -- line. Otherwise, the LM is either one from the input, or else one 104 -- from the initialization, which means an incomplete end-of-line was 105 -- encountered. Only in first case the LM will be followed by a 0. 106 107 if P = Null_Address then 108 pragma Assert (Buf (N) = ASCII.NUL); 109 memcpy (Item (Last + 1)'Address, 110 Buf (1)'Address, size_t (N - 1)); 111 Last := Last + N - 1; 112 113 return 1; 114 115 else 116 -- P points to the LM character. Set K so Buf (K) is the character 117 -- right before. 118 119 declare 120 K : Natural := Natural (P - S); 121 122 begin 123 -- If K + 2 is greater than N, then Buf (K + 1) cannot be a LM 124 -- character from the source file, as the call to fgets copied at 125 -- most N - 1 characters. Otherwise, either LM is a character from 126 -- the source file and then Buf (K + 2) should be 0, or LM is a 127 -- character put in Buf by memset and then Buf (K) is the 0 put in 128 -- by fgets. In both cases where LM does not come from the source 129 -- file, compensate. 130 131 if K + 2 > N or else Buf (K + 2) /= ASCII.NUL then 132 133 -- Incomplete last line, so remove the extra 0 134 135 pragma Assert (Buf (K) = ASCII.NUL); 136 K := K - 1; 137 end if; 138 139 memcpy (Item (Last + 1)'Address, 140 Buf (1)'Address, size_t (K)); 141 Last := Last + K; 142 end; 143 144 return 0; 145 end if; 146 end Get_Chunk; 147 148-- Start of processing for Get_Line 149 150begin 151 FIO.Check_Read_Status (AP (File)); 152 153 -- Set Last to Item'First - 1 when no characters are read, as mandated by 154 -- Ada RM. In the case where Item'First is negative or null, this results 155 -- in Constraint_Error being raised. 156 157 Last := Item'First - 1; 158 159 -- Immediate exit for null string, this is a case in which we do not 160 -- need to test for end of file and we do not skip a line mark under 161 -- any circumstances. 162 163 if Item'First > Item'Last then 164 return; 165 end if; 166 167 N := Item'Last - Item'First + 1; 168 169 -- Here we have at least one character, if we are immediately before 170 -- a line mark, then we will just skip past it storing no characters. 171 172 if File.Before_LM then 173 File.Before_LM := False; 174 File.Before_LM_PM := False; 175 176 -- Otherwise we need to read some characters 177 178 else 179 while N >= Chunk_Size loop 180 if Get_Chunk (Chunk_Size) = 0 then 181 N := 0; 182 else 183 N := N - Chunk_Size + 1; 184 end if; 185 end loop; 186 187 if N > 1 then 188 N := Get_Chunk (N); 189 end if; 190 191 -- Almost there, only a little bit more to read 192 193 if N = 1 then 194 ch := Getc (File); 195 196 -- If we get EOF after already reading data, this is an incomplete 197 -- last line, in which case no End_Error should be raised. 198 199 if ch = EOF then 200 if Last < Item'First then 201 raise End_Error; 202 203 else -- All done 204 return; 205 end if; 206 207 elsif ch /= LM then 208 209 -- Buffer really is full without having seen LM, update col 210 211 Last := Last + 1; 212 Item (Last) := Character'Val (ch); 213 File.Col := File.Col + Count (Last - Item'First + 1); 214 return; 215 end if; 216 end if; 217 end if; 218 219 -- We have skipped past, but not stored, a line mark. Skip following 220 -- page mark if one follows, but do not do this for a non-regular file 221 -- (since otherwise we get annoying wait for an extra character) 222 223 File.Line := File.Line + 1; 224 File.Col := 1; 225 226 if File.Before_LM_PM then 227 File.Line := 1; 228 File.Before_LM_PM := False; 229 File.Page := File.Page + 1; 230 231 elsif File.Is_Regular_File then 232 ch := Getc (File); 233 234 if ch = PM and then File.Is_Regular_File then 235 File.Line := 1; 236 File.Page := File.Page + 1; 237 else 238 Ungetc (ch, File); 239 end if; 240 end if; 241end Get_Line; 242