Skip to content

R
riscv-gcc-1
Commit bfaf8a97 by Arnaud Charlet
Options

[multiple changes] 

2017-01-23  Yannick Moy  <moy@adacore.com>

	* sem_ch4.adb (Analyze_Indexed_Component_Form):
	Adapt to inlined prefix with string literal subtype.
	* inline.adb (Expand_Inlined_Call): Keep unchecked
	conversion inside inlined call when formal type is constrained.

2017-01-23  Javier Miranda  <miranda@adacore.com>

	* sem_util.adb (New_Copy_Tree): Code cleanup:
	removal of global variables. All the global variables, global
	functions and tables of this subprogram are now declared locally.

From-SVN: r244807
parent 9313a26a
Showing with 150 additions and 121 deletions
gcc/ada/ChangeLog
2017-01-23 Yannick Moy <moy@adacore.com>
* sem_ch4.adb (Analyze_Indexed_Component_Form):
Adapt to inlined prefix with string literal subtype.
* inline.adb (Expand_Inlined_Call): Keep unchecked
conversion inside inlined call when formal type is constrained.
2017-01-23 Javier Miranda <miranda@adacore.com>
* sem_util.adb (New_Copy_Tree): Code cleanup:
removal of global variables. All the global variables, global
functions and tables of this subprogram are now declared locally.
2017-01-23 Gary Dismukes <dismukes@adacore.com>
* exp_strm.ads: Minor reformatting and typo fixes.
......
gcc/ada/inline.adb
......@@ -959,6 +959,7 @@ package body Inline is
function Has_Single_Return_In_GNATprove_Mode return Boolean is
Last_Statement : Node_Id := Empty;
Body_To_Inline : constant Node_Id := N;
function Check_Return (N : Node_Id) return Traverse_Result;
-- Returns OK on node N if this is not a return statement different
......@@ -970,18 +971,29 @@ package body Inline is
function Check_Return (N : Node_Id) return Traverse_Result is
begin
if Nkind_In (N, N_Simple_Return_Statement,
N_Extended_Return_Statement)
then
if N = Last_Statement then
return OK;
else
return Abandon;
end if;
case Nkind (N) is
when N_Simple_Return_Statement
| N_Extended_Return_Statement
=>
if N = Last_Statement then
return OK;
else
return Abandon;
end if;
else
return OK;
end if;
-- Skip locally declared subprogram bodies inside the body to
-- inline, as the return statements inside those do not count.
when N_Subprogram_Body =>
if N = Body_To_Inline then
return OK;
else
return Skip;
end if;
when others =>
return OK;
end case;
end Check_Return;
function Check_All_Returns is new Traverse_Func (Check_Return);
......@@ -3151,13 +3163,16 @@ package body Inline is
Subtype_Mark => New_Occurrence_Of (Etype (F), Loc),
Expression => Relocate_Node (Expression (A)));
-- In GNATprove mode, keep the most precise type of the actual
-- for the temporary variable. Otherwise, the AST may contain
-- unexpected assignment statements to a temporary variable of
-- unconstrained type renaming a local variable of constrained
-- type, which is not expected by GNATprove.
-- In GNATprove mode, keep the most precise type of the actual for
-- the temporary variable, when the formal type is unconstrained.
-- Otherwise, the AST may contain unexpected assignment statements
-- to a temporary variable of unconstrained type renaming a
-- local variable of constrained type, which is not expected
-- by GNATprove.
elsif Etype (F) /= Etype (A) and then not GNATprove_Mode then
elsif Etype (F) /= Etype (A)
and then (not GNATprove_Mode or else Is_Constrained (Etype (F)))
then
New_A := Unchecked_Convert_To (Etype (F), Relocate_Node (A));
Temp_Typ := Etype (F);
......
gcc/ada/sem_ch4.adb
......@@ -2407,7 +2407,13 @@ package body Sem_Ch4 is
end if;
if Is_Array_Type (Array_Type) then
null;
-- In order to correctly access First_Index component later,
-- replace string literal subtype by its parent type.
if Ekind (Array_Type) = E_String_Literal_Subtype then
Array_Type := Etype (Array_Type);
end if;
elsif Present (Pent) and then Ekind (Pent) = E_Entry_Family then
Analyze (Exp);
......
gcc/ada/sem_util.adb
......@@ -71,35 +71,6 @@ with GNAT.HTable; use GNAT.HTable;
package body Sem_Util is
----------------------------------------
-- Global Variables for New_Copy_Tree --
----------------------------------------
-- These global variables are used by New_Copy_Tree. See description of the
-- body of this subprogram for details. Global variables can be safely used
-- by New_Copy_Tree, since there is no case of a recursive call from the
-- processing inside New_Copy_Tree.
NCT_Hash_Threshold : constant := 20;
-- If there are more than this number of pairs of entries in the map, then
-- Hash_Tables_Used will be set, and the hash tables will be initialized
-- and used for the searches.
NCT_Hash_Tables_Used : Boolean := False;
-- Set to True if hash tables are in use
NCT_Table_Entries : Nat := 0;
-- Count entries in table to see if threshold is reached
NCT_Hash_Table_Setup : Boolean := False;
-- Set to True if hash table contains data. We set this True if we setup
-- the hash table with data, and leave it set permanently from then on,
-- this is a signal that second and subsequent users of the hash table
-- must clear the old entries before reuse.
subtype NCT_Header_Num is Int range 0 .. 511;
-- Defines range of headers in hash tables (512 headers)
-----------------------
-- Local Subprograms --
-----------------------
......@@ -1993,9 +1964,9 @@ package body Sem_Util is
function Contains (List : Elist_Id; N : Node_Id) return Boolean;
-- Returns True if List has a node whose Entity is Entity (N)
-------------------------
-- Check_Function_Call --
-------------------------
----------------
-- Check_Node --
----------------
function Check_Node (N : Node_Id) return Traverse_Result is
Is_Writable_Actual : Boolean := False;
......@@ -16245,71 +16216,6 @@ package body Sem_Util is
end if;
end New_Copy_List_Tree;
--------------------------------------------------
-- New_Copy_Tree Auxiliary Data and Subprograms --
--------------------------------------------------
use Atree.Unchecked_Access;
use Atree_Private_Part;
-- Our approach here requires a two pass traversal of the tree. The
-- first pass visits all nodes that eventually will be copied looking
-- for defining Itypes. If any defining Itypes are found, then they are
-- copied, and an entry is added to the replacement map. In the second
-- phase, the tree is copied, using the replacement map to replace any
-- Itype references within the copied tree.
-- The following hash tables are used if the Map supplied has more
-- than hash threshold entries to speed up access to the map. If
-- there are fewer entries, then the map is searched sequentially
-- (because setting up a hash table for only a few entries takes
-- more time than it saves.
function New_Copy_Hash (E : Entity_Id) return NCT_Header_Num;
-- Hash function used for hash operations
-------------------
-- New_Copy_Hash --
-------------------
function New_Copy_Hash (E : Entity_Id) return NCT_Header_Num is
begin
return Nat (E) mod (NCT_Header_Num'Last + 1);
end New_Copy_Hash;
---------------
-- NCT_Assoc --
---------------
-- The hash table NCT_Assoc associates old entities in the table with their
-- corresponding new entities (i.e. the pairs of entries presented in the
-- original Map argument are Key-Element pairs).
package NCT_Assoc is new Simple_HTable (
Header_Num => NCT_Header_Num,
Element => Entity_Id,
No_Element => Empty,
Key => Entity_Id,
Hash => New_Copy_Hash,
Equal => Types."=");
---------------------
-- NCT_Itype_Assoc --
---------------------
-- The hash table NCT_Itype_Assoc contains entries only for those old
-- nodes which have a non-empty Associated_Node_For_Itype set. The key
-- is the associated node, and the element is the new node itself (NOT
-- the associated node for the new node).
package NCT_Itype_Assoc is new Simple_HTable (
Header_Num => NCT_Header_Num,
Element => Entity_Id,
No_Element => Empty,
Key => Entity_Id,
Hash => New_Copy_Hash,
Equal => Types."=");
-------------------
-- New_Copy_Tree --
-------------------
......@@ -16329,6 +16235,81 @@ package body Sem_Util is
-- (and normally is) initialized to No_Elist, and if we have mapped
-- entities, we have to reset it to point to a real Elist.
NCT_Hash_Threshold : constant := 20;
-- If there are more than this number of pairs of entries in the map,
-- then Hash_Tables_Used will be set, and the hash tables will be
-- initialized and used for the searches.
NCT_Hash_Tables_Used : Boolean := False;
-- Set to True if hash tables are in use
NCT_Table_Entries : Nat := 0;
-- Count entries in table to see if threshold is reached
NCT_Hash_Table_Setup : Boolean := False;
-- Set to True if hash table contains data. We set this True if we setup
-- the hash table with data. This is a signal that we must clear its
-- contents before returning the tree copy.
------------------------------------
-- Auxiliary Data and Subprograms --
------------------------------------
use Atree.Unchecked_Access;
use Atree_Private_Part;
-- Our approach here requires a two pass traversal of the tree. The
-- first pass visits all nodes that eventually will be copied looking
-- for defining Itypes. If any defining Itypes are found, then they are
-- copied, and an entry is added to the replacement map. In the second
-- phase, the tree is copied, using the replacement map to replace any
-- Itype references within the copied tree.
-- The following hash tables are used if the Map supplied has more
-- than hash threshold entries to speed up access to the map. If
-- there are fewer entries, then the map is searched sequentially
-- (because setting up a hash table for only a few entries takes
-- more time than it saves.
subtype NCT_Header_Num is Int range 0 .. 511;
-- Defines range of headers in hash tables (512 headers)
function New_Copy_Hash (E : Entity_Id) return NCT_Header_Num;
-- Hash function used for hash operations
---------------
-- NCT_Assoc --
---------------
-- The hash table NCT_Assoc associates old entities in the table with
-- their corresponding new entities (i.e. the pairs of entries presented
-- in the original Map argument are Key-Element pairs).
package NCT_Assoc is new Simple_HTable (
Header_Num => NCT_Header_Num,
Element => Entity_Id,
No_Element => Empty,
Key => Entity_Id,
Hash => New_Copy_Hash,
Equal => Types."=");
---------------------
-- NCT_Itype_Assoc --
---------------------
-- The hash table NCT_Itype_Assoc contains entries only for those old
-- nodes which have a non-empty Associated_Node_For_Itype set. The key
-- is the associated node, and the element is the new node itself (NOT
-- the associated node for the new node).
package NCT_Itype_Assoc is new Simple_HTable (
Header_Num => NCT_Header_Num,
Element => Entity_Id,
No_Element => Empty,
Key => Entity_Id,
Hash => New_Copy_Hash,
Equal => Types."=");
function Assoc (N : Node_Or_Entity_Id) return Node_Id;
-- Called during second phase to map entities into their corresponding
-- copies using Actual_Map. If the argument is not an entity, or is not
......@@ -16418,11 +16399,6 @@ package body Sem_Util is
Ent : Entity_Id;
begin
if NCT_Hash_Table_Setup then
NCT_Assoc.Reset;
NCT_Itype_Assoc.Reset;
end if;
Elmt := First_Elmt (Actual_Map);
while Present (Elmt) loop
Ent := Node (Elmt);
......@@ -16814,6 +16790,15 @@ package body Sem_Util is
return New_Node;
end Copy_Node_With_Replacement;
-------------------
-- New_Copy_Hash --
-------------------
function New_Copy_Hash (E : Entity_Id) return NCT_Header_Num is
begin
return Nat (E) mod (NCT_Header_Num'Last + 1);
end New_Copy_Hash;
-----------------
-- Visit_Elist --
-----------------
......@@ -17161,7 +17146,17 @@ package body Sem_Util is
-- Now we can copy the actual tree
return Copy_Node_With_Replacement (Source);
declare
Result : constant Node_Id := Copy_Node_With_Replacement (Source);
begin
if NCT_Hash_Table_Setup then
NCT_Assoc.Reset;
NCT_Itype_Assoc.Reset;
end if;
return Result;
end;
end New_Copy_Tree;
-------------------------
......
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