diff options
72 files changed, 502 insertions, 1873 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index f190763..6069ea6 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,66 @@ +2014-08-01 Arnaud Charlet <charlet@adacore.com> + + * exp_vfpt.adb, exp_vfpt.ads: Removed, no longer used. + * gcc-interface/Make-lang.in: Remove exp_vfpt.o + +2014-08-01 Javier Miranda <miranda@adacore.com> + + * inline.ads (Inlined_Calls, Backend_Calls, + Backend_Inlined_Subps, Backend_Not_Inlined_Subps): Declarations + moved to inline.adb (Cannot_Inline): Update documentation. + (Check_And_Build_Body_To_Inline): Renamed. + (List_Inlining_Info): Subprogram moved here from package exp_ch6. + * inline.adb (Check_Inlining_Restrictions): New local variable. + (Inlined_Calls, Backend_Calls, Backend_Inlined_Subps, + Backend_Not_Inlined_Subps): Declarations moved here + from inline.ads (Number_Of_Statements): Removed. + (Remove_Pragmas): Avoid duplicated version of this subprogram. + (Build_Body_To_Inline): Code cleanup. + (Build_Body_To_Inline.Has_Excluded_Statament): Removed. + (Check_And_Build_Body_To_Inline): Renamed. Code cleanup. + (Check_Body_To_Inline): Removed. + (Generate_Body_To_Inline): Renamed as Generate_Subprogram_Body. + (Has_Excluded_Declaration): No action if not + Check_Inlining_Restrictions. + (Has_Excluded_Statement): No action if not Check_Inlining_Restrictions. + (Initialize): Initialize the lists of inlined calls and subprograms. + (List_Inlining_Info): Subprogram moved here from package exp_ch6. + * sem_ch6.adb (Analyze_Subprogram_Body_Helper): Update call + to Check_And_Build_Body_To_Inline since it has been renamed as + Check_And_Split_Unconstrained_Function + * exp_ch6.ad[sb] (List_Inlining_Info): Subprogram moved to + package inline. + * gnat1drv.adb Update call to Inline.List_Inlining_Info. + +2014-08-01 Vincent Celier <celier@adacore.com> + + * debug.adb: Add documentation for new debug switch -ds. + * make.adb (List_Bad_Compilations): Do not issue any message + when switch -ds is specified. + * makeutl.adb (Fail_Program): Do not issue any message when + -ds is specified. + (Finish_Program): Ditto. + +2014-08-01 Robert Dewar <dewar@adacore.com> + + * s-exnint.adb, s-exnint.ads, s-wwdwch.ads, s-carsi8.ads, + s-casi32.ads, indepsw.adb, a-timoau.ads, s-explli.adb, s-explli.ads, + s-casi16.ads, s-powtab.ads, g-wistsp.ads, a-ztmoau.adb, + indepsw-gnu.adb, s-imgllb.ads, types.adb, gnat.ads, s-proinf.adb, + indepsw-aix.adb, s-caun64.ads, s-imgllw.ads, s-traces-default.adb, + s-vxwork-x86.ads, s-expllu.adb, s-exnlli.adb, s-exnlli.ads, + s-traces.adb, widechar.ads, stand.adb, s-expint.adb, + s-tratas-default.adb, s-expint.ads, s-geveop.ads, s-caun32.ads, + s-expuns.adb, s-mantis.adb, s-mantis.ads, s-caun16.ads, s-tasinf.adb, + s-memcop.ads, s-dsaser.ads, s-imgbiu.ads, a-szmzco.ads, g-strspl.ads, + s-casi64.ads, g-zstspl.ads, indepsw-mingw.adb, tree_io.adb, + s-boarop.ads, uname.ads, s-fore.adb, s-fore.ads, g-timsta.adb, + g-timsta.ads, s-assert.adb, s-vector.ads, s-tratas.adb, + s-tratas.ads: Minor fix to copyright notices. + +2014-08-01 Eric Botcazou <ebotcazou@adacore.com> + + * sinfo.ads: Remove long obsolete comment. 2014-08-01 Ed Schonberg <schonberg@adacore.com> * sem_util.adb: Add guard to setting of No_Predicate_On_Actual. diff --git a/gcc/ada/a-szmzco.ads b/gcc/ada/a-szmzco.ads index f54746d..6fbb7bf 100644 --- a/gcc/ada/a-szmzco.ads +++ b/gcc/ada/a-szmzco.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2009 Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2014, Free Software Foundation, Inc. -- -- -- -- This specification is derived from the Ada Reference Manual for use with -- -- GNAT. The copyright notice above, and the license provisions that follow -- diff --git a/gcc/ada/a-timoau.ads b/gcc/ada/a-timoau.ads index 200184f..3520b56 100644 --- a/gcc/ada/a-timoau.ads +++ b/gcc/ada/a-timoau.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2009 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- -- diff --git a/gcc/ada/a-ztmoau.adb b/gcc/ada/a-ztmoau.adb index 4ade589..f8d7295 100644 --- a/gcc/ada/a-ztmoau.adb +++ b/gcc/ada/a-ztmoau.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2009 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- -- diff --git a/gcc/ada/debug.adb b/gcc/ada/debug.adb index 94da8ec..de649f4 100644 --- a/gcc/ada/debug.adb +++ b/gcc/ada/debug.adb @@ -214,7 +214,7 @@ package body Debug is -- dp Prints the contents of the Q used by Make.Compile_Sources -- dq Prints source files as they are enqueued and dequeued -- dr - -- ds + -- ds Suppress exit message when compilation fails -- dt Display time stamps when there is a mismatch -- du List units as their ali files are acquired -- dv @@ -801,6 +801,10 @@ package body Debug is -- used by routine Make.Compile_Sources. Useful to figure out the -- order in which sources are recompiled. + -- ds When one or more compilations compilation fail, gnatmake does not + -- issue an error message such as: + -- gnatmake: "/path/to/main.adb" compilation error + -- dt When a time stamp mismatch has been found for an ALI file, -- display the source file name, the time stamp expected and -- the time stamp found. @@ -820,6 +824,10 @@ package body Debug is -- of execution, such as temporary config pragma files, mapping -- files or project path files. + -- ds When one or more compilations compilation fail, gprbuild does not + -- issue the error message: + -- gprbuild: *** compilation phase failed + -- dt When a time stamp mismatch has been found for an ALI file, -- display the source file name, the time stamp expected and -- the time stamp found. diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index c5a8b83..4550986 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -51,7 +51,6 @@ with Namet; use Namet; with Nlists; use Nlists; with Nmake; use Nmake; with Opt; use Opt; -with Output; use Output; with Restrict; use Restrict; with Rident; use Rident; with Rtsfind; use Rtsfind; @@ -69,7 +68,6 @@ with Sem_Res; use Sem_Res; with Sem_SCIL; use Sem_SCIL; with Sem_Util; use Sem_Util; with Sinfo; use Sinfo; -with Sinput; use Sinput; with Snames; use Snames; with Stand; use Stand; with Stringt; use Stringt; @@ -9647,139 +9645,4 @@ package body Exp_Ch6 is end if; end Needs_Result_Accessibility_Level; - ------------------------ - -- List_Inlining_Info -- - ------------------------ - - procedure List_Inlining_Info is - Elmt : Elmt_Id; - Nod : Node_Id; - Count : Nat; - - begin - if not Debug_Flag_Dot_J then - return; - end if; - - -- Generate listing of calls inlined by the frontend - - if Present (Inlined_Calls) then - Count := 0; - Elmt := First_Elmt (Inlined_Calls); - while Present (Elmt) loop - Nod := Node (Elmt); - - if In_Extended_Main_Code_Unit (Nod) then - Count := Count + 1; - - if Count = 1 then - Write_Str ("Listing of frontend inlined calls"); - Write_Eol; - end if; - - Write_Str (" "); - Write_Int (Count); - Write_Str (":"); - Write_Location (Sloc (Nod)); - Write_Str (":"); - Output.Write_Eol; - end if; - - Next_Elmt (Elmt); - end loop; - end if; - - -- Generate listing of calls passed to the backend - - if Present (Backend_Calls) then - Count := 0; - - Elmt := First_Elmt (Backend_Calls); - while Present (Elmt) loop - Nod := Node (Elmt); - - if In_Extended_Main_Code_Unit (Nod) then - Count := Count + 1; - - if Count = 1 then - Write_Str ("Listing of inlined calls passed to the backend"); - Write_Eol; - end if; - - Write_Str (" "); - Write_Int (Count); - Write_Str (":"); - Write_Location (Sloc (Nod)); - Output.Write_Eol; - end if; - - Next_Elmt (Elmt); - end loop; - end if; - - -- Generate listing of subprograms passed to the backend - - if Present (Backend_Inlined_Subps) - and then Back_End_Inlining - then - Count := 0; - - Elmt := First_Elmt (Backend_Inlined_Subps); - while Present (Elmt) loop - Nod := Node (Elmt); - - Count := Count + 1; - - if Count = 1 then - Write_Str - ("Listing of inlined subprograms passed to the backend"); - Write_Eol; - end if; - - Write_Str (" "); - Write_Int (Count); - Write_Str (":"); - Write_Name (Chars (Nod)); - Write_Str (" ("); - Write_Location (Sloc (Nod)); - Write_Str (")"); - Output.Write_Eol; - - Next_Elmt (Elmt); - end loop; - end if; - - -- Generate listing of subprogram that cannot be inlined by the backend - - if Present (Backend_Not_Inlined_Subps) - and then Back_End_Inlining - then - Count := 0; - - Elmt := First_Elmt (Backend_Not_Inlined_Subps); - while Present (Elmt) loop - Nod := Node (Elmt); - - Count := Count + 1; - - if Count = 1 then - Write_Str - ("Listing of subprograms that cannot inline the backend"); - Write_Eol; - end if; - - Write_Str (" "); - Write_Int (Count); - Write_Str (":"); - Write_Name (Chars (Nod)); - Write_Str (" ("); - Write_Location (Sloc (Nod)); - Write_Str (")"); - Output.Write_Eol; - - Next_Elmt (Elmt); - end loop; - end if; - end List_Inlining_Info; - end Exp_Ch6; diff --git a/gcc/ada/exp_ch6.ads b/gcc/ada/exp_ch6.ads index 801a5a2..0c31ea6 100644 --- a/gcc/ada/exp_ch6.ads +++ b/gcc/ada/exp_ch6.ads @@ -139,10 +139,6 @@ package Exp_Ch6 is -- Predicate to recognize stubbed procedures and null procedures, which -- can be inlined unconditionally in all cases. - procedure List_Inlining_Info; - -- Generate listing of calls inlined by the frontend plus listing of - -- calls to inline subprograms passed to the backend. - procedure Make_Build_In_Place_Call_In_Allocator (Allocator : Node_Id; Function_Call : Node_Id); diff --git a/gcc/ada/exp_vfpt.adb b/gcc/ada/exp_vfpt.adb deleted file mode 100644 index 82d2fe1..0000000 --- a/gcc/ada/exp_vfpt.adb +++ /dev/null @@ -1,690 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- E X P _ V F P T -- --- -- --- B o d y -- --- -- --- Copyright (C) 1997-2012, 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- -- --- ware Foundation; either version 3, or (at your option) any later ver- -- --- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- --- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- --- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- --- for more details. You should have received a copy of the GNU General -- --- Public License distributed with GNAT; see file COPYING3. If not, go to -- --- http://www.gnu.org/licenses for a complete copy of the license. -- --- -- --- GNAT was originally developed by the GNAT team at New York University. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - -with Atree; use Atree; -with Einfo; use Einfo; -with Nlists; use Nlists; -with Nmake; use Nmake; -with Rtsfind; use Rtsfind; -with Sem_Res; use Sem_Res; -with Sinfo; use Sinfo; -with Stand; use Stand; -with Tbuild; use Tbuild; -with Urealp; use Urealp; -with Eval_Fat; use Eval_Fat; - -package body Exp_VFpt is - - -- Vax floating point format (from Vax Architecture Reference Manual - -- version 6): - - -- Float F: - -- -------- - - -- 1 1 - -- 5 4 7 6 0 - -- +-+---------------+--------------+ - -- |S| exp | fraction | A - -- +-+---------------+--------------+ - -- | fraction | A + 2 - -- +--------------------------------+ - - -- bit 15 is the sign bit, - -- bits 14:7 is the excess 128 binary exponent, - -- bits 6:0 and 31:16 the normalized 24-bit fraction with the redundant - -- most significant fraction bit not represented. - - -- An exponent value of 0 together with a sign bit of 0, is taken to - -- indicate that the datum has a value of 0. Exponent values of 1 through - -- 255 indicate true binary exponents of -127 to +127. An exponent value - -- of 0, together with a sign bit of 1, is taken as reserved. - - -- Note that fraction bits are not continuous in memory, VAX is little - -- endian (LSB first). - - -- Float D: - -- -------- - - -- 1 1 - -- 5 4 7 6 0 - -- +-+---------------+--------------+ - -- |S| exp | fraction | A - -- +-+---------------+--------------+ - -- | fraction | A + 2 - -- +--------------------------------+ - -- | fraction | A + 4 - -- +--------------------------------+ - -- | fraction (low) | A + 6 - -- +--------------------------------+ - - -- Note that the fraction bits are not continuous in memory. Bytes in a - -- words are stored in little endian format, but words are stored using - -- big endian format (PDP endian). - - -- Like Float F but with 55 bits for the fraction. - - -- Float G: - -- -------- - - -- 1 1 - -- 5 4 4 3 0 - -- +-+---------------------+--------+ - -- |S| exp | fract | A - -- +-+---------------------+--------+ - -- | fraction | A + 2 - -- +--------------------------------+ - -- | fraction | A + 4 - -- +--------------------------------+ - -- | fraction (low) | A + 6 - -- +--------------------------------+ - - -- Exponent values of 1 through 2047 indicate true binary exponents of - -- -1023 to +1023. - - -- Main differences compared to IEEE 754: - - -- * No denormalized numbers - -- * No infinity - -- * No NaN - -- * No -0.0 - -- * Reserved values (exp = 0, sign = 1) - -- * Vax mantissa represent values [0.5, 1) - -- * Bias is shifted by 1 (for single float: 128 on Vax, 127 on IEEE) - - VAXFF_Digits : constant := 6; - VAXDF_Digits : constant := 9; - VAXGF_Digits : constant := 15; - - ---------------------- - -- Expand_Vax_Arith -- - ---------------------- - - procedure Expand_Vax_Arith (N : Node_Id) is - Loc : constant Source_Ptr := Sloc (N); - Typ : constant Entity_Id := Base_Type (Etype (N)); - Typc : Character; - Atyp : Entity_Id; - Func : RE_Id; - Args : List_Id; - - begin - -- Get arithmetic type, note that we do D stuff in G - - if Digits_Value (Typ) = VAXFF_Digits then - Typc := 'F'; - Atyp := RTE (RE_F); - else - Typc := 'G'; - Atyp := RTE (RE_G); - end if; - - case Nkind (N) is - - when N_Op_Abs => - if Typc = 'F' then - Func := RE_Abs_F; - else - Func := RE_Abs_G; - end if; - - when N_Op_Add => - if Typc = 'F' then - Func := RE_Add_F; - else - Func := RE_Add_G; - end if; - - when N_Op_Divide => - if Typc = 'F' then - Func := RE_Div_F; - else - Func := RE_Div_G; - end if; - - when N_Op_Multiply => - if Typc = 'F' then - Func := RE_Mul_F; - else - Func := RE_Mul_G; - end if; - - when N_Op_Minus => - if Typc = 'F' then - Func := RE_Neg_F; - else - Func := RE_Neg_G; - end if; - - when N_Op_Subtract => - if Typc = 'F' then - Func := RE_Sub_F; - else - Func := RE_Sub_G; - end if; - - when others => - Func := RE_Null; - raise Program_Error; - - end case; - - Args := New_List; - - if Nkind (N) in N_Binary_Op then - Append_To (Args, - Convert_To (Atyp, Left_Opnd (N))); - end if; - - Append_To (Args, - Convert_To (Atyp, Right_Opnd (N))); - - Rewrite (N, - Convert_To (Typ, - Make_Function_Call (Loc, - Name => New_Occurrence_Of (RTE (Func), Loc), - Parameter_Associations => Args))); - - Analyze_And_Resolve (N, Typ, Suppress => All_Checks); - end Expand_Vax_Arith; - - --------------------------- - -- Expand_Vax_Comparison -- - --------------------------- - - procedure Expand_Vax_Comparison (N : Node_Id) is - Loc : constant Source_Ptr := Sloc (N); - Typ : constant Entity_Id := Base_Type (Etype (Left_Opnd (N))); - Typc : Character; - Func : RE_Id; - Atyp : Entity_Id; - Revrs : Boolean := False; - Args : List_Id; - - begin - -- Get arithmetic type, note that we do D stuff in G - - if Digits_Value (Typ) = VAXFF_Digits then - Typc := 'F'; - Atyp := RTE (RE_F); - else - Typc := 'G'; - Atyp := RTE (RE_G); - end if; - - case Nkind (N) is - - when N_Op_Eq => - if Typc = 'F' then - Func := RE_Eq_F; - else - Func := RE_Eq_G; - end if; - - when N_Op_Ge => - if Typc = 'F' then - Func := RE_Le_F; - else - Func := RE_Le_G; - end if; - - Revrs := True; - - when N_Op_Gt => - if Typc = 'F' then - Func := RE_Lt_F; - else - Func := RE_Lt_G; - end if; - - Revrs := True; - - when N_Op_Le => - if Typc = 'F' then - Func := RE_Le_F; - else - Func := RE_Le_G; - end if; - - when N_Op_Lt => - if Typc = 'F' then - Func := RE_Lt_F; - else - Func := RE_Lt_G; - end if; - - when N_Op_Ne => - if Typc = 'F' then - Func := RE_Ne_F; - else - Func := RE_Ne_G; - end if; - - when others => - Func := RE_Null; - raise Program_Error; - - end case; - - if not Revrs then - Args := New_List ( - Convert_To (Atyp, Left_Opnd (N)), - Convert_To (Atyp, Right_Opnd (N))); - - else - Args := New_List ( - Convert_To (Atyp, Right_Opnd (N)), - Convert_To (Atyp, Left_Opnd (N))); - end if; - - Rewrite (N, - Make_Function_Call (Loc, - Name => New_Occurrence_Of (RTE (Func), Loc), - Parameter_Associations => Args)); - - Analyze_And_Resolve (N, Standard_Boolean, Suppress => All_Checks); - end Expand_Vax_Comparison; - - --------------------------- - -- Expand_Vax_Conversion -- - --------------------------- - - procedure Expand_Vax_Conversion (N : Node_Id) is - Loc : constant Source_Ptr := Sloc (N); - Expr : constant Node_Id := Expression (N); - S_Typ : constant Entity_Id := Base_Type (Etype (Expr)); - T_Typ : constant Entity_Id := Base_Type (Etype (N)); - - CallS : RE_Id; - CallT : RE_Id; - Func : RE_Id; - - function Call_Type (T : Entity_Id; Otyp : Entity_Id) return RE_Id; - -- Given one of the two types T, determines the corresponding call - -- type, i.e. the type to be used for the call (or the result of - -- the call). The actual operand is converted to (or from) this type. - -- Otyp is the other type, which is useful in figuring out the result. - -- The result returned is the RE_Id value for the type entity. - - function Equivalent_Integer_Type (T : Entity_Id) return Entity_Id; - -- Find the predefined integer type that has the same size as the - -- fixed-point type T, for use in fixed/float conversions. - - --------------- - -- Call_Type -- - --------------- - - function Call_Type (T : Entity_Id; Otyp : Entity_Id) return RE_Id is - begin - -- Vax float formats - - if Vax_Float (T) then - if Digits_Value (T) = VAXFF_Digits then - return RE_F; - - elsif Digits_Value (T) = VAXGF_Digits then - return RE_G; - - -- For D_Float, leave it as D float if the other operand is - -- G_Float, since this is the one conversion that is properly - -- supported for D_Float, but otherwise, use G_Float. - - else pragma Assert (Digits_Value (T) = VAXDF_Digits); - - if Vax_Float (Otyp) - and then Digits_Value (Otyp) = VAXGF_Digits - then - return RE_D; - else - return RE_G; - end if; - end if; - - -- For all discrete types, use 64-bit integer - - elsif Is_Discrete_Type (T) then - return RE_Q; - - -- For all real types (other than Vax float format), we use the - -- IEEE float-type which corresponds in length to the other type - -- (which is Vax Float). - - else pragma Assert (Is_Real_Type (T)); - - if Digits_Value (Otyp) = VAXFF_Digits then - return RE_S; - else - return RE_T; - end if; - end if; - end Call_Type; - - ------------------------------------------------- - -- Expand_Multiply_Fixed_By_Fixed_Giving_Fixed -- - ------------------------------------------------- - - function Equivalent_Integer_Type (T : Entity_Id) return Entity_Id is - begin - if Esize (T) = Esize (Standard_Long_Long_Integer) then - return Standard_Long_Long_Integer; - elsif Esize (T) = Esize (Standard_Long_Integer) then - return Standard_Long_Integer; - else - return Standard_Integer; - end if; - end Equivalent_Integer_Type; - - -- Start of processing for Expand_Vax_Conversion; - - begin - -- If input and output are the same Vax type, we change the - -- conversion to be an unchecked conversion and that's it. - - if Vax_Float (S_Typ) and then Vax_Float (T_Typ) - and then Digits_Value (S_Typ) = Digits_Value (T_Typ) - then - Rewrite (N, - Unchecked_Convert_To (T_Typ, Expr)); - - -- Case of conversion of fixed-point type to Vax_Float type - - elsif Is_Fixed_Point_Type (S_Typ) then - - -- If Conversion_OK set, then we introduce an intermediate IEEE - -- target type since we are expecting the code generator to handle - -- the case of integer to IEEE float. - - if Conversion_OK (N) then - Rewrite (N, - Convert_To (T_Typ, OK_Convert_To (Universal_Real, Expr))); - - -- Otherwise, convert the scaled integer value to the target type, - -- and multiply by 'Small of type. - - else - Rewrite (N, - Make_Op_Multiply (Loc, - Left_Opnd => - Make_Type_Conversion (Loc, - Subtype_Mark => New_Occurrence_Of (T_Typ, Loc), - Expression => - Unchecked_Convert_To ( - Equivalent_Integer_Type (S_Typ), Expr)), - Right_Opnd => - Make_Real_Literal (Loc, Realval => Small_Value (S_Typ)))); - end if; - - -- Case of conversion of Vax_Float type to fixed-point type - - elsif Is_Fixed_Point_Type (T_Typ) then - - -- If Conversion_OK set, then we introduce an intermediate IEEE - -- target type, since we are expecting the code generator to handle - -- the case of IEEE float to integer. - - if Conversion_OK (N) then - Rewrite (N, - OK_Convert_To (T_Typ, Convert_To (Universal_Real, Expr))); - - -- Otherwise, multiply value by 'small of type, and convert to the - -- corresponding integer type. - - else - Rewrite (N, - Unchecked_Convert_To (T_Typ, - Make_Type_Conversion (Loc, - Subtype_Mark => - New_Occurrence_Of (Equivalent_Integer_Type (T_Typ), Loc), - Expression => - Make_Op_Multiply (Loc, - Left_Opnd => Expr, - Right_Opnd => - Make_Real_Literal (Loc, - Realval => Ureal_1 / Small_Value (T_Typ)))))); - end if; - - -- All other cases - - else - -- Compute types for call - - CallS := Call_Type (S_Typ, T_Typ); - CallT := Call_Type (T_Typ, S_Typ); - - -- Get function and its types - - if CallS = RE_D and then CallT = RE_G then - Func := RE_D_To_G; - - elsif CallS = RE_G and then CallT = RE_D then - Func := RE_G_To_D; - - elsif CallS = RE_G and then CallT = RE_F then - Func := RE_G_To_F; - - elsif CallS = RE_F and then CallT = RE_G then - Func := RE_F_To_G; - - elsif CallS = RE_F and then CallT = RE_S then - Func := RE_F_To_S; - - elsif CallS = RE_S and then CallT = RE_F then - Func := RE_S_To_F; - - elsif CallS = RE_G and then CallT = RE_T then - Func := RE_G_To_T; - - elsif CallS = RE_T and then CallT = RE_G then - Func := RE_T_To_G; - - elsif CallS = RE_F and then CallT = RE_Q then - Func := RE_F_To_Q; - - elsif CallS = RE_Q and then CallT = RE_F then - Func := RE_Q_To_F; - - elsif CallS = RE_G and then CallT = RE_Q then - Func := RE_G_To_Q; - - else pragma Assert (CallS = RE_Q and then CallT = RE_G); - Func := RE_Q_To_G; - end if; - - Rewrite (N, - Convert_To (T_Typ, - Make_Function_Call (Loc, - Name => New_Occurrence_Of (RTE (Func), Loc), - Parameter_Associations => New_List ( - Convert_To (RTE (CallS), Expr))))); - end if; - - Analyze_And_Resolve (N, T_Typ, Suppress => All_Checks); - end Expand_Vax_Conversion; - - ------------------------------- - -- Expand_Vax_Foreign_Return -- - ------------------------------- - - procedure Expand_Vax_Foreign_Return (N : Node_Id) is - Loc : constant Source_Ptr := Sloc (N); - Typ : constant Entity_Id := Base_Type (Etype (N)); - Func : RE_Id; - Args : List_Id; - Atyp : Entity_Id; - Rtyp : constant Entity_Id := Etype (N); - - begin - if Digits_Value (Typ) = VAXFF_Digits then - Func := RE_Return_F; - Atyp := RTE (RE_F); - elsif Digits_Value (Typ) = VAXDF_Digits then - Func := RE_Return_D; - Atyp := RTE (RE_D); - else pragma Assert (Digits_Value (Typ) = VAXGF_Digits); - Func := RE_Return_G; - Atyp := RTE (RE_G); - end if; - - Args := New_List (Convert_To (Atyp, N)); - - Rewrite (N, - Convert_To (Rtyp, - Make_Function_Call (Loc, - Name => New_Occurrence_Of (RTE (Func), Loc), - Parameter_Associations => Args))); - - Analyze_And_Resolve (N, Typ, Suppress => All_Checks); - end Expand_Vax_Foreign_Return; - - -------------------------------- - -- Vax_Real_Literal_As_Signed -- - -------------------------------- - - function Get_Vax_Real_Literal_As_Signed (N : Node_Id) return Uint is - Btyp : constant Entity_Id := - Base_Type (Underlying_Type (Etype (N))); - - Value : constant Ureal := Realval (N); - Negative : Boolean; - Fraction : UI; - Exponent : UI; - Res : UI; - - Exponent_Size : Uint; - -- Number of bits for the exponent - - Fraction_Size : Uint; - -- Number of bits for the fraction - - Uintp_Mark : constant Uintp.Save_Mark := Mark; - -- Use the mark & release feature to delete temporaries - begin - -- Extract the sign now - - Negative := UR_Is_Negative (Value); - - -- Decompose the number - - Decompose_Int (Btyp, abs Value, Fraction, Exponent, Round_Even); - - -- Number of bits for the fraction, leading fraction bit is implicit - - Fraction_Size := Machine_Mantissa_Value (Btyp) - Int'(1); - - -- Number of bits for the exponent (one bit for the sign) - - Exponent_Size := RM_Size (Btyp) - Fraction_Size - Int'(1); - - if Fraction = Uint_0 then - -- Handle zero - - Res := Uint_0; - - elsif Exponent <= -(Uint_2 ** (Exponent_Size - 1)) then - -- Underflow - - Res := Uint_0; - else - -- Check for overflow - - pragma Assert (Exponent < Uint_2 ** (Exponent_Size - 1)); - - -- MSB of the fraction must be 1 - - pragma Assert (Fraction / Uint_2 ** Fraction_Size = Uint_1); - - -- Remove the redudant most significant fraction bit - - Fraction := Fraction - Uint_2 ** Fraction_Size; - - -- Build the fraction part. Note that this field is in mixed - -- endianness: words are stored using little endianness, while bytes - -- in words are stored using big endianness. - - Res := Uint_0; - for I in 1 .. UI_To_Int (RM_Size (Btyp)) / 16 loop - Res := (Res * (Uint_2 ** 16)) + (Fraction mod (Uint_2 ** 16)); - Fraction := Fraction / (Uint_2 ** 16); - end loop; - - -- The sign bit - - if Negative then - Res := Res + Int (2**15); - end if; - - -- The exponent - - Res := Res + (Exponent + Uint_2 ** (Exponent_Size - 1)) - * Uint_2 ** (15 - Exponent_Size); - - -- Until now, we have created an unsigned number, but an underlying - -- type is a signed type. Convert to a signed number to avoid - -- overflow in gigi. - - if Res >= Uint_2 ** (Exponent_Size + Fraction_Size) then - Res := Res - Uint_2 ** (Exponent_Size + Fraction_Size + 1); - end if; - end if; - - Release_And_Save (Uintp_Mark, Res); - - return Res; - end Get_Vax_Real_Literal_As_Signed; - - ---------------------- - -- Expand_Vax_Valid -- - ---------------------- - - procedure Expand_Vax_Valid (N : Node_Id) is - Loc : constant Source_Ptr := Sloc (N); - Pref : constant Node_Id := Prefix (N); - Ptyp : constant Entity_Id := Root_Type (Etype (Pref)); - Rtyp : constant Entity_Id := Etype (N); - Vtyp : RE_Id; - Func : RE_Id; - - begin - if Digits_Value (Ptyp) = VAXFF_Digits then - Func := RE_Valid_F; - Vtyp := RE_F; - elsif Digits_Value (Ptyp) = VAXDF_Digits then - Func := RE_Valid_D; - Vtyp := RE_D; - else pragma Assert (Digits_Value (Ptyp) = VAXGF_Digits); - Func := RE_Valid_G; - Vtyp := RE_G; - end if; - - Rewrite (N, - Convert_To (Rtyp, - Make_Function_Call (Loc, - Name => New_Occurrence_Of (RTE (Func), Loc), - Parameter_Associations => New_List ( - Convert_To (RTE (Vtyp), Pref))))); - - Analyze_And_Resolve (N); - end Expand_Vax_Valid; - -end Exp_VFpt; diff --git a/gcc/ada/exp_vfpt.ads b/gcc/ada/exp_vfpt.ads deleted file mode 100644 index db01866..0000000 --- a/gcc/ada/exp_vfpt.ads +++ /dev/null @@ -1,67 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- E X P _ V F P T -- --- -- --- S p e c -- --- -- --- Copyright (C) 1992-2012, 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- -- --- ware Foundation; either version 3, or (at your option) any later ver- -- --- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- --- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- --- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- --- for more details. You should have received a copy of the GNU General -- --- Public License distributed with GNAT; see file COPYING3. If not, go to -- --- http://www.gnu.org/licenses for a complete copy of the license. -- --- -- --- GNAT was originally developed by the GNAT team at New York University. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - --- This package contains specialized routines for handling the expansion --- of arithmetic and conversion operations involving Vax format floating- --- point formats as used on the Vax and the Alpha and the ia64. - -with Types; use Types; -with Uintp; use Uintp; - -package Exp_VFpt is - - procedure Expand_Vax_Arith (N : Node_Id); - -- The node N is an arithmetic node (N_Op_Abs, N_Op_Add, N_Op_Sub, - -- N_Op_Div, N_Op_Mul, N_Op_Minus where the operands are in Vax float - -- format. This procedure expands the necessary call. - - procedure Expand_Vax_Comparison (N : Node_Id); - -- The node N is an arithmetic comparison node where the types to be - -- compared are in Vax float format. This procedure expands the necessary - -- call. - - procedure Expand_Vax_Conversion (N : Node_Id); - -- The node N is a type conversion node where either the source or the - -- target type, or both, are Vax floating-point type. - - procedure Expand_Vax_Foreign_Return (N : Node_Id); - -- The node N is a call to a foreign function that returns a Vax float - -- value in a floating point register. Wraps the call in an asm stub - -- that moves the return value to an integer location on Alpha/VMS, - -- noop everywhere else. - - function Get_Vax_Real_Literal_As_Signed (N : Node_Id) return Uint; - -- Get the Vax binary representation of a real literal whose type is a Vax - -- floating-point type. This is used by gigi. Previously we expanded real - -- literal to a call to a LIB$OTS routine that performed the conversion. - -- This worked correctly from a funcional point of view, but was - -- inefficient and generated huge functions for aggregate initializations. - - procedure Expand_Vax_Valid (N : Node_Id); - -- The node N is an attribute reference node for the Valid attribute where - -- the prefix is of a Vax floating-point type. This procedure expands the - -- necessary call for the validity test. - -end Exp_VFpt; diff --git a/gcc/ada/g-strspl.ads b/gcc/ada/g-strspl.ads index 746ab83..31851b3 100644 --- a/gcc/ada/g-strspl.ads +++ b/gcc/ada/g-strspl.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2002-2009 Free Software Foundation, Inc. -- +-- Copyright (C) 2002-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- -- diff --git a/gcc/ada/g-timsta.adb b/gcc/ada/g-timsta.adb index f188b68..50d4f70 100644 --- a/gcc/ada/g-timsta.adb +++ b/gcc/ada/g-timsta.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2008-2009 Free Software Foundation, Inc. -- +-- Copyright (C) 2008-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- -- diff --git a/gcc/ada/g-timsta.ads b/gcc/ada/g-timsta.ads index 094ccb5..8f35e7b 100644 --- a/gcc/ada/g-timsta.ads +++ b/gcc/ada/g-timsta.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2008-2009 Free Software Foundation, Inc. -- +-- Copyright (C) 2008-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- -- diff --git a/gcc/ada/g-wistsp.ads b/gcc/ada/g-wistsp.ads index 7fceb17..39f19a6 100644 --- a/gcc/ada/g-wistsp.ads +++ b/gcc/ada/g-wistsp.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2002-2009 Free Software Foundation, Inc. -- +-- Copyright (C) 2002-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- -- diff --git a/gcc/ada/g-zstspl.ads b/gcc/ada/g-zstspl.ads index f3af568..de87324 100644 --- a/gcc/ada/g-zstspl.ads +++ b/gcc/ada/g-zstspl.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2002-2009 Free Software Foundation, Inc. -- +-- Copyright (C) 2002-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- -- diff --git a/gcc/ada/gcc-interface/Make-lang.in b/gcc/ada/gcc-interface/Make-lang.in index 321c0d6..11a97b4 100644 --- a/gcc/ada/gcc-interface/Make-lang.in +++ b/gcc/ada/gcc-interface/Make-lang.in @@ -281,7 +281,6 @@ GNAT_ADA_OBJS = \ ada/exp_strm.o \ ada/exp_tss.o \ ada/exp_util.o \ - ada/exp_vfpt.o \ ada/expander.o \ ada/fmap.o \ ada/fname-uf.o \ diff --git a/gcc/ada/gnat.ads b/gcc/ada/gnat.ads index cfdfdc8..a0807b6 100644 --- a/gcc/ada/gnat.ads +++ b/gcc/ada/gnat.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2005 AdaCore -- +-- Copyright (C) 1992-2014, AdaCore -- -- -- -- 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- -- diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb index a816f4e..2eb9d98 100644 --- a/gcc/ada/gnat1drv.adb +++ b/gcc/ada/gnat1drv.adb @@ -32,7 +32,6 @@ with Debug; use Debug; with Elists; with Errout; use Errout; with Exp_CG; -with Exp_Ch6; use Exp_Ch6; with Fmap; with Fname; use Fname; with Fname.UF; use Fname.UF; @@ -1276,7 +1275,7 @@ begin Errout.Finalize (Last_Call => True); Errout.Output_Messages; List_Rep_Info (Ttypes.Bytes_Big_Endian); - List_Inlining_Info; + Inline.List_Inlining_Info; -- Only write the library if the backend did not generate any error -- messages. Otherwise signal errors to the driver program so that diff --git a/gcc/ada/indepsw-aix.adb b/gcc/ada/indepsw-aix.adb index 8eaa382..61bb54c 100644 --- a/gcc/ada/indepsw-aix.adb +++ b/gcc/ada/indepsw-aix.adb @@ -7,7 +7,7 @@ -- B o d y -- -- (AIX version) -- -- -- --- Copyright (C) 2009 Free Software Foundation, Inc. -- +-- Copyright (C) 2009-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- -- diff --git a/gcc/ada/indepsw-gnu.adb b/gcc/ada/indepsw-gnu.adb index c81270e..145f6a2 100644 --- a/gcc/ada/indepsw-gnu.adb +++ b/gcc/ada/indepsw-gnu.adb @@ -7,7 +7,7 @@ -- B o d y -- -- (GNU version) -- -- -- --- Copyright (C) 2009, Free Software Foundation, Inc. -- +-- Copyright (C) 2009-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- -- diff --git a/gcc/ada/indepsw-mingw.adb b/gcc/ada/indepsw-mingw.adb index 7632cf7..819652d 100644 --- a/gcc/ada/indepsw-mingw.adb +++ b/gcc/ada/indepsw-mingw.adb @@ -7,7 +7,7 @@ -- B o d y -- -- (Windows version) -- -- -- --- Copyright (C) 2009 Free Software Foundation, Inc. -- +-- Copyright (C) 2009-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- -- diff --git a/gcc/ada/indepsw.adb b/gcc/ada/indepsw.adb index 8439075..6313675 100644 --- a/gcc/ada/indepsw.adb +++ b/gcc/ada/indepsw.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2009 Free Software Foundation, Inc. -- +-- Copyright (C) 2009-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- -- diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb index b133cc4..04ca7ca 100644 --- a/gcc/ada/inline.adb +++ b/gcc/ada/inline.adb @@ -24,6 +24,7 @@ ------------------------------------------------------------------------------ with Atree; use Atree; +with Debug; use Debug; with Einfo; use Einfo; with Elists; use Elists; with Errout; use Errout; @@ -38,11 +39,11 @@ with Lib; use Lib; with Namet; use Namet; with Nmake; use Nmake; with Nlists; use Nlists; +with Output; use Output; with Sem_Aux; use Sem_Aux; with Sem_Ch8; use Sem_Ch8; with Sem_Ch10; use Sem_Ch10; with Sem_Ch12; use Sem_Ch12; -with Sem_Eval; use Sem_Eval; with Sem_Prag; use Sem_Prag; with Sem_Util; use Sem_Util; with Sinfo; use Sinfo; @@ -50,11 +51,42 @@ with Sinput; use Sinput; with Snames; use Snames; with Stand; use Stand; with Uname; use Uname; -with Targparm; use Targparm; with Tbuild; use Tbuild; package body Inline is + Check_Inlining_Restrictions : constant Boolean := True; + -- In the following cases the frontend rejects inlining because they + -- are not handled well by the backend. This variable facilitates + -- disabling these restrictions to evaluate future versions of the + -- GCC backend in which some of the restrictions may be supported. + -- + -- - subprograms that have: + -- - nested subprograms + -- - instantiations + -- - package declarations + -- - task or protected object declarations + -- - some of the following statements: + -- - abort + -- - asynchronous-select + -- - conditional-entry-call + -- - delay-relative + -- - delay-until + -- - selective-accept + -- - timed-entry-call + + Inlined_Calls : Elist_Id; + -- List of frontend inlined calls + + Backend_Calls : Elist_Id; + -- List of inline calls passed to the backend + + Backend_Inlined_Subps : Elist_Id; + -- List of subprograms inlined by the backend + + Backend_Not_Inlined_Subps : Elist_Id; + -- List of subprograms that cannot be inlined by the backend + -------------------- -- Inlined Bodies -- -------------------- @@ -180,8 +212,11 @@ package body Inline is -- function anyway. This is also the case if the function is defined in a -- task body or within an entry (for example, an initialization procedure). - function Number_Of_Statements (Stats : List_Id) return Natural; - -- Return the number of statements in the list + procedure Remove_Pragmas (Bod : Node_Id); + -- A pragma Unreferenced or pragma Unmodified that mentions a formal + -- parameter has no meaning when the body is inlined and the formals + -- are rewritten. Remove it from body to inline. The analysis of the + -- non-inlined body will handle the pragma properly. ------------------------------ -- Deferred Cleanup Actions -- @@ -889,18 +924,12 @@ package body Inline is -- Build_Body_To_Inline -- -------------------------- - procedure Build_Body_To_Inline (N : Node_Id; Subp : Entity_Id) is - Decl : constant Node_Id := Unit_Declaration_Node (Subp); + procedure Build_Body_To_Inline (N : Node_Id; Spec_Id : Entity_Id) is + Decl : constant Node_Id := Unit_Declaration_Node (Spec_Id); Analysis_Status : constant Boolean := Full_Analysis; Original_Body : Node_Id; Body_To_Analyze : Node_Id; Max_Size : constant := 10; - Stat_Count : Integer := 0; - - function Has_Excluded_Statement (Stats : List_Id) return Boolean; - -- Check for statements that make inlining not worthwhile: any tasking - -- statement, nested at any level. Keep track of total number of - -- elementary statements, as a measure of acceptable size. function Has_Pending_Instantiation return Boolean; -- If some enclosing body contains instantiations that appear before @@ -911,116 +940,14 @@ package body Inline is function Has_Single_Return_In_GNATprove_Mode return Boolean; -- This function is called only in GNATprove mode, and it returns - -- True if the subprogram has no or a single return statement as - -- last statement. - - procedure Remove_Pragmas; - -- A pragma Unreferenced or pragma Unmodified that mentions a formal - -- parameter has no meaning when the body is inlined and the formals - -- are rewritten. Remove it from body to inline. The analysis of the - -- non-inlined body will handle the pragma properly. + -- True if the subprogram has no return statement or a single return + -- statement as last statement. 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. - ---------------------------- - -- Has_Excluded_Statement -- - ---------------------------- - - function Has_Excluded_Statement (Stats : List_Id) return Boolean is - S : Node_Id; - E : Node_Id; - - begin - S := First (Stats); - while Present (S) loop - Stat_Count := Stat_Count + 1; - - if Nkind_In (S, N_Abort_Statement, - N_Asynchronous_Select, - N_Conditional_Entry_Call, - N_Delay_Relative_Statement, - N_Delay_Until_Statement, - N_Selective_Accept, - N_Timed_Entry_Call) - then - Cannot_Inline - ("cannot inline & (non-allowed statement)?", S, Subp); - return True; - - elsif Nkind (S) = N_Block_Statement then - if Present (Declarations (S)) - and then Has_Excluded_Declaration (Subp, Declarations (S)) - then - return True; - - elsif Present (Handled_Statement_Sequence (S)) - and then - (Present - (Exception_Handlers (Handled_Statement_Sequence (S))) - or else - Has_Excluded_Statement - (Statements (Handled_Statement_Sequence (S)))) - then - return True; - end if; - - elsif Nkind (S) = N_Case_Statement then - E := First (Alternatives (S)); - while Present (E) loop - if Has_Excluded_Statement (Statements (E)) then - return True; - end if; - - Next (E); - end loop; - - elsif Nkind (S) = N_If_Statement then - if Has_Excluded_Statement (Then_Statements (S)) then - return True; - end if; - - if Present (Elsif_Parts (S)) then - E := First (Elsif_Parts (S)); - while Present (E) loop - if Has_Excluded_Statement (Then_Statements (E)) then - return True; - end if; - - Next (E); - end loop; - end if; - - if Present (Else_Statements (S)) - and then Has_Excluded_Statement (Else_Statements (S)) - then - return True; - end if; - - elsif Nkind (S) = N_Loop_Statement - and then Has_Excluded_Statement (Statements (S)) - then - return True; - - elsif Nkind (S) = N_Extended_Return_Statement then - if Has_Excluded_Statement - (Statements (Handled_Statement_Sequence (S))) - or else - Present - (Exception_Handlers (Handled_Statement_Sequence (S))) - then - return True; - end if; - end if; - - Next (S); - end loop; - - return False; - end Has_Excluded_Statement; - ------------------------------- -- Has_Pending_Instantiation -- ------------------------------- @@ -1099,30 +1026,6 @@ package body Inline is return Check_All_Returns (N) = OK; end Has_Single_Return_In_GNATprove_Mode; - -------------------- - -- Remove_Pragmas -- - -------------------- - - procedure Remove_Pragmas is - Decl : Node_Id; - Nxt : Node_Id; - - begin - Decl := First (Declarations (Body_To_Analyze)); - while Present (Decl) loop - Nxt := Next (Decl); - - if Nkind (Decl) = N_Pragma - and then Nam_In (Pragma_Name (Decl), Name_Unreferenced, - Name_Unmodified) - then - Remove (Decl); - end if; - - Decl := Nxt; - end loop; - end Remove_Pragmas; - -------------------------- -- Uses_Secondary_Stack -- -------------------------- @@ -1144,7 +1047,7 @@ package body Inline is then Cannot_Inline ("cannot inline & (call returns unconstrained type)?", - N, Subp); + N, Spec_Id); return Abandon; else return OK; @@ -1174,7 +1077,7 @@ package body Inline is elsif GNATprove_Mode and then not Has_Single_Return_In_GNATprove_Mode then - Cannot_Inline ("cannot inline & (multiple returns)?", N, Subp); + Cannot_Inline ("cannot inline & (multiple returns)?", N, Spec_Id); return; -- Functions that return unconstrained composite types require @@ -1182,30 +1085,30 @@ package body Inline is -- all return statements return a local variable that is the first -- local declaration in the body. - elsif Ekind (Subp) = E_Function - and then not Is_Scalar_Type (Etype (Subp)) - and then not Is_Access_Type (Etype (Subp)) - and then not Is_Constrained (Etype (Subp)) + 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, Subp); + ("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. - elsif Ekind (Subp) = E_Function - and then Needs_Finalization (Etype (Subp)) + elsif Ekind (Spec_Id) = E_Function + and then Needs_Finalization (Etype (Spec_Id)) then Cannot_Inline - ("cannot inline & (controlled return type)?", N, Subp); + ("cannot inline & (controlled return type)?", N, Spec_Id); return; end if; if Present (Declarations (N)) - and then Has_Excluded_Declaration (Subp, Declarations (N)) + and then Has_Excluded_Declaration (Spec_Id, Declarations (N)) then return; end if; @@ -1215,11 +1118,11 @@ package body Inline is Cannot_Inline ("cannot inline& (exception handler)?", First (Exception_Handlers (Handled_Statement_Sequence (N))), - Subp); + Spec_Id); return; - elsif - Has_Excluded_Statement (Statements (Handled_Statement_Sequence (N))) + elsif Has_Excluded_Statement + (Spec_Id, Statements (Handled_Statement_Sequence (N))) then return; end if; @@ -1230,17 +1133,18 @@ package body Inline is -- suppress the other checks on inlining (forbidden declarations, -- handlers, etc). - if Stat_Count > Max_Size - and then not (Has_Pragma_Inline_Always (Subp) or else GNATprove_Mode) + if not (Has_Pragma_Inline_Always (Spec_Id) or else GNATprove_Mode) + and then List_Length + (Statements (Handled_Statement_Sequence (N))) > Max_Size then - Cannot_Inline ("cannot inline& (body too large)?", N, Subp); + Cannot_Inline ("cannot inline& (body too large)?", N, Spec_Id); return; end if; if Has_Pending_Instantiation then Cannot_Inline ("cannot inline& (forward instance within enclosing body)?", - N, Subp); + N, Spec_Id); return; end if; @@ -1277,9 +1181,9 @@ package body Inline is -- Set return type of function, which is also global and does not need -- to be resolved. - if Ekind (Subp) = E_Function then + if Ekind (Spec_Id) = E_Function then Set_Result_Definition (Specification (Body_To_Analyze), - New_Occurrence_Of (Etype (Subp), Sloc (N))); + New_Occurrence_Of (Etype (Spec_Id), Sloc (N))); end if; if No (Declarations (N)) then @@ -1294,7 +1198,7 @@ package body Inline is Expander_Mode_Save_And_Set (False); Full_Analysis := False; - Remove_Pragmas; + Remove_Pragmas (Body_To_Analyze); Analyze (Body_To_Analyze); Push_Scope (Defining_Entity (Body_To_Analyze)); @@ -1319,8 +1223,8 @@ package body Inline is end if; Set_Body_To_Inline (Decl, Original_Body); - Set_Ekind (Defining_Entity (Original_Body), Ekind (Subp)); - Set_Is_Inlined (Subp); + Set_Ekind (Defining_Entity (Original_Body), Ekind (Spec_Id)); + Set_Is_Inlined (Spec_Id); end Build_Body_To_Inline; ------------------- @@ -1357,7 +1261,7 @@ package body Inline is pragma Assert (Msg (Msg'Last) = '?'); - -- Old semantics + -- Legacy front end inlining model if not Back_End_Inlining then @@ -1643,11 +1547,11 @@ package body Inline is end if; end Can_Be_Inlined_In_GNATprove_Mode; - ------------------------------------ - -- Check_And_Build_Body_To_Inline -- - ------------------------------------ + -------------------------------------------- + -- Check_And_Split_Unconstrained_Function -- + -------------------------------------------- - procedure Check_And_Build_Body_To_Inline + procedure Check_And_Split_Unconstrained_Function (N : Node_Id; Spec_Id : Entity_Id; Body_Id : Entity_Id) @@ -1661,47 +1565,7 @@ package body Inline is -- body N has no local declarations and its unique statement is a single -- extended return statement with a handled statements sequence. - function Check_Body_To_Inline - (N : Node_Id; - Subp : Entity_Id) return Boolean; - -- N is the N_Subprogram_Body of Subp. Return true if Subp can be - -- inlined by the frontend. These are the rules: - -- * At -O0 use fe inlining when inline_always is specified except if - -- the function returns a controlled type. - -- * At other optimization levels use the fe inlining for both inline - -- and inline_always in the following cases: - -- - function returning a known at compile time constant - -- - function returning a call to an intrinsic function - -- - function returning an unconstrained type (see Can_Split - -- Unconstrained_Function). - -- - function returning a call to a frontend-inlined function - -- Use the back-end mechanism otherwise - -- - -- In addition, in the following cases the function cannot be inlined by - -- the frontend: - -- - functions that uses the secondary stack - -- - functions that have declarations of: - -- - Concurrent types - -- - Packages - -- - Instantiations - -- - Subprograms - -- - functions that have some of the following statements: - -- - abort - -- - asynchronous-select - -- - conditional-entry-call - -- - delay-relative - -- - delay-until - -- - selective-accept - -- - timed-entry-call - -- - functions that have exception handlers - -- - functions that have some enclosing body containing instantiations - -- that appear before the corresponding generic body. - -- - functions that have some of the following contracts (and the - -- sources are compiled with assertions enabled): - -- - Pre/post condition - -- - Contract cases - - procedure Generate_Body_To_Inline + procedure Generate_Subprogram_Body (N : Node_Id; Body_To_Inline : out Node_Id); -- Generate a parameterless duplicate of subprogram body N. Occurrences @@ -1750,7 +1614,7 @@ package body Inline is -- inline, we nest it within a dummy parameterless subprogram, -- declared within the real one. - Generate_Body_To_Inline (N, Original_Body); + Generate_Subprogram_Body (N, Original_Body); Body_To_Analyze := Copy_Generic_Node (Original_Body, Empty, False); -- Set return type of function, which is also global and does not @@ -1787,568 +1651,6 @@ package body Inline is Set_Ekind (Defining_Entity (Original_Body), Ekind (Spec_Id)); end Build_Body_To_Inline; - -------------------------- - -- Check_Body_To_Inline -- - -------------------------- - - function Check_Body_To_Inline - (N : Node_Id; - Subp : Entity_Id) return Boolean - is - Max_Size : constant := 10; - - function Has_Excluded_Contract return Boolean; - -- Check for contracts that cannot be inlined - - function Has_Pending_Instantiation return Boolean; - -- Return True if some enclosing body contains instantiations that - -- appear before the corresponding generic body. - - function Has_Single_Return_In_GNATprove_Mode return Boolean; - -- This function is called only in GNATprove mode, and it returns - -- True if the subprogram has no return statement or a single return - -- statement as last statement. - - function Returns_Compile_Time_Constant (N : Node_Id) return Boolean; - -- Return True if all the return statements of the function body N - -- are simple return statements and return a compile time constant - - function Returns_Intrinsic_Function_Call (N : Node_Id) return Boolean; - -- Return True if all the return statements of the function body N - -- are simple return statements and return an intrinsic function call - - function Uses_Secondary_Stack (N : 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. - - --------------------------- - -- Has_Excluded_Contract -- - --------------------------- - - function Has_Excluded_Contract return Boolean is - function Check_Excluded_Contracts (E : Entity_Id) return Boolean; - -- Return True if the subprogram E has unsupported contracts - - ------------------------------ - -- Check_Excluded_Contracts -- - ------------------------------ - - function Check_Excluded_Contracts (E : Entity_Id) return Boolean is - Items : constant Node_Id := Contract (E); - - begin - if Present (Items) then - if Present (Pre_Post_Conditions (Items)) - or else Present (Contract_Test_Cases (Items)) - then - Cannot_Inline - ("cannot inline & (non-allowed contract)?", - N, Subp); - return True; - end if; - end if; - - return False; - end Check_Excluded_Contracts; - - -- Local declarations - - Decl : Node_Id; - P_Id : Pragma_Id; - - -- Start of processing for Has_Excluded_Contract - - begin - if Check_Excluded_Contracts (Spec_Id) - or else Check_Excluded_Contracts (Body_Id) - then - return True; - end if; - - -- Check pragmas located in the body which may generate contracts - - if Present (Declarations (N)) then - Decl := First (Declarations (N)); - while Present (Decl) loop - if Nkind (Decl) = N_Pragma then - P_Id := Get_Pragma_Id (Pragma_Name (Decl)); - - if P_Id = Pragma_Contract_Cases or else - P_Id = Pragma_Pre or else - P_Id = Pragma_Precondition or else - P_Id = Pragma_Post or else - P_Id = Pragma_Postcondition - then - Cannot_Inline - ("cannot inline & (non-allowed contract)?", - N, Subp); - return True; - end if; - end if; - - Next (Decl); - end loop; - end if; - - return False; - end Has_Excluded_Contract; - - ------------------------------- - -- Has_Pending_Instantiation -- - ------------------------------- - - function Has_Pending_Instantiation return Boolean is - S : Entity_Id; - - begin - S := Current_Scope; - while Present (S) loop - if Is_Compilation_Unit (S) or else Is_Child_Unit (S) then - return False; - - elsif Ekind (S) = E_Package - and then Has_Forward_Instantiation (S) - then - return True; - end if; - - S := Scope (S); - end loop; - - return False; - end Has_Pending_Instantiation; - - ----------------------------------------- - -- Has_Single_Return_In_GNATprove_Mode -- - ----------------------------------------- - - function Has_Single_Return_In_GNATprove_Mode return Boolean is - Last_Statement : Node_Id := Empty; - - function Check_Return (N : Node_Id) return Traverse_Result; - -- Returns OK on node N if this is not a return statement - -- different from the last statement in the subprogram. - - ------------------ - -- Check_Return -- - ------------------ - - function Check_Return (N : Node_Id) return Traverse_Result is - begin - if Nkind_In (N, N_Simple_Return_Statement, - N_Extended_Return_Statement) - then - if N = Last_Statement then - return OK; - else - return Abandon; - end if; - - else - return OK; - end if; - end Check_Return; - - function Check_All_Returns is new Traverse_Func (Check_Return); - - -- Start of processing for Has_Single_Return_In_GNATprove_Mode - - begin - -- Retrieve last statement inside possible block statements - - Last_Statement := - Last (Statements (Handled_Statement_Sequence (N))); - - while Nkind (Last_Statement) = N_Block_Statement loop - Last_Statement := Last - (Statements (Handled_Statement_Sequence (Last_Statement))); - end loop; - - -- Check that the last statement is the only possible return - -- statement in the subprogram. - - return Check_All_Returns (N) = OK; - end Has_Single_Return_In_GNATprove_Mode; - - ------------------------------------ - -- Returns_Compile_Time_Constant -- - ------------------------------------ - - function Returns_Compile_Time_Constant (N : Node_Id) return Boolean is - - function Check_Return (N : Node_Id) return Traverse_Result; - - ------------------ - -- Check_Return -- - ------------------ - - function Check_Return (N : Node_Id) return Traverse_Result is - begin - if Nkind (N) = N_Extended_Return_Statement then - return Abandon; - - elsif Nkind (N) = N_Simple_Return_Statement then - if Present (Expression (N)) then - declare - Orig_Expr : constant Node_Id := - Original_Node (Expression (N)); - - begin - if Nkind_In (Orig_Expr, N_Integer_Literal, - N_Real_Literal, - N_Character_Literal) - then - return OK; - - elsif Is_Entity_Name (Orig_Expr) - and then Ekind (Entity (Orig_Expr)) = E_Constant - and then Is_OK_Static_Expression (Orig_Expr) - then - return OK; - else - return Abandon; - end if; - end; - - -- Expression has wrong form - - else - return Abandon; - end if; - - -- Continue analyzing statements - - else - return OK; - end if; - end Check_Return; - - function Check_All_Returns is new Traverse_Func (Check_Return); - - -- Start of processing for Returns_Compile_Time_Constant - - begin - return Check_All_Returns (N) = OK; - end Returns_Compile_Time_Constant; - - -------------------------------------- - -- Returns_Intrinsic_Function_Call -- - -------------------------------------- - - function Returns_Intrinsic_Function_Call - (N : Node_Id) return Boolean - is - function Check_Return (N : Node_Id) return Traverse_Result; - - ------------------ - -- Check_Return -- - ------------------ - - function Check_Return (N : Node_Id) return Traverse_Result is - begin - if Nkind (N) = N_Extended_Return_Statement then - return Abandon; - - elsif Nkind (N) = N_Simple_Return_Statement then - if Present (Expression (N)) then - declare - Orig_Expr : constant Node_Id := - Original_Node (Expression (N)); - - begin - if Nkind (Orig_Expr) in N_Op - and then Is_Intrinsic_Subprogram (Entity (Orig_Expr)) - then - return OK; - - elsif Nkind (Orig_Expr) in N_Has_Entity - and then Present (Entity (Orig_Expr)) - and then Ekind (Entity (Orig_Expr)) = E_Function - and then Is_Inlined (Entity (Orig_Expr)) - then - return OK; - - elsif Nkind (Orig_Expr) in N_Has_Entity - and then Present (Entity (Orig_Expr)) - and then Is_Intrinsic_Subprogram (Entity (Orig_Expr)) - then - return OK; - - else - return Abandon; - end if; - end; - - -- Expression has wrong form - - else - return Abandon; - end if; - - -- Continue analyzing statements - - else - return OK; - end if; - end Check_Return; - - function Check_All_Returns is new Traverse_Func (Check_Return); - - -- Start of processing for Returns_Intrinsic_Function_Call - - begin - return Check_All_Returns (N) = OK; - end Returns_Intrinsic_Function_Call; - - -------------------------- - -- Uses_Secondary_Stack -- - -------------------------- - - function Uses_Secondary_Stack (N : Node_Id) return Boolean is - - function Check_Call (N : Node_Id) return Traverse_Result; - -- Look for function calls that return an unconstrained type - - ---------------- - -- Check_Call -- - ---------------- - - function Check_Call (N : Node_Id) return Traverse_Result is - begin - if Nkind (N) = N_Function_Call - and then Is_Entity_Name (Name (N)) - and then Is_Composite_Type (Etype (Entity (Name (N)))) - and then not Is_Constrained (Etype (Entity (Name (N)))) - then - Cannot_Inline - ("cannot inline & (call returns unconstrained type)?", - N, Subp); - - return Abandon; - else - return OK; - end if; - end Check_Call; - - function Check_Calls is new Traverse_Func (Check_Call); - - -- Start of processing for Uses_Secondary_Stack - - begin - return Check_Calls (N) = Abandon; - end Uses_Secondary_Stack; - - -- Local variables - - Decl : constant Node_Id := Unit_Declaration_Node (Spec_Id); - May_Inline : constant Boolean := - GNATprove_Mode - or else Has_Pragma_Inline_Always (Spec_Id) - or else (Has_Pragma_Inline (Spec_Id) - and then ((Optimization_Level > 0 - and then Ekind (Spec_Id) = - E_Function) - or else Front_End_Inlining - or else Back_End_Inlining)); - - Body_To_Analyze : Node_Id; - - -- Start of processing for Check_Body_To_Inline - - begin - -- No action needed in stubs since the attribute Body_To_Inline - -- is not available - - if Nkind (Decl) = N_Subprogram_Body_Stub then - return False; - - -- Cannot build the body to inline if the attribute is already set. - -- This attribute may have been set if this is a subprogram renaming - -- declarations (see Freeze.Build_Renamed_Body). - - elsif Present (Body_To_Inline (Decl)) then - return False; - - -- Cannot build the body to inline if the subprogram has unsupported - -- contracts that will be expanded into code (if assertions are not - -- enabled these pragmas will be removed by Generate_Body_To_Inline - -- to avoid reporting spurious errors). - - elsif Assertions_Enabled - and then Has_Excluded_Contract - and then not Back_End_Inlining - then - return False; - - -- Subprograms that have return statements in the middle of the - -- body are inlined with gotos. GNATprove does not currently - -- support gotos, so we prevent such inlining. - - elsif GNATprove_Mode - and then not Has_Single_Return_In_GNATprove_Mode - then - Cannot_Inline ("cannot inline & (multiple returns)?", N, Subp); - return False; - - -- No action needed if the subprogram does not fulfill the minimum - -- conditions to be inlined by the frontend - - elsif not May_Inline then - return False; - end if; - - -- Check excluded declarations - - if Present (Declarations (N)) - and then Has_Excluded_Declaration (Subp, Declarations (N)) - then - return False; - end if; - - -- Check excluded statements - - if Present (Handled_Statement_Sequence (N)) then - if Present - (Exception_Handlers (Handled_Statement_Sequence (N))) - then - Cannot_Inline - ("cannot inline& (exception handler)?", - First (Exception_Handlers (Handled_Statement_Sequence (N))), - Subp); - return False; - - elsif Has_Excluded_Statement - (Subp, Statements (Handled_Statement_Sequence (N))) - then - return False; - end if; - end if; - - -- For backward compatibility, compiling under -gnatN we do not - -- inline a subprogram that is too large, unless it is marked - -- Inline_Always. This pragma does not suppress the other checks - -- on inlining (forbidden declarations, handlers, etc). - - if Front_End_Inlining - and then - not (Has_Pragma_Inline_Always (Subp) or else GNATprove_Mode) - and then Number_Of_Statements - (Statements (Handled_Statement_Sequence (N))) > Max_Size - then - Cannot_Inline ("cannot inline& (body too large)?", N, Subp); - return False; - end if; - - -- If some enclosing body contains instantiations that appear before - -- the corresponding generic body, the enclosing body has a freeze - -- node so that it can be elaborated after the generic itself. This - -- might conflict with subsequent inlinings, so that it is unsafe to - -- try to inline in such a case. - - if Has_Pending_Instantiation then - Cannot_Inline - ("cannot inline& (forward instance within enclosing body)?", - N, Subp); - return False; - end if; - - -- Generate and preanalyze the body to inline (needed to perform - -- the rest of the checks) - - Generate_Body_To_Inline (N, Body_To_Analyze); - - if Ekind (Subp) = E_Function then - Set_Result_Definition (Specification (Body_To_Analyze), - New_Occurrence_Of (Etype (Subp), Sloc (N))); - end if; - - -- Nest the body to analyze within the real one - - if No (Declarations (N)) then - Set_Declarations (N, New_List (Body_To_Analyze)); - else - Append_To (Declarations (N), Body_To_Analyze); - end if; - - Preanalyze (Body_To_Analyze); - Remove (Body_To_Analyze); - - -- Keep separate checks needed when compiling without optimizations - - if Optimization_Level = 0 - - -- AAMP and VM targets have no support for inlining in the backend - -- and hence we use frontend inlining at all optimization levels. - - or else AAMP_On_Target - or else VM_Target /= No_VM - then - -- Cannot inline functions whose body has a call that returns an - -- unconstrained type since the secondary stack is involved, and - -- it is not worth inlining. - - if Uses_Secondary_Stack (Body_To_Analyze) then - return False; - - -- Cannot inline functions that return controlled types since - -- controlled actions interfere in complex ways with inlining. - - elsif Ekind (Subp) = E_Function - and then Needs_Finalization (Etype (Subp)) - then - Cannot_Inline - ("cannot inline & (controlled return type)?", N, Subp); - return False; - - elsif Returns_Unconstrained_Type (Subp) then - - if Back_End_Inlining - and then Can_Split_Unconstrained_Function (N) - then - return True; - - elsif Has_Single_Return (N) then - return True; - - -- Otherwise the secondary stack is involved, and it is not - -- worth inlining. - - else - Cannot_Inline - ("cannot inline & (unconstrained return type)?", N, Subp); - end if; - - return False; - end if; - - -- Compiling with optimizations enabled - - else - -- Procedures are never frontend inlined in this case - - if Ekind (Subp) /= E_Function then - return False; - - -- Functions returning unconstrained types are tested - -- separately (see Can_Split_Unconstrained_Function). - - elsif Returns_Unconstrained_Type (Subp) then - return True; - - -- Check supported cases - - elsif not Returns_Compile_Time_Constant (Body_To_Analyze) - and then Convention (Subp) /= Convention_Intrinsic - and then not Returns_Intrinsic_Function_Call (Body_To_Analyze) - then - return False; - end if; - end if; - - return True; - end Check_Body_To_Inline; - -------------------------------------- -- Can_Split_Unconstrained_Function -- -------------------------------------- @@ -2391,44 +1693,10 @@ package body Inline is -- Generate_Body_To_Inline -- ----------------------------- - procedure Generate_Body_To_Inline + procedure Generate_Subprogram_Body (N : Node_Id; Body_To_Inline : out Node_Id) is - procedure Remove_Pragmas (N : Node_Id); - -- Remove occurrences of pragmas that may reference the formals of - -- N. The analysis of the non-inlined body will handle these pragmas - -- properly. - - -------------------- - -- Remove_Pragmas -- - -------------------- - - procedure Remove_Pragmas (N : Node_Id) is - Decl : Node_Id; - Nxt : Node_Id; - - begin - Decl := First (Declarations (N)); - while Present (Decl) loop - Nxt := Next (Decl); - - if Nkind (Decl) = N_Pragma - and then Nam_In (Pragma_Name (Decl), Name_Contract_Cases, - Name_Precondition, - Name_Postcondition, - Name_Unreferenced, - Name_Unmodified) - then - Remove (Decl); - end if; - - Decl := Nxt; - end loop; - end Remove_Pragmas; - - -- Start of processing for Generate_Body_To_Inline - begin -- Within an instance, the body to inline must be treated as a nested -- generic, so that the proper global references are preserved. @@ -2467,7 +1735,7 @@ package body Inline is Set_Defining_Unit_Name (Specification (Body_To_Inline), Make_Defining_Identifier (Sloc (N), New_Internal_Name ('P'))); Set_Corresponding_Spec (Body_To_Inline, Empty); - end Generate_Body_To_Inline; + end Generate_Subprogram_Body; ---------------------------------- -- Split_Unconstrained_Function -- @@ -2673,9 +1941,31 @@ package body Inline is Rewrite (Ret_Node, Blk_Stmt); end Split_Unconstrained_Function; - -- Start of processing for Check_And_Build_Body_To_Inline + -- Local variables + + Decl : constant Node_Id := Unit_Declaration_Node (Spec_Id); + + -- Start of processing for Check_And_Split_Unconstrained_Function begin + pragma Assert (Back_End_Inlining + and then Ekind (Spec_Id) = E_Function + and then Returns_Unconstrained_Type (Spec_Id) + and then Comes_From_Source (Body_Id) + and then (Has_Pragma_Inline_Always (Spec_Id) + or else Optimization_Level > 0)); + + -- This routine must not be used in GNATprove mode since GNATprove + -- relies on frontend inlining + + pragma Assert (not GNATprove_Mode); + + -- No need to split the function if we cannot generate the code + + if Serious_Errors_Detected /= 0 then + return; + end if; + -- Do not inline any subprogram that contains nested subprograms, -- since the backend inlining circuit seems to generate uninitialized -- references in this case. We know this happens in the case of front @@ -2690,60 +1980,68 @@ package body Inline is -- error cases, this code blows up, and we don't need it anyway if -- there have been errors, since we won't get to the linker anyway. - if Comes_From_Source (Body_Id) - and then (Has_Pragma_Inline_Always (Spec_Id) - or else Optimization_Level > 0) - and then Serious_Errors_Detected = 0 - then - declare - P_Ent : Node_Id; + declare + P_Ent : Node_Id; - begin - P_Ent := Body_Id; - loop - P_Ent := Scope (P_Ent); - exit when No (P_Ent) or else P_Ent = Standard_Standard; + begin + P_Ent := Body_Id; + loop + P_Ent := Scope (P_Ent); + exit when No (P_Ent) or else P_Ent = Standard_Standard; - if Is_Subprogram (P_Ent) then - Set_Is_Inlined (P_Ent, False); + if Is_Subprogram (P_Ent) then + Set_Is_Inlined (P_Ent, False); - -- In GNATprove mode, issue a warning, and indicate that - -- the subprogram is not always inlined by setting flag - -- Is_Inlined_Always to False. + if Comes_From_Source (P_Ent) + and then (Has_Pragma_Inline (P_Ent)) + then + Cannot_Inline + ("cannot inline& (nested subprogram)?", N, P_Ent, + Is_Serious => True); + return; + end if; + end if; + end loop; + end; - if GNATprove_Mode then - Set_Is_Inlined_Always (P_Ent, False); - end if; + -- No action needed in stubs since the attribute Body_To_Inline + -- is not available - if Comes_From_Source (P_Ent) - and then (Has_Pragma_Inline (P_Ent) or else GNATprove_Mode) - then - Cannot_Inline - ("cannot inline& (nested subprogram)?", N, P_Ent, - Is_Serious => True); - end if; - end if; - end loop; - end; + if Nkind (Decl) = N_Subprogram_Body_Stub then + return; + + -- Cannot build the body to inline if the attribute is already set. + -- This attribute may have been set if this is a subprogram renaming + -- declarations (see Freeze.Build_Renamed_Body). + + elsif Present (Body_To_Inline (Decl)) then + return; + + -- Check excluded declarations + + elsif Present (Declarations (N)) + and then Has_Excluded_Declaration (Spec_Id, Declarations (N)) + then + return; + + -- Check excluded statements. There is no need to protect us against + -- exception handlers since they are supported by the GCC backend. + + elsif Present (Handled_Statement_Sequence (N)) + and then Has_Excluded_Statement + (Spec_Id, Statements (Handled_Statement_Sequence (N))) + then + return; end if; -- Build the body to inline only if really needed - if Check_Body_To_Inline (N, Spec_Id) - and then Serious_Errors_Detected = 0 - then - if Returns_Unconstrained_Type (Spec_Id) then - if Can_Split_Unconstrained_Function (N) then - Split_Unconstrained_Function (N, Spec_Id); - Build_Body_To_Inline (N, Spec_Id); - Set_Is_Inlined (Spec_Id); - end if; - elsif not Back_End_Inlining then - Build_Body_To_Inline (N, Spec_Id); - Set_Is_Inlined (Spec_Id); - end if; + if Can_Split_Unconstrained_Function (N) then + Split_Unconstrained_Function (N, Spec_Id); + Build_Body_To_Inline (N, Spec_Id); + Set_Is_Inlined (Spec_Id); end if; - end Check_And_Build_Body_To_Inline; + end Check_And_Split_Unconstrained_Function; ------------------------------------- -- Check_Package_Body_For_Inlining -- @@ -4130,6 +3428,12 @@ package body Inline is -- Start of processing for Has_Excluded_Declaration begin + -- No action needed if the check is not needed + + if not Check_Inlining_Restrictions then + return False; + end if; + D := First (Decls); while Present (D) loop if Nkind (D) = N_Subprogram_Body then @@ -4199,6 +3503,12 @@ package body Inline is E : Node_Id; begin + -- No action needed if the check is not needed + + if not Check_Inlining_Restrictions then + return False; + end if; + S := First (Stats); while Present (S) loop if Nkind_In (S, N_Abort_Statement, @@ -4220,8 +3530,10 @@ package body Inline is return True; elsif Present (Handled_Statement_Sequence (S)) then - if Present - (Exception_Handlers (Handled_Statement_Sequence (S))) + if not Back_End_Inlining + and then + Present + (Exception_Handlers (Handled_Statement_Sequence (S))) then Cannot_Inline ("cannot inline& (exception handler)?", @@ -4282,7 +3594,8 @@ package body Inline is then return True; - elsif Present (Handled_Statement_Sequence (S)) + elsif not Back_End_Inlining + and then Present (Handled_Statement_Sequence (S)) and then Present (Exception_Handlers (Handled_Statement_Sequence (S))) @@ -4449,6 +3762,11 @@ package body Inline is for J in Hash_Headers'Range loop Hash_Headers (J) := No_Subp; end loop; + + Inlined_Calls := No_Elist; + Backend_Calls := No_Elist; + Backend_Inlined_Subps := No_Elist; + Backend_Not_Inlined_Subps := No_Elist; end Initialize; ------------------------ @@ -4552,6 +3870,141 @@ package body Inline is return False; end Is_Nested; + ------------------------ + -- List_Inlining_Info -- + ------------------------ + + procedure List_Inlining_Info is + Elmt : Elmt_Id; + Nod : Node_Id; + Count : Nat; + + begin + if not Debug_Flag_Dot_J then + return; + end if; + + -- Generate listing of calls inlined by the frontend + + if Present (Inlined_Calls) then + Count := 0; + Elmt := First_Elmt (Inlined_Calls); + while Present (Elmt) loop + Nod := Node (Elmt); + + if In_Extended_Main_Code_Unit (Nod) then + Count := Count + 1; + + if Count = 1 then + Write_Str ("Listing of frontend inlined calls"); + Write_Eol; + end if; + + Write_Str (" "); + Write_Int (Count); + Write_Str (":"); + Write_Location (Sloc (Nod)); + Write_Str (":"); + Output.Write_Eol; + end if; + + Next_Elmt (Elmt); + end loop; + end if; + + -- Generate listing of calls passed to the backend + + if Present (Backend_Calls) then + Count := 0; + + Elmt := First_Elmt (Backend_Calls); + while Present (Elmt) loop + Nod := Node (Elmt); + + if In_Extended_Main_Code_Unit (Nod) then + Count := Count + 1; + + if Count = 1 then + Write_Str ("Listing of inlined calls passed to the backend"); + Write_Eol; + end if; + + Write_Str (" "); + Write_Int (Count); + Write_Str (":"); + Write_Location (Sloc (Nod)); + Output.Write_Eol; + end if; + + Next_Elmt (Elmt); + end loop; + end if; + + -- Generate listing of subprograms passed to the backend + + if Present (Backend_Inlined_Subps) + and then Back_End_Inlining + then + Count := 0; + + Elmt := First_Elmt (Backend_Inlined_Subps); + while Present (Elmt) loop + Nod := Node (Elmt); + + Count := Count + 1; + + if Count = 1 then + Write_Str + ("Listing of inlined subprograms passed to the backend"); + Write_Eol; + end if; + + Write_Str (" "); + Write_Int (Count); + Write_Str (":"); + Write_Name (Chars (Nod)); + Write_Str (" ("); + Write_Location (Sloc (Nod)); + Write_Str (")"); + Output.Write_Eol; + + Next_Elmt (Elmt); + end loop; + end if; + + -- Generate listing of subprogram that cannot be inlined by the backend + + if Present (Backend_Not_Inlined_Subps) + and then Back_End_Inlining + then + Count := 0; + + Elmt := First_Elmt (Backend_Not_Inlined_Subps); + while Present (Elmt) loop + Nod := Node (Elmt); + + Count := Count + 1; + + if Count = 1 then + Write_Str + ("Listing of subprograms that cannot inline the backend"); + Write_Eol; + end if; + + Write_Str (" "); + Write_Int (Count); + Write_Str (":"); + Write_Name (Chars (Nod)); + Write_Str (" ("); + Write_Location (Sloc (Nod)); + Write_Str (")"); + Output.Write_Eol; + + Next_Elmt (Elmt); + end loop; + end if; + end List_Inlining_Info; + ---------- -- Lock -- ---------- @@ -4568,26 +4021,6 @@ package body Inline is Inlined.Release; end Lock; - -------------------------- - -- Number_Of_Statements -- - -------------------------- - - -- Why not List_Length??? - - function Number_Of_Statements (Stats : List_Id) return Natural is - Stat_Count : Integer := 0; - Stmt : Node_Id; - - begin - Stmt := First (Stats); - while Present (Stmt) loop - Stat_Count := Stat_Count + 1; - Next (Stmt); - end loop; - - return Stat_Count; - end Number_Of_Statements; - --------------------------- -- Register_Backend_Call -- --------------------------- @@ -4620,4 +4053,31 @@ package body Inline is end loop; end Remove_Dead_Instance; + -------------------- + -- Remove_Pragmas -- + -------------------- + + procedure Remove_Pragmas (Bod : Node_Id) is + Decl : Node_Id; + Nxt : Node_Id; + + begin + Decl := First (Declarations (Bod)); + while Present (Decl) loop + Nxt := Next (Decl); + + if Nkind (Decl) = N_Pragma + and then Nam_In (Pragma_Name (Decl), Name_Contract_Cases, + Name_Precondition, + Name_Postcondition, + Name_Unreferenced, + Name_Unmodified) + then + Remove (Decl); + end if; + + Decl := Nxt; + end loop; + end Remove_Pragmas; + end Inline; diff --git a/gcc/ada/inline.ads b/gcc/ada/inline.ads index edab783..632cbc2 100644 --- a/gcc/ada/inline.ads +++ b/gcc/ada/inline.ads @@ -134,18 +134,6 @@ package Inline is -- The following should be initialized in an init call in Frontend, we -- have thoughts of making the frontend reusable in future ??? - Inlined_Calls : Elist_Id := No_Elist; - -- List of frontend inlined calls - - Backend_Calls : Elist_Id := No_Elist; - -- List of inline calls passed to the backend - - Backend_Inlined_Subps : Elist_Id := No_Elist; - -- List of subprograms inlined by the backend - - Backend_Not_Inlined_Subps : Elist_Id := No_Elist; - -- List of subprograms that cannot be inlined by the backend - ----------------- -- Subprograms -- ----------------- @@ -171,7 +159,7 @@ package Inline is -- At end of compilation, analyze the bodies of all units that contain -- inlined subprograms that are actually called. - procedure Build_Body_To_Inline (N : Node_Id; Subp : Entity_Id); + procedure Build_Body_To_Inline (N : Node_Id; Spec_Id : Entity_Id); -- If a subprogram has pragma Inline and inlining is active, use generic -- machinery to build an unexpanded body for the subprogram. This body is -- subsequently used for inline expansions at call sites. If subprogram can @@ -189,16 +177,17 @@ package Inline is -- This procedure is called if the node N, an instance of a call to -- subprogram Subp, cannot be inlined. Msg is the message to be issued, -- which ends with ? (it does not end with ?p?, this routine takes care of - -- the need to change ? to ?p?). Temporarily the behavior of this routine - -- depends on the value of -gnatd.k: + -- the need to change ? to ?p?). The behavior of this routine depends on + -- the value of Back_End_Inlining: -- - -- * If -gnatd.k is not set (ie. old inlining model) then if Subp has - -- a pragma Always_Inlined, then an error message is issued (by - -- removing the last character of Msg). If Subp is not Always_Inlined, - -- then a warning is issued if the flag Ineffective_Inline_Warnings - -- is set, adding ?p to the msg, and if not, the call has no effect. + -- * If Back_End_Inlining is not set (ie. legacy frontend inlining model) + -- then if Subp has a pragma Always_Inlined, then an error message is + -- issued (by removing the last character of Msg). If Subp is not + -- Always_Inlined, then a warning is issued if the flag Ineffective_ + -- Inline_Warnings is set, adding ?p to the msg, and if not, the call + -- has no effect. -- - -- * If -gnatd.k is set (ie. new inlining model) then: + -- * If Back_End_Inlining is set then: -- - If Is_Serious is true, then an error is reported (by removing the -- last character of Msg); -- @@ -214,7 +203,7 @@ package Inline is -- flag Ineffective_Inline_Warnings is set (adding p?); otherwise -- no effect since inlining may be performed by the backend. - procedure Check_And_Build_Body_To_Inline + procedure Check_And_Split_Unconstrained_Function (N : Node_Id; Spec_Id : Entity_Id; Body_Id : Entity_Id); @@ -254,6 +243,10 @@ package Inline is -- Check a list of statements, Stats, that make inlining of Subp not -- worthwhile, including any tasking statement, nested at any level. + procedure List_Inlining_Info; + -- Generate listing of calls inlined by the frontend plus listing of + -- calls to inline subprograms passed to the backend. + procedure Register_Backend_Call (N : Node_Id); -- Append N to the list Backend_Calls diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb index c194bc7..808ad00 100644 --- a/gcc/ada/make.adb +++ b/gcc/ada/make.adb @@ -6948,15 +6948,17 @@ package body Make is procedure List_Bad_Compilations is begin - for J in Bad_Compilation.First .. Bad_Compilation.Last loop - if Bad_Compilation.Table (J).File = No_File then - null; - elsif not Bad_Compilation.Table (J).Found then - Inform (Bad_Compilation.Table (J).File, "not found"); - else - Inform (Bad_Compilation.Table (J).File, "compilation error"); - end if; - end loop; + if not Debug.Debug_Flag_S then + for J in Bad_Compilation.First .. Bad_Compilation.Last loop + if Bad_Compilation.Table (J).File = No_File then + null; + elsif not Bad_Compilation.Table (J).Found then + Inform (Bad_Compilation.Table (J).File, "not found"); + else + Inform (Bad_Compilation.Table (J).File, "compilation error"); + end if; + end loop; + end if; end List_Bad_Compilations; ----------------- diff --git a/gcc/ada/makeutl.adb b/gcc/ada/makeutl.adb index 7d4b762..a988c6a 100644 --- a/gcc/ada/makeutl.adb +++ b/gcc/ada/makeutl.adb @@ -777,7 +777,7 @@ package body Makeutl is Flush_Messages : Boolean := True) is begin - if Flush_Messages then + if Flush_Messages and then not Debug.Debug_Flag_S then if Total_Errors_Detected /= 0 or else Warnings_Detected /= 0 then Errutil.Finalize; end if; @@ -806,8 +806,13 @@ package body Makeutl is if S'Length > 0 then if Exit_Code /= E_Success then - Osint.Fail (S); - else + if Debug.Debug_Flag_S then + Osint.Exit_Program (E_Fatal); + else + Osint.Fail (S); + end if; + + elsif not Debug.Debug_Flag_S then Write_Str (S); end if; end if; diff --git a/gcc/ada/s-assert.adb b/gcc/ada/s-assert.adb index 92bb96f..3828cc1 100644 --- a/gcc/ada/s-assert.adb +++ b/gcc/ada/s-assert.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2013, 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- -- diff --git a/gcc/ada/s-boarop.ads b/gcc/ada/s-boarop.ads index c321995..bc8b4a6 100644 --- a/gcc/ada/s-boarop.ads +++ b/gcc/ada/s-boarop.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2002-2009 Free Software Foundation, Inc. -- +-- Copyright (C) 2002-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- -- diff --git a/gcc/ada/s-carsi8.ads b/gcc/ada/s-carsi8.ads index 995cd20..c12ff1e 100644 --- a/gcc/ada/s-carsi8.ads +++ b/gcc/ada/s-carsi8.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2002-2009 Free Software Foundation, Inc. -- +-- Copyright (C) 2002-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- -- diff --git a/gcc/ada/s-casi16.ads b/gcc/ada/s-casi16.ads index e9bfe92..b970b7b 100644 --- a/gcc/ada/s-casi16.ads +++ b/gcc/ada/s-casi16.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2002-2009 Free Software Foundation, Inc. -- +-- Copyright (C) 2002-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- -- diff --git a/gcc/ada/s-casi32.ads b/gcc/ada/s-casi32.ads index b5af1bc..8c3a208 100644 --- a/gcc/ada/s-casi32.ads +++ b/gcc/ada/s-casi32.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2002-2009 Free Software Foundation, Inc. -- +-- Copyright (C) 2002-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- -- diff --git a/gcc/ada/s-casi64.ads b/gcc/ada/s-casi64.ads index e276a56..e8a28bd 100644 --- a/gcc/ada/s-casi64.ads +++ b/gcc/ada/s-casi64.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2002-2009 Free Software Foundation, Inc. -- +-- Copyright (C) 2002-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- -- diff --git a/gcc/ada/s-caun16.ads b/gcc/ada/s-caun16.ads index c152dc4..31c0e09 100644 --- a/gcc/ada/s-caun16.ads +++ b/gcc/ada/s-caun16.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2002-2009 Free Software Foundation, Inc. -- +-- Copyright (C) 2002-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- -- diff --git a/gcc/ada/s-caun32.ads b/gcc/ada/s-caun32.ads index a2f9b56..61ff421 100644 --- a/gcc/ada/s-caun32.ads +++ b/gcc/ada/s-caun32.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2002-2009 Free Software Foundation, Inc. -- +-- Copyright (C) 2002-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- -- diff --git a/gcc/ada/s-caun64.ads b/gcc/ada/s-caun64.ads index fe0d0e81..c225516 100644 --- a/gcc/ada/s-caun64.ads +++ b/gcc/ada/s-caun64.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2002-2009 Free Software Foundation, Inc. -- +-- Copyright (C) 2002-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- -- diff --git a/gcc/ada/s-dsaser.ads b/gcc/ada/s-dsaser.ads index ff9c147..c87e384 100644 --- a/gcc/ada/s-dsaser.ads +++ b/gcc/ada/s-dsaser.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2006-2009 Free Software Foundation, Inc. -- +-- Copyright (C) 2006-2014, Free Software Foundation, Inc. -- -- -- -- GNARL 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- -- diff --git a/gcc/ada/s-exnint.adb b/gcc/ada/s-exnint.adb index bce8fd6..5b4f967 100644 --- a/gcc/ada/s-exnint.adb +++ b/gcc/ada/s-exnint.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2009 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- -- diff --git a/gcc/ada/s-exnint.ads b/gcc/ada/s-exnint.ads index fde7af6..79773e8 100644 --- a/gcc/ada/s-exnint.ads +++ b/gcc/ada/s-exnint.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2009 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- -- diff --git a/gcc/ada/s-exnlli.adb b/gcc/ada/s-exnlli.adb index f060ee3..e89c12b 100644 --- a/gcc/ada/s-exnlli.adb +++ b/gcc/ada/s-exnlli.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2009 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- -- diff --git a/gcc/ada/s-exnlli.ads b/gcc/ada/s-exnlli.ads index 5713bbc..0c733f8 100644 --- a/gcc/ada/s-exnlli.ads +++ b/gcc/ada/s-exnlli.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2009 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- -- diff --git a/gcc/ada/s-expint.adb b/gcc/ada/s-expint.adb index 58b82eb..0e90705 100644 --- a/gcc/ada/s-expint.adb +++ b/gcc/ada/s-expint.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2009 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- -- diff --git a/gcc/ada/s-expint.ads b/gcc/ada/s-expint.ads index d0d1cf8..6b41670 100644 --- a/gcc/ada/s-expint.ads +++ b/gcc/ada/s-expint.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2009 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- -- diff --git a/gcc/ada/s-explli.adb b/gcc/ada/s-explli.adb index b19aaf5..32aae1a 100644 --- a/gcc/ada/s-explli.adb +++ b/gcc/ada/s-explli.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2009 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- -- diff --git a/gcc/ada/s-explli.ads b/gcc/ada/s-explli.ads index d9d8a13..9c4f292 100644 --- a/gcc/ada/s-explli.ads +++ b/gcc/ada/s-explli.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2009 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- -- diff --git a/gcc/ada/s-expllu.adb b/gcc/ada/s-expllu.adb index 23ca437..47192b9 100644 --- a/gcc/ada/s-expllu.adb +++ b/gcc/ada/s-expllu.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2009 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- -- diff --git a/gcc/ada/s-expuns.adb b/gcc/ada/s-expuns.adb index 4bda950..47581b0 100644 --- a/gcc/ada/s-expuns.adb +++ b/gcc/ada/s-expuns.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2009 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- -- diff --git a/gcc/ada/s-fore.adb b/gcc/ada/s-fore.adb index 5d5a283..df8cdf2 100644 --- a/gcc/ada/s-fore.adb +++ b/gcc/ada/s-fore.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2009 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- -- diff --git a/gcc/ada/s-fore.ads b/gcc/ada/s-fore.ads index e3fee48..f334d96 100644 --- a/gcc/ada/s-fore.ads +++ b/gcc/ada/s-fore.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- 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- -- diff --git a/gcc/ada/s-geveop.ads b/gcc/ada/s-geveop.ads index 3fa7204..3796bc9 100644 --- a/gcc/ada/s-geveop.ads +++ b/gcc/ada/s-geveop.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2002-2009 Free Software Foundation, Inc. -- +-- Copyright (C) 2002-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- -- diff --git a/gcc/ada/s-imgbiu.ads b/gcc/ada/s-imgbiu.ads index 2ddce28..987b8b0 100644 --- a/gcc/ada/s-imgbiu.ads +++ b/gcc/ada/s-imgbiu.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2009 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- -- diff --git a/gcc/ada/s-imgllb.ads b/gcc/ada/s-imgllb.ads index 1a5636b..9c94baa 100644 --- a/gcc/ada/s-imgllb.ads +++ b/gcc/ada/s-imgllb.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2009 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- -- diff --git a/gcc/ada/s-imgllw.ads b/gcc/ada/s-imgllw.ads index e84a8f0..baf4a38 100644 --- a/gcc/ada/s-imgllw.ads +++ b/gcc/ada/s-imgllw.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2009 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- -- diff --git a/gcc/ada/s-mantis.adb b/gcc/ada/s-mantis.adb index 0353621..04f6e5a 100644 --- a/gcc/ada/s-mantis.adb +++ b/gcc/ada/s-mantis.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1996-2009 Free Software Foundation, Inc. -- +-- Copyright (C) 1996-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- -- diff --git a/gcc/ada/s-mantis.ads b/gcc/ada/s-mantis.ads index de5a6f2..5169299 100644 --- a/gcc/ada/s-mantis.ads +++ b/gcc/ada/s-mantis.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1996-2009 Free Software Foundation, Inc. -- +-- Copyright (C) 1996-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- -- diff --git a/gcc/ada/s-memcop.ads b/gcc/ada/s-memcop.ads index 96219f1..fc2403f 100644 --- a/gcc/ada/s-memcop.ads +++ b/gcc/ada/s-memcop.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2001-2009 Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2014, Free Software Foundation, Inc. -- -- -- -- This specification is derived from the Ada Reference Manual for use with -- -- GNAT. The copyright notice above, and the license provisions that follow -- diff --git a/gcc/ada/s-powtab.ads b/gcc/ada/s-powtab.ads index ea1820b..5a84b50 100644 --- a/gcc/ada/s-powtab.ads +++ b/gcc/ada/s-powtab.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2009 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- -- diff --git a/gcc/ada/s-proinf.adb b/gcc/ada/s-proinf.adb index 308b207..1d7e424 100644 --- a/gcc/ada/s-proinf.adb +++ b/gcc/ada/s-proinf.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1996-2009 Free Software Foundation, Inc. -- +-- Copyright (C) 1996-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- -- diff --git a/gcc/ada/s-tasinf.adb b/gcc/ada/s-tasinf.adb index 905af86..d48d163 100644 --- a/gcc/ada/s-tasinf.adb +++ b/gcc/ada/s-tasinf.adb @@ -7,7 +7,7 @@ -- B o d y -- -- (Compiler Interface) -- -- -- --- Copyright (C) 1998-2009 Free Software Foundation, Inc. -- +-- Copyright (C) 1998-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- -- diff --git a/gcc/ada/s-traces-default.adb b/gcc/ada/s-traces-default.adb index 03145a9..e370efa 100644 --- a/gcc/ada/s-traces-default.adb +++ b/gcc/ada/s-traces-default.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2009 Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2014, Free Software Foundation, Inc. -- -- -- -- GNARL 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- -- diff --git a/gcc/ada/s-traces.adb b/gcc/ada/s-traces.adb index e7116f5..abf7e8d 100644 --- a/gcc/ada/s-traces.adb +++ b/gcc/ada/s-traces.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2009 Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2014, Free Software Foundation, Inc. -- -- -- -- GNARL 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- -- diff --git a/gcc/ada/s-tratas-default.adb b/gcc/ada/s-tratas-default.adb index 0c80fe9..24f0d24 100644 --- a/gcc/ada/s-tratas-default.adb +++ b/gcc/ada/s-tratas-default.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2009 Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2014, Free Software Foundation, Inc. -- -- -- -- GNARL 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- -- diff --git a/gcc/ada/s-tratas.adb b/gcc/ada/s-tratas.adb index a65f70b..7a6ac5d 100644 --- a/gcc/ada/s-tratas.adb +++ b/gcc/ada/s-tratas.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2009 Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2014, Free Software Foundation, Inc. -- -- -- -- GNARL 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- -- diff --git a/gcc/ada/s-tratas.ads b/gcc/ada/s-tratas.ads index 7cb567a..8f89445 100644 --- a/gcc/ada/s-tratas.ads +++ b/gcc/ada/s-tratas.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2001-2009 Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2014, Free Software Foundation, Inc. -- -- -- -- GNARL 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- -- diff --git a/gcc/ada/s-vector.ads b/gcc/ada/s-vector.ads index 7205258..4c529b2 100644 --- a/gcc/ada/s-vector.ads +++ b/gcc/ada/s-vector.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2002-2009 Free Software Foundation, Inc. -- +-- Copyright (C) 2002-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- -- diff --git a/gcc/ada/s-vxwork-x86.ads b/gcc/ada/s-vxwork-x86.ads index 566b71b..fac24f3 100644 --- a/gcc/ada/s-vxwork-x86.ads +++ b/gcc/ada/s-vxwork-x86.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1998-2009 Free Software Foundation, Inc. -- +-- Copyright (C) 1998-2014, Free Software Foundation, Inc. -- -- -- -- GNARL 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- -- diff --git a/gcc/ada/s-wwdwch.ads b/gcc/ada/s-wwdwch.ads index af42232b..ecdd93f 100644 --- a/gcc/ada/s-wwdwch.ads +++ b/gcc/ada/s-wwdwch.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2009 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- -- diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 498aafa..00f56f9 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -3589,7 +3589,7 @@ package body Sem_Ch6 is and then Ekind (Spec_Id) = E_Function and then Returns_Unconstrained_Type (Spec_Id) then - Check_And_Build_Body_To_Inline (N, Spec_Id, Body_Id); + Check_And_Split_Unconstrained_Function (N, Spec_Id, Body_Id); else declare diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads index 211e009..841f2c7 100644 --- a/gcc/ada/sinfo.ads +++ b/gcc/ada/sinfo.ads @@ -1259,8 +1259,6 @@ package Sinfo is -- Float_Truncate (Flag11-Sem) -- A flag present in type conversion nodes. This is used for float to -- integer conversions where truncation is required rather than rounding. - -- Note that Gigi does not handle type conversions from real to integer - -- with rounding (see Expand_N_Type_Conversion). -- Forwards_OK (Flag5-Sem) -- A flag present in the N_Assignment_Statement node. It is used only diff --git a/gcc/ada/stand.adb b/gcc/ada/stand.adb index b2c6a3f..429f545 100644 --- a/gcc/ada/stand.adb +++ b/gcc/ada/stand.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2014, 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- -- diff --git a/gcc/ada/tree_io.adb b/gcc/ada/tree_io.adb index 6f56478..addefd0 100644 --- a/gcc/ada/tree_io.adb +++ b/gcc/ada/tree_io.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2009 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- -- diff --git a/gcc/ada/types.adb b/gcc/ada/types.adb index bcb1922..67d15cf 100644 --- a/gcc/ada/types.adb +++ b/gcc/ada/types.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2009 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- -- diff --git a/gcc/ada/uname.ads b/gcc/ada/uname.ads index c1b59b6..9b38d9a 100644 --- a/gcc/ada/uname.ads +++ b/gcc/ada/uname.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2009 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- -- diff --git a/gcc/ada/widechar.ads b/gcc/ada/widechar.ads index 7db577a..a6e8293 100644 --- a/gcc/ada/widechar.ads +++ b/gcc/ada/widechar.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2009 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- -- |