Commit e2534738 by Arnaud Charlet

[multiple changes]

2010-08-05  Robert Dewar  <dewar@adacore.com>

	* gnat1drv.adb: Minor reformatting.

2010-08-05  Ed Schonberg  <schonberg@adacore.com>

	* 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  <celier@adacore.com>

	* 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  <schonberg@adacore.com>

	* 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
parent aa9a7dd7
2010-08-05 Robert Dewar <dewar@adacore.com>
* gnat1drv.adb: Minor reformatting.
2010-08-05 Ed Schonberg <schonberg@adacore.com>
* 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 <celier@adacore.com>
* 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 <schonberg@adacore.com>
* 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 <schonberg@adacore.com> 2010-08-05 Ed Schonberg <schonberg@adacore.com>
* exp_util.adb (Insert_Actions): If the action appears within a * exp_util.adb (Insert_Actions): If the action appears within a
......
...@@ -250,6 +250,40 @@ package Einfo is ...@@ -250,6 +250,40 @@ package Einfo is
-- reference GCC expressions for the case of non-static sizes, as explained -- reference GCC expressions for the case of non-static sizes, as explained
-- in Repinfo. -- 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 -- -- Entity Attributes --
----------------------- -----------------------
...@@ -3394,29 +3428,29 @@ package Einfo is ...@@ -3394,29 +3428,29 @@ package Einfo is
-- the Scope will be Standard. -- the Scope will be Standard.
-- Scope_Depth (synthesized) -- Scope_Depth (synthesized)
-- Applies to program units, blocks, concurrent types and entries, -- Applies to program units, blocks, concurrent types and entries, and
-- and also to record types, i.e. to any entity that can appear on -- also to record types, i.e. to any entity that can appear on the scope
-- the scope stack. Yields the scope depth value, which for those -- stack. Yields the scope depth value, which for those entities other
-- entities other than records is simply the scope depth value, -- than records is simply the scope depth value, for record entities, it
-- for record entities, it is the Scope_Depth of the record scope. -- is the Scope_Depth of the record scope.
-- Scope_Depth_Value (Uint22) -- Scope_Depth_Value (Uint22)
-- Present in program units, blocks, concurrent types and entries. -- Present in program units, blocks, concurrent types, and entries.
-- Indicates the number of scopes that statically enclose the -- Indicates the number of scopes that statically enclose the declaration
-- declaration of the unit or type. Library units have a depth of zero. -- of the unit or type. Library units have a depth of zero. Note that
-- Note that record types can act as scopes but do NOT have this field -- record types can act as scopes but do NOT have this field set (see
-- set (see Scope_Depth above) -- Scope_Depth above)
-- Scope_Depth_Set (synthesized) -- Scope_Depth_Set (synthesized)
-- Applies to a special predicate function that returns a Boolean value -- Applies to a special predicate function that returns a Boolean value
-- indicating whether or not the Scope_Depth field has been set. It -- indicating whether or not the Scope_Depth field has been set. It is
-- is needed, since returns an invalid value in this case! -- needed, since returns an invalid value in this case!
-- Sec_Stack_Needed_For_Return (Flag167) -- Sec_Stack_Needed_For_Return (Flag167)
-- Present in scope entities (blocks, functions, procedures, tasks, -- Present in scope entities (blocks, functions, procedures, tasks,
-- entries). Set to True when secondary stack is used to hold -- entries). Set to True when secondary stack is used to hold the
-- the returned value of a function and thus should not be -- returned value of a function and thus should not be released on
-- released on scope exit. -- scope exit.
-- Shadow_Entities (List14) -- Shadow_Entities (List14)
-- Present in package and generic package entities. Points to a list -- Present in package and generic package entities. Points to a list
......
...@@ -7463,7 +7463,7 @@ package body Exp_Ch4 is ...@@ -7463,7 +7463,7 @@ package body Exp_Ch4 is
null; null;
-- Don't do this optimization for the prefix of an attribute or -- 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. -- contexts where we do not want the value anyway.
elsif (Nkind (Par) = N_Attribute_Reference elsif (Nkind (Par) = N_Attribute_Reference
...@@ -7472,6 +7472,18 @@ package body Exp_Ch4 is ...@@ -7472,6 +7472,18 @@ package body Exp_Ch4 is
then then
null; 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 -- Don't do this optimization if we are within the code for a
-- discriminant check, since the whole point of such a check may -- discriminant check, since the whole point of such a check may
-- be to verify the condition on which the code below depends! -- be to verify the condition on which the code below depends!
......
...@@ -801,9 +801,8 @@ begin ...@@ -801,9 +801,8 @@ begin
-- We can generate code for a generic package declaration of a generic -- We can generate code for a generic package declaration of a generic
-- subprogram declaration only if does not require a body. -- subprogram declaration only if does not require a body.
elsif Nkind_In (Main_Kind, elsif Nkind_In (Main_Kind, N_Generic_Package_Declaration,
N_Generic_Package_Declaration, N_Generic_Subprogram_Declaration)
N_Generic_Subprogram_Declaration)
and then not Body_Required (Main_Unit_Node) and then not Body_Required (Main_Unit_Node)
then then
Back_End_Mode := Generate_Object; Back_End_Mode := Generate_Object;
...@@ -811,9 +810,8 @@ begin ...@@ -811,9 +810,8 @@ begin
-- Compilation units that are renamings do not require bodies, so we can -- Compilation units that are renamings do not require bodies, so we can
-- generate code for them. -- generate code for them.
elsif Nkind_In (Main_Kind, elsif Nkind_In (Main_Kind, N_Package_Renaming_Declaration,
N_Package_Renaming_Declaration, N_Subprogram_Renaming_Declaration)
N_Subprogram_Renaming_Declaration)
then then
Back_End_Mode := Generate_Object; Back_End_Mode := Generate_Object;
......
...@@ -1841,10 +1841,11 @@ package body Prj.Nmsc is ...@@ -1841,10 +1841,11 @@ package body Prj.Nmsc is
elsif Attribute.Name = Name_Required_Switches then 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 -- 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, From_List => Attribute.Value.Values,
In_Tree => Data.Tree); In_Tree => Data.Tree);
...@@ -1880,15 +1881,28 @@ package body Prj.Nmsc is ...@@ -1880,15 +1881,28 @@ package body Prj.Nmsc is
elsif Name = Name_Gnu then elsif Name = Name_Gnu then
Project.Config.Resp_File_Format := GNU; 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 elsif Name = Name_Object_List then
Project.Config.Resp_File_Format := Object_List; Project.Config.Resp_File_Format := Object_List;
elsif Name = Name_Option_List then elsif Name = Name_Option_List then
Project.Config.Resp_File_Format := Option_List; 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 else
Error_Msg Error_Msg
(Data.Flags, (Data.Flags,
......
...@@ -899,9 +899,12 @@ package Prj is ...@@ -899,9 +899,12 @@ package Prj is
type Response_File_Format is type Response_File_Format is
(None, (None,
GNU, GNU,
GCC,
Object_List, Object_List,
Option_List); Option_List,
GCC,
GCC_GNU,
GCC_Object_List,
GCC_Option_List);
-- The format of the different response files -- The format of the different response files
type Project_Configuration is record type Project_Configuration is record
...@@ -939,7 +942,7 @@ package Prj is ...@@ -939,7 +942,7 @@ package Prj is
Map_File_Option : Name_Id := No_Name; Map_File_Option : Name_Id := No_Name;
-- Option to use when invoking the linker to build a map file -- 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 -- The minimum options for the linker driver. Specified in the
-- configuration. -- configuration.
...@@ -1038,7 +1041,8 @@ package Prj is ...@@ -1038,7 +1041,8 @@ package Prj is
Executable_Suffix => No_Name, Executable_Suffix => No_Name,
Linker => No_Path, Linker => No_Path,
Map_File_Option => No_Name, 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_Executable_Option => No_Name_List,
Linker_Lib_Dir_Option => No_Name, Linker_Lib_Dir_Option => No_Name,
Linker_Lib_Name_Option => No_Name, Linker_Lib_Name_Option => No_Name,
......
...@@ -1730,6 +1730,7 @@ package body Sem is ...@@ -1730,6 +1730,7 @@ package body Sem is
procedure Do_Unit_And_Dependents (CU : Node_Id; Item : Node_Id) is procedure Do_Unit_And_Dependents (CU : Node_Id; Item : Node_Id) is
Unit_Num : constant Unit_Number_Type := Get_Cunit_Unit_Number (CU); Unit_Num : constant Unit_Number_Type := Get_Cunit_Unit_Number (CU);
Child : Node_Id; Child : Node_Id;
Body_U : Unit_Number_Type;
Parent_CU : Node_Id; Parent_CU : Node_Id;
procedure Do_Withed_Units is new Walk_Withs (Do_Withed_Unit); procedure Do_Withed_Units is new Walk_Withs (Do_Withed_Unit);
...@@ -1758,8 +1759,11 @@ package body Sem is ...@@ -1758,8 +1759,11 @@ package body Sem is
if CU = Library_Unit (Main_CU) then if CU = Library_Unit (Main_CU) then
Process_Bodies_In_Context (CU); Process_Bodies_In_Context (CU);
-- If main is a child unit, examine context of parent -- If main is a child unit, examine parent unit contexts
-- units to see if they include instantiated units. -- 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 if Is_Child_Unit (Cunit_Entity (Main_Unit)) then
Child := Cunit_Entity (Main_Unit); Child := Cunit_Entity (Main_Unit);
...@@ -1768,6 +1772,20 @@ package body Sem is ...@@ -1768,6 +1772,20 @@ package body Sem is
Cunit Cunit
(Get_Cunit_Entity_Unit_Number (Scope (Child))); (Get_Cunit_Entity_Unit_Number (Scope (Child)));
Process_Bodies_In_Context (Parent_CU); 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); Child := Scope (Child);
end loop; end loop;
end if; end if;
...@@ -1842,7 +1860,8 @@ package body Sem is ...@@ -1842,7 +1860,8 @@ package body Sem is
-- If we are processing the spec of the main unit, load bodies -- If we are processing the spec of the main unit, load bodies
-- only if the with_clause indicates that it forced the loading -- 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) if Present (Body_CU)
and then Body_CU /= Cunit (Main_Unit) and then Body_CU /= Cunit (Main_Unit)
...@@ -1976,6 +1995,9 @@ package body Sem is ...@@ -1976,6 +1995,9 @@ package body Sem is
-- If the main unit is a child unit, parent bodies may be present -- If the main unit is a child unit, parent bodies may be present
-- because they export instances or inlined subprograms. Check for -- because they export instances or inlined subprograms. Check for
-- presence of these, which are not present in context clauses. -- 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 if Is_Child_Unit (Cunit_Entity (Main_Unit)) then
Child := Cunit_Entity (Main_Unit); Child := Cunit_Entity (Main_Unit);
......
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