]>
Commit | Line | Data |
---|---|---|
996ae0b0 RK |
1 | ------------------------------------------------------------------------------ |
2 | -- -- | |
3 | -- GNAT COMPILER COMPONENTS -- | |
4 | -- -- | |
5 | -- S I N P U T . L -- | |
6 | -- -- | |
7 | -- B o d y -- | |
8 | -- -- | |
1d005acc | 9 | -- Copyright (C) 1992-2019, Free Software Foundation, Inc. -- |
996ae0b0 RK |
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- -- | |
b5c84c3c | 13 | -- ware Foundation; either version 3, or (at your option) any later ver- -- |
996ae0b0 RK |
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 -- | |
b5c84c3c RD |
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. -- | |
996ae0b0 RK |
20 | -- -- |
21 | -- GNAT was originally developed by the GNAT team at New York University. -- | |
71ff80dc | 22 | -- Extensive contributions were provided by Ada Core Technologies Inc. -- |
996ae0b0 RK |
23 | -- -- |
24 | ------------------------------------------------------------------------------ | |
25 | ||
26 | with Alloc; | |
fbf5a39b AC |
27 | with Atree; use Atree; |
28 | with Debug; use Debug; | |
29 | with Einfo; use Einfo; | |
30 | with Errout; use Errout; | |
a037f912 | 31 | with Fname; use Fname; |
ea4ce0f7 | 32 | with Lib; use Lib; |
2820d220 | 33 | with Opt; use Opt; |
fbf5a39b AC |
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; | |
cf427f02 AC |
40 | with Sem_Aux; use Sem_Aux; |
41 | with Sem_Util; use Sem_Util; | |
fbf5a39b | 42 | with Sinfo; use Sinfo; |
0600d9bc | 43 | with Snames; use Snames; |
fbf5a39b | 44 | with System; use System; |
996ae0b0 | 45 | |
a037f912 VC |
46 | with System.OS_Lib; use System.OS_Lib; |
47 | ||
996ae0b0 RK |
48 | package body Sinput.L is |
49 | ||
fbf5a39b AC |
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 | |
3354f96d | 62 | -- "foreword", a single line indicating what source the symbols apply to. |
fbf5a39b AC |
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 := """"; | |
996ae0b0 RK |
70 | |
71 | ----------------- | |
72 | -- Subprograms -- | |
73 | ----------------- | |
74 | ||
fbf5a39b AC |
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; | |
d82d3baa | 80 | -- Add an LF to Prep_Buffer (used to initialize the preprocessor) |
fbf5a39b | 81 | |
996ae0b0 | 82 | function Load_File |
2820d220 AC |
83 | (N : File_Name_Type; |
84 | T : Osint.File_Type) return Source_File_Index; | |
fbf5a39b AC |
85 | -- Load a source file, a configuration pragmas file or a definition file |
86 | -- Coding also allows preprocessing file, but not a library file ??? | |
996ae0b0 RK |
87 | |
88 | ------------------------------- | |
89 | -- Adjust_Instantiation_Sloc -- | |
90 | ------------------------------- | |
91 | ||
c308e762 HK |
92 | procedure Adjust_Instantiation_Sloc |
93 | (N : Node_Id; | |
94 | Factor : Sloc_Adjustment) | |
95 | is | |
996ae0b0 RK |
96 | Loc : constant Source_Ptr := Sloc (N); |
97 | ||
98 | begin | |
d82d3baa TQ |
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. | |
996ae0b0 | 103 | |
5e9cb404 | 104 | if Loc in Factor.Lo .. Factor.Hi then |
c308e762 | 105 | Set_Sloc (N, Loc + Factor.Adjust); |
996ae0b0 RK |
106 | end if; |
107 | end Adjust_Instantiation_Sloc; | |
108 | ||
996ae0b0 RK |
109 | -------------------------------- |
110 | -- Complete_Source_File_Entry -- | |
111 | -------------------------------- | |
112 | ||
113 | procedure Complete_Source_File_Entry is | |
114 | CSF : constant Source_File_Index := Current_Source_File; | |
996ae0b0 RK |
115 | begin |
116 | Trim_Lines_Table (CSF); | |
117 | Source_File.Table (CSF).Source_Checksum := Checksum; | |
118 | end Complete_Source_File_Entry; | |
119 | ||
996ae0b0 RK |
120 | --------------------------------- |
121 | -- Create_Instantiation_Source -- | |
122 | --------------------------------- | |
123 | ||
124 | procedure Create_Instantiation_Source | |
96df3ff4 AC |
125 | (Inst_Node : Entity_Id; |
126 | Template_Id : Entity_Id; | |
c308e762 | 127 | Factor : out Sloc_Adjustment; |
96df3ff4 AC |
128 | Inlined_Body : Boolean := False; |
129 | Inherited_Pragma : Boolean := False) | |
996ae0b0 RK |
130 | is |
131 | Dnod : constant Node_Id := Declaration_Node (Template_Id); | |
132 | Xold : Source_File_Index; | |
133 | Xnew : Source_File_Index; | |
134 | ||
135 | begin | |
c308e762 HK |
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; | |
996ae0b0 | 139 | |
1d6f10a1 | 140 | Source_File.Append (Source_File.Table (Xold)); |
996ae0b0 RK |
141 | Xnew := Source_File.Last; |
142 | ||
211e7410 | 143 | if Debug_Flag_L then |
5e9cb404 AC |
144 | Write_Eol; |
145 | Write_Str ("*** Create_Instantiation_Source: created source "); | |
211e7410 AC |
146 | Write_Int (Int (Xnew)); |
147 | Write_Line (""); | |
148 | end if; | |
149 | ||
cf427f02 AC |
150 | declare |
151 | Sold : Source_File_Record renames Source_File.Table (Xold); | |
152 | Snew : Source_File_Record renames Source_File.Table (Xnew); | |
996ae0b0 | 153 | |
cf427f02 | 154 | Inst_Spec : Node_Id; |
996ae0b0 | 155 | |
cf427f02 | 156 | begin |
211e7410 | 157 | Snew.Index := Xnew; |
96df3ff4 AC |
158 | Snew.Inlined_Body := Inlined_Body; |
159 | Snew.Inherited_Pragma := Inherited_Pragma; | |
160 | Snew.Template := Xold; | |
1d6f10a1 | 161 | |
96df3ff4 | 162 | -- For a genuine generic instantiation, assign new instance id. For |
f50f7e2c AC |
163 | -- inlined bodies or inherited pragmas, we retain that of the |
164 | -- template, but we save the call location. | |
996ae0b0 | 165 | |
f50f7e2c | 166 | if Inlined_Body or Inherited_Pragma then |
cf427f02 | 167 | Snew.Inlined_Call := Sloc (Inst_Node); |
996ae0b0 | 168 | |
cf427f02 | 169 | else |
cf427f02 AC |
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 | |
cd38efa5 | 178 | Inst_Spec_Ent : Entity_Id; |
cf427f02 AC |
179 | -- Instance spec entity |
180 | ||
cd38efa5 | 181 | Inst_Spec_Sloc : Source_Ptr; |
cf427f02 AC |
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. | |
cd38efa5 | 199 | |
cf427f02 AC |
200 | -- ??? But the Unit_Declaration_Node has the sloc of the |
201 | -- instantiation, which is somewhat of an oddity. | |
202 | ||
cd38efa5 AC |
203 | Inst_Spec_Sloc := |
204 | Sloc | |
205 | (Specification (Unit_Declaration_Node (Inst_Spec_Ent))); | |
cf427f02 AC |
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; | |
996ae0b0 | 214 | |
996ae0b0 | 215 | else |
cf427f02 AC |
216 | Instances.Append (Sloc (Inst_Node)); |
217 | Snew.Instance := Instances.Last; | |
996ae0b0 | 218 | end if; |
cf427f02 | 219 | end if; |
996ae0b0 | 220 | |
c308e762 | 221 | -- Now compute the new values of Source_First and Source_Last and |
211e7410 AC |
222 | -- adjust the source file pointer to have the correct bounds for the |
223 | -- new range of values. | |
996ae0b0 | 224 | |
c308e762 HK |
225 | -- Source_First must be greater than the last Source_Last value and |
226 | -- also must be a multiple of Source_Align. | |
cd38efa5 AC |
227 | |
228 | Snew.Source_First := | |
229 | ((Source_File.Table (Xnew - 1).Source_Last + Source_Align) / | |
230 | Source_Align) * Source_Align; | |
c308e762 HK |
231 | Factor.Adjust := Snew.Source_First - Factor.Lo; |
232 | Snew.Source_Last := Factor.Hi + Factor.Adjust; | |
996ae0b0 | 233 | |
cf427f02 | 234 | Set_Source_File_Index_Table (Xnew); |
996ae0b0 | 235 | |
c308e762 | 236 | Snew.Sloc_Adjust := Sold.Sloc_Adjust - Factor.Adjust; |
996ae0b0 | 237 | |
211e7410 AC |
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 | ||
cf427f02 | 251 | if Debug_Flag_L then |
5e9cb404 | 252 | Write_Str (" for "); |
cf427f02 AC |
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; | |
996ae0b0 | 265 | |
cf427f02 AC |
266 | elsif Ekind (Template_Id) = E_Function then |
267 | Write_Str ("body of function "); | |
996ae0b0 | 268 | |
cf427f02 | 269 | elsif Ekind (Template_Id) = E_Procedure then |
996ae0b0 | 270 | Write_Str ("body of procedure "); |
cf427f02 AC |
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); | |
cf427f02 AC |
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; | |
996ae0b0 | 287 | end if; |
996ae0b0 | 288 | |
cf427f02 AC |
289 | Write_Name (Chars (Template_Id)); |
290 | Write_Eol; | |
996ae0b0 | 291 | |
cf427f02 AC |
292 | Write_Str (" copying from file name = "); |
293 | Write_Name (File_Name (Xold)); | |
294 | Write_Eol; | |
996ae0b0 | 295 | |
cf427f02 AC |
296 | Write_Str (" old source index = "); |
297 | Write_Int (Int (Xold)); | |
298 | Write_Eol; | |
996ae0b0 | 299 | |
cf427f02 | 300 | Write_Str (" old lo = "); |
c308e762 | 301 | Write_Int (Int (Factor.Lo)); |
cf427f02 | 302 | Write_Eol; |
996ae0b0 | 303 | |
cf427f02 | 304 | Write_Str (" old hi = "); |
c308e762 | 305 | Write_Int (Int (Factor.Hi)); |
cf427f02 | 306 | Write_Eol; |
996ae0b0 | 307 | |
cf427f02 AC |
308 | Write_Str (" new lo = "); |
309 | Write_Int (Int (Snew.Source_First)); | |
310 | Write_Eol; | |
996ae0b0 | 311 | |
cf427f02 AC |
312 | Write_Str (" new hi = "); |
313 | Write_Int (Int (Snew.Source_Last)); | |
314 | Write_Eol; | |
996ae0b0 | 315 | |
cf427f02 | 316 | Write_Str (" adjustment factor = "); |
c308e762 | 317 | Write_Int (Int (Factor.Adjust)); |
cf427f02 | 318 | Write_Eol; |
996ae0b0 | 319 | |
cf427f02 AC |
320 | Write_Str (" instantiation location: "); |
321 | Write_Location (Sloc (Inst_Node)); | |
322 | Write_Eol; | |
323 | end if; | |
996ae0b0 | 324 | end; |
996ae0b0 RK |
325 | end Create_Instantiation_Source; |
326 | ||
327 | ---------------------- | |
328 | -- Load_Config_File -- | |
329 | ---------------------- | |
330 | ||
331 | function Load_Config_File | |
2820d220 | 332 | (N : File_Name_Type) return Source_File_Index |
996ae0b0 RK |
333 | is |
334 | begin | |
335 | return Load_File (N, Osint.Config); | |
336 | end Load_Config_File; | |
337 | ||
fbf5a39b AC |
338 | -------------------------- |
339 | -- Load_Definition_File -- | |
340 | -------------------------- | |
341 | ||
342 | function Load_Definition_File | |
2820d220 | 343 | (N : File_Name_Type) return Source_File_Index |
fbf5a39b AC |
344 | is |
345 | begin | |
346 | return Load_File (N, Osint.Definition); | |
347 | end Load_Definition_File; | |
348 | ||
996ae0b0 RK |
349 | --------------- |
350 | -- Load_File -- | |
351 | --------------- | |
352 | ||
353 | function Load_File | |
2820d220 AC |
354 | (N : File_Name_Type; |
355 | T : Osint.File_Type) return Source_File_Index | |
996ae0b0 | 356 | is |
cd644ae2 | 357 | FD : File_Descriptor; |
7f5e671b PMR |
358 | Hi : Source_Ptr; |
359 | Lo : Source_Ptr; | |
fbf5a39b AC |
360 | Src : Source_Buffer_Ptr; |
361 | X : Source_File_Index; | |
fbf5a39b AC |
362 | |
363 | Preprocessing_Needed : Boolean := False; | |
996ae0b0 RK |
364 | |
365 | begin | |
2820d220 AC |
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; | |
996ae0b0 RK |
381 | |
382 | -- Here we must build a new entry in the file table | |
383 | ||
fbf5a39b AC |
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 | ||
a037f912 | 390 | if T = Osint.Source and then not Is_Internal_File_Name (N) then |
fbf5a39b AC |
391 | Prepare_To_Preprocess |
392 | (Source => N, Preprocessing_Needed => Preprocessing_Needed); | |
393 | end if; | |
394 | ||
996ae0b0 RK |
395 | Source_File.Increment_Last; |
396 | X := Source_File.Last; | |
397 | ||
211e7410 | 398 | if Debug_Flag_L then |
5e9cb404 | 399 | Write_Eol; |
211e7410 AC |
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)); | |
211e7410 AC |
404 | end if; |
405 | ||
cd38efa5 AC |
406 | -- Compute starting index, respecting alignment requirement |
407 | ||
996ae0b0 RK |
408 | if X = Source_File.First then |
409 | Lo := First_Source_Ptr; | |
410 | else | |
cd38efa5 AC |
411 | Lo := ((Source_File.Table (X - 1).Source_Last + Source_Align) / |
412 | Source_Align) * Source_Align; | |
996ae0b0 RK |
413 | end if; |
414 | ||
cd644ae2 | 415 | Osint.Read_Source_File (N, Lo, Hi, Src, FD, T); |
996ae0b0 | 416 | |
0f96fd14 | 417 | if Null_Source_Buffer_Ptr (Src) then |
996ae0b0 | 418 | Source_File.Decrement_Last; |
996ae0b0 | 419 | |
cd644ae2 PMR |
420 | if FD = Null_FD then |
421 | return No_Source_File; | |
422 | else | |
423 | return No_Access_To_Source_File; | |
424 | end if; | |
996ae0b0 RK |
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 | ||
d1ced162 RD |
446 | ----------- |
447 | -- Wchar -- | |
448 | ----------- | |
449 | ||
996ae0b0 RK |
450 | procedure Wchar (C : Character) is |
451 | begin | |
d1ced162 RD |
452 | if C < ' ' |
453 | or else C in ASCII.DEL .. Character'Val (16#9F#) | |
454 | then | |
996ae0b0 RK |
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 | |
fbf5a39b AC |
486 | S : Source_File_Record renames Source_File.Table (X); |
487 | File_Type : Type_Of_File; | |
996ae0b0 RK |
488 | |
489 | begin | |
fbf5a39b AC |
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, | |
996ae0b0 | 508 | File_Name => N, |
fbf5a39b | 509 | File_Type => File_Type, |
996ae0b0 | 510 | First_Mapped_Line => No_Line_Number, |
fbf5a39b AC |
511 | Full_Debug_Name => Osint.Full_Source_Name, |
512 | Full_File_Name => Osint.Full_Source_Name, | |
513 | Full_Ref_Name => Osint.Full_Source_Name, | |
cf427f02 | 514 | Instance => No_Instance_Id, |
996ae0b0 | 515 | Identifier_Casing => Unknown, |
cf427f02 | 516 | Inlined_Call => No_Location, |
fbf5a39b | 517 | Inlined_Body => False, |
96df3ff4 | 518 | Inherited_Pragma => False, |
996ae0b0 RK |
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, | |
68e2ea27 | 533 | Unit => No_Unit, |
211e7410 AC |
534 | Time_Stamp => Osint.Current_Source_File_Stamp, |
535 | Index => X); | |
996ae0b0 RK |
536 | |
537 | Alloc_Line_Tables (S, Opt.Table_Factor * Alloc.Lines_Initial); | |
538 | S.Lines_Table (1) := Lo; | |
539 | end; | |
540 | ||
fbf5a39b AC |
541 | -- Preprocess the source if it needs to be preprocessed |
542 | ||
543 | if Preprocessing_Needed then | |
4e7a4f6e AC |
544 | |
545 | -- Temporarily set the Source_File_Index_Table entries for the | |
35debead EB |
546 | -- source, to avoid crash when reporting an error. |
547 | ||
548 | Set_Source_File_Index_Table (X); | |
549 | ||
fbf5a39b AC |
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 | ||
d82d3baa TQ |
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 | ||
a037f912 VC |
576 | Modified : Boolean; |
577 | ||
fbf5a39b AC |
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 | ||
4e0079cc | 591 | -- Initialize the preprocessor hooks |
fbf5a39b | 592 | |
4e0079cc | 593 | Prep.Setup_Hooks |
fbf5a39b AC |
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 | ||
d82d3baa TQ |
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). | |
fbf5a39b | 606 | |
68e2ea27 | 607 | Scn.Scanner.Initialize_Scanner (X); |
fbf5a39b AC |
608 | |
609 | Scn.Scanner.Set_Special_Character ('#'); | |
610 | Scn.Scanner.Set_Special_Character ('$'); | |
611 | Scn.Scanner.Set_End_Of_Line_As_Token (True); | |
d82d3baa TQ |
612 | Save_Style_Check := Opt.Style_Check; |
613 | Opt.Style_Check := False; | |
fbf5a39b | 614 | |
c90b2058 | 615 | -- The actual preprocessing step |
043ce308 | 616 | |
a037f912 | 617 | Preprocess (Modified); |
fbf5a39b | 618 | |
d82d3baa TQ |
619 | -- Reset the scanner to its standard behavior, and restore the |
620 | -- Style_Checks flag. | |
fbf5a39b AC |
621 | |
622 | Scn.Scanner.Reset_Special_Characters; | |
623 | Scn.Scanner.Set_End_Of_Line_As_Token (False); | |
d82d3baa | 624 | Opt.Style_Check := Save_Style_Check; |
fbf5a39b | 625 | |
d82d3baa TQ |
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. | |
fbf5a39b AC |
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 | |
a037f912 | 636 | -- Output the result of the preprocessing, if requested and |
ea4ce0f7 VC |
637 | -- the source has been modified by the preprocessing. Only |
638 | -- do that for the main unit (spec, body and subunits). | |
639 | ||
477bd732 AC |
640 | if Generate_Processed_File |
641 | and then Modified | |
642 | and then | |
ea4ce0f7 | 643 | ((Compiler_State = Parsing |
477bd732 AC |
644 | and then Parsing_Main_Extended_Source) |
645 | or else | |
646 | (Compiler_State = Analyzing | |
647 | and then Analysing_Subunit_Of_Main)) | |
ea4ce0f7 | 648 | then |
a037f912 VC |
649 | declare |
650 | FD : File_Descriptor; | |
651 | NB : Integer; | |
652 | Status : Boolean; | |
653 | ||
654 | begin | |
655 | Get_Name_String (N); | |
bbe9779c | 656 | Add_Str_To_Name_Buffer (Prep_Suffix); |
a037f912 VC |
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 | |
685bc70f | 680 | ("??could not write processed file """ & |
a037f912 VC |
681 | Name_Buffer (1 .. Name_Len) & '"', |
682 | Lo); | |
a037f912 VC |
683 | end if; |
684 | end; | |
685 | end if; | |
686 | ||
fbf5a39b AC |
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 | |
211e7410 AC |
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. | |
fbf5a39b AC |
698 | |
699 | begin | |
211e7410 | 700 | Var_Ptr (Lo .. Hi - 1) := |
fbf5a39b | 701 | Prep_Buffer (1 .. Prep_Buffer_Last); |
211e7410 AC |
702 | Var_Ptr (Hi) := EOF; |
703 | Src := Var_Ptr.all'Access; | |
704 | end; | |
fbf5a39b | 705 | |
211e7410 AC |
706 | -- Record in the table the new source buffer and the |
707 | -- new value of Hi. | |
fbf5a39b | 708 | |
211e7410 AC |
709 | Source_File.Table (X).Source_Text := Src; |
710 | Source_File.Table (X).Source_Last := Hi; | |
fbf5a39b | 711 | |
211e7410 AC |
712 | -- Reset Last_Line to 1, because the lines do not |
713 | -- have necessarily the same starts and lengths. | |
fbf5a39b | 714 | |
211e7410 | 715 | Source_File.Table (X).Last_Source_Line := 1; |
fbf5a39b AC |
716 | end if; |
717 | end; | |
718 | end if; | |
719 | ||
720 | Set_Source_File_Index_Table (X); | |
996ae0b0 RK |
721 | return X; |
722 | end if; | |
723 | end Load_File; | |
724 | ||
fbf5a39b AC |
725 | ---------------------------------- |
726 | -- Load_Preprocessing_Data_File -- | |
727 | ---------------------------------- | |
728 | ||
729 | function Load_Preprocessing_Data_File | |
2820d220 | 730 | (N : File_Name_Type) return Source_File_Index |
fbf5a39b AC |
731 | is |
732 | begin | |
733 | return Load_File (N, Osint.Preprocessing_Data); | |
734 | end Load_Preprocessing_Data_File; | |
735 | ||
996ae0b0 RK |
736 | ---------------------- |
737 | -- Load_Source_File -- | |
738 | ---------------------- | |
739 | ||
740 | function Load_Source_File | |
2820d220 | 741 | (N : File_Name_Type) return Source_File_Index |
996ae0b0 RK |
742 | is |
743 | begin | |
744 | return Load_File (N, Osint.Source); | |
745 | end Load_Source_File; | |
746 | ||
fbf5a39b AC |
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 | ||
da574a86 AC |
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 | ||
d8f43ee6 HK |
797 | when Tok_Pragma |
798 | | Tok_Use | |
799 | | Tok_With | |
800 | => | |
da574a86 AC |
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 | ||
d8f43ee6 HK |
826 | when Tok_Function |
827 | | Tok_Procedure | |
828 | => | |
da574a86 AC |
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 | ||
d8f43ee6 HK |
854 | when Tok_Begin |
855 | | Tok_End | |
856 | | Tok_Is | |
857 | => | |
da574a86 AC |
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 | ---------------------------- | |
0600d9bc RD |
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 | ||
996ae0b0 | 915 | end Sinput.L; |