From: Ed Schonberg Date: Tue, 31 Oct 2006 17:55:21 +0000 (+0100) Subject: exp_ch9.adb (Update_Prival_Types): Simplify code for entity references that are priva... X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=ae5dd59d043919bf07714293c31d93281cebfb30;p=gcc.git exp_ch9.adb (Update_Prival_Types): Simplify code for entity references that are private components of the... 2006-10-31 Ed Schonberg * 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 --- diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index bc673d7f4c8..3cb895ec439 100644 --- a/gcc/ada/exp_ch9.adb +++ b/gcc/ada/exp_ch9.adb @@ -910,13 +910,15 @@ package body Exp_Ch9 is Ent_Formals : constant Node_Id := Entry_Body_Formal_Part (N); Index_Spec : constant Node_Id := Entry_Index_Specification (Ent_Formals); - Op_Decls : constant List_Id := New_List; - Bdef : Entity_Id; - Bspec : Node_Id; + Op_Decls : constant List_Id := New_List; + Bdef : Entity_Id; + Bspec : Node_Id; + EBF : Node_Id; begin 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); -- @@ -944,7 +946,6 @@ package body Exp_Ch9 is Index_Con : constant Entity_Id := Make_Defining_Identifier (Loc, Chars => New_Internal_Name ('J')); - begin Set_Entry_Index_Constant (Index_Id, Index_Con); Append_List_To (Op_Decls, @@ -956,7 +957,7 @@ package body Exp_Ch9 is -- processed for the C/Fortran boolean possibility, but this happens -- automatically since the return statement does this normalization. - return + EBF := Make_Subprogram_Body (Loc, Specification => Bspec, Declarations => Op_Decls, @@ -965,6 +966,8 @@ package body Exp_Ch9 is Statements => New_List ( Make_Return_Statement (Loc, Expression => Condition (Ent_Formals))))); + Set_Is_Entry_Barrier_Function (EBF); + return EBF; end Build_Barrier_Function; ------------------------------------------ @@ -2697,6 +2700,12 @@ package body Exp_Ch9 is begin 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 declare @@ -4161,7 +4170,6 @@ package body Exp_Ch9 is -- scope. if Is_Entity_Name (Cond) then - if Entity (Cond) = Standard_False or else Entity (Cond) = Standard_True @@ -10494,39 +10502,78 @@ package body Exp_Ch9 is if Present (Pdef) and then Has_Priority_Pragma (Pdef) then - Append_To (Args, - Duplicate_Subexpr_No_Checks - (Expression - (First - (Pragma_Argument_Associations - (Find_Task_Or_Protected_Pragma (Pdef, Name_Priority)))))); + declare + Prio : constant Node_Id := + Expression + (First + (Pragma_Argument_Associations + (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) or else Has_Attach_Handler (Ptyp) 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, New_Reference_To (RTE (RE_Default_Interrupt_Priority), Loc)); + -- Normal case, no priority or xx_Handler specified, default priority + else Append_To (Args, New_Reference_To (RTE (RE_Unspecified_Priority), Loc)); 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 or else Has_Interrupt_Handler (Ptyp) or else Has_Attach_Handler (Ptyp) or else (Ada_Version >= Ada_05 and then Present (Interface_List (Parent (Ptyp)))) 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 Append_To (Args, Make_Attribute_Reference (Loc, @@ -10534,13 +10581,12 @@ package body Exp_Ch9 is Attribute_Name => Name_Address)); 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. If the protected type has no entries this object - -- will not exist; in this case, pass a null. + -- Entry_Bodies parameter. This is a pointer to an array of pointers + -- to the entry body procedures and barrier functions of 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); Append_To (Args, @@ -11260,7 +11306,11 @@ package body Exp_Ch9 is and then not Is_Scalar_Type (Etype (E)) and then Etype (N) /= Etype (E) 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); elsif Present (E) @@ -11376,7 +11426,7 @@ package body Exp_Ch9 is end if; end Update_Index_Types; - procedure Traverse is new Traverse_Proc; + procedure Traverse is new Traverse_Proc (Process); -- Start of processing for Update_Prival_Subtypes