From: Arnaud Charlet Date: Thu, 20 Nov 2014 15:59:01 +0000 (+0100) Subject: [multiple changes] X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=572f38e4b24c395d3841f9fb8939037885222e4e;p=gcc.git [multiple changes] 2014-11-20 Thomas Quinot * freeze.adb (Freeze_Entity): Do not reset Is_True_Constant for aliased constant objects. 2014-11-20 Robert Dewar * 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 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 8d72e443d42..7fba4d06016 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,29 @@ +2014-11-20 Thomas Quinot + + * freeze.adb (Freeze_Entity): Do not reset Is_True_Constant + for aliased constant objects. + +2014-11-20 Robert Dewar + + * 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 * gcc-interface/Makefile.in: Add some support for VxWorks7. diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index 86b46c60e72..381002255c0 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -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 diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 532bde9a146..4765d8ee693 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -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); diff --git a/gcc/ada/namet.adb b/gcc/ada/namet.adb index 1a946402845..e6df9db610d 100644 --- a/gcc/ada/namet.adb +++ b/gcc/ada/namet.adb @@ -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 -- ------------------------- diff --git a/gcc/ada/namet.ads b/gcc/ada/namet.ads index a7d7a481636..ad52122c586 100644 --- a/gcc/ada/namet.ads +++ b/gcc/ada/namet.ads @@ -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; diff --git a/gcc/ada/par-ch13.adb b/gcc/ada/par-ch13.adb index ba528faf62f..0bbca433935 100644 --- a/gcc/ada/par-ch13.adb +++ b/gcc/ada/par-ch13.adb @@ -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 diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 28b44718406..9adcb8208ac 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -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); diff --git a/gcc/ada/sem_elab.adb b/gcc/ada/sem_elab.adb index 71883350cdf..940f90f1bda 100644 --- a/gcc/ada/sem_elab.adb +++ b/gcc/ada/sem_elab.adb @@ -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. diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 7872328e063..75f430c5762 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -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;