Skip to content

R
riscv-gcc-1
Commit 68e2ea27 by Thomas Quinot Committed by Arnaud Charlet
Options

ali-util.adb (Get_File_Checksum): Update to account for change in profile of Initialize_Scanner. 

2006-02-13  Thomas Quinot  <quinot@adacore.com>
	    Vincent Celier  <celier@adacore.com>
	    Robert Dewar  <dewar@adacore.com>

	* ali-util.adb (Get_File_Checksum): Update to account for change in
	profile of Initialize_Scanner.

	* gprep.adb (Gnatprep): Update to account for change in profile of
	Initialize_Scanner.
	(Process_One_File): Same.

	* lib.adb (Get_Code_Or_Source_Unit): New subprogram factoring the
	common code between Get_Code_Unit and Get_Source_Unit. Reimplement
	that behaviour using the new Unit information recorded in the source
	files table, rather than going through all units every time.
	(Get_Code_Unit): Reimplement in terms of Get_Code_Or_Source_Unit.
	(Get_Source_Unit): Same.

	* prepcomp.adb (Parse_Preprocessing_Data_File): Update to account for
	change in profile of Initialize_Scanner.
	(Prepare_To_Preprocess): Same.

	* lib.ads: Fix typo in comment (templace -> template).

	* prj-part.adb (Parse_Single_Project): Update to account for change in
	profile of Initialize_Scanner.

	* scn.adb (Initialize_Scanner): Account for change in profile of
	Scng.Initialize_Scanner: set Current_Source_Unit in Scn instead of Scng.
	Also record the association of the given Source_File_Index to the
	corresponding Unit_Number_Type.

	* scng.ads, scng.adb (Initialize_Scanner.Set_Reserved): Remove
	procedure.
	(Initialize_Scanner): Call Scans.Initialize_Ada_Keywords.
	Remove Unit formal for generic scanner: this formal
	is only relevant to Scn (the scanner instance used to parse Ada source
	files), not to other instances. Update comment accordingly.
	(Scan): Use new function Snames.Is_Keyword_Name.

	* sinfo-cn.adb: Fix typo in comment.

	* sinput.adb (Unit, Set_Unit): Accessors for new source file attribute
	Unit.

	* sinput.ads (Source_File_Record): New component Unit, used to capture
	the unit identifier (if any) associated to a source file.

	* sinput-c.adb, sinput-l.adb (Load_File): Initialize new component
	Unit in Source_File_Record.

	* sinput-p.adb (Source_File_Is_Subunit): Update to account for change
	in profile of Initialize_Scanner.

	* scans.adb (Initialize_Ada_Keywords): New procedure

	* scans.ads (Initialize_Ada_Keywords): New procedure to initialize the
	Ada keywords in the Namet table, without the need to call
	Initialize_Scanner.

	* snames.adb: Add pragma Ada_2005 (synonym for Ada_05)
	(Is_Keyword_Name): New function

	* snames.ads: Add subtype Configuration_Pragma_Names
	Add pragma Ada_2005 (synonym for Ada_05)
	(Is_Keyword_Name): New function

	* snames.h: Add pragma Ada_2005 (synonym for Ada_05)

