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