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>
* sem_ch13.adb (Check_Constant_Address_Clause): Disable checks
......
gcc/ada/exp_ch6.adb
......@@ -1998,19 +1998,6 @@ package body Exp_Ch6 is
-- expression for the value of the actual, EF is the entity for the
-- 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;
-- Within an instance, a type derived from an untagged formal derived
-- type inherits from the original parent, not from the actual. The
......@@ -2097,211 +2084,6 @@ package body Exp_Ch6 is
end if;
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 --
---------------------------
......@@ -3941,39 +3723,12 @@ package body Exp_Ch6 is
Set_Needs_Debug_Info (Subp, False);
end if;
-- Frontend expansion of supported functions returning unconstrained
-- types and simple renamings inlined by the frontend (see Freeze.
-- Build_Renamed_Entity).
-- Front end expansion of simple functions returning unconstrained
-- types (see Check_And_Split_Unconstrained_Function) and simple
-- renamings inlined by the front end (see Build_Renamed_Entity).
else
declare
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;
Expand_Inlined_Call (Call_Node, Subp, Orig_Subp);
end if;
end if;
......
gcc/ada/inline.adb
......@@ -1225,9 +1225,7 @@ package body Inline is
Error_Msg_NE (Msg & "p?", N, Subp);
end if;
return;
-- New semantics
-- New semantics relying on back end inlining
elsif Is_Serious then
......@@ -1242,9 +1240,7 @@ package body Inline is
Set_Is_Inlined_Always (Subp, False);
Error_Msg_NE (Msg & "p?", N, Subp);
-- Do not issue errors/warnings when compiling with optimizations
elsif Optimization_Level = 0 then
else
-- Do not emit warning if this is a predefined unit which is not
-- the main unit. This behavior is currently provided for backward
......@@ -1281,24 +1277,13 @@ package body Inline is
Error_Msg_NE (Msg (Msg'First .. Msg'Last - 1), N, Subp);
else pragma Assert (Front_End_Inlining);
else
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
Error_Msg_NE (Msg & "p?", N, Subp);
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 Cannot_Inline;
......@@ -3327,11 +3312,25 @@ package body Inline is
D := First (Decls);
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 & (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);
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
or else Nkind (D) = N_Single_Task_Declaration
......@@ -3349,9 +3348,9 @@ package body Inline is
D, Subp);
return True;
elsif Nkind (D) = N_Package_Declaration then
elsif Nkind (D) = N_Subprogram_Body then
Cannot_Inline
("cannot inline & (nested package declaration)?",
("cannot inline & (nested subprogram)?",
D, Subp);
return True;
......@@ -3368,12 +3367,6 @@ package body Inline is
("cannot inline & (nested procedure instantiation)?",
D, Subp);
return True;
elsif Nkind (D) = N_Package_Instantiation then
Cannot_Inline
("cannot inline & (nested package instantiation)?",
D, Subp);
return True;
end if;
Next (D);
......
gcc/ada/prj-nmsc.adb
......@@ -4711,7 +4711,7 @@ package body Prj.Nmsc is
then
Error_Msg
(Data.Flags,
"Library_Standalone valid only if Library_Interface is set",
"Library_Standalone valid only if library has Ada interfaces",
Lib_Standalone.Location, Project);
end if;
......
gcc/ada/table.adb
......@@ -6,7 +6,7 @@
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -399,7 +399,7 @@ package body Table is
Tree_Read_Data
(Tree_Get_Table_Address,
(Last_Val - Int (First) + 1) *
Table_Type'Component_Size / Storage_Unit);
(Table_Type'Component_Size / Storage_Unit));
end Tree_Read;
----------------
......@@ -415,7 +415,7 @@ package body Table is
Tree_Write_Data
(Tree_Get_Table_Address,
(Last_Val - Int (First) + 1) *
Table_Type'Component_Size / Storage_Unit);
(Table_Type'Component_Size / Storage_Unit));
end Tree_Write;
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