Subversion Repositories openrisc

------------------------------------------------------------------------------

--                                                                          --

--                         GNAT COMPILER COMPONENTS                         --

--                                                                          --

--                               I N L I N E                                --

--                                                                          --

--                                 B o d y                                  --

--                                                                          --

--          Copyright (C) 1992-2011, 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 Elists;   use Elists;

with Errout;   use Errout;

with Exp_Ch7;  use Exp_Ch7;

with Exp_Tss;  use Exp_Tss;

with Fname;    use Fname;

with Fname.UF; use Fname.UF;

with Lib;      use Lib;

with Namet;    use Namet;

with Nlists;   use Nlists;

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_Util; use Sem_Util;

with Sinfo;    use Sinfo;

with Snames;   use Snames;

with Stand;    use Stand;

with Uname;    use Uname;

package body Inline is

   --------------------

   -- Inlined Bodies --

   --------------------

   --  Inlined functions are actually placed in line by the backend if the

   --  corresponding bodies are available (i.e. compiled). Whenever we find

   --  a call to an inlined subprogram, we add the name of the enclosing

   --  compilation unit to a worklist. After all compilation, and after

   --  expansion of generic bodies, we traverse the list of pending bodies

   --  and compile them as well.

   package Inlined_Bodies is new Table.Table (

     Table_Component_Type => Entity_Id,

     Table_Index_Type     => Int,

     Table_Low_Bound      => 0,

     Table_Initial        => Alloc.Inlined_Bodies_Initial,

     Table_Increment      => Alloc.Inlined_Bodies_Increment,

     Table_Name           => "Inlined_Bodies");

   -----------------------

   -- Inline Processing --

   -----------------------

   --  For each call to an inlined subprogram, we make entries in a table

   --  that stores caller and callee, and indicates a prerequisite from

   --  one to the other. We also record the compilation unit that contains

   --  the callee. After analyzing the bodies of all such compilation units,

   --  we produce a list of subprograms in  topological order, for use by the

   --  back-end. If P2 is a prerequisite of P1, then P1 calls P2, and for

   --  proper inlining the back-end must analyze the body of P2 before that of

   --  P1. The code below guarantees that the transitive closure of inlined

   --  subprograms called from the main compilation unit is made available to

   --  the code generator.

   Last_Inlined : Entity_Id := Empty;

   --  For each entry in the table we keep a list of successors in topological

   --  order, i.e. callers of the current subprogram.

   type Subp_Index is new Nat;

   No_Subp : constant Subp_Index := 0;

   --  The subprogram entities are hashed into the Inlined table

   Num_Hash_Headers : constant := 512;

   Hash_Headers : array (Subp_Index range 0 .. Num_Hash_Headers - 1)

                                                          of Subp_Index;

   type Succ_Index is new Nat;

   No_Succ : constant Succ_Index := 0;

   type Succ_Info is record

      Subp : Subp_Index;

      Next : Succ_Index;

   end record;

   --  The following table stores list elements for the successor lists.

   --  These lists cannot be chained directly through entries in the Inlined

   --  table, because a given subprogram can appear in several such lists.

   package Successors is new Table.Table (

      Table_Component_Type => Succ_Info,

      Table_Index_Type     => Succ_Index,

      Table_Low_Bound      => 1,

      Table_Initial        => Alloc.Successors_Initial,

      Table_Increment      => Alloc.Successors_Increment,

      Table_Name           => "Successors");

   type Subp_Info is record

      Name        : Entity_Id  := Empty;

      First_Succ  : Succ_Index := No_Succ;

      Count       : Integer    := 0;

      Listed      : Boolean    := False;

      Main_Call   : Boolean    := False;

      Next        : Subp_Index := No_Subp;

      Next_Nopred : Subp_Index := No_Subp;

   end record;

   package Inlined is new Table.Table (

      Table_Component_Type => Subp_Info,

      Table_Index_Type     => Subp_Index,

      Table_Low_Bound      => 1,

      Table_Initial        => Alloc.Inlined_Initial,

      Table_Increment      => Alloc.Inlined_Increment,

      Table_Name           => "Inlined");

   -----------------------

   -- Local Subprograms --

   -----------------------

   function Get_Code_Unit_Entity (E : Entity_Id) return Entity_Id;

   pragma Inline (Get_Code_Unit_Entity);

   --  Return the entity node for the unit containing E

   function Scope_In_Main_Unit (Scop : Entity_Id) return Boolean;

   --  Return True if Scop is in the main unit or its spec

   procedure Add_Call (Called : Entity_Id; Caller : Entity_Id := Empty);

   --  Make two entries in Inlined table, for an inlined subprogram being

   --  called, and for the inlined subprogram that contains the call. If

   --  the call is in the main compilation unit, Caller is Empty.

   function Add_Subp (E : Entity_Id) return Subp_Index;

   --  Make entry in Inlined table for subprogram E, or return table index

   --  that already holds E.

   function Has_Initialized_Type (E : Entity_Id) return Boolean;

   --  If a candidate for inlining contains type declarations for types with

   --  non-trivial initialization procedures, they are not worth inlining.

   function Is_Nested (E : Entity_Id) return Boolean;

   --  If the function is nested inside some other function, it will

   --  always be compiled if that function is, so don't add it to the

   --  inline list. We cannot compile a nested function outside the

   --  scope of the containing 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).

   procedure Add_Inlined_Subprogram (Index : Subp_Index);

   --  Add subprogram to Inlined List once all of its predecessors have been

   --  placed on the list. Decrement the count of all its successors, and

   --  add them to list (recursively) if count drops to zero.

   ------------------------------

   -- Deferred Cleanup Actions --

   ------------------------------

   --  The cleanup actions for scopes that contain instantiations is delayed

   --  until after expansion of those instantiations, because they may

   --  contain finalizable objects or tasks that affect the cleanup code.

   --  A scope that contains instantiations only needs to be finalized once,

   --  even if it contains more than one instance. We keep a list of scopes

   --  that must still be finalized, and call cleanup_actions after all the

   --  instantiations have been completed.

   To_Clean : Elist_Id;

   procedure Add_Scope_To_Clean (Inst : Entity_Id);

   --  Build set of scopes on which cleanup actions must be performed

   procedure Cleanup_Scopes;

   --  Complete cleanup actions on scopes that need it

   --------------

   -- Add_Call --

   --------------

   procedure Add_Call (Called : Entity_Id; Caller : Entity_Id := Empty) is

      P1 : constant Subp_Index := Add_Subp (Called);

      P2 : Subp_Index;

      J  : Succ_Index;

   begin

      if Present (Caller) then

         P2 := Add_Subp (Caller);

         --  Add P2 to the list of successors of P1, if not already there.

         --  Note that P2 may contain more than one call to P1, and only

         --  one needs to be recorded.

         J := Inlined.Table (P1).First_Succ;

         while J /= No_Succ loop

            if Successors.Table (J).Subp = P2 then

               return;

            end if;

            J := Successors.Table (J).Next;

         end loop;

         --  On exit, make a successor entry for P2

         Successors.Increment_Last;

         Successors.Table (Successors.Last).Subp := P2;

         Successors.Table (Successors.Last).Next :=

                             Inlined.Table (P1).First_Succ;

         Inlined.Table (P1).First_Succ := Successors.Last;

         Inlined.Table (P2).Count := Inlined.Table (P2).Count + 1;

      else

         Inlined.Table (P1).Main_Call := True;

      end if;

   end Add_Call;

   ----------------------

   -- Add_Inlined_Body --

   ----------------------

   procedure Add_Inlined_Body (E : Entity_Id) is

      function Must_Inline return Boolean;

      --  Inlining is only done if the call statement N is in the main unit,

      --  or within the body of another inlined subprogram.

      -----------------

      -- Must_Inline --

      -----------------

      function Must_Inline return Boolean is

         Scop : Entity_Id;

         Comp : Node_Id;

      begin

         --  Check if call is in main unit

         Scop := Current_Scope;

         --  Do not try to inline if scope is standard. This could happen, for

         --  example, for a call to Add_Global_Declaration, and it causes

         --  trouble to try to inline at this level.

         if Scop = Standard_Standard then

            return False;

         end if;

         --  Otherwise lookup scope stack to outer scope

         while Scope (Scop) /= Standard_Standard

           and then not Is_Child_Unit (Scop)

         loop

            Scop := Scope (Scop);

         end loop;

         Comp := Parent (Scop);

         while Nkind (Comp) /= N_Compilation_Unit loop

            Comp := Parent (Comp);

         end loop;

         if Comp = Cunit (Main_Unit)

           or else Comp = Library_Unit (Cunit (Main_Unit))

         then

            Add_Call (E);

            return True;

         end if;

         --  Call is not in main unit. See if it's in some inlined subprogram

         Scop := Current_Scope;

         while Scope (Scop) /= Standard_Standard

           and then not Is_Child_Unit (Scop)

         loop

            if Is_Overloadable (Scop)

              and then Is_Inlined (Scop)

            then

               Add_Call (E, Scop);

               return True;

            end if;

            Scop := Scope (Scop);

         end loop;

         return False;

      end Must_Inline;

   --  Start of processing for Add_Inlined_Body

   begin

      --  Find unit containing E, and add to list of inlined bodies if needed.

      --  If the body is already present, no need to load any other unit. This

      --  is the case for an initialization procedure, which appears in the

      --  package declaration that contains the type. It is also the case if

      --  the body has already been analyzed. Finally, if the unit enclosing

      --  E is an instance, the instance body will be analyzed in any case,

      --  and there is no need to add the enclosing unit (whose body might not

      --  be available).

      --  Library-level functions must be handled specially, because there is

      --  no enclosing package to retrieve. In this case, it is the body of

      --  the function that will have to be loaded.

      if not Is_Abstract_Subprogram (E)

        and then not Is_Nested (E)

        and then Convention (E) /= Convention_Protected

        and then Must_Inline

      then

         declare

            Pack : constant Entity_Id := Get_Code_Unit_Entity (E);

         begin

            if Pack = E then

               --  Library-level inlined function. Add function itself to

               --  list of needed units.

               Set_Is_Called (E);

               Inlined_Bodies.Increment_Last;

               Inlined_Bodies.Table (Inlined_Bodies.Last) := E;

            elsif Ekind (Pack) = E_Package then

               Set_Is_Called (E);

               if Is_Generic_Instance (Pack) then

                  null;

               --  Do not inline the package if the subprogram is an init proc

               --  or other internally generated subprogram, because in that

               --  case the subprogram body appears in the same unit that

               --  declares the type, and that body is visible to the back end.

               elsif not Is_Inlined (Pack)

                 and then Comes_From_Source (E)

               then

                  Set_Is_Inlined (Pack);

                  Inlined_Bodies.Increment_Last;

                  Inlined_Bodies.Table (Inlined_Bodies.Last) := Pack;

               end if;

            end if;

         end;

      end if;

   end Add_Inlined_Body;

   ----------------------------

   -- Add_Inlined_Subprogram --

   ----------------------------

   procedure Add_Inlined_Subprogram (Index : Subp_Index) is

      E    : constant Entity_Id := Inlined.Table (Index).Name;

      Pack : constant Entity_Id := Get_Code_Unit_Entity (E);

      Succ : Succ_Index;

      Subp : Subp_Index;

      function Back_End_Cannot_Inline (Subp : Entity_Id) return Boolean;

      --  There are various conditions under which back-end inlining cannot

      --  be done reliably:

      --

      --    a) If a body has handlers, it must not be inlined, because this

      --    may violate program semantics, and because in zero-cost exception

      --    mode it will lead to undefined symbols at link time.

      --

      --    b) If a body contains inlined function instances, it cannot be

      --    inlined under ZCX because the numeric suffix generated by gigi

      --    will be different in the body and the place of the inlined call.

      --

      --  This procedure must be carefully coordinated with the back end.

      ----------------------------

      -- Back_End_Cannot_Inline --

      ----------------------------

      function Back_End_Cannot_Inline (Subp : Entity_Id) return Boolean is

         Decl     : constant Node_Id := Unit_Declaration_Node (Subp);

         Body_Ent : Entity_Id;

         Ent      : Entity_Id;

      begin

         if Nkind (Decl) = N_Subprogram_Declaration

           and then Present (Corresponding_Body (Decl))

         then

            Body_Ent := Corresponding_Body (Decl);

         else

            return False;

         end if;

         --  If subprogram is marked Inline_Always, inlining is mandatory

         if Has_Pragma_Inline_Always (Subp) then

            return False;

         end if;

         if Present

          (Exception_Handlers

            (Handled_Statement_Sequence

              (Unit_Declaration_Node (Corresponding_Body (Decl)))))

         then

            return True;

         end if;

         Ent := First_Entity (Body_Ent);

         while Present (Ent) loop

            if Is_Subprogram (Ent)

              and then Is_Generic_Instance (Ent)

            then

               return True;

            end if;

            Next_Entity (Ent);

         end loop;

         return False;

      end Back_End_Cannot_Inline;

   --  Start of processing for Add_Inlined_Subprogram

   begin

      --  If the subprogram is to be inlined, and if its unit is known to be

      --  inlined or is an instance whose body will be analyzed anyway or the

      --  subprogram has been generated by the compiler, and if it is declared

      --  at the library level not in the main unit, and if it can be inlined

      --  by the back-end, then insert it in the list of inlined subprograms.

      if Is_Inlined (E)

        and then (Is_Inlined (Pack)

                    or else Is_Generic_Instance (Pack)

                    or else Is_Internal (E))

        and then not Scope_In_Main_Unit (E)

        and then not Is_Nested (E)

        and then not Has_Initialized_Type (E)

      then

         if Back_End_Cannot_Inline (E) then

            Set_Is_Inlined (E, False);

         else

            if No (Last_Inlined) then

               Set_First_Inlined_Subprogram (Cunit (Main_Unit), E);

            else

               Set_Next_Inlined_Subprogram (Last_Inlined, E);

            end if;

            Last_Inlined := E;

         end if;

      end if;

      Inlined.Table (Index).Listed := True;

      --  Now add to the list those callers of the current subprogram that

      --  are themselves called. They may appear on the graph as callers

      --  of the current one, even if they are themselves not called, and

      --  there is no point in including them in the list for the backend.

      --  Furthermore, they might not even be public, in which case the

      --  back-end cannot handle them at all.

      Succ := Inlined.Table (Index).First_Succ;

      while Succ /= No_Succ loop

         Subp := Successors.Table (Succ).Subp;

         Inlined.Table (Subp).Count := Inlined.Table (Subp).Count - 1;

         if Inlined.Table (Subp).Count = 0

           and then Is_Called (Inlined.Table (Subp).Name)

         then

            Add_Inlined_Subprogram (Subp);

         end if;

         Succ := Successors.Table (Succ).Next;

      end loop;

   end Add_Inlined_Subprogram;

   ------------------------

   -- Add_Scope_To_Clean --

   ------------------------

   procedure Add_Scope_To_Clean (Inst : Entity_Id) is

      Scop : constant Entity_Id := Enclosing_Dynamic_Scope (Inst);

      Elmt : Elmt_Id;

   begin

      --  If the instance appears in a library-level package declaration,

      --  all finalization is global, and nothing needs doing here.

      if Scop = Standard_Standard then

         return;

      end if;

      --  If the instance is within a generic unit, no finalization code

      --  can be generated. Note that at this point all bodies have been

      --  analyzed, and the scope stack itself is not present, and the flag

      --  Inside_A_Generic is not set.

      declare

         S : Entity_Id;

      begin

         S := Scope (Inst);

         while Present (S) and then S /= Standard_Standard loop

            if Is_Generic_Unit (S) then

               return;

            end if;

            S := Scope (S);

         end loop;

      end;

      Elmt := First_Elmt (To_Clean);

      while Present (Elmt) loop

         if Node (Elmt) = Scop then

            return;

         end if;

         Elmt := Next_Elmt (Elmt);

      end loop;

      Append_Elmt (Scop, To_Clean);

   end Add_Scope_To_Clean;

   --------------

   -- Add_Subp --

   --------------

   function Add_Subp (E : Entity_Id) return Subp_Index is

      Index : Subp_Index := Subp_Index (E) mod Num_Hash_Headers;

      J     : Subp_Index;

      procedure New_Entry;

      --  Initialize entry in Inlined table

      procedure New_Entry is

      begin

         Inlined.Increment_Last;

         Inlined.Table (Inlined.Last).Name        := E;

         Inlined.Table (Inlined.Last).First_Succ  := No_Succ;

         Inlined.Table (Inlined.Last).Count       := 0;

         Inlined.Table (Inlined.Last).Listed      := False;

         Inlined.Table (Inlined.Last).Main_Call   := False;

         Inlined.Table (Inlined.Last).Next        := No_Subp;

         Inlined.Table (Inlined.Last).Next_Nopred := No_Subp;

      end New_Entry;

   --  Start of processing for Add_Subp

   begin

      if Hash_Headers (Index) = No_Subp then

         New_Entry;

         Hash_Headers (Index) := Inlined.Last;

         return Inlined.Last;

      else

         J := Hash_Headers (Index);

         while J /= No_Subp loop

            if Inlined.Table (J).Name = E then

               return J;

            else

               Index := J;

               J := Inlined.Table (J).Next;

            end if;

         end loop;

         --  On exit, subprogram was not found. Enter in table. Index is

         --  the current last entry on the hash chain.

         New_Entry;

         Inlined.Table (Index).Next := Inlined.Last;

         return Inlined.Last;

      end if;

   end Add_Subp;

   ----------------------------

   -- Analyze_Inlined_Bodies --

   ----------------------------

   procedure Analyze_Inlined_Bodies is

      Comp_Unit : Node_Id;

      J         : Int;

      Pack      : Entity_Id;

      S         : Succ_Index;

      function Is_Ancestor_Of_Main

        (U_Name : Entity_Id;

         Nam    : Node_Id) return Boolean;

      --  Determine whether the unit whose body is loaded is an ancestor of

      --  the main unit, and has a with_clause on it. The body is not

      --  analyzed yet, so the check is purely lexical: the name of the with

      --  clause is a selected component, and names of ancestors must match.

      -------------------------

      -- Is_Ancestor_Of_Main --

      -------------------------

      function Is_Ancestor_Of_Main

        (U_Name : Entity_Id;

         Nam    : Node_Id) return Boolean

      is

         Pref : Node_Id;

      begin

         if Nkind (Nam) /= N_Selected_Component then

            return False;

         else

            if Chars (Selector_Name (Nam)) /=

               Chars (Cunit_Entity (Main_Unit))

            then

               return False;

            end if;

            Pref := Prefix (Nam);

            if Nkind (Pref) = N_Identifier then

               --  Par is an ancestor of Par.Child.

               return Chars (Pref) = Chars (U_Name);

            elsif Nkind (Pref) = N_Selected_Component

              and then Chars (Selector_Name (Pref)) = Chars (U_Name)

            then

               --  Par.Child is an ancestor of Par.Child.Grand.

               return True;   --  should check that ancestor match

            else

               --  A is an ancestor of A.B.C if it is an ancestor of A.B

               return Is_Ancestor_Of_Main (U_Name, Pref);

            end if;

         end if;

      end Is_Ancestor_Of_Main;

   --  Start of processing for  Analyze_Inlined_Bodies

   begin

      Analyzing_Inlined_Bodies := False;

      if Serious_Errors_Detected = 0 then

         Push_Scope (Standard_Standard);

         J := 0;

         while J <= Inlined_Bodies.Last

           and then Serious_Errors_Detected = 0

         loop

            Pack := Inlined_Bodies.Table (J);

            while Present (Pack)

              and then Scope (Pack) /= Standard_Standard

              and then not Is_Child_Unit (Pack)

            loop

               Pack := Scope (Pack);

            end loop;

            Comp_Unit := Parent (Pack);

            while Present (Comp_Unit)

              and then Nkind (Comp_Unit) /= N_Compilation_Unit

            loop

               Comp_Unit := Parent (Comp_Unit);

            end loop;

            --  Load the body, unless it the main unit, or is an instance whose

            --  body has already been analyzed.

            if Present (Comp_Unit)

              and then Comp_Unit /= Cunit (Main_Unit)

              and then Body_Required (Comp_Unit)

              and then (Nkind (Unit (Comp_Unit)) /= N_Package_Declaration

                         or else No (Corresponding_Body (Unit (Comp_Unit))))

            then

               declare

                  Bname : constant Unit_Name_Type :=

                            Get_Body_Name (Get_Unit_Name (Unit (Comp_Unit)));

                  OK : Boolean;

               begin

                  if not Is_Loaded (Bname) then

                     Style_Check := False;

                     Load_Needed_Body (Comp_Unit, OK, Do_Analyze => False);

                     if not OK then

                        --  Warn that a body was not available for inlining

                        --  by the back-end.

                        Error_Msg_Unit_1 := Bname;

                        Error_Msg_N

                          ("one or more inlined subprograms accessed in $!?",

                           Comp_Unit);

                        Error_Msg_File_1 :=

                          Get_File_Name (Bname, Subunit => False);

                        Error_Msg_N ("\but file{ was not found!?", Comp_Unit);

                     else

                        --  If the package to be inlined is an ancestor unit of

                        --  the main unit, and it has a semantic dependence on

                        --  it, the inlining cannot take place to prevent an

                        --  elaboration circularity. The desired body is not

                        --  analyzed yet, to prevent the completion of Taft

                        --  amendment types that would lead to elaboration

                        --  circularities in gigi.

                        declare

                           U_Id      : constant Entity_Id :=

                                         Defining_Entity (Unit (Comp_Unit));

                           Body_Unit : constant Node_Id :=

                                         Library_Unit (Comp_Unit);

                           Item      : Node_Id;

                        begin

                           Item := First (Context_Items (Body_Unit));

                           while Present (Item) loop

                              if Nkind (Item) = N_With_Clause

                                and then

                                  Is_Ancestor_Of_Main (U_Id, Name (Item))

                              then

                                 Set_Is_Inlined (U_Id, False);

                                 exit;

                              end if;

                              Next (Item);

                           end loop;

                           --  If no suspicious with_clauses, analyze the body.

                           if Is_Inlined (U_Id) then

                              Semantics (Body_Unit);

                           end if;

                        end;

                     end if;

                  end if;

               end;

            end if;

            J := J + 1;

         end loop;

         --  The analysis of required bodies may have produced additional

         --  generic instantiations. To obtain further inlining, we perform

         --  another round of generic body instantiations. Establishing a

         --  fully recursive loop between inlining and generic instantiations

         --  is unlikely to yield more than this one additional pass.

         Instantiate_Bodies;

         --  The list of inlined subprograms is an overestimate, because it

         --  includes inlined functions called from functions that are compiled

         --  as part of an inlined package, but are not themselves called. An

         --  accurate computation of just those subprograms that are needed

         --  requires that we perform a transitive closure over the call graph,

         --  starting from calls in the main program. Here we do one step of

         --  the inverse transitive closure, and reset the Is_Called flag on

         --  subprograms all of whose callers are not.

         for Index in Inlined.First .. Inlined.Last loop

            S := Inlined.Table (Index).First_Succ;

            if S /= No_Succ

              and then not Inlined.Table (Index).Main_Call

            then

               Set_Is_Called (Inlined.Table (Index).Name, False);

               while S /= No_Succ loop