+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.
-- 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
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);
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 --
-------------------------
Name_Len => Short (Name_Len),
Byte_Info => 0,
Int_Info => 0,
+ Boolean_Info => False,
Name_Has_No_Encodings => False,
Hash_Link => No_Name));
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
Name_Len => 1,
Byte_Info => 0,
Int_Info => 0,
+ Boolean_Info => False,
Name_Has_No_Encodings => True,
Hash_Link => No_Name));
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 --
-------------------------
-- 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
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).
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
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
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
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;
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);
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
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);
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.
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
-- 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;
projects / gcc.git / commitdiff