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