From e2534738ee23d66ecbbbc9bacce6bc19395045c5 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Thu, 5 Aug 2010 11:26:47 +0200 Subject: [PATCH] [multiple changes] 2010-08-05 Robert Dewar * gnat1drv.adb: Minor reformatting. 2010-08-05 Ed Schonberg * sem.adb (Do_Unit_And_Dependents): If some parent unit is an instantiation, process its body before the spec of the main unit, because it may contain subprograms invoked in the spec of main. * einfo.ads: Add documention of delayed freeze. 2010-08-05 Vincent Celier * prj-nmsc.adb (Process_Linker): Take into account new values for attribute Response_File_Format. * prj.ads (Response_File_Format): New enumeration values GCC_GNU, GCC_Object_List and GCC_Option_List. 2010-08-05 Ed Schonberg * exp_ch4.adb (Expand_N_Selected_Component): Do not constant-fold a selected component that denotes a discriminant if it is the discriminant of a component of an unconstrained record type. From-SVN: r162908 --- gcc/ada/ChangeLog | 24 +++++++++++++++++ gcc/ada/einfo.ads | 64 +++++++++++++++++++++++++++++++++----------- gcc/ada/exp_ch4.adb | 14 +++++++++- gcc/ada/gnat1drv.adb | 10 +++---- gcc/ada/prj-nmsc.adb | 24 +++++++++++++---- gcc/ada/prj.ads | 12 ++++++--- gcc/ada/sem.adb | 28 ++++++++++++++++--- 7 files changed, 142 insertions(+), 34 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index dfe74317bf8..224099ba77e 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,27 @@ +2010-08-05 Robert Dewar + + * gnat1drv.adb: Minor reformatting. + +2010-08-05 Ed Schonberg + + * sem.adb (Do_Unit_And_Dependents): If some parent unit is an + instantiation, process its body before the spec of the main unit, + because it may contain subprograms invoked in the spec of main. + * einfo.ads: Add documention of delayed freeze. + +2010-08-05 Vincent Celier + + * prj-nmsc.adb (Process_Linker): Take into account new values for + attribute Response_File_Format. + * prj.ads (Response_File_Format): New enumeration values GCC_GNU, + GCC_Object_List and GCC_Option_List. + +2010-08-05 Ed Schonberg + + * exp_ch4.adb (Expand_N_Selected_Component): Do not constant-fold a + selected component that denotes a discriminant if it is the + discriminant of a component of an unconstrained record type. + 2010-08-05 Ed Schonberg * exp_util.adb (Insert_Actions): If the action appears within a diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index a3bff056113..b6c87371fb6 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -250,6 +250,40 @@ package Einfo is -- reference GCC expressions for the case of non-static sizes, as explained -- in Repinfo. +-------------------------------------- +-- Delayed Freezing and Elaboration -- +-------------------------------------- + +-- The flag Has_Delayed_Freeze indicates that an entity carries an explicit +-- freeze node, which appears later in the expanded tree. + +-- a) The flag is used by the front-end to trigger expansion actions which +-- include the generation of that freeze node. Typically this happens at the +-- end of the current compilation unit, or before the first subprogram body is +-- encountered in the current unit. See files freeze and exp_ch13 for details +-- on the actions triggered by a freeze node, which include the construction +-- of initialization procedures and dispatch tables. + +-- b) The presence of a freeze node on an entity is used by the backend to +-- defer elaboration of the entity until its freeze node is seen. In the +-- absence of an explicit freeze node, an entity is frozen (and elaborated) +-- at the point of declaration. + +-- For object declarations, the flag is set when an address clause for the +-- object is encountered. Legality checks on the address expression only take +-- place at the freeze point of the object. + +-- Most types have an explicit freeze node, because they cannot be elaborated +-- until all representation and operational items that apply to them have been +-- analyzed. Private types and incomplete types have the flag set as well, as +-- do task and protected types. + +-- Implicit base types created for type derivations, as well as classwide +-- types created for all tagged types, have the flag set. + +-- If a subprogram has an access parameter whose designated type is incomplete +-- the subprogram has the flag set. + ----------------------- -- Entity Attributes -- ----------------------- @@ -3394,29 +3428,29 @@ package Einfo is -- the Scope will be Standard. -- Scope_Depth (synthesized) --- Applies to program units, blocks, concurrent types and entries, --- and also to record types, i.e. to any entity that can appear on --- the scope stack. Yields the scope depth value, which for those --- entities other than records is simply the scope depth value, --- for record entities, it is the Scope_Depth of the record scope. +-- Applies to program units, blocks, concurrent types and entries, and +-- also to record types, i.e. to any entity that can appear on the scope +-- stack. Yields the scope depth value, which for those entities other +-- than records is simply the scope depth value, for record entities, it +-- is the Scope_Depth of the record scope. -- Scope_Depth_Value (Uint22) --- Present in program units, blocks, concurrent types and entries. --- Indicates the number of scopes that statically enclose the --- declaration of the unit or type. Library units have a depth of zero. --- Note that record types can act as scopes but do NOT have this field --- set (see Scope_Depth above) +-- Present in program units, blocks, concurrent types, and entries. +-- Indicates the number of scopes that statically enclose the declaration +-- of the unit or type. Library units have a depth of zero. Note that +-- record types can act as scopes but do NOT have this field set (see +-- Scope_Depth above) -- Scope_Depth_Set (synthesized) -- Applies to a special predicate function that returns a Boolean value --- indicating whether or not the Scope_Depth field has been set. It --- is needed, since returns an invalid value in this case! +-- indicating whether or not the Scope_Depth field has been set. It is +-- needed, since returns an invalid value in this case! -- Sec_Stack_Needed_For_Return (Flag167) -- Present in scope entities (blocks, functions, procedures, tasks, --- entries). Set to True when secondary stack is used to hold --- the returned value of a function and thus should not be --- released on scope exit. +-- entries). Set to True when secondary stack is used to hold the +-- returned value of a function and thus should not be released on +-- scope exit. -- Shadow_Entities (List14) -- Present in package and generic package entities. Points to a list diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index d60555d2b82..2b3c28b0994 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -7463,7 +7463,7 @@ package body Exp_Ch4 is null; -- Don't do this optimization for the prefix of an attribute or - -- the operand of an object renaming declaration since these are + -- the name of an object renaming declaration since these are -- contexts where we do not want the value anyway. elsif (Nkind (Par) = N_Attribute_Reference @@ -7472,6 +7472,18 @@ package body Exp_Ch4 is then null; + -- If this is a discriminant of a component of a mutable record, + -- or a renaming of such, no optimization is possible, and value + -- must be retrieved anew. Note that in the previous case we may + -- be dealing with a renaming declaration, while here we may have + -- a use of a renaming. + + elsif Nkind (P) = N_Selected_Component + and then Is_Record_Type (Etype (Prefix (P))) + and then not Is_Constrained (Etype (Prefix (P))) + then + null; + -- Don't do this optimization if we are within the code for a -- discriminant check, since the whole point of such a check may -- be to verify the condition on which the code below depends! diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb index cb14532194e..414d61446f4 100644 --- a/gcc/ada/gnat1drv.adb +++ b/gcc/ada/gnat1drv.adb @@ -801,9 +801,8 @@ begin -- We can generate code for a generic package declaration of a generic -- subprogram declaration only if does not require a body. - elsif Nkind_In (Main_Kind, - N_Generic_Package_Declaration, - N_Generic_Subprogram_Declaration) + elsif Nkind_In (Main_Kind, N_Generic_Package_Declaration, + N_Generic_Subprogram_Declaration) and then not Body_Required (Main_Unit_Node) then Back_End_Mode := Generate_Object; @@ -811,9 +810,8 @@ begin -- Compilation units that are renamings do not require bodies, so we can -- generate code for them. - elsif Nkind_In (Main_Kind, - N_Package_Renaming_Declaration, - N_Subprogram_Renaming_Declaration) + elsif Nkind_In (Main_Kind, N_Package_Renaming_Declaration, + N_Subprogram_Renaming_Declaration) then Back_End_Mode := Generate_Object; diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb index 16448928b25..456db448408 100644 --- a/gcc/ada/prj-nmsc.adb +++ b/gcc/ada/prj-nmsc.adb @@ -1841,10 +1841,11 @@ package body Prj.Nmsc is elsif Attribute.Name = Name_Required_Switches then - -- Attribute Required_Switches: the minimum + -- Attribute Required_Switches: the minimum trailing -- options to use when invoking the linker - Put (Into_List => Project.Config.Minimum_Linker_Options, + Put (Into_List => + Project.Config.Trailing_Linker_Required_Switches, From_List => Attribute.Value.Values, In_Tree => Data.Tree); @@ -1880,15 +1881,28 @@ package body Prj.Nmsc is elsif Name = Name_Gnu then Project.Config.Resp_File_Format := GNU; - elsif Name_Buffer (1 .. Name_Len) = "gcc" then - Project.Config.Resp_File_Format := GCC; - elsif Name = Name_Object_List then Project.Config.Resp_File_Format := Object_List; elsif Name = Name_Option_List then Project.Config.Resp_File_Format := Option_List; + elsif Name_Buffer (1 .. Name_Len) = "gcc" then + Project.Config.Resp_File_Format := GCC; + + elsif Name_Buffer (1 .. Name_Len) = "gcc_gnu" then + Project.Config.Resp_File_Format := GCC_GNU; + + elsif + Name_Buffer (1 .. Name_Len) = "gcc_option_list" + then + Project.Config.Resp_File_Format := GCC_Option_List; + + elsif + Name_Buffer (1 .. Name_Len) = "gcc_object_list" + then + Project.Config.Resp_File_Format := GCC_Object_List; + else Error_Msg (Data.Flags, diff --git a/gcc/ada/prj.ads b/gcc/ada/prj.ads index a6a79646a53..146d5302240 100644 --- a/gcc/ada/prj.ads +++ b/gcc/ada/prj.ads @@ -899,9 +899,12 @@ package Prj is type Response_File_Format is (None, GNU, - GCC, Object_List, - Option_List); + Option_List, + GCC, + GCC_GNU, + GCC_Object_List, + GCC_Option_List); -- The format of the different response files type Project_Configuration is record @@ -939,7 +942,7 @@ package Prj is Map_File_Option : Name_Id := No_Name; -- Option to use when invoking the linker to build a map file - Minimum_Linker_Options : Name_List_Index := No_Name_List; + Trailing_Linker_Required_Switches : Name_List_Index := No_Name_List; -- The minimum options for the linker driver. Specified in the -- configuration. @@ -1038,7 +1041,8 @@ package Prj is Executable_Suffix => No_Name, Linker => No_Path, Map_File_Option => No_Name, - Minimum_Linker_Options => No_Name_List, + Trailing_Linker_Required_Switches => + No_Name_List, Linker_Executable_Option => No_Name_List, Linker_Lib_Dir_Option => No_Name, Linker_Lib_Name_Option => No_Name, diff --git a/gcc/ada/sem.adb b/gcc/ada/sem.adb index 7f71cadcfcf..f18e5e68785 100644 --- a/gcc/ada/sem.adb +++ b/gcc/ada/sem.adb @@ -1730,6 +1730,7 @@ package body Sem is procedure Do_Unit_And_Dependents (CU : Node_Id; Item : Node_Id) is Unit_Num : constant Unit_Number_Type := Get_Cunit_Unit_Number (CU); Child : Node_Id; + Body_U : Unit_Number_Type; Parent_CU : Node_Id; procedure Do_Withed_Units is new Walk_Withs (Do_Withed_Unit); @@ -1758,8 +1759,11 @@ package body Sem is if CU = Library_Unit (Main_CU) then Process_Bodies_In_Context (CU); - -- If main is a child unit, examine context of parent - -- units to see if they include instantiated units. + -- If main is a child unit, examine parent unit contexts + -- to see if they include instantiated units. Also, if + -- the parent itself is an instance, process its body + -- because it may contain subprograms that are called + -- in the main unit. if Is_Child_Unit (Cunit_Entity (Main_Unit)) then Child := Cunit_Entity (Main_Unit); @@ -1768,6 +1772,20 @@ package body Sem is Cunit (Get_Cunit_Entity_Unit_Number (Scope (Child))); Process_Bodies_In_Context (Parent_CU); + + if Nkind (Unit (Parent_CU)) = N_Package_Body + and then + Nkind (Original_Node (Unit (Parent_CU))) + = N_Package_Instantiation + and then + not Seen (Get_Cunit_Unit_Number (Parent_CU)) + then + Body_U := Get_Cunit_Unit_Number (Parent_CU); + Seen (Body_U) := True; + Do_Action (Parent_CU, Unit (Parent_CU)); + Done (Body_U) := True; + end if; + Child := Scope (Child); end loop; end if; @@ -1842,7 +1860,8 @@ package body Sem is -- If we are processing the spec of the main unit, load bodies -- only if the with_clause indicates that it forced the loading - -- of the body for a generic instantiation. + -- of the body for a generic instantiation. Note that bodies of + -- parents that are instances have been loaded already. if Present (Body_CU) and then Body_CU /= Cunit (Main_Unit) @@ -1976,6 +1995,9 @@ package body Sem is -- If the main unit is a child unit, parent bodies may be present -- because they export instances or inlined subprograms. Check for -- presence of these, which are not present in context clauses. + -- Note that if the parents are instances, their bodies have been + -- processed before the main spec, because they may be needed + -- therein, so the following loop only affects non-instances. if Is_Child_Unit (Cunit_Entity (Main_Unit)) then Child := Cunit_Entity (Main_Unit);