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>
* exp_util.adb (Insert_Actions): If the action appears within a
......
......@@ -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
......
......@@ -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!
......
......@@ -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;
......
......@@ -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,
......
......@@ -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,
......
......@@ -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);
......
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