[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
This commit is contained in:
parent
aa9a7dd7c2
commit
e2534738ee
7 changed files with 142 additions and 34 deletions
|
@ -1,3 +1,27 @@
|
|||
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);
|
||||
|
|
Loading…
Add table
Reference in a new issue