|
111
|
1 ------------------------------------------------------------------------------
|
|
|
2 -- --
|
|
|
3 -- GNAT COMPILER COMPONENTS --
|
|
|
4 -- --
|
|
|
5 -- S I N P U T . L --
|
|
|
6 -- --
|
|
|
7 -- B o d y --
|
|
|
8 -- --
|
|
|
9 -- Copyright (C) 1992-2017, 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. See the GNU General Public License --
|
|
|
17 -- for more details. You should have received a copy of the GNU General --
|
|
|
18 -- Public License distributed with GNAT; see file COPYING3. If not, go to --
|
|
|
19 -- http://www.gnu.org/licenses for a complete copy of the license. --
|
|
|
20 -- --
|
|
|
21 -- GNAT was originally developed by the GNAT team at New York University. --
|
|
|
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
|
|
|
23 -- --
|
|
|
24 ------------------------------------------------------------------------------
|
|
|
25
|
|
|
26 with Alloc;
|
|
|
27 with Atree; use Atree;
|
|
|
28 with Debug; use Debug;
|
|
|
29 with Einfo; use Einfo;
|
|
|
30 with Errout; use Errout;
|
|
|
31 with Fname; use Fname;
|
|
|
32 with Lib; use Lib;
|
|
|
33 with Opt; use Opt;
|
|
|
34 with Osint; use Osint;
|
|
|
35 with Output; use Output;
|
|
|
36 with Prep; use Prep;
|
|
|
37 with Prepcomp; use Prepcomp;
|
|
|
38 with Scans; use Scans;
|
|
|
39 with Scn; use Scn;
|
|
|
40 with Sem_Aux; use Sem_Aux;
|
|
|
41 with Sem_Util; use Sem_Util;
|
|
|
42 with Sinfo; use Sinfo;
|
|
|
43 with Snames; use Snames;
|
|
|
44 with System; use System;
|
|
|
45
|
|
|
46 with System.OS_Lib; use System.OS_Lib;
|
|
|
47
|
|
|
48 package body Sinput.L is
|
|
|
49
|
|
|
50 Prep_Buffer : Text_Buffer_Ptr := null;
|
|
|
51 -- A buffer to temporarily stored the result of preprocessing a source.
|
|
|
52 -- It is only allocated if there is at least one source to preprocess.
|
|
|
53
|
|
|
54 Prep_Buffer_Last : Text_Ptr := 0;
|
|
|
55 -- Index of the last significant character in Prep_Buffer
|
|
|
56
|
|
|
57 Initial_Size_Of_Prep_Buffer : constant := 10_000;
|
|
|
58 -- Size of Prep_Buffer when it is first allocated
|
|
|
59
|
|
|
60 -- When a file is to be preprocessed and the options to list symbols
|
|
|
61 -- has been selected (switch -s), Prep.List_Symbols is called with a
|
|
|
62 -- "foreword", a single line indicating what source the symbols apply to.
|
|
|
63 -- The following two constant String are the start and the end of this
|
|
|
64 -- foreword.
|
|
|
65
|
|
|
66 Foreword_Start : constant String :=
|
|
|
67 "Preprocessing Symbols for source """;
|
|
|
68
|
|
|
69 Foreword_End : constant String := """";
|
|
|
70
|
|
|
71 -----------------
|
|
|
72 -- Subprograms --
|
|
|
73 -----------------
|
|
|
74
|
|
|
75 procedure Put_Char_In_Prep_Buffer (C : Character);
|
|
|
76 -- Add one character in Prep_Buffer, extending Prep_Buffer if need be.
|
|
|
77 -- Used to initialize the preprocessor.
|
|
|
78
|
|
|
79 procedure New_EOL_In_Prep_Buffer;
|
|
|
80 -- Add an LF to Prep_Buffer (used to initialize the preprocessor)
|
|
|
81
|
|
|
82 function Load_File
|
|
|
83 (N : File_Name_Type;
|
|
|
84 T : Osint.File_Type) return Source_File_Index;
|
|
|
85 -- Load a source file, a configuration pragmas file or a definition file
|
|
|
86 -- Coding also allows preprocessing file, but not a library file ???
|
|
|
87
|
|
|
88 -------------------------------
|
|
|
89 -- Adjust_Instantiation_Sloc --
|
|
|
90 -------------------------------
|
|
|
91
|
|
|
92 procedure Adjust_Instantiation_Sloc
|
|
|
93 (N : Node_Id;
|
|
|
94 Factor : Sloc_Adjustment)
|
|
|
95 is
|
|
|
96 Loc : constant Source_Ptr := Sloc (N);
|
|
|
97
|
|
|
98 begin
|
|
|
99 -- We only do the adjustment if the value is between the appropriate low
|
|
|
100 -- and high values. It is not clear that this should ever not be the
|
|
|
101 -- case, but in practice there seem to be some nodes that get copied
|
|
|
102 -- twice, and this is a defence against that happening.
|
|
|
103
|
|
|
104 if Loc in Factor.Lo .. Factor.Hi then
|
|
|
105 Set_Sloc (N, Loc + Factor.Adjust);
|
|
|
106 end if;
|
|
|
107 end Adjust_Instantiation_Sloc;
|
|
|
108
|
|
|
109 --------------------------------
|
|
|
110 -- Complete_Source_File_Entry --
|
|
|
111 --------------------------------
|
|
|
112
|
|
|
113 procedure Complete_Source_File_Entry is
|
|
|
114 CSF : constant Source_File_Index := Current_Source_File;
|
|
|
115 begin
|
|
|
116 Trim_Lines_Table (CSF);
|
|
|
117 Source_File.Table (CSF).Source_Checksum := Checksum;
|
|
|
118 end Complete_Source_File_Entry;
|
|
|
119
|
|
|
120 ---------------------------------
|
|
|
121 -- Create_Instantiation_Source --
|
|
|
122 ---------------------------------
|
|
|
123
|
|
|
124 procedure Create_Instantiation_Source
|
|
|
125 (Inst_Node : Entity_Id;
|
|
|
126 Template_Id : Entity_Id;
|
|
|
127 Factor : out Sloc_Adjustment;
|
|
|
128 Inlined_Body : Boolean := False;
|
|
|
129 Inherited_Pragma : Boolean := False)
|
|
|
130 is
|
|
|
131 Dnod : constant Node_Id := Declaration_Node (Template_Id);
|
|
|
132 Xold : Source_File_Index;
|
|
|
133 Xnew : Source_File_Index;
|
|
|
134
|
|
|
135 begin
|
|
|
136 Xold := Get_Source_File_Index (Sloc (Template_Id));
|
|
|
137 Factor.Lo := Source_File.Table (Xold).Source_First;
|
|
|
138 Factor.Hi := Source_File.Table (Xold).Source_Last;
|
|
|
139
|
|
|
140 Source_File.Append (Source_File.Table (Xold));
|
|
|
141 Xnew := Source_File.Last;
|
|
|
142
|
|
|
143 if Debug_Flag_L then
|
|
|
144 Write_Eol;
|
|
|
145 Write_Str ("*** Create_Instantiation_Source: created source ");
|
|
|
146 Write_Int (Int (Xnew));
|
|
|
147 Write_Line ("");
|
|
|
148 end if;
|
|
|
149
|
|
|
150 declare
|
|
|
151 Sold : Source_File_Record renames Source_File.Table (Xold);
|
|
|
152 Snew : Source_File_Record renames Source_File.Table (Xnew);
|
|
|
153
|
|
|
154 Inst_Spec : Node_Id;
|
|
|
155
|
|
|
156 begin
|
|
|
157 Snew.Index := Xnew;
|
|
|
158 Snew.Inlined_Body := Inlined_Body;
|
|
|
159 Snew.Inherited_Pragma := Inherited_Pragma;
|
|
|
160 Snew.Template := Xold;
|
|
|
161
|
|
|
162 -- For a genuine generic instantiation, assign new instance id. For
|
|
|
163 -- inlined bodies or inherited pragmas, we retain that of the
|
|
|
164 -- template, but we save the call location.
|
|
|
165
|
|
|
166 if Inlined_Body or Inherited_Pragma then
|
|
|
167 Snew.Inlined_Call := Sloc (Inst_Node);
|
|
|
168
|
|
|
169 else
|
|
|
170 -- If the spec has been instantiated already, and we are now
|
|
|
171 -- creating the instance source for the corresponding body now,
|
|
|
172 -- retrieve the instance id that was assigned to the spec, which
|
|
|
173 -- corresponds to the same instantiation sloc.
|
|
|
174
|
|
|
175 Inst_Spec := Instance_Spec (Inst_Node);
|
|
|
176 if Present (Inst_Spec) then
|
|
|
177 declare
|
|
|
178 Inst_Spec_Ent : Entity_Id;
|
|
|
179 -- Instance spec entity
|
|
|
180
|
|
|
181 Inst_Spec_Sloc : Source_Ptr;
|
|
|
182 -- Virtual sloc of the spec instance source
|
|
|
183
|
|
|
184 Inst_Spec_Inst_Id : Instance_Id;
|
|
|
185 -- Instance id assigned to the instance spec
|
|
|
186
|
|
|
187 begin
|
|
|
188 Inst_Spec_Ent := Defining_Entity (Inst_Spec);
|
|
|
189
|
|
|
190 -- For a subprogram instantiation, we want the subprogram
|
|
|
191 -- instance, not the wrapper package.
|
|
|
192
|
|
|
193 if Present (Related_Instance (Inst_Spec_Ent)) then
|
|
|
194 Inst_Spec_Ent := Related_Instance (Inst_Spec_Ent);
|
|
|
195 end if;
|
|
|
196
|
|
|
197 -- The specification of the instance entity has a virtual
|
|
|
198 -- sloc within the instance sloc range.
|
|
|
199
|
|
|
200 -- ??? But the Unit_Declaration_Node has the sloc of the
|
|
|
201 -- instantiation, which is somewhat of an oddity.
|
|
|
202
|
|
|
203 Inst_Spec_Sloc :=
|
|
|
204 Sloc
|
|
|
205 (Specification (Unit_Declaration_Node (Inst_Spec_Ent)));
|
|
|
206 Inst_Spec_Inst_Id :=
|
|
|
207 Source_File.Table
|
|
|
208 (Get_Source_File_Index (Inst_Spec_Sloc)).Instance;
|
|
|
209
|
|
|
210 pragma Assert
|
|
|
211 (Sloc (Inst_Node) = Instances.Table (Inst_Spec_Inst_Id));
|
|
|
212 Snew.Instance := Inst_Spec_Inst_Id;
|
|
|
213 end;
|
|
|
214
|
|
|
215 else
|
|
|
216 Instances.Append (Sloc (Inst_Node));
|
|
|
217 Snew.Instance := Instances.Last;
|
|
|
218 end if;
|
|
|
219 end if;
|
|
|
220
|
|
|
221 -- Now compute the new values of Source_First and Source_Last and
|
|
|
222 -- adjust the source file pointer to have the correct bounds for the
|
|
|
223 -- new range of values.
|
|
|
224
|
|
|
225 -- Source_First must be greater than the last Source_Last value and
|
|
|
226 -- also must be a multiple of Source_Align.
|
|
|
227
|
|
|
228 Snew.Source_First :=
|
|
|
229 ((Source_File.Table (Xnew - 1).Source_Last + Source_Align) /
|
|
|
230 Source_Align) * Source_Align;
|
|
|
231 Factor.Adjust := Snew.Source_First - Factor.Lo;
|
|
|
232 Snew.Source_Last := Factor.Hi + Factor.Adjust;
|
|
|
233
|
|
|
234 Set_Source_File_Index_Table (Xnew);
|
|
|
235
|
|
|
236 Snew.Sloc_Adjust := Sold.Sloc_Adjust - Factor.Adjust;
|
|
|
237
|
|
|
238 -- Modify the Dope of the instance Source_Text to use the
|
|
|
239 -- above-computed bounds.
|
|
|
240
|
|
|
241 declare
|
|
|
242 Dope : constant Dope_Ptr :=
|
|
|
243 new Dope_Rec'(Snew.Source_First, Snew.Source_Last);
|
|
|
244 begin
|
|
|
245 Snew.Source_Text := Sold.Source_Text;
|
|
|
246 Set_Dope (Snew.Source_Text'Address, Dope);
|
|
|
247 pragma Assert (Snew.Source_Text'First = Snew.Source_First);
|
|
|
248 pragma Assert (Snew.Source_Text'Last = Snew.Source_Last);
|
|
|
249 end;
|
|
|
250
|
|
|
251 if Debug_Flag_L then
|
|
|
252 Write_Str (" for ");
|
|
|
253
|
|
|
254 if Nkind (Dnod) in N_Proper_Body
|
|
|
255 and then Was_Originally_Stub (Dnod)
|
|
|
256 then
|
|
|
257 Write_Str ("subunit ");
|
|
|
258
|
|
|
259 elsif Ekind (Template_Id) = E_Generic_Package then
|
|
|
260 if Nkind (Dnod) = N_Package_Body then
|
|
|
261 Write_Str ("body of package ");
|
|
|
262 else
|
|
|
263 Write_Str ("spec of package ");
|
|
|
264 end if;
|
|
|
265
|
|
|
266 elsif Ekind (Template_Id) = E_Function then
|
|
|
267 Write_Str ("body of function ");
|
|
|
268
|
|
|
269 elsif Ekind (Template_Id) = E_Procedure then
|
|
|
270 Write_Str ("body of procedure ");
|
|
|
271
|
|
|
272 elsif Ekind (Template_Id) = E_Generic_Function then
|
|
|
273 Write_Str ("spec of function ");
|
|
|
274
|
|
|
275 elsif Ekind (Template_Id) = E_Generic_Procedure then
|
|
|
276 Write_Str ("spec of procedure ");
|
|
|
277
|
|
|
278 elsif Ekind (Template_Id) = E_Package_Body then
|
|
|
279 Write_Str ("body of package ");
|
|
|
280
|
|
|
281 else pragma Assert (Ekind (Template_Id) = E_Subprogram_Body);
|
|
|
282 if Nkind (Dnod) = N_Procedure_Specification then
|
|
|
283 Write_Str ("body of procedure ");
|
|
|
284 else
|
|
|
285 Write_Str ("body of function ");
|
|
|
286 end if;
|
|
|
287 end if;
|
|
|
288
|
|
|
289 Write_Name (Chars (Template_Id));
|
|
|
290 Write_Eol;
|
|
|
291
|
|
|
292 Write_Str (" copying from file name = ");
|
|
|
293 Write_Name (File_Name (Xold));
|
|
|
294 Write_Eol;
|
|
|
295
|
|
|
296 Write_Str (" old source index = ");
|
|
|
297 Write_Int (Int (Xold));
|
|
|
298 Write_Eol;
|
|
|
299
|
|
|
300 Write_Str (" old lo = ");
|
|
|
301 Write_Int (Int (Factor.Lo));
|
|
|
302 Write_Eol;
|
|
|
303
|
|
|
304 Write_Str (" old hi = ");
|
|
|
305 Write_Int (Int (Factor.Hi));
|
|
|
306 Write_Eol;
|
|
|
307
|
|
|
308 Write_Str (" new lo = ");
|
|
|
309 Write_Int (Int (Snew.Source_First));
|
|
|
310 Write_Eol;
|
|
|
311
|
|
|
312 Write_Str (" new hi = ");
|
|
|
313 Write_Int (Int (Snew.Source_Last));
|
|
|
314 Write_Eol;
|
|
|
315
|
|
|
316 Write_Str (" adjustment factor = ");
|
|
|
317 Write_Int (Int (Factor.Adjust));
|
|
|
318 Write_Eol;
|
|
|
319
|
|
|
320 Write_Str (" instantiation location: ");
|
|
|
321 Write_Location (Sloc (Inst_Node));
|
|
|
322 Write_Eol;
|
|
|
323 end if;
|
|
|
324 end;
|
|
|
325 end Create_Instantiation_Source;
|
|
|
326
|
|
|
327 ----------------------
|
|
|
328 -- Load_Config_File --
|
|
|
329 ----------------------
|
|
|
330
|
|
|
331 function Load_Config_File
|
|
|
332 (N : File_Name_Type) return Source_File_Index
|
|
|
333 is
|
|
|
334 begin
|
|
|
335 return Load_File (N, Osint.Config);
|
|
|
336 end Load_Config_File;
|
|
|
337
|
|
|
338 --------------------------
|
|
|
339 -- Load_Definition_File --
|
|
|
340 --------------------------
|
|
|
341
|
|
|
342 function Load_Definition_File
|
|
|
343 (N : File_Name_Type) return Source_File_Index
|
|
|
344 is
|
|
|
345 begin
|
|
|
346 return Load_File (N, Osint.Definition);
|
|
|
347 end Load_Definition_File;
|
|
|
348
|
|
|
349 ---------------
|
|
|
350 -- Load_File --
|
|
|
351 ---------------
|
|
|
352
|
|
|
353 function Load_File
|
|
|
354 (N : File_Name_Type;
|
|
|
355 T : Osint.File_Type) return Source_File_Index
|
|
|
356 is
|
|
|
357 FD : File_Descriptor;
|
|
|
358 Hi : Source_Ptr;
|
|
|
359 Lo : Source_Ptr;
|
|
|
360 Src : Source_Buffer_Ptr;
|
|
|
361 X : Source_File_Index;
|
|
|
362
|
|
|
363 Preprocessing_Needed : Boolean := False;
|
|
|
364
|
|
|
365 begin
|
|
|
366 -- If already there, don't need to reload file. An exception occurs
|
|
|
367 -- in multiple unit per file mode. It would be nice in this case to
|
|
|
368 -- share the same source file for each unit, but this leads to many
|
|
|
369 -- difficulties with assumptions (e.g. in the body of lib), that a
|
|
|
370 -- unit can be found by locating its source file index. Since we do
|
|
|
371 -- not expect much use of this mode, it's no big deal to waste a bit
|
|
|
372 -- of space and time by reading and storing the source multiple times.
|
|
|
373
|
|
|
374 if Multiple_Unit_Index = 0 then
|
|
|
375 for J in 1 .. Source_File.Last loop
|
|
|
376 if Source_File.Table (J).File_Name = N then
|
|
|
377 return J;
|
|
|
378 end if;
|
|
|
379 end loop;
|
|
|
380 end if;
|
|
|
381
|
|
|
382 -- Here we must build a new entry in the file table
|
|
|
383
|
|
|
384 -- But first, we must check if a source needs to be preprocessed,
|
|
|
385 -- because we may have to load and parse a definition file, and we want
|
|
|
386 -- to do that before we load the source, so that the buffer of the
|
|
|
387 -- source will be the last created, and we will be able to replace it
|
|
|
388 -- and modify Hi without stepping on another buffer.
|
|
|
389
|
|
|
390 if T = Osint.Source and then not Is_Internal_File_Name (N) then
|
|
|
391 Prepare_To_Preprocess
|
|
|
392 (Source => N, Preprocessing_Needed => Preprocessing_Needed);
|
|
|
393 end if;
|
|
|
394
|
|
|
395 Source_File.Increment_Last;
|
|
|
396 X := Source_File.Last;
|
|
|
397
|
|
|
398 if Debug_Flag_L then
|
|
|
399 Write_Eol;
|
|
|
400 Write_Str ("Sinput.L.Load_File: created source ");
|
|
|
401 Write_Int (Int (X));
|
|
|
402 Write_Str (" for ");
|
|
|
403 Write_Str (Get_Name_String (N));
|
|
|
404 end if;
|
|
|
405
|
|
|
406 -- Compute starting index, respecting alignment requirement
|
|
|
407
|
|
|
408 if X = Source_File.First then
|
|
|
409 Lo := First_Source_Ptr;
|
|
|
410 else
|
|
|
411 Lo := ((Source_File.Table (X - 1).Source_Last + Source_Align) /
|
|
|
412 Source_Align) * Source_Align;
|
|
|
413 end if;
|
|
|
414
|
|
|
415 Osint.Read_Source_File (N, Lo, Hi, Src, FD, T);
|
|
|
416
|
|
|
417 if Null_Source_Buffer_Ptr (Src) then
|
|
|
418 Source_File.Decrement_Last;
|
|
|
419
|
|
|
420 if FD = Null_FD then
|
|
|
421 return No_Source_File;
|
|
|
422 else
|
|
|
423 return No_Access_To_Source_File;
|
|
|
424 end if;
|
|
|
425 else
|
|
|
426 if Debug_Flag_L then
|
|
|
427 Write_Eol;
|
|
|
428 Write_Str ("*** Build source file table entry, Index = ");
|
|
|
429 Write_Int (Int (X));
|
|
|
430 Write_Str (", file name = ");
|
|
|
431 Write_Name (N);
|
|
|
432 Write_Eol;
|
|
|
433 Write_Str (" lo = ");
|
|
|
434 Write_Int (Int (Lo));
|
|
|
435 Write_Eol;
|
|
|
436 Write_Str (" hi = ");
|
|
|
437 Write_Int (Int (Hi));
|
|
|
438 Write_Eol;
|
|
|
439
|
|
|
440 Write_Str (" first 10 chars -->");
|
|
|
441
|
|
|
442 declare
|
|
|
443 procedure Wchar (C : Character);
|
|
|
444 -- Writes character or ? for control character
|
|
|
445
|
|
|
446 -----------
|
|
|
447 -- Wchar --
|
|
|
448 -----------
|
|
|
449
|
|
|
450 procedure Wchar (C : Character) is
|
|
|
451 begin
|
|
|
452 if C < ' '
|
|
|
453 or else C in ASCII.DEL .. Character'Val (16#9F#)
|
|
|
454 then
|
|
|
455 Write_Char ('?');
|
|
|
456 else
|
|
|
457 Write_Char (C);
|
|
|
458 end if;
|
|
|
459 end Wchar;
|
|
|
460
|
|
|
461 begin
|
|
|
462 for J in Lo .. Lo + 9 loop
|
|
|
463 Wchar (Src (J));
|
|
|
464 end loop;
|
|
|
465
|
|
|
466 Write_Str ("<--");
|
|
|
467 Write_Eol;
|
|
|
468
|
|
|
469 Write_Str (" last 10 chars -->");
|
|
|
470
|
|
|
471 for J in Hi - 10 .. Hi - 1 loop
|
|
|
472 Wchar (Src (J));
|
|
|
473 end loop;
|
|
|
474
|
|
|
475 Write_Str ("<--");
|
|
|
476 Write_Eol;
|
|
|
477
|
|
|
478 if Src (Hi) /= EOF then
|
|
|
479 Write_Str (" error: no EOF at end");
|
|
|
480 Write_Eol;
|
|
|
481 end if;
|
|
|
482 end;
|
|
|
483 end if;
|
|
|
484
|
|
|
485 declare
|
|
|
486 S : Source_File_Record renames Source_File.Table (X);
|
|
|
487 File_Type : Type_Of_File;
|
|
|
488
|
|
|
489 begin
|
|
|
490 case T is
|
|
|
491 when Osint.Source =>
|
|
|
492 File_Type := Sinput.Src;
|
|
|
493
|
|
|
494 when Osint.Library =>
|
|
|
495 raise Program_Error;
|
|
|
496
|
|
|
497 when Osint.Config =>
|
|
|
498 File_Type := Sinput.Config;
|
|
|
499
|
|
|
500 when Osint.Definition =>
|
|
|
501 File_Type := Def;
|
|
|
502
|
|
|
503 when Osint.Preprocessing_Data =>
|
|
|
504 File_Type := Preproc;
|
|
|
505 end case;
|
|
|
506
|
|
|
507 S := (Debug_Source_Name => N,
|
|
|
508 File_Name => N,
|
|
|
509 File_Type => File_Type,
|
|
|
510 First_Mapped_Line => No_Line_Number,
|
|
|
511 Full_Debug_Name => Osint.Full_Source_Name,
|
|
|
512 Full_File_Name => Osint.Full_Source_Name,
|
|
|
513 Full_Ref_Name => Osint.Full_Source_Name,
|
|
|
514 Instance => No_Instance_Id,
|
|
|
515 Identifier_Casing => Unknown,
|
|
|
516 Inlined_Call => No_Location,
|
|
|
517 Inlined_Body => False,
|
|
|
518 Inherited_Pragma => False,
|
|
|
519 Keyword_Casing => Unknown,
|
|
|
520 Last_Source_Line => 1,
|
|
|
521 License => Unknown,
|
|
|
522 Lines_Table => null,
|
|
|
523 Lines_Table_Max => 1,
|
|
|
524 Logical_Lines_Table => null,
|
|
|
525 Num_SRef_Pragmas => 0,
|
|
|
526 Reference_Name => N,
|
|
|
527 Sloc_Adjust => 0,
|
|
|
528 Source_Checksum => 0,
|
|
|
529 Source_First => Lo,
|
|
|
530 Source_Last => Hi,
|
|
|
531 Source_Text => Src,
|
|
|
532 Template => No_Source_File,
|
|
|
533 Unit => No_Unit,
|
|
|
534 Time_Stamp => Osint.Current_Source_File_Stamp,
|
|
|
535 Index => X);
|
|
|
536
|
|
|
537 Alloc_Line_Tables (S, Opt.Table_Factor * Alloc.Lines_Initial);
|
|
|
538 S.Lines_Table (1) := Lo;
|
|
|
539 end;
|
|
|
540
|
|
|
541 -- Preprocess the source if it needs to be preprocessed
|
|
|
542
|
|
|
543 if Preprocessing_Needed then
|
|
|
544
|
|
|
545 -- Temporarily set the Source_File_Index_Table entries for the
|
|
|
546 -- source, to avoid crash when reporting an error.
|
|
|
547
|
|
|
548 Set_Source_File_Index_Table (X);
|
|
|
549
|
|
|
550 if Opt.List_Preprocessing_Symbols then
|
|
|
551 Get_Name_String (N);
|
|
|
552
|
|
|
553 declare
|
|
|
554 Foreword : String (1 .. Foreword_Start'Length +
|
|
|
555 Name_Len + Foreword_End'Length);
|
|
|
556
|
|
|
557 begin
|
|
|
558 Foreword (1 .. Foreword_Start'Length) := Foreword_Start;
|
|
|
559 Foreword (Foreword_Start'Length + 1 ..
|
|
|
560 Foreword_Start'Length + Name_Len) :=
|
|
|
561 Name_Buffer (1 .. Name_Len);
|
|
|
562 Foreword (Foreword'Last - Foreword_End'Length + 1 ..
|
|
|
563 Foreword'Last) := Foreword_End;
|
|
|
564 Prep.List_Symbols (Foreword);
|
|
|
565 end;
|
|
|
566 end if;
|
|
|
567
|
|
|
568 declare
|
|
|
569 T : constant Nat := Total_Errors_Detected;
|
|
|
570 -- Used to check if there were errors during preprocessing
|
|
|
571
|
|
|
572 Save_Style_Check : Boolean;
|
|
|
573 -- Saved state of the Style_Check flag (which needs to be
|
|
|
574 -- temporarily set to False during preprocessing, see below).
|
|
|
575
|
|
|
576 Modified : Boolean;
|
|
|
577
|
|
|
578 begin
|
|
|
579 -- If this is the first time we preprocess a source, allocate
|
|
|
580 -- the preprocessing buffer.
|
|
|
581
|
|
|
582 if Prep_Buffer = null then
|
|
|
583 Prep_Buffer :=
|
|
|
584 new Text_Buffer (1 .. Initial_Size_Of_Prep_Buffer);
|
|
|
585 end if;
|
|
|
586
|
|
|
587 -- Make sure the preprocessing buffer is empty
|
|
|
588
|
|
|
589 Prep_Buffer_Last := 0;
|
|
|
590
|
|
|
591 -- Initialize the preprocessor hooks
|
|
|
592
|
|
|
593 Prep.Setup_Hooks
|
|
|
594 (Error_Msg => Errout.Error_Msg'Access,
|
|
|
595 Scan => Scn.Scanner.Scan'Access,
|
|
|
596 Set_Ignore_Errors => Errout.Set_Ignore_Errors'Access,
|
|
|
597 Put_Char => Put_Char_In_Prep_Buffer'Access,
|
|
|
598 New_EOL => New_EOL_In_Prep_Buffer'Access);
|
|
|
599
|
|
|
600 -- Initialize scanner and set its behavior for preprocessing,
|
|
|
601 -- then preprocess. Also disable style checks, since some of
|
|
|
602 -- them are done in the scanner (specifically, those dealing
|
|
|
603 -- with line length and line termination), and cannot be done
|
|
|
604 -- during preprocessing (because the source file index table
|
|
|
605 -- has not been set yet).
|
|
|
606
|
|
|
607 Scn.Scanner.Initialize_Scanner (X);
|
|
|
608
|
|
|
609 Scn.Scanner.Set_Special_Character ('#');
|
|
|
610 Scn.Scanner.Set_Special_Character ('$');
|
|
|
611 Scn.Scanner.Set_End_Of_Line_As_Token (True);
|
|
|
612 Save_Style_Check := Opt.Style_Check;
|
|
|
613 Opt.Style_Check := False;
|
|
|
614
|
|
|
615 -- The actual preprocessing step
|
|
|
616
|
|
|
617 Preprocess (Modified);
|
|
|
618
|
|
|
619 -- Reset the scanner to its standard behavior, and restore the
|
|
|
620 -- Style_Checks flag.
|
|
|
621
|
|
|
622 Scn.Scanner.Reset_Special_Characters;
|
|
|
623 Scn.Scanner.Set_End_Of_Line_As_Token (False);
|
|
|
624 Opt.Style_Check := Save_Style_Check;
|
|
|
625
|
|
|
626 -- If there were errors during preprocessing, record an error
|
|
|
627 -- at the start of the file, and do not change the source
|
|
|
628 -- buffer.
|
|
|
629
|
|
|
630 if T /= Total_Errors_Detected then
|
|
|
631 Errout.Error_Msg
|
|
|
632 ("file could not be successfully preprocessed", Lo);
|
|
|
633 return No_Source_File;
|
|
|
634
|
|
|
635 else
|
|
|
636 -- Output the result of the preprocessing, if requested and
|
|
|
637 -- the source has been modified by the preprocessing. Only
|
|
|
638 -- do that for the main unit (spec, body and subunits).
|
|
|
639
|
|
|
640 if Generate_Processed_File
|
|
|
641 and then Modified
|
|
|
642 and then
|
|
|
643 ((Compiler_State = Parsing
|
|
|
644 and then Parsing_Main_Extended_Source)
|
|
|
645 or else
|
|
|
646 (Compiler_State = Analyzing
|
|
|
647 and then Analysing_Subunit_Of_Main))
|
|
|
648 then
|
|
|
649 declare
|
|
|
650 FD : File_Descriptor;
|
|
|
651 NB : Integer;
|
|
|
652 Status : Boolean;
|
|
|
653
|
|
|
654 begin
|
|
|
655 Get_Name_String (N);
|
|
|
656 Add_Str_To_Name_Buffer (Prep_Suffix);
|
|
|
657
|
|
|
658 Delete_File (Name_Buffer (1 .. Name_Len), Status);
|
|
|
659
|
|
|
660 FD :=
|
|
|
661 Create_New_File (Name_Buffer (1 .. Name_Len), Text);
|
|
|
662
|
|
|
663 Status := FD /= Invalid_FD;
|
|
|
664
|
|
|
665 if Status then
|
|
|
666 NB :=
|
|
|
667 Write
|
|
|
668 (FD,
|
|
|
669 Prep_Buffer (1)'Address,
|
|
|
670 Integer (Prep_Buffer_Last));
|
|
|
671 Status := NB = Integer (Prep_Buffer_Last);
|
|
|
672 end if;
|
|
|
673
|
|
|
674 if Status then
|
|
|
675 Close (FD, Status);
|
|
|
676 end if;
|
|
|
677
|
|
|
678 if not Status then
|
|
|
679 Errout.Error_Msg
|
|
|
680 ("??could not write processed file """ &
|
|
|
681 Name_Buffer (1 .. Name_Len) & '"',
|
|
|
682 Lo);
|
|
|
683 end if;
|
|
|
684 end;
|
|
|
685 end if;
|
|
|
686
|
|
|
687 -- Set the new value of Hi
|
|
|
688
|
|
|
689 Hi := Lo + Source_Ptr (Prep_Buffer_Last);
|
|
|
690
|
|
|
691 -- Create the new source buffer
|
|
|
692
|
|
|
693 declare
|
|
|
694 Var_Ptr : constant Source_Buffer_Ptr_Var :=
|
|
|
695 new Source_Buffer (Lo .. Hi);
|
|
|
696 -- Allocate source buffer, allowing extra character at
|
|
|
697 -- end for EOF.
|
|
|
698
|
|
|
699 begin
|
|
|
700 Var_Ptr (Lo .. Hi - 1) :=
|
|
|
701 Prep_Buffer (1 .. Prep_Buffer_Last);
|
|
|
702 Var_Ptr (Hi) := EOF;
|
|
|
703 Src := Var_Ptr.all'Access;
|
|
|
704 end;
|
|
|
705
|
|
|
706 -- Record in the table the new source buffer and the
|
|
|
707 -- new value of Hi.
|
|
|
708
|
|
|
709 Source_File.Table (X).Source_Text := Src;
|
|
|
710 Source_File.Table (X).Source_Last := Hi;
|
|
|
711
|
|
|
712 -- Reset Last_Line to 1, because the lines do not
|
|
|
713 -- have necessarily the same starts and lengths.
|
|
|
714
|
|
|
715 Source_File.Table (X).Last_Source_Line := 1;
|
|
|
716 end if;
|
|
|
717 end;
|
|
|
718 end if;
|
|
|
719
|
|
|
720 Set_Source_File_Index_Table (X);
|
|
|
721 return X;
|
|
|
722 end if;
|
|
|
723 end Load_File;
|
|
|
724
|
|
|
725 ----------------------------------
|
|
|
726 -- Load_Preprocessing_Data_File --
|
|
|
727 ----------------------------------
|
|
|
728
|
|
|
729 function Load_Preprocessing_Data_File
|
|
|
730 (N : File_Name_Type) return Source_File_Index
|
|
|
731 is
|
|
|
732 begin
|
|
|
733 return Load_File (N, Osint.Preprocessing_Data);
|
|
|
734 end Load_Preprocessing_Data_File;
|
|
|
735
|
|
|
736 ----------------------
|
|
|
737 -- Load_Source_File --
|
|
|
738 ----------------------
|
|
|
739
|
|
|
740 function Load_Source_File
|
|
|
741 (N : File_Name_Type) return Source_File_Index
|
|
|
742 is
|
|
|
743 begin
|
|
|
744 return Load_File (N, Osint.Source);
|
|
|
745 end Load_Source_File;
|
|
|
746
|
|
|
747 ----------------------------
|
|
|
748 -- New_EOL_In_Prep_Buffer --
|
|
|
749 ----------------------------
|
|
|
750
|
|
|
751 procedure New_EOL_In_Prep_Buffer is
|
|
|
752 begin
|
|
|
753 Put_Char_In_Prep_Buffer (ASCII.LF);
|
|
|
754 end New_EOL_In_Prep_Buffer;
|
|
|
755
|
|
|
756 -----------------------------
|
|
|
757 -- Put_Char_In_Prep_Buffer --
|
|
|
758 -----------------------------
|
|
|
759
|
|
|
760 procedure Put_Char_In_Prep_Buffer (C : Character) is
|
|
|
761 begin
|
|
|
762 -- If preprocessing buffer is not large enough, double it
|
|
|
763
|
|
|
764 if Prep_Buffer_Last = Prep_Buffer'Last then
|
|
|
765 declare
|
|
|
766 New_Prep_Buffer : constant Text_Buffer_Ptr :=
|
|
|
767 new Text_Buffer (1 .. 2 * Prep_Buffer_Last);
|
|
|
768
|
|
|
769 begin
|
|
|
770 New_Prep_Buffer (Prep_Buffer'Range) := Prep_Buffer.all;
|
|
|
771 Free (Prep_Buffer);
|
|
|
772 Prep_Buffer := New_Prep_Buffer;
|
|
|
773 end;
|
|
|
774 end if;
|
|
|
775
|
|
|
776 Prep_Buffer_Last := Prep_Buffer_Last + 1;
|
|
|
777 Prep_Buffer (Prep_Buffer_Last) := C;
|
|
|
778 end Put_Char_In_Prep_Buffer;
|
|
|
779
|
|
|
780 -------------------------
|
|
|
781 -- Source_File_Is_Body --
|
|
|
782 -------------------------
|
|
|
783
|
|
|
784 function Source_File_Is_Body (X : Source_File_Index) return Boolean is
|
|
|
785 Pcount : Natural;
|
|
|
786
|
|
|
787 begin
|
|
|
788 Initialize_Scanner (No_Unit, X);
|
|
|
789
|
|
|
790 -- Loop to look for subprogram or package body
|
|
|
791
|
|
|
792 loop
|
|
|
793 case Token is
|
|
|
794
|
|
|
795 -- PRAGMA, WITH, USE (which can appear before a body)
|
|
|
796
|
|
|
797 when Tok_Pragma
|
|
|
798 | Tok_Use
|
|
|
799 | Tok_With
|
|
|
800 =>
|
|
|
801 -- We just want to skip any of these, do it by skipping to a
|
|
|
802 -- semicolon, but check for EOF, in case we have bad syntax.
|
|
|
803
|
|
|
804 loop
|
|
|
805 if Token = Tok_Semicolon then
|
|
|
806 Scan;
|
|
|
807 exit;
|
|
|
808 elsif Token = Tok_EOF then
|
|
|
809 return False;
|
|
|
810 else
|
|
|
811 Scan;
|
|
|
812 end if;
|
|
|
813 end loop;
|
|
|
814
|
|
|
815 -- PACKAGE
|
|
|
816
|
|
|
817 when Tok_Package =>
|
|
|
818 Scan; -- Past PACKAGE
|
|
|
819
|
|
|
820 -- We have a body if and only if BODY follows
|
|
|
821
|
|
|
822 return Token = Tok_Body;
|
|
|
823
|
|
|
824 -- FUNCTION or PROCEDURE
|
|
|
825
|
|
|
826 when Tok_Function
|
|
|
827 | Tok_Procedure
|
|
|
828 =>
|
|
|
829 Pcount := 0;
|
|
|
830
|
|
|
831 -- Loop through tokens following PROCEDURE or FUNCTION
|
|
|
832
|
|
|
833 loop
|
|
|
834 Scan;
|
|
|
835
|
|
|
836 case Token is
|
|
|
837
|
|
|
838 -- For parens, count paren level (note that paren level
|
|
|
839 -- can get greater than 1 if we have default parameters).
|
|
|
840
|
|
|
841 when Tok_Left_Paren =>
|
|
|
842 Pcount := Pcount + 1;
|
|
|
843
|
|
|
844 when Tok_Right_Paren =>
|
|
|
845 Pcount := Pcount - 1;
|
|
|
846
|
|
|
847 -- EOF means something weird, probably no body
|
|
|
848
|
|
|
849 when Tok_EOF =>
|
|
|
850 return False;
|
|
|
851
|
|
|
852 -- BEGIN or IS or END definitely means body is present
|
|
|
853
|
|
|
854 when Tok_Begin
|
|
|
855 | Tok_End
|
|
|
856 | Tok_Is
|
|
|
857 =>
|
|
|
858 return True;
|
|
|
859
|
|
|
860 -- Semicolon means no body present if at outside any
|
|
|
861 -- parens. If within parens, ignore, since it could be
|
|
|
862 -- a parameter separator.
|
|
|
863
|
|
|
864 when Tok_Semicolon =>
|
|
|
865 if Pcount = 0 then
|
|
|
866 return False;
|
|
|
867 end if;
|
|
|
868
|
|
|
869 -- Skip anything else
|
|
|
870
|
|
|
871 when others =>
|
|
|
872 null;
|
|
|
873 end case;
|
|
|
874 end loop;
|
|
|
875
|
|
|
876 -- Anything else in main scan means we don't have a body
|
|
|
877
|
|
|
878 when others =>
|
|
|
879 return False;
|
|
|
880 end case;
|
|
|
881 end loop;
|
|
|
882 end Source_File_Is_Body;
|
|
|
883
|
|
|
884 ----------------------------
|
|
|
885 -- Source_File_Is_No_Body --
|
|
|
886 ----------------------------
|
|
|
887
|
|
|
888 function Source_File_Is_No_Body (X : Source_File_Index) return Boolean is
|
|
|
889 begin
|
|
|
890 Initialize_Scanner (No_Unit, X);
|
|
|
891
|
|
|
892 if Token /= Tok_Pragma then
|
|
|
893 return False;
|
|
|
894 end if;
|
|
|
895
|
|
|
896 Scan; -- past pragma
|
|
|
897
|
|
|
898 if Token /= Tok_Identifier
|
|
|
899 or else Chars (Token_Node) /= Name_No_Body
|
|
|
900 then
|
|
|
901 return False;
|
|
|
902 end if;
|
|
|
903
|
|
|
904 Scan; -- past No_Body
|
|
|
905
|
|
|
906 if Token /= Tok_Semicolon then
|
|
|
907 return False;
|
|
|
908 end if;
|
|
|
909
|
|
|
910 Scan; -- past semicolon
|
|
|
911
|
|
|
912 return Token = Tok_EOF;
|
|
|
913 end Source_File_Is_No_Body;
|
|
|
914
|
|
|
915 end Sinput.L;
|
