Skip to content

R
riscv-gcc-1
Commit 0c6826a5 by Arnaud Charlet
Options

[multiple changes] 

2015-05-26  Robert Dewar  <dewar@adacore.com>

	* errout.ads, sem_ch4.adb, sem_ch6.adb: Minor reformatting.

2015-05-26  Bob Duff  <duff@adacore.com>

	* sem_elab.adb (Check_A_Call): In the case where we're
	calling something in an instance of a generic package that is
	within this same unit (as the call), make sure we treat it
	as a call to an entity within the same unit. That is, call
	Check_Internal_Call, rather than putting "Elaborate_All(X)"
	on X, which would necessarily result in an elaboration cycle in
	static-elaboration mode.

2015-05-26  Eric Botcazou  <ebotcazou@adacore.com>

	* freeze.ads (Is_Atomic_VFA_Aggregate): Adjust profile.
	* freeze.adb (Is_Atomic_VFA_Aggregate): Change Entity
	parameter into Node parameter and remove Type parameter.
	Look at Is_Atomic_Or_VFA both on the type and on the object.
	(Freeze_Entity): Adjust call to Is_Atomic_VFA_Aggregate.
	* exp_aggr.adb (Expand_Record_Aggregate): Likewise.
	(Process_Atomic_Independent_Shared_Volatile): Remove code
	propagating Atomic or VFA from object to locally-defined type.

2015-05-26  Bob Duff  <duff@adacore.com>

	* exp_ch7.adb: Minor comment fix.

From-SVN: r223751
parent faae53f8
Showing with 92 additions and 90 deletions
gcc/ada/ChangeLog
2015-05-26 Robert Dewar <dewar@adacore.com>
* errout.ads, sem_ch4.adb, sem_ch6.adb: Minor reformatting.
2015-05-26 Bob Duff <duff@adacore.com>
* sem_elab.adb (Check_A_Call): In the case where we're
calling something in an instance of a generic package that is
within this same unit (as the call), make sure we treat it
as a call to an entity within the same unit. That is, call
Check_Internal_Call, rather than putting "Elaborate_All(X)"
on X, which would necessarily result in an elaboration cycle in
static-elaboration mode.
2015-05-26 Eric Botcazou <ebotcazou@adacore.com>
* freeze.ads (Is_Atomic_VFA_Aggregate): Adjust profile.
* freeze.adb (Is_Atomic_VFA_Aggregate): Change Entity
parameter into Node parameter and remove Type parameter.
Look at Is_Atomic_Or_VFA both on the type and on the object.
(Freeze_Entity): Adjust call to Is_Atomic_VFA_Aggregate.
* exp_aggr.adb (Expand_Record_Aggregate): Likewise.
(Process_Atomic_Independent_Shared_Volatile): Remove code
propagating Atomic or VFA from object to locally-defined type.
2015-05-26 Bob Duff <duff@adacore.com>
* exp_ch7.adb: Minor comment fix.
2015-05-26 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/trans.c (Attribute_to_gnu) <Attr_Min/Attr_Max>: Do not
......
gcc/ada/errout.ads
......@@ -24,7 +24,7 @@
------------------------------------------------------------------------------
-- This package contains the routines to output error messages. They are
-- basically system independent, however, in some environments, e.g. when the
-- basically system independent, however in some environments, e.g. when the
-- parser is embedded into an editor, it may be appropriate to replace the
-- implementation of this package.
......
gcc/ada/exp_aggr.adb
......@@ -5950,10 +5950,7 @@ package body Exp_Aggr is
-- temporary instead, so that the back end can generate an atomic move
-- for it.
if Is_Atomic_Or_VFA (Typ)
and then Comes_From_Source (Parent (N))
and then Is_Atomic_VFA_Aggregate (N, Typ)
then
if Is_Atomic_VFA_Aggregate (N) then
return;
-- No special management required for aggregates used to initialize
......
gcc/ada/exp_ch7.adb
......@@ -129,7 +129,7 @@ package body Exp_Ch7 is
function Find_Node_To_Be_Wrapped (N : Node_Id) return Node_Id;
-- N is a node which may generate a transient scope. Loop over the parent
-- pointers of N until it find the appropriate node to wrap. If it returns
-- pointers of N until we find the appropriate node to wrap. If it returns
-- Empty, it means that no transient scope is needed in this context.
procedure Insert_Actions_In_Scope_Around
......
gcc/ada/freeze.adb
......@@ -1459,17 +1459,15 @@ package body Freeze is
-- Is_Atomic_VFA_Aggregate --
-----------------------------
function Is_Atomic_VFA_Aggregate
(E : Entity_Id;
Typ : Entity_Id) return Boolean
is
Loc : constant Source_Ptr := Sloc (E);
function Is_Atomic_VFA_Aggregate (N : Node_Id) return Boolean is
Loc : constant Source_Ptr := Sloc (N);
New_N : Node_Id;
Par : Node_Id;
Temp : Entity_Id;
Typ : Entity_Id;
begin
Par := Parent (E);
Par := Parent (N);
-- Array may be qualified, so find outer context
......@@ -1477,24 +1475,45 @@ package body Freeze is
Par := Parent (Par);
end if;
if Nkind_In (Par, N_Object_Declaration, N_Assignment_Statement)
and then Comes_From_Source (Par)
then
Temp := Make_Temporary (Loc, 'T', E);
New_N :=
Make_Object_Declaration (Loc,
Defining_Identifier => Temp,
Object_Definition => New_Occurrence_Of (Typ, Loc),
Expression => Relocate_Node (E));
Insert_Before (Par, New_N);
Analyze (New_N);
Set_Expression (Par, New_Occurrence_Of (Temp, Loc));
return True;
else
if not Comes_From_Source (Par) then
return False;
end if;
case Nkind (Par) is
when N_Assignment_Statement =>
Typ := Etype (Name (Par));
if not Is_Atomic_Or_VFA (Typ)
and then not (Is_Entity_Name (Name (Par))
and then Is_Atomic_Or_VFA (Entity (Name (Par))))
then
return False;
end if;
when N_Object_Declaration =>
Typ := Etype (Defining_Identifier (Par));
if not Is_Atomic_Or_VFA (Typ)
and then not Is_Atomic_Or_VFA (Defining_Identifier (Par))
then
return False;
end if;
when others =>
return False;
end case;
Temp := Make_Temporary (Loc, 'T', N);
New_N :=
Make_Object_Declaration (Loc,
Defining_Identifier => Temp,
Object_Definition => New_Occurrence_Of (Typ, Loc),
Expression => Relocate_Node (N));
Insert_Before (Par, New_N);
Analyze (New_N);
Set_Expression (Par, New_Occurrence_Of (Temp, Loc));
return True;
end Is_Atomic_VFA_Aggregate;
-----------------------------------------------
......@@ -4821,8 +4840,7 @@ package body Freeze is
and then Nkind (Parent (E)) = N_Object_Declaration
and then Present (Expression (Parent (E)))
and then Nkind (Expression (Parent (E))) = N_Aggregate
and then
Is_Atomic_VFA_Aggregate (Expression (Parent (E)), Etype (E))
and then Is_Atomic_VFA_Aggregate (Expression (Parent (E)))
then
null;
end if;
......
gcc/ada/freeze.ads
......@@ -174,9 +174,7 @@ package Freeze is
-- do not allow a size clause if the size would not otherwise be known at
-- compile time in any case.
function Is_Atomic_VFA_Aggregate
(E : Entity_Id;
Typ : Entity_Id) return Boolean;
function Is_Atomic_VFA_Aggregate (N : Node_Id) return Boolean;
-- If an atomic/VFA object is initialized with an aggregate or is assigned
-- an aggregate, we have to prevent a piecemeal access or assignment to the
-- object, even if the aggregate is to be expanded. We create a temporary
......
gcc/ada/sem_ch4.adb
......@@ -1968,10 +1968,10 @@ package body Sem_Ch4 is
end if;
-- An explicit dereference is a legal occurrence of an
-- incomplete type imported through a limited_with clause,
-- if the full view is visible, or if we are within an
-- instance body, where the enclosing body has a regular
-- with_clause on the unit.
-- incomplete type imported through a limited_with clause, if
-- the full view is visible, or if we are within an instance
-- body, where the enclosing body has a regular with_clause
-- on the unit.
if From_Limited_With (DT)
and then not From_Limited_With (Scope (DT))
......@@ -2196,8 +2196,8 @@ package body Sem_Ch4 is
Get_First_Interp (Then_Expr, I, It);
while Present (It.Nam) loop
-- Add possible intepretation of Then_Expr if no Else_Expr,
-- or Else_Expr is present and has a compatible type.
-- Add possible intepretation of Then_Expr if no Else_Expr, or
-- Else_Expr is present and has a compatible type.
if No (Else_Expr)
or else Has_Compatible_Type (Else_Expr, It.Typ)
......@@ -2224,8 +2224,8 @@ package body Sem_Ch4 is
U_N : Entity_Id;
procedure Process_Function_Call;
-- Prefix in indexed component form is an overloadable entity,
-- so the node is a function call. Reformat it as such.
-- Prefix in indexed component form is an overloadable entity, so the
-- node is a function call. Reformat it as such.
procedure Process_Indexed_Component;
-- Prefix in indexed component form is actually an indexed component.
......@@ -2263,8 +2263,8 @@ package body Sem_Ch4 is
-- Move to next actual. Note that we use Next, not Next_Actual
-- here. The reason for this is a bit subtle. If a function call
-- includes named associations, the parser recognizes the node as
-- a call, and it is analyzed as such. If all associations are
-- includes named associations, the parser recognizes the node
-- as a call, and it is analyzed as such. If all associations are
-- positional, the parser builds an indexed_component node, and
-- it is only after analysis of the prefix that the construct
-- is recognized as a call, in which case Process_Function_Call
......@@ -2398,7 +2398,7 @@ package body Sem_Ch4 is
elsif Is_Entity_Name (P)
and then Etype (P) = Standard_Void_Type
then
Error_Msg_NE ("incorrect use of&", P, Entity (P));
Error_Msg_NE ("incorrect use of &", P, Entity (P));
else
Error_Msg_N ("array type required in indexed component", P);
......@@ -2447,10 +2447,10 @@ package body Sem_Ch4 is
Exp := First (Exprs);
-- If one index is present, and it is a subtype name, then the
-- node denotes a slice (note that the case of an explicit range
-- for a slice was already built as an N_Slice node in the first
-- place, so that case is not handled here).
-- If one index is present, and it is a subtype name, then the node
-- denotes a slice (note that the case of an explicit range for a
-- slice was already built as an N_Slice node in the first place,
-- so that case is not handled here).
-- We use a replace rather than a rewrite here because this is one
-- of the cases in which the tree built by the parser is plain wrong.
......
gcc/ada/sem_ch6.adb
......@@ -8297,7 +8297,7 @@ package body Sem_Ch6 is
then
Defn :=
Type_Definition
(Original_Node (Parent (First_Subtype (F_Typ))));
(Original_Node (Parent (First_Subtype (F_Typ))));
else
Defn := Type_Definition (Original_Node (Parent (F_Typ)));
end if;
......@@ -8347,6 +8347,7 @@ package body Sem_Ch6 is
elsif not Is_Class_Wide_Type (New_Type) then
while Etype (New_Type) /= New_Type loop
New_Type := Etype (New_Type);
if New_Type = Prev_Type then
return True;
end if;
......
gcc/ada/sem_prag.adb
......@@ -5875,7 +5875,6 @@ package body Sem_Prag is
E : Entity_Id;
E_Id : Node_Id;
K : Node_Kind;
Utyp : Entity_Id;
procedure Set_Atomic_VFA (E : Entity_Id);
-- Set given type as Is_Atomic or Is_Volatile_Full_Access. Also, if
......@@ -6053,46 +6052,6 @@ package body Sem_Prag is
then
Set_Has_Delayed_Freeze (E);
end if;
-- An interesting improvement here. If an object of composite
-- type X is declared atomic, and the type X isn't, that's a
-- pity, since it may not have appropriate alignment etc. We
-- can rescue this in the special case where the object and
-- type are in the same unit by just setting the type as
-- atomic, so that the back end will process it as atomic.
-- Note: we used to do this for elementary types as well,
-- but that turns out to be a bad idea and can have unwanted
-- effects, most notably if the type is elementary, the object
-- a simple component within a record, and both are in a spec:
-- every object of this type in the entire program will be
-- treated as atomic, thus incurring a potentially costly
-- synchronization operation for every access.
-- For Volatile_Full_Access we can do this for elementary types
-- too, since there is no issue of atomic synchronization.
-- Of course it would be best if the back end could just adjust
-- the alignment etc for the specific object, but that's not
-- something we are capable of doing at this point.
Utyp := Underlying_Type (Etype (E));
if Present (Utyp)
and then (Is_Composite_Type (Utyp)
or else Prag_Id = Pragma_Volatile_Full_Access)
and then Sloc (E) > No_Location
and then Sloc (Utyp) > No_Location
and then
Get_Source_File_Index (Sloc (E)) =
Get_Source_File_Index (Sloc (Utyp))
then
if Prag_Id = Pragma_Volatile_Full_Access then
Set_Is_Volatile_Full_Access (Utyp);
else
Set_Is_Atomic (Utyp);
end if;
end if;
end if;
-- Atomic/Shared/Volatile_Full_Access imply Independent
......
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