Commit 6ec084f3 by Hristian Kirtchev Committed by Arnaud Charlet

exp_alfa.adb: Add local constant Disable_Processing_Of_Renamings;

2011-11-04  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_alfa.adb: Add local constant
	Disable_Processing_Of_Renamings;
	(Expand_Alfa_N_Object_Renaming_Declaration): Disable
	the name evaluation of object renamings for now.
	(Expand_Potential_Renaming): Do not perform the substitution
	for now.
	* exp_util.adb (Remove_Side_Effects): Remove processing for
        functions with side effects in Alfa mode.

From-SVN: r180953
parent 73fe1679
2011-11-04 Hristian Kirtchev <kirtchev@adacore.com>
* exp_alfa.adb: Add local constant
Disable_Processing_Of_Renamings;
(Expand_Alfa_N_Object_Renaming_Declaration): Disable
the name evaluation of object renamings for now.
(Expand_Potential_Renaming): Do not perform the substitution
for now.
* exp_util.adb (Remove_Side_Effects): Remove processing for
functions with side effects in Alfa mode.
2011-11-04 Gary Dismukes <dismukes@adacore.com> 2011-11-04 Gary Dismukes <dismukes@adacore.com>
* bindgen.adb (Gen_Elab_Calls): In the case * bindgen.adb (Gen_Elab_Calls): In the case
......
...@@ -42,6 +42,8 @@ with Tbuild; use Tbuild; ...@@ -42,6 +42,8 @@ with Tbuild; use Tbuild;
package body Exp_Alfa is package body Exp_Alfa is
Disable_Processing_Of_Renamings : constant Boolean := True;
----------------------- -----------------------
-- Local Subprograms -- -- Local Subprograms --
----------------------- -----------------------
...@@ -209,6 +211,10 @@ package body Exp_Alfa is ...@@ -209,6 +211,10 @@ package body Exp_Alfa is
procedure Expand_Alfa_N_Object_Renaming_Declaration (N : Node_Id) is procedure Expand_Alfa_N_Object_Renaming_Declaration (N : Node_Id) is
begin begin
if Disable_Processing_Of_Renamings then
return;
end if;
-- Unconditionally remove all side effects from the name -- Unconditionally remove all side effects from the name
Evaluate_Name (Name (N)); Evaluate_Name (Name (N));
...@@ -297,6 +303,10 @@ package body Exp_Alfa is ...@@ -297,6 +303,10 @@ package body Exp_Alfa is
T : constant Entity_Id := Etype (N); T : constant Entity_Id := Etype (N);
begin begin
if Disable_Processing_Of_Renamings then
return;
end if;
-- Substitute a reference to a renaming with the actual renamed object -- Substitute a reference to a renaming with the actual renamed object
if Present (Renamed_Object (E)) then if Present (Renamed_Object (E)) then
......
...@@ -168,23 +168,30 @@ package body Exp_Util is ...@@ -168,23 +168,30 @@ package body Exp_Util is
Msg_Node : Node_Id; Msg_Node : Node_Id;
begin begin
case Nkind (Parent (N)) is case Nkind (Parent (N)) is
when N_Attribute_Reference |
-- Nothing to do if we are the prefix of an attribute, since we -- Check for cases of appearing in the prefix of a construct where
-- do not want an atomic sync operation for things like 'Size. -- we don't need atomic synchronization for this kind of usage.
when
-- Nothing to do if we are the prefix of an attribute, since we
-- do not want an atomic sync operation for things like 'Size.
N_Attribute_Reference |
-- The N_Reference node is like an attribute
N_Reference | N_Reference |
-- Likewise for a mere reference -- Nothing to do for a reference to a component (or components)
-- of a composite object. Only reads and updates of the object
-- as a whole require atomic synchronization (RM C.6 (15)).
N_Indexed_Component | N_Indexed_Component |
N_Selected_Component | N_Selected_Component |
N_Slice => N_Slice =>
-- The C.6(15) clause says that only reads and updates of the -- For all the above cases, nothing to do if we are the prefix
-- object as a whole require atomic synchronization.
if Prefix (Parent (N)) = N then if Prefix (Parent (N)) = N then
return; return;
...@@ -6547,57 +6554,32 @@ package body Exp_Util is ...@@ -6547,57 +6554,32 @@ package body Exp_Util is
end; end;
end if; end if;
Def_Id := Make_Temporary (Loc, 'R', Exp); Ref_Type := Make_Temporary (Loc, 'A');
Set_Etype (Def_Id, Exp_Type);
-- The regular expansion of functions with side effects involves the
-- generation of an access type to capture the return value found on
-- the secondary stack. Since Alfa (and why) cannot process access
-- types, use a different approach which ignores the secondary stack
-- and "copies" the returned object.
if Alfa_Mode then
Res := New_Reference_To (Def_Id, Loc);
Ref_Type := Exp_Type;
-- Regular expansion utilizing an access type and 'reference
else Ptr_Typ_Decl :=
Res := Make_Full_Type_Declaration (Loc,
Make_Explicit_Dereference (Loc, Defining_Identifier => Ref_Type,
Prefix => New_Reference_To (Def_Id, Loc)); Type_Definition =>
Make_Access_To_Object_Definition (Loc,
All_Present => True,
Subtype_Indication =>
New_Reference_To (Exp_Type, Loc)));
-- Generate: E := Exp;
-- type Ann is access all <Exp_Type>; Insert_Action (Exp, Ptr_Typ_Decl);
Ref_Type := Make_Temporary (Loc, 'A');
Ptr_Typ_Decl := Def_Id := Make_Temporary (Loc, 'R', Exp);
Make_Full_Type_Declaration (Loc, Set_Etype (Def_Id, Exp_Type);
Defining_Identifier => Ref_Type,
Type_Definition =>
Make_Access_To_Object_Definition (Loc,
All_Present => True,
Subtype_Indication =>
New_Reference_To (Exp_Type, Loc)));
Insert_Action (Exp, Ptr_Typ_Decl); Res :=
end if; Make_Explicit_Dereference (Loc,
Prefix => New_Reference_To (Def_Id, Loc));
E := Exp;
if Nkind (E) = N_Explicit_Dereference then if Nkind (E) = N_Explicit_Dereference then
New_Exp := Relocate_Node (Prefix (E)); New_Exp := Relocate_Node (Prefix (E));
else else
E := Relocate_Node (E); E := Relocate_Node (E);
New_Exp := Make_Reference (Loc, E);
-- Do not generate a 'reference in Alfa since the access type is
-- not generated.
if Alfa_Mode then
New_Exp := E;
else
New_Exp := Make_Reference (Loc, E);
end if;
end if; end if;
if Is_Delayed_Aggregate (E) then if Is_Delayed_Aggregate (E) then
......
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