From 6fd52b789342ed9e37869891e07cd445b8f3e0bd Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Fri, 31 Oct 2014 12:15:51 +0100 Subject: [PATCH] [multiple changes] 2014-10-31 Eric Botcazou * inline.adb (Has_Excluded_Declaration): With back-end inlining, only return true for nested packages. (Cannot_Inline): Issue errors/warnings whatever the optimization level for back-end inlining and remove assertion. 2014-10-31 Sergey Rybin * table.adb (Tree_Read, Tree_Write): Use parentheses to specify the desired order of '*' and '/' operations to avoid overflow. 2014-10-31 Eric Botcazou * exp_ch6.adb (Do_Inline): Remove unreachable code. (Do_Inline_Always): Likewise. 2014-10-31 Vincent Celier * prj-nmsc.adb (Check_Stand_Alone_Library): Change error message when library has no Ada interfaces and Library_Standalone is declared. From-SVN: r216961 --- gcc/ada/ChangeLog | 23 ++++ gcc/ada/exp_ch6.adb | 253 +------------------------------------------ gcc/ada/inline.adb | 49 ++++----- gcc/ada/prj-nmsc.adb | 2 +- gcc/ada/table.adb | 6 +- 5 files changed, 52 insertions(+), 281 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 37e32f928fc..ec9daba8df5 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,26 @@ +2014-10-31 Eric Botcazou + + * inline.adb (Has_Excluded_Declaration): With back-end inlining, + only return true for nested packages. + (Cannot_Inline): Issue errors/warnings whatever the optimization level + for back-end inlining and remove assertion. + +2014-10-31 Sergey Rybin + + * table.adb (Tree_Read, Tree_Write): Use parentheses to specify + the desired order of '*' and '/' operations to avoid overflow. + +2014-10-31 Eric Botcazou + + * exp_ch6.adb (Do_Inline): Remove unreachable code. + (Do_Inline_Always): Likewise. + +2014-10-31 Vincent Celier + + * prj-nmsc.adb (Check_Stand_Alone_Library): Change error message + when library has no Ada interfaces and Library_Standalone is + declared. + 2014-10-31 Arnaud Charlet * sem_ch13.adb (Check_Constant_Address_Clause): Disable checks diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 25a3972e758..b3f9ab6fc5e 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -1998,19 +1998,6 @@ package body Exp_Ch6 is -- expression for the value of the actual, EF is the entity for the -- extra formal. - procedure Do_Inline (Subp : Entity_Id; Orig_Subp : Entity_Id); - -- Check and inline the body of Subp. Invoked when compiling with - -- optimizations enabled and Subp has pragma inline or inline always. - -- If the subprogram is a renaming, or if it is inherited, then Subp - -- references the renamed entity and Orig_Subp is the entity of the - -- call node N. - - procedure Do_Inline_Always (Subp : Entity_Id; Orig_Subp : Entity_Id); - -- Check and inline the body of Subp. Invoked when compiling without - -- optimizations and Subp has pragma inline always. If the subprogram is - -- a renaming, or if it is inherited, then Subp references the renamed - -- entity and Orig_Subp is the entity of the call node N. - function Inherited_From_Formal (S : Entity_Id) return Entity_Id; -- Within an instance, a type derived from an untagged formal derived -- type inherits from the original parent, not from the actual. The @@ -2097,211 +2084,6 @@ package body Exp_Ch6 is end if; end Add_Extra_Actual; - ---------------- - -- Do_Inline -- - ---------------- - - procedure Do_Inline (Subp : Entity_Id; Orig_Subp : Entity_Id) is - Spec : constant Node_Id := Unit_Declaration_Node (Subp); - - procedure Do_Backend_Inline; - -- Check that the call can be safely passed to the backend. If true - -- then register the enclosing unit of Subp to Inlined_Bodies so that - -- the body of Subp can be retrieved and analyzed by the backend. - - ----------------------- - -- Do_Backend_Inline -- - ----------------------- - - procedure Do_Backend_Inline is - begin - -- No extra test needed for init subprograms since we know they - -- are available to the backend. - - if Is_Init_Proc (Subp) then - Add_Inlined_Body (Subp); - Register_Backend_Call (Call_Node); - - -- Verify that if the body to inline is located in the current - -- unit the inlining does not occur earlier. This avoids - -- order-of-elaboration problems in the back end. - - elsif In_Same_Extended_Unit (Call_Node, Subp) - and then Nkind (Spec) = N_Subprogram_Declaration - and then Earlier_In_Extended_Unit - (Loc, Sloc (Body_To_Inline (Spec))) - then - Error_Msg_NE - ("cannot inline& (body not seen yet)??", Call_Node, Subp); - - else - declare - Backend_Inline : Boolean := True; - - begin - -- If we are compiling a package body that is not the - -- main unit, it must be for inlining/instantiation - -- purposes, in which case we inline the call to insure - -- that the same temporaries are generated when compiling - -- the body by itself. Otherwise link errors can occur. - - -- If the function being called is itself in the main - -- unit, we cannot inline, because there is a risk of - -- double elaboration and/or circularity: the inlining - -- can make visible a private entity in the body of the - -- main unit, that gigi will see before its sees its - -- proper definition. - - if not (In_Extended_Main_Code_Unit (Call_Node)) - and then In_Package_Body - then - Backend_Inline := - not In_Extended_Main_Source_Unit (Subp); - end if; - - if Backend_Inline then - Add_Inlined_Body (Subp); - Register_Backend_Call (Call_Node); - end if; - end; - end if; - end Do_Backend_Inline; - - -- Start of processing for Do_Inline - - begin - -- Verify that the body to inline has already been seen - - if No (Spec) - or else Nkind (Spec) /= N_Subprogram_Declaration - or else No (Body_To_Inline (Spec)) - then - if Comes_From_Source (Subp) - and then Must_Inline (Subp) - then - Cannot_Inline - ("cannot inline& (body not seen yet)?", Call_Node, Subp); - - -- Let the back end handle it - - else - Do_Backend_Inline; - return; - end if; - - -- If this an inherited function that returns a private type, do not - -- inline if the full view is an unconstrained array, because such - -- calls cannot be inlined. - - elsif Present (Orig_Subp) - and then Is_Array_Type (Etype (Orig_Subp)) - and then not Is_Constrained (Etype (Orig_Subp)) - then - Cannot_Inline - ("cannot inline& (unconstrained array)?", Call_Node, Subp); - - else - Expand_Inlined_Call (Call_Node, Subp, Orig_Subp); - end if; - end Do_Inline; - - ---------------------- - -- Do_Inline_Always -- - ---------------------- - - procedure Do_Inline_Always (Subp : Entity_Id; Orig_Subp : Entity_Id) is - Spec : constant Node_Id := Unit_Declaration_Node (Subp); - Body_Id : Entity_Id; - - begin - if No (Spec) - or else Nkind (Spec) /= N_Subprogram_Declaration - or else No (Body_To_Inline (Spec)) - or else Serious_Errors_Detected /= 0 - then - return; - end if; - - Body_Id := Corresponding_Body (Spec); - - -- Verify that the body to inline has already been seen - - if No (Body_Id) - or else not Analyzed (Body_Id) - then - Set_Is_Inlined (Subp, False); - - if Comes_From_Source (Subp) then - - -- Report a warning only if the call is located in the unit of - -- the called subprogram; otherwise it is an error. - - if not In_Same_Extended_Unit (Call_Node, Subp) then - Cannot_Inline - ("cannot inline& (body not seen yet)?", Call_Node, Subp, - Is_Serious => True); - - elsif In_Open_Scopes (Subp) then - - -- For backward compatibility we generate the same error - -- or warning of the previous implementation. This will - -- be changed when we definitely incorporate the new - -- support ??? - - if Front_End_Inlining - and then Optimization_Level = 0 - then - Error_Msg_N - ("call to recursive subprogram cannot be inlined?p?", - N); - - -- Do not emit error compiling runtime packages - - elsif Is_Predefined_File_Name - (Unit_File_Name (Get_Source_Unit (Subp))) - then - Error_Msg_N - ("call to recursive subprogram cannot be inlined??", - N); - - else - Error_Msg_N - ("call to recursive subprogram cannot be inlined", - N); - end if; - - else - Cannot_Inline - ("cannot inline& (body not seen yet)?", Call_Node, Subp); - end if; - end if; - - return; - - -- If this an inherited function that returns a private type, do not - -- inline if the full view is an unconstrained array, because such - -- calls cannot be inlined. - - elsif Present (Orig_Subp) - and then Is_Array_Type (Etype (Orig_Subp)) - and then not Is_Constrained (Etype (Orig_Subp)) - then - Cannot_Inline - ("cannot inline& (unconstrained array)?", Call_Node, Subp); - - -- If the called subprogram comes from an instance in the same - -- unit, and the instance is not yet frozen, inlining might - -- trigger order-of-elaboration problems. - - elsif In_Unfrozen_Instance (Scope (Subp)) then - Cannot_Inline - ("cannot inline& (unfrozen instance)?", Call_Node, Subp); - - else - Expand_Inlined_Call (Call_Node, Subp, Orig_Subp); - end if; - end Do_Inline_Always; - --------------------------- -- Inherited_From_Formal -- --------------------------- @@ -3941,39 +3723,12 @@ package body Exp_Ch6 is Set_Needs_Debug_Info (Subp, False); end if; - -- Frontend expansion of supported functions returning unconstrained - -- types and simple renamings inlined by the frontend (see Freeze. - -- Build_Renamed_Entity). + -- Front end expansion of simple functions returning unconstrained + -- types (see Check_And_Split_Unconstrained_Function) and simple + -- renamings inlined by the front end (see Build_Renamed_Entity). else - declare - Spec : constant Node_Id := Unit_Declaration_Node (Subp); - - begin - if Must_Inline (Subp) then - if In_Extended_Main_Code_Unit (Call_Node) - and then In_Same_Extended_Unit (Sloc (Spec), Loc) - and then not Has_Completion (Subp) - then - Cannot_Inline - ("cannot inline& (body not seen yet)?", - Call_Node, Subp); - - else - Do_Inline_Always (Subp, Orig_Subp); - end if; - - elsif Optimization_Level > 0 then - Do_Inline (Subp, Orig_Subp); - end if; - - -- The call may have been inlined or may have been passed to - -- the backend. No further action needed if it was inlined. - - if Nkind (N) /= N_Function_Call then - return; - end if; - end; + Expand_Inlined_Call (Call_Node, Subp, Orig_Subp); end if; end if; diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb index 8157bf20a25..dc26d21e136 100644 --- a/gcc/ada/inline.adb +++ b/gcc/ada/inline.adb @@ -1225,9 +1225,7 @@ package body Inline is Error_Msg_NE (Msg & "p?", N, Subp); end if; - return; - - -- New semantics + -- New semantics relying on back end inlining elsif Is_Serious then @@ -1242,9 +1240,7 @@ package body Inline is Set_Is_Inlined_Always (Subp, False); Error_Msg_NE (Msg & "p?", N, Subp); - -- Do not issue errors/warnings when compiling with optimizations - - elsif Optimization_Level = 0 then + else -- Do not emit warning if this is a predefined unit which is not -- the main unit. This behavior is currently provided for backward @@ -1281,24 +1277,13 @@ package body Inline is Error_Msg_NE (Msg (Msg'First .. Msg'Last - 1), N, Subp); - else pragma Assert (Front_End_Inlining); + else Set_Is_Inlined (Subp, False); - -- When inlining cannot take place we must issue an error. - -- For backward compatibility we still report a warning. - if Ineffective_Inline_Warnings then Error_Msg_NE (Msg & "p?", N, Subp); end if; end if; - - -- Compiling with optimizations enabled it is too early to report - -- problems since the backend may still perform inlining. In order - -- to report unhandled inlinings the program must be compiled with - -- -Winline and the error is reported by the backend. - - else - null; end if; end Cannot_Inline; @@ -3327,11 +3312,25 @@ package body Inline is D := First (Decls); while Present (D) loop - if Nkind (D) = N_Subprogram_Body then + -- First declarations universally excluded + + if Nkind (D) = N_Package_Declaration then Cannot_Inline - ("cannot inline & (nested subprogram)?", + ("cannot inline & (nested package declaration)?", + D, Subp); + return True; + + elsif Nkind (D) = N_Package_Instantiation then + Cannot_Inline + ("cannot inline & (nested package instantiation)?", D, Subp); return True; + end if; + + -- Then declarations excluded only for front end inlining + + if Back_End_Inlining then + null; elsif Nkind (D) = N_Task_Type_Declaration or else Nkind (D) = N_Single_Task_Declaration @@ -3349,9 +3348,9 @@ package body Inline is D, Subp); return True; - elsif Nkind (D) = N_Package_Declaration then + elsif Nkind (D) = N_Subprogram_Body then Cannot_Inline - ("cannot inline & (nested package declaration)?", + ("cannot inline & (nested subprogram)?", D, Subp); return True; @@ -3368,12 +3367,6 @@ package body Inline is ("cannot inline & (nested procedure instantiation)?", D, Subp); return True; - - elsif Nkind (D) = N_Package_Instantiation then - Cannot_Inline - ("cannot inline & (nested package instantiation)?", - D, Subp); - return True; end if; Next (D); diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb index 24007995df1..b808112e8c9 100644 --- a/gcc/ada/prj-nmsc.adb +++ b/gcc/ada/prj-nmsc.adb @@ -4711,7 +4711,7 @@ package body Prj.Nmsc is then Error_Msg (Data.Flags, - "Library_Standalone valid only if Library_Interface is set", + "Library_Standalone valid only if library has Ada interfaces", Lib_Standalone.Location, Project); end if; diff --git a/gcc/ada/table.adb b/gcc/ada/table.adb index e6367af45a2..97d0410e6dd 100644 --- a/gcc/ada/table.adb +++ b/gcc/ada/table.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2014, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -399,7 +399,7 @@ package body Table is Tree_Read_Data (Tree_Get_Table_Address, (Last_Val - Int (First) + 1) * - Table_Type'Component_Size / Storage_Unit); + (Table_Type'Component_Size / Storage_Unit)); end Tree_Read; ---------------- @@ -415,7 +415,7 @@ package body Table is Tree_Write_Data (Tree_Get_Table_Address, (Last_Val - Int (First) + 1) * - Table_Type'Component_Size / Storage_Unit); + (Table_Type'Component_Size / Storage_Unit)); end Tree_Write; begin -- 2.30.2