[Ada] Backend inlining related fix
Arnaud Charlet
charlet@adacore.com
Wed Apr 8 13:48:00 GMT 2009
If subprograms are marked for inlining by the back-end, gigi creates the trees
for these subprograms before completing the elaboration of the body in which
they appear. As a result, the bodies to be inlined cannot contain calls to
subprograms that have no previous spec (and are declared in the same unit)
because the definining entities will not have been elaborated yet. This patch
detectes such calls, and removes the enclosing body from the list of inlining
candidates.
The following must compile quietly:
gcc -c -O2 -gnatn p.ads
---
with Number_Sets; use Number_Sets;
with Hash_Mappings;
package P is
package Int_Mappings is new Hash_Mappings (Number_Set);
end P;
--
generic
type Arg1_Type is private;
with function Hash(Arg: Arg1_Type) return Integer is <>;
Sample_Arg1: Arg1_Type;
type Arg2_Type is private;
with function Hash(Arg: Arg2_Type) return Integer is <>;
Sample_Arg2: Arg2_Type;
type Result_Type is private;
with function Restricted_Op
(Arg1: Arg1_Type; Arg2: Arg2_Type) return Result_Type;
Num_Cache_Entries: Integer;
package Binary_Op_Cache is
function Cached_Restricted_Op
(Arg1: Arg1_Type; Arg2: Arg2_Type) return Result_Type;
pragma Inline(Cached_Restricted_Op);
end Binary_Op_Cache;
--
package body Binary_Op_Cache is
function Cached_Restricted_Op
(Arg1: Arg1_Type; Arg2: Arg2_Type) return Result_Type is
Hash_Val: constant Integer := Hash(Arg1) + Hash(Arg2);
begin
return Restricted_Op(Arg1, Arg2);
end Cached_Restricted_Op;
end Binary_Op_Cache;
--
generic
type Key_Type is private;
with function "="(Key1, Key2: Key_Type) return Boolean is <>;
with function Hash(Key: Key_Type) return Integer is <>;
package Hash_Mappings is
function Get_Hash(Key: Key_Type) return Integer;
end Hash_Mappings;
--
package body Hash_Mappings is
function Get_Hash(Key: Key_Type) return Integer is
begin
return Hash(Key);
end Get_Hash;
end Hash_Mappings;
--
package Number_Sets is
type Number_Set is new Integer;
Empty_Set: constant Number_Set := -1;
function Intersect(Set1, Set2: Number_Set) return Number_Set;
function Hash(Set: Number_Set) return Integer;
pragma Inline(Hash);
end Number_Sets;
--
with Unchecked_Conversion;
with Binary_Op_Cache;
package body Number_Sets is
function To_Hash_Value is
new Unchecked_Conversion (Number_Set'Base, Integer);
function Hash(Set: Number_Set) return Integer is
begin
return To_Hash_Value(Set);
end Hash;
function Uncached_Intersect (Set1, Set2: Number_Set) return Number_Set is
begin
return Empty_Set;
end Uncached_Intersect;
package Memoizing_Intersect is new Binary_Op_Cache
(Arg1_Type => Number_Set,
Sample_Arg1 => Empty_Set,
Arg2_Type => Number_Set,
Sample_Arg2 => Empty_Set,
Result_Type => Number_Set,
Restricted_Op => Uncached_Intersect,
Num_Cache_Entries => 997);
function Intersect(Set1, Set2: Number_Set) return Number_Set
renames Memoizing_Intersect.Cached_Restricted_Op;
end Number_Sets;
Tested on x86_64-pc-linux-gnu, committed on trunk
2009-04-08 Ed Schonberg <schonberg@adacore.com>
* inline.adb (Back_End_Cannot_Inline): Do not mark a body as inlineable
by the back-end if it contains a call to a subprogram without a
previous spec that is declared in the same unit.
-------------- next part --------------
Index: inline.adb
===================================================================
--- inline.adb (revision 145676)
+++ inline.adb (working copy)
@@ -371,7 +371,13 @@ package body Inline is
-- inlined under ZCX because the numeric suffix generated by gigi
-- will be different in the body and the place of the inlined call.
--
- -- This procedure must be carefully coordinated with the back end
+ -- If the body to be inlined contains calls to subprograms declared
+ -- in the same body that have no previous spec, the back-end cannot
+ -- inline either because the bodies to be inlined are processed before
+ -- the rest of the enclosing package body, and gigi will then find
+ -- references to entities that have not been elaborated yet.
+ --
+ -- This procedure must be carefully coordinated with the back end.
----------------------------
-- Back_End_Cannot_Inline --
@@ -381,6 +387,40 @@ package body Inline is
Decl : constant Node_Id := Unit_Declaration_Node (Subp);
Body_Ent : Entity_Id;
Ent : Entity_Id;
+ Bad_Call : Node_Id;
+
+ function Process (N : Node_Id) return Traverse_Result;
+ -- Look for calls to subprograms with no previous spec, declared
+ -- in the same enclosiong package body.
+
+ -------------
+ -- Process --
+ -------------
+
+ function Process (N : Node_Id) return Traverse_Result is
+ begin
+ if Nkind (N) = N_Procedure_Call_Statement
+ or else Nkind (N) = N_Function_Call
+ then
+ if Is_Entity_Name (Name (N))
+ and then
+ Nkind (Unit_Declaration_Node (Entity (Name (N))))
+ = N_Subprogram_Body
+ and then In_Same_Extended_Unit (Subp, Entity (Name (N)))
+ then
+ Bad_Call := N;
+ return Abandon;
+ else
+ return OK;
+ end if;
+ else
+ return OK;
+ end if;
+ end Process;
+
+ function Has_Exposed_Call is new Traverse_Func (Process);
+
+ -- Start of processing for Back_End_Cannot_Inline
begin
if Nkind (Decl) = N_Subprogram_Declaration
@@ -400,13 +440,12 @@ package body Inline is
if Present
(Exception_Handlers
(Handled_Statement_Sequence
- (Unit_Declaration_Node (Corresponding_Body (Decl)))))
+ (Unit_Declaration_Node (Corresponding_Body (Decl)))))
then
return True;
end if;
Ent := First_Entity (Body_Ent);
-
while Present (Ent) loop
if Is_Subprogram (Ent)
and then Is_Generic_Instance (Ent)
@@ -416,7 +455,20 @@ package body Inline is
Next_Entity (Ent);
end loop;
- return False;
+
+ if Has_Exposed_Call
+ (Unit_Declaration_Node (Corresponding_Body (Decl))) = Abandon
+ then
+ if Ineffective_Inline_Warnings then
+ Error_Msg_N
+ ("?call to subprogram with no separate spec"
+ & " prevents inlining!!", Bad_Call);
+ end if;
+
+ return True;
+ else
+ return False;
+ end if;
end Back_End_Cannot_Inline;
-- Start of processing for Add_Inlined_Subprogram
@@ -445,8 +497,8 @@ package body Inline is
end if;
Inlined.Table (Index).Listed := True;
- Succ := Inlined.Table (Index).First_Succ;
+ Succ := Inlined.Table (Index).First_Succ;
while Succ /= No_Succ loop
Subp := Successors.Table (Succ).Subp;
Inlined.Table (Subp).Count := Inlined.Table (Subp).Count - 1;
@@ -614,14 +666,17 @@ package body Inline is
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 $!",
+ ("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);
- raise Unrecoverable_Error;
+ Error_Msg_N ("\but file{ was not found!?", Comp_Unit);
end if;
end if;
end;
More information about the Gcc-patches
mailing list