1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2004 Free Software Foundation, Inc. --
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 2, 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 COPYING. If not, write --
19 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
20 -- MA 02111-1307, USA. --
22 -- GNAT was originally developed by the GNAT team at New York University. --
23 -- Extensive contributions were provided by Ada Core Technologies Inc. --
25 ------------------------------------------------------------------------------
28 with Atree; use Atree;
29 with Debug; use Debug;
30 with Einfo; use Einfo;
31 with Errout; use Errout;
32 with Namet; use Namet;
34 with Osint; use Osint;
35 with Output; use Output;
37 with Prepcomp; use Prepcomp;
38 with Scans; use Scans;
40 with Sinfo; use Sinfo;
41 with System; use System;
43 with Unchecked_Conversion;
45 package body Sinput.L is
47 Prep_Buffer : Text_Buffer_Ptr := null;
48 -- A buffer to temporarily stored the result of preprocessing a source.
49 -- It is only allocated if there is at least one source to preprocess.
51 Prep_Buffer_Last : Text_Ptr := 0;
52 -- Index of the last significant character in Prep_Buffer
54 Initial_Size_Of_Prep_Buffer : constant := 10_000;
55 -- Size of Prep_Buffer when it is first allocated
57 -- When a file is to be preprocessed and the options to list symbols
58 -- has been selected (switch -s), Prep.List_Symbols is called with a
59 -- "foreword", a single line indicationg what source the symbols apply to.
60 -- The following two constant String are the start and the end of this
63 Foreword_Start : constant String :=
64 "Preprocessing Symbols for source """;
66 Foreword_End : constant String := """";
72 procedure Put_Char_In_Prep_Buffer (C : Character);
73 -- Add one character in Prep_Buffer, extending Prep_Buffer if need be.
74 -- Used to initialize the preprocessor.
76 procedure New_EOL_In_Prep_Buffer;
77 -- Add an LF to Prep_Buffer.
78 -- Used to initialize the preprocessor.
82 T : Osint.File_Type) return Source_File_Index;
83 -- Load a source file, a configuration pragmas file or a definition file
84 -- Coding also allows preprocessing file, but not a library file ???
86 -------------------------------
87 -- Adjust_Instantiation_Sloc --
88 -------------------------------
90 procedure Adjust_Instantiation_Sloc (N : Node_Id; A : Sloc_Adjustment) is
91 Loc : constant Source_Ptr := Sloc (N);
94 -- We only do the adjustment if the value is between the appropriate
95 -- low and high values. It is not clear that this should ever not be
96 -- the case, but in practice there seem to be some nodes that get
97 -- copied twice, and this is a defence against that happening.
99 if A.Lo <= Loc and then Loc <= A.Hi then
100 Set_Sloc (N, Loc + A.Adjust);
102 end Adjust_Instantiation_Sloc;
104 --------------------------------
105 -- Complete_Source_File_Entry --
106 --------------------------------
108 procedure Complete_Source_File_Entry is
109 CSF : constant Source_File_Index := Current_Source_File;
112 Trim_Lines_Table (CSF);
113 Source_File.Table (CSF).Source_Checksum := Checksum;
114 end Complete_Source_File_Entry;
116 ---------------------------------
117 -- Create_Instantiation_Source --
118 ---------------------------------
120 procedure Create_Instantiation_Source
121 (Inst_Node : Entity_Id;
122 Template_Id : Entity_Id;
123 Inlined_Body : Boolean;
124 A : out Sloc_Adjustment)
126 Dnod : constant Node_Id := Declaration_Node (Template_Id);
127 Xold : Source_File_Index;
128 Xnew : Source_File_Index;
131 Xold := Get_Source_File_Index (Sloc (Template_Id));
132 A.Lo := Source_File.Table (Xold).Source_First;
133 A.Hi := Source_File.Table (Xold).Source_Last;
135 Source_File.Increment_Last;
136 Xnew := Source_File.Last;
138 Source_File.Table (Xnew) := Source_File.Table (Xold);
139 Source_File.Table (Xnew).Inlined_Body := Inlined_Body;
140 Source_File.Table (Xnew).Instantiation := Sloc (Inst_Node);
141 Source_File.Table (Xnew).Template := Xold;
143 -- Now we need to compute the new values of Source_First, Source_Last
144 -- and adjust the source file pointer to have the correct virtual
145 -- origin for the new range of values.
147 Source_File.Table (Xnew).Source_First :=
148 Source_File.Table (Xnew - 1).Source_Last + 1;
149 A.Adjust := Source_File.Table (Xnew).Source_First - A.Lo;
150 Source_File.Table (Xnew).Source_Last := A.Hi + A.Adjust;
151 Set_Source_File_Index_Table (Xnew);
153 Source_File.Table (Xnew).Sloc_Adjust :=
154 Source_File.Table (Xold).Sloc_Adjust - A.Adjust;
158 Write_Str ("*** Create instantiation source for ");
160 if Nkind (Dnod) in N_Proper_Body
161 and then Was_Originally_Stub (Dnod)
163 Write_Str ("subunit ");
165 elsif Ekind (Template_Id) = E_Generic_Package then
166 if Nkind (Dnod) = N_Package_Body then
167 Write_Str ("body of package ");
169 Write_Str ("spec of package ");
172 elsif Ekind (Template_Id) = E_Function then
173 Write_Str ("body of function ");
175 elsif Ekind (Template_Id) = E_Procedure then
176 Write_Str ("body of procedure ");
178 elsif Ekind (Template_Id) = E_Generic_Function then
179 Write_Str ("spec of function ");
181 elsif Ekind (Template_Id) = E_Generic_Procedure then
182 Write_Str ("spec of procedure ");
184 elsif Ekind (Template_Id) = E_Package_Body then
185 Write_Str ("body of package ");
187 else pragma Assert (Ekind (Template_Id) = E_Subprogram_Body);
189 if Nkind (Dnod) = N_Procedure_Specification then
190 Write_Str ("body of procedure ");
192 Write_Str ("body of function ");
196 Write_Name (Chars (Template_Id));
199 Write_Str (" new source index = ");
200 Write_Int (Int (Xnew));
203 Write_Str (" copying from file name = ");
204 Write_Name (File_Name (Xold));
207 Write_Str (" old source index = ");
208 Write_Int (Int (Xold));
211 Write_Str (" old lo = ");
212 Write_Int (Int (A.Lo));
215 Write_Str (" old hi = ");
216 Write_Int (Int (A.Hi));
219 Write_Str (" new lo = ");
220 Write_Int (Int (Source_File.Table (Xnew).Source_First));
223 Write_Str (" new hi = ");
224 Write_Int (Int (Source_File.Table (Xnew).Source_Last));
227 Write_Str (" adjustment factor = ");
228 Write_Int (Int (A.Adjust));
231 Write_Str (" instantiation location: ");
232 Write_Location (Sloc (Inst_Node));
236 -- For a given character in the source, a higher subscript will be
237 -- used to access the instantiation, which means that the virtual
238 -- origin must have a corresponding lower value. We compute this
239 -- new origin by taking the address of the appropriate adjusted
240 -- element in the old array. Since this adjusted element will be
241 -- at a negative subscript, we must suppress checks.
244 pragma Suppress (All_Checks);
246 pragma Warnings (Off);
247 -- This unchecked conversion is aliasing safe, since it is never
248 -- used to create improperly aliased pointer values.
250 function To_Source_Buffer_Ptr is new
251 Unchecked_Conversion (Address, Source_Buffer_Ptr);
253 pragma Warnings (On);
256 Source_File.Table (Xnew).Source_Text :=
258 (Source_File.Table (Xold).Source_Text (-A.Adjust)'Address);
260 end Create_Instantiation_Source;
262 ----------------------
263 -- Load_Config_File --
264 ----------------------
266 function Load_Config_File
267 (N : File_Name_Type) return Source_File_Index
270 return Load_File (N, Osint.Config);
271 end Load_Config_File;
273 --------------------------
274 -- Load_Definition_File --
275 --------------------------
277 function Load_Definition_File
278 (N : File_Name_Type) return Source_File_Index
281 return Load_File (N, Osint.Definition);
282 end Load_Definition_File;
290 T : Osint.File_Type) return Source_File_Index
292 Src : Source_Buffer_Ptr;
293 X : Source_File_Index;
297 Preprocessing_Needed : Boolean := False;
300 -- If already there, don't need to reload file. An exception occurs
301 -- in multiple unit per file mode. It would be nice in this case to
302 -- share the same source file for each unit, but this leads to many
303 -- difficulties with assumptions (e.g. in the body of lib), that a
304 -- unit can be found by locating its source file index. Since we do
305 -- not expect much use of this mode, it's no big deal to waste a bit
306 -- of space and time by reading and storing the source multiple times.
308 if Multiple_Unit_Index = 0 then
309 for J in 1 .. Source_File.Last loop
310 if Source_File.Table (J).File_Name = N then
316 -- Here we must build a new entry in the file table
318 -- But first, we must check if a source needs to be preprocessed,
319 -- because we may have to load and parse a definition file, and we want
320 -- to do that before we load the source, so that the buffer of the
321 -- source will be the last created, and we will be able to replace it
322 -- and modify Hi without stepping on another buffer.
324 if T = Osint.Source then
325 Prepare_To_Preprocess
326 (Source => N, Preprocessing_Needed => Preprocessing_Needed);
329 Source_File.Increment_Last;
330 X := Source_File.Last;
332 if X = Source_File.First then
333 Lo := First_Source_Ptr;
335 Lo := Source_File.Table (X - 1).Source_Last + 1;
338 Osint.Read_Source_File (N, Lo, Hi, Src, T);
341 Source_File.Decrement_Last;
342 return No_Source_File;
347 Write_Str ("*** Build source file table entry, Index = ");
349 Write_Str (", file name = ");
352 Write_Str (" lo = ");
353 Write_Int (Int (Lo));
355 Write_Str (" hi = ");
356 Write_Int (Int (Hi));
359 Write_Str (" first 10 chars -->");
362 procedure Wchar (C : Character);
363 -- Writes character or ? for control character
365 procedure Wchar (C : Character) is
367 if C < ' ' or C in ASCII.DEL .. Character'Val (16#9F#) then
375 for J in Lo .. Lo + 9 loop
382 Write_Str (" last 10 chars -->");
384 for J in Hi - 10 .. Hi - 1 loop
391 if Src (Hi) /= EOF then
392 Write_Str (" error: no EOF at end");
399 S : Source_File_Record renames Source_File.Table (X);
400 File_Type : Type_Of_File;
405 File_Type := Sinput.Src;
407 when Osint.Library =>
411 File_Type := Sinput.Config;
413 when Osint.Definition =>
416 when Osint.Preprocessing_Data =>
417 File_Type := Preproc;
420 S := (Debug_Source_Name => N,
422 File_Type => File_Type,
423 First_Mapped_Line => No_Line_Number,
424 Full_Debug_Name => Osint.Full_Source_Name,
425 Full_File_Name => Osint.Full_Source_Name,
426 Full_Ref_Name => Osint.Full_Source_Name,
427 Identifier_Casing => Unknown,
428 Inlined_Body => False,
429 Instantiation => No_Location,
430 Keyword_Casing => Unknown,
431 Last_Source_Line => 1,
434 Lines_Table_Max => 1,
435 Logical_Lines_Table => null,
436 Num_SRef_Pragmas => 0,
439 Source_Checksum => 0,
443 Template => No_Source_File,
444 Time_Stamp => Osint.Current_Source_File_Stamp);
446 Alloc_Line_Tables (S, Opt.Table_Factor * Alloc.Lines_Initial);
447 S.Lines_Table (1) := Lo;
450 -- Preprocess the source if it needs to be preprocessed
452 if Preprocessing_Needed then
453 if Opt.List_Preprocessing_Symbols then
457 Foreword : String (1 .. Foreword_Start'Length +
458 Name_Len + Foreword_End'Length);
461 Foreword (1 .. Foreword_Start'Length) := Foreword_Start;
462 Foreword (Foreword_Start'Length + 1 ..
463 Foreword_Start'Length + Name_Len) :=
464 Name_Buffer (1 .. Name_Len);
465 Foreword (Foreword'Last - Foreword_End'Length + 1 ..
466 Foreword'Last) := Foreword_End;
467 Prep.List_Symbols (Foreword);
472 T : constant Nat := Total_Errors_Detected;
473 -- Used to check if there were errors during preprocessing
476 -- If this is the first time we preprocess a source, allocate
477 -- the preprocessing buffer.
479 if Prep_Buffer = null then
481 new Text_Buffer (1 .. Initial_Size_Of_Prep_Buffer);
484 -- Make sure the preprocessing buffer is empty
486 Prep_Buffer_Last := 0;
488 -- Initialize the preprocessor
491 (Error_Msg => Errout.Error_Msg'Access,
492 Scan => Scn.Scanner.Scan'Access,
493 Set_Ignore_Errors => Errout.Set_Ignore_Errors'Access,
494 Put_Char => Put_Char_In_Prep_Buffer'Access,
495 New_EOL => New_EOL_In_Prep_Buffer'Access);
497 -- Initialize the scanner and set its behavior for
498 -- preprocessing, then preprocess.
500 Scn.Scanner.Initialize_Scanner (No_Unit, X);
502 Scn.Scanner.Set_Special_Character ('#');
503 Scn.Scanner.Set_Special_Character ('$');
504 Scn.Scanner.Set_End_Of_Line_As_Token (True);
508 -- Reset the scanner to its standard behavior
510 Scn.Scanner.Reset_Special_Characters;
511 Scn.Scanner.Set_End_Of_Line_As_Token (False);
513 -- If there were errors during preprocessing, record an
514 -- error at the start of the file, and do not change the
517 if T /= Total_Errors_Detected then
519 ("file could not be successfully preprocessed", Lo);
520 return No_Source_File;
523 -- Set the new value of Hi
525 Hi := Lo + Source_Ptr (Prep_Buffer_Last);
527 -- Create the new source buffer
530 subtype Actual_Source_Buffer is Source_Buffer (Lo .. Hi);
531 -- Physical buffer allocated
533 type Actual_Source_Ptr is access Actual_Source_Buffer;
534 -- This is the pointer type for the physical buffer
537 Actual_Ptr : constant Actual_Source_Ptr :=
538 new Actual_Source_Buffer;
539 -- And this is the actual physical buffer
542 Actual_Ptr (Lo .. Hi - 1) :=
543 Prep_Buffer (1 .. Prep_Buffer_Last);
544 Actual_Ptr (Hi) := EOF;
546 -- Now we need to work out the proper virtual origin
547 -- pointer to return. This is exactly
548 -- Actual_Ptr (0)'Address, but we have to be careful to
549 -- suppress checks to compute this address.
552 pragma Suppress (All_Checks);
554 pragma Warnings (Off);
555 -- This unchecked conversion is aliasing safe, since
556 -- it is never used to create improperly aliased
559 function To_Source_Buffer_Ptr is new
560 Unchecked_Conversion (Address, Source_Buffer_Ptr);
562 pragma Warnings (On);
565 Src := To_Source_Buffer_Ptr (Actual_Ptr (0)'Address);
567 -- Record in the table the new source buffer and the
570 Source_File.Table (X).Source_Text := Src;
571 Source_File.Table (X).Source_Last := Hi;
573 -- Reset Last_Line to 1, because the lines do not
574 -- have neccessarily the same starts and lengths.
576 Source_File.Table (X).Last_Source_Line := 1;
583 Set_Source_File_Index_Table (X);
588 ----------------------------------
589 -- Load_Preprocessing_Data_File --
590 ----------------------------------
592 function Load_Preprocessing_Data_File
593 (N : File_Name_Type) return Source_File_Index
596 return Load_File (N, Osint.Preprocessing_Data);
597 end Load_Preprocessing_Data_File;
599 ----------------------
600 -- Load_Source_File --
601 ----------------------
603 function Load_Source_File
604 (N : File_Name_Type) return Source_File_Index
607 return Load_File (N, Osint.Source);
608 end Load_Source_File;
610 ----------------------------
611 -- New_EOL_In_Prep_Buffer --
612 ----------------------------
614 procedure New_EOL_In_Prep_Buffer is
616 Put_Char_In_Prep_Buffer (ASCII.LF);
617 end New_EOL_In_Prep_Buffer;
619 -----------------------------
620 -- Put_Char_In_Prep_Buffer --
621 -----------------------------
623 procedure Put_Char_In_Prep_Buffer (C : Character) is
625 -- If preprocessing buffer is not large enough, double it
627 if Prep_Buffer_Last = Prep_Buffer'Last then
629 New_Prep_Buffer : constant Text_Buffer_Ptr :=
630 new Text_Buffer (1 .. 2 * Prep_Buffer_Last);
633 New_Prep_Buffer (Prep_Buffer'Range) := Prep_Buffer.all;
635 Prep_Buffer := New_Prep_Buffer;
639 Prep_Buffer_Last := Prep_Buffer_Last + 1;
640 Prep_Buffer (Prep_Buffer_Last) := C;
641 end Put_Char_In_Prep_Buffer;
643 ----------------------------
644 -- Source_File_Is_Subunit --
645 ----------------------------
647 function Source_File_Is_Subunit (X : Source_File_Index) return Boolean is
649 Initialize_Scanner (No_Unit, X);
651 -- We scan past junk to the first interesting compilation unit
652 -- token, to see if it is SEPARATE. We ignore WITH keywords during
653 -- this and also PRIVATE. The reason for ignoring PRIVATE is that
654 -- it handles some error situations, and also it is possible that
655 -- a PRIVATE WITH feature might be approved some time in the future.
657 while Token = Tok_With
658 or else Token = Tok_Private
659 or else (Token not in Token_Class_Cunit and then Token /= Tok_EOF)
664 return Token = Tok_Separate;
665 end Source_File_Is_Subunit;