]> git.ipfire.org Git - thirdparty/gcc.git/blame - gcc/ada/sinput-l.adb
[Ada] Bump copyright year
[thirdparty/gcc.git] / gcc / ada / sinput-l.adb
CommitLineData
996ae0b0
RK
1------------------------------------------------------------------------------
2-- --
3-- GNAT COMPILER COMPONENTS --
4-- --
5-- S I N P U T . L --
6-- --
7-- B o d y --
8-- --
4b490c1e 9-- Copyright (C) 1992-2020, 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
26with Alloc;
fbf5a39b
AC
27with Atree; use Atree;
28with Debug; use Debug;
29with Einfo; use Einfo;
30with Errout; use Errout;
a037f912 31with Fname; use Fname;
ea4ce0f7 32with Lib; use Lib;
2820d220 33with Opt; use Opt;
fbf5a39b
AC
34with Osint; use Osint;
35with Output; use Output;
36with Prep; use Prep;
37with Prepcomp; use Prepcomp;
38with Scans; use Scans;
39with Scn; use Scn;
cf427f02
AC
40with Sem_Aux; use Sem_Aux;
41with Sem_Util; use Sem_Util;
fbf5a39b 42with Sinfo; use Sinfo;
0600d9bc 43with Snames; use Snames;
fbf5a39b 44with System; use System;
996ae0b0 45
a037f912
VC
46with System.OS_Lib; use System.OS_Lib;
47
996ae0b0
RK
48package 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 915end Sinput.L;