[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:
parent
812f574fda
commit
46ff89f320
|
@ -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>
|
2009-04-08 Tristan Gingold <gingold@adacore.com>
|
||||||
|
|
||||||
* sem_prag.adb: Restrict pragma Thread_Local_Storage to library level
|
* sem_prag.adb: Restrict pragma Thread_Local_Storage to library level
|
||||||
|
|
|
@ -269,8 +269,10 @@ package Errout is
|
||||||
|
|
||||||
-- Normally warning messages issued in other than the main unit are
|
-- Normally warning messages issued in other than the main unit are
|
||||||
-- suppressed. If the message ends with !! then this suppression is
|
-- suppressed. If the message ends with !! then this suppression is
|
||||||
-- avoided. This is currently only used by the Compile_Time_Warning
|
-- avoided. This is currently used by the Compile_Time_Warning pragma
|
||||||
-- pragma to ensure the message for a with'ed unit is output.
|
-- 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)
|
-- Insertion character ? (Question: warning message)
|
||||||
-- The character ? appearing anywhere in a message makes the message
|
-- The character ? appearing anywhere in a message makes the message
|
||||||
|
|
|
@ -2154,7 +2154,7 @@ package body Exp_Ch4 is
|
||||||
-- for all computed bounds (which may be out of range of Istyp in the
|
-- for all computed bounds (which may be out of range of Istyp in the
|
||||||
-- case of null ranges).
|
-- case of null ranges).
|
||||||
|
|
||||||
Intyp : Entity_Id;
|
Artyp : Entity_Id;
|
||||||
-- This is the type we use to do arithmetic to compute the bounds and
|
-- 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
|
-- 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.
|
-- 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
|
-- 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
|
-- operand whose length is not known at compile time. Entries in this
|
||||||
-- array are set only if the corresponding entry in Is_Fixed_Length
|
-- 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;
|
Aggr_Length : array (0 .. N) of Node_Id;
|
||||||
-- The J'th entry in an expression node that represents the total length
|
-- 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
|
-- 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
|
-- 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
|
-- 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;
|
Low_Bound : Node_Id;
|
||||||
-- A tree node representing the low bound of the result (of type Ityp).
|
-- 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 : Node_Id;
|
||||||
-- Result of the concatenation (of type Ityp)
|
-- 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
|
-- 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.
|
-- types, the Pos of the value is returned.
|
||||||
|
|
||||||
function To_Ityp (X : Node_Id) return Node_Id;
|
function To_Ityp (X : Node_Id) return Node_Id;
|
||||||
-- The inverse function (uses Val in the case of enumeration types)
|
-- 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
|
begin
|
||||||
if Ityp = Base_Type (Intyp) then
|
if Ityp = Base_Type (Artyp) then
|
||||||
return X;
|
return X;
|
||||||
|
|
||||||
elsif Is_Enumeration_Type (Ityp) then
|
elsif Is_Enumeration_Type (Ityp) then
|
||||||
|
@ -2255,9 +2255,9 @@ package body Exp_Ch4 is
|
||||||
Expressions => New_List (X));
|
Expressions => New_List (X));
|
||||||
|
|
||||||
else
|
else
|
||||||
return Convert_To (Intyp, X);
|
return Convert_To (Artyp, X);
|
||||||
end if;
|
end if;
|
||||||
end To_Intyp;
|
end To_Artyp;
|
||||||
|
|
||||||
-------------
|
-------------
|
||||||
-- To_Ityp --
|
-- To_Ityp --
|
||||||
|
@ -2287,15 +2287,13 @@ package body Exp_Ch4 is
|
||||||
-- we analyzed and resolved the expression.
|
-- we analyzed and resolved the expression.
|
||||||
|
|
||||||
Set_Parent (X, Cnode);
|
Set_Parent (X, Cnode);
|
||||||
Analyze_And_Resolve (X);
|
Analyze_And_Resolve (X, Artyp);
|
||||||
|
|
||||||
if Compile_Time_Compare
|
if Compile_Time_Compare
|
||||||
(X, Type_High_Bound (Istyp),
|
(X, Type_High_Bound (Istyp), Assume_Valid => False) = GT
|
||||||
Assume_Valid => False) = GT
|
|
||||||
or else
|
or else
|
||||||
Compile_Time_Compare
|
Compile_Time_Compare
|
||||||
(X, Type_High_Bound (Ityp),
|
(X, Type_High_Bound (Ityp), Assume_Valid => False) = GT
|
||||||
Assume_Valid => False) = GT
|
|
||||||
then
|
then
|
||||||
Apply_Compile_Time_Constraint_Error
|
Apply_Compile_Time_Constraint_Error
|
||||||
(N => Cnode,
|
(N => Cnode,
|
||||||
|
@ -2304,7 +2302,7 @@ package body Exp_Ch4 is
|
||||||
raise Concatenation_Error;
|
raise Concatenation_Error;
|
||||||
|
|
||||||
else
|
else
|
||||||
if Ityp = Base_Type (Intyp) then
|
if Ityp = Base_Type (Artyp) then
|
||||||
return X;
|
return X;
|
||||||
else
|
else
|
||||||
return Convert_To (Ityp, X);
|
return Convert_To (Ityp, X);
|
||||||
|
@ -2343,7 +2341,7 @@ package body Exp_Ch4 is
|
||||||
-- arithmetic with POS values, not representation values).
|
-- arithmetic with POS values, not representation values).
|
||||||
|
|
||||||
if Is_Enumeration_Type (Ityp) then
|
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
|
-- 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
|
-- 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
|
elsif Is_Modular_Integer_Type (Ityp) then
|
||||||
if RM_Size (Ityp) < RM_Size (Standard_Unsigned) 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
|
elsif RM_Size (Ityp) = RM_Size (Standard_Unsigned) then
|
||||||
Intyp := Ityp;
|
Artyp := Ityp;
|
||||||
else
|
else
|
||||||
Intyp := RTE (RE_Long_Long_Unsigned);
|
Artyp := RTE (RE_Long_Long_Unsigned);
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
-- Similar treatment for signed types
|
-- Similar treatment for signed types
|
||||||
|
|
||||||
else
|
else
|
||||||
if RM_Size (Ityp) < RM_Size (Standard_Integer) then
|
if RM_Size (Ityp) < RM_Size (Standard_Integer) then
|
||||||
Intyp := Standard_Integer;
|
Artyp := Standard_Integer;
|
||||||
elsif RM_Size (Ityp) = RM_Size (Standard_Integer) then
|
elsif RM_Size (Ityp) = RM_Size (Standard_Integer) then
|
||||||
Intyp := Ityp;
|
Artyp := Ityp;
|
||||||
else
|
else
|
||||||
Intyp := Standard_Long_Long_Integer;
|
Artyp := Standard_Long_Long_Integer;
|
||||||
end if;
|
end if;
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
|
@ -2543,7 +2541,7 @@ package body Exp_Ch4 is
|
||||||
Constant_Present => True,
|
Constant_Present => True,
|
||||||
|
|
||||||
Object_Definition =>
|
Object_Definition =>
|
||||||
New_Occurrence_Of (Intyp, Loc),
|
New_Occurrence_Of (Artyp, Loc),
|
||||||
|
|
||||||
Expression =>
|
Expression =>
|
||||||
Make_Attribute_Reference (Loc,
|
Make_Attribute_Reference (Loc,
|
||||||
|
@ -2600,7 +2598,7 @@ package body Exp_Ch4 is
|
||||||
Constant_Present => True,
|
Constant_Present => True,
|
||||||
|
|
||||||
Object_Definition =>
|
Object_Definition =>
|
||||||
New_Occurrence_Of (Intyp, Loc),
|
New_Occurrence_Of (Artyp, Loc),
|
||||||
|
|
||||||
Expression =>
|
Expression =>
|
||||||
Make_Op_Add (Loc,
|
Make_Op_Add (Loc,
|
||||||
|
@ -2729,7 +2727,7 @@ package body Exp_Ch4 is
|
||||||
High_Bound :=
|
High_Bound :=
|
||||||
To_Ityp (
|
To_Ityp (
|
||||||
Make_Op_Add (Loc,
|
Make_Op_Add (Loc,
|
||||||
Left_Opnd => To_Intyp (New_Copy (Low_Bound)),
|
Left_Opnd => To_Artyp (New_Copy (Low_Bound)),
|
||||||
Right_Opnd =>
|
Right_Opnd =>
|
||||||
Make_Op_Subtract (Loc,
|
Make_Op_Subtract (Loc,
|
||||||
Left_Opnd => New_Copy (Aggr_Length (NN)),
|
Left_Opnd => New_Copy (Aggr_Length (NN)),
|
||||||
|
@ -2777,12 +2775,12 @@ package body Exp_Ch4 is
|
||||||
declare
|
declare
|
||||||
Lo : constant Node_Id :=
|
Lo : constant Node_Id :=
|
||||||
Make_Op_Add (Loc,
|
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));
|
Right_Opnd => Aggr_Length (J - 1));
|
||||||
|
|
||||||
Hi : constant Node_Id :=
|
Hi : constant Node_Id :=
|
||||||
Make_Op_Add (Loc,
|
Make_Op_Add (Loc,
|
||||||
Left_Opnd => To_Intyp (New_Copy (Low_Bound)),
|
Left_Opnd => To_Artyp (New_Copy (Low_Bound)),
|
||||||
Right_Opnd =>
|
Right_Opnd =>
|
||||||
Make_Op_Subtract (Loc,
|
Make_Op_Subtract (Loc,
|
||||||
Left_Opnd => Aggr_Length (J),
|
Left_Opnd => Aggr_Length (J),
|
||||||
|
|
|
@ -371,7 +371,13 @@ package body Inline is
|
||||||
-- inlined under ZCX because the numeric suffix generated by gigi
|
-- inlined under ZCX because the numeric suffix generated by gigi
|
||||||
-- will be different in the body and the place of the inlined call.
|
-- 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 --
|
-- Back_End_Cannot_Inline --
|
||||||
|
@ -381,6 +387,40 @@ package body Inline is
|
||||||
Decl : constant Node_Id := Unit_Declaration_Node (Subp);
|
Decl : constant Node_Id := Unit_Declaration_Node (Subp);
|
||||||
Body_Ent : Entity_Id;
|
Body_Ent : Entity_Id;
|
||||||
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
|
begin
|
||||||
if Nkind (Decl) = N_Subprogram_Declaration
|
if Nkind (Decl) = N_Subprogram_Declaration
|
||||||
|
@ -400,13 +440,12 @@ package body Inline is
|
||||||
if Present
|
if Present
|
||||||
(Exception_Handlers
|
(Exception_Handlers
|
||||||
(Handled_Statement_Sequence
|
(Handled_Statement_Sequence
|
||||||
(Unit_Declaration_Node (Corresponding_Body (Decl)))))
|
(Unit_Declaration_Node (Corresponding_Body (Decl)))))
|
||||||
then
|
then
|
||||||
return True;
|
return True;
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
Ent := First_Entity (Body_Ent);
|
Ent := First_Entity (Body_Ent);
|
||||||
|
|
||||||
while Present (Ent) loop
|
while Present (Ent) loop
|
||||||
if Is_Subprogram (Ent)
|
if Is_Subprogram (Ent)
|
||||||
and then Is_Generic_Instance (Ent)
|
and then Is_Generic_Instance (Ent)
|
||||||
|
@ -416,7 +455,20 @@ package body Inline is
|
||||||
|
|
||||||
Next_Entity (Ent);
|
Next_Entity (Ent);
|
||||||
end loop;
|
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;
|
end Back_End_Cannot_Inline;
|
||||||
|
|
||||||
-- Start of processing for Add_Inlined_Subprogram
|
-- Start of processing for Add_Inlined_Subprogram
|
||||||
|
@ -445,8 +497,8 @@ package body Inline is
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
Inlined.Table (Index).Listed := True;
|
Inlined.Table (Index).Listed := True;
|
||||||
Succ := Inlined.Table (Index).First_Succ;
|
|
||||||
|
|
||||||
|
Succ := Inlined.Table (Index).First_Succ;
|
||||||
while Succ /= No_Succ loop
|
while Succ /= No_Succ loop
|
||||||
Subp := Successors.Table (Succ).Subp;
|
Subp := Successors.Table (Succ).Subp;
|
||||||
Inlined.Table (Subp).Count := Inlined.Table (Subp).Count - 1;
|
Inlined.Table (Subp).Count := Inlined.Table (Subp).Count - 1;
|
||||||
|
@ -614,14 +666,17 @@ package body Inline is
|
||||||
Load_Needed_Body (Comp_Unit, OK);
|
Load_Needed_Body (Comp_Unit, OK);
|
||||||
|
|
||||||
if not OK then
|
if not OK then
|
||||||
|
|
||||||
|
-- Warn that a body was not available for inlining
|
||||||
|
-- by the back-end.
|
||||||
|
|
||||||
Error_Msg_Unit_1 := Bname;
|
Error_Msg_Unit_1 := Bname;
|
||||||
Error_Msg_N
|
Error_Msg_N
|
||||||
("one or more inlined subprograms accessed in $!",
|
("one or more inlined subprograms accessed in $!?",
|
||||||
Comp_Unit);
|
Comp_Unit);
|
||||||
Error_Msg_File_1 :=
|
Error_Msg_File_1 :=
|
||||||
Get_File_Name (Bname, Subunit => False);
|
Get_File_Name (Bname, Subunit => False);
|
||||||
Error_Msg_N ("\but file{ was not found!", Comp_Unit);
|
Error_Msg_N ("\but file{ was not found!?", Comp_Unit);
|
||||||
raise Unrecoverable_Error;
|
|
||||||
end if;
|
end if;
|
||||||
end if;
|
end if;
|
||||||
end;
|
end;
|
||||||
|
|
Loading…
Reference in New Issue