OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes]

Browse Source 
2014-11-20  Thomas Quinot  <quinot@adacore.com>

	* freeze.adb (Freeze_Entity): Do not reset Is_True_Constant
	for aliased constant objects.

2014-11-20  Robert Dewar  <dewar@adacore.com>

	* exp_util.adb (Following_Address_Clause): Use new Name_Table
	boolean flag set by parser to avoid the search if there is no
	address clause anywhere for the name.
	* namet.adb (Name_Enter): Initialize Boolean_Info flag
	(Name_Find): ditto (Reinitialize): ditto (Get_Name_Table_Boolean):
	New function (Set_Name_Table_Boolean): New procedure
	* namet.ads: Add and document new Boolean field in name table
	(Get_Name_Table_Boolean): New function.
	(Set_Name_Table_Boolean): New procedure.
	* par-ch13.adb (P_Representation_Clause): Set Name_Table boolean
	flag for an identifier name if we detect an address clause or
	use-at clause for the identifier.
	* sem_ch3.adb (Analyze_Object_Declaration): Remove comment about
	Following_Address_Clause since this function is now optimized
	and is not a performance concern.
	* sem_prag.adb (Analyze_Pragma, case Elaborate): In SPARK
	mode, pragma Elaborate is now allowed, but does not suppress
	elaboration checking.

From-SVN: r217882
This commit is contained in:
Arnaud Charlet 2014-11-20 16:59:01 +01:00
parent 28eccd34fa
commit 572f38e4b2
9 changed files with 145 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
gcc/ada/ChangeLog
View File

@ -1,3 +1,29 @@
2014-11-20 Thomas Quinot <quinot@adacore.com>
* freeze.adb (Freeze_Entity): Do not reset Is_True_Constant
for aliased constant objects.
2014-11-20 Robert Dewar <dewar@adacore.com>
* exp_util.adb (Following_Address_Clause): Use new Name_Table
boolean flag set by parser to avoid the search if there is no
address clause anywhere for the name.
* namet.adb (Name_Enter): Initialize Boolean_Info flag
(Name_Find): ditto (Reinitialize): ditto (Get_Name_Table_Boolean):
New function (Set_Name_Table_Boolean): New procedure
* namet.ads: Add and document new Boolean field in name table
(Get_Name_Table_Boolean): New function.
(Set_Name_Table_Boolean): New procedure.
* par-ch13.adb (P_Representation_Clause): Set Name_Table boolean
flag for an identifier name if we detect an address clause or
use-at clause for the identifier.
* sem_ch3.adb (Analyze_Object_Declaration): Remove comment about
Following_Address_Clause since this function is now optimized
and is not a performance concern.
* sem_prag.adb (Analyze_Pragma, case Elaborate): In SPARK
mode, pragma Elaborate is now allowed, but does not suppress
elaboration checking.
2014-11-20 Jerome Lambourg <lambourg@adacore.com>
* gcc-interface/Makefile.in: Add some support for VxWorks7.

9
gcc/ada/exp_util.adb
View File

@ -2960,6 +2960,15 @@ package body Exp_Util is
-- Start of processing for Following_Address_Clause
begin
-- If parser detected no address clause for the identifier in question,
-- then then answer is a quick NO, without the need for a search.
if not Get_Name_Table_Boolean (Chars (Id)) then
return Empty;
end if;
-- Otherwise search current declarative unit
Result := Check_Decls (Next (D));
if Present (Result) then

24
gcc/ada/freeze.adb
View File

@ -4596,19 +4596,27 @@ package body Freeze is
Check_Address_Clause (E);
-- Reset Is_True_Constant for aliased object. We consider that
-- the fact that something is aliased may indicate that some
-- funny business is going on, e.g. an aliased object is passed
-- by reference to a procedure which captures the address of
-- the object, which is later used to assign a new value. Such
-- code is highly dubious, but we choose to make it "work" for
-- aliased objects.
-- Reset Is_True_Constant for non-constant aliased object. We
-- consider that the fact that a non-constant object is aliased
-- may indicate that some funny business is going on, e.g. an
-- aliased object is passed by reference to a procedure which
-- captures the address of the object, which is later used to
-- assign a new value, even though the compiler thinks that
-- it is not modified. Such code is highly dubious, but we
-- choose to make it "work" for non-constant aliased objects.
-- Note that we used to do this for all aliased objects,
-- whether or not constant, but this caused anomalies down
-- the line because we ended up with static objects that
-- were not Is_True_Constant. Not resetting Is_True_Constant
-- for (aliased) constant objects ensures that this anomaly
-- never occurs.
-- However, we don't do that for internal entities. We figure
-- that if we deliberately set Is_True_Constant for an internal
-- entity, e.g. a dispatch table entry, then we mean it.
if (Is_Aliased (E) or else Is_Aliased (Etype (E)))
if Ekind (E) /= E_Constant
and then (Is_Aliased (E) or else Is_Aliased (Etype (E)))
and then not Is_Internal_Name (Chars (E))
then
Set_Is_True_Constant (E, False);

