| ------------------------------------------------------------------------------ |
| -- -- |
| -- GNAT COMPILER COMPONENTS -- |
| -- -- |
| -- I N L I N E -- |
| -- -- |
| -- B o d y -- |
| -- -- |
| -- Copyright (C) 1992-2022, 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 Alloc; |
| with Aspects; use Aspects; |
| with Atree; use Atree; |
| with Debug; use Debug; |
| with Einfo; use Einfo; |
| with Einfo.Entities; use Einfo.Entities; |
| with Einfo.Utils; use Einfo.Utils; |
| with Elists; use Elists; |
| with Errout; use Errout; |
| with Exp_Ch6; use Exp_Ch6; |
| with Exp_Ch7; use Exp_Ch7; |
| with Exp_Tss; use Exp_Tss; |
| with Exp_Util; use Exp_Util; |
| with Fname; use Fname; |
| with Fname.UF; use Fname.UF; |
| with Lib; use Lib; |
| with Namet; use Namet; |
| with Nmake; use Nmake; |
| with Nlists; use Nlists; |
| with Output; use Output; |
| with Sem_Aux; use Sem_Aux; |
| with Sem_Ch8; use Sem_Ch8; |
| with Sem_Ch10; use Sem_Ch10; |
| with Sem_Ch12; use Sem_Ch12; |
| with Sem_Prag; use Sem_Prag; |
| with Sem_Res; use Sem_Res; |
| with Sem_Util; use Sem_Util; |
| with Sinfo; use Sinfo; |
| with Sinfo.Nodes; use Sinfo.Nodes; |
| with Sinfo.Utils; use Sinfo.Utils; |
| with Sinput; use Sinput; |
| with Snames; use Snames; |
| with Stand; use Stand; |
| with Table; |
| with Tbuild; use Tbuild; |
| with Uintp; use Uintp; |
| with Uname; use Uname; |
| |
| with GNAT.HTable; |
| |
| 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_Instances : Elist_Id; |
| -- List of instances inlined for 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 |
| |
| ----------------------------- |
| -- Pending_Instantiations -- |
| ----------------------------- |
| |
| -- We make entries in this table for the pending instantiations of generic |
| -- bodies that are created during semantic analysis. After the analysis is |
| -- complete, calling Instantiate_Bodies performs the actual instantiations. |
| |
| package Pending_Instantiations is new Table.Table ( |
| Table_Component_Type => Pending_Body_Info, |
| Table_Index_Type => Int, |
| Table_Low_Bound => 0, |
| Table_Initial => Alloc.Pending_Instantiations_Initial, |
| Table_Increment => Alloc.Pending_Instantiations_Increment, |
| Table_Name => "Pending_Instantiations"); |
| |
| ------------------------------------- |
| -- Called_Pending_Instantiations -- |
| ------------------------------------- |
| |
| -- With back-end inlining, the pending instantiations that are not in the |
| -- main unit or subunit are performed only after a call to the subprogram |
| -- instance, or to a subprogram within the package instance, is inlined. |
| -- Since such a call can be within a subsequent pending instantiation, |
| -- we make entries in this table that stores the index of these "called" |
| -- pending instantiations and perform them when the table is populated. |
| |
| package Called_Pending_Instantiations is new Table.Table ( |
| Table_Component_Type => Int, |
| Table_Index_Type => Int, |
| Table_Low_Bound => 0, |
| Table_Initial => Alloc.Pending_Instantiations_Initial, |
| Table_Increment => Alloc.Pending_Instantiations_Increment, |
| Table_Name => "Called_Pending_Instantiations"); |
| |
| --------------------------------- |
| -- To_Pending_Instantiations -- |
| --------------------------------- |
| |
| -- With back-end inlining, we also need to have a map from the pending |
| -- instantiations to their index in the Pending_Instantiations table. |
| |
| Node_Table_Size : constant := 257; |
| -- Number of headers in hash table |
| |
| subtype Node_Header_Num is Integer range 0 .. Node_Table_Size - 1; |
| -- Range of headers in hash table |
| |
| function Node_Hash (Id : Node_Id) return Node_Header_Num; |
| -- Simple hash function for Node_Ids |
| |
| package To_Pending_Instantiations is new GNAT.Htable.Simple_HTable |
| (Header_Num => Node_Header_Num, |
| Element => Int, |
| No_Element => -1, |
| Key => Node_Id, |
| Hash => Node_Hash, |
| Equal => "="); |
| |
| ----------------- |
| -- Node_Hash -- |
| ----------------- |
| |
| function Node_Hash (Id : Node_Id) return Node_Header_Num is |
| begin |
| return Node_Header_Num (Id mod Node_Table_Size); |
| end Node_Hash; |
| |
| -------------------- |
| -- 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 the call direction 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 compute the transitive closure of inlined subprograms called from |
| -- the main compilation unit and make it available to the code generator |
| -- in no particular order, thus allowing cycles in the call graph. |
| |
| 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; |
| Next : Subp_Index := No_Subp; |
| First_Succ : Succ_Index := No_Succ; |
| Main_Call : Boolean := False; |
| Processed : Boolean := False; |
| 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 -- |
| ----------------------- |
| |
| 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. |
| |
| procedure Add_Inlined_Instance (E : Entity_Id); |
| -- Add instance E to the list of inlined instances for the unit |
| |
| procedure Add_Inlined_Subprogram (E : Entity_Id); |
| -- Add subprogram E to the list of inlined subprograms for the unit |
| |
| 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. |
| |
| procedure Establish_Actual_Mapping_For_Inlined_Call |
| (N : Node_Id; |
| Subp : Entity_Id; |
| Decls : List_Id; |
| Body_Or_Expr_To_Check : Node_Id); |
| -- Establish a mapping from formals to actuals in the call N for the target |
| -- subprogram Subp, and create temporaries or renamings when needed for the |
| -- actuals that are expressions (except for actuals given by simple entity |
| -- names or literals) or that are scalars that require copying to preserve |
| -- semantics. Any temporary objects that are created are inserted in Decls. |
| -- Body_Or_Expr_To_Check indicates the target body (or possibly expression |
| -- of an expression function), which may be traversed to count formal uses. |
| |
| 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. Always return the spec |
| -- for a package. |
| |
| function Has_Initialized_Type (E : Entity_Id) return Boolean; |
| -- If a candidate for inlining contains type declarations for types with |
| -- nontrivial initialization procedures, they are not worth inlining. |
| |
| function Has_Single_Return (N : Node_Id) return Boolean; |
| -- In general we cannot inline functions that return unconstrained type. |
| -- However, we can handle such functions if all return statements return |
| -- a local variable that is the first declaration in the body of the |
| -- function. In that case the call can be replaced by that local |
| -- variable as is done for other inlined calls. |
| |
| function In_Main_Unit_Or_Subunit (E : Entity_Id) return Boolean; |
| -- Return True if E is in the main unit or its spec or in a subunit |
| |
| 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 Remove_Aspects_And_Pragmas (Body_Decl : Node_Id); |
| -- Remove all aspects and/or pragmas that have no meaning in inlined body |
| -- Body_Decl. The analysis of these items is performed on the non-inlined |
| -- body. The items currently removed are: |
| -- Contract_Cases |
| -- Global |
| -- Depends |
| -- Postcondition |
| -- Precondition |
| -- Refined_Global |
| -- Refined_Depends |
| -- Refined_Post |
| -- Subprogram_Variant |
| -- Test_Case |
| -- Unmodified |
| -- Unreferenced |
| |
| procedure Reset_Actual_Mapping_For_Inlined_Call (Subp : Entity_Id); |
| -- Reset the Renamed_Object field to Empty on all formals of Subp, which |
| -- can be set by a call to Establish_Actual_Mapping_For_Inlined_Call. |
| |
| ------------------------------ |
| -- 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 P1 to the list of successors of P2, 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 (P2).First_Succ; |
| while J /= No_Succ loop |
| if Successors.Table (J).Subp = P1 then |
| return; |
| end if; |
| |
| J := Successors.Table (J).Next; |
| end loop; |
| |
| -- On exit, make a successor entry for P1 |
| |
| Successors.Increment_Last; |
| Successors.Table (Successors.Last).Subp := P1; |
| Successors.Table (Successors.Last).Next := |
| Inlined.Table (P2).First_Succ; |
| Inlined.Table (P2).First_Succ := Successors.Last; |
| else |
| Inlined.Table (P1).Main_Call := True; |
| end if; |
| end Add_Call; |
| |
| ---------------------- |
| -- Add_Inlined_Body -- |
| ---------------------- |
| |
| procedure Add_Inlined_Body (E : Entity_Id; N : Node_Id) is |
| |
| type Inline_Level_Type is (Dont_Inline, Inline_Call, Inline_Package); |
| -- Level of inlining for the call: Dont_Inline means no inlining, |
| -- Inline_Call means that only the call is considered for inlining, |
| -- Inline_Package means that the call is considered for inlining and |
| -- its package compiled and scanned for more inlining opportunities. |
| |
| function Is_Non_Loading_Expression_Function |
| (Id : Entity_Id) return Boolean; |
| -- Determine whether arbitrary entity Id denotes a subprogram which is |
| -- either |
| -- |
| -- * An expression function |
| -- |
| -- * A function completed by an expression function where both the |
| -- spec and body are in the same context. |
| |
| function Must_Inline return Inline_Level_Type; |
| -- Inlining is only done if the call statement N is in the main unit, |
| -- or within the body of another inlined subprogram. |
| |
| ---------------------------------------- |
| -- Is_Non_Loading_Expression_Function -- |
| ---------------------------------------- |
| |
| function Is_Non_Loading_Expression_Function |
| (Id : Entity_Id) return Boolean |
| is |
| Body_Decl : Node_Id; |
| Body_Id : Entity_Id; |
| Spec_Decl : Node_Id; |
| |
| begin |
| -- A stand-alone expression function is transformed into a spec-body |
| -- pair in-place. Since both the spec and body are in the same list, |
| -- the inlining of such an expression function does not need to load |
| -- anything extra. |
| |
| if Is_Expression_Function (Id) then |
| return True; |
| |
| -- A function may be completed by an expression function |
| |
| elsif Ekind (Id) = E_Function then |
| Spec_Decl := Unit_Declaration_Node (Id); |
| |
| if Nkind (Spec_Decl) = N_Subprogram_Declaration then |
| Body_Id := Corresponding_Body (Spec_Decl); |
| |
| if Present (Body_Id) then |
| Body_Decl := Unit_Declaration_Node (Body_Id); |
| |
| -- The inlining of a completing expression function does |
| -- not need to load anything extra when both the spec and |
| -- body are in the same context. |
| |
| return |
| Was_Expression_Function (Body_Decl) |
| and then Parent (Spec_Decl) = Parent (Body_Decl); |
| end if; |
| end if; |
| end if; |
| |
| return False; |
| end Is_Non_Loading_Expression_Function; |
| |
| ----------------- |
| -- Must_Inline -- |
| ----------------- |
| |
| function Must_Inline return Inline_Level_Type 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 Dont_Inline; |
| 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 the call is in the main unit, inline the call and compile the |
| -- package of the subprogram to find more calls to be inlined. |
| |
| if Comp = Cunit (Main_Unit) |
| or else Comp = Library_Unit (Cunit (Main_Unit)) |
| then |
| Add_Call (E); |
| return Inline_Package; |
| end if; |
| |
| -- The call is not in the main unit. See if it is in some subprogram |
| -- that can be inlined outside its unit. If so, inline the call and, |
| -- if the inlining level is set to 1, stop there; otherwise also |
| -- compile the package as above. |
| |
| 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) |
| and then not Is_Nested (Scop) |
| then |
| Add_Call (E, Scop); |
| |
| if Inline_Level = 1 then |
| return Inline_Call; |
| else |
| return Inline_Package; |
| end if; |
| end if; |
| |
| Scop := Scope (Scop); |
| end loop; |
| |
| return Dont_Inline; |
| end Must_Inline; |
| |
| Inst : Entity_Id; |
| Inst_Decl : Node_Id; |
| Level : Inline_Level_Type; |
| |
| -- Start of processing for Add_Inlined_Body |
| |
| begin |
| Append_New_Elmt (N, To => Backend_Calls); |
| |
| -- Skip subprograms that cannot or need not be inlined outside their |
| -- unit or parent subprogram. |
| |
| if Is_Abstract_Subprogram (E) |
| or else Convention (E) = Convention_Protected |
| or else In_Main_Unit_Or_Subunit (E) |
| or else Is_Nested (E) |
| then |
| return; |
| end if; |
| |
| -- Find out whether the call must be inlined. Unless the result is |
| -- Dont_Inline, Must_Inline also creates an edge for the call in the |
| -- callgraph; however, it will not be activated until after Is_Called |
| -- is set on the subprogram. |
| |
| Level := Must_Inline; |
| |
| if Level = Dont_Inline then |
| return; |
| end if; |
| |
| -- If a previous call to the subprogram has been inlined, nothing to do |
| |
| if Is_Called (E) then |
| return; |
| end if; |
| |
| -- If the subprogram is an instance, then inline the instance |
| |
| if Is_Generic_Instance (E) then |
| Add_Inlined_Instance (E); |
| end if; |
| |
| -- Mark the subprogram as called |
| |
| Set_Is_Called (E); |
| |
| -- If the call was generated by the compiler and is to a subprogram in |
| -- a run-time unit, we need to suppress debugging information for it, |
| -- so that the code that is eventually inlined will not affect the |
| -- debugging of the program. We do not do it if the call comes from |
| -- source because, even if the call is inlined, the user may expect it |
| -- to be present in the debugging information. |
| |
| if not Comes_From_Source (N) |
| and then In_Extended_Main_Source_Unit (N) |
| and then Is_Predefined_Unit (Get_Source_Unit (E)) |
| then |
| Set_Needs_Debug_Info (E, False); |
| end if; |
| |
| -- If the subprogram is an expression function, or is completed by one |
| -- where both the spec and body are in the same context, then there is |
| -- no need to load any package body since the body of the function is |
| -- in the spec. |
| |
| if Is_Non_Loading_Expression_Function (E) then |
| return; |
| end if; |
| |
| -- Find unit containing E, and add to list of inlined bodies if needed. |
| -- 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. |
| |
| declare |
| Pack : constant Entity_Id := Get_Code_Unit_Entity (E); |
| |
| begin |
| if Pack = E then |
| Inlined_Bodies.Increment_Last; |
| Inlined_Bodies.Table (Inlined_Bodies.Last) := E; |
| |
| else |
| pragma Assert (Ekind (Pack) = E_Package); |
| |
| -- If the subprogram is within an instance, inline the instance |
| |
| if Comes_From_Source (E) then |
| Inst := Scope (E); |
| |
| while Present (Inst) and then Inst /= Standard_Standard loop |
| exit when Is_Generic_Instance (Inst); |
| Inst := Scope (Inst); |
| end loop; |
| |
| if Present (Inst) |
| and then Is_Generic_Instance (Inst) |
| and then not Is_Called (Inst) |
| then |
| Inst_Decl := Unit_Declaration_Node (Inst); |
| |
| -- Do not inline the instance if the body already exists, |
| -- or the instance node is simply missing. |
| |
| if Present (Corresponding_Body (Inst_Decl)) |
| or else (Nkind (Parent (Inst_Decl)) /= N_Compilation_Unit |
| and then No (Next (Inst_Decl))) |
| then |
| Set_Is_Called (Inst); |
| else |
| Add_Inlined_Instance (Inst); |
| end if; |
| end if; |
| end if; |
| |
| -- If the unit containing E is an instance, nothing more to do |
| |
| 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. |
| -- Do not inline it either if it is in the main unit. |
| -- Extend the -gnatn2 processing to -gnatn1 for Inline_Always |
| -- calls if the back end takes care of inlining the call. |
| -- Note that Level is in Inline_Call | Inline_Package here. |
| |
| elsif ((Level = Inline_Call |
| and then Has_Pragma_Inline_Always (E) |
| and then Back_End_Inlining) |
| or else Level = Inline_Package) |
| and then not Is_Inlined (Pack) |
| and then not Is_Internal (E) |
| and then not In_Main_Unit_Or_Subunit (Pack) |
| then |
| Set_Is_Inlined (Pack); |
| Inlined_Bodies.Increment_Last; |
| Inlined_Bodies.Table (Inlined_Bodies.Last) := Pack; |
| end if; |
| end if; |
| |
| -- Ensure that Analyze_Inlined_Bodies will be invoked after |
| -- completing the analysis of the current unit. |
| |
| Inline_Processing_Required := True; |
| end; |
| end Add_Inlined_Body; |
| |
| -------------------------- |
| -- Add_Inlined_Instance -- |
| -------------------------- |
| |
| procedure Add_Inlined_Instance (E : Entity_Id) is |
| Decl_Node : constant Node_Id := Unit_Declaration_Node (E); |
| Index : Int; |
| |
| begin |
| -- This machinery is only used with back-end inlining |
| |
| if not Back_End_Inlining then |
| return; |
| end if; |
| |
| -- Register the instance in the list |
| |
| Append_New_Elmt (Decl_Node, To => Backend_Instances); |
| |
| -- Retrieve the index of its corresponding pending instantiation |
| -- and mark this corresponding pending instantiation as needed. |
| |
| Index := To_Pending_Instantiations.Get (Decl_Node); |
| if Index >= 0 then |
| Called_Pending_Instantiations.Append (Index); |
| else |
| pragma Assert (False); |
| null; |
| end if; |
| |
| Set_Is_Called (E); |
| end Add_Inlined_Instance; |
| |
| ---------------------------- |
| -- Add_Inlined_Subprogram -- |
| ---------------------------- |
| |
| procedure Add_Inlined_Subprogram (E : Entity_Id) is |
| Decl : constant Node_Id := Parent (Declaration_Node (E)); |
| Pack : constant Entity_Id := Get_Code_Unit_Entity (E); |
| |
| procedure Register_Backend_Inlined_Subprogram (Subp : Entity_Id); |
| -- Append Subp to the list of subprograms inlined by the backend |
| |
| procedure Register_Backend_Not_Inlined_Subprogram (Subp : Entity_Id); |
| -- Append Subp to the list of subprograms that cannot be inlined by |
| -- the backend. |
| |
| ----------------------------------------- |
| -- Register_Backend_Inlined_Subprogram -- |
| ----------------------------------------- |
| |
| procedure Register_Backend_Inlined_Subprogram (Subp : Entity_Id) is |
| begin |
| Append_New_Elmt (Subp, To => Backend_Inlined_Subps); |
| end Register_Backend_Inlined_Subprogram; |
| |
| --------------------------------------------- |
| -- Register_Backend_Not_Inlined_Subprogram -- |
| --------------------------------------------- |
| |
| procedure Register_Backend_Not_Inlined_Subprogram (Subp : Entity_Id) is |
| begin |
| Append_New_Elmt (Subp, To => Backend_Not_Inlined_Subps); |
| end Register_Backend_Not_Inlined_Subprogram; |
| |
| -- Start of processing for Add_Inlined_Subprogram |
| |
| begin |
| -- We can inline the subprogram if its unit is known to be inlined or is |
| -- an instance whose body will be analyzed anyway or the subprogram was |
| -- generated as a body by the compiler (for example an initialization |
| -- procedure) or its declaration was provided along with the body (for |
| -- example an expression function) and it does not declare types with |
| -- nontrivial initialization procedures. |
| |
| if (Is_Inlined (Pack) |
| or else Is_Generic_Instance (Pack) |
| or else Nkind (Decl) = N_Subprogram_Body |
| or else Present (Corresponding_Body (Decl))) |
| and then not Has_Initialized_Type (E) |
| then |
| Register_Backend_Inlined_Subprogram (E); |
| |
| 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; |
| |
| else |
| Register_Backend_Not_Inlined_Subprogram (E); |
| end if; |
| end Add_Inlined_Subprogram; |
| |
| -------------------------------- |
| -- Add_Pending_Instantiation -- |
| -------------------------------- |
| |
| procedure Add_Pending_Instantiation (Inst : Node_Id; Act_Decl : Node_Id) is |
| Act_Decl_Id : Entity_Id; |
| Index : Int; |
| |
| begin |
| -- Here is a defense against a ludicrous number of instantiations |
| -- caused by a circular set of instantiation attempts. |
| |
| if Pending_Instantiations.Last + 1 >= Maximum_Instantiations then |
| Error_Msg_Uint_1 := UI_From_Int (Maximum_Instantiations); |
| Error_Msg_N ("too many instantiations, exceeds max of^", Inst); |
| Error_Msg_N ("\limit can be changed using -gnateinn switch", Inst); |
| raise Unrecoverable_Error; |
| end if; |
| |
| -- Capture the body of the generic instantiation along with its context |
| -- for later processing by Instantiate_Bodies. |
| |
| Pending_Instantiations.Append |
| ((Act_Decl => Act_Decl, |
| Config_Switches => Save_Config_Switches, |
| Current_Sem_Unit => Current_Sem_Unit, |
| Expander_Status => Expander_Active, |
| Inst_Node => Inst, |
| Local_Suppress_Stack_Top => Local_Suppress_Stack_Top, |
| Scope_Suppress => Scope_Suppress, |
| Warnings => Save_Warnings)); |
| |
| -- With back-end inlining, also associate the index to the instantiation |
| |
| if Back_End_Inlining then |
| Act_Decl_Id := Defining_Entity (Act_Decl); |
| Index := Pending_Instantiations.Last; |
| |
| To_Pending_Instantiations.Set (Act_Decl, Index); |
| |
| -- If an instantiation is in the main unit or subunit, or is a nested |
| -- subprogram, then its body is needed as per the analysis done in |
| -- Analyze_Package_Instantiation & Analyze_Subprogram_Instantiation. |
| |
| if In_Main_Unit_Or_Subunit (Act_Decl_Id) |
| or else (Is_Subprogram (Act_Decl_Id) |
| and then Is_Nested (Act_Decl_Id)) |
| then |
| Called_Pending_Instantiations.Append (Index); |
| |
| Set_Is_Called (Act_Decl_Id); |
| end if; |
| end if; |
| end Add_Pending_Instantiation; |
| |
| ------------------------ |
| -- 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; |
| |
| 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).Next := No_Subp; |
| Inlined.Table (Inlined.Last).First_Succ := No_Succ; |
| Inlined.Table (Inlined.Last).Main_Call := False; |
| Inlined.Table (Inlined.Last).Processed := False; |
| 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; |
| Subp : Subp_Index; |
| S : Succ_Index; |
| |
| type Pending_Index is new Nat; |
| |
| package Pending_Inlined is new Table.Table ( |
| Table_Component_Type => Subp_Index, |
| Table_Index_Type => Pending_Index, |
| Table_Low_Bound => 1, |
| Table_Initial => Alloc.Inlined_Initial, |
| Table_Increment => Alloc.Inlined_Increment, |
| Table_Name => "Pending_Inlined"); |
| -- The workpile used to compute the transitive closure |
| |
| -- Start of processing for Analyze_Inlined_Bodies |
| |
| begin |
| 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 if it exists and contains inlineable entities, |
| -- unless it is 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))) |
| and then Body_Needed_For_Inlining |
| (Defining_Entity (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); |
| |
| 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); |
| end if; |
| end if; |
| end; |
| end if; |
| |
| J := J + 1; |
| |
| if J > Inlined_Bodies.Last then |
| |
| -- The analysis of required bodies may have produced additional |
| -- generic instantiations. To obtain further inlining, we need |
| -- to perform another round of generic body instantiations. |
| |
| Instantiate_Bodies; |
| |
| -- Symmetrically, the instantiation of required generic bodies |
| -- may have caused additional bodies to be inlined. To obtain |
| -- further inlining, we keep looping over the inlined bodies. |
| end if; |
| end loop; |
| |
| -- 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 compilation unit. |
| |
| for Index in Inlined.First .. Inlined.Last loop |
| if not Is_Called (Inlined.Table (Index).Name) then |
| |
| -- This means that Add_Inlined_Body added the subprogram to the |
| -- table but wasn't able to handle its code unit. Do nothing. |
| |
| Inlined.Table (Index).Processed := True; |
| |
| elsif Inlined.Table (Index).Main_Call then |
| Pending_Inlined.Increment_Last; |
| Pending_Inlined.Table (Pending_Inlined.Last) := Index; |
| Inlined.Table (Index).Processed := True; |
| |
| else |
| Set_Is_Called (Inlined.Table (Index).Name, False); |
| end if; |
| end loop; |
| |
| -- Iterate over the workpile until it is emptied, propagating the |
| -- Is_Called flag to the successors of the processed subprogram. |
| |
| while Pending_Inlined.Last >= Pending_Inlined.First loop |
| Subp := Pending_Inlined.Table (Pending_Inlined.Last); |
| Pending_Inlined.Decrement_Last; |
| |
| S := Inlined.Table (Subp).First_Succ; |
| |
| while S /= No_Succ loop |
| Subp := Successors.Table (S).Subp; |
| |
| if not Inlined.Table (Subp).Processed then |
| Set_Is_Called (Inlined.Table (Subp).Name); |
| Pending_Inlined.Increment_Last; |
| Pending_Inlined.Table (Pending_Inlined.Last) := Subp; |
| Inlined.Table (Subp).Processed := True; |
| end if; |
| |
| S := Successors.Table (S).Next; |
| end loop; |
| end loop; |
| |
| -- Finally add the called subprograms to the list of inlined |
| -- subprograms for the unit. |
| |
| for Index in Inlined.First .. Inlined.Last loop |
| declare |
| E : constant Subprogram_Kind_Id := Inlined.Table (Index).Name; |
| |
| begin |
| if Is_Called (E) and then not Is_Ignored_Ghost_Entity (E) then |
| Add_Inlined_Subprogram (E); |
| end if; |
| end; |
| end loop; |
| |
| Pop_Scope; |
| end if; |
| end Analyze_Inlined_Bodies; |
| |
| -------------------------- |
| -- Build_Body_To_Inline -- |
| -------------------------- |
| |
| procedure Build_Body_To_Inline (N : Node_Id; Spec_Id : Entity_Id) is |
| Decl : constant Node_Id := Unit_Declaration_Node (Spec_Id); |
| Original_Body : Node_Id; |
| Body_To_Analyze : Node_Id; |
| Max_Size : constant := 10; |
| |
| function Has_Extended_Return return Boolean; |
| -- This function returns True if the subprogram has an extended return |
| -- statement. |
| |
| function Has_Pending_Instantiation return Boolean; |
| -- If some enclosing body contains instantiations that appear before |
| -- the corresponding generic body, the enclosing body has a freeze node |
| -- 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. |
| |
| 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. It returns False for subprogram with |
| -- a single return as last statement inside one or more blocks, as |
| -- inlining would generate gotos in that case as well (although the |
| -- goto is useless in that case). |
| |
| 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_Extended_Return -- |
| ------------------------- |
| |
| function Has_Extended_Return return Boolean is |
| Body_To_Inline : constant Node_Id := N; |
| |
| function Check_Return (N : Node_Id) return Traverse_Result; |
| -- Returns OK on node N if this is not an extended return statement |
| |
| ------------------ |
| -- Check_Return -- |
| ------------------ |
| |
| function Check_Return (N : Node_Id) return Traverse_Result is |
| begin |
| case Nkind (N) is |
| when N_Extended_Return_Statement => |
| return Abandon; |
| |
| -- Skip locally declared subprogram bodies inside the body to |
| -- inline, as the return statements inside those do not count. |
| |
| when N_Subprogram_Body => |
| if N = Body_To_Inline then |
| return OK; |
| else |
| return Skip; |
| end if; |
| |
| when others => |
| return OK; |
| end case; |
| end Check_Return; |
| |
| function Check_All_Returns is new Traverse_Func (Check_Return); |
| |
| -- Start of processing for Has_Extended_Return |
| |
| begin |
| return Check_All_Returns (N) /= OK; |
| end Has_Extended_Return; |
| |
| ------------------------------- |
| -- Has_Pending_Instantiation -- |
| ------------------------------- |
| |
| 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 |
| Body_To_Inline : constant Node_Id := N; |
| 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 |
| case Nkind (N) is |
| when N_Extended_Return_Statement |
| | N_Simple_Return_Statement |
| => |
| if N = Last_Statement then |
| return OK; |
| else |
| return Abandon; |
| end if; |
| |
| -- Skip locally declared subprogram bodies inside the body to |
| -- inline, as the return statements inside those do not count. |
| |
| when N_Subprogram_Body => |
| if N = Body_To_Inline then |
| return OK; |
| else |
| return Skip; |
| end if; |
| |
| when others => |
| return OK; |
| end case; |
| end Check_Return; |
| |
| function Check_All_Returns is new Traverse_Func (Check_Return); |
| |
| -- Start of processing for Has_Single_Return_In_GNATprove_Mode |
| |
| begin |
| -- Retrieve the last statement |
| |
| Last_Statement := Last (Statements (Handled_Statement_Sequence (N))); |
| |
| -- 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; |
| |
| -------------------------- |
| -- Uses_Secondary_Stack -- |
| -------------------------- |
| |
| function Uses_Secondary_Stack (Bod : 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, Spec_Id); |
| return Abandon; |
| else |
| return OK; |
| end if; |
| end Check_Call; |
| |
| function Check_Calls is new Traverse_Func (Check_Call); |
| |
| begin |
| return Check_Calls (Bod) = Abandon; |
| end Uses_Secondary_Stack; |
| |
| -- Start of processing for Build_Body_To_Inline |
| |
| begin |
| -- Return immediately if done already |
| |
| if Nkind (Decl) = N_Subprogram_Declaration |
| and then Present (Body_To_Inline (Decl)) |
| then |
| return; |
| |
| -- 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, Spec_Id); |
| return; |
| |
| -- Functions that return controlled types cannot currently be inlined |
| -- because they require secondary stack handling; controlled actions |
| -- may also interfere in complex ways with inlining. |
| |
| elsif Ekind (Spec_Id) = E_Function |
| and then Needs_Finalization (Etype (Spec_Id)) |
| then |
| Cannot_Inline |
| ("cannot inline & (controlled return type)?", N, Spec_Id); |
| return; |
| end if; |
| |
| if Has_Excluded_Declaration (Spec_Id, Declarations (N)) then |
| return; |
| end if; |
| |
| 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))), |
| Spec_Id); |
| return; |
| |
| elsif Has_Excluded_Statement |
| (Spec_Id, Statements (Handled_Statement_Sequence (N))) |
| then |
| return; |
| end if; |
| end if; |
| |
| -- We do not inline a subprogram that is too large, unless it is marked |
| -- Inline_Always or we are in GNATprove mode. This pragma does not |
| -- suppress the other checks on inlining (forbidden declarations, |
| -- handlers, etc). |
| |
| 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, Spec_Id); |
| return; |
| end if; |
| |
| if Has_Pending_Instantiation then |
| Cannot_Inline |
| ("cannot inline& (forward instance within enclosing body)?", |
| N, Spec_Id); |
| return; |
| end if; |
| |
| -- Within an instance, the body to inline must be treated as a nested |
| -- generic, so that the proper global references are preserved. |
| |
| -- Note that we do not do this at the library level, because it is not |
| -- needed, and furthermore this causes trouble if front-end inlining |
| -- is activated (-gnatN). |
| |
| if In_Instance and then Scope (Current_Scope) /= Standard_Standard then |
| Save_Env (Scope (Current_Scope), Scope (Current_Scope)); |
| Original_Body := Copy_Generic_Node (N, Empty, Instantiating => True); |
| else |
| Original_Body := Copy_Separate_Tree (N); |
| end if; |
| |
| -- We need to capture references to the formals in order to substitute |
| -- the actuals at the point of inlining, i.e. instantiation. To treat |
| -- the formals as globals to the body to inline, we nest it within a |
| -- dummy parameterless subprogram, declared within the real one. To |
| -- avoid generating an internal name (which is never public, and which |
| -- affects serial numbers of other generated names), we use an internal |
| -- symbol that cannot conflict with user declarations. |
| |
| Set_Parameter_Specifications (Specification (Original_Body), No_List); |
| Set_Defining_Unit_Name |
| (Specification (Original_Body), |
| Make_Defining_Identifier (Sloc (N), Name_uParent)); |
| Set_Corresponding_Spec (Original_Body, Empty); |
| |
| -- Remove all aspects/pragmas that have no meaning in an inlined body |
| |
| Remove_Aspects_And_Pragmas (Original_Body); |
| |
| Body_To_Analyze := |
| Copy_Generic_Node (Original_Body, Empty, Instantiating => False); |
| |
| -- Set return type of function, which is also global and does not need |
| -- to be resolved. |
| |
| if Ekind (Spec_Id) = E_Function then |
| Set_Result_Definition |
| (Specification (Body_To_Analyze), |
| New_Occurrence_Of (Etype (Spec_Id), Sloc (N))); |
| end if; |
| |
| if No (Declarations (N)) then |
| Set_Declarations (N, New_List (Body_To_Analyze)); |
| else |
| Append (Body_To_Analyze, Declarations (N)); |
| end if; |
| |
| Start_Generic; |
| |
| Analyze (Body_To_Analyze); |
| Push_Scope (Defining_Entity (Body_To_Analyze)); |
| Save_Global_References (Original_Body); |
| End_Scope; |
| Remove (Body_To_Analyze); |
| |
| End_Generic; |
| |
| -- Restore environment if previously saved |
| |
| if In_Instance and then Scope (Current_Scope) /= Standard_Standard then |
| Restore_Env; |
| end if; |
| |
| -- Functions that return unconstrained composite types require |
| -- secondary stack handling, and cannot currently be inlined, unless |
| -- all return statements return a local variable that is the first |
| -- local declaration in the body. We had to delay this check until |
| -- the body of the function is analyzed since Has_Single_Return() |
| -- requires a minimum decoration. |
| |
| if Ekind (Spec_Id) = E_Function |
| and then not Is_Scalar_Type (Etype (Spec_Id)) |
| and then not Is_Access_Type (Etype (Spec_Id)) |
| and then not Is_Constrained (Etype (Spec_Id)) |
| then |
| if not Has_Single_Return (Body_To_Analyze) |
| |
| -- Skip inlining if the function returns an unconstrained type |
| -- using an extended return statement, since this part of the |
| -- new inlining model is not yet supported by the current |
| -- implementation. |
| |
| or else (Returns_Unconstrained_Type (Spec_Id) |
| and then Has_Extended_Return) |
| then |
| Cannot_Inline |
| ("cannot inline & (unconstrained return type)?", N, Spec_Id); |
| return; |
| end if; |
| |
| -- If secondary stack is used, there is no point in inlining. We have |
| -- already issued the warning in this case, so nothing to do. |
| |
| elsif Uses_Secondary_Stack (Body_To_Analyze) then |
| return; |
| end if; |
| |
| Set_Body_To_Inline (Decl, Original_Body); |
| Mutate_Ekind (Defining_Entity (Original_Body), Ekind (Spec_Id)); |
| Set_Is_Inlined (Spec_Id); |
| end Build_Body_To_Inline; |
| |
| ------------------------------------------- |
| -- Call_Can_Be_Inlined_In_GNATprove_Mode -- |
| ------------------------------------------- |
| |
| function Call_Can_Be_Inlined_In_GNATprove_Mode |
| (N : Node_Id; |
| Subp : Entity_Id) return Boolean |
| is |
| F : Entity_Id; |
| A : Node_Id; |
| |
| begin |
| F := First_Formal (Subp); |
| A := First_Actual (N); |
| while Present (F) loop |
| if Ekind (F) /= E_Out_Parameter |
| and then not Same_Type (Etype (F), Etype (A)) |
| and then |
| (Is_By_Reference_Type (Etype (A)) |
| or else Is_Limited_Type (Etype (A))) |
| then |
| return False; |
| end if; |
| |
| Next_Formal (F); |
| Next_Actual (A); |
| end loop; |
| |
| return True; |
| end Call_Can_Be_Inlined_In_GNATprove_Mode; |
| |
| -------------------------------------- |
| -- Can_Be_Inlined_In_GNATprove_Mode -- |
| -------------------------------------- |
| |
| function Can_Be_Inlined_In_GNATprove_Mode |
| (Spec_Id : Entity_Id; |
| Body_Id : Entity_Id) return Boolean |
| is |
| function Has_Formal_Or_Result_Of_Deep_Type |
| (Id : Entity_Id) return Boolean; |
| -- Returns true if the subprogram has at least one formal parameter or |
| -- a return type of a deep type: either an access type or a composite |
| -- type containing an access type. |
| |
| function Has_Formal_With_Discriminant_Dependent_Fields |
| (Id : Entity_Id) return Boolean; |
| -- Returns true if the subprogram has at least one formal parameter of |
| -- an unconstrained record type with per-object constraints on component |
| -- types. |
| |
| function Has_Some_Contract (Id : Entity_Id) return Boolean; |
| -- Return True if subprogram Id has any contract. The presence of |
| -- Extensions_Visible or Volatile_Function is also considered as a |
| -- contract here. |
| |
| function Is_Unit_Subprogram (Id : Entity_Id) return Boolean; |
| -- Return True if subprogram Id defines a compilation unit |
| |
| function In_Package_Spec (Id : Entity_Id) return Boolean; |
| -- Return True if subprogram Id is defined in the package specification, |
| -- either its visible or private part. |
| |
| function Maybe_Traversal_Function (Id : Entity_Id) return Boolean; |
| -- Return True if subprogram Id could be a traversal function, as |
| -- defined in SPARK RM 3.10. This is only a safe approximation, as the |
| -- knowledge of the SPARK boundary is needed to determine exactly |
| -- traversal functions. |
| |
| --------------------------------------- |
| -- Has_Formal_Or_Result_Of_Deep_Type -- |
| --------------------------------------- |
| |
| function Has_Formal_Or_Result_Of_Deep_Type |
| (Id : Entity_Id) return Boolean |
| is |
| function Is_Deep (Typ : Entity_Id) return Boolean; |
| -- Return True if Typ is deep: either an access type or a composite |
| -- type containing an access type. |
| |
| ------------- |
| -- Is_Deep -- |
| ------------- |
| |
| function Is_Deep (Typ : Entity_Id) return Boolean is |
| begin |
| case Type_Kind'(Ekind (Typ)) is |
| when Access_Kind => |
| return True; |
| |
| when E_Array_Type |
| | E_Array_Subtype |
| => |
| return Is_Deep (Component_Type (Typ)); |
| |
| when Record_Kind => |
| declare |
| Comp : Entity_Id := First_Component_Or_Discriminant (Typ); |
| begin |
| while Present (Comp) loop |
| if Is_Deep (Etype (Comp)) then |
| return True; |
| end if; |
| Next_Component_Or_Discriminant (Comp); |
| end loop; |
| end; |
| return False; |
| |
| when Scalar_Kind |
| | E_String_Literal_Subtype |
| | Concurrent_Kind |
| | Incomplete_Kind |
| | E_Exception_Type |
| | E_Subprogram_Type |
| => |
| return False; |
| |
| when E_Private_Type |
| | E_Private_Subtype |
| | E_Limited_Private_Type |
| | E_Limited_Private_Subtype |
| => |
| -- Conservatively consider that the type might be deep if |
| -- its completion has not been seen yet. |
| |
| if No (Underlying_Type (Typ)) then |
| return True; |
| |
| -- Do not peek under a private type if its completion has |
| -- SPARK_Mode Off. In such a case, a deep type is considered |
| -- by GNATprove to be not deep. |
| |
| elsif Present (Full_View (Typ)) |
| and then Present (SPARK_Pragma (Full_View (Typ))) |
| and then Get_SPARK_Mode_From_Annotation |
| (SPARK_Pragma (Full_View (Typ))) = Off |
| then |
| return False; |
| |
| -- Otherwise peek under the private type. |
| |
| else |
| return Is_Deep (Underlying_Type (Typ)); |
| end if; |
| end case; |
| end Is_Deep; |
| |
| -- Local variables |
| |
| Subp_Id : constant Entity_Id := Ultimate_Alias (Id); |
| Formal : Entity_Id; |
| Formal_Typ : Entity_Id; |
| |
| -- Start of processing for Has_Formal_Or_Result_Of_Deep_Type |
| |
| begin |
| -- Inspect all parameters of the subprogram looking for a formal |
| -- of a deep type. |
| |
| Formal := First_Formal (Subp_Id); |
| while Present (Formal) loop |
| Formal_Typ := Etype (Formal); |
| |
| if Is_Deep (Formal_Typ) then |
| return True; |
| end if; |
| |
| Next_Formal (Formal); |
| end loop; |
| |
| -- Check whether this is a function whose return type is deep |
| |
| if Ekind (Subp_Id) = E_Function |
| and then Is_Deep (Etype (Subp_Id)) |
| then |
| return True; |
| end if; |
| |
| return False; |
| end Has_Formal_Or_Result_Of_Deep_Type; |
| |
| --------------------------------------------------- |
| -- Has_Formal_With_Discriminant_Dependent_Fields -- |
| --------------------------------------------------- |
| |
| function Has_Formal_With_Discriminant_Dependent_Fields |
| (Id : Entity_Id) return Boolean |
| is |
| function Has_Discriminant_Dependent_Component |
| (Typ : Entity_Id) return Boolean; |
| -- Determine whether unconstrained record type Typ has at least one |
| -- component that depends on a discriminant. |
| |
| ------------------------------------------ |
| -- Has_Discriminant_Dependent_Component -- |
| ------------------------------------------ |
| |
| function Has_Discriminant_Dependent_Component |
| (Typ : Entity_Id) return Boolean |
| is |
| Comp : Entity_Id; |
| |
| begin |
| -- Inspect all components of the record type looking for one that |
| -- depends on a discriminant. |
| |
| Comp := First_Component (Typ); |
| while Present (Comp) loop |
| if Has_Discriminant_Dependent_Constraint (Comp) then |
| return True; |
| end if; |
| |
| Next_Component (Comp); |
| end loop; |
| |
| return False; |
| end Has_Discriminant_Dependent_Component; |
| |
| -- Local variables |
| |
| Subp_Id : constant Entity_Id := Ultimate_Alias (Id); |
| Formal : Entity_Id; |
| Formal_Typ : Entity_Id; |
| |
| -- Start of processing for |
| -- Has_Formal_With_Discriminant_Dependent_Fields |
| |
| begin |
| -- Inspect all parameters of the subprogram looking for a formal |
| -- of an unconstrained record type with at least one discriminant |
| -- dependent component. |
| |
| Formal := First_Formal (Subp_Id); |
| while Present (Formal) loop |
| Formal_Typ := Etype (Formal); |
| |
| if Is_Record_Type (Formal_Typ) |
| and then not Is_Constrained (Formal_Typ) |
| and then Has_Discriminant_Dependent_Component (Formal_Typ) |
| then |
| return True; |
| end if; |
| |
| Next_Formal (Formal); |
| end loop; |
| |
| return False; |
| end Has_Formal_With_Discriminant_Dependent_Fields; |
| |
| ----------------------- |
| -- Has_Some_Contract -- |
| ----------------------- |
| |
| function Has_Some_Contract (Id : Entity_Id) return Boolean is |
| Items : Node_Id; |
| |
| begin |
| -- A call to an expression function may precede the actual body which |
| -- is inserted at the end of the enclosing declarations. Ensure that |
| -- the related entity is decorated before inspecting the contract. |
| |
| if Is_Subprogram_Or_Generic_Subprogram (Id) then |
| Items := Contract (Id); |
| |
| -- Note that Classifications is not Empty when Extensions_Visible |
| -- or Volatile_Function is present, which causes such subprograms |
| -- to be considered to have a contract here. This is fine as we |
| -- want to avoid inlining these too. |
| |
| return Present (Items) |
| and then (Present (Pre_Post_Conditions (Items)) or else |
| Present (Contract_Test_Cases (Items)) or else |
| Present (Classifications (Items))); |
| end if; |
| |
| return False; |
| end Has_Some_Contract; |
| |
| --------------------- |
| -- In_Package_Spec -- |
| --------------------- |
| |
| function In_Package_Spec (Id : Entity_Id) return Boolean is |
| P : constant Node_Id := Parent (Subprogram_Spec (Id)); |
| -- Parent of the subprogram's declaration |
| |
| begin |
| return Nkind (Enclosing_Declaration (P)) = N_Package_Declaration; |
| end In_Package_Spec; |
| |
| ------------------------ |
| -- Is_Unit_Subprogram -- |
| ------------------------ |
| |
| function Is_Unit_Subprogram (Id : Entity_Id) return Boolean is |
| Decl : Node_Id := Parent (Parent (Id)); |
| begin |
| if Nkind (Parent (Id)) = N_Defining_Program_Unit_Name then |
| Decl := Parent (Decl); |
| end if; |
| |
| return Nkind (Parent (Decl)) = N_Compilation_Unit; |
| end Is_Unit_Subprogram; |
| |
| ------------------------------ |
| -- Maybe_Traversal_Function -- |
| ------------------------------ |
| |
| function Maybe_Traversal_Function (Id : Entity_Id) return Boolean is |
| begin |
| return Ekind (Id) = E_Function |
| |
| -- Only traversal functions return an anonymous access-to-object |
| -- type in SPARK. |
| |
| and then Is_Anonymous_Access_Type (Etype (Id)); |
| end Maybe_Traversal_Function; |
| |
| -- Local declarations |
| |
| Id : Entity_Id; |
| -- Procedure or function entity for the subprogram |
| |
| -- Start of processing for Can_Be_Inlined_In_GNATprove_Mode |
| |
| begin |
| pragma Assert (Present (Spec_Id) or else Present (Body_Id)); |
| |
| if Present (Spec_Id) then |
| Id := Spec_Id; |
| else |
| Id := Body_Id; |
| end if; |
| |
| -- Only local subprograms without contracts are inlined in GNATprove |
| -- mode, as these are the subprograms which a user is not interested in |
| -- analyzing in isolation, but rather in the context of their call. This |
| -- is a convenient convention, that could be changed for an explicit |
| -- pragma/aspect one day. |
| |
| -- In a number of special cases, inlining is not desirable or not |
| -- possible, see below. |
| |
| -- Do not inline unit-level subprograms |
| |
| if Is_Unit_Subprogram (Id) then |
| return False; |
| |
| -- Do not inline subprograms declared in package specs, because they are |
| -- not local, i.e. can be called either from anywhere (if declared in |
| -- visible part) or from the child units (if declared in private part). |
| |
| elsif In_Package_Spec (Id) then |
| return False; |
| |
| -- Do not inline subprograms declared in other units. This is important |
| -- in particular for subprograms defined in the private part of a |
| -- package spec, when analyzing one of its child packages, as otherwise |
| -- we issue spurious messages about the impossibility to inline such |
| -- calls. |
| |
| elsif not In_Extended_Main_Code_Unit (Id) then |
| return False; |
| |
| -- Do not inline dispatching operations, as only their static calls |
| -- can be analyzed in context, and not their dispatching calls. |
| |
| elsif Is_Dispatching_Operation (Id) then |
| return False; |
| |
| -- Do not inline subprograms marked No_Return, possibly used for |
| -- signaling errors, which GNATprove handles specially. |
| |
| elsif No_Return (Id) then |
| return False; |
| |
| -- Do not inline subprograms that have a contract on the spec or the |
| -- body. Use the contract(s) instead in GNATprove. This also prevents |
| -- inlining of subprograms with Extensions_Visible or Volatile_Function. |
| |
| elsif (Present (Spec_Id) and then Has_Some_Contract (Spec_Id)) |
| or else |
| (Present (Body_Id) and then Has_Some_Contract (Body_Id)) |
| then |
| return False; |
| |
| -- Do not inline expression functions, which are directly inlined at the |
| -- prover level. |
| |
| elsif (Present (Spec_Id) and then Is_Expression_Function (Spec_Id)) |
| or else |
| (Present (Body_Id) and then Is_Expression_Function (Body_Id)) |
| then |
| return False; |
| |
| -- Do not inline generic subprogram instances. The visibility rules of |
| -- generic instances plays badly with inlining. |
| |
| elsif Is_Generic_Instance (Spec_Id) then |
| return False; |
| |
| -- Only inline subprograms whose spec is marked SPARK_Mode On. For |
| -- the subprogram body, a similar check is performed after the body |
| -- is analyzed, as this is where a pragma SPARK_Mode might be inserted. |
| |
| elsif Present (Spec_Id) |
| and then |
| (No (SPARK_Pragma (Spec_Id)) |
| or else |
| Get_SPARK_Mode_From_Annotation (SPARK_Pragma (Spec_Id)) /= On) |
| then |
| return False; |
| |
| -- Do not inline subprograms and entries defined inside protected types, |
| -- which typically are not helper subprograms, which also avoids getting |
| -- spurious messages on calls that cannot be inlined. |
| |
| elsif Within_Protected_Type (Id) then |
| return False; |
| |
| -- Do not inline predicate functions (treated specially by GNATprove) |
| |
| elsif Is_Predicate_Function (Id) then |
| return False; |
| |
| -- Do not inline subprograms with a parameter of an unconstrained |
| -- record type if it has discrimiant dependent fields. Indeed, with |
| -- such parameters, the frontend cannot always ensure type compliance |
| -- in record component accesses (in particular with records containing |
| -- packed arrays). |
| |
| elsif Has_Formal_With_Discriminant_Dependent_Fields (Id) then |
| return False; |
| |
| -- Do not inline subprograms with a formal parameter or return type of |
| -- a deep type, as in that case inlining might generate code that |
| -- violates borrow-checking rules of SPARK 3.10 even if the original |
| -- code did not. |
| |
| elsif Has_Formal_Or_Result_Of_Deep_Type (Id) then |
| return False; |
| |
| -- Do not inline subprograms which may be traversal functions. Such |
| -- inlining introduces temporary variables of named access type for |
| -- which assignments are move instead of borrow/observe, possibly |
| -- leading to spurious errors when checking SPARK rules related to |
| -- pointer usage. |
| |
| elsif Maybe_Traversal_Function (Id) then |
| return False; |
| |
| -- Otherwise, this is a subprogram declared inside the private part of a |
| -- package, or inside a package body, or locally in a subprogram, and it |
| -- does not have any contract. Inline it. |
| |
| else |
| return True; |
| end if; |
| end Can_Be_Inlined_In_GNATprove_Mode; |
| |
| ------------------- |
| -- Cannot_Inline -- |
| ------------------- |
| |
| procedure Cannot_Inline |
| (Msg : String; |
| N : Node_Id; |
| Subp : Entity_Id; |
| Is_Serious : Boolean := False; |
| Suppress_Info : Boolean := False) |
| is |
| begin |
| -- In GNATprove mode, inlining is the technical means by which the |
| -- higher-level goal of contextual analysis is reached, so issue |
| -- messages about failure to apply contextual analysis to a |
| -- subprogram, rather than failure to inline it. |
| |
| if GNATprove_Mode |
| and then Msg (Msg'First .. Msg'First + 12) = "cannot inline" |
| then |
| declare |
| Len1 : constant Positive := |
| String (String'("cannot inline"))'Length; |
| Len2 : constant Positive := |
| String (String'("info: no contextual analysis of"))'Length; |
| |
| New_Msg : String (1 .. Msg'Length + Len2 - Len1); |
| |
| begin |
| New_Msg (1 .. Len2) := "info: no contextual analysis of"; |
| New_Msg (Len2 + 1 .. Msg'Length + Len2 - Len1) := |
| Msg (Msg'First + Len1 .. Msg'Last); |
| Cannot_Inline (New_Msg, N, Subp, Is_Serious, Suppress_Info); |
| return; |
| end; |
| end if; |
| |
| pragma Assert (Msg (Msg'Last) = '?'); |
| |
| -- Legacy front-end inlining model |
| |
| if not Back_End_Inlining then |
| |
| -- Do not emit warning if this is a predefined unit which is not |
| -- the main unit. With validity checks enabled, some predefined |
| -- subprograms may contain nested subprograms and become ineligible |
| -- for inlining. |
| |
| if Is_Predefined_Unit (Get_Source_Unit (Subp)) |
| and then not In_Extended_Main_Source_Unit (Subp) |
| then |
| null; |
| |
| -- In GNATprove mode, issue an info message when -gnatd_f is set and |
| -- Suppress_Info is False, and indicate that the subprogram is not |
| -- always inlined by setting flag Is_Inlined_Always to False. |
| |
| elsif GNATprove_Mode then |
| Set_Is_Inlined_Always (Subp, False); |
| |
| if Debug_Flag_Underscore_F and not Suppress_Info then |
| Error_Msg_NE (Msg, N, Subp); |
| end if; |
| |
| elsif Has_Pragma_Inline_Always (Subp) then |
| |
| -- Remove last character (question mark) to make this into an |
| -- error, because the Inline_Always pragma cannot be obeyed. |
| |
| Error_Msg_NE (Msg (Msg'First .. Msg'Last - 1), N, Subp); |
| |
| elsif Ineffective_Inline_Warnings then |
| Error_Msg_NE (Msg & "p?", N, Subp); |
| end if; |
| |
| -- New semantics relying on back-end inlining |
| |
| elsif Is_Serious then |
| |
| -- Remove last character (question mark) to make this into an error. |
| |
| Error_Msg_NE (Msg (Msg'First .. Msg'Last - 1), N, Subp); |
| |
| -- In GNATprove mode, issue an info message when -gnatd_f is set and |
| -- Suppress_Info is False, and indicate that the subprogram is not |
| -- always inlined by setting flag Is_Inlined_Always to False. |
| |
| elsif GNATprove_Mode then |
| Set_Is_Inlined_Always (Subp, False); |
| |
| if Debug_Flag_Underscore_F and not Suppress_Info then |
| Error_Msg_NE (Msg, N, Subp); |
| end if; |
| |
| else |
| |
| -- Do not emit warning if this is a predefined unit which is not |
| -- the main unit. This behavior is currently provided for backward |
| -- compatibility but it will be removed when we enforce the |
| -- strictness of the new rules. |
| |
| if Is_Predefined_Unit (Get_Source_Unit (Subp)) |
| and then not In_Extended_Main_Source_Unit (Subp) |
| then |
| null; |
| |
| elsif Has_Pragma_Inline_Always (Subp) then |
| |
| -- Emit a warning if this is a call to a runtime subprogram |
| -- which is located inside a generic. Previously this call |
| -- was silently skipped. |
| |
| if Is_Generic_Instance (Subp) then |
| declare |
| Gen_P : constant Entity_Id := Generic_Parent (Parent (Subp)); |
| begin |
| if Is_Predefined_Unit (Get_Source_Unit (Gen_P)) then |
| Set_Is_Inlined (Subp, False); |
| Error_Msg_NE (Msg & "p?", N, Subp); |
| return; |
| end if; |
| end; |
| end if; |
| |
| -- Remove last character (question mark) to make this into an |
| -- error, because the Inline_Always pragma cannot be obeyed. |
| |
| Error_Msg_NE (Msg (Msg'First .. Msg'Last - 1), N, Subp); |
| |
| else |
| Set_Is_Inlined (Subp, False); |
| |
| if Ineffective_Inline_Warnings then |
| Error_Msg_NE (Msg & "p?", N, Subp); |
| end if; |
| end if; |
| end if; |
| end Cannot_Inline; |
| |
| -------------------------------------------- |
| -- Check_And_Split_Unconstrained_Function -- |
| -------------------------------------------- |
| |
| procedure Check_And_Split_Unconstrained_Function |
| (N : Node_Id; |
| Spec_Id : Entity_Id; |
| Body_Id : Entity_Id) |
| is |
| procedure Build_Body_To_Inline (N : Node_Id; Spec_Id : Entity_Id); |
| -- Use generic machinery to build an unexpanded body for the subprogram. |
| -- This body is subsequently used for inline expansions at call sites. |
| |
| procedure Build_Return_Object_Formal |
| (Loc : Source_Ptr; |
| Obj_Decl : Node_Id; |
| Formals : List_Id); |
| -- Create a formal parameter for return object declaration Obj_Decl of |
| -- an extended return statement and add it to list Formals. |
| |
| function Can_Split_Unconstrained_Function (N : Node_Id) return Boolean; |
| -- Return true if we generate code for the function body N, the function |
| -- body N has no local declarations and its unique statement is a single |
| -- extended return statement with a handled statements sequence. |
| |
| procedure Copy_Formals |
| (Loc : Source_Ptr; |
| Subp_Id : Entity_Id; |
| Formals : List_Id); |
| -- Create new formal parameters from the formal parameters of subprogram |
| -- Subp_Id and add them to list Formals. |
| |
| function Copy_Return_Object (Obj_Decl : Node_Id) return Node_Id; |
| -- Create a copy of return object declaration Obj_Decl of an extended |
| -- return statement. |
| |
| procedure Split_Unconstrained_Function |
| (N : Node_Id; |
| Spec_Id : Entity_Id); |
| -- N is an inlined function body that returns an unconstrained type and |
| -- has a single extended return statement. Split N in two subprograms: |
| -- a procedure P' and a function F'. The formals of P' duplicate the |
| -- formals of N plus an extra formal which is used to return a value; |
| -- its body is composed by the declarations and list of statements |
| -- of the extended return statement of N. |
| |
| -------------------------- |
| -- Build_Body_To_Inline -- |
| -------------------------- |
| |
| procedure Build_Body_To_Inline (N : Node_Id; Spec_Id : Entity_Id) is |
| procedure Generate_Subprogram_Body |
| (N : Node_Id; |
| Body_To_Inline : out Node_Id); |
| -- Generate a parameterless duplicate of subprogram body N. Note that |
| -- occurrences of pragmas referencing the formals are removed since |
| -- they have no meaning when the body is inlined and the formals are |
| -- rewritten (the analysis of the non-inlined body will handle these |
| -- pragmas). A new internal name is associated with Body_To_Inline. |
| |
| ------------------------------ |
| -- Generate_Subprogram_Body -- |
| ------------------------------ |
| |
| procedure Generate_Subprogram_Body |
| (N : Node_Id; |
| Body_To_Inline : out Node_Id) |
| is |
| begin |
| -- Within an instance, the body to inline must be treated as a |
| -- nested generic so that proper global references are preserved. |
| |
| -- Note that we do not do this at the library level, because it |
| -- is not needed, and furthermore this causes trouble if front |
| -- end inlining is activated (-gnatN). |
| |
| if In_Instance |
| and then Scope (Current_Scope) /= Standard_Standard |
| then |
| Body_To_Inline := |
| Copy_Generic_Node (N, Empty, Instantiating => True); |
| else |
| Body_To_Inline := New_Copy_Tree (N); |
| end if; |
| |
| -- Remove aspects/pragmas that have no meaning in an inlined body |
| |
| Remove_Aspects_And_Pragmas (Body_To_Inline); |
| |
| -- We need to capture references to the formals in order |
| -- to substitute the actuals at the point of inlining, i.e. |
| -- instantiation. To treat the formals as globals to the body to |
| -- inline, we nest it within a dummy parameterless subprogram, |
| -- declared within the real one. |
| |
| Set_Parameter_Specifications |
| (Specification (Body_To_Inline), No_List); |
| |
| -- A new internal name is associated with Body_To_Inline to avoid |
| -- conflicts when the non-inlined body N is analyzed. |
| |
| Set_Defining_Unit_Name (Specification (Body_To_Inline), |
| Make_Temporary (Sloc (N), 'P')); |
| Set_Corresponding_Spec (Body_To_Inline, Empty); |
| end Generate_Subprogram_Body; |
| |
| -- Local variables |
| |
| Decl : constant Node_Id := Unit_Declaration_Node (Spec_Id); |
| Original_Body : Node_Id; |
| Body_To_Analyze : Node_Id; |
| |
| -- Start of processing for Build_Body_To_Inline |
| |
| begin |
| pragma Assert (Current_Scope = Spec_Id); |
| |
| -- Within an instance, the body to inline must be treated as a nested |
| -- generic, so that the proper global references are preserved. We |
| -- do not do this at the library level, because it is not needed, and |
| -- furthermore this causes trouble if front-end inlining is activated |
| -- (-gnatN). |
| |
| if In_Instance |
| and then Scope (Current_Scope) /= Standard_Standard |
| then |
| Save_Env (Scope (Current_Scope), Scope (Current_Scope)); |
| end if; |
| |
| -- Capture references to formals in order to substitute the actuals |
| -- at the point of inlining or instantiation. To treat the formals |
| -- as globals to the body to inline, nest the body within a dummy |
| -- parameterless subprogram, declared within the real one. |
| |
| Generate_Subprogram_Body (N, Original_Body); |
| Body_To_Analyze := |
| Copy_Generic_Node (Original_Body, Empty, Instantiating => False); |
| |
| -- Set return type of function, which is also global and does not |
| -- need to be resolved. |
| |
| if Ekind (Spec_Id) = E_Function then |
| Set_Result_Definition (Specification (Body_To_Analyze), |
| New_Occurrence_Of (Etype (Spec_Id), Sloc (N))); |
| end if; |
| |
| 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); |
| |
| Push_Scope (Defining_Entity (Body_To_Analyze)); |
| Save_Global_References (Original_Body); |
| End_Scope; |
| Remove (Body_To_Analyze); |
| |
| -- Restore environment if previously saved |
| |
| if In_Instance |
| and then Scope (Current_Scope) /= Standard_Standard |
| then |
| Restore_Env; |
| end if; |
| |
| pragma Assert (No (Body_To_Inline (Decl))); |
| Set_Body_To_Inline (Decl, Original_Body); |
| Mutate_Ekind (Defining_Entity (Original_Body), Ekind (Spec_Id)); |
| end Build_Body_To_Inline; |
| |
| -------------------------------- |
| -- Build_Return_Object_Formal -- |
| -------------------------------- |
| |
| procedure Build_Return_Object_Formal |
| (Loc : Source_Ptr; |
| Obj_Decl : Node_Id; |
| Formals : List_Id) |
| is |
| Obj_Def : constant Node_Id := Object_Definition (Obj_Decl); |
| Obj_Id : constant Entity_Id := Defining_Entity (Obj_Decl); |
| Typ_Def : Node_Id; |
| |
| begin |
| -- Build the type definition of the formal parameter. The use of |
| -- New_Copy_Tree ensures that global references preserved in the |
| -- case of generics. |
| |
| if Is_Entity_Name (Obj_Def) then |
| Typ_Def := New_Copy_Tree (Obj_Def); |
| else |
| Typ_Def := New_Copy_Tree (Subtype_Mark (Obj_Def)); |
| end if; |
| |
| -- Generate: |
| -- |
| -- Obj_Id : [out] Typ_Def |
| |
| -- Mode OUT should not be used when the return object is declared as |
| -- a constant. Check the definition of the object declaration because |
| -- the object has not been analyzed yet. |
| |
| Append_To (Formals, |
| Make_Parameter_Specification (Loc, |
| Defining_Identifier => |
| Make_Defining_Identifier (Loc, Chars (Obj_Id)), |
| In_Present => False, |
| Out_Present => not Constant_Present (Obj_Decl), |
| Null_Exclusion_Present => False, |
| Parameter_Type => Typ_Def)); |
| end Build_Return_Object_Formal; |
| |
| -------------------------------------- |
| -- Can_Split_Unconstrained_Function -- |
| -------------------------------------- |
| |
| function Can_Split_Unconstrained_Function (N : Node_Id) return Boolean is |
| Stmt : constant Node_Id := |
| First (Statements (Handled_Statement_Sequence (N))); |
| Decl : Node_Id; |
| |
| begin |
| -- No user defined declarations allowed in the function except inside |
| -- the unique return statement; implicit labels are the only allowed |
| -- declarations. |
| |
| Decl := First (Declarations (N)); |
| while Present (Decl) loop |
| if Nkind (Decl) /= N_Implicit_Label_Declaration then |
| return False; |
| end if; |
| |
| Next (Decl); |
| end loop; |
| |
| -- We only split the inlined function when we are generating the code |
| -- of its body; otherwise we leave duplicated split subprograms in |
| -- the tree which (if referenced) generate wrong references at link |
| -- time. |
| |
| return In_Extended_Main_Code_Unit (N) |
| and then Present (Stmt) |
| and then Nkind (Stmt) = N_Extended_Return_Statement |
| and then No (Next (Stmt)) |
| and then Present (Handled_Statement_Sequence (Stmt)); |
| end Can_Split_Unconstrained_Function; |
| |
| ------------------ |
| -- Copy_Formals -- |
| ------------------ |
| |
| procedure Copy_Formals |
| (Loc : Source_Ptr; |
| Subp_Id : Entity_Id; |
| Formals : List_Id) |
| is |
| Formal : Entity_Id; |
| Spec : Node_Id; |
| |
| begin |
| Formal := First_Formal (Subp_Id); |
| while Present (Formal) loop |
| Spec := Parent (Formal); |
| |
| -- Create an exact copy of the formal parameter. The use of |
| -- New_Copy_Tree ensures that global references are preserved |
| -- in case of generics. |
| |
| Append_To (Formals, |
| Make_Parameter_Specification (Loc, |
| Defining_Identifier => |
| Make_Defining_Identifier (Sloc (Formal), Chars (Formal)), |
| In_Present => In_Present (Spec), |
| Out_Present => Out_Present (Spec), |
| Null_Exclusion_Present => Null_Exclusion_Present (Spec), |
| Parameter_Type => |
| New_Copy_Tree (Parameter_Type (Spec)), |
| Expression => New_Copy_Tree (Expression (Spec)))); |
| |
| Next_Formal (Formal); |
| end loop; |
| end Copy_Formals; |
| |
| ------------------------ |
| -- Copy_Return_Object -- |
| ------------------------ |
| |
| function Copy_Return_Object (Obj_Decl : Node_Id) return Node_Id is |
| Obj_Id : constant Entity_Id := Defining_Entity (Obj_Decl); |
| |
| begin |
| -- The use of New_Copy_Tree ensures that global references are |
| -- preserved in case of generics. |
| |
| return |
| Make_Object_Declaration (Sloc (Obj_Decl), |
| Defining_Identifier => |
| Make_Defining_Identifier (Sloc (Obj_Id), Chars (Obj_Id)), |
| Aliased_Present => Aliased_Present (Obj_Decl), |
| Constant_Present => Constant_Present (Obj_Decl), |
| Null_Exclusion_Present => Null_Exclusion_Present (Obj_Decl), |
| Object_Definition => |
| New_Copy_Tree (Object_Definition (Obj_Decl)), |
| Expression => New_Copy_Tree (Expression (Obj_Decl))); |
| end Copy_Return_Object; |
| |
| ---------------------------------- |
| -- Split_Unconstrained_Function -- |
| ---------------------------------- |
| |
| procedure Split_Unconstrained_Function |
| (N : Node_Id; |
| Spec_Id : Entity_Id) |
| is |
| Loc : constant Source_Ptr := Sloc (N); |
| Ret_Stmt : constant Node_Id := |
| First (Statements (Handled_Statement_Sequence (N))); |
| Ret_Obj : constant Node_Id := |
| First (Return_Object_Declarations (Ret_Stmt)); |
| |
| procedure Build_Procedure |
| (Proc_Id : out Entity_Id; |
| Decl_List : out List_Id); |
| -- Build a procedure containing the statements found in the extended |
| -- return statement of the unconstrained function body N. |
| |
| --------------------- |
| -- Build_Procedure -- |
| --------------------- |
| |
| procedure Build_Procedure |
| (Proc_Id : out Entity_Id; |
| Decl_List : out List_Id) |
| is |
| Formals : constant List_Id := New_List; |
| Subp_Name : constant Name_Id := New_Internal_Name ('F'); |
| |
| Body_Decls : List_Id := No_List; |
| Decl : Node_Id; |
| Proc_Body : Node_Id; |
| Proc_Spec : Node_Id; |
| |
| begin |
| -- Create formal parameters for the return object and all formals |
| -- of the unconstrained function in order to pass their values to |
| -- the procedure. |
| |
| Build_Return_Object_Formal |
| (Loc => Loc, |
| Obj_Decl => Ret_Obj, |
| Formals => Formals); |
| |
| Copy_Formals |
| (Loc => Loc, |
| Subp_Id => Spec_Id, |
| Formals => Formals); |
| |
| Proc_Id := Make_Defining_Identifier (Loc, Chars => Subp_Name); |
| |
| Proc_Spec := |
| Make_Procedure_Specification (Loc, |
| Defining_Unit_Name => Proc_Id, |
| Parameter_Specifications => Formals); |
| |
| Decl_List := New_List; |
| |
| Append_To (Decl_List, |
| Make_Subprogram_Declaration (Loc, Proc_Spec)); |
| |
| -- Can_Convert_Unconstrained_Function checked that the function |
| -- has no local declarations except implicit label declarations. |
| -- Copy these declarations to the built procedure. |
| |
| if Present (Declarations (N)) then |
| Body_Decls := New_List; |
| |
| Decl := First (Declarations (N)); |
| while Present (Decl) loop |
| pragma Assert (Nkind (Decl) = N_Implicit_Label_Declaration); |
| |
| Append_To (Body_Decls, |
| Make_Implicit_Label_Declaration (Loc, |
| Make_Defining_Identifier (Loc, |
| Chars => Chars (Defining_Identifier (Decl))), |
| Label_Construct => Empty)); |
| |
| Next (Decl); |
| end loop; |
| end if; |
| |
| pragma Assert (Present (Handled_Statement_Sequence (Ret_Stmt))); |
| |
| Proc_Body := |
| Make_Subprogram_Body (Loc, |
| Specification => Copy_Subprogram_Spec (Proc_Spec), |
| Declarations => Body_Decls, |
| Handled_Statement_Sequence => |
| New_Copy_Tree (Handled_Statement_Sequence (Ret_Stmt))); |
| |
| Set_Defining_Unit_Name (Specification (Proc_Body), |
| Make_Defining_Identifier (Loc, Subp_Name)); |
| |
| Append_To (Decl_List, Proc_Body); |
| end Build_Procedure; |
| |
| -- Local variables |
| |
| New_Obj : constant Node_Id := Copy_Return_Object (Ret_Obj); |
| Blk_Stmt : Node_Id; |
| Proc_Call : Node_Id; |
| Proc_Id : Entity_Id; |
| |
| -- Start of processing for Split_Unconstrained_Function |
| |
| begin |
| -- Build the associated procedure, analyze it and insert it before |
| -- the function body N. |
| |
| declare |
| Scope : constant Entity_Id := Current_Scope; |
| Decl_List : List_Id; |
| begin |
| Pop_Scope; |
| Build_Procedure (Proc_Id, Decl_List); |
| Insert_Actions (N, Decl_List); |
| Set_Is_Inlined (Proc_Id); |
| Push_Scope (Scope); |
| end; |
| |
| -- Build the call to the generated procedure |
| |
| declare |
| Actual_List : constant List_Id := New_List; |
| Formal : Entity_Id; |
| |
| begin |
| Append_To (Actual_List, |
| New_Occurrence_Of (Defining_Identifier (New_Obj), Loc)); |
| |
| Formal := First_Formal (Spec_Id); |
| while Present (Formal) loop |
| Append_To (Actual_List, New_Occurrence_Of (Formal, Loc)); |
| |
| -- Avoid spurious warning on unreferenced formals |
| |
| Set_Referenced (Formal); |
| Next_Formal (Formal); |
| end loop; |
| |
| Proc_Call := |
| Make_Procedure_Call_Statement (Loc, |
| Name => New_Occurrence_Of (Proc_Id, Loc), |
| Parameter_Associations => Actual_List); |
| end; |
| |
| -- Generate: |
| |
| -- declare |
| -- New_Obj : ... |
| -- begin |
| -- Proc (New_Obj, ...); |
| -- return New_Obj; |
| -- end; |
| |
| Blk_Stmt := |
| Make_Block_Statement (Loc, |
| Declarations => New_List (New_Obj), |
| Handled_Statement_Sequence => |
| Make_Handled_Sequence_Of_Statements (Loc, |
| Statements => New_List ( |
| |
| Proc_Call, |
| |
| Make_Simple_Return_Statement (Loc, |
| Expression => |
| New_Occurrence_Of |
| (Defining_Identifier (New_Obj), Loc))))); |
| |
| Rewrite (Ret_Stmt, Blk_Stmt); |
| end Split_Unconstrained_Function; |
| |
| -- 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; |
| |
| -- No action needed in stubs since the attribute Body_To_Inline |
| -- is not available |
| |
| 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; |
| |
| -- Do not generate a body to inline for protected functions, because the |
| -- transformation generates a call to a protected procedure, causing |
| -- spurious errors. We don't inline protected operations anyway, so |
| -- this is no loss. We might as well ignore intrinsics and foreign |
| -- conventions as well -- just allow Ada conventions. |
| |
| elsif not (Convention (Spec_Id) = Convention_Ada |
| or else Convention (Spec_Id) = Convention_Ada_Pass_By_Copy |
| or else Convention (Spec_Id) = Convention_Ada_Pass_By_Reference) |
| then |
| return; |
| |
| -- Check excluded declarations |
| |
| elsif 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 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_Split_Unconstrained_Function; |
| |
| --------------------------------------------- |
| -- Check_Object_Renaming_In_GNATprove_Mode -- |
| --------------------------------------------- |
| |
| procedure Check_Object_Renaming_In_GNATprove_Mode (Spec_Id : Entity_Id) is |
| Decl : constant Node_Id := Unit_Declaration_Node (Spec_Id); |
| Body_Decl : constant Node_Id := |
| Unit_Declaration_Node (Corresponding_Body (Decl)); |
| |
| function Check_Object_Renaming (N : Node_Id) return Traverse_Result; |
| -- Returns Abandon on node N if this is a reference to an object |
| -- renaming, which will be expanded into the renamed object in |
| -- GNATprove mode. |
| |
| --------------------------- |
| -- Check_Object_Renaming -- |
| --------------------------- |
| |
| function Check_Object_Renaming (N : Node_Id) return Traverse_Result is |
| begin |
| case Nkind (Original_Node (N)) is |
| when N_Expanded_Name |
| | N_Identifier |
| => |
| declare |
| Obj_Id : constant Entity_Id := Entity (Original_Node (N)); |
| begin |
| -- Recognize the case when SPARK expansion rewrites a |
| -- reference to an object renaming. |
| |
| if Present (Obj_Id) |
| and then Is_Object (Obj_Id) |
| and then Present (Renamed_Object (Obj_Id)) |
| and then Nkind (Renamed_Object (Obj_Id)) not in N_Entity |
| |
| -- Copy_Generic_Node called for inlining expects the |
| -- references to global entities to have the same kind |
| -- in the "generic" code and its "instantiation". |
| |
| and then Nkind (Original_Node (N)) /= |
| Nkind (Renamed_Object (Obj_Id)) |
| then |
| return Abandon; |
| else |
| return OK; |
| end if; |
| end; |
| |
| when others => |
| return OK; |
| end case; |
| end Check_Object_Renaming; |
| |
| function Check_All_Object_Renamings is new |
| Traverse_Func (Check_Object_Renaming); |
| |
| -- Start of processing for Check_Object_Renaming_In_GNATprove_Mode |
| |
| begin |
| -- Subprograms with object renamings replaced by the special SPARK |
| -- expansion cannot be inlined. |
| |
| if Check_All_Object_Renamings (Body_Decl) /= OK then |
| Cannot_Inline ("cannot inline & (object renaming)?", |
| Body_Decl, Spec_Id); |
| Set_Body_To_Inline (Decl, Empty); |
| end if; |
| end Check_Object_Renaming_In_GNATprove_Mode; |
| |
| ------------------------------------- |
| -- Check_Package_Body_For_Inlining -- |
| ------------------------------------- |
| |
| procedure Check_Package_Body_For_Inlining (N : Node_Id; P : Entity_Id) is |
| Bname : Unit_Name_Type; |
| E : Entity_Id; |
| OK : Boolean; |
| |
| begin |
| -- Legacy implementation (relying on frontend inlining) |
| |
| if not Back_End_Inlining |
| and then Is_Compilation_Unit (P) |
| and then not Is_Generic_Instance (P) |
| then |
| Bname := Get_Body_Name (Get_Unit_Name (Unit (N))); |
| |
| E := First_Entity (P); |
| while Present (E) loop |
| if Has_Pragma_Inline_Always (E) |
| or else (Has_Pragma_Inline (E) and Front_End_Inlining) |
| then |
| if not Is_Loaded (Bname) then |
| Load_Needed_Body (N, OK); |
| |
| if OK then |
| |
| -- Check we are not trying to inline a parent whose body |
| -- depends on a child, when we are compiling the body of |
| -- the child. Otherwise we have a potential elaboration |
| -- circularity with inlined subprograms and with |
| -- Taft-Amendment types. |
| |
| declare |
| Comp : Node_Id; -- Body just compiled |
| Child_Spec : Entity_Id; -- Spec of main unit |
| Ent : Entity_Id; -- For iteration |
| With_Clause : Node_Id; -- Context of body. |
| |
| begin |
| if Nkind (Unit (Cunit (Main_Unit))) = N_Package_Body |
| and then Present (Body_Entity (P)) |
| then |
| Child_Spec := |
| Defining_Entity |
| ((Unit (Library_Unit (Cunit (Main_Unit))))); |
| |
| Comp := |
| Parent (Unit_Declaration_Node (Body_Entity (P))); |
| |
| -- Check whether the context of the body just |
| -- compiled includes a child of itself, and that |
| -- child is the spec of the main compilation. |
| |
| With_Clause := First (Context_Items (Comp)); |
| while Present (With_Clause) loop |
| if Nkind (With_Clause) = N_With_Clause |
| and then |
| Scope (Entity (Name (With_Clause))) = P |
| and then |
| Entity (Name (With_Clause)) = Child_Spec |
| then |
| Error_Msg_Node_2 := Child_Spec; |
| Error_Msg_NE |
| ("body of & depends on child unit&??", |
| With_Clause, P); |
| Error_Msg_N |
| ("\subprograms in body cannot be inlined??", |
| With_Clause); |
| |
| -- Disable further inlining from this unit, |
| -- and keep Taft-amendment types incomplete. |
| |
| Ent := First_Entity (P); |
| while Present (Ent) loop |
| if Is_Type (Ent) |
| and then Has_Completion_In_Body (Ent) |
| then |
| Set_Full_View (Ent, Empty); |
| |
| elsif Is_Subprogram (Ent) then |
| Set_Is_Inlined (Ent, False); |
| end if; |
| |
| Next_Entity (Ent); |
| end loop; |
| |
| return; |
| end if; |
| |
| Next (With_Clause); |
| end loop; |
| end if; |
| end; |
| |
| elsif Ineffective_Inline_Warnings then |
| Error_Msg_Unit_1 := Bname; |
| Error_Msg_N |
| ("unable to inline subprograms defined in $?p?", P); |
| Error_Msg_N ("\body not found?p?", P); |
| return; |
| end if; |
| end if; |
| |
| return; |
| end if; |
| |
| Next_Entity (E); |
| end loop; |
| end if; |
| end Check_Package_Body_For_Inlining; |
| |
| -------------------- |
| -- Cleanup_Scopes -- |
| -------------------- |
| |
| procedure Cleanup_Scopes is |
| Elmt : Elmt_Id; |
| Decl : Node_Id; |
| Scop : Entity_Id; |
| |
| begin |
| Elmt := First_Elmt (To_Clean); |
| while Present (Elmt) loop |
| Scop := Node (Elmt); |
| |
| if Ekind (Scop) = E_Entry then |
| Scop := Protected_Body_Subprogram (Scop); |
| |
| elsif Is_Subprogram (Scop) |
| and then Is_Protected_Type (Underlying_Type (Scope (Scop))) |
| and then Present (Protected_Body_Subprogram (Scop)) |
| then |
| -- If a protected operation contains an instance, its cleanup |
| -- operations have been delayed, and the subprogram has been |
| -- rewritten in the expansion of the enclosing protected body. It |
| -- is the corresponding subprogram that may require the cleanup |
| -- operations, so propagate the information that triggers cleanup |
| -- activity. |
| |
| Set_Uses_Sec_Stack |
| (Protected_Body_Subprogram (Scop), |
| Uses_Sec_Stack (Scop)); |
| |
| Scop := Protected_Body_Subprogram (Scop); |
| end if; |
| |
| if Ekind (Scop) = E_Block then |
| Decl := Parent (Block_Node (Scop)); |
| |
| else |
| Decl := Unit_Declaration_Node (Scop); |
| |
| if Nkind (Decl) in N_Subprogram_Declaration |
| | N_Task_Type_Declaration |
| | N_Subprogram_Body_Stub |
| then |
| Decl := Unit_Declaration_Node (Corresponding_Body (Decl)); |
| end if; |
| end if; |
| |
| Push_Scope (Scop); |
| Expand_Cleanup_Actions (Decl); |
| End_Scope; |
| |
| Next_Elmt (Elmt); |
| end loop; |
| end Cleanup_Scopes; |
| |
| procedure Establish_Actual_Mapping_For_Inlined_Call |
| (N : Node_Id; |
| Subp : Entity_Id; |
| Decls : List_Id; |
| Body_Or_Expr_To_Check : Node_Id) |
| is |
| |
| function Formal_Is_Used_Once (Formal : Entity_Id) return Boolean; |
| -- Determine whether a formal parameter is used only once in |
| -- Body_Or_Expr_To_Check. |
| |
| ------------------------- |
| -- Formal_Is_Used_Once -- |
| ------------------------- |
| |
| function Formal_Is_Used_Once (Formal : Entity_Id) return Boolean is |
| Use_Counter : Nat := 0; |
| |
| function Count_Uses (N : Node_Id) return Traverse_Result; |
| -- Traverse the tree and count the uses of the formal parameter. |
| -- In this case, for optimization purposes, we do not need to |
| -- continue the traversal once more than one use is encountered. |
| |
| ---------------- |
| -- Count_Uses -- |
| ---------------- |
| |
| function Count_Uses (N : Node_Id) return Traverse_Result is |
| begin |
| -- The original node is an identifier |
| |
| if Nkind (N) = N_Identifier |
| and then Present (Entity (N)) |
| |
| -- Original node's entity points to the one in the copied body |
| |
| and then Nkind (Entity (N)) = N_Identifier |
| and then Present (Entity (Entity (N))) |
| |
| -- The entity of the copied node is the formal parameter |
| |
| and then Entity (Entity (N)) = Formal |
| then |
| Use_Counter := Use_Counter + 1; |
| |
| -- If this is a second use then abandon the traversal |
| |
| if Use_Counter > 1 then |
| return Abandon; |
| end if; |
| end if; |
| |
| return OK; |
| end Count_Uses; |
| |
| procedure Count_Formal_Uses is new Traverse_Proc (Count_Uses); |
| |
| -- Start of processing for Formal_Is_Used_Once |
| |
| begin |
| Count_Formal_Uses (Body_Or_Expr_To_Check); |
| return Use_Counter = 1; |
| end Formal_Is_Used_Once; |
| |
| -- Local Data -- |
| |
| F : Entity_Id; |
| A : Node_Id; |
| Decl : Node_Id; |
| Loc : constant Source_Ptr := Sloc (N); |
| New_A : Node_Id; |
| Temp : Entity_Id; |
| Temp_Typ : Entity_Id; |
| |
| -- Start of processing for Establish_Actual_Mapping_For_Inlined_Call |
| |
| begin |
| F := First_Formal (Subp); |
| A := First_Actual (N); |
| while Present (F) loop |
| if Present (Renamed_Object (F)) then |
| |
| -- If expander is active, it is an error to try to inline a |
| -- recursive subprogram. In GNATprove mode, just indicate that the |
| -- inlining will not happen, and mark the subprogram as not always |
| -- inlined. |
| |
| if GNATprove_Mode then |
| Cannot_Inline |
| ("cannot inline call to recursive subprogram?", N, Subp); |
| Set_Is_Inlined_Always (Subp, False); |
| else |
| Error_Msg_N |
| ("cannot inline call to recursive subprogram", N); |
| end if; |
| |
| return; |
| end if; |
| |
| -- Reset Last_Assignment for any parameters of mode out or in out, to |
| -- prevent spurious warnings about overwriting for assignments to the |
| -- formal in the inlined code. |
| |
| if Is_Entity_Name (A) and then Ekind (F) /= E_In_Parameter then |
| |
| -- In GNATprove mode a protected component acting as an actual |
| -- subprogram parameter will appear as inlined-for-proof. However, |
| -- its E_Component entity is not an assignable object, so the |
| -- assertion in Set_Last_Assignment will fail. We just omit the |
| -- call to Set_Last_Assignment, because GNATprove flags useless |
| -- assignments with its own flow analysis. |
| -- |
| -- In GNAT mode such a problem does not occur, because protected |
| -- components are inlined via object renamings whose entity kind |
| -- E_Variable is assignable. |
| |
| if Is_Assignable (Entity (A)) then |
| Set_Last_Assignment (Entity (A), Empty); |
| else |
| pragma Assert |
| (GNATprove_Mode and then Is_Protected_Component (Entity (A))); |
| end if; |
| end if; |
| |
| -- If the argument may be a controlling argument in a call within |
| -- the inlined body, we must preserve its class-wide nature to ensure |
| -- that dynamic dispatching will take place subsequently. If the |
| -- formal has a constraint, then it must be preserved to retain the |
| -- semantics of the body. |
| |
| if Is_Class_Wide_Type (Etype (F)) |
| or else (Is_Access_Type (Etype (F)) |
| and then Is_Class_Wide_Type (Designated_Type (Etype (F)))) |
| then |
| Temp_Typ := Etype (F); |
| |
| elsif Base_Type (Etype (F)) = Base_Type (Etype (A)) |
| and then Etype (F) /= Base_Type (Etype (F)) |
| and then Is_Constrained (Etype (F)) |
| then |
| Temp_Typ := Etype (F); |
| |
| else |
| Temp_Typ := Etype (A); |
| end if; |
| |
| -- If the actual is a simple name or a literal, no need to create a |
| -- temporary, object can be used directly. Skip this optimization in |
| -- GNATprove mode, to make sure any check on a type conversion will |
| -- be issued. |
| |
| if (Is_Entity_Name (A) |
| and then |
| (not Is_Scalar_Type (Etype (A)) |
| or else Ekind (Entity (A)) = E_Enumeration_Literal) |
| and then not GNATprove_Mode) |
| |
| -- When the actual is an identifier and the corresponding formal is |
| -- used only once in the original body, the formal can be substituted |
| -- directly with the actual parameter. Skip this optimization in |
| -- GNATprove mode, to make sure any check on a type conversion |
| -- will be issued. |
| |
| or else |
| (Nkind (A) = N_Identifier |
| and then Formal_Is_Used_Once (F) |
| and then not GNATprove_Mode) |
| |
| -- If the actual is a literal and the formal has its address taken, |
| -- we cannot pass the literal itself as an argument, so its value |
| -- must be captured in a temporary. |
| |
| or else |
| (Nkind (A) in |
| N_Real_Literal | N_Integer_Literal | N_Character_Literal |
| and then not Address_Taken (F)) |
| then |
| if Etype (F) /= Etype (A) then |
| Set_Renamed_Object |
| (F, Unchecked_Convert_To (Etype (F), Relocate_Node (A))); |
| else |
| Set_Renamed_Object (F, A); |
| end if; |
| |
| else |
| Temp := Make_Temporary (Loc, 'C'); |
| |
| -- If the actual for an in/in-out parameter is a view conversion, |
| -- make it into an unchecked conversion, given that an untagged |
| -- type conversion is not a proper object for a renaming. |
| |
| -- In-out conversions that involve real conversions have already |
| -- been transformed in Expand_Actuals. |
| |
| if Nkind (A) = N_Type_Conversion |
| and then Ekind (F) /= E_In_Parameter |
| then |
| New_A := Unchecked_Convert_To (Etype (F), Expression (A)); |
| |
| -- In GNATprove mode, keep the most precise type of the actual for |
| -- the temporary variable, when the formal type is unconstrained. |
| -- Otherwise, the AST may contain unexpected assignment statements |
| -- to a temporary variable of unconstrained type renaming a local |
| -- variable of constrained type, which is not expected by |
| -- GNATprove. |
| |
| elsif Etype (F) /= Etype (A) |
| and then (not GNATprove_Mode or else Is_Constrained (Etype (F))) |
| then |
| New_A := Unchecked_Convert_To (Etype (F), Relocate_Node (A)); |
| Temp_Typ := Etype (F); |
| |
| else |
| New_A := Relocate_Node (A); |
| end if; |
| |
| Set_Sloc (New_A, Sloc (N)); |
| |
| -- If the actual has a by-reference type, it cannot be copied, |
| -- so its value is captured in a renaming declaration. Otherwise |
| -- declare a local constant initialized with the actual. |
| |
| -- We also use a renaming declaration for expressions of an array |
| -- type that is not bit-packed, both for efficiency reasons and to |
| -- respect the semantics of the call: in most cases the original |
| -- call will pass the parameter by reference, and thus the inlined |
| -- code will have the same semantics. |
| |
| -- Finally, we need a renaming declaration in the case of limited |
| -- types for which initialization cannot be by copy either. |
| |
| if Ekind (F) = E_In_Parameter |
| and then not Is_By_Reference_Type (Etype (A)) |
| and then not Is_Limited_Type (Etype (A)) |
| and then |
| (not Is_Array_Type (Etype (A)) |
| or else not Is_Object_Reference (A) |
| or else Is_Bit_Packed_Array (Etype (A))) |
| then |
| Decl := |
| Make_Object_Declaration (Loc, |
| Defining_Identifier => Temp, |
| Constant_Present => True, |
| Object_Definition => New_Occurrence_Of (Temp_Typ, Loc), |
| Expression => New_A); |
| |
| else |
| -- In GNATprove mode, make an explicit copy of input |
| -- parameters when formal and actual types differ, to make |
| -- sure any check on the type conversion will be issued. |
| -- The legality of the copy is ensured by calling first |
| -- Call_Can_Be_Inlined_In_GNATprove_Mode. |
| |
| if GNATprove_Mode |
| and then Ekind (F) /= E_Out_Parameter |
| and then not Same_Type (Etype (F), Etype (A)) |
| then |
| pragma Assert (not Is_By_Reference_Type (Etype (A))); |
| pragma Assert (not Is_Limited_Type (Etype (A))); |
| |
| Append_To (Decls, |
| Make_Object_Declaration (Loc, |
| Defining_Identifier => Make_Temporary (Loc, 'C'), |
| Constant_Present => True, |
| Object_Definition => New_Occurrence_Of (Temp_Typ, Loc), |
| Expression => New_Copy_Tree (New_A))); |
| end if; |
| |
| Decl := |
| Make_Object_Renaming_Declaration (Loc, |
| Defining_Identifier => Temp, |
| Subtype_Mark => New_Occurrence_Of (Temp_Typ, Loc), |
| Name => New_A); |
| end if; |
| |
| Append (Decl, Decls); |
| Set_Renamed_Object (F, Temp); |
| end if; |
| |
| Next_Formal (F); |
| Next_Actual (A); |
| end loop; |
| end Establish_Actual_Mapping_For_Inlined_Call; |
| |
| ------------------------- |
| -- Expand_Inlined_Call -- |
| ------------------------- |
| |
| procedure Expand_Inlined_Call |
| (N : Node_Id; |
| Subp : Entity_Id; |
| Orig_Subp : Entity_Id) |
| is |
| Decls : constant List_Id := New_List; |
| Is_Predef : constant Boolean := |
| Is_Predefined_Unit (Get_Source_Unit (Subp)); |
| Loc : constant Source_Ptr := Sloc (N); |
| Orig_Bod : constant Node_Id := |
| Body_To_Inline (Unit_Declaration_Node (Subp)); |
| |
| Uses_Back_End : constant Boolean := |
| Back_End_Inlining and then Optimization_Level > 0; |
| -- The back-end expansion is used if the target supports back-end |
| -- inlining and some level of optimixation is required; otherwise |
| -- the inlining takes place fully as a tree expansion. |
| |
| Blk : Node_Id; |
| Decl : Node_Id; |
| Exit_Lab : Entity_Id := Empty; |
| Lab_Decl : Node_Id := Empty; |
| Lab_Id : Node_Id; |
| Num_Ret : Nat := 0; |
| Ret_Type : Entity_Id; |
| Temp : Entity_Id; |
| |
| Is_Unc : Boolean; |
| Is_Unc_Decl : Boolean; |
| -- If the type returned by the function is unconstrained and the call |
| -- can be inlined, special processing is required. |
| |
| Return_Object : Entity_Id := Empty; |
| -- Entity in declaration in an extended_return_statement |
| |
| Targ : Node_Id := Empty; |
| -- The target of the call. If context is an assignment statement then |
| -- this is the left-hand side of the assignment, else it is a temporary |
| -- to which the return value is assigned prior to rewriting the call. |
| |
| Targ1 : Node_Id := Empty; |
| -- A separate target used when the return type is unconstrained |
| |
| procedure Declare_Postconditions_Result; |
| -- When generating C code, declare _Result, which may be used in the |
| -- inlined _Postconditions procedure to verify the return value. |
| |
| procedure Make_Exit_Label; |
| -- Build declaration for exit label to be used in Return statements, |
| -- sets Exit_Lab (the label node) and Lab_Decl (corresponding implicit |
| -- declaration). Does nothing if Exit_Lab already set. |
| |
| procedure Make_Loop_Labels_Unique (HSS : Node_Id); |
| -- When compiling for CCG and performing front-end inlining, replace |
| -- loop names and references to them so that they do not conflict with |
| -- homographs in the current subprogram. |
| |
| function Process_Formals (N : Node_Id) return Traverse_Result; |
| -- Replace occurrence of a formal with the corresponding actual, or the |
| -- thunk generated for it. Replace a return statement with an assignment |
| -- to the target of the call, with appropriate conversions if needed. |
| |
| function Process_Formals_In_Aspects (N : Node_Id) return Traverse_Result; |
| -- Because aspects are linked indirectly to the rest of the tree, |
| -- replacement of formals appearing in aspect specifications must |
| -- be performed in a separate pass, using an instantiation of the |
| -- previous subprogram over aspect specifications reachable from N. |
| |
| function Process_Sloc (Nod : Node_Id) return Traverse_Result; |
| -- If the call being expanded is that of an internal subprogram, set the |
| -- sloc of the generated block to that of the call itself, so that the |
| -- expansion is skipped by the "next" command in gdb. Same processing |
| -- for a subprogram in a predefined file, e.g. Ada.Tags. If |
| -- Debug_Generated_Code is true, suppress this change to simplify our |
| -- own development. Same in GNATprove mode, to ensure that warnings and |
| -- diagnostics point to the proper location. |
| |
| procedure Reset_Dispatching_Calls (N : Node_Id); |
| -- In subtree N search for occurrences of dispatching calls that use the |
| -- Ada 2005 Object.Operation notation and the object is a formal of the |
| -- inlined subprogram. Reset the entity associated with Operation in all |
| -- the found occurrences. |
| |
| procedure Rewrite_Function_Call (N : Node_Id; Blk : Node_Id); |
| -- If the function body is a single expression, replace call with |
| -- expression, else insert block appropriately. |
| |
| procedure Rewrite_Procedure_Call (N : Node_Id; Blk : Node_Id); |
| -- If procedure body has no local variables, inline body without |
| -- creating block, otherwise rewrite call with block. |
| |
| ----------------------------------- |
| -- Declare_Postconditions_Result -- |
| ----------------------------------- |
| |
| procedure Declare_Postconditions_Result is |
| Enclosing_Subp : constant Entity_Id := Scope (Subp); |
| |
| begin |
| pragma Assert |
| (Modify_Tree_For_C |
| and then Is_Subprogram (Enclosing_Subp) |
| and then Present (Wrapped_Statements (Enclosing_Subp))); |
| |
| if Ekind (Enclosing_Subp) = E_Function then |
| if Nkind (First (Parameter_Associations (N))) in |
| N_Numeric_Or_String_Literal |
| then |
| Append_To (Declarations (Blk), |
| Make_Object_Declaration (Loc, |
| Defining_Identifier => |
| Make_Defining_Identifier (Loc, Name_uResult), |
| Constant_Present => True, |
| Object_Definition => |
| New_Occurrence_Of (Etype (Enclosing_Subp), Loc), |
| Expression => |
| New_Copy_Tree (First (Parameter_Associations (N))))); |
| else |
| Append_To (Declarations (Blk), |
| Make_Object_Renaming_Declaration (Loc, |
| Defining_Identifier => |
| Make_Defining_Identifier (Loc, Name_uResult), |
| Subtype_Mark => |
| New_Occurrence_Of (Etype (Enclosing_Subp), Loc), |
| Name => |
| New_Copy_Tree (First (Parameter_Associations (N))))); |
| end if; |
| end if; |
| end Declare_Postconditions_Result; |
| |
| --------------------- |
| -- Make_Exit_Label -- |
| --------------------- |
| |
| procedure Make_Exit_Label is |
| Lab_Ent : Entity_Id; |
| begin |
| if No (Exit_Lab) then |
| Lab_Ent := Make_Temporary (Loc, 'L'); |
| Lab_Id := New_Occurrence_Of (Lab_Ent, Loc); |
| Exit_Lab := Make_Label (Loc, Lab_Id); |
| Lab_Decl := |
| Make_Implicit_Label_Declaration (Loc, |
| Defining_Identifier => Lab_Ent, |
| Label_Construct => Exit_Lab); |
| end if; |
| end Make_Exit_Label; |
| |
| ----------------------------- |
| -- Make_Loop_Labels_Unique -- |
| ----------------------------- |
| |
| procedure Make_Loop_Labels_Unique (HSS : Node_Id) is |
| function Process_Loop (N : Node_Id) return Traverse_Result; |
| |
| ------------------ |
| -- Process_Loop -- |
| ------------------ |
| |
| function Process_Loop (N : Node_Id) return Traverse_Result is |
| Id : Entity_Id; |
| |
| begin |
| if Nkind (N) = N_Loop_Statement |
| and then Present (Identifier (N)) |
| then |
| -- Create new external name for loop and update the |
| -- corresponding entity. |
| |
| Id := Entity (Identifier (N)); |
| Set_Chars (Id, New_External_Name (Chars (Id), 'L', -1)); |
| Set_Chars (Identifier (N), Chars (Id)); |
| |
| elsif Nkind (N) = N_Exit_Statement |
| and then Present (Name (N)) |
| then |
| -- The exit statement must name an enclosing loop, whose name |
| -- has already been updated. |
| |
| Set_Chars (Name (N), Chars (Entity (Name (N)))); |
| end if; |
| |
| return OK; |
| end Process_Loop; |
| |
| procedure Update_Loop_Names is new Traverse_Proc (Process_Loop); |
| |
| -- Local variables |
| |
| Stmt : Node_Id; |
| |
| -- Start of processing for Make_Loop_Labels_Unique |
| |
| begin |
| if Modify_Tree_For_C then |
| Stmt := First (Statements (HSS)); |
| while Present (Stmt) loop |
| Update_Loop_Names (Stmt); |
| Next (Stmt); |
| end loop; |
| end if; |
| end Make_Loop_Labels_Unique; |
| |
| --------------------- |
| -- Process_Formals -- |
| --------------------- |
| |
| function Process_Formals (N : Node_Id) return Traverse_Result is |
| A : Entity_Id; |
| E : Entity_Id; |
| Ret : Node_Id; |
| |
| Had_Private_View : Boolean; |
| |
| begin |
| if Is_Entity_Name (N) and then Present (Entity (N)) then |
| E := Entity (N); |
| |
| if Is_Formal (E) and then Scope (E) = Subp then |
| A := Renamed_Object (E); |
| |
| -- Rewrite the occurrence of the formal into an occurrence of |
| -- the actual. Also establish visibility on the proper view of |
| -- the actual's subtype for the body's context (if the actual's |
| -- subtype is private at the call point but its full view is |
| -- visible to the body, then the inlined tree here must be |
| -- analyzed with the full view). |
| -- |
| -- The Has_Private_View flag is cleared by rewriting, so it |
| -- must be explicitly saved and restored, just like when |
| -- instantiating the body to inline. |
| |
| if Is_Entity_Name (A) then |
| Had_Private_View := Has_Private_View (N); |
| Rewrite (N, New_Occurrence_Of (Entity (A), Sloc (N))); |
| Set_Has_Private_View (N, Had_Private_View); |
| Check_Private_View (N); |
| |
| elsif Nkind (A) = N_Defining_Identifier then |
| Had_Private_View := Has_Private_View (N); |
| Rewrite (N, New_Occurrence_Of (A, Sloc (N))); |
| Set_Has_Private_View (N, Had_Private_View); |
| Check_Private_View (N); |
| |
| -- Numeric literal |
| |
| else |
| Rewrite (N, New_Copy (A)); |
| end if; |
| end if; |
| |
| return Skip; |
| |
| elsif Is_Entity_Name (N) |
| and then Present (Return_Object) |
| and then Chars (N) = Chars (Return_Object) |
| then |
| -- Occurrence within an extended return statement. The return |
| -- object is local to the body been inlined, and thus the generic |
| -- copy is not analyzed yet, so we match by name, and replace it |
| -- with target of call. |
| |
| if Nkind (Targ) = N_Defining_Identifier then |
| Rewrite (N, New_Occurrence_Of (Targ, Loc)); |
| else |
| Rewrite (N, New_Copy_Tree (Targ)); |
| end if; |
| |
| return Skip; |
| |
| elsif Nkind (N) = N_Simple_Return_Statement then |
| if No (Expression (N)) then |
| Num_Ret := Num_Ret + 1; |
| Make_Exit_Label; |
| Rewrite (N, |
| Make_Goto_Statement (Loc, Name => New_Copy (Lab_Id))); |
| |
| else |
| if Nkind (Parent (N)) = N_Handled_Sequence_Of_Statements |
| and then Nkind (Parent (Parent (N))) = N_Subprogram_Body |
| then |
| -- Function body is a single expression. No need for |
| -- exit label. |
| |
| null; |
| |
| else |
| Num_Ret := Num_Ret + 1; |
| Make_Exit_Label; |
| end if; |
| |
| -- Because of the presence of private types, the views of the |
| -- expression and the context may be different, so place |
| -- a type conversion to the context type to avoid spurious |
| -- errors, e.g. when the expression is a numeric literal and |
| -- the context is private. If the expression is an aggregate, |
| -- use a qualified expression, because an aggregate is not a |
| -- legal argument of a conversion. Ditto for numeric, character |
| -- and string literals, and attributes that yield a universal |
| -- type, because those must be resolved to a specific type. |
| |
| if Nkind (Expression (N)) in N_Aggregate |
| | N_Character_Literal |
| | N_Null |
| | N_String_Literal |
| or else Yields_Universal_Type (Expression (N)) |
| then |
| Ret := |
| Make_Qualified_Expression (Sloc (N), |
| Subtype_Mark => New_Occurrence_Of (Ret_Type, Sloc (N)), |
| Expression => Relocate_Node (Expression (N))); |
| |
| -- Use an unchecked type conversion between access types, for |
| -- which a type conversion would not always be valid, as no |
| -- check may result from the conversion. |
| |
| elsif Is_Access_Type (Ret_Type) then |
| Ret := |
| Unchecked_Convert_To |
| (Ret_Type, Relocate_Node (Expression (N))); |
| |
| -- Otherwise use a type conversion, which may trigger a check |
| |
| else |
| Ret := |
| Make_Type_Conversion (Sloc (N), |
| Subtype_Mark => New_Occurrence_Of (Ret_Type, Sloc (N)), |
| Expression => Relocate_Node (Expression (N))); |
| end if; |
| |
| if Nkind (Targ) = N_Defining_Identifier then |
| Rewrite (N, |
| Make_Assignment_Statement (Loc, |
| Name => New_Occurrence_Of (Targ, Loc), |
| Expression => Ret)); |
| else |
| Rewrite (N, |
| Make_Assignment_Statement (Loc, |
| Name => New_Copy (Targ), |
| Expression => Ret)); |
| end if; |
| |
| Set_Assignment_OK (Name (N)); |
| |
| if Present (Exit_Lab) then |
| Insert_After (N, |
| Make_Goto_Statement (Loc, Name => New_Copy (Lab_Id))); |
| end if; |
| end if; |
| |
| return OK; |
| |
| -- An extended return becomes a block whose first statement is the |
| -- assignment of the initial expression of the return object to the |
| -- target of the call itself. |
| |
| elsif Nkind (N) = N_Extended_Return_Statement then |
| declare |
| Return_Decl : constant Entity_Id := |
| First (Return_Object_Declarations (N)); |
| Assign : Node_Id; |
| |
| begin |
| Return_Object := Defining_Identifier (Return_Decl); |
| |
| if Present (Expression (Return_Decl)) then |
| if Nkind (Targ) = N_Defining_Identifier then |
| Assign := |
| Make_Assignment_Statement (Loc, |
| Name => New_Occurrence_Of (Targ, Loc), |
| Expression => Expression (Return_Decl)); |
| else |
| Assign := |
| Make_Assignment_Statement (Loc, |
| Name => New_Copy (Targ), |
| Expression => Expression (Return_Decl)); |
| end if; |
| |
| Set_Assignment_OK (Name (Assign)); |
| |
| if No (Handled_Statement_Sequence (N)) then |
| Set_Handled_Statement_Sequence (N, |
| Make_Handled_Sequence_Of_Statements (Loc, |
| Statements => New_List)); |
| end if; |
| |
| Prepend (Assign, |
| Statements (Handled_Statement_Sequence (N))); |
| end if; |
| |
| Rewrite (N, |
| Make_Block_Statement (Loc, |
| Handled_Statement_Sequence => |
| Handled_Statement_Sequence (N))); |
| |
| return OK; |
| end; |
| |
| -- Remove pragma Unreferenced since it may refer to formals that |
| -- are not visible in the inlined body, and in any case we will |
| -- not be posting warnings on the inlined body so it is unneeded. |
| |
| elsif Nkind (N) = N_Pragma |
| and then Pragma_Name (N) = Name_Unreferenced |
| then |
| Rewrite (N, Make_Null_Statement (Sloc (N))); |
| return OK; |
| |
| else |
| return OK; |
| end if; |
| end Process_Formals; |
| |
| procedure Replace_Formals is new Traverse_Proc (Process_Formals); |
| |
| -------------------------------- |
| -- Process_Formals_In_Aspects -- |
| -------------------------------- |
| |
| function Process_Formals_In_Aspects |
| (N : Node_Id) return Traverse_Result |
| is |
| A : Node_Id; |
| |
| begin |
| if Has_Aspects (N) then |
| A := First (Aspect_Specifications (N)); |
| while Present (A) loop |
| Replace_Formals (Expression (A)); |
| |
| Next (A); |
| end loop; |
| end if; |
| return OK; |
| end Process_Formals_In_Aspects; |
| |
| procedure Replace_Formals_In_Aspects is |
| new Traverse_Proc (Process_Formals_In_Aspects); |
| |
| ------------------ |
| -- Process_Sloc -- |
| ------------------ |
| |
| function Process_Sloc (Nod : Node_Id) return Traverse_Result is |
| begin |
| if not Debug_Generated_Code then |
| Set_Sloc (Nod, Sloc (N)); |
| Set_Comes_From_Source (Nod, False); |
| end if; |
| |
| return OK; |
| end Process_Sloc; |
| |
| procedure Reset_Slocs is new Traverse_Proc (Process_Sloc); |
| |
| ------------------------------ |
| -- Reset_Dispatching_Calls -- |
| ------------------------------ |
| |
| procedure Reset_Dispatching_Calls (N : Node_Id) is |
| |
| function Do_Reset (N : Node_Id) return Traverse_Result; |
| |
| -------------- |
| -- Do_Reset -- |
| -------------- |
| |
| function Do_Reset (N : Node_Id) return Traverse_Result is |
| begin |
| if Nkind (N) = N_Procedure_Call_Statement |
| and then Nkind (Name (N)) = N_Selected_Component |
| and then Nkind (Prefix (Name (N))) = N_Identifier |
| and then Is_Formal (Entity (Prefix (Name (N)))) |
| and then Is_Dispatching_Operation |
| (Entity (Selector_Name (Name (N)))) |
| then |
| Set_Entity (Selector_Name (Name (N)), Empty); |
| end if; |
| |
| return OK; |
| end Do_Reset; |
| |
| procedure Do_Reset_Calls is new Traverse_Proc (Do_Reset); |
| |
| begin |
| Do_Reset_Calls (N); |
| end Reset_Dispatching_Calls; |
| |
| --------------------------- |
| -- Rewrite_Function_Call -- |
| --------------------------- |
| |
| procedure Rewrite_Function_Call (N : Node_Id; Blk : Node_Id) is |
| HSS : constant Node_Id := Handled_Statement_Sequence (Blk); |
| Fst : constant Node_Id := First (Statements (HSS)); |
| |
| begin |
| Make_Loop_Labels_Unique (HSS); |
| |
| -- Optimize simple case: function body is a single return statement, |
| -- which has been expanded into an assignment. |
| |
| if Is_Empty_List (Declarations (Blk)) |
| and then Nkind (Fst) = N_Assignment_Statement |
| and then No (Next (Fst)) |
| then |
| -- The function call may have been rewritten as the temporary |
| -- that holds the result of the call, in which case remove the |
| -- now useless declaration. |
| |
| if Nkind (N) = N_Identifier |
| and then Nkind (Parent (Entity (N))) = N_Object_Declaration |
| then |
| Rewrite (Parent (Entity (N)), Make_Null_Statement (Loc)); |
| end if; |
| |
| Rewrite (N, Expression (Fst)); |
| |
| elsif Nkind (N) = N_Identifier |
| and then Nkind (Parent (Entity (N))) = N_Object_Declaration |
| then |
| -- The block assigns the result of the call to the temporary |
| |
| Insert_After (Parent (Entity (N)), Blk); |
| |
| -- If the context is an assignment, and the left-hand side is free of |
| -- side-effects, the replacement is also safe. |
| |
| elsif Nkind (Parent (N)) = N_Assignment_Statement |
| and then |
| (Is_Entity_Name (Name (Parent (N))) |
| or else |
| (Nkind (Name (Parent (N))) = N_Explicit_Dereference |
| and then Is_Entity_Name (Prefix (Name (Parent (N))))) |
| |
| or else |
| (Nkind (Name (Parent (N))) = N_Selected_Component |
| and then Is_Entity_Name (Prefix (Name (Parent (N)))))) |
| then |
| -- Replace assignment with the block |
| |
| declare |
| Original_Assignment : constant Node_Id := Parent (N); |
| |
| begin |
| -- Preserve the original assignment node to keep the complete |
| -- assignment subtree consistent enough for Analyze_Assignment |
| -- to proceed (specifically, the original Lhs node must still |
| -- have an assignment statement as its parent). |
| |
| -- We cannot rely on Original_Node to go back from the block |
| -- node to the assignment node, because the assignment might |
| -- already be a rewrite substitution. |
| |
| Discard_Node (Relocate_Node (Original_Assignment)); |
| Rewrite (Original_Assignment, Blk); |
| end; |
| |
| elsif Nkind (Parent (N)) = N_Object_Declaration then |
| |
| -- A call to a function which returns an unconstrained type |
| -- found in the expression initializing an object-declaration is |
| -- expanded into a procedure call which must be added after the |
| -- object declaration. |
| |
| if Is_Unc_Decl and Back_End_Inlining then |
| Insert_Action_After (Parent (N), Blk); |
| else |
| Set_Expression (Parent (N), Empty); |
| Insert_After (Parent (N), Blk); |
| end if; |
| |
| elsif Is_Unc and then not Back_End_Inlining then |
| Insert_Before (Parent (N), Blk); |
| end if; |
| end Rewrite_Function_Call; |
| |
| ---------------------------- |
| -- Rewrite_Procedure_Call -- |
| ---------------------------- |
| |
| procedure Rewrite_Procedure_Call (N : Node_Id; Blk : Node_Id) is |
| HSS : constant Node_Id := Handled_Statement_Sequence (Blk); |
| |
| begin |
| Make_Loop_Labels_Unique (HSS); |
| |
| -- If there is a transient scope for N, this will be the scope of the |
| -- actions for N, and the statements in Blk need to be within this |
| -- scope. For example, they need to have visibility on the constant |
| -- declarations created for the formals. |
| |
| -- If N needs no transient scope, and if there are no declarations in |
| -- the inlined body, we can do a little optimization and insert the |
| -- statements for the body directly after N, and rewrite N to a |
| -- null statement, instead of rewriting N into a full-blown block |
| -- statement. |
| |
| if not Scope_Is_Transient |
| and then Is_Empty_List (Declarations (Blk)) |
| then |
| Insert_List_After (N, Statements (HSS)); |
| Rewrite (N, Make_Null_Statement (Loc)); |
| else |
| Rewrite (N, Blk); |
| end if; |
| end Rewrite_Procedure_Call; |
| |
| -- Start of processing for Expand_Inlined_Call |
| |
| begin |
| -- Initializations for old/new semantics |
| |
| if not Uses_Back_End then |
| Is_Unc := Is_Array_Type (Etype (Subp)) |
| and then not Is_Constrained (Etype (Subp)); |
| Is_Unc_Decl := False; |
| else |
| Is_Unc := Returns_Unconstrained_Type (Subp) |
| and then Optimization_Level > 0; |
| Is_Unc_Decl := Nkind (Parent (N)) = N_Object_Declaration |
| and then Is_Unc; |
| end if; |
| |
| -- Check for an illegal attempt to inline a recursive procedure. If the |
| -- subprogram has parameters this is detected when trying to supply a |
| -- binding for parameters that already have one. For parameterless |
| -- subprograms this must be done explicitly. |
| |
| if In_Open_Scopes (Subp) then |
| Cannot_Inline |
| ("cannot inline call to recursive subprogram?", N, Subp); |
| Set_Is_Inlined (Subp, False); |
| return; |
| |
| -- Skip inlining if this is not a true inlining since the attribute |
| -- Body_To_Inline is also set for renamings (see sinfo.ads). For a |
| -- true inlining, Orig_Bod has code rather than being an entity. |
| |
| elsif Nkind (Orig_Bod) in N_Entity then |
| return; |
| end if; |
| |
| if Nkind (Orig_Bod) in N_Defining_Identifier |
| | N_Defining_Operator_Symbol |
| then |
| -- Subprogram is renaming_as_body. Calls occurring after the renaming |
| -- can be replaced with calls to the renamed entity directly, because |
| -- the subprograms are subtype conformant. If the renamed subprogram |
| -- is an inherited operation, we must redo the expansion because |
| -- implicit conversions may be needed. Similarly, if the renamed |
| -- entity is inlined, expand the call for further optimizations. |
| |
| Set_Name (N, New_Occurrence_Of (Orig_Bod, Loc)); |
| |
| if Present (Alias (Orig_Bod)) or else Is_Inlined (Orig_Bod) then |
| Expand_Call (N); |
| end if; |
| |
| return; |
| end if; |
| |
| -- Register the call in the list of inlined calls |
| |
| Append_New_Elmt (N, To => Inlined_Calls); |
| |
| -- Use generic machinery to copy body of inlined subprogram, as if it |
| -- were an instantiation, resetting source locations appropriately, so |
| -- that nested inlined calls appear in the main unit. |
| |
| Save_Env (Subp, Empty); |
| Set_Copied_Sloc_For_Inlined_Body (N, Defining_Entity (Orig_Bod)); |
| |
| -- Old semantics |
| |
| if not Uses_Back_End then |
| declare |
| Bod : Node_Id; |
| |
| begin |
| Bod := Copy_Generic_Node (Orig_Bod, Empty, Instantiating => True); |
| Blk := |
| Make_Block_Statement (Loc, |
| Declarations => Declarations (Bod), |
| Handled_Statement_Sequence => |
| Handled_Statement_Sequence (Bod)); |
| |
| if No (Declarations (Bod)) then |
| Set_Declarations (Blk, New_List); |
| end if; |
| |
| -- When generating C code, declare _Result, which may be used to |
| -- verify the return value. |
| |
| if Modify_Tree_For_C |
| and then Nkind (N) = N_Procedure_Call_Statement |
| and then Chars (Name (N)) = Name_uWrapped_Statements |
| then |
| Declare_Postconditions_Result; |
| end if; |
| |
| -- For the unconstrained case, capture the name of the local |
| -- variable that holds the result. This must be the first |
| -- declaration in the block, because its bounds cannot depend |
| -- on local variables. Otherwise there is no way to declare the |
| -- result outside of the block. Needless to say, in general the |
| -- bounds will depend on the actuals in the call. |
| |
| -- If the context is an assignment statement, as is the case |
| -- for the expansion of an extended return, the left-hand side |
| -- provides bounds even if the return type is unconstrained. |
| |
| if Is_Unc then |
| declare |
| First_Decl : Node_Id; |
| |
| begin |
| First_Decl := First (Declarations (Blk)); |
| |
| -- If the body is a single extended return statement,the |
| -- resulting block is a nested block. |
| |
| if No (First_Decl) then |
| First_Decl := |
| First (Statements (Handled_Statement_Sequence (Blk))); |
| |
| if Nkind (First_Decl) = N_Block_Statement then |
| First_Decl := First (Declarations (First_Decl)); |
| end if; |
| end if; |
| |
| -- No front-end inlining possible |
| |
| if Nkind (First_Decl) /= N_Object_Declaration then |
| return; |
| end if; |
| |
| if Nkind (Parent (N)) /= N_Assignment_Statement then |
| Targ1 := Defining_Identifier (First_Decl); |
| else |
| Targ1 := Name (Parent (N)); |
| end if; |
| end; |
| end if; |
| end; |
| |
| -- New semantics |
| |
| else |
| declare |
| Bod : Node_Id; |
| |
| begin |
| -- General case |
| |
| if not Is_Unc then |
| Bod := |
| Copy_Generic_Node (Orig_Bod, Empty, Instantiating => True); |
| Blk := |
| Make_Block_Statement (Loc, |
| Declarations => Declarations (Bod), |
| Handled_Statement_Sequence => |
| Handled_Statement_Sequence (Bod)); |
| |
| -- Inline a call to a function that returns an unconstrained type. |
| -- The semantic analyzer checked that frontend-inlined functions |
| -- returning unconstrained types have no declarations and have |
| -- a single extended return statement. As part of its processing |
| -- the function was split into two subprograms: a procedure P' and |
| -- a function F' that has a block with a call to procedure P' (see |
| -- Split_Unconstrained_Function). |
| |
| else |
| pragma Assert |
| (Nkind |
| (First |
| (Statements (Handled_Statement_Sequence (Orig_Bod)))) = |
| N_Block_Statement); |
| |
| declare |
| Blk_Stmt : constant Node_Id := |
| First (Statements (Handled_Statement_Sequence (Orig_Bod))); |
| First_Stmt : constant Node_Id := |
| First (Statements (Handled_Statement_Sequence (Blk_Stmt))); |
| Second_Stmt : constant Node_Id := Next (First_Stmt); |
| |
| begin |
| pragma Assert |
| (Nkind (First_Stmt) = N_Procedure_Call_Statement |
| and then Nkind (Second_Stmt) = N_Simple_Return_Statement |
| and then No (Next (Second_Stmt))); |
| |
| Bod := |
| Copy_Generic_Node |
| (First |
| (Statements (Handled_Statement_Sequence (Orig_Bod))), |
| Empty, Instantiating => True); |
| Blk := Bod; |
| |
| -- Capture the name of the local variable that holds the |
| -- result. This must be the first declaration in the block, |
| -- because its bounds cannot depend on local variables. |
| -- Otherwise there is no way to declare the result outside |
| -- of the block. Needless to say, in general the bounds will |
| -- depend on the actuals in the call. |
| |
| if Nkind (Parent (N)) /= N_Assignment_Statement then |
| Targ1 := Defining_Identifier (First (Declarations (Blk))); |
| |
| -- If the context is an assignment statement, as is the case |
| -- for the expansion of an extended return, the left-hand |
| -- side provides bounds even if the return type is |
| -- unconstrained. |
| |
| else |
| Targ1 := Name (Parent (N)); |
| end if; |
| end; |
| end if; |
| |
| if No (Declarations (Bod)) then |
| Set_Declarations (Blk, New_List); |
| end if; |
| end; |
| end if; |
| |
| -- If this is a derived function, establish the proper return type |
| |
| if Present (Orig_Subp) and then Orig_Subp /= Subp then |
| Ret_Type := Etype (Orig_Subp); |
| else |
| Ret_Type := Etype (Subp); |
| end if; |
| |
| -- Create temporaries for the actuals that are expressions, or that are |
| -- scalars and require copying to preserve semantics. |
| |
| Establish_Actual_Mapping_For_Inlined_Call (N, Subp, Decls, Orig_Bod); |
| |
| -- Establish target of function call. If context is not assignment or |
| -- declaration, create a temporary as a target. The declaration for the |
| -- temporary may be subsequently optimized away if the body is a single |
| -- expression, or if the left-hand side of the assignment is simple |
| -- enough, i.e. an entity or an explicit dereference of one. |
| |
| if Ekind (Subp) = E_Function then |
| if Nkind (Parent (N)) = N_Assignment_Statement |
| and then Is_Entity_Name (Name (Parent (N))) |
| then |
| Targ := Name (Parent (N)); |
| |
| elsif Nkind (Parent (N)) = N_Assignment_Statement |
| and then Nkind (Name (Parent (N))) = N_Explicit_Dereference |
| and then Is_Entity_Name (Prefix (Name (Parent (N)))) |
| then |
| Targ := Name (Parent (N)); |
| |
| elsif Nkind (Parent (N)) = N_Assignment_Statement |
| and then Nkind (Name (Parent (N))) = N_Selected_Component |
| and then Is_Entity_Name (Prefix (Name (Parent (N)))) |
| then |
| Targ := New_Copy_Tree (Name (Parent (N))); |
| |
| elsif Nkind (Parent (N)) = N_Object_Declaration |
| and then Is_Limited_Type (Etype (Subp)) |
| then |
| Targ := Defining_Identifier (Parent (N)); |
| |
| -- New semantics: In an object declaration avoid an extra copy |
| -- of the result of a call to an inlined function that returns |
| -- an unconstrained type |
| |
| elsif Uses_Back_End |
| and then Nkind (Parent (N)) = N_Object_Declaration |
| and then Is_Unc |
| then |
| Targ := Defining_Identifier (Parent (N)); |
| |
| else |
| -- Replace call with temporary and create its declaration |
| |
| Temp := Make_Temporary (Loc, 'C'); |
| Set_Is_Internal (Temp); |
| |
| -- For the unconstrained case, the generated temporary has the |
| -- same constrained declaration as the result variable. It may |
| -- eventually be possible to remove that temporary and use the |
| -- result variable directly. |
| |
| if Is_Unc and then Nkind (Parent (N)) /= N_Assignment_Statement |
| then |
| Decl := |
| Make_Object_Declaration (Loc, |
| Defining_Identifier => Temp, |
| Object_Definition => |
| New_Copy_Tree (Object_Definition (Parent (Targ1)))); |
| |
| Replace_Formals (Decl); |
| |
| else |
| Decl := |
| Make_Object_Declaration (Loc, |
| Defining_Identifier => Temp, |
| Object_Definition => New_Occurrence_Of (Ret_Type, Loc)); |
| |
| Set_Etype (Temp, Ret_Type); |
| end if; |
| |
| Set_No_Initialization (Decl); |
| Append (Decl, Decls); |
| Rewrite (N, New_Occurrence_Of (Temp, Loc)); |
| Targ := Temp; |
| end if; |
| end if; |
| |
| Insert_Actions (N, Decls); |
| |
| if Is_Unc_Decl then |
| |
| -- Special management for inlining a call to a function that returns |
| -- an unconstrained type and initializes an object declaration: we |
| -- avoid generating undesired extra calls and goto statements. |
| |
| -- Given: |
| -- function Func (...) return String is |
| -- begin |
| -- declare |
| -- Result : String (1 .. 4); |
| -- begin |
| -- Proc (Result, ...); |
| -- return Result; |
| -- end; |
| -- end Func; |
| |
| -- Result : String := Func (...); |
| |
| -- Replace this object declaration by: |
| |
| -- Result : String (1 .. 4); |
| -- Proc (Result, ...); |
| |
| Remove_Homonym (Targ); |
| |
| Decl := |
| Make_Object_Declaration |
| (Loc, |
| Defining_Identifier => Targ, |
| Object_Definition => |
| New_Copy_Tree (Object_Definition (Parent (Targ1)))); |
| Replace_Formals (Decl); |
| Rewrite (Parent (N), Decl); |
| Analyze (Parent (N)); |
| |
| -- Avoid spurious warnings since we know that this declaration is |
| -- referenced by the procedure call. |
| |
| Set_Never_Set_In_Source (Targ, False); |
| |
| -- Remove the local declaration of the extended return stmt from the |
| -- inlined code |
| |
| Remove (Parent (Targ1)); |
| |
| -- Update the reference to the result (since we have rewriten the |
| -- object declaration) |
| |
| declare |
| Blk_Call_Stmt : Node_Id; |
| |
| begin |
| -- Capture the call to the procedure |
| |
| Blk_Call_Stmt := |
| First (Statements (Handled_Statement_Sequence (Blk))); |
| pragma Assert |
| (Nkind (Blk_Call_Stmt) = N_Procedure_Call_Statement); |
| |
| Remove (First (Parameter_Associations (Blk_Call_Stmt))); |
| Prepend_To (Parameter_Associations (Blk_Call_Stmt), |
| New_Occurrence_Of (Targ, Loc)); |
| end; |
| |
| -- Remove the return statement |
| |
| pragma Assert |
| (Nkind (Last (Statements (Handled_Statement_Sequence (Blk)))) = |
| N_Simple_Return_Statement); |
| |
| Remove (Last (Statements (Handled_Statement_Sequence (Blk)))); |
| end if; |
| |
| -- Traverse the tree and replace formals with actuals or their thunks. |
| -- Attach block to tree before analysis and rewriting. |
| |
| Replace_Formals (Blk); |
| Replace_Formals_In_Aspects (Blk); |
| Set_Parent (Blk, N); |
| |
| if GNATprove_Mode then |
| null; |
| |
| elsif not Comes_From_Source (Subp) or else Is_Predef then |
| Reset_Slocs (Blk); |
| end if; |
| |
| if Is_Unc_Decl then |
| |
| -- No action needed since return statement has been already removed |
| |
| null; |
| |
| elsif Present (Exit_Lab) then |
| |
| -- If there's a single return statement at the end of the subprogram, |
| -- the corresponding goto statement and the corresponding label are |
| -- useless. |
| |
| if Num_Ret = 1 |
| and then |
| Nkind (Last (Statements (Handled_Statement_Sequence (Blk)))) = |
| N_Goto_Statement |
| then |
| Remove (Last (Statements (Handled_Statement_Sequence (Blk)))); |
| else |
| Append (Lab_Decl, (Declarations (Blk))); |
| Append (Exit_Lab, Statements (Handled_Statement_Sequence (Blk))); |
| end if; |
| end if; |
| |
| -- Analyze Blk with In_Inlined_Body set, to avoid spurious errors |
| -- on conflicting private views that Gigi would ignore. If this is a |
| -- predefined unit, analyze with checks off, as is done in the non- |
| -- inlined run-time units. |
| |
| declare |
| I_Flag : constant Boolean := In_Inlined_Body; |
| |
| begin |
| In_Inlined_Body := True; |
| |
| if Is_Predef then |
| declare |
| Style : constant Boolean := Style_Check; |
| |
| begin |
| Style_Check := False; |
| |
| -- Search for dispatching calls that use the Object.Operation |
| -- notation using an Object that is a parameter of the inlined |
| -- function. We reset the decoration of Operation to force |
| -- the reanalysis of the inlined dispatching call because |
| -- the actual object has been inlined. |
| |
| Reset_Dispatching_Calls (Blk); |
| |
| -- In GNATprove mode, always consider checks on, even for |
| -- predefined units. |
| |
| if GNATprove_Mode then |
| Analyze (Blk); |
| else |
| Analyze (Blk, Suppress => All_Checks); |
| end if; |
| |
| Style_Check := Style; |
| end; |
| |
| else |
| Analyze (Blk); |
| end if; |
| |
| In_Inlined_Body := I_Flag; |
| end; |
| |
| if Ekind (Subp) = E_Procedure then |
| Rewrite_Procedure_Call (N, Blk); |
| |
| else |
| Rewrite_Function_Call (N, Blk); |
| |
| if Is_Unc_Decl then |
| null; |
| |
| -- For the unconstrained case, the replacement of the call has been |
| -- made prior to the complete analysis of the generated declarations. |
| -- Propagate the proper type now. |
| |
| elsif Is_Unc then |
| if Nkind (N) = N_Identifier then |
| Set_Etype (N, Etype (Entity (N))); |
| else |
| Set_Etype (N, Etype (Targ1)); |
| end if; |
| end if; |
| end if; |
| |
| Restore_Env; |
| |
| -- Cleanup mapping between formals and actuals for other expansions |
| |
| Reset_Actual_Mapping_For_Inlined_Call (Subp); |
| end Expand_Inlined_Call; |
| |
| -------------------------- |
| -- Get_Code_Unit_Entity -- |
| -------------------------- |
| |
| function Get_Code_Unit_Entity (E : Entity_Id) return Entity_Id is |
| Unit : Entity_Id := Cunit_Entity (Get_Code_Unit (E)); |
| |
| begin |
| if Ekind (Unit) = E_Package_Body then |
| Unit := Spec_Entity (Unit); |
| end if; |
| |
| return Unit; |
| end Get_Code_Unit_Entity; |
| |
| ------------------------------ |
| -- Has_Excluded_Declaration -- |
| ------------------------------ |
| |
| function Has_Excluded_Declaration |
| (Subp : Entity_Id; |
| Decls : List_Id) return Boolean |
| is |
| function Is_Unchecked_Conversion (D : Node_Id) return Boolean; |
| -- Nested subprograms make a given body ineligible for inlining, but |
| -- we make an exception for instantiations of unc
|