1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
|
------------------------------------------------------------------------------
-- --
-- POLYORB COMPONENTS --
-- --
-- S O U R C E _ I N P U T --
-- --
-- B o d y --
-- --
-- Copyright (C) 2011-2012, Free Software Foundation, Inc. --
-- --
-- This 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. This software is distributed in the hope that it will be useful, --
-- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- --
-- TABILITY 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 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/>. --
-- --
-- PolyORB is maintained by AdaCore --
-- (email: sales@adacore.com) --
-- --
------------------------------------------------------------------------------
with Ada.Containers.Hashed_Maps; use Ada.Containers;
with Ada.Containers.Vectors;
with GNAT.OS_Lib; use GNAT.OS_Lib;
with Errors; use Errors;
with Namet; use Namet;
package body Source_Input is
-- Vector of source files in creation order
package Source_File_Vectors is new Vectors
(Index_Type => Positive,
Element_Type => Source_File_Ptr);
use Source_File_Vectors;
Source_Files : Source_File_Vectors.Vector;
-- Contains all source files in creation order. Open_Source appends to
-- this; elements are never removed. Used by Iterate_Source_Files.
-- Mapping from file names to source files
package Source_File_Maps is new Hashed_Maps
(Key_Type => Name_Id,
Element_Type => Source_File_Ptr,
Hash => Hash,
Equivalent_Keys => "=");
use Source_File_Maps;
Source_File_Map : Source_File_Maps.Map;
-- Contains all True_Source files. Open_Source inserts in this; elements
-- are never removed. Used by Named_File. It is important to avoid putting
-- Preprocessed_Source files in this mapping, because on Windows, all the
-- temp files get the same name (they are deleted immediately after being
-- read). We can't have duplicates.
-----------------------------
-- Copy_To_Standard_Output --
-----------------------------
procedure Copy_To_Standard_Output (Source : Source_File) is
Ignore : Integer;
pragma Unreferenced (Ignore);
Buf : Text_Buffer renames Source.Buffer.all;
begin
Ignore := Write (Standout, Buf'Address, Buf'Length - 1);
-- Deliberately ignore result on output; it's not clear what we could
-- do about any failure.
-- "- 1" is to leave out the EOF terminator
end Copy_To_Standard_Output;
-------------------
-- Iterate_Lines --
-------------------
procedure Iterate_Lines
(Source : Source_File;
Process : not null access procedure (Line : String)) is
Buf : Text_Buffer renames Source.Buffer.all;
First : Text_Ptr := 1;
Last : Text_Ptr := 0;
begin
while Last < Buf'Last loop
while Buf (Last + 1) /= EOF and then
Buf (Last + 1) /= ASCII.CR and then
Buf (Last + 1) /= ASCII.LF
loop
Last := Last + 1;
end loop;
Process (String (Buf (First .. Last)));
-- Skip end-of-line characters, which could be any of LF, CR, or
-- CRLF. Buf (Last + 1) always exists below, because there's an
-- extra EOF at the end.
Last := Last + 1;
if Buf (Last) = ASCII.CR and then Buf (Last + 1) = ASCII.LF then
Last := Last + 1;
end if;
-- Next line starts after end-of-line characters
First := Last + 1;
end loop;
end Iterate_Lines;
--------------------------
-- Iterate_Source_Files --
--------------------------
procedure Iterate_Source_Files
(Process : not null access procedure (Source : Source_File)) is
procedure Call_Process (Position : Source_File_Vectors.Cursor);
-- Wrapper just to get the Source_File from the cursor
------------------
-- Call_Process --
------------------
procedure Call_Process (Position : Source_File_Vectors.Cursor) is
begin
Process (Element (Position).all);
end Call_Process;
begin
Iterate (Source_Files, Call_Process'Access);
end Iterate_Source_Files;
----------------
-- Named_File --
----------------
function Named_File (Name : Name_Id) return Source_File_Ptr is
begin
return Element (Source_File_Map, Name);
end Named_File;
-----------------
-- Open_Source --
-----------------
function Open_Source
(Name : Name_Id; Kind : Source_Kind) return Source_File_Ptr
is
Name_String : aliased constant String :=
Get_Name_String (Name) & ASCII.NUL;
FD : constant File_Descriptor := Open_Read (Name_String'Address, Binary);
begin
if FD = Invalid_FD then
case Kind is
when True_Source =>
DE ("file not found: %", Get_Name_String (Name));
when Preprocessed_Source =>
DE ("preprocessor output file not found: %",
Get_Name_String (Name));
end case;
raise Fatal_Error;
end if;
declare
Length : Integer := Integer (File_Length (FD));
Result : constant Source_File_Ptr := new Source_File'
(Name => Name,
Buffer => new Text_Buffer (1 .. Text_Ptr (Length) + 1),
-- "+ 1" is room for the last character to be EOF
Kind => Kind);
Buf : Text_Buffer renames Result.Buffer.all;
Pos : Text_Ptr := 1; -- position in buffer to read into
Read_RC : Integer; -- return code from Read
begin
-- Put the Result in the two containers
Append (Source_Files, Result);
-- Put it in Source_File_Map only if it's a True_Source
case Kind is
when True_Source =>
Insert (Source_File_Map, Name, Result);
when Preprocessed_Source =>
null;
end case;
-- Read the entire contents of the file
loop
Read_RC := Read (FD, Buf (Pos)'Address, Length);
exit when Read_RC = Length;
if Read_RC <= 0 then
DE ("cannot read: %", Get_Name_String (Name));
raise Fatal_Error;
end if;
Pos := Pos + Text_Ptr (Read_RC);
Length := Length - Read_RC;
end loop;
Close (FD);
-- Terminate buffer with EOF
Buf (Buf'Length) := EOF;
return Result;
end;
end Open_Source;
end Source_Input;
|
