Skip to content

R
riscv-gcc-1
Commit 6fd52b78 by Arnaud Charlet
Options

[multiple changes] 

2014-10-31  Eric Botcazou  <ebotcazou@adacore.com>

	* inline.adb (Has_Excluded_Declaration): With back-end inlining,
	only return true for nested packages.
	(Cannot_Inline): Issue errors/warnings whatever the optimization level
	for back-end inlining and remove assertion.

2014-10-31  Sergey Rybin  <rybin@adacore.com frybin>

	* table.adb (Tree_Read, Tree_Write): Use parentheses to specify
	the desired order of '*' and '/' operations to avoid overflow.

2014-10-31  Eric Botcazou  <ebotcazou@adacore.com>

	* exp_ch6.adb (Do_Inline): Remove unreachable code.
	(Do_Inline_Always): Likewise.

2014-10-31  Vincent Celier  <celier@adacore.com>

	* prj-nmsc.adb (Check_Stand_Alone_Library): Change error message
	when library has no Ada interfaces and Library_Standalone is
	declared.

From-SVN: r216961
parent d99565f8
Showing with 52 additions and 281 deletions
gcc/ada/ChangeLog
2014-10-31 Eric Botcazou <ebotcazou@adacore.com>
* inline.adb (Has_Excluded_Declaration): With back-end inlining,
only return true for nested packages.
(Cannot_Inline): Issue errors/warnings whatever the optimization level
for back-end inlining and remove assertion.
2014-10-31 Sergey Rybin <rybin@adacore.com frybin>
* table.adb (Tree_Read, Tree_Write): Use parentheses to specify
the desired order of '*' and '/' operations to avoid overflow.
2014-10-31 Eric Botcazou <ebotcazou@adacore.com>
* exp_ch6.adb (Do_Inline): Remove unreachable code.
(Do_Inline_Always): Likewise.
2014-10-31 Vincent Celier <celier@adacore.com>
* prj-nmsc.adb (Check_Stand_Alone_Library): Change error message
when library has no Ada interfaces and Library_Standalone is
declared.
2014-10-31 Arnaud Charlet <charlet@adacore.com> 2014-10-31 Arnaud Charlet <charlet@adacore.com>
* sem_ch13.adb (Check_Constant_Address_Clause): Disable checks * sem_ch13.adb (Check_Constant_Address_Clause): Disable checks
......
gcc/ada/exp_ch6.adb
...@@ -1998,19 +1998,6 @@ package body Exp_Ch6 is ...@@ -1998,19 +1998,6 @@ package body Exp_Ch6 is
-- expression for the value of the actual, EF is the entity for the -- expression for the value of the actual, EF is the entity for the
-- extra formal. -- extra formal.
procedure Do_Inline (Subp : Entity_Id; Orig_Subp : Entity_Id);
-- Check and inline the body of Subp. Invoked when compiling with
-- optimizations enabled and Subp has pragma inline or inline always.
-- If the subprogram is a renaming, or if it is inherited, then Subp
-- references the renamed entity and Orig_Subp is the entity of the
-- call node N.
procedure Do_Inline_Always (Subp : Entity_Id; Orig_Subp : Entity_Id);
-- Check and inline the body of Subp. Invoked when compiling without
-- optimizations and Subp has pragma inline always. If the subprogram is
-- a renaming, or if it is inherited, then Subp references the renamed
-- entity and Orig_Subp is the entity of the call node N.
function Inherited_From_Formal (S : Entity_Id) return Entity_Id; function Inherited_From_Formal (S : Entity_Id) return Entity_Id;
-- Within an instance, a type derived from an untagged formal derived -- Within an instance, a type derived from an untagged formal derived
-- type inherits from the original parent, not from the actual. The -- type inherits from the original parent, not from the actual. The
...@@ -2097,211 +2084,6 @@ package body Exp_Ch6 is ...@@ -2097,211 +2084,6 @@ package body Exp_Ch6 is
end if; end if;
end Add_Extra_Actual; end Add_Extra_Actual;
----------------
-- Do_Inline --
----------------
procedure Do_Inline (Subp : Entity_Id; Orig_Subp : Entity_Id) is
Spec : constant Node_Id := Unit_Declaration_Node (Subp);
procedure Do_Backend_Inline;
-- Check that the call can be safely passed to the backend. If true
-- then register the enclosing unit of Subp to Inlined_Bodies so that
-- the body of Subp can be retrieved and analyzed by the backend.
-----------------------
-- Do_Backend_Inline --
-----------------------
procedure Do_Backend_Inline is
begin
-- No extra test needed for init subprograms since we know they
-- are available to the backend.
if Is_Init_Proc (Subp) then
Add_Inlined_Body (Subp);
Register_Backend_Call (Call_Node);
-- Verify that if the body to inline is located in the current
-- unit the inlining does not occur earlier. This avoids
-- order-of-elaboration problems in the back end.
elsif In_Same_Extended_Unit (Call_Node, Subp)
and then Nkind (Spec) = N_Subprogram_Declaration
and then Earlier_In_Extended_Unit
(Loc, Sloc (Body_To_Inline (Spec)))
then
Error_Msg_NE
("cannot inline& (body not seen yet)??", Call_Node, Subp);
else
declare
Backend_Inline : Boolean := True;
begin
-- If we are compiling a package body that is not the
-- main unit, it must be for inlining/instantiation
-- purposes, in which case we inline the call to insure
-- that the same temporaries are generated when compiling
-- the body by itself. Otherwise link errors can occur.
-- If the function being called is itself in the main
-- unit, we cannot inline, because there is a risk of
-- double elaboration and/or circularity: the inlining
-- can make visible a private entity in the body of the
-- main unit, that gigi will see before its sees its
-- proper definition.
if not (In_Extended_Main_Code_Unit (Call_Node))
and then In_Package_Body
then
Backend_Inline :=
not In_Extended_Main_Source_Unit (Subp);
end if;
if Backend_Inline then
Add_Inlined_Body (Subp);
Register_Backend_Call (Call_Node);
end if;
end;
end if;
end Do_Backend_Inline;
-- Start of processing for Do_Inline
begin
-- Verify that the body to inline has already been seen
if No (Spec)
or else Nkind (Spec) /= N_Subprogram_Declaration
or else No (Body_To_Inline (Spec))
then
if Comes_From_Source (Subp)
and then Must_Inline (Subp)
then
Cannot_Inline
("cannot inline& (body not seen yet)?", Call_Node, Subp);
-- Let the back end handle it
else
Do_Backend_Inline;
return;
end if;
-- If this an inherited function that returns a private type, do not
-- inline if the full view is an unconstrained array, because such
-- calls cannot be inlined.
elsif Present (Orig_Subp)
and then Is_Array_Type (Etype (Orig_Subp))
and then not Is_Constrained (Etype (Orig_Subp))
then
Cannot_Inline
("cannot inline& (unconstrained array)?", Call_Node, Subp);
else
Expand_Inlined_Call (Call_Node, Subp, Orig_Subp);
end if;
end Do_Inline;
----------------------
-- Do_Inline_Always --
----------------------
procedure Do_Inline_Always (Subp : Entity_Id; Orig_Subp : Entity_Id) is
Spec : constant Node_Id := Unit_Declaration_Node (Subp);
Body_Id : Entity_Id;
begin
if No (Spec)
or else Nkind (Spec) /= N_Subprogram_Declaration
or else No (Body_To_Inline (Spec))
or else Serious_Errors_Detected /= 0
then
return;
end if;
Body_Id := Corresponding_Body (Spec);
-- Verify that the body to inline has already been seen
if No (Body_Id)
or else not Analyzed (Body_Id)
then
Set_Is_Inlined (Subp, False);
if Comes_From_Source (Subp) then
-- Report a warning only if the call is located in the unit of
-- the called subprogram; otherwise it is an error.
if not In_Same_Extended_Unit (Call_Node, Subp) then
Cannot_Inline
("cannot inline& (body not seen yet)?", Call_Node, Subp,
Is_Serious => True);
elsif In_Open_Scopes (Subp) then
-- For backward compatibility we generate the same error
-- or warning of the previous implementation. This will
-- be changed when we definitely incorporate the new
-- support ???
if Front_End_Inlining
and then Optimization_Level = 0
then
Error_Msg_N
("call to recursive subprogram cannot be inlined?p?",
N);
-- Do not emit error compiling runtime packages
elsif Is_Predefined_File_Name
(Unit_File_Name (Get_Source_Unit (Subp)))
then
Error_Msg_N
("call to recursive subprogram cannot be inlined??",
N);
else
Error_Msg_N
("call to recursive subprogram cannot be inlined",
N);
end if;
else
Cannot_Inline
("cannot inline& (body not seen yet)?", Call_Node, Subp);
end if;
end if;
return;
-- If this an inherited function that returns a private type, do not
-- inline if the full view is an unconstrained array, because such
-- calls cannot be inlined.
elsif Present (Orig_Subp)
and then Is_Array_Type (Etype (Orig_Subp))
and then not Is_Constrained (Etype (Orig_Subp))
then
Cannot_Inline
("cannot inline& (unconstrained array)?", Call_Node, Subp);
-- If the called subprogram comes from an instance in the same
-- unit, and the instance is not yet frozen, inlining might
-- trigger order-of-elaboration problems.
elsif In_Unfrozen_Instance (Scope (Subp)) then
Cannot_Inline
("cannot inline& (unfrozen instance)?", Call_Node, Subp);
else
Expand_Inlined_Call (Call_Node, Subp, Orig_Subp);
end if;
end Do_Inline_Always;
--------------------------- ---------------------------
-- Inherited_From_Formal -- -- Inherited_From_Formal --
--------------------------- ---------------------------
...@@ -3941,39 +3723,12 @@ package body Exp_Ch6 is ...@@ -3941,39 +3723,12 @@ package body Exp_Ch6 is
Set_Needs_Debug_Info (Subp, False); Set_Needs_Debug_Info (Subp, False);
end if; end if;
-- Frontend expansion of supported functions returning unconstrained -- Front end expansion of simple functions returning unconstrained
-- types and simple renamings inlined by the frontend (see Freeze. -- types (see Check_And_Split_Unconstrained_Function) and simple
-- Build_Renamed_Entity). -- renamings inlined by the front end (see Build_Renamed_Entity).
else else
declare Expand_Inlined_Call (Call_Node, Subp, Orig_Subp);
Spec : constant Node_Id := Unit_Declaration_Node (Subp);
begin
if Must_Inline (Subp) then
if In_Extended_Main_Code_Unit (Call_Node)
and then In_Same_Extended_Unit (Sloc (Spec), Loc)
and then not Has_Completion (Subp)
then
Cannot_Inline
("cannot inline& (body not seen yet)?",
Call_Node, Subp);
else
Do_Inline_Always (Subp, Orig_Subp);
end if;
elsif Optimization_Level > 0 then
Do_Inline (Subp, Orig_Subp);
end if;
-- The call may have been inlined or may have been passed to
-- the backend. No further action needed if it was inlined.
if Nkind (N) /= N_Function_Call then
return;
end if;
end;
end if; end if;
end if; end if;
......
gcc/ada/inline.adb
...@@ -1225,9 +1225,7 @@ package body Inline is ...@@ -1225,9 +1225,7 @@ package body Inline is
Error_Msg_NE (Msg & "p?", N, Subp); Error_Msg_NE (Msg & "p?", N, Subp);
end if; end if;
return; -- New semantics relying on back end inlining
-- New semantics
elsif Is_Serious then elsif Is_Serious then
...@@ -1242,9 +1240,7 @@ package body Inline is ...@@ -1242,9 +1240,7 @@ package body Inline is
Set_Is_Inlined_Always (Subp, False); Set_Is_Inlined_Always (Subp, False);
Error_Msg_NE (Msg & "p?", N, Subp); Error_Msg_NE (Msg & "p?", N, Subp);
-- Do not issue errors/warnings when compiling with optimizations else
elsif Optimization_Level = 0 then
-- Do not emit warning if this is a predefined unit which is not -- Do not emit warning if this is a predefined unit which is not
-- the main unit. This behavior is currently provided for backward -- the main unit. This behavior is currently provided for backward
...@@ -1281,24 +1277,13 @@ package body Inline is ...@@ -1281,24 +1277,13 @@ package body Inline is
Error_Msg_NE (Msg (Msg'First .. Msg'Last - 1), N, Subp); Error_Msg_NE (Msg (Msg'First .. Msg'Last - 1), N, Subp);
else pragma Assert (Front_End_Inlining); else
Set_Is_Inlined (Subp, False); Set_Is_Inlined (Subp, False);
-- When inlining cannot take place we must issue an error.
-- For backward compatibility we still report a warning.
if Ineffective_Inline_Warnings then if Ineffective_Inline_Warnings then
Error_Msg_NE (Msg & "p?", N, Subp); Error_Msg_NE (Msg & "p?", N, Subp);
end if; end if;
end if; end if;
-- Compiling with optimizations enabled it is too early to report
-- problems since the backend may still perform inlining. In order
-- to report unhandled inlinings the program must be compiled with
-- -Winline and the error is reported by the backend.
else
null;
end if; end if;
end Cannot_Inline; end Cannot_Inline;
...@@ -3327,11 +3312,25 @@ package body Inline is ...@@ -3327,11 +3312,25 @@ package body Inline is
D := First (Decls); D := First (Decls);
while Present (D) loop while Present (D) loop
if Nkind (D) = N_Subprogram_Body then -- First declarations universally excluded
if Nkind (D) = N_Package_Declaration then
Cannot_Inline Cannot_Inline
("cannot inline & (nested subprogram)?", ("cannot inline & (nested package declaration)?",
D, Subp);
return True;
elsif Nkind (D) = N_Package_Instantiation then
Cannot_Inline
("cannot inline & (nested package instantiation)?",
D, Subp); D, Subp);
return True; return True;
end if;
-- Then declarations excluded only for front end inlining
if Back_End_Inlining then
null;
elsif Nkind (D) = N_Task_Type_Declaration elsif Nkind (D) = N_Task_Type_Declaration
or else Nkind (D) = N_Single_Task_Declaration or else Nkind (D) = N_Single_Task_Declaration
...@@ -3349,9 +3348,9 @@ package body Inline is ...@@ -3349,9 +3348,9 @@ package body Inline is
D, Subp); D, Subp);
return True; return True;
elsif Nkind (D) = N_Package_Declaration then elsif Nkind (D) = N_Subprogram_Body then
Cannot_Inline Cannot_Inline
("cannot inline & (nested package declaration)?", ("cannot inline & (nested subprogram)?",
D, Subp); D, Subp);
return True; return True;
...@@ -3368,12 +3367,6 @@ package body Inline is ...@@ -3368,12 +3367,6 @@ package body Inline is
("cannot inline & (nested procedure instantiation)?", ("cannot inline & (nested procedure instantiation)?",
D, Subp); D, Subp);
return True; return True;
elsif Nkind (D) = N_Package_Instantiation then
Cannot_Inline
("cannot inline & (nested package instantiation)?",
D, Subp);
return True;
end if; end if;
Next (D); Next (D);
......
gcc/ada/prj-nmsc.adb
...@@ -4711,7 +4711,7 @@ package body Prj.Nmsc is ...@@ -4711,7 +4711,7 @@ package body Prj.Nmsc is
then then
Error_Msg Error_Msg
(Data.Flags, (Data.Flags,
"Library_Standalone valid only if Library_Interface is set", "Library_Standalone valid only if library has Ada interfaces",
Lib_Standalone.Location, Project); Lib_Standalone.Location, Project);
end if; end if;
......
gcc/ada/table.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -399,7 +399,7 @@ package body Table is ...@@ -399,7 +399,7 @@ package body Table is
Tree_Read_Data Tree_Read_Data
(Tree_Get_Table_Address, (Tree_Get_Table_Address,
(Last_Val - Int (First) + 1) * (Last_Val - Int (First) + 1) *
Table_Type'Component_Size / Storage_Unit); (Table_Type'Component_Size / Storage_Unit));
end Tree_Read; end Tree_Read;
---------------- ----------------
...@@ -415,7 +415,7 @@ package body Table is ...@@ -415,7 +415,7 @@ package body Table is
Tree_Write_Data Tree_Write_Data
(Tree_Get_Table_Address, (Tree_Get_Table_Address,
(Last_Val - Int (First) + 1) * (Last_Val - Int (First) + 1) *
Table_Type'Component_Size / Storage_Unit); (Table_Type'Component_Size / Storage_Unit));
end Tree_Write; end Tree_Write;
begin begin
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment