-- --
-- B o d y --
-- --
--- $Revision: 1.40 $
--- --
--- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2003 Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- MA 02111-1307, USA. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
--- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
with Alloc;
-with Atree; use Atree;
-with Debug; use Debug;
-with Einfo; use Einfo;
-with Namet; use Namet;
+with Atree; use Atree;
+with Debug; use Debug;
+with Einfo; use Einfo;
+with Errout; use Errout;
+with Namet; use Namet;
with Opt;
-with Osint; use Osint;
-with Output; use Output;
-with Scans; use Scans;
-with Scn; use Scn;
-with Sinfo; use Sinfo;
-with System; use System;
+with Osint; use Osint;
+with Output; use Output;
+with Prep; use Prep;
+with Prepcomp; use Prepcomp;
+with Scans; use Scans;
+with Scn; use Scn;
+with Sinfo; use Sinfo;
+with System; use System;
with Unchecked_Conversion;
package body Sinput.L is
- Dfile : Source_File_Index;
- -- Index of currently active debug source file
+ Prep_Buffer : Text_Buffer_Ptr := null;
+ -- A buffer to temporarily stored the result of preprocessing a source.
+ -- It is only allocated if there is at least one source to preprocess.
+
+ Prep_Buffer_Last : Text_Ptr := 0;
+ -- Index of the last significant character in Prep_Buffer
+
+ Initial_Size_Of_Prep_Buffer : constant := 10_000;
+ -- Size of Prep_Buffer when it is first allocated
+
+ -- When a file is to be preprocessed and the options to list symbols
+ -- has been selected (switch -s), Prep.List_Symbols is called with a
+ -- "foreword", a single line indicationg what source the symbols apply to.
+ -- The following two constant String are the start and the end of this
+ -- foreword.
+
+ Foreword_Start : constant String :=
+ "Preprocessing Symbols for source """;
+
+ Foreword_End : constant String := """";
-----------------
-- Subprograms --
-----------------
- procedure Trim_Lines_Table (S : Source_File_Index);
- -- Set lines table size for entry S in the source file table to
- -- correspond to the current value of Num_Source_Lines, releasing
- -- any unused storage.
+ procedure Put_Char_In_Prep_Buffer (C : Character);
+ -- Add one character in Prep_Buffer, extending Prep_Buffer if need be.
+ -- Used to initialize the preprocessor.
+
+ procedure New_EOL_In_Prep_Buffer;
+ -- Add an LF to Prep_Buffer.
+ -- Used to initialize the preprocessor.
function Load_File
(N : File_Name_Type;
- T : File_Type)
+ T : Osint.File_Type)
return Source_File_Index;
- -- Load a source file or a configuration pragma file.
+ -- Load a source file, a configuration pragmas file or a definition file
+ -- Coding also allows preprocessing file, but not a library file ???
-------------------------------
-- Adjust_Instantiation_Sloc --
end if;
end Adjust_Instantiation_Sloc;
- ------------------------
- -- Close_Debug_Source --
- ------------------------
-
- procedure Close_Debug_Source is
- S : Source_File_Record renames Source_File.Table (Dfile);
- Src : Source_Buffer_Ptr;
-
- begin
- Trim_Lines_Table (Dfile);
- Close_Debug_File;
-
- -- Now we need to read the file that we wrote and store it
- -- in memory for subsequent access.
-
- Read_Source_File
- (S.Debug_Source_Name, S.Source_First, S.Source_Last, Src);
- S.Source_Text := Src;
- end Close_Debug_Source;
-
--------------------------------
-- Complete_Source_File_Entry --
--------------------------------
Source_File.Table (CSF).Source_Checksum := Checksum;
end Complete_Source_File_Entry;
- -------------------------
- -- Create_Debug_Source --
- -------------------------
-
- procedure Create_Debug_Source
- (Source : Source_File_Index;
- Loc : out Source_Ptr)
- is
- begin
- Loc := Source_File.Table (Source_File.Last).Source_Last + 1;
- Source_File.Increment_Last;
- Dfile := Source_File.Last;
-
- declare
- S : Source_File_Record renames Source_File.Table (Dfile);
-
- begin
- S := Source_File.Table (Source);
- S.Debug_Source_Name := Create_Debug_File (S.File_Name);
- S.Source_First := Loc;
- S.Source_Last := Loc;
- S.Lines_Table := null;
- S.Last_Source_Line := 1;
-
- -- Allocate lines table, guess that it needs to be three times
- -- bigger than the original source (in number of lines).
-
- Alloc_Line_Tables
- (S, Int (Source_File.Table (Source).Last_Source_Line * 3));
- S.Lines_Table (1) := Loc;
- end;
-
- if Debug_Flag_GG then
- Write_Str ("---> Create_Debug_Source (Source => ");
- Write_Int (Int (Source));
- Write_Str (", Loc => ");
- Write_Int (Int (Loc));
- Write_Str (");");
- Write_Eol;
- end if;
-
- end Create_Debug_Source;
-
---------------------------------
-- Create_Instantiation_Source --
---------------------------------
procedure Create_Instantiation_Source
- (Inst_Node : Entity_Id;
- Template_Id : Entity_Id;
- A : out Sloc_Adjustment)
+ (Inst_Node : Entity_Id;
+ Template_Id : Entity_Id;
+ Inlined_Body : Boolean;
+ A : out Sloc_Adjustment)
is
Dnod : constant Node_Id := Declaration_Node (Template_Id);
Xold : Source_File_Index;
Xnew := Source_File.Last;
Source_File.Table (Xnew) := Source_File.Table (Xold);
+ Source_File.Table (Xnew).Inlined_Body := Inlined_Body;
Source_File.Table (Xnew).Instantiation := Sloc (Inst_Node);
Source_File.Table (Xnew).Template := Xold;
Source_File.Table (Xnew).Source_First :=
Source_File.Table (Xnew - 1).Source_Last + 1;
-
A.Adjust := Source_File.Table (Xnew).Source_First - A.Lo;
Source_File.Table (Xnew).Source_Last := A.Hi + A.Adjust;
+ Set_Source_File_Index_Table (Xnew);
Source_File.Table (Xnew).Sloc_Adjust :=
Source_File.Table (Xold).Sloc_Adjust - A.Adjust;
To_Source_Buffer_Ptr
(Source_File.Table (Xold).Source_Text (-A.Adjust)'Address);
end;
-
end Create_Instantiation_Source;
----------------------
return Load_File (N, Osint.Config);
end Load_Config_File;
+ --------------------------
+ -- Load_Definition_File --
+ --------------------------
+
+ function Load_Definition_File
+ (N : File_Name_Type)
+ return Source_File_Index
+ is
+ begin
+ return Load_File (N, Osint.Definition);
+ end Load_Definition_File;
+
---------------
-- Load_File --
---------------
function Load_File
(N : File_Name_Type;
- T : File_Type)
+ T : Osint.File_Type)
return Source_File_Index
is
- Src : Source_Buffer_Ptr;
- X : Source_File_Index;
- Lo : Source_Ptr;
- Hi : Source_Ptr;
+ Src : Source_Buffer_Ptr;
+ X : Source_File_Index;
+ Lo : Source_Ptr;
+ Hi : Source_Ptr;
+
+ Preprocessing_Needed : Boolean := False;
begin
for J in 1 .. Source_File.Last loop
-- Here we must build a new entry in the file table
+ -- But first, we must check if a source needs to be preprocessed,
+ -- because we may have to load and parse a definition file, and we want
+ -- to do that before we load the source, so that the buffer of the
+ -- source will be the last created, and we will be able to replace it
+ -- and modify Hi without stepping on another buffer.
+
+ if T = Osint.Source then
+ Prepare_To_Preprocess
+ (Source => N, Preprocessing_Needed => Preprocessing_Needed);
+ end if;
+
Source_File.Increment_Last;
X := Source_File.Last;
Lo := Source_File.Table (X - 1).Source_Last + 1;
end if;
- Read_Source_File (N, Lo, Hi, Src, T);
+ Osint.Read_Source_File (N, Lo, Hi, Src, T);
if Src = null then
Source_File.Decrement_Last;
end if;
declare
- S : Source_File_Record renames Source_File.Table (X);
+ S : Source_File_Record renames Source_File.Table (X);
+ File_Type : Type_Of_File;
begin
- S := (Debug_Source_Name => Full_Source_Name,
+ case T is
+ when Osint.Source =>
+ File_Type := Sinput.Src;
+
+ when Osint.Library =>
+ raise Program_Error;
+
+ when Osint.Config =>
+ File_Type := Sinput.Config;
+
+ when Osint.Definition =>
+ File_Type := Def;
+
+ when Osint.Preprocessing_Data =>
+ File_Type := Preproc;
+ end case;
+
+ S := (Debug_Source_Name => N,
File_Name => N,
+ File_Type => File_Type,
First_Mapped_Line => No_Line_Number,
- Full_File_Name => Full_Source_Name,
- Full_Ref_Name => Full_Source_Name,
+ Full_Debug_Name => Osint.Full_Source_Name,
+ Full_File_Name => Osint.Full_Source_Name,
+ Full_Ref_Name => Osint.Full_Source_Name,
Identifier_Casing => Unknown,
+ Inlined_Body => False,
Instantiation => No_Location,
Keyword_Casing => Unknown,
Last_Source_Line => 1,
Source_Last => Hi,
Source_Text => Src,
Template => No_Source_File,
- Time_Stamp => Current_Source_File_Stamp);
+ Time_Stamp => Osint.Current_Source_File_Stamp);
Alloc_Line_Tables (S, Opt.Table_Factor * Alloc.Lines_Initial);
S.Lines_Table (1) := Lo;
end;
+ -- Preprocess the source if it needs to be preprocessed
+
+ if Preprocessing_Needed then
+ if Opt.List_Preprocessing_Symbols then
+ Get_Name_String (N);
+
+ declare
+ Foreword : String (1 .. Foreword_Start'Length +
+ Name_Len + Foreword_End'Length);
+
+ begin
+ Foreword (1 .. Foreword_Start'Length) := Foreword_Start;
+ Foreword (Foreword_Start'Length + 1 ..
+ Foreword_Start'Length + Name_Len) :=
+ Name_Buffer (1 .. Name_Len);
+ Foreword (Foreword'Last - Foreword_End'Length + 1 ..
+ Foreword'Last) := Foreword_End;
+ Prep.List_Symbols (Foreword);
+ end;
+ end if;
+
+ declare
+ T : constant Nat := Total_Errors_Detected;
+ -- Used to check if there were errors during preprocessing
+
+ begin
+ -- If this is the first time we preprocess a source, allocate
+ -- the preprocessing buffer.
+
+ if Prep_Buffer = null then
+ Prep_Buffer :=
+ new Text_Buffer (1 .. Initial_Size_Of_Prep_Buffer);
+ end if;
+
+ -- Make sure the preprocessing buffer is empty
+
+ Prep_Buffer_Last := 0;
+
+ -- Initialize the preprocessor
+
+ Prep.Initialize
+ (Error_Msg => Errout.Error_Msg'Access,
+ Scan => Scn.Scanner.Scan'Access,
+ Set_Ignore_Errors => Errout.Set_Ignore_Errors'Access,
+ Put_Char => Put_Char_In_Prep_Buffer'Access,
+ New_EOL => New_EOL_In_Prep_Buffer'Access);
+
+ -- Initialize the scanner and set its behavior for
+ -- preprocessing, then preprocess.
+
+ Scn.Scanner.Initialize_Scanner (No_Unit, X);
+
+ Scn.Scanner.Set_Special_Character ('#');
+ Scn.Scanner.Set_Special_Character ('$');
+ Scn.Scanner.Set_End_Of_Line_As_Token (True);
+
+ Preprocess;
+
+ -- Reset the scanner to its standard behavior
+
+ Scn.Scanner.Reset_Special_Characters;
+ Scn.Scanner.Set_End_Of_Line_As_Token (False);
+
+ -- If there were errors during preprocessing, record an
+ -- error at the start of the file, and do not change the
+ -- source buffer.
+
+ if T /= Total_Errors_Detected then
+ Errout.Error_Msg
+ ("file could not be successfully preprocessed", Lo);
+ return No_Source_File;
+
+ else
+ -- Set the new value of Hi
+
+ Hi := Lo + Source_Ptr (Prep_Buffer_Last);
+
+ -- Create the new source buffer
+
+ declare
+ subtype Actual_Source_Buffer is Source_Buffer (Lo .. Hi);
+ -- Physical buffer allocated
+
+ type Actual_Source_Ptr is access Actual_Source_Buffer;
+ -- This is the pointer type for the physical buffer
+ -- allocated.
+
+ Actual_Ptr : constant Actual_Source_Ptr :=
+ new Actual_Source_Buffer;
+ -- And this is the actual physical buffer
+
+ begin
+ Actual_Ptr (Lo .. Hi - 1) :=
+ Prep_Buffer (1 .. Prep_Buffer_Last);
+ Actual_Ptr (Hi) := EOF;
+
+ -- Now we need to work out the proper virtual origin
+ -- pointer to return. This is exactly
+ -- Actual_Ptr (0)'Address, but we have to be careful to
+ -- suppress checks to compute this address.
+
+ declare
+ pragma Suppress (All_Checks);
+
+ function To_Source_Buffer_Ptr is new
+ Unchecked_Conversion (Address, Source_Buffer_Ptr);
+
+ begin
+ Src := To_Source_Buffer_Ptr (Actual_Ptr (0)'Address);
+
+ -- Record in the table the new source buffer and the
+ -- new value of Hi.
+
+ Source_File.Table (X).Source_Text := Src;
+ Source_File.Table (X).Source_Last := Hi;
+
+ -- Reset Last_Line to 1, because the lines do not
+ -- have neccessarily the same starts and lengths.
+
+ Source_File.Table (X).Last_Source_Line := 1;
+ end;
+ end;
+ end if;
+ end;
+ end if;
+
+ Set_Source_File_Index_Table (X);
return X;
end if;
end Load_File;
+ ----------------------------------
+ -- Load_Preprocessing_Data_File --
+ ----------------------------------
+
+ function Load_Preprocessing_Data_File
+ (N : File_Name_Type)
+ return Source_File_Index
+ is
+ begin
+ return Load_File (N, Osint.Preprocessing_Data);
+ end Load_Preprocessing_Data_File;
+
----------------------
-- Load_Source_File --
----------------------
end Load_Source_File;
----------------------------
+ -- New_EOL_In_Prep_Buffer --
+ ----------------------------
+
+ procedure New_EOL_In_Prep_Buffer is
+ begin
+ Put_Char_In_Prep_Buffer (ASCII.LF);
+ end New_EOL_In_Prep_Buffer;
+
+ -----------------------------
+ -- Put_Char_In_Prep_Buffer --
+ -----------------------------
+
+ procedure Put_Char_In_Prep_Buffer (C : Character) is
+ begin
+ -- If preprocessing buffer is not large enough, double it
+
+ if Prep_Buffer_Last = Prep_Buffer'Last then
+ declare
+ New_Prep_Buffer : constant Text_Buffer_Ptr :=
+ new Text_Buffer (1 .. 2 * Prep_Buffer_Last);
+
+ begin
+ New_Prep_Buffer (Prep_Buffer'Range) := Prep_Buffer.all;
+ Free (Prep_Buffer);
+ Prep_Buffer := New_Prep_Buffer;
+ end;
+ end if;
+
+ Prep_Buffer_Last := Prep_Buffer_Last + 1;
+ Prep_Buffer (Prep_Buffer_Last) := C;
+ end Put_Char_In_Prep_Buffer;
+
+ ----------------------------
-- Source_File_Is_Subunit --
----------------------------
return Token = Tok_Separate;
end Source_File_Is_Subunit;
- ----------------------
- -- Trim_Lines_Table --
- ----------------------
-
- procedure Trim_Lines_Table (S : Source_File_Index) is
-
- function realloc
- (P : Lines_Table_Ptr;
- New_Size : Int)
- return Lines_Table_Ptr;
- pragma Import (C, realloc);
-
- Max : constant Nat := Nat (Source_File.Table (S).Last_Source_Line);
-
- begin
- -- Release allocated storage that is no longer needed
-
- Source_File.Table (S).Lines_Table :=
- realloc
- (Source_File.Table (S).Lines_Table,
- Max * (Lines_Table_Type'Component_Size / System.Storage_Unit));
- Source_File.Table (S).Lines_Table_Max := Physical_Line_Number (Max);
- end Trim_Lines_Table;
-
- ----------------------
- -- Write_Debug_Line --
- ----------------------
-
- procedure Write_Debug_Line (Str : String; Loc : in out Source_Ptr) is
- S : Source_File_Record renames Source_File.Table (Dfile);
-
- begin
- -- Ignore write request if null line at start of file
-
- if Str'Length = 0 and then Loc = S.Source_First then
- return;
-
- -- Here we write the line, and update the source record entry
-
- else
- Write_Debug_Info (Str);
- Add_Line_Tables_Entry (S, Loc);
- Loc := Loc + Source_Ptr (Str'Length + Debug_File_Eol_Length);
- S.Source_Last := Loc;
-
- if Debug_Flag_GG then
- declare
- Lin : constant String := Str;
-
- begin
- Column := 1;
- Write_Str ("---> Write_Debug_Line (Str => """);
- Write_Str (Lin);
- Write_Str (""", Loc => ");
- Write_Int (Int (Loc));
- Write_Str (");");
- Write_Eol;
- end;
- end if;
- end if;
- end Write_Debug_Line;
-
end Sinput.L;
OSDN Git Service
