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