OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes] 

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.

	* errout.ads: Update comments on uses of dirs

2009-04-08  Robert Dewar  <dewar@adacore.com>

	* exp_ch4.adb (Expand_Concatenate): Make sure nodes are properly typed

From-SVN: r145729
This commit is contained in:
Arnaud Charlet 2009-04-08 15:44:17 +02:00
parent 812f574fda
commit 46ff89f320
4 changed files with 105 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
gcc/ada/ChangeLog
View File

@ -1,3 +1,15 @@
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.
* errout.ads: Update comments on uses of dirs
2009-04-08 Robert Dewar <dewar@adacore.com>
* exp_ch4.adb (Expand_Concatenate): Make sure nodes are properly typed
2009-04-08 Tristan Gingold <gingold@adacore.com>
* sem_prag.adb: Restrict pragma Thread_Local_Storage to library level

6
gcc/ada/errout.ads
View File

@ -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

54
gcc/ada/exp_ch4.adb
View File

@ -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),

71
gcc/ada/inline.adb
View File

@ -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;