25
gcc/ada/namet.adb
View File

@ -705,6 +705,16 @@ package body Namet is
end loop;
end Get_Name_String_And_Append;
----------------------------
-- Get_Name_Table_Boolean --
----------------------------
function Get_Name_Table_Boolean (Id : Name_Id) return Boolean is
begin
pragma Assert (Id in Name_Entries.First .. Name_Entries.Last);
return Name_Entries.Table (Id).Boolean_Info;
end Get_Name_Table_Boolean;
-------------------------
-- Get_Name_Table_Byte --
-------------------------
@ -923,6 +933,7 @@ package body Namet is
Name_Len => Short (Name_Len),
Byte_Info => 0,
Int_Info => 0,
Boolean_Info => False,
Name_Has_No_Encodings => False,
Hash_Link => No_Name));
@ -1025,7 +1036,8 @@ package body Namet is
Hash_Link => No_Name,
Name_Has_No_Encodings => False,
Int_Info => 0,
Byte_Info => 0));
Byte_Info => 0,
Boolean_Info => False));
-- Set corresponding string entry in the Name_Chars table
@ -1250,6 +1262,7 @@ package body Namet is
Name_Len => 1,
Byte_Info => 0,
Int_Info => 0,
Boolean_Info => False,
Name_Has_No_Encodings => True,
Hash_Link => No_Name));
@ -1287,6 +1300,16 @@ package body Namet is
Store_Encoded_Character (C);
end Set_Character_Literal_Name;
----------------------------
-- Set_Name_Table_Boolean --
----------------------------
procedure Set_Name_Table_Boolean (Id : Name_Id; Val : Boolean) is
begin
pragma Assert (Id in Name_Entries.First .. Name_Entries.Last);
Name_Entries.Table (Id).Boolean_Info := Val;
end Set_Name_Table_Boolean;
-------------------------
-- Set_Name_Table_Byte --
-------------------------

59
gcc/ada/namet.ads
View File

@ -115,14 +115,32 @@ package Namet is
-- character lower case letters in the range a-z, and these names are created
-- and initialized by the Initialize procedure.
-- Two values, one of type Int and one of type Byte, are stored with each
-- names table entry and subprograms are provided for setting and retrieving
-- these associated values. The usage of these values is up to the client. In
-- the compiler, the Int field is used to point to a chain of potentially
-- visible entities (see Sem.Ch8 for details), and the Byte field is used to
-- hold the Token_Type value for reserved words (see Sem for details). In the
-- binder, the Byte field is unused, and the Int field is used in various
-- ways depending on the name involved (see binder documentation).
-- Three values, one of type Int, one of type Byte, and one of type Boolean,
-- are stored with each names table entry and subprograms are provided for
-- setting and retrieving these associated values. The usage of these values
-- is up to the client:
-- In the compiler we have the following uses:
-- The Int field is used to point to a chain of potentially visible
-- entities (see Sem.Ch8 for details).
-- The Byte field is used to hold the Token_Type value for reserved words
-- (see Sem for details).
-- The Boolean field is used to mark address clauses to optimize the
-- performance of the Exp_Util.Following_Address_Clause function.
-- In the binder, we have the following uses:
-- The Int field is used in various ways depending on the name involved,
-- see binder documentation for details.
-- The Byte and Boolean fields are unused.
-- Note that the value of the Int and Byte fields are initialized to zero,
-- and the Boolean field is initialized to False, when a new Name table entry
-- is created.
Name_Buffer : String (1 .. 4 * Max_Line_Length);
-- This buffer is used to set the name to be stored in the table for the
@ -349,6 +367,9 @@ package Namet is
pragma Inline (Get_Name_Table_Info);
-- Fetches the Int value associated with the given name
function Get_Name_Table_Boolean (Id : Name_Id) return Boolean;
-- Fetches the Boolean value associated with the given name
function Is_Operator_Name (Id : Name_Id) return Boolean;
-- Returns True if name given is of the form of an operator (that
-- is, it starts with an upper case O).
@ -386,12 +407,12 @@ package Namet is
function Name_Find return Name_Id;
-- Name_Find is called with a string stored in Name_Buffer whose length is
-- in Name_Len (i.e. the characters of the name are in subscript positions
-- 1 to Name_Len in Name_Buffer). It searches the names table to see if
-- the string has already been stored. If so the Id of the existing entry
-- is returned. Otherwise a new entry is created with its Name_Table_Info
-- field set to zero. The contents of Name_Buffer and Name_Len are not
-- modified by this call. Note that it is permissible for Name_Len to be
-- set to zero to lookup the null name string.
-- 1 to Name_Len in Name_Buffer). It searches the names table to see if the
-- string has already been stored. If so the Id of the existing entry is
-- returned. Otherwise a new entry is created with its Name_Table_Info
-- fields set to zero/false. The contents of Name_Buffer and Name_Len are
-- not modified by this call. Note that it is permissible for Name_Len to
-- be set to zero to lookup the null name string.
function Name_Enter return Name_Id;
-- Name_Enter has the same calling interface as Name_Find. The difference
@ -483,6 +504,9 @@ package Namet is
pragma Inline (Set_Name_Table_Byte);
-- Sets the Byte value associated with the given name
procedure Set_Name_Table_Boolean (Id : Name_Id; Val : Boolean);
-- Sets the Boolean value associated with the given name
procedure Store_Encoded_Character (C : Char_Code);
-- Stores given character code at the end of Name_Buffer, updating the
-- value in Name_Len appropriately. Lower case letters and digits are
@ -620,6 +644,9 @@ private
Byte_Info : Byte;
-- Byte value associated with this name
Boolean_Info : Boolean;
-- Boolean value associated with the name
Name_Has_No_Encodings : Boolean;
-- This flag is set True if the name entry is known not to contain any
-- special character encodings. This is used to speed up repeated calls
@ -631,13 +658,15 @@ private
Int_Info : Int;
-- Int Value associated with this name
end record;
for Name_Entry use record
Name_Chars_Index at 0 range 0 .. 31;
Name_Len at 4 range 0 .. 15;
Byte_Info at 6 range 0 .. 7;
Name_Has_No_Encodings at 7 range 0 .. 7;
Boolean_Info at 7 range 0 .. 0;
Name_Has_No_Encodings at 7 range 1 .. 7;
Hash_Link at 8 range 0 .. 31;
Int_Info at 12 range 0 .. 31;
end record;

18
gcc/ada/par-ch13.adb
View File

@ -726,14 +726,23 @@ package body Ch13 is
end if;
end if;
-- We come here with an OK attribute scanned, and the
-- corresponding Attribute identifier node stored in Ident_Node.
-- Here we have an OK attribute scanned, and the corresponding
-- Attribute identifier node is stored in Ident_Node.
Prefix_Node := Name_Node;
Name_Node := New_Node (N_Attribute_Reference, Prev_Token_Ptr);
Set_Prefix (Name_Node, Prefix_Node);
Set_Attribute_Name (Name_Node, Attr_Name);
Scan;
-- Check for Address clause which needs to be marked for use in
-- optimizing performance of Exp_Util.Following_Address_Clause.
if Attr_Name = Name_Address
and then Nkind (Prefix_Node) = N_Identifier
then
Set_Name_Table_Boolean (Chars (Prefix_Node), True);
end if;
end loop;
Rep_Clause_Node := New_Node (N_Attribute_Definition_Clause, For_Loc);
@ -759,6 +768,11 @@ package body Ch13 is
Check_Simple_Expression_In_Ada_83 (Expr_Node);
Set_Expression (Rep_Clause_Node, Expr_Node);
-- Mark occurrence of address clause (used to optimize performance
-- of Exp_Util.Following_Address_Clause).
Set_Name_Table_Boolean (Chars (Identifier_Node), True);
-- RECORD follows USE (Record Representation Clause)
elsif Token = Tok_Record then

5
gcc/ada/sem_ch3.adb
View File

@ -3649,11 +3649,6 @@ package body Sem_Ch3 is
if Comes_From_Source (N)
and then Expander_Active
and then Nkind (E) = N_Aggregate
-- Note the importance of doing this the following test after the
-- N_Aggregate test to avoid inefficiencies from too many calls to
-- the function Following_Address_Clause which can be expensive.
and then Present (Following_Address_Clause (N))
then
Set_Etype (E, T);

2
gcc/ada/sem_elab.adb
View File

@ -601,7 +601,7 @@ package body Sem_Elab is
Cunit_SC : Boolean := False;
-- Set to suppress dynamic elaboration checks where one of the
-- enclosing scopes has Elaboration_Checks_Suppressed set, or else
-- if a pragma Elaborate (_All) applies to that scope, in which case
-- if a pragma Elaborate[_All] applies to that scope, in which case
-- warnings on the scope are also suppressed. For the internal case,
-- we ignore this flag.

15
gcc/ada/sem_prag.adb
View File

@ -13134,10 +13134,6 @@ package body Sem_Prag is
Citem : Node_Id;
begin
if SPARK_Mode = On then
Error_Msg_N ("pragma Elaborate not allowed in SPARK", N);
end if;
-- Pragma must be in context items list of a compilation unit
if not Is_In_Context_Clause then
@ -13197,8 +13193,15 @@ package body Sem_Prag is
-- to the named unit, so we keep the check enabled.
if In_Extended_Main_Source_Unit (N) then
Set_Suppress_Elaboration_Warnings
(Entity (Name (Citem)));
-- This does not apply in SPARK mode, where we allow
-- pragma Elaborate, but we don't trust it to be right
-- so we will still insist on the Elaborate_All.
if SPARK_Mode /= On then
Set_Suppress_Elaboration_Warnings
(Entity (Name (Citem)));
end if;
end if;
exit Inner;