1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
11 -- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
13 -- GNAT is free software; you can redistribute it and/or modify it under --
14 -- terms of the GNU General Public License as published by the Free Soft- --
15 -- ware Foundation; either version 2, or (at your option) any later ver- --
16 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
17 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
18 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
19 -- for more details. You should have received a copy of the GNU General --
20 -- Public License distributed with GNAT; see file COPYING. If not, write --
21 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
22 -- MA 02111-1307, USA. --
24 -- GNAT was originally developed by the GNAT team at New York University. --
25 -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
27 ------------------------------------------------------------------------------
29 with Atree; use Atree;
30 with Einfo; use Einfo;
31 with Elists; use Elists;
32 with Errout; use Errout;
33 with Exp_Ch7; use Exp_Ch7;
34 with Exp_Ch11; use Exp_Ch11;
35 with Exp_Tss; use Exp_Tss;
36 with Fname; use Fname;
37 with Fname.UF; use Fname.UF;
39 with Nlists; use Nlists;
41 with Sem_Ch8; use Sem_Ch8;
42 with Sem_Ch10; use Sem_Ch10;
43 with Sem_Ch12; use Sem_Ch12;
44 with Sem_Util; use Sem_Util;
45 with Sinfo; use Sinfo;
46 with Snames; use Snames;
47 with Stand; use Stand;
48 with Uname; use Uname;
50 package body Inline is
56 -- Inlined functions are actually placed in line by the backend if the
57 -- corresponding bodies are available (i.e. compiled). Whenever we find
58 -- a call to an inlined subprogram, we add the name of the enclosing
59 -- compilation unit to a worklist. After all compilation, and after
60 -- expansion of generic bodies, we traverse the list of pending bodies
61 -- and compile them as well.
63 package Inlined_Bodies is new Table.Table (
64 Table_Component_Type => Entity_Id,
65 Table_Index_Type => Int,
67 Table_Initial => Alloc.Inlined_Bodies_Initial,
68 Table_Increment => Alloc.Inlined_Bodies_Increment,
69 Table_Name => "Inlined_Bodies");
71 -----------------------
72 -- Inline Processing --
73 -----------------------
75 -- For each call to an inlined subprogram, we make entries in a table
76 -- that stores caller and callee, and indicates a prerequisite from
77 -- one to the other. We also record the compilation unit that contains
78 -- the callee. After analyzing the bodies of all such compilation units,
79 -- we produce a list of subprograms in topological order, for use by the
80 -- back-end. If P2 is a prerequisite of P1, then P1 calls P2, and for
81 -- proper inlining the back-end must analyze the body of P2 before that of
82 -- P1. The code below guarantees that the transitive closure of inlined
83 -- subprograms called from the main compilation unit is made available to
84 -- the code generator.
86 Last_Inlined : Entity_Id := Empty;
88 -- For each entry in the table we keep a list of successors in topological
89 -- order, i.e. callers of the current subprogram.
91 type Subp_Index is new Nat;
92 No_Subp : constant Subp_Index := 0;
94 -- The subprogram entities are hashed into the Inlined table.
96 Num_Hash_Headers : constant := 512;
98 Hash_Headers : array (Subp_Index range 0 .. Num_Hash_Headers - 1)
101 type Succ_Index is new Nat;
102 No_Succ : constant Succ_Index := 0;
104 type Succ_Info is record
109 -- The following table stores list elements for the successor lists.
110 -- These lists cannot be chained directly through entries in the Inlined
111 -- table, because a given subprogram can appear in several such lists.
113 package Successors is new Table.Table (
114 Table_Component_Type => Succ_Info,
115 Table_Index_Type => Succ_Index,
116 Table_Low_Bound => 1,
117 Table_Initial => Alloc.Successors_Initial,
118 Table_Increment => Alloc.Successors_Increment,
119 Table_Name => "Successors");
121 type Subp_Info is record
122 Name : Entity_Id := Empty;
123 First_Succ : Succ_Index := No_Succ;
124 Count : Integer := 0;
125 Listed : Boolean := False;
126 Main_Call : Boolean := False;
127 Next : Subp_Index := No_Subp;
128 Next_Nopred : Subp_Index := No_Subp;
131 package Inlined is new Table.Table (
132 Table_Component_Type => Subp_Info,
133 Table_Index_Type => Subp_Index,
134 Table_Low_Bound => 1,
135 Table_Initial => Alloc.Inlined_Initial,
136 Table_Increment => Alloc.Inlined_Increment,
137 Table_Name => "Inlined");
139 -----------------------
140 -- Local Subprograms --
141 -----------------------
143 function Scope_In_Main_Unit (Scop : Entity_Id) return Boolean;
144 -- Return True if Scop is in the main unit or its spec, or in a
145 -- parent of the main unit if it is a child unit.
147 procedure Add_Call (Called : Entity_Id; Caller : Entity_Id := Empty);
148 -- Make two entries in Inlined table, for an inlined subprogram being
149 -- called, and for the inlined subprogram that contains the call. If
150 -- the call is in the main compilation unit, Caller is Empty.
152 function Add_Subp (E : Entity_Id) return Subp_Index;
153 -- Make entry in Inlined table for subprogram E, or return table index
154 -- that already holds E.
156 function Has_Initialized_Type (E : Entity_Id) return Boolean;
157 -- If a candidate for inlining contains type declarations for types with
158 -- non-trivial initialization procedures, they are not worth inlining.
160 function Is_Nested (E : Entity_Id) return Boolean;
161 -- If the function is nested inside some other function, it will
162 -- always be compiled if that function is, so don't add it to the
163 -- inline list. We cannot compile a nested function outside the
164 -- scope of the containing function anyway. This is also the case if
165 -- the function is defined in a task body or within an entry (for
166 -- example, an initialization procedure).
168 procedure Add_Inlined_Subprogram (Index : Subp_Index);
169 -- Add subprogram to Inlined List once all of its predecessors have been
170 -- placed on the list. Decrement the count of all its successors, and
171 -- add them to list (recursively) if count drops to zero.
173 ------------------------------
174 -- Deferred Cleanup Actions --
175 ------------------------------
177 -- The cleanup actions for scopes that contain instantiations is delayed
178 -- until after expansion of those instantiations, because they may
179 -- contain finalizable objects or tasks that affect the cleanup code.
180 -- A scope that contains instantiations only needs to be finalized once,
181 -- even if it contains more than one instance. We keep a list of scopes
182 -- that must still be finalized, and call cleanup_actions after all the
183 -- instantiations have been completed.
187 procedure Add_Scope_To_Clean (Inst : Entity_Id);
188 -- Build set of scopes on which cleanup actions must be performed.
190 procedure Cleanup_Scopes;
191 -- Complete cleanup actions on scopes that need it.
197 procedure Add_Call (Called : Entity_Id; Caller : Entity_Id := Empty) is
198 P1 : Subp_Index := Add_Subp (Called);
203 if Present (Caller) then
204 P2 := Add_Subp (Caller);
206 -- Add P2 to the list of successors of P1, if not already there.
207 -- Note that P2 may contain more than one call to P1, and only
208 -- one needs to be recorded.
210 J := Inlined.Table (P1).First_Succ;
212 while J /= No_Succ loop
214 if Successors.Table (J).Subp = P2 then
218 J := Successors.Table (J).Next;
221 -- On exit, make a successor entry for P2.
223 Successors.Increment_Last;
224 Successors.Table (Successors.Last).Subp := P2;
225 Successors.Table (Successors.Last).Next :=
226 Inlined.Table (P1).First_Succ;
227 Inlined.Table (P1).First_Succ := Successors.Last;
229 Inlined.Table (P2).Count := Inlined.Table (P2).Count + 1;
232 Inlined.Table (P1).Main_Call := True;
236 ----------------------
237 -- Add_Inlined_Body --
238 ----------------------
240 procedure Add_Inlined_Body (E : Entity_Id) is
244 function Must_Inline return Boolean;
245 -- Inlining is only done if the call statement N is in the main unit,
246 -- or within the body of another inlined subprogram.
248 function Must_Inline return Boolean is
249 Scop : Entity_Id := Current_Scope;
253 -- Check if call is in main unit.
255 while Scope (Scop) /= Standard_Standard
256 and then not Is_Child_Unit (Scop)
258 Scop := Scope (Scop);
261 Comp := Parent (Scop);
263 while Nkind (Comp) /= N_Compilation_Unit loop
264 Comp := Parent (Comp);
267 if (Comp = Cunit (Main_Unit)
268 or else Comp = Library_Unit (Cunit (Main_Unit)))
274 -- Call is not in main unit. See if it's in some inlined
277 Scop := Current_Scope;
278 while Scope (Scop) /= Standard_Standard
279 and then not Is_Child_Unit (Scop)
281 if Is_Overloadable (Scop)
282 and then Is_Inlined (Scop)
288 Scop := Scope (Scop);
295 -- Start of processing for Add_Inlined_Body
298 -- Find unit containing E, and add to list of inlined bodies if needed.
299 -- If the body is already present, no need to load any other unit. This
300 -- is the case for an initialization procedure, which appears in the
301 -- package declaration that contains the type. It is also the case if
302 -- the body has already been analyzed. Finally, if the unit enclosing
303 -- E is an instance, the instance body will be analyzed in any case,
304 -- and there is no need to add the enclosing unit (whose body might not
307 -- Library-level functions must be handled specially, because there is
308 -- no enclosing package to retrieve. In this case, it is the body of
309 -- the function that will have to be loaded.
311 if not Is_Abstract (E) and then not Is_Nested (E)
312 and then Convention (E) /= Convention_Protected
317 and then Ekind (Pack) = E_Package
320 Comp_Unit := Parent (Pack);
322 if Pack = Standard_Standard then
324 -- Library-level inlined function. Add function iself to
325 -- list of needed units.
327 Inlined_Bodies.Increment_Last;
328 Inlined_Bodies.Table (Inlined_Bodies.Last) := E;
330 elsif Is_Generic_Instance (Pack) then
333 elsif not Is_Inlined (Pack)
334 and then not Has_Completion (E)
335 and then not Scope_In_Main_Unit (Pack)
337 Set_Is_Inlined (Pack);
338 Inlined_Bodies.Increment_Last;
339 Inlined_Bodies.Table (Inlined_Bodies.Last) := Pack;
343 end Add_Inlined_Body;
345 ----------------------------
346 -- Add_Inlined_Subprogram --
347 ----------------------------
349 procedure Add_Inlined_Subprogram (Index : Subp_Index) is
350 E : constant Entity_Id := Inlined.Table (Index).Name;
355 -- Insert the current subprogram in the list of inlined subprograms
357 if not Scope_In_Main_Unit (E)
358 and then Is_Inlined (E)
359 and then not Is_Nested (E)
360 and then not Has_Initialized_Type (E)
362 if No (Last_Inlined) then
363 Set_First_Inlined_Subprogram (Cunit (Main_Unit), E);
365 Set_Next_Inlined_Subprogram (Last_Inlined, E);
371 Inlined.Table (Index).Listed := True;
372 Succ := Inlined.Table (Index).First_Succ;
374 while Succ /= No_Succ loop
375 Subp := Successors.Table (Succ).Subp;
376 Inlined.Table (Subp).Count := Inlined.Table (Subp).Count - 1;
378 if Inlined.Table (Subp).Count = 0 then
379 Add_Inlined_Subprogram (Subp);
382 Succ := Successors.Table (Succ).Next;
384 end Add_Inlined_Subprogram;
386 ------------------------
387 -- Add_Scope_To_Clean --
388 ------------------------
390 procedure Add_Scope_To_Clean (Inst : Entity_Id) is
392 Scop : Entity_Id := Enclosing_Dynamic_Scope (Inst);
395 -- If the instance appears in a library-level package declaration,
396 -- all finalization is global, and nothing needs doing here.
398 if Scop = Standard_Standard then
402 Elmt := First_Elmt (To_Clean);
404 while Present (Elmt) loop
406 if Node (Elmt) = Scop then
410 Elmt := Next_Elmt (Elmt);
413 Append_Elmt (Scop, To_Clean);
414 end Add_Scope_To_Clean;
420 function Add_Subp (E : Entity_Id) return Subp_Index is
421 Index : Subp_Index := Subp_Index (E) mod Num_Hash_Headers;
425 -- Initialize entry in Inlined table.
427 procedure New_Entry is
429 Inlined.Increment_Last;
430 Inlined.Table (Inlined.Last).Name := E;
431 Inlined.Table (Inlined.Last).First_Succ := No_Succ;
432 Inlined.Table (Inlined.Last).Count := 0;
433 Inlined.Table (Inlined.Last).Listed := False;
434 Inlined.Table (Inlined.Last).Main_Call := False;
435 Inlined.Table (Inlined.Last).Next := No_Subp;
436 Inlined.Table (Inlined.Last).Next_Nopred := No_Subp;
439 -- Start of processing for Add_Subp
442 if Hash_Headers (Index) = No_Subp then
444 Hash_Headers (Index) := Inlined.Last;
448 J := Hash_Headers (Index);
450 while J /= No_Subp loop
452 if Inlined.Table (J).Name = E then
456 J := Inlined.Table (J).Next;
460 -- On exit, subprogram was not found. Enter in table. Index is
461 -- the current last entry on the hash chain.
464 Inlined.Table (Index).Next := Inlined.Last;
469 ----------------------------
470 -- Analyze_Inlined_Bodies --
471 ----------------------------
473 procedure Analyze_Inlined_Bodies is
480 Analyzing_Inlined_Bodies := False;
482 if Errors_Detected = 0 then
483 New_Scope (Standard_Standard);
486 while J <= Inlined_Bodies.Last
487 and then Errors_Detected = 0
489 Pack := Inlined_Bodies.Table (J);
492 and then Scope (Pack) /= Standard_Standard
493 and then not Is_Child_Unit (Pack)
495 Pack := Scope (Pack);
498 Comp_Unit := Parent (Pack);
500 while Present (Comp_Unit)
501 and then Nkind (Comp_Unit) /= N_Compilation_Unit
503 Comp_Unit := Parent (Comp_Unit);
506 if Present (Comp_Unit)
507 and then Comp_Unit /= Cunit (Main_Unit)
508 and then Body_Required (Comp_Unit)
511 Bname : constant Unit_Name_Type :=
512 Get_Body_Name (Get_Unit_Name (Unit (Comp_Unit)));
517 if not Is_Loaded (Bname) then
518 Load_Needed_Body (Comp_Unit, OK);
521 Error_Msg_Unit_1 := Bname;
523 ("one or more inlined subprograms accessed in $!",
526 Get_File_Name (Bname, Subunit => False);
527 Error_Msg_N ("\but file{ was not found!", Comp_Unit);
528 raise Unrecoverable_Error;
537 -- The analysis of required bodies may have produced additional
538 -- generic instantiations. To obtain further inlining, we perform
539 -- another round of generic body instantiations. Establishing a
540 -- fully recursive loop between inlining and generic instantiations
541 -- is unlikely to yield more than this one additional pass.
545 -- The list of inlined subprograms is an overestimate, because
546 -- it includes inlined functions called from functions that are
547 -- compiled as part of an inlined package, but are not themselves
548 -- called. An accurate computation of just those subprograms that
549 -- are needed requires that we perform a transitive closure over
550 -- the call graph, starting from calls in the main program. Here
551 -- we do one step of the inverse transitive closure, and reset
552 -- the Is_Called flag on subprograms all of whose callers are not.
554 for Index in Inlined.First .. Inlined.Last loop
555 S := Inlined.Table (Index).First_Succ;
558 and then not Inlined.Table (Index).Main_Call
560 Set_Is_Called (Inlined.Table (Index).Name, False);
562 while S /= No_Succ loop
565 (Inlined.Table (Successors.Table (S).Subp).Name)
566 or else Inlined.Table (Successors.Table (S).Subp).Main_Call
568 Set_Is_Called (Inlined.Table (Index).Name);
572 S := Successors.Table (S).Next;
577 -- Now that the units are compiled, chain the subprograms within
578 -- that are called and inlined. Produce list of inlined subprograms
579 -- sorted in topological order. Start with all subprograms that
580 -- have no prerequisites, i.e. inlined subprograms that do not call
581 -- other inlined subprograms.
583 for Index in Inlined.First .. Inlined.Last loop
585 if Is_Called (Inlined.Table (Index).Name)
586 and then Inlined.Table (Index).Count = 0
587 and then not Inlined.Table (Index).Listed
589 Add_Inlined_Subprogram (Index);
593 -- Because Add_Inlined_Subprogram treats recursively nodes that have
594 -- no prerequisites left, at the end of the loop all subprograms
595 -- must have been listed. If there are any unlisted subprograms
596 -- left, there must be some recursive chains that cannot be inlined.
598 for Index in Inlined.First .. Inlined.Last loop
599 if Is_Called (Inlined.Table (Index).Name)
600 and then Inlined.Table (Index).Count /= 0
601 and then not Is_Predefined_File_Name
603 (Get_Source_Unit (Inlined.Table (Index).Name)))
606 ("& cannot be inlined?", Inlined.Table (Index).Name);
607 -- A warning on the first one might be sufficient.
613 end Analyze_Inlined_Bodies;
615 --------------------------------
616 -- Check_Body_For_Inlining --
617 --------------------------------
619 procedure Check_Body_For_Inlining (N : Node_Id; P : Entity_Id) is
620 Bname : Unit_Name_Type;
625 if Is_Compilation_Unit (P)
626 and then not Is_Generic_Instance (P)
628 Bname := Get_Body_Name (Get_Unit_Name (Unit (N)));
629 E := First_Entity (P);
631 while Present (E) loop
632 if Has_Pragma_Inline (E) then
633 if not Is_Loaded (Bname) then
634 Load_Needed_Body (N, OK);
637 and then Ineffective_Inline_Warnings
639 Error_Msg_Unit_1 := Bname;
641 ("unable to inline subprograms defined in $?", P);
642 Error_Msg_N ("\body not found?", P);
653 end Check_Body_For_Inlining;
659 procedure Cleanup_Scopes is
665 Elmt := First_Elmt (To_Clean);
667 while Present (Elmt) loop
670 if Ekind (Scop) = E_Entry then
671 Scop := Protected_Body_Subprogram (Scop);
674 if Ekind (Scop) = E_Block then
675 Decl := Parent (Block_Node (Scop));
678 Decl := Unit_Declaration_Node (Scop);
680 if Nkind (Decl) = N_Subprogram_Declaration
681 or else Nkind (Decl) = N_Task_Type_Declaration
682 or else Nkind (Decl) = N_Subprogram_Body_Stub
684 Decl := Unit_Declaration_Node (Corresponding_Body (Decl));
689 Expand_Cleanup_Actions (Decl);
692 Elmt := Next_Elmt (Elmt);
696 --------------------------
697 -- Has_Initialized_Type --
698 --------------------------
700 function Has_Initialized_Type (E : Entity_Id) return Boolean is
701 E_Body : constant Node_Id := Get_Subprogram_Body (E);
705 if No (E_Body) then -- imported subprogram
709 Decl := First (Declarations (E_Body));
711 while Present (Decl) loop
713 if Nkind (Decl) = N_Full_Type_Declaration
714 and then Present (Init_Proc (Defining_Identifier (Decl)))
724 end Has_Initialized_Type;
730 procedure Initialize is
732 Analyzing_Inlined_Bodies := False;
733 Pending_Descriptor.Init;
734 Pending_Instantiations.Init;
739 for J in Hash_Headers'Range loop
740 Hash_Headers (J) := No_Subp;
744 ------------------------
745 -- Instantiate_Bodies --
746 ------------------------
748 -- Generic bodies contain all the non-local references, so an
749 -- instantiation does not need any more context than Standard
750 -- itself, even if the instantiation appears in an inner scope.
751 -- Generic associations have verified that the contract model is
752 -- satisfied, so that any error that may occur in the analysis of
753 -- the body is an internal error.
755 procedure Instantiate_Bodies is
757 Info : Pending_Body_Info;
760 if Errors_Detected = 0 then
762 Expander_Active := (Operating_Mode = Opt.Generate_Code);
763 New_Scope (Standard_Standard);
764 To_Clean := New_Elmt_List;
766 if Is_Generic_Unit (Cunit_Entity (Main_Unit)) then
770 -- A body instantiation may generate additional instantiations, so
771 -- the following loop must scan to the end of a possibly expanding
772 -- set (that's why we can't simply use a FOR loop here).
776 while J <= Pending_Instantiations.Last
777 and then Errors_Detected = 0
780 Info := Pending_Instantiations.Table (J);
782 -- If the instantiation node is absent, it has been removed
783 -- as part of unreachable code.
785 if No (Info.Inst_Node) then
788 elsif Nkind (Info. Act_Decl) = N_Package_Declaration then
789 Instantiate_Package_Body (Info);
790 Add_Scope_To_Clean (Defining_Entity (Info.Act_Decl));
793 Instantiate_Subprogram_Body (Info);
799 -- Reset the table of instantiations. Additional instantiations
800 -- may be added through inlining, when additional bodies are
803 Pending_Instantiations.Init;
805 -- We can now complete the cleanup actions of scopes that contain
806 -- pending instantiations (skipped for generic units, since we
807 -- never need any cleanups in generic units).
808 -- pending instantiations.
811 and then not Is_Generic_Unit (Main_Unit_Entity)
815 -- Also generate subprogram descriptors that were delayed
817 for J in Pending_Descriptor.First .. Pending_Descriptor.Last loop
819 Ent : constant Entity_Id := Pending_Descriptor.Table (J);
822 if Is_Subprogram (Ent) then
823 Generate_Subprogram_Descriptor_For_Subprogram
824 (Get_Subprogram_Body (Ent), Ent);
826 elsif Ekind (Ent) = E_Package then
827 Generate_Subprogram_Descriptor_For_Package
828 (Parent (Declaration_Node (Ent)), Ent);
830 elsif Ekind (Ent) = E_Package_Body then
831 Generate_Subprogram_Descriptor_For_Package
832 (Declaration_Node (Ent), Ent);
837 elsif Is_Generic_Unit (Cunit_Entity (Main_Unit)) then
843 end Instantiate_Bodies;
849 function Is_Nested (E : Entity_Id) return Boolean is
850 Scop : Entity_Id := Scope (E);
853 while Scop /= Standard_Standard loop
854 if Ekind (Scop) in Subprogram_Kind then
857 elsif Ekind (Scop) = E_Task_Type
858 or else Ekind (Scop) = E_Entry
859 or else Ekind (Scop) = E_Entry_Family then
863 Scop := Scope (Scop);
875 Pending_Instantiations.Locked := True;
876 Inlined_Bodies.Locked := True;
877 Successors.Locked := True;
878 Inlined.Locked := True;
879 Pending_Instantiations.Release;
880 Inlined_Bodies.Release;
885 --------------------------
886 -- Remove_Dead_Instance --
887 --------------------------
889 procedure Remove_Dead_Instance (N : Node_Id) is
895 while J <= Pending_Instantiations.Last loop
897 if Pending_Instantiations.Table (J).Inst_Node = N then
898 Pending_Instantiations.Table (J).Inst_Node := Empty;
904 end Remove_Dead_Instance;
906 ------------------------
907 -- Scope_In_Main_Unit --
908 ------------------------
910 function Scope_In_Main_Unit (Scop : Entity_Id) return Boolean is
912 S : Entity_Id := Scop;
913 Ent : Entity_Id := Cunit_Entity (Main_Unit);
916 -- The scope may be within the main unit, or it may be an ancestor
917 -- of the main unit, if the main unit is a child unit. In both cases
918 -- it makes no sense to process the body before the main unit. In
919 -- the second case, this may lead to circularities if a parent body
920 -- depends on a child spec, and we are analyzing the child.
922 while Scope (S) /= Standard_Standard
923 and then not Is_Child_Unit (S)
931 and then Nkind (Comp) /= N_Compilation_Unit
933 Comp := Parent (Comp);
936 if Is_Child_Unit (Ent) then
939 and then Is_Child_Unit (Ent)
941 if Scope (Ent) = S then
950 Comp = Cunit (Main_Unit)
951 or else Comp = Library_Unit (Cunit (Main_Unit));
952 end Scope_In_Main_Unit;