diff options
Diffstat (limited to 'gcc/ada/exp_ch9.adb')
| -rw-r--r-- | gcc/ada/exp_ch9.adb | 75 |
1 files changed, 47 insertions, 28 deletions
diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index 1a91bf1b0a3..d09911a680b 100644 --- a/gcc/ada/exp_ch9.adb +++ b/gcc/ada/exp_ch9.adb @@ -1132,8 +1132,9 @@ package body Exp_Ch9 is -- for Lnn in Family_Low .. Family_High loop -- Inn := Inn + 1; -- Set_Entry_Name - -- (_init._object, Inn, new String ("<Entry name> " & Lnn'Img)); - -- _init._task_id + -- (_init._object <or> _init._task_id, + -- Inn, + -- new String ("<Entry name>(" & Lnn'Img & ")")); -- end loop; -- Note that the bounds of the range may reference discriminants. The -- above construct is added directly to the statements of the block. @@ -1141,8 +1142,10 @@ package body Exp_Ch9 is procedure Build_Entry_Name (Id : Entity_Id); -- Generate: -- Inn := Inn + 1; - -- Set_Entry_Name (_init._task_id, Inn, new String ("<Entry name>"); - -- _init._object + -- Set_Entry_Name + -- (_init._object <or>_init._task_id, + -- Inn, + -- new String ("<Entry name>"); -- The above construct is added directly to the statements of the block. function Build_Set_Entry_Name_Call (Arg3 : Node_Id) return Node_Id; @@ -1213,13 +1216,12 @@ package body Exp_Ch9 is begin Get_Name_String (Chars (Id)); - if Is_Enumeration_Type (Etype (Def)) then - Name_Len := Name_Len + 1; - Name_Buffer (Name_Len) := ' '; - end if; + -- Add a leading '(' + + Add_Char_To_Name_Buffer ('('); -- Generate: - -- new String'("<Entry name>" & Lnn'Img); + -- new String'("<Entry name>(" & Lnn'Img & ")"); -- This is an implicit heap allocation, and Comes_From_Source is -- False, which ensures that it will get flagged as a violation of @@ -1233,13 +1235,18 @@ package body Exp_Ch9 is Expression => Make_Op_Concat (Loc, Left_Opnd => - Make_String_Literal (Loc, - String_From_Name_Buffer), + Make_Op_Concat (Loc, + Left_Opnd => + Make_String_Literal (Loc, + Strval => String_From_Name_Buffer), + Right_Opnd => + Make_Attribute_Reference (Loc, + Prefix => + New_Reference_To (L_Id, Loc), + Attribute_Name => Name_Img)), Right_Opnd => - Make_Attribute_Reference (Loc, - Prefix => - New_Reference_To (L_Id, Loc), - Attribute_Name => Name_Img)))); + Make_String_Literal (Loc, + Strval => ")")))); Increment_Index (L_Stmts); Append_To (L_Stmts, Build_Set_Entry_Name_Call (Val)); @@ -1247,7 +1254,8 @@ package body Exp_Ch9 is -- Generate: -- for Lnn in Family_Low .. Family_High loop -- Inn := Inn + 1; - -- Set_Entry_Name (_init._task_id, Inn, <Val>); + -- Set_Entry_Name + -- (_init._object <or> _init._task_id, Inn, <Val>); -- end loop; Append_To (B_Stmts, @@ -3167,13 +3175,9 @@ package body Exp_Ch9 is Name_Len := Name_Len - 1; end if; - Name_Buffer (Name_Len + 1) := '_'; - Name_Buffer (Name_Len + 2) := '_'; - - Name_Len := Name_Len + 2; + Add_Str_To_Name_Buffer ("__"); for J in 1 .. Select_Len loop - Name_Len := Name_Len + 1; - Name_Buffer (Name_Len) := Select_Buffer (J); + Add_Char_To_Name_Buffer (Select_Buffer (J)); end loop; -- Now add the Append_Char if specified. The encoding to follow @@ -3186,13 +3190,10 @@ package body Exp_Ch9 is if Append_Char /= ' ' then if Append_Char = 'P' or Append_Char = 'N' then - Name_Len := Name_Len + 1; - Name_Buffer (Name_Len) := Append_Char; + Add_Char_To_Name_Buffer (Append_Char); return Name_Find; else - Name_Buffer (Name_Len + 1) := '_'; - Name_Buffer (Name_Len + 2) := Append_Char; - Name_Len := Name_Len + 2; + Add_Str_To_Name_Buffer ((1 => '_', 2 => Append_Char)); return New_External_Name (Name_Find, ' ', -1); end if; else @@ -7461,10 +7462,27 @@ package body Exp_Ch9 is E_Count : Int; Object_Comp : Node_Id; + procedure Check_Inlining (Subp : Entity_Id); + -- If the original operation has a pragma Inline, propagate the flag + -- to the internal body, for possible inlining later on. The source + -- operation is invisible to the back-end and is never actually called. + procedure Register_Handler; -- For a protected operation that is an interrupt handler, add the -- freeze action that will register it as such. + -------------------- + -- Check_Inlining -- + -------------------- + + procedure Check_Inlining (Subp : Entity_Id) is + begin + if Is_Inlined (Subp) then + Set_Is_Inlined (Protected_Body_Subprogram (Subp)); + Set_Is_Inlined (Subp, False); + end if; + end Check_Inlining; + ---------------------- -- Register_Handler -- ---------------------- @@ -7713,7 +7731,7 @@ package body Exp_Ch9 is Set_Protected_Body_Subprogram (Defining_Unit_Name (Specification (Priv)), Defining_Unit_Name (Specification (Sub))); - + Check_Inlining (Defining_Unit_Name (Specification (Priv))); Current_Node := Sub; Sub := @@ -7800,6 +7818,7 @@ package body Exp_Ch9 is Set_Protected_Body_Subprogram (Defining_Unit_Name (Specification (Comp)), Defining_Unit_Name (Specification (Sub))); + Check_Inlining (Defining_Unit_Name (Specification (Comp))); -- Make the protected version of the subprogram available for -- expansion of external calls. |