779 lines
26 KiB
Ada
779 lines
26 KiB
Ada
------------------------------------------------------------------------------
|
|
-- --
|
|
-- GNAT COMPILER COMPONENTS --
|
|
-- --
|
|
-- S I N P U T . L --
|
|
-- --
|
|
-- B o d y --
|
|
-- --
|
|
-- Copyright (C) 1992-2009, 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- --
|
|
-- ware Foundation; either version 3, or (at your option) any later ver- --
|
|
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
|
|
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
|
|
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
|
|
-- for more details. You should have received a copy of the GNU General --
|
|
-- Public License distributed with GNAT; see file COPYING3. If not, go to --
|
|
-- http://www.gnu.org/licenses for a complete copy of the license. --
|
|
-- --
|
|
-- GNAT was originally developed by the GNAT team at New York University. --
|
|
-- Extensive contributions were provided by Ada Core Technologies Inc. --
|
|
-- --
|
|
------------------------------------------------------------------------------
|
|
|
|
with Alloc;
|
|
with Atree; use Atree;
|
|
with Debug; use Debug;
|
|
with Einfo; use Einfo;
|
|
with Errout; use Errout;
|
|
with Fname; use Fname;
|
|
with Hostparm;
|
|
with Opt; use Opt;
|
|
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 Snames; use Snames;
|
|
with System; use System;
|
|
|
|
with System.OS_Lib; use System.OS_Lib;
|
|
|
|
with Unchecked_Conversion;
|
|
|
|
package body Sinput.L is
|
|
|
|
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 indicating 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 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 : Osint.File_Type) return Source_File_Index;
|
|
-- 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 --
|
|
-------------------------------
|
|
|
|
procedure Adjust_Instantiation_Sloc (N : Node_Id; A : Sloc_Adjustment) is
|
|
Loc : constant Source_Ptr := Sloc (N);
|
|
|
|
begin
|
|
-- We only do the adjustment if the value is between the appropriate low
|
|
-- and high values. It is not clear that this should ever not be the
|
|
-- case, but in practice there seem to be some nodes that get copied
|
|
-- twice, and this is a defence against that happening.
|
|
|
|
if A.Lo <= Loc and then Loc <= A.Hi then
|
|
Set_Sloc (N, Loc + A.Adjust);
|
|
end if;
|
|
end Adjust_Instantiation_Sloc;
|
|
|
|
--------------------------------
|
|
-- Complete_Source_File_Entry --
|
|
--------------------------------
|
|
|
|
procedure Complete_Source_File_Entry is
|
|
CSF : constant Source_File_Index := Current_Source_File;
|
|
|
|
begin
|
|
Trim_Lines_Table (CSF);
|
|
Source_File.Table (CSF).Source_Checksum := Checksum;
|
|
end Complete_Source_File_Entry;
|
|
|
|
---------------------------------
|
|
-- Create_Instantiation_Source --
|
|
---------------------------------
|
|
|
|
procedure Create_Instantiation_Source
|
|
(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_Index;
|
|
|
|
begin
|
|
Xold := Get_Source_File_Index (Sloc (Template_Id));
|
|
A.Lo := Source_File.Table (Xold).Source_First;
|
|
A.Hi := Source_File.Table (Xold).Source_Last;
|
|
|
|
Source_File.Append (Source_File.Table (Xold));
|
|
Xnew := Source_File.Last;
|
|
|
|
Source_File.Table (Xnew).Inlined_Body := Inlined_Body;
|
|
Source_File.Table (Xnew).Instantiation := Sloc (Inst_Node);
|
|
Source_File.Table (Xnew).Template := Xold;
|
|
|
|
-- Now we need to compute the new values of Source_First, Source_Last
|
|
-- and adjust the source file pointer to have the correct virtual
|
|
-- origin for the new range of values.
|
|
|
|
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;
|
|
|
|
if Debug_Flag_L then
|
|
Write_Eol;
|
|
Write_Str ("*** Create instantiation source for ");
|
|
|
|
if Nkind (Dnod) in N_Proper_Body
|
|
and then Was_Originally_Stub (Dnod)
|
|
then
|
|
Write_Str ("subunit ");
|
|
|
|
elsif Ekind (Template_Id) = E_Generic_Package then
|
|
if Nkind (Dnod) = N_Package_Body then
|
|
Write_Str ("body of package ");
|
|
else
|
|
Write_Str ("spec of package ");
|
|
end if;
|
|
|
|
elsif Ekind (Template_Id) = E_Function then
|
|
Write_Str ("body of function ");
|
|
|
|
elsif Ekind (Template_Id) = E_Procedure then
|
|
Write_Str ("body of procedure ");
|
|
|
|
elsif Ekind (Template_Id) = E_Generic_Function then
|
|
Write_Str ("spec of function ");
|
|
|
|
elsif Ekind (Template_Id) = E_Generic_Procedure then
|
|
Write_Str ("spec of procedure ");
|
|
|
|
elsif Ekind (Template_Id) = E_Package_Body then
|
|
Write_Str ("body of package ");
|
|
|
|
else pragma Assert (Ekind (Template_Id) = E_Subprogram_Body);
|
|
|
|
if Nkind (Dnod) = N_Procedure_Specification then
|
|
Write_Str ("body of procedure ");
|
|
else
|
|
Write_Str ("body of function ");
|
|
end if;
|
|
end if;
|
|
|
|
Write_Name (Chars (Template_Id));
|
|
Write_Eol;
|
|
|
|
Write_Str (" new source index = ");
|
|
Write_Int (Int (Xnew));
|
|
Write_Eol;
|
|
|
|
Write_Str (" copying from file name = ");
|
|
Write_Name (File_Name (Xold));
|
|
Write_Eol;
|
|
|
|
Write_Str (" old source index = ");
|
|
Write_Int (Int (Xold));
|
|
Write_Eol;
|
|
|
|
Write_Str (" old lo = ");
|
|
Write_Int (Int (A.Lo));
|
|
Write_Eol;
|
|
|
|
Write_Str (" old hi = ");
|
|
Write_Int (Int (A.Hi));
|
|
Write_Eol;
|
|
|
|
Write_Str (" new lo = ");
|
|
Write_Int (Int (Source_File.Table (Xnew).Source_First));
|
|
Write_Eol;
|
|
|
|
Write_Str (" new hi = ");
|
|
Write_Int (Int (Source_File.Table (Xnew).Source_Last));
|
|
Write_Eol;
|
|
|
|
Write_Str (" adjustment factor = ");
|
|
Write_Int (Int (A.Adjust));
|
|
Write_Eol;
|
|
|
|
Write_Str (" instantiation location: ");
|
|
Write_Location (Sloc (Inst_Node));
|
|
Write_Eol;
|
|
end if;
|
|
|
|
-- For a given character in the source, a higher subscript will be used
|
|
-- to access the instantiation, which means that the virtual origin must
|
|
-- have a corresponding lower value. We compute this new origin by
|
|
-- taking the address of the appropriate adjusted element in the old
|
|
-- array. Since this adjusted element will be at a negative subscript,
|
|
-- we must suppress checks.
|
|
|
|
declare
|
|
pragma Suppress (All_Checks);
|
|
|
|
pragma Warnings (Off);
|
|
-- This unchecked conversion is aliasing safe, since it is never used
|
|
-- to create improperly aliased pointer values.
|
|
|
|
function To_Source_Buffer_Ptr is new
|
|
Unchecked_Conversion (Address, Source_Buffer_Ptr);
|
|
|
|
pragma Warnings (On);
|
|
|
|
begin
|
|
Source_File.Table (Xnew).Source_Text :=
|
|
To_Source_Buffer_Ptr
|
|
(Source_File.Table (Xold).Source_Text (-A.Adjust)'Address);
|
|
end;
|
|
end Create_Instantiation_Source;
|
|
|
|
----------------------
|
|
-- Load_Config_File --
|
|
----------------------
|
|
|
|
function Load_Config_File
|
|
(N : File_Name_Type) return Source_File_Index
|
|
is
|
|
begin
|
|
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 : Osint.File_Type) return Source_File_Index
|
|
is
|
|
Src : Source_Buffer_Ptr;
|
|
X : Source_File_Index;
|
|
Lo : Source_Ptr;
|
|
Hi : Source_Ptr;
|
|
|
|
Preprocessing_Needed : Boolean := False;
|
|
|
|
begin
|
|
-- If already there, don't need to reload file. An exception occurs
|
|
-- in multiple unit per file mode. It would be nice in this case to
|
|
-- share the same source file for each unit, but this leads to many
|
|
-- difficulties with assumptions (e.g. in the body of lib), that a
|
|
-- unit can be found by locating its source file index. Since we do
|
|
-- not expect much use of this mode, it's no big deal to waste a bit
|
|
-- of space and time by reading and storing the source multiple times.
|
|
|
|
if Multiple_Unit_Index = 0 then
|
|
for J in 1 .. Source_File.Last loop
|
|
if Source_File.Table (J).File_Name = N then
|
|
return J;
|
|
end if;
|
|
end loop;
|
|
end if;
|
|
|
|
-- 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 and then not Is_Internal_File_Name (N) then
|
|
Prepare_To_Preprocess
|
|
(Source => N, Preprocessing_Needed => Preprocessing_Needed);
|
|
end if;
|
|
|
|
Source_File.Increment_Last;
|
|
X := Source_File.Last;
|
|
|
|
if X = Source_File.First then
|
|
Lo := First_Source_Ptr;
|
|
else
|
|
Lo := Source_File.Table (X - 1).Source_Last + 1;
|
|
end if;
|
|
|
|
Osint.Read_Source_File (N, Lo, Hi, Src, T);
|
|
|
|
if Src = null then
|
|
Source_File.Decrement_Last;
|
|
return No_Source_File;
|
|
|
|
else
|
|
if Debug_Flag_L then
|
|
Write_Eol;
|
|
Write_Str ("*** Build source file table entry, Index = ");
|
|
Write_Int (Int (X));
|
|
Write_Str (", file name = ");
|
|
Write_Name (N);
|
|
Write_Eol;
|
|
Write_Str (" lo = ");
|
|
Write_Int (Int (Lo));
|
|
Write_Eol;
|
|
Write_Str (" hi = ");
|
|
Write_Int (Int (Hi));
|
|
Write_Eol;
|
|
|
|
Write_Str (" first 10 chars -->");
|
|
|
|
declare
|
|
procedure Wchar (C : Character);
|
|
-- Writes character or ? for control character
|
|
|
|
-----------
|
|
-- Wchar --
|
|
-----------
|
|
|
|
procedure Wchar (C : Character) is
|
|
begin
|
|
if C < ' '
|
|
or else C in ASCII.DEL .. Character'Val (16#9F#)
|
|
then
|
|
Write_Char ('?');
|
|
else
|
|
Write_Char (C);
|
|
end if;
|
|
end Wchar;
|
|
|
|
begin
|
|
for J in Lo .. Lo + 9 loop
|
|
Wchar (Src (J));
|
|
end loop;
|
|
|
|
Write_Str ("<--");
|
|
Write_Eol;
|
|
|
|
Write_Str (" last 10 chars -->");
|
|
|
|
for J in Hi - 10 .. Hi - 1 loop
|
|
Wchar (Src (J));
|
|
end loop;
|
|
|
|
Write_Str ("<--");
|
|
Write_Eol;
|
|
|
|
if Src (Hi) /= EOF then
|
|
Write_Str (" error: no EOF at end");
|
|
Write_Eol;
|
|
end if;
|
|
end;
|
|
end if;
|
|
|
|
declare
|
|
S : Source_File_Record renames Source_File.Table (X);
|
|
File_Type : Type_Of_File;
|
|
|
|
begin
|
|
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_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,
|
|
License => Unknown,
|
|
Lines_Table => null,
|
|
Lines_Table_Max => 1,
|
|
Logical_Lines_Table => null,
|
|
Num_SRef_Pragmas => 0,
|
|
Reference_Name => N,
|
|
Sloc_Adjust => 0,
|
|
Source_Checksum => 0,
|
|
Source_First => Lo,
|
|
Source_Last => Hi,
|
|
Source_Text => Src,
|
|
Template => No_Source_File,
|
|
Unit => No_Unit,
|
|
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
|
|
|
|
-- Temporarily set the Source_File_Index_Table entries for the
|
|
-- source, to avoid crash when reporting an error.
|
|
|
|
Set_Source_File_Index_Table (X);
|
|
|
|
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
|
|
|
|
Save_Style_Check : Boolean;
|
|
-- Saved state of the Style_Check flag (which needs to be
|
|
-- temporarily set to False during preprocessing, see below).
|
|
|
|
Modified : Boolean;
|
|
|
|
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 hooks
|
|
|
|
Prep.Setup_Hooks
|
|
(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 scanner and set its behavior for preprocessing,
|
|
-- then preprocess. Also disable style checks, since some of
|
|
-- them are done in the scanner (specifically, those dealing
|
|
-- with line length and line termination), and cannot be done
|
|
-- during preprocessing (because the source file index table
|
|
-- has not been set yet).
|
|
|
|
Scn.Scanner.Initialize_Scanner (X);
|
|
|
|
Scn.Scanner.Set_Special_Character ('#');
|
|
Scn.Scanner.Set_Special_Character ('$');
|
|
Scn.Scanner.Set_End_Of_Line_As_Token (True);
|
|
Save_Style_Check := Opt.Style_Check;
|
|
Opt.Style_Check := False;
|
|
|
|
-- Make sure that there will be no check of pragma Restrictions
|
|
-- for obsolescent features while preprocessing the source.
|
|
|
|
Scn.Set_Obsolescent_Check (False);
|
|
Preprocess (Modified);
|
|
Scn.Set_Obsolescent_Check (True);
|
|
|
|
-- Reset the scanner to its standard behavior, and restore the
|
|
-- Style_Checks flag.
|
|
|
|
Scn.Scanner.Reset_Special_Characters;
|
|
Scn.Scanner.Set_End_Of_Line_As_Token (False);
|
|
Opt.Style_Check := Save_Style_Check;
|
|
|
|
-- 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
|
|
-- Output the result of the preprocessing, if requested and
|
|
-- the source has been modified by the preprocessing.
|
|
|
|
if Generate_Processed_File and then Modified then
|
|
declare
|
|
FD : File_Descriptor;
|
|
NB : Integer;
|
|
Status : Boolean;
|
|
|
|
begin
|
|
Get_Name_String (N);
|
|
|
|
if Hostparm.OpenVMS then
|
|
Add_Str_To_Name_Buffer ("_prep");
|
|
else
|
|
Add_Str_To_Name_Buffer (".prep");
|
|
end if;
|
|
|
|
Delete_File (Name_Buffer (1 .. Name_Len), Status);
|
|
|
|
FD :=
|
|
Create_New_File (Name_Buffer (1 .. Name_Len), Text);
|
|
|
|
Status := FD /= Invalid_FD;
|
|
|
|
if Status then
|
|
NB :=
|
|
Write
|
|
(FD,
|
|
Prep_Buffer (1)'Address,
|
|
Integer (Prep_Buffer_Last));
|
|
Status := NB = Integer (Prep_Buffer_Last);
|
|
end if;
|
|
|
|
if Status then
|
|
Close (FD, Status);
|
|
end if;
|
|
|
|
if not Status then
|
|
Errout.Error_Msg
|
|
("could not write processed file """ &
|
|
Name_Buffer (1 .. Name_Len) & '"',
|
|
Lo);
|
|
return No_Source_File;
|
|
end if;
|
|
end;
|
|
end if;
|
|
|
|
-- 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;
|
|
-- Pointer type for the physical buffer allocated
|
|
|
|
Actual_Ptr : constant Actual_Source_Ptr :=
|
|
new Actual_Source_Buffer;
|
|
-- 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 Actual_Ptr (0)'Address, but
|
|
-- we have to be careful to suppress checks to compute
|
|
-- this address.
|
|
|
|
declare
|
|
pragma Suppress (All_Checks);
|
|
|
|
pragma Warnings (Off);
|
|
-- This unchecked conversion is aliasing safe, since
|
|
-- it is never used to create improperly aliased
|
|
-- pointer values.
|
|
|
|
function To_Source_Buffer_Ptr is new
|
|
Unchecked_Conversion (Address, Source_Buffer_Ptr);
|
|
|
|
pragma Warnings (On);
|
|
|
|
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 necessarily 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 --
|
|
----------------------
|
|
|
|
function Load_Source_File
|
|
(N : File_Name_Type) return Source_File_Index
|
|
is
|
|
begin
|
|
return Load_File (N, Osint.Source);
|
|
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_Pragma_No_Body --
|
|
-----------------------------------
|
|
|
|
function Source_File_Is_No_Body (X : Source_File_Index) return Boolean is
|
|
begin
|
|
Initialize_Scanner (No_Unit, X);
|
|
|
|
if Token /= Tok_Pragma then
|
|
return False;
|
|
end if;
|
|
|
|
Scan; -- past pragma
|
|
|
|
if Token /= Tok_Identifier
|
|
or else Chars (Token_Node) /= Name_No_Body
|
|
then
|
|
return False;
|
|
end if;
|
|
|
|
Scan; -- past No_Body
|
|
|
|
if Token /= Tok_Semicolon then
|
|
return False;
|
|
end if;
|
|
|
|
Scan; -- past semicolon
|
|
|
|
return Token = Tok_EOF;
|
|
end Source_File_Is_No_Body;
|
|
|
|
----------------------------
|
|
-- Source_File_Is_Subunit --
|
|
----------------------------
|
|
|
|
function Source_File_Is_Subunit (X : Source_File_Index) return Boolean is
|
|
begin
|
|
Initialize_Scanner (No_Unit, X);
|
|
|
|
-- We scan past junk to the first interesting compilation unit token, to
|
|
-- see if it is SEPARATE. We ignore WITH keywords during this and also
|
|
-- PRIVATE. The reason for ignoring PRIVATE is that it handles some
|
|
-- error situations, and also to handle PRIVATE WITH in Ada 2005 mode.
|
|
|
|
while Token = Tok_With
|
|
or else Token = Tok_Private
|
|
or else (Token not in Token_Class_Cunit and then Token /= Tok_EOF)
|
|
loop
|
|
Scan;
|
|
end loop;
|
|
|
|
return Token = Tok_Separate;
|
|
end Source_File_Is_Subunit;
|
|
|
|
end Sinput.L;
|