From-SVN: r111032
parent 6f301919
Showing with 233 additions and 189 deletions
gcc/ada/ali-util.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2006, 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- --
......@@ -154,7 +154,7 @@ package body ALI.Util is
return Checksum_Error;
end if;
Scanner.Initialize_Scanner (Types.No_Unit, Source_Index);
Scanner.Initialize_Scanner (Source_Index);
-- Make sure that the project language reserved words are not
-- recognized as reserved words, but as identifiers. The byte info for
......
gcc/ada/gprep.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2002-2005, Free Software Foundation, Inc. --
-- Copyright (C) 2002-2006, 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- --
......@@ -27,7 +27,7 @@
with Csets;
with Err_Vars; use Err_Vars;
with Errutil;
with Gnatvsn;
with Gnatvsn; use Gnatvsn;
with Namet; use Namet;
with Opt;
with Osint; use Osint;
......@@ -137,7 +137,9 @@ package body GPrep is
begin
if not Copyright_Displayed then
Write_Line ("GNAT Preprocessor " & Gnatvsn.Gnat_Version_String);
Write_Line ("Copyright 1996-2005, Free Software Foundation, Inc.");
Write_Line ("Copyright 1996-" &
Current_Year &
", Free Software Foundation, Inc.");
Copyright_Displayed := True;
end if;
end Display_Copyright;
......@@ -241,7 +243,7 @@ package body GPrep is
"""");
end if;
Scanner.Initialize_Scanner (No_Unit, Deffile);
Scanner.Initialize_Scanner (Deffile);
Prep.Parse_Def_File;
end;
......@@ -502,7 +504,7 @@ package body GPrep is
Sinput.Main_Source_File := Infile;
Scanner.Initialize_Scanner (No_Unit, Infile);
Scanner.Initialize_Scanner (Infile);
-- Output the SFN pragma if asked to
......
gcc/ada/lib.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2006, 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- --
......@@ -66,6 +66,12 @@ package body Lib is
-- Used by In_Same_Extended_Unit and Earlier_In_Extended_Unit. Returns
-- value as described above.
function Get_Code_Or_Source_Unit
(S : Source_Ptr;
Unwind_Instances : Boolean) return Unit_Number_Type;
-- Common code for Get_Code_Unit (get unit of instantiation for location)
-- and Get_Source_Unit (get unit of template for location).
--------------------------------------------
-- Access Functions for Unit Table Fields --
--------------------------------------------
......@@ -486,11 +492,14 @@ package body Lib is
end if;
end Generic_Separately_Compiled;
-------------------
-- Get_Code_Unit --
-------------------
-----------------------------
-- Get_Code_Or_Source_Unit --
-----------------------------
function Get_Code_Unit (S : Source_Ptr) return Unit_Number_Type is
function Get_Code_Or_Source_Unit
(S : Source_Ptr;
Unwind_Instances : Boolean) return Unit_Number_Type
is
begin
-- Search table unless we have No_Location, which can happen if the
-- relevant location has not been set yet. Happens for example when
......@@ -498,22 +507,41 @@ package body Lib is
if S /= No_Location then
declare
Source_File : constant Source_File_Index :=
Get_Source_File_Index (Top_Level_Location (S));
Source_File : Source_File_Index;
Source_Unit : Unit_Number_Type;
begin
for U in Units.First .. Units.Last loop
if Source_Index (U) = Source_File then
return U;
end if;
end loop;
Source_File := Get_Source_File_Index (S);
if Unwind_Instances then
while Template (Source_File) /= No_Source_File loop
Source_File := Template (Source_File);
end loop;
end if;
Source_Unit := Unit (Source_File);
if Source_Unit /= No_Unit then
return Source_Unit;
end if;
end;
end if;
-- If S was No_Location, or was not in the table, we must be in the
-- main source unit (and the value has not been placed in the table yet)
-- If S was No_Location, or was not in the table, we must be in the main
-- source unit (and the value has not been placed in the table yet),
-- or in one of the configuration pragma files.
return Main_Unit;
end Get_Code_Or_Source_Unit;
-------------------
-- Get_Code_Unit --
-------------------
function Get_Code_Unit (S : Source_Ptr) return Unit_Number_Type is
begin
return Get_Code_Or_Source_Unit (Top_Level_Location (S),
Unwind_Instances => False);
end Get_Code_Unit;
function Get_Code_Unit (N : Node_Or_Entity_Id) return Unit_Number_Type is
......@@ -579,33 +607,7 @@ package body Lib is
function Get_Source_Unit (S : Source_Ptr) return Unit_Number_Type is
begin
-- Search table unless we have No_Location, which can happen if the
-- relevant location has not been set yet. Happens for example when
-- we obtain Sloc (Cunit (Main_Unit)) before it is set.
if S /= No_Location then
declare
Source_File : Source_File_Index :=
Get_Source_File_Index (Top_Level_Location (S));
begin
Source_File := Get_Source_File_Index (S);
while Template (Source_File) /= No_Source_File loop
Source_File := Template (Source_File);
end loop;
for U in Units.First .. Units.Last loop
if Source_Index (U) = Source_File then
return U;
end if;
end loop;
end;
end if;
-- If S was No_Location, or was not in the table, we must be in the
-- main source unit (and the value has not got put into the table yet)
return Main_Unit;
return Get_Code_Or_Source_Unit (S, Unwind_Instances => True);
end Get_Source_Unit;
function Get_Source_Unit (N : Node_Or_Entity_Id) return Unit_Number_Type is
......
gcc/ada/lib.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2006, 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- --
......@@ -424,10 +424,10 @@ package Lib is
-- Return unit number of file identified by given source pointer value.
-- This call must always succeed, since any valid source pointer value
-- belongs to some previously loaded module. If the given source pointer
-- value is within an instantiation, this function returns the unit
-- number of the templace, i.e. the unit containing the source code
-- corresponding to the given Source_Ptr value. The version taking
-- a Node_Id argument, N, simply applies the function to Sloc (N).
-- value is within an instantiation, this function returns the unit number
-- of the template, i.e. the unit containing the source code corresponding
-- to the given Source_Ptr value. The version taking a Node_Id argument, N,
-- simply applies the function to Sloc (N).
function Get_Code_Unit (N : Node_Or_Entity_Id) return Unit_Number_Type;
pragma Inline (Get_Code_Unit);
......
gcc/ada/prepcomp.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2003-2005, Free Software Foundation, Inc. --
-- Copyright (C) 2003-2006, 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- --
......@@ -248,8 +248,7 @@ package body Prepcomp is
-- Initialize the sanner and set its behavior for a processing data file
Scn.Scanner.Initialize_Scanner
(No_Unit, Source_Index_Of_Preproc_Data_File);
Scn.Scanner.Initialize_Scanner (Source_Index_Of_Preproc_Data_File);
Scn.Scanner.Set_End_Of_Line_As_Token (True);
Scn.Scanner.Reset_Special_Characters;
......@@ -676,7 +675,7 @@ package body Prepcomp is
-- Initialize the scanner and process the definition file
Scn.Scanner.Initialize_Scanner (No_Unit, Deffile);
Scn.Scanner.Initialize_Scanner (Deffile);
Prep.Parse_Def_File;
-- Reset the behaviour of the scanner to the default
......
gcc/ada/prj-part.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2001-2005, Free Software Foundation, Inc. --
-- Copyright (C) 2001-2006, 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- --
......@@ -1040,7 +1040,7 @@ package body Prj.Part is
return;
end if;
Prj.Err.Scanner.Initialize_Scanner (Types.No_Unit, Source_Index);
Prj.Err.Scanner.Initialize_Scanner (Source_Index);
Tree.Reset_State;
Scan (In_Tree);
......
gcc/ada/scans.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
-- Copyright (C) 1992-2006, 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- --
......@@ -31,13 +31,122 @@
-- --
------------------------------------------------------------------------------
with Namet; use Namet;
with Snames; use Snames;
package body Scans is
-----------------------------
-- Initialize_Ada_Keywords --
-----------------------------
procedure Initialize_Ada_Keywords is
procedure Set_Reserved (N : Name_Id; T : Token_Type);
pragma Inline (Set_Reserved);
-- Set given name as a reserved word (T is the corresponding token)
------------------
-- Set_Reserved --
------------------
procedure Set_Reserved (N : Name_Id; T : Token_Type) is
begin
-- Set up Token_Type values in Names table entries for reserved
-- words. We use the Pos value of the Token_Type value. Note that
-- Is_Keyword_Name relies on the fact that Token_Type'Val (0) is not
-- a reserved word!
Set_Name_Table_Byte (N, Token_Type'Pos (T));
end Set_Reserved;
-- Start of processing for Initialize_Ada_Keywords
begin
-- Establish reserved words
Set_Reserved (Name_Abort, Tok_Abort);
Set_Reserved (Name_Abs, Tok_Abs);
Set_Reserved (Name_Abstract, Tok_Abstract);
Set_Reserved (Name_Accept, Tok_Accept);
Set_Reserved (Name_Access, Tok_Access);
Set_Reserved (Name_And, Tok_And);
Set_Reserved (Name_Aliased, Tok_Aliased);
Set_Reserved (Name_All, Tok_All);
Set_Reserved (Name_Array, Tok_Array);
Set_Reserved (Name_At, Tok_At);
Set_Reserved (Name_Begin, Tok_Begin);
Set_Reserved (Name_Body, Tok_Body);
Set_Reserved (Name_Case, Tok_Case);
Set_Reserved (Name_Constant, Tok_Constant);
Set_Reserved (Name_Declare, Tok_Declare);
Set_Reserved (Name_Delay, Tok_Delay);
Set_Reserved (Name_Delta, Tok_Delta);
Set_Reserved (Name_Digits, Tok_Digits);
Set_Reserved (Name_Do, Tok_Do);
Set_Reserved (Name_Else, Tok_Else);
Set_Reserved (Name_Elsif, Tok_Elsif);
Set_Reserved (Name_End, Tok_End);
Set_Reserved (Name_Entry, Tok_Entry);
Set_Reserved (Name_Exception, Tok_Exception);
Set_Reserved (Name_Exit, Tok_Exit);
Set_Reserved (Name_For, Tok_For);
Set_Reserved (Name_Function, Tok_Function);
Set_Reserved (Name_Generic, Tok_Generic);
Set_Reserved (Name_Goto, Tok_Goto);
Set_Reserved (Name_If, Tok_If);
Set_Reserved (Name_In, Tok_In);
Set_Reserved (Name_Is, Tok_Is);
Set_Reserved (Name_Limited, Tok_Limited);
Set_Reserved (Name_Loop, Tok_Loop);
Set_Reserved (Name_Mod, Tok_Mod);
Set_Reserved (Name_New, Tok_New);
Set_Reserved (Name_Not, Tok_Not);
Set_Reserved (Name_Null, Tok_Null);
Set_Reserved (Name_Of, Tok_Of);
Set_Reserved (Name_Or, Tok_Or);
Set_Reserved (Name_Others, Tok_Others);
Set_Reserved (Name_Out, Tok_Out);
Set_Reserved (Name_Package, Tok_Package);
Set_Reserved (Name_Pragma, Tok_Pragma);
Set_Reserved (Name_Private, Tok_Private);
Set_Reserved (Name_Procedure, Tok_Procedure);
Set_Reserved (Name_Protected, Tok_Protected);
Set_Reserved (Name_Raise, Tok_Raise);
Set_Reserved (Name_Range, Tok_Range);
Set_Reserved (Name_Record, Tok_Record);
Set_Reserved (Name_Rem, Tok_Rem);
Set_Reserved (Name_Renames, Tok_Renames);
Set_Reserved (Name_Requeue, Tok_Requeue);
Set_Reserved (Name_Return, Tok_Return);
Set_Reserved (Name_Reverse, Tok_Reverse);
Set_Reserved (Name_Select, Tok_Select);
Set_Reserved (Name_Separate, Tok_Separate);
Set_Reserved (Name_Subtype, Tok_Subtype);
Set_Reserved (Name_Tagged, Tok_Tagged);
Set_Reserved (Name_Task, Tok_Task);
Set_Reserved (Name_Terminate, Tok_Terminate);
Set_Reserved (Name_Then, Tok_Then);
Set_Reserved (Name_Type, Tok_Type);
Set_Reserved (Name_Until, Tok_Until);
Set_Reserved (Name_Use, Tok_Use);
Set_Reserved (Name_When, Tok_When);
Set_Reserved (Name_While, Tok_While);
Set_Reserved (Name_With, Tok_With);
Set_Reserved (Name_Xor, Tok_Xor);
-- Ada 2005 reserved words
Set_Reserved (Name_Interface, Tok_Interface);
Set_Reserved (Name_Overriding, Tok_Overriding);
Set_Reserved (Name_Synchronized, Tok_Synchronized);
end Initialize_Ada_Keywords;
------------------------
-- Restore_Scan_State --
------------------------
procedure Restore_Scan_State (Saved_State : in Saved_Scan_State) is
procedure Restore_Scan_State (Saved_State : Saved_Scan_State) is
begin
Scan_Ptr := Saved_State.Save_Scan_Ptr;
Token := Saved_State.Save_Token;
......
gcc/ada/scn.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2005 Free Software Foundation, Inc. --
-- Copyright (C) 1992-2006, 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- --
......@@ -281,7 +281,13 @@ package body Scn is
GNAT_Hedr : constant Text_Buffer (1 .. 78) := (others => '-');
begin
Scanner.Initialize_Scanner (Unit, Index);
Scanner.Initialize_Scanner (Index);
if Index /= Internal_Source_File then
Set_Unit (Index, Unit);
end if;
Current_Source_Unit := Unit;
-- Set default for Comes_From_Source (except if we are going to process
-- an artificial string internally created within the compiler and
......
gcc/ada/scng.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2005 Free Software Foundation, Inc. --
-- Copyright (C) 1992-2006, 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- --
......@@ -141,113 +141,16 @@ package body Scng is
-- Initialize_Scanner --
------------------------
procedure Initialize_Scanner
(Unit : Unit_Number_Type;
Index : Source_File_Index)
is
procedure Set_Reserved (N : Name_Id; T : Token_Type);
pragma Inline (Set_Reserved);
-- Set given name as a reserved keyword (T is the corresponding token)
-------------
-- Set_NTB --
-------------
procedure Set_Reserved (N : Name_Id; T : Token_Type) is
begin
-- Set up Token_Type values in Names Table entries for reserved
-- keywords We use the Pos value of the Token_Type value. Note we
-- rely on the fact that Token_Type'Val (0) is not a reserved word!
Set_Name_Table_Byte (N, Token_Type'Pos (T));
end Set_Reserved;
-- Start of processing for Initialize_Scanner
procedure Initialize_Scanner (Index : Source_File_Index) is
begin
-- Establish reserved words
Set_Reserved (Name_Abort, Tok_Abort);
Set_Reserved (Name_Abs, Tok_Abs);
Set_Reserved (Name_Abstract, Tok_Abstract);
Set_Reserved (Name_Accept, Tok_Accept);
Set_Reserved (Name_Access, Tok_Access);
Set_Reserved (Name_And, Tok_And);
Set_Reserved (Name_Aliased, Tok_Aliased);
Set_Reserved (Name_All, Tok_All);
Set_Reserved (Name_Array, Tok_Array);
Set_Reserved (Name_At, Tok_At);
Set_Reserved (Name_Begin, Tok_Begin);
Set_Reserved (Name_Body, Tok_Body);
Set_Reserved (Name_Case, Tok_Case);
Set_Reserved (Name_Constant, Tok_Constant);
Set_Reserved (Name_Declare, Tok_Declare);
Set_Reserved (Name_Delay, Tok_Delay);
Set_Reserved (Name_Delta, Tok_Delta);
Set_Reserved (Name_Digits, Tok_Digits);
Set_Reserved (Name_Do, Tok_Do);
Set_Reserved (Name_Else, Tok_Else);
Set_Reserved (Name_Elsif, Tok_Elsif);
Set_Reserved (Name_End, Tok_End);
Set_Reserved (Name_Entry, Tok_Entry);
Set_Reserved (Name_Exception, Tok_Exception);
Set_Reserved (Name_Exit, Tok_Exit);
Set_Reserved (Name_For, Tok_For);
Set_Reserved (Name_Function, Tok_Function);
Set_Reserved (Name_Generic, Tok_Generic);
Set_Reserved (Name_Goto, Tok_Goto);
Set_Reserved (Name_If, Tok_If);
Set_Reserved (Name_In, Tok_In);
Set_Reserved (Name_Is, Tok_Is);
Set_Reserved (Name_Limited, Tok_Limited);
Set_Reserved (Name_Loop, Tok_Loop);
Set_Reserved (Name_Mod, Tok_Mod);
Set_Reserved (Name_New, Tok_New);
Set_Reserved (Name_Not, Tok_Not);
Set_Reserved (Name_Null, Tok_Null);
Set_Reserved (Name_Of, Tok_Of);
Set_Reserved (Name_Or, Tok_Or);
Set_Reserved (Name_Others, Tok_Others);
Set_Reserved (Name_Out, Tok_Out);
Set_Reserved (Name_Package, Tok_Package);
Set_Reserved (Name_Pragma, Tok_Pragma);
Set_Reserved (Name_Private, Tok_Private);
Set_Reserved (Name_Procedure, Tok_Procedure);
Set_Reserved (Name_Protected, Tok_Protected);
Set_Reserved (Name_Raise, Tok_Raise);
Set_Reserved (Name_Range, Tok_Range);
Set_Reserved (Name_Record, Tok_Record);
Set_Reserved (Name_Rem, Tok_Rem);
Set_Reserved (Name_Renames, Tok_Renames);
Set_Reserved (Name_Requeue, Tok_Requeue);
Set_Reserved (Name_Return, Tok_Return);
Set_Reserved (Name_Reverse, Tok_Reverse);
Set_Reserved (Name_Select, Tok_Select);
Set_Reserved (Name_Separate, Tok_Separate);
Set_Reserved (Name_Subtype, Tok_Subtype);
Set_Reserved (Name_Tagged, Tok_Tagged);
Set_Reserved (Name_Task, Tok_Task);
Set_Reserved (Name_Terminate, Tok_Terminate);
Set_Reserved (Name_Then, Tok_Then);
Set_Reserved (Name_Type, Tok_Type);
Set_Reserved (Name_Until, Tok_Until);
Set_Reserved (Name_Use, Tok_Use);
Set_Reserved (Name_When, Tok_When);
Set_Reserved (Name_While, Tok_While);
Set_Reserved (Name_With, Tok_With);
Set_Reserved (Name_Xor, Tok_Xor);
-- Ada 2005 reserved words
Set_Reserved (Name_Interface, Tok_Interface);
Set_Reserved (Name_Overriding, Tok_Overriding);
Set_Reserved (Name_Synchronized, Tok_Synchronized);
Scans.Initialize_Ada_Keywords;
-- Initialize scan control variables
Current_Source_File := Index;
Source := Source_Text (Current_Source_File);
Current_Source_Unit := Unit;
Scan_Ptr := Source_First (Current_Source_File);
Token := No_Token;
Token_Ptr := Scan_Ptr;
......@@ -2330,12 +2233,7 @@ package body Scng is
-- Here is where we check if it was a keyword
if Get_Name_Table_Byte (Token_Name) /= 0
and then (Ada_Version >= Ada_95
or else Token_Name not in Ada_95_Reserved_Words)
and then (Ada_Version >= Ada_05
or else Token_Name not in Ada_2005_Reserved_Words)
then
if Is_Keyword_Name (Token_Name) then
Token := Token_Type'Val (Get_Name_Table_Byte (Token_Name));
-- Deal with possible style check for non-lower case keyword, but
......
gcc/ada/scng.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2004 Free Software Foundation, Inc. --
-- Copyright (C) 1992-2006, 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- --
......@@ -60,14 +60,8 @@ generic
package Scng is
procedure Initialize_Scanner
(Unit : Unit_Number_Type;
Index : Source_File_Index);
-- Initialize lexical scanner for scanning a new file. The caller has
-- completed the construction of the Units.Table entry for the specified
-- Unit and Index references the corresponding source file. A special
-- case is when Unit = No_Unit_Number, and Index corresponds to the
-- source index for reading the configuration pragma file.
procedure Initialize_Scanner (Index : Source_File_Index);
-- Initialize lexical scanner for scanning a new file referenced by Index.
-- Initialize_Scanner does not call Scan.
procedure Scan;
......
gcc/ada/sinfo-cn.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
-- Copyright (C) 1992-2006, 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- --
......@@ -26,7 +26,7 @@
-- This child package of Sinfo contains some routines that permit in place
-- alteration of existing tree nodes by changing the value in the Nkind
-- field. Since Nkind functions logically in a manner similart to a variant
-- field. Since Nkind functions logically in a manner similar to a variant
-- record discriminant part, such alterations cannot be permitted in a
-- general manner, but in some specific cases, the fields of related nodes
-- have been deliberately layed out in a manner that permits such alteration.
......
gcc/ada/sinput-c.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2004 Free Software Foundation, Inc. --
-- Copyright (C) 1992-2006, 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- --
......@@ -193,6 +193,7 @@ package body Sinput.C is
Source_Last => Hi,
Source_Text => Src,
Template => No_Source_File,
Unit => No_Unit,
Time_Stamp => Empty_Time_Stamp);
Alloc_Line_Tables (S, Opt.Table_Factor * Alloc.Lines_Initial);
......
gcc/ada/sinput-l.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2004 Free Software Foundation, Inc. --
-- Copyright (C) 1992-2006, 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- --
......@@ -441,6 +441,7 @@ package body Sinput.L is
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);
......@@ -497,7 +498,7 @@ package body Sinput.L is
-- Initialize the scanner and set its behavior for
-- preprocessing, then preprocess.
Scn.Scanner.Initialize_Scanner (No_Unit, X);
Scn.Scanner.Initialize_Scanner (X);
Scn.Scanner.Set_Special_Character ('#');
Scn.Scanner.Set_Special_Character ('$');
......
gcc/ada/sinput-p.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2003 Free Software Foundation, Inc. --
-- Copyright (C) 1992-2006, 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- --
......@@ -57,7 +57,7 @@ package body Sinput.P is
--------------------------------
procedure Restore_Project_Scan_State
(Saved_State : in Saved_Project_Scan_State)
(Saved_State : Saved_Project_Scan_State)
is
begin
Restore_Scan_State (Saved_State.Scan_State);
......@@ -84,7 +84,7 @@ package body Sinput.P is
function Source_File_Is_Subunit (X : Source_File_Index) return Boolean is
begin
Prj.Err.Scanner.Initialize_Scanner (No_Unit, X);
Prj.Err.Scanner.Initialize_Scanner (X);
-- We scan past junk to the first interesting compilation unit
-- token, to see if it is SEPARATE. We ignore WITH keywords during
......
gcc/ada/sinput.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2006, 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- --
......@@ -1155,6 +1155,11 @@ package body Sinput is
return Source_File.Table (S).Time_Stamp;
end Time_Stamp;
function Unit (S : SFI) return Unit_Number_Type is
begin
return Source_File.Table (S).Unit;
end Unit;
------------------------------------------
-- Set Procedures for Source File Table --
------------------------------------------
......@@ -1174,6 +1179,11 @@ package body Sinput is
Source_File.Table (S).License := L;
end Set_License;
procedure Set_Unit (S : SFI; U : Unit_Number_Type) is
begin
Source_File.Table (S).Unit := U;
end Set_Unit;
----------------------
-- Trim_Lines_Table --
----------------------
......
gcc/ada/sinput.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2006, 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- --
......@@ -268,6 +268,10 @@ package Sinput is
-- is a generic instantiation. Set to No_Source_File for the normal case
-- of a non-instantiation entry. See Sinput-L for details.
-- Unit : Unit_Number_Type;
-- Identifies the unit contained in this source file. Set by
-- Initialize_Scanner, must not be subsequently altered.
-- The source file table is accessed by clients using the following
-- subprogram interface:
......@@ -299,11 +303,13 @@ package Sinput is
function Source_Last (S : SFI) return Source_Ptr;
function Source_Text (S : SFI) return Source_Buffer_Ptr;
function Template (S : SFI) return Source_File_Index;
function Unit (S : SFI) return Unit_Number_Type;
function Time_Stamp (S : SFI) return Time_Stamp_Type;
procedure Set_Keyword_Casing (S : SFI; C : Casing_Type);
procedure Set_Identifier_Casing (S : SFI; C : Casing_Type);
procedure Set_License (S : SFI; L : License_Type);
procedure Set_Unit (S : SFI; U : Unit_Number_Type);
function Last_Source_File return Source_File_Index;
-- Index of last source file table entry
......@@ -686,6 +692,7 @@ private
Identifier_Casing : Casing_Type;
Instantiation : Source_Ptr;
Template : Source_File_Index;
Unit : Unit_Number_Type;
-- The following fields are for internal use only (i.e. only in the
-- body of Sinput or its children, with no direct access by clients).
......
gcc/ada/snames.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2006, 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- --
......@@ -32,6 +32,7 @@
------------------------------------------------------------------------------
with Namet; use Namet;
with Opt; use Opt;
with Table;
package body Snames is
......@@ -174,6 +175,7 @@ package body Snames is
"ada_83#" &
"ada_95#" &
"ada_05#" &
"ada_2005#" &
"assertion_policy#" &
"c_pass_by_copy#" &
"compile_time_warning#" &
......@@ -992,6 +994,19 @@ package body Snames is
Last_Renamable_Function_Attribute;
end Is_Function_Attribute_Name;
---------------------
-- Is_Keyword_Name --
---------------------
function Is_Keyword_Name (N : Name_Id) return Boolean is
begin
return Get_Name_Table_Byte (N) /= 0
and then (Ada_Version >= Ada_95
or else N not in Ada_95_Reserved_Words)
and then (Ada_Version >= Ada_05
or else N not in Ada_2005_Reserved_Words);
end Is_Keyword_Name;
----------------------------
-- Is_Locking_Policy_Name --
----------------------------
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment