Mercurial > hg > CbC > CbC_gcc
diff gcc/ada/inline.adb @ 131:84e7813d76e9
gcc-8.2
| author | mir3636 |
|---|---|
| date | Thu, 25 Oct 2018 07:37:49 +0900 |
| parents | 04ced10e8804 |
| children | 1830386684a0 |
line wrap: on
line diff
--- a/gcc/ada/inline.adb Fri Oct 27 22:46:09 2017 +0900 +++ b/gcc/ada/inline.adb Thu Oct 25 07:37:49 2018 +0900 @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2017, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2018, 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- -- @@ -197,10 +197,10 @@ function Has_Single_Return (N : Node_Id) return Boolean; -- In general we cannot inline functions that return unconstrained type. - -- However, we can handle such functions if all return statements return a - -- local variable that is the only declaration in the body of the function. - -- In that case the call can be replaced by that local variable as is done - -- for other inlined calls. + -- However, we can handle such functions if all return statements return + -- a local variable that is the first declaration in the body of the + -- function. In that case the call can be replaced by that local + -- variable as is done for other inlined calls. function In_Main_Unit_Or_Subunit (E : Entity_Id) return Boolean; -- Return True if E is in the main unit or its spec or in a subunit @@ -298,10 +298,65 @@ -- Inline_Package means that the call is considered for inlining and -- its package compiled and scanned for more inlining opportunities. + function Is_Non_Loading_Expression_Function + (Id : Entity_Id) return Boolean; + -- Determine whether arbitrary entity Id denotes a subprogram which is + -- either + -- + -- * An expression function + -- + -- * A function completed by an expression function where both the + -- spec and body are in the same context. + function Must_Inline return Inline_Level_Type; -- Inlining is only done if the call statement N is in the main unit, -- or within the body of another inlined subprogram. + ---------------------------------------- + -- Is_Non_Loading_Expression_Function -- + ---------------------------------------- + + function Is_Non_Loading_Expression_Function + (Id : Entity_Id) return Boolean + is + Body_Decl : Node_Id; + Body_Id : Entity_Id; + Spec_Decl : Node_Id; + + begin + -- A stand-alone expression function is transformed into a spec-body + -- pair in-place. Since both the spec and body are in the same list, + -- the inlining of such an expression function does not need to load + -- anything extra. + + if Is_Expression_Function (Id) then + return True; + + -- A function may be completed by an expression function + + elsif Ekind (Id) = E_Function then + Spec_Decl := Unit_Declaration_Node (Id); + + if Nkind (Spec_Decl) = N_Subprogram_Declaration then + Body_Id := Corresponding_Body (Spec_Decl); + + if Present (Body_Id) then + Body_Decl := Unit_Declaration_Node (Body_Id); + + -- The inlining of a completing expression function does + -- not need to load anything extra when both the spec and + -- body are in the same context. + + return + Was_Expression_Function (Body_Decl) + and then Parent (Spec_Decl) = Parent (Body_Decl); + end if; + end if; + end if; + + return False; + end Is_Non_Loading_Expression_Function; + ----------------- -- Must_Inline -- ----------------- @@ -415,10 +470,12 @@ Set_Needs_Debug_Info (E, False); end if; - -- If the subprogram is an expression function, then there is no need to - -- load any package body since the body of the function is in the spec. - - if Is_Expression_Function (E) then + -- If the subprogram is an expression function, or is completed by one + -- where both the spec and body are in the same context, then there is + -- no need to load any package body since the body of the function is + -- in the spec. + + if Is_Non_Loading_Expression_Function (E) then Set_Is_Called (E); return; end if; @@ -822,6 +879,10 @@ Body_To_Analyze : Node_Id; Max_Size : constant := 10; + function Has_Extended_Return return Boolean; + -- This function returns True if the subprogram has an extended return + -- statement. + function Has_Pending_Instantiation return Boolean; -- If some enclosing body contains instantiations that appear before -- the corresponding generic body, the enclosing body has a freeze node @@ -839,8 +900,51 @@ function Uses_Secondary_Stack (Bod : Node_Id) return Boolean; -- If the body of the subprogram includes a call that returns an - -- unconstrained type, the secondary stack is involved, and it - -- is not worth inlining. + -- unconstrained type, the secondary stack is involved, and it is + -- not worth inlining. + + ------------------------- + -- Has_Extended_Return -- + ------------------------- + + function Has_Extended_Return return Boolean is + Body_To_Inline : constant Node_Id := N; + + function Check_Return (N : Node_Id) return Traverse_Result; + -- Returns OK on node N if this is not an extended return statement + + ------------------ + -- Check_Return -- + ------------------ + + function Check_Return (N : Node_Id) return Traverse_Result is + begin + case Nkind (N) is + when N_Extended_Return_Statement => + return Abandon; + + -- Skip locally declared subprogram bodies inside the body to + -- inline, as the return statements inside those do not count. + + when N_Subprogram_Body => + if N = Body_To_Inline then + return OK; + else + return Skip; + end if; + + when others => + return OK; + end case; + end Check_Return; + + function Check_All_Returns is new Traverse_Func (Check_Return); + + -- Start of processing for Has_Extended_Return + + begin + return Check_All_Returns (N) /= OK; + end Has_Extended_Return; ------------------------------- -- Has_Pending_Instantiation -- @@ -981,24 +1085,9 @@ Cannot_Inline ("cannot inline & (multiple returns)?", N, Spec_Id); return; - -- Functions that return unconstrained composite types require - -- secondary stack handling, and cannot currently be inlined, unless - -- all return statements return a local variable that is the first - -- local declaration in the body. - - elsif Ekind (Spec_Id) = E_Function - and then not Is_Scalar_Type (Etype (Spec_Id)) - and then not Is_Access_Type (Etype (Spec_Id)) - and then not Is_Constrained (Etype (Spec_Id)) - then - if not Has_Single_Return (N) then - Cannot_Inline - ("cannot inline & (unconstrained return type)?", N, Spec_Id); - return; - end if; - - -- Ditto for functions that return controlled types, where controlled - -- actions interfere in complex ways with inlining. + -- Functions that return controlled types cannot currently be inlined + -- because they require secondary stack handling; controlled actions + -- may also interfere in complex ways with inlining. elsif Ekind (Spec_Id) = E_Function and then Needs_Finalization (Etype (Spec_Id)) @@ -1099,7 +1188,7 @@ Append (Body_To_Analyze, Declarations (N)); end if; - -- The body to inline is pre-analyzed. In GNATprove mode we must disable + -- The body to inline is preanalyzed. In GNATprove mode we must disable -- full analysis as well so that light expansion does not take place -- either, and name resolution is unaffected. @@ -1121,10 +1210,37 @@ Restore_Env; end if; + -- Functions that return unconstrained composite types require + -- secondary stack handling, and cannot currently be inlined, unless + -- all return statements return a local variable that is the first + -- local declaration in the body. We had to delay this check until + -- the body of the function is analyzed since Has_Single_Return() + -- requires a minimum decoration. + + if Ekind (Spec_Id) = E_Function + and then not Is_Scalar_Type (Etype (Spec_Id)) + and then not Is_Access_Type (Etype (Spec_Id)) + and then not Is_Constrained (Etype (Spec_Id)) + then + if not Has_Single_Return (Body_To_Analyze) + + -- Skip inlining if the function returns an unconstrained type + -- using an extended return statement, since this part of the + -- new inlining model is not yet supported by the current + -- implementation. ??? + + or else (Returns_Unconstrained_Type (Spec_Id) + and then Has_Extended_Return) + then + Cannot_Inline + ("cannot inline & (unconstrained return type)?", N, Spec_Id); + return; + end if; + -- If secondary stack is used, there is no point in inlining. We have -- already issued the warning in this case, so nothing to do. - if Uses_Secondary_Stack (Body_To_Analyze) then + elsif Uses_Secondary_Stack (Body_To_Analyze) then return; end if; @@ -1491,13 +1607,16 @@ then null; - -- In GNATprove mode, issue a warning, and indicate that the - -- subprogram is not always inlined by setting flag Is_Inlined_Always - -- to False. + -- In GNATprove mode, issue a warning when -gnatd_f is set, and + -- indicate that the subprogram is not always inlined by setting + -- flag Is_Inlined_Always to False. elsif GNATprove_Mode then Set_Is_Inlined_Always (Subp, False); - Error_Msg_NE (Msg & "p?", N, Subp); + + if Debug_Flag_Underscore_F then + Error_Msg_NE (Msg, N, Subp); + end if; elsif Has_Pragma_Inline_Always (Subp) then @@ -1518,12 +1637,16 @@ Error_Msg_NE (Msg (Msg'First .. Msg'Last - 1), N, Subp); - -- In GNATprove mode, issue a warning, and indicate that the subprogram - -- is not always inlined by setting flag Is_Inlined_Always to False. + -- In GNATprove mode, issue a warning when -gnatd_f is set, and + -- indicate that the subprogram is not always inlined by setting + -- flag Is_Inlined_Always to False. elsif GNATprove_Mode then Set_Is_Inlined_Always (Subp, False); - Error_Msg_NE (Msg & "p?", N, Subp); + + if Debug_Flag_Underscore_F then + Error_Msg_NE (Msg, N, Subp); + end if; else @@ -1612,9 +1735,9 @@ -- rewritten (the analysis of the non-inlined body will handle these -- pragmas). A new internal name is associated with Body_To_Inline. - ----------------------------- - -- Generate_Body_To_Inline -- - ----------------------------- + ------------------------------ + -- Generate_Subprogram_Body -- + ------------------------------ procedure Generate_Subprogram_Body (N : Node_Id; @@ -2212,25 +2335,41 @@ Subp : Entity_Id; Orig_Subp : Entity_Id) is - Loc : constant Source_Ptr := Sloc (N); - Is_Predef : constant Boolean := + Decls : constant List_Id := New_List; + Is_Predef : constant Boolean := Is_Predefined_Unit (Get_Source_Unit (Subp)); - Orig_Bod : constant Node_Id := + Loc : constant Source_Ptr := Sloc (N); + Orig_Bod : constant Node_Id := Body_To_Inline (Unit_Declaration_Node (Subp)); + Uses_Back_End : constant Boolean := + Back_End_Inlining and then Optimization_Level > 0; + -- The back-end expansion is used if the target supports back-end + -- inlining and some level of optimixation is required; otherwise + -- the inlining takes place fully as a tree expansion. + Blk : Node_Id; Decl : Node_Id; - Decls : constant List_Id := New_List; - Exit_Lab : Entity_Id := Empty; + Exit_Lab : Entity_Id := Empty; F : Entity_Id; A : Node_Id; - Lab_Decl : Node_Id; + Lab_Decl : Node_Id := Empty; Lab_Id : Node_Id; New_A : Node_Id; - Num_Ret : Nat := 0; + Num_Ret : Nat := 0; Ret_Type : Entity_Id; - - Targ : Node_Id; + Temp : Entity_Id; + Temp_Typ : Entity_Id; + + Is_Unc : Boolean; + Is_Unc_Decl : Boolean; + -- If the type returned by the function is unconstrained and the call + -- can be inlined, special processing is required. + + Return_Object : Entity_Id := Empty; + -- Entity in declaration in an extended_return_statement + + Targ : Node_Id := Empty; -- The target of the call. If context is an assignment statement then -- this is the left-hand side of the assignment, else it is a temporary -- to which the return value is assigned prior to rewriting the call. @@ -2238,17 +2377,6 @@ Targ1 : Node_Id := Empty; -- A separate target used when the return type is unconstrained - Temp : Entity_Id; - Temp_Typ : Entity_Id; - - Return_Object : Entity_Id := Empty; - -- Entity in declaration in an extended_return_statement - - Is_Unc : Boolean; - Is_Unc_Decl : Boolean; - -- If the type returned by the function is unconstrained and the call - -- can be inlined, special processing is required. - procedure Declare_Postconditions_Result; -- When generating C code, declare _Result, which may be used in the -- inlined _Postconditions procedure to verify the return value. @@ -2425,26 +2553,42 @@ end if; -- Because of the presence of private types, the views of the - -- expression and the context may be different, so place an - -- unchecked conversion to the context type to avoid spurious + -- expression and the context may be different, so place + -- a type conversion to the context type to avoid spurious -- errors, e.g. when the expression is a numeric literal and -- the context is private. If the expression is an aggregate, -- use a qualified expression, because an aggregate is not a - -- legal argument of a conversion. Ditto for numeric literals - -- and attributes that yield a universal type, because those - -- must be resolved to a specific type. - - if Nkind_In (Expression (N), N_Aggregate, N_Null) + -- legal argument of a conversion. Ditto for numeric, character + -- and string literals, and attributes that yield a universal + -- type, because those must be resolved to a specific type. + + if Nkind_In (Expression (N), N_Aggregate, + N_Character_Literal, + N_Null, + N_String_Literal) or else Yields_Universal_Type (Expression (N)) then Ret := Make_Qualified_Expression (Sloc (N), Subtype_Mark => New_Occurrence_Of (Ret_Type, Sloc (N)), Expression => Relocate_Node (Expression (N))); - else + + -- Use an unchecked type conversion between access types, for + -- which a type conversion would not always be valid, as no + -- check may result from the conversion. + + elsif Is_Access_Type (Ret_Type) then Ret := Unchecked_Convert_To (Ret_Type, Relocate_Node (Expression (N))); + + -- Otherwise use a type conversion, which may trigger a check + + else + Ret := + Make_Type_Conversion (Sloc (N), + Subtype_Mark => New_Occurrence_Of (Ret_Type, Sloc (N)), + Expression => Relocate_Node (Expression (N))); end if; if Nkind (Targ) = N_Defining_Identifier then @@ -2767,7 +2911,7 @@ begin -- Initializations for old/new semantics - if not Back_End_Inlining then + if not Uses_Back_End then Is_Unc := Is_Array_Type (Etype (Subp)) and then not Is_Constrained (Etype (Subp)); Is_Unc_Decl := False; @@ -2795,18 +2939,6 @@ elsif Nkind (Orig_Bod) in N_Entity then return; - - -- Skip inlining if the function returns an unconstrained type using - -- an extended return statement since this part of the new inlining - -- model which is not yet supported by the current implementation. ??? - - elsif Is_Unc - and then - Nkind (First (Statements (Handled_Statement_Sequence (Orig_Bod)))) = - N_Extended_Return_Statement - and then not Back_End_Inlining - then - return; end if; if Nkind (Orig_Bod) = N_Defining_Identifier @@ -2841,7 +2973,7 @@ -- Old semantics - if not Back_End_Inlining then + if not Uses_Back_End then declare Bod : Node_Id; @@ -2885,6 +3017,20 @@ begin First_Decl := First (Declarations (Blk)); + -- If the body is a single extended return statement,the + -- resulting block is a nested block. + + if No (First_Decl) then + First_Decl := + First (Statements (Handled_Statement_Sequence (Blk))); + + if Nkind (First_Decl) = N_Block_Statement then + First_Decl := First (Declarations (First_Decl)); + end if; + end if; + + -- No front-end inlining possible + if Nkind (First_Decl) /= N_Object_Declaration then return; end if; @@ -3156,8 +3302,8 @@ and then Ekind (F) /= E_Out_Parameter and then not Same_Type (Etype (F), Etype (A)) then - pragma Assert (not (Is_By_Reference_Type (Etype (A)))); - pragma Assert (not (Is_Limited_Type (Etype (A)))); + pragma Assert (not Is_By_Reference_Type (Etype (A))); + pragma Assert (not Is_Limited_Type (Etype (A))); Append_To (Decls, Make_Object_Declaration (Loc, @@ -3215,7 +3361,7 @@ -- of the result of a call to an inlined function that returns -- an unconstrained type - elsif Back_End_Inlining + elsif Uses_Back_End and then Nkind (Parent (N)) = N_Object_Declaration and then Is_Unc then @@ -3768,25 +3914,31 @@ if Present (Expression (N)) and then Is_Entity_Name (Expression (N)) then + pragma Assert (Present (Entity (Expression (N)))); + if No (Return_Statement) then Return_Statement := N; return OK; - elsif Chars (Expression (N)) = - Chars (Expression (Return_Statement)) - then - return OK; - else - return Abandon; + pragma Assert + (Present (Entity (Expression (Return_Statement)))); + + if Entity (Expression (N)) = + Entity (Expression (Return_Statement)) + then + return OK; + else + return Abandon; + end if; end if; - -- A return statement within an extended return is a noop - -- after inlining. + -- A return statement within an extended return is a noop after + -- inlining. elsif No (Expression (N)) - and then - Nkind (Parent (Parent (N))) = N_Extended_Return_Statement + and then Nkind (Parent (Parent (N))) = + N_Extended_Return_Statement then return OK; @@ -3825,10 +3977,11 @@ return True; else - return Present (Declarations (N)) - and then Present (First (Declarations (N))) - and then Chars (Expression (Return_Statement)) = - Chars (Defining_Identifier (First (Declarations (N)))); + return + Present (Declarations (N)) + and then Present (First (Declarations (N))) + and then Entity (Expression (Return_Statement)) = + Defining_Identifier (First (Declarations (N))); end if; end Has_Single_Return;