Commit ae5dd59d by Ed Schonberg Committed by Arnaud Charlet

exp_ch9.adb (Update_Prival_Types): Simplify code for entity references that are…

exp_ch9.adb (Update_Prival_Types): Simplify code for entity references that are private components of the...

2006-10-31  Ed Schonberg  <schonberg@adacore.com>             

        * exp_ch9.adb (Update_Prival_Types): Simplify code for entity
	references that are private components of the protected object.
	(Build_Barrier_Function): Set flag Is_Entry_Barrier_Function
	(Update_Prival_Subtypes): Add explicit Process argument to Traverse_Proc
	instantiation to deal with warnings.
	(Initialize_Protection): If expression for priority is non-static, use
	System_Priority as its expected type, in case the expression has not
	been analyzed yet.

From-SVN: r118261
parent 02822a92
...@@ -910,13 +910,15 @@ package body Exp_Ch9 is ...@@ -910,13 +910,15 @@ package body Exp_Ch9 is
Ent_Formals : constant Node_Id := Entry_Body_Formal_Part (N); Ent_Formals : constant Node_Id := Entry_Body_Formal_Part (N);
Index_Spec : constant Node_Id := Entry_Index_Specification Index_Spec : constant Node_Id := Entry_Index_Specification
(Ent_Formals); (Ent_Formals);
Op_Decls : constant List_Id := New_List; Op_Decls : constant List_Id := New_List;
Bdef : Entity_Id; Bdef : Entity_Id;
Bspec : Node_Id; Bspec : Node_Id;
EBF : Node_Id;
begin begin
Bdef := Bdef :=
Make_Defining_Identifier (Loc, Chars (Barrier_Function (Ent))); Make_Defining_Identifier (Loc,
Chars => Chars (Barrier_Function (Ent)));
Bspec := Build_Barrier_Function_Specification (Bdef, Loc); Bspec := Build_Barrier_Function_Specification (Bdef, Loc);
-- <object pointer declaration> -- <object pointer declaration>
...@@ -944,7 +946,6 @@ package body Exp_Ch9 is ...@@ -944,7 +946,6 @@ package body Exp_Ch9 is
Index_Con : constant Entity_Id := Index_Con : constant Entity_Id :=
Make_Defining_Identifier (Loc, Make_Defining_Identifier (Loc,
Chars => New_Internal_Name ('J')); Chars => New_Internal_Name ('J'));
begin begin
Set_Entry_Index_Constant (Index_Id, Index_Con); Set_Entry_Index_Constant (Index_Id, Index_Con);
Append_List_To (Op_Decls, Append_List_To (Op_Decls,
...@@ -956,7 +957,7 @@ package body Exp_Ch9 is ...@@ -956,7 +957,7 @@ package body Exp_Ch9 is
-- processed for the C/Fortran boolean possibility, but this happens -- processed for the C/Fortran boolean possibility, but this happens
-- automatically since the return statement does this normalization. -- automatically since the return statement does this normalization.
return EBF :=
Make_Subprogram_Body (Loc, Make_Subprogram_Body (Loc,
Specification => Bspec, Specification => Bspec,
Declarations => Op_Decls, Declarations => Op_Decls,
...@@ -965,6 +966,8 @@ package body Exp_Ch9 is ...@@ -965,6 +966,8 @@ package body Exp_Ch9 is
Statements => New_List ( Statements => New_List (
Make_Return_Statement (Loc, Make_Return_Statement (Loc,
Expression => Condition (Ent_Formals))))); Expression => Condition (Ent_Formals)))));
Set_Is_Entry_Barrier_Function (EBF);
return EBF;
end Build_Barrier_Function; end Build_Barrier_Function;
------------------------------------------ ------------------------------------------
...@@ -2697,6 +2700,12 @@ package body Exp_Ch9 is ...@@ -2697,6 +2700,12 @@ package body Exp_Ch9 is
begin begin
Expand_Call (N); Expand_Call (N);
-- If call has been inlined, nothing left to do
if Nkind (N) = N_Block_Statement then
return;
end if;
-- Convert entry call to Call_Simple call -- Convert entry call to Call_Simple call
declare declare
...@@ -4161,7 +4170,6 @@ package body Exp_Ch9 is ...@@ -4161,7 +4170,6 @@ package body Exp_Ch9 is
-- scope. -- scope.
if Is_Entity_Name (Cond) then if Is_Entity_Name (Cond) then
if Entity (Cond) = Standard_False if Entity (Cond) = Standard_False
or else or else
Entity (Cond) = Standard_True Entity (Cond) = Standard_True
...@@ -10494,39 +10502,78 @@ package body Exp_Ch9 is ...@@ -10494,39 +10502,78 @@ package body Exp_Ch9 is
if Present (Pdef) if Present (Pdef)
and then Has_Priority_Pragma (Pdef) and then Has_Priority_Pragma (Pdef)
then then
Append_To (Args, declare
Duplicate_Subexpr_No_Checks Prio : constant Node_Id :=
(Expression Expression
(First (First
(Pragma_Argument_Associations (Pragma_Argument_Associations
(Find_Task_Or_Protected_Pragma (Pdef, Name_Priority)))))); (Find_Task_Or_Protected_Pragma
(Pdef, Name_Priority))));
Temp : Entity_Id;
begin
-- If priority is a static expression, then we can duplicate it
-- with no problem and simply append it to the argument list.
if Is_Static_Expression (Prio) then
Append_To (Args,
Duplicate_Subexpr_No_Checks (Prio));
-- Otherwise, the priority may be a per-object expression, if it
-- depends on a discriminant of the type. In this case, create
-- local variable to capture the expression. Note that it is
-- really necessary to create this variable explicitly. It might
-- be thought that removing side effects would the appropriate
-- approach, but that could generate declarations improperly
-- placed in the enclosing scope.
-- Note: Use System.Any_Priority as the expected type for the
-- non-static priority expression, in case the expression has not
-- been analyzed yet (as occurs for example with pragma
-- Interrupt_Priority).
else
Temp :=
Make_Defining_Identifier (Loc, New_Internal_Name ('R'));
Append_To (L,
Make_Object_Declaration (Loc,
Defining_Identifier => Temp,
Object_Definition =>
New_Occurrence_Of (RTE (RE_Any_Priority), Loc),
Expression => Relocate_Node (Prio)));
Append_To (Args, New_Occurrence_Of (Temp, Loc));
end if;
end;
-- When no priority is specified but an xx_Handler pragma is, we default
-- to System.Interrupts.Default_Interrupt_Priority, see D.3(10).
elsif Has_Interrupt_Handler (Ptyp) elsif Has_Interrupt_Handler (Ptyp)
or else Has_Attach_Handler (Ptyp) or else Has_Attach_Handler (Ptyp)
then then
-- When no priority is specified but an xx_Handler pragma is,
-- we default to System.Interrupts.Default_Interrupt_Priority,
-- see D.3(10).
Append_To (Args, Append_To (Args,
New_Reference_To (RTE (RE_Default_Interrupt_Priority), Loc)); New_Reference_To (RTE (RE_Default_Interrupt_Priority), Loc));
-- Normal case, no priority or xx_Handler specified, default priority
else else
Append_To (Args, Append_To (Args,
New_Reference_To (RTE (RE_Unspecified_Priority), Loc)); New_Reference_To (RTE (RE_Unspecified_Priority), Loc));
end if; end if;
-- Test for Compiler_Info parameter. This parameter allows entry body
-- procedures and barrier functions to be called from the runtime. It
-- is a pointer to the record generated by the compiler to represent
-- the protected object.
if Has_Entry if Has_Entry
or else Has_Interrupt_Handler (Ptyp) or else Has_Interrupt_Handler (Ptyp)
or else Has_Attach_Handler (Ptyp) or else Has_Attach_Handler (Ptyp)
or else (Ada_Version >= Ada_05 or else (Ada_Version >= Ada_05
and then Present (Interface_List (Parent (Ptyp)))) and then Present (Interface_List (Parent (Ptyp))))
then then
-- Compiler_Info parameter. This parameter allows entry body
-- procedures and barrier functions to be called from the runtime.
-- It is a pointer to the record generated by the compiler to
-- represent the protected object.
if Has_Entry or else not Restricted then if Has_Entry or else not Restricted then
Append_To (Args, Append_To (Args,
Make_Attribute_Reference (Loc, Make_Attribute_Reference (Loc,
...@@ -10534,13 +10581,12 @@ package body Exp_Ch9 is ...@@ -10534,13 +10581,12 @@ package body Exp_Ch9 is
Attribute_Name => Name_Address)); Attribute_Name => Name_Address));
end if; end if;
if Has_Entry then -- Entry_Bodies parameter. This is a pointer to an array of pointers
-- to the entry body procedures and barrier functions of the object.
-- Entry_Bodies parameter. This is a pointer to an array of -- If the protected type has no entries this object will not exist;
-- pointers to the entry body procedures and barrier functions of -- in this case, pass a null.
-- the object. If the protected type has no entries this object
-- will not exist; in this case, pass a null.
if Has_Entry then
P_Arr := Entry_Bodies_Array (Ptyp); P_Arr := Entry_Bodies_Array (Ptyp);
Append_To (Args, Append_To (Args,
...@@ -11260,7 +11306,11 @@ package body Exp_Ch9 is ...@@ -11260,7 +11306,11 @@ package body Exp_Ch9 is
and then not Is_Scalar_Type (Etype (E)) and then not Is_Scalar_Type (Etype (E))
and then Etype (N) /= Etype (E) and then Etype (N) /= Etype (E)
then then
Set_Etype (N, Etype (Entity (Original_Node (N))));
-- Ensure that reference and entity have the same Etype,
-- to prevent back-end inconsistencies.
Set_Etype (N, Etype (E));
Update_Index_Types (N); Update_Index_Types (N);
elsif Present (E) elsif Present (E)
...@@ -11376,7 +11426,7 @@ package body Exp_Ch9 is ...@@ -11376,7 +11426,7 @@ package body Exp_Ch9 is
end if; end if;
end Update_Index_Types; end Update_Index_Types;
procedure Traverse is new Traverse_Proc; procedure Traverse is new Traverse_Proc (Process);
-- Start of processing for Update_Prival_Subtypes -- Start of processing for Update_Prival_Subtypes
......
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