From 46ff89f320ff47227c77ce8cc749280a862f114c Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Wed, 8 Apr 2009 15:44:17 +0200 Subject: [PATCH] [multiple changes] 2009-04-08 Ed Schonberg * 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. * errout.ads: Update comments on uses of dirs 2009-04-08 Robert Dewar * exp_ch4.adb (Expand_Concatenate): Make sure nodes are properly typed From-SVN: r145729 --- gcc/ada/ChangeLog | 12 ++++++++ gcc/ada/errout.ads | 6 ++-- gcc/ada/exp_ch4.adb | 54 +++++++++++++++++----------------- gcc/ada/inline.adb | 71 ++++++++++++++++++++++++++++++++++++++++----- 4 files changed, 105 insertions(+), 38 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 940337e2e5e..0231903067f 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,15 @@ +2009-04-08 Ed Schonberg + + * 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. + + * errout.ads: Update comments on uses of dirs + +2009-04-08 Robert Dewar + + * exp_ch4.adb (Expand_Concatenate): Make sure nodes are properly typed + 2009-04-08 Tristan Gingold * sem_prag.adb: Restrict pragma Thread_Local_Storage to library level diff --git a/gcc/ada/errout.ads b/gcc/ada/errout.ads index 83b50953010..0d934633513 100644 --- a/gcc/ada/errout.ads +++ b/gcc/ada/errout.ads @@ -269,8 +269,10 @@ package Errout is -- Normally warning messages issued in other than the main unit are -- suppressed. If the message ends with !! then this suppression is - -- avoided. This is currently only used by the Compile_Time_Warning - -- pragma to ensure the message for a with'ed unit is output. + -- avoided. This is currently used by the Compile_Time_Warning pragma + -- to ensure the message for a with'ed unit is output, and for warnings + -- on ineffective back-end inlining, which is detected in units that + -- contain subprograms to be inlined in the main program. -- Insertion character ? (Question: warning message) -- The character ? appearing anywhere in a message makes the message diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index b01203d1366..190baa62373 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -2154,7 +2154,7 @@ package body Exp_Ch4 is -- for all computed bounds (which may be out of range of Istyp in the -- case of null ranges). - Intyp : Entity_Id; + Artyp : Entity_Id; -- This is the type we use to do arithmetic to compute the bounds and -- lengths of operands. The choice of this type is a little subtle and -- is discussed in a separate section at the start of the body code. @@ -2204,14 +2204,14 @@ package body Exp_Ch4 is -- Set to an entity of type Natural that contains the length of an -- operand whose length is not known at compile time. Entries in this -- array are set only if the corresponding entry in Is_Fixed_Length - -- is False. The entity is of type Intyp. + -- is False. The entity is of type Artyp. Aggr_Length : array (0 .. N) of Node_Id; -- The J'th entry in an expression node that represents the total length -- of operands 1 through J. It is either an integer literal node, or a -- reference to a constant entity with the right value, so it is fine -- to just do a Copy_Node to get an appropriate copy. The extra zero'th - -- entry always is set to zero. The length is of type Intyp. + -- entry always is set to zero. The length is of type Artyp. Low_Bound : Node_Id; -- A tree node representing the low bound of the result (of type Ityp). @@ -2230,21 +2230,21 @@ package body Exp_Ch4 is Result : Node_Id; -- Result of the concatenation (of type Ityp) - function To_Intyp (X : Node_Id) return Node_Id; + function To_Artyp (X : Node_Id) return Node_Id; -- Given a node of type Ityp, returns the corresponding value of type - -- Intyp. For non-enumeration types, this is the identity. For enum + -- Artyp. For non-enumeration types, this is the identity. For enum -- types, the Pos of the value is returned. function To_Ityp (X : Node_Id) return Node_Id; -- The inverse function (uses Val in the case of enumeration types) -------------- - -- To_Intyp -- + -- To_Artyp -- -------------- - function To_Intyp (X : Node_Id) return Node_Id is + function To_Artyp (X : Node_Id) return Node_Id is begin - if Ityp = Base_Type (Intyp) then + if Ityp = Base_Type (Artyp) then return X; elsif Is_Enumeration_Type (Ityp) then @@ -2255,9 +2255,9 @@ package body Exp_Ch4 is Expressions => New_List (X)); else - return Convert_To (Intyp, X); + return Convert_To (Artyp, X); end if; - end To_Intyp; + end To_Artyp; ------------- -- To_Ityp -- @@ -2287,15 +2287,13 @@ package body Exp_Ch4 is -- we analyzed and resolved the expression. Set_Parent (X, Cnode); - Analyze_And_Resolve (X); + Analyze_And_Resolve (X, Artyp); if Compile_Time_Compare - (X, Type_High_Bound (Istyp), - Assume_Valid => False) = GT + (X, Type_High_Bound (Istyp), Assume_Valid => False) = GT or else Compile_Time_Compare - (X, Type_High_Bound (Ityp), - Assume_Valid => False) = GT + (X, Type_High_Bound (Ityp), Assume_Valid => False) = GT then Apply_Compile_Time_Constraint_Error (N => Cnode, @@ -2304,7 +2302,7 @@ package body Exp_Ch4 is raise Concatenation_Error; else - if Ityp = Base_Type (Intyp) then + if Ityp = Base_Type (Artyp) then return X; else return Convert_To (Ityp, X); @@ -2343,7 +2341,7 @@ package body Exp_Ch4 is -- arithmetic with POS values, not representation values). if Is_Enumeration_Type (Ityp) then - Intyp := Standard_Integer; + Artyp := Standard_Integer; -- For modular types, we use a 32-bit modular type for types whose size -- is in the range 1-31 bits. For 32-bit unsigned types, we use the @@ -2351,22 +2349,22 @@ package body Exp_Ch4 is elsif Is_Modular_Integer_Type (Ityp) then if RM_Size (Ityp) < RM_Size (Standard_Unsigned) then - Intyp := Standard_Unsigned; + Artyp := Standard_Unsigned; elsif RM_Size (Ityp) = RM_Size (Standard_Unsigned) then - Intyp := Ityp; + Artyp := Ityp; else - Intyp := RTE (RE_Long_Long_Unsigned); + Artyp := RTE (RE_Long_Long_Unsigned); end if; -- Similar treatment for signed types else if RM_Size (Ityp) < RM_Size (Standard_Integer) then - Intyp := Standard_Integer; + Artyp := Standard_Integer; elsif RM_Size (Ityp) = RM_Size (Standard_Integer) then - Intyp := Ityp; + Artyp := Ityp; else - Intyp := Standard_Long_Long_Integer; + Artyp := Standard_Long_Long_Integer; end if; end if; @@ -2543,7 +2541,7 @@ package body Exp_Ch4 is Constant_Present => True, Object_Definition => - New_Occurrence_Of (Intyp, Loc), + New_Occurrence_Of (Artyp, Loc), Expression => Make_Attribute_Reference (Loc, @@ -2600,7 +2598,7 @@ package body Exp_Ch4 is Constant_Present => True, Object_Definition => - New_Occurrence_Of (Intyp, Loc), + New_Occurrence_Of (Artyp, Loc), Expression => Make_Op_Add (Loc, @@ -2729,7 +2727,7 @@ package body Exp_Ch4 is High_Bound := To_Ityp ( Make_Op_Add (Loc, - Left_Opnd => To_Intyp (New_Copy (Low_Bound)), + Left_Opnd => To_Artyp (New_Copy (Low_Bound)), Right_Opnd => Make_Op_Subtract (Loc, Left_Opnd => New_Copy (Aggr_Length (NN)), @@ -2777,12 +2775,12 @@ package body Exp_Ch4 is declare Lo : constant Node_Id := Make_Op_Add (Loc, - Left_Opnd => To_Intyp (New_Copy (Low_Bound)), + Left_Opnd => To_Artyp (New_Copy (Low_Bound)), Right_Opnd => Aggr_Length (J - 1)); Hi : constant Node_Id := Make_Op_Add (Loc, - Left_Opnd => To_Intyp (New_Copy (Low_Bound)), + Left_Opnd => To_Artyp (New_Copy (Low_Bound)), Right_Opnd => Make_Op_Subtract (Loc, Left_Opnd => Aggr_Length (J), diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb index 296ff6b1df5..7cda5d5a153 100644 --- a/gcc/ada/inline.adb +++ b/gcc/ada/inline.adb @@ -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; -- 2.30.2