+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.
-- --
-- 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 --
-- --
-- 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- --
-- --
-- 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- --
-- 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
-- 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.
-- 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.
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;
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;
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;
-- 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);
+++ /dev/null
-------------------------------------------------------------------------------
--- --
--- 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;
+++ /dev/null
-------------------------------------------------------------------------------
--- --
--- 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;
-- --
-- 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- --
-- --
-- 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- --
-- --
-- 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- --
-- --
-- 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- --
-- --
-- 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- --
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 \
-- --
-- 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- --
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;
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
-- 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- --
-- 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- --
-- 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- --
-- --
-- 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- --
------------------------------------------------------------------------------
with Atree; use Atree;
+with Debug; use Debug;
with Einfo; use Einfo;
with Elists; use Elists;
with Errout; use Errout;
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;
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 --
--------------------
-- 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 --
-- 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
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 --
-------------------------------
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 --
--------------------------
then
Cannot_Inline
("cannot inline & (call returns unconstrained type)?",
- N, Subp);
+ N, Spec_Id);
return Abandon;
else
return OK;
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
-- 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;
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;
-- 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;
-- 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
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));
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;
-------------------
pragma Assert (Msg (Msg'Last) = '?');
- -- Old semantics
+ -- Legacy front end inlining model
if not Back_End_Inlining then
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)
-- 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
-- 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
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 --
--------------------------------------
-- 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.
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 --
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
-- 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 --
-- 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
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,
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)?",
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)))
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;
------------------------
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 --
----------
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 --
---------------------------
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;
-- 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 --
-----------------
-- 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
-- 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);
--
-- 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);
-- 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
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;
-----------------
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;
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;
-- --
-- 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- --
-- --
-- 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- --
-- --
-- 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- --
-- --
-- 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- --
-- --
-- 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- --
-- --
-- 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- --
-- --
-- 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- --
-- --
-- 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- --
-- --
-- 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- --
-- --
-- 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- --
-- --
-- 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- --
-- --
-- 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- --
-- --
-- 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- --
-- --
-- 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- --
-- --
-- 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- --
-- --
-- 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- --
-- --
-- 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- --
-- --
-- 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- --
-- --
-- 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- --
-- --
-- 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- --
-- --
-- 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- --
-- --
-- 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- --
-- --
-- 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- --
-- --
-- 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- --
-- --
-- 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- --
-- --
-- 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- --
-- --
-- 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- --
-- --
-- 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- --
-- --
-- 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 --
-- --
-- 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- --
-- --
-- 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- --
-- 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- --
-- --
-- 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- --
-- --
-- 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- --
-- --
-- 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- --
-- --
-- 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- --
-- --
-- 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- --
-- --
-- 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- --
-- --
-- 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- --
-- --
-- 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- --
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
-- 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
-- --
-- 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- --
-- --
-- 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- --
-- --
-- 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- --
-- --
-- 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- --
-- --
-- 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- --
projects / platform / upstream / gcc.git / commitdiff