Skip to content

R
riscv-gcc-1
Commit 30196a76 by Robert Dewar Committed by Arnaud Charlet
Options

nlists.ads, nlists.adb (In_Same_List): New function. 

2010-09-09  Robert Dewar  <dewar@adacore.com>

	* nlists.ads, nlists.adb (In_Same_List): New function.
	Use Node_Or_Entity_Id where appropriate.
	* par-labl.adb, sem_ch6.adb, sem_type.adb: Use In_Same_List.

2010-09-09  Robert Dewar  <dewar@adacore.com>

	* restrict.ads, restrict.adb (Check_Wide_Character_Restriction): New
	procedure.
	* sem_ch3.adb: Use Check_Wide_Character_Restriction
	(Enumeration_Type_Declaration): Check violation of No_Wide_Characters
	* sem_ch8.adb (Find_Direct_Name): Check violation of No_Wide_Characters
	(Find_Expanded_Name): Check violation of No_Wide_Characters

2010-09-09  Robert Dewar  <dewar@adacore.com>

	* par-ch5.adb: Minor reformatting.

From-SVN: r164056
parent d151d6a3
Showing with 317 additions and 202 deletions
gcc/ada/ChangeLog
2010-09-09 Robert Dewar <dewar@adacore.com> 2010-09-09 Robert Dewar <dewar@adacore.com>
* nlists.ads, nlists.adb (In_Same_List): New function.
Use Node_Or_Entity_Id where appropriate.
* par-labl.adb, sem_ch6.adb, sem_type.adb: Use In_Same_List.
2010-09-09 Robert Dewar <dewar@adacore.com>
* restrict.ads, restrict.adb (Check_Wide_Character_Restriction): New
procedure.
* sem_ch3.adb: Use Check_Wide_Character_Restriction
(Enumeration_Type_Declaration): Check violation of No_Wide_Characters
* sem_ch8.adb (Find_Direct_Name): Check violation of No_Wide_Characters
(Find_Expanded_Name): Check violation of No_Wide_Characters
2010-09-09 Robert Dewar <dewar@adacore.com>
* par-ch5.adb: Minor reformatting.
2010-09-09 Robert Dewar <dewar@adacore.com>
* prj-env.adb: Minor code reorganization. * prj-env.adb: Minor code reorganization.
* par-ch3.adb: Minor reformatting. * par-ch3.adb: Minor reformatting.
* gcc-interface/Make-lang.in: Update dependencies. * gcc-interface/Make-lang.in: Update dependencies.
......
gcc/ada/nlists.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2010, 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- --
...@@ -52,10 +52,10 @@ package body Nlists is ...@@ -52,10 +52,10 @@ package body Nlists is
-- three fields: -- three fields:
type List_Header is record type List_Header is record
First : Node_Id; First : Node_Or_Entity_Id;
-- Pointer to first node in list. Empty if list is empty -- Pointer to first node in list. Empty if list is empty
Last : Node_Id; Last : Node_Or_Entity_Id;
-- Pointer to last node in list. Empty if list is empty -- Pointer to last node in list. Empty if list is empty
Parent : Node_Id; Parent : Node_Id;
...@@ -85,16 +85,16 @@ package body Nlists is ...@@ -85,16 +85,16 @@ package body Nlists is
-- list and Prev_Node is Empty at the start of a list. -- list and Prev_Node is Empty at the start of a list.
package Next_Node is new Table.Table ( package Next_Node is new Table.Table (
Table_Component_Type => Node_Id, Table_Component_Type => Node_Or_Entity_Id,
Table_Index_Type => Node_Id'Base, Table_Index_Type => Node_Or_Entity_Id'Base,
Table_Low_Bound => First_Node_Id, Table_Low_Bound => First_Node_Id,
Table_Initial => Alloc.Orig_Nodes_Initial, Table_Initial => Alloc.Orig_Nodes_Initial,
Table_Increment => Alloc.Orig_Nodes_Increment, Table_Increment => Alloc.Orig_Nodes_Increment,
Table_Name => "Next_Node"); Table_Name => "Next_Node");
package Prev_Node is new Table.Table ( package Prev_Node is new Table.Table (
Table_Component_Type => Node_Id, Table_Component_Type => Node_Or_Entity_Id,
Table_Index_Type => Node_Id'Base, Table_Index_Type => Node_Or_Entity_Id'Base,
Table_Low_Bound => First_Node_Id, Table_Low_Bound => First_Node_Id,
Table_Initial => Alloc.Orig_Nodes_Initial, Table_Initial => Alloc.Orig_Nodes_Initial,
Table_Increment => Alloc.Orig_Nodes_Increment, Table_Increment => Alloc.Orig_Nodes_Increment,
...@@ -104,23 +104,23 @@ package body Nlists is ...@@ -104,23 +104,23 @@ package body Nlists is
-- Local Subprograms -- -- Local Subprograms --
----------------------- -----------------------
procedure Set_First (List : List_Id; To : Node_Id); procedure Set_First (List : List_Id; To : Node_Or_Entity_Id);
pragma Inline (Set_First); pragma Inline (Set_First);
-- Sets First field of list header List to reference To -- Sets First field of list header List to reference To
procedure Set_Last (List : List_Id; To : Node_Id); procedure Set_Last (List : List_Id; To : Node_Or_Entity_Id);
pragma Inline (Set_Last); pragma Inline (Set_Last);
-- Sets Last field of list header List to reference To -- Sets Last field of list header List to reference To
procedure Set_List_Link (Node : Node_Id; To : List_Id); procedure Set_List_Link (Node : Node_Or_Entity_Id; To : List_Id);
pragma Inline (Set_List_Link); pragma Inline (Set_List_Link);
-- Sets list link of Node to list header To -- Sets list link of Node to list header To
procedure Set_Next (Node : Node_Id; To : Node_Id); procedure Set_Next (Node : Node_Or_Entity_Id; To : Node_Or_Entity_Id);
pragma Inline (Set_Next); pragma Inline (Set_Next);
-- Sets the Next_Node pointer for Node to reference To -- Sets the Next_Node pointer for Node to reference To
procedure Set_Prev (Node : Node_Id; To : Node_Id); procedure Set_Prev (Node : Node_Or_Entity_Id; To : Node_Or_Entity_Id);
pragma Inline (Set_Prev); pragma Inline (Set_Prev);
-- Sets the Prev_Node pointer for Node to reference To -- Sets the Prev_Node pointer for Node to reference To
...@@ -128,8 +128,8 @@ package body Nlists is ...@@ -128,8 +128,8 @@ package body Nlists is
-- Allocate_List_Tables -- -- Allocate_List_Tables --
-------------------------- --------------------------
procedure Allocate_List_Tables (N : Node_Id) is procedure Allocate_List_Tables (N : Node_Or_Entity_Id) is
Old_Last : constant Node_Id'Base := Next_Node.Last; Old_Last : constant Node_Or_Entity_Id'Base := Next_Node.Last;
begin begin
pragma Assert (N >= Old_Last); pragma Assert (N >= Old_Last);
...@@ -149,8 +149,8 @@ package body Nlists is ...@@ -149,8 +149,8 @@ package body Nlists is
-- Append -- -- Append --
------------ ------------
procedure Append (Node : Node_Id; To : List_Id) is procedure Append (Node : Node_Or_Entity_Id; To : List_Id) is
L : constant Node_Id := Last (To); L : constant Node_Or_Entity_Id := Last (To);
procedure Append_Debug; procedure Append_Debug;
pragma Inline (Append_Debug); pragma Inline (Append_Debug);
...@@ -230,9 +230,9 @@ package body Nlists is ...@@ -230,9 +230,9 @@ package body Nlists is
else else
declare declare
L : constant Node_Id := Last (To); L : constant Node_Or_Entity_Id := Last (To);
F : constant Node_Id := First (List); F : constant Node_Or_Entity_Id := First (List);
N : Node_Id; N : Node_Or_Entity_Id;
begin begin
pragma Debug (Append_List_Debug); pragma Debug (Append_List_Debug);
...@@ -272,7 +272,7 @@ package body Nlists is ...@@ -272,7 +272,7 @@ package body Nlists is
-- Append_To -- -- Append_To --
--------------- ---------------
procedure Append_To (To : List_Id; Node : Node_Id) is procedure Append_To (To : List_Id; Node : Node_Or_Entity_Id) is
begin begin
Append (Node, To); Append (Node, To);
end Append_To; end Append_To;
...@@ -281,7 +281,7 @@ package body Nlists is ...@@ -281,7 +281,7 @@ package body Nlists is
-- First -- -- First --
----------- -----------
function First (List : List_Id) return Node_Id is function First (List : List_Id) return Node_Or_Entity_Id is
begin begin
if List = No_List then if List = No_List then
return Empty; return Empty;
...@@ -295,8 +295,8 @@ package body Nlists is ...@@ -295,8 +295,8 @@ package body Nlists is
-- First_Non_Pragma -- -- First_Non_Pragma --
---------------------- ----------------------
function First_Non_Pragma (List : List_Id) return Node_Id is function First_Non_Pragma (List : List_Id) return Node_Or_Entity_Id is
N : constant Node_Id := First (List); N : constant Node_Or_Entity_Id := First (List);
begin begin
if Nkind (N) /= N_Pragma if Nkind (N) /= N_Pragma
and then and then
...@@ -329,11 +329,22 @@ package body Nlists is ...@@ -329,11 +329,22 @@ package body Nlists is
end Initialize; end Initialize;
------------------ ------------------
-- Insert_After -- -- In_Same_List --
------------------ ------------------
procedure Insert_After (After : Node_Id; Node : Node_Id) is function In_Same_List (N1, N2 : Node_Or_Entity_Id) return Boolean is
begin
return List_Containing (N1) = List_Containing (N2);
end In_Same_List;
------------------
-- Insert_After --
------------------
procedure Insert_After
(After : Node_Or_Entity_Id;
Node : Node_Or_Entity_Id)
is
procedure Insert_After_Debug; procedure Insert_After_Debug;
pragma Inline (Insert_After_Debug); pragma Inline (Insert_After_Debug);
-- Output debug information if Debug_Flag_N set -- Output debug information if Debug_Flag_N set
...@@ -366,8 +377,8 @@ package body Nlists is ...@@ -366,8 +377,8 @@ package body Nlists is
pragma Debug (Insert_After_Debug); pragma Debug (Insert_After_Debug);
declare declare
Before : constant Node_Id := Next (After); Before : constant Node_Or_Entity_Id := Next (After);
LC : constant List_Id := List_Containing (After); LC : constant List_Id := List_Containing (After);
begin begin
if Present (Before) then if Present (Before) then
...@@ -390,8 +401,10 @@ package body Nlists is ...@@ -390,8 +401,10 @@ package body Nlists is
-- Insert_Before -- -- Insert_Before --
------------------- -------------------
procedure Insert_Before (Before : Node_Id; Node : Node_Id) is procedure Insert_Before
(Before : Node_Or_Entity_Id;
Node : Node_Or_Entity_Id)
is
procedure Insert_Before_Debug; procedure Insert_Before_Debug;
pragma Inline (Insert_Before_Debug); pragma Inline (Insert_Before_Debug);
-- Output debug information if Debug_Flag_N set -- Output debug information if Debug_Flag_N set
...@@ -424,8 +437,8 @@ package body Nlists is ...@@ -424,8 +437,8 @@ package body Nlists is
pragma Debug (Insert_Before_Debug); pragma Debug (Insert_Before_Debug);
declare declare
After : constant Node_Id := Prev (Before); After : constant Node_Or_Entity_Id := Prev (Before);
LC : constant List_Id := List_Containing (Before); LC : constant List_Id := List_Containing (Before);
begin begin
if Present (After) then if Present (After) then
...@@ -448,7 +461,7 @@ package body Nlists is ...@@ -448,7 +461,7 @@ package body Nlists is
-- Insert_List_After -- -- Insert_List_After --
----------------------- -----------------------
procedure Insert_List_After (After : Node_Id; List : List_Id) is procedure Insert_List_After (After : Node_Or_Entity_Id; List : List_Id) is
procedure Insert_List_After_Debug; procedure Insert_List_After_Debug;
pragma Inline (Insert_List_After_Debug); pragma Inline (Insert_List_After_Debug);
...@@ -479,11 +492,11 @@ package body Nlists is ...@@ -479,11 +492,11 @@ package body Nlists is
else else
declare declare
Before : constant Node_Id := Next (After); Before : constant Node_Or_Entity_Id := Next (After);
LC : constant List_Id := List_Containing (After); LC : constant List_Id := List_Containing (After);
F : constant Node_Id := First (List); F : constant Node_Or_Entity_Id := First (List);
L : constant Node_Id := Last (List); L : constant Node_Or_Entity_Id := Last (List);
N : Node_Id; N : Node_Or_Entity_Id;
begin begin
pragma Debug (Insert_List_After_Debug); pragma Debug (Insert_List_After_Debug);
...@@ -515,7 +528,7 @@ package body Nlists is ...@@ -515,7 +528,7 @@ package body Nlists is
-- Insert_List_Before -- -- Insert_List_Before --
------------------------ ------------------------
procedure Insert_List_Before (Before : Node_Id; List : List_Id) is procedure Insert_List_Before (Before : Node_Or_Entity_Id; List : List_Id) is
procedure Insert_List_Before_Debug; procedure Insert_List_Before_Debug;
pragma Inline (Insert_List_Before_Debug); pragma Inline (Insert_List_Before_Debug);
...@@ -546,11 +559,11 @@ package body Nlists is ...@@ -546,11 +559,11 @@ package body Nlists is
else else
declare declare
After : constant Node_Id := Prev (Before); After : constant Node_Or_Entity_Id := Prev (Before);
LC : constant List_Id := List_Containing (Before); LC : constant List_Id := List_Containing (Before);
F : constant Node_Id := First (List); F : constant Node_Or_Entity_Id := First (List);
L : constant Node_Id := Last (List); L : constant Node_Or_Entity_Id := Last (List);
N : Node_Id; N : Node_Or_Entity_Id;
begin begin
pragma Debug (Insert_List_Before_Debug); pragma Debug (Insert_List_Before_Debug);
...@@ -591,7 +604,7 @@ package body Nlists is ...@@ -591,7 +604,7 @@ package body Nlists is
-- Is_List_Member -- -- Is_List_Member --
-------------------- --------------------
function Is_List_Member (Node : Node_Id) return Boolean is function Is_List_Member (Node : Node_Or_Entity_Id) return Boolean is
begin begin
return Nodes.Table (Node).In_List; return Nodes.Table (Node).In_List;
end Is_List_Member; end Is_List_Member;
...@@ -609,7 +622,7 @@ package body Nlists is ...@@ -609,7 +622,7 @@ package body Nlists is
-- Last -- -- Last --
---------- ----------
function Last (List : List_Id) return Node_Id is function Last (List : List_Id) return Node_Or_Entity_Id is
begin begin
pragma Assert (List <= Lists.Last); pragma Assert (List <= Lists.Last);
return Lists.Table (List).Last; return Lists.Table (List).Last;
...@@ -628,8 +641,8 @@ package body Nlists is ...@@ -628,8 +641,8 @@ package body Nlists is
-- Last_Non_Pragma -- -- Last_Non_Pragma --
--------------------- ---------------------
function Last_Non_Pragma (List : List_Id) return Node_Id is function Last_Non_Pragma (List : List_Id) return Node_Or_Entity_Id is
N : constant Node_Id := Last (List); N : constant Node_Or_Entity_Id := Last (List);
begin begin
if Nkind (N) /= N_Pragma then if Nkind (N) /= N_Pragma then
return N; return N;
...@@ -642,7 +655,7 @@ package body Nlists is ...@@ -642,7 +655,7 @@ package body Nlists is
-- List_Containing -- -- List_Containing --
--------------------- ---------------------
function List_Containing (Node : Node_Id) return List_Id is function List_Containing (Node : Node_Or_Entity_Id) return List_Id is
begin begin
pragma Assert (Is_List_Member (Node)); pragma Assert (Is_List_Member (Node));
return List_Id (Nodes.Table (Node).Link); return List_Id (Nodes.Table (Node).Link);
...@@ -654,7 +667,7 @@ package body Nlists is ...@@ -654,7 +667,7 @@ package body Nlists is
function List_Length (List : List_Id) return Nat is function List_Length (List : List_Id) return Nat is
Result : Nat; Result : Nat;
Node : Node_Id; Node : Node_Or_Entity_Id;
begin begin
Result := 0; Result := 0;
...@@ -698,7 +711,7 @@ package body Nlists is ...@@ -698,7 +711,7 @@ package body Nlists is
function New_Copy_List (List : List_Id) return List_Id is function New_Copy_List (List : List_Id) return List_Id is
NL : List_Id; NL : List_Id;
E : Node_Id; E : Node_Or_Entity_Id;
begin begin
if List = No_List then if List = No_List then
...@@ -723,7 +736,7 @@ package body Nlists is ...@@ -723,7 +736,7 @@ package body Nlists is
function New_Copy_List_Original (List : List_Id) return List_Id is function New_Copy_List_Original (List : List_Id) return List_Id is
NL : List_Id; NL : List_Id;
E : Node_Id; E : Node_Or_Entity_Id;
begin begin
if List = No_List then if List = No_List then
...@@ -790,7 +803,7 @@ package body Nlists is ...@@ -790,7 +803,7 @@ package body Nlists is
-- list directly, rather than first building an empty list and then doing -- list directly, rather than first building an empty list and then doing
-- the insertion, which results in some unnecessary work. -- the insertion, which results in some unnecessary work.
function New_List (Node : Node_Id) return List_Id is function New_List (Node : Node_Or_Entity_Id) return List_Id is
procedure New_List_Debug; procedure New_List_Debug;
pragma Inline (New_List_Debug); pragma Inline (New_List_Debug);
...@@ -838,14 +851,21 @@ package body Nlists is ...@@ -838,14 +851,21 @@ package body Nlists is
end if; end if;
end New_List; end New_List;
function New_List (Node1, Node2 : Node_Id) return List_Id is function New_List
(Node1 : Node_Or_Entity_Id;
Node2 : Node_Or_Entity_Id) return List_Id
is
L : constant List_Id := New_List (Node1); L : constant List_Id := New_List (Node1);
begin begin
Append (Node2, L); Append (Node2, L);
return L; return L;
end New_List; end New_List;
function New_List (Node1, Node2, Node3 : Node_Id) return List_Id is function New_List
(Node1 : Node_Or_Entity_Id;
Node2 : Node_Or_Entity_Id;
Node3 : Node_Or_Entity_Id) return List_Id
is
L : constant List_Id := New_List (Node1); L : constant List_Id := New_List (Node1);
begin begin
Append (Node2, L); Append (Node2, L);
...@@ -853,7 +873,12 @@ package body Nlists is ...@@ -853,7 +873,12 @@ package body Nlists is
return L; return L;
end New_List; end New_List;
function New_List (Node1, Node2, Node3, Node4 : Node_Id) return List_Id is function New_List
(Node1 : Node_Or_Entity_Id;
Node2 : Node_Or_Entity_Id;
Node3 : Node_Or_Entity_Id;
Node4 : Node_Or_Entity_Id) return List_Id
is
L : constant List_Id := New_List (Node1); L : constant List_Id := New_List (Node1);
begin begin
Append (Node2, L); Append (Node2, L);
...@@ -863,11 +888,11 @@ package body Nlists is ...@@ -863,11 +888,11 @@ package body Nlists is
end New_List; end New_List;
function New_List function New_List
(Node1 : Node_Id; (Node1 : Node_Or_Entity_Id;
Node2 : Node_Id; Node2 : Node_Or_Entity_Id;
Node3 : Node_Id; Node3 : Node_Or_Entity_Id;
Node4 : Node_Id; Node4 : Node_Or_Entity_Id;
Node5 : Node_Id) return List_Id Node5 : Node_Or_Entity_Id) return List_Id
is is
L : constant List_Id := New_List (Node1); L : constant List_Id := New_List (Node1);
begin begin
...@@ -879,12 +904,12 @@ package body Nlists is ...@@ -879,12 +904,12 @@ package body Nlists is
end New_List; end New_List;
function New_List function New_List
(Node1 : Node_Id; (Node1 : Node_Or_Entity_Id;
Node2 : Node_Id; Node2 : Node_Or_Entity_Id;
Node3 : Node_Id; Node3 : Node_Or_Entity_Id;
Node4 : Node_Id; Node4 : Node_Or_Entity_Id;
Node5 : Node_Id; Node5 : Node_Or_Entity_Id;
Node6 : Node_Id) return List_Id Node6 : Node_Or_Entity_Id) return List_Id
is is
L : constant List_Id := New_List (Node1); L : constant List_Id := New_List (Node1);
begin begin
...@@ -900,13 +925,13 @@ package body Nlists is ...@@ -900,13 +925,13 @@ package body Nlists is
-- Next -- -- Next --
---------- ----------
function Next (Node : Node_Id) return Node_Id is function Next (Node : Node_Or_Entity_Id) return Node_Or_Entity_Id is
begin begin
pragma Assert (Is_List_Member (Node)); pragma Assert (Is_List_Member (Node));
return Next_Node.Table (Node); return Next_Node.Table (Node);
end Next; end Next;
procedure Next (Node : in out Node_Id) is procedure Next (Node : in out Node_Or_Entity_Id) is
begin begin
Node := Next (Node); Node := Next (Node);
end Next; end Next;
...@@ -924,22 +949,22 @@ package body Nlists is ...@@ -924,22 +949,22 @@ package body Nlists is
-- Next_Non_Pragma -- -- Next_Non_Pragma --
--------------------- ---------------------
function Next_Non_Pragma (Node : Node_Id) return Node_Id is function Next_Non_Pragma
N : Node_Id; (Node : Node_Or_Entity_Id) return Node_Or_Entity_Id
is
N : Node_Or_Entity_Id;
begin begin
N := Node; N := Node;
loop loop
N := Next (N); N := Next (N);
exit when Nkind (N) /= N_Pragma exit when not Nkind_In (N, N_Pragma, N_Null_Statement);
and then
Nkind (N) /= N_Null_Statement;
end loop; end loop;
return N; return N;
end Next_Non_Pragma; end Next_Non_Pragma;
procedure Next_Non_Pragma (Node : in out Node_Id) is procedure Next_Non_Pragma (Node : in out Node_Or_Entity_Id) is
begin begin
Node := Next_Non_Pragma (Node); Node := Next_Non_Pragma (Node);
end Next_Non_Pragma; end Next_Non_Pragma;
...@@ -966,10 +991,10 @@ package body Nlists is ...@@ -966,10 +991,10 @@ package body Nlists is
-- p -- -- p --
------- -------
function p (U : Union_Id) return Node_Id is function p (U : Union_Id) return Node_Or_Entity_Id is
begin begin
if U in Node_Range then if U in Node_Range then
return Parent (Node_Id (U)); return Parent (Node_Or_Entity_Id (U));
elsif U in List_Range then elsif U in List_Range then
return Parent (List_Id (U)); return Parent (List_Id (U));
else else
...@@ -981,7 +1006,7 @@ package body Nlists is ...@@ -981,7 +1006,7 @@ package body Nlists is
-- Parent -- -- Parent --
------------ ------------
function Parent (List : List_Id) return Node_Id is function Parent (List : List_Id) return Node_Or_Entity_Id is
begin begin
pragma Assert (List <= Lists.Last); pragma Assert (List <= Lists.Last);
return Lists.Table (List).Parent; return Lists.Table (List).Parent;
...@@ -991,8 +1016,8 @@ package body Nlists is ...@@ -991,8 +1016,8 @@ package body Nlists is
-- Pick -- -- Pick --
---------- ----------
function Pick (List : List_Id; Index : Pos) return Node_Id is function Pick (List : List_Id; Index : Pos) return Node_Or_Entity_Id is
Elmt : Node_Id; Elmt : Node_Or_Entity_Id;
begin begin
Elmt := First (List); Elmt := First (List);
...@@ -1007,8 +1032,8 @@ package body Nlists is ...@@ -1007,8 +1032,8 @@ package body Nlists is
-- Prepend -- -- Prepend --
------------- -------------
procedure Prepend (Node : Node_Id; To : List_Id) is procedure Prepend (Node : Node_Or_Entity_Id; To : List_Id) is
F : constant Node_Id := First (To); F : constant Node_Or_Entity_Id := First (To);
procedure Prepend_Debug; procedure Prepend_Debug;
pragma Inline (Prepend_Debug); pragma Inline (Prepend_Debug);
...@@ -1088,9 +1113,9 @@ package body Nlists is ...@@ -1088,9 +1113,9 @@ package body Nlists is
else else
declare declare
F : constant Node_Id := First (To); F : constant Node_Or_Entity_Id := First (To);
L : constant Node_Id := Last (List); L : constant Node_Or_Entity_Id := Last (List);
N : Node_Id; N : Node_Or_Entity_Id;
begin begin
pragma Debug (Prepend_List_Debug); pragma Debug (Prepend_List_Debug);
...@@ -1130,7 +1155,7 @@ package body Nlists is ...@@ -1130,7 +1155,7 @@ package body Nlists is
-- Prepend_To -- -- Prepend_To --
---------------- ----------------
procedure Prepend_To (To : List_Id; Node : Node_Id) is procedure Prepend_To (To : List_Id; Node : Node_Or_Entity_Id) is
begin begin
Prepend (Node, To); Prepend (Node, To);
end Prepend_To; end Prepend_To;
...@@ -1148,13 +1173,13 @@ package body Nlists is ...@@ -1148,13 +1173,13 @@ package body Nlists is
-- Prev -- -- Prev --
---------- ----------
function Prev (Node : Node_Id) return Node_Id is function Prev (Node : Node_Or_Entity_Id) return Node_Or_Entity_Id is
begin begin
pragma Assert (Is_List_Member (Node)); pragma Assert (Is_List_Member (Node));
return Prev_Node.Table (Node); return Prev_Node.Table (Node);
end Prev; end Prev;
procedure Prev (Node : in out Node_Id) is procedure Prev (Node : in out Node_Or_Entity_Id) is
begin begin
Node := Prev (Node); Node := Prev (Node);
end Prev; end Prev;
...@@ -1172,8 +1197,10 @@ package body Nlists is ...@@ -1172,8 +1197,10 @@ package body Nlists is
-- Prev_Non_Pragma -- -- Prev_Non_Pragma --
--------------------- ---------------------
function Prev_Non_Pragma (Node : Node_Id) return Node_Id is function Prev_Non_Pragma
N : Node_Id; (Node : Node_Or_Entity_Id) return Node_Or_Entity_Id
is
N : Node_Or_Entity_Id;
begin begin
N := Node; N := Node;
...@@ -1185,7 +1212,7 @@ package body Nlists is ...@@ -1185,7 +1212,7 @@ package body Nlists is
return N; return N;
end Prev_Non_Pragma; end Prev_Non_Pragma;
procedure Prev_Non_Pragma (Node : in out Node_Id) is procedure Prev_Non_Pragma (Node : in out Node_Or_Entity_Id) is
begin begin
Node := Prev_Non_Pragma (Node); Node := Prev_Non_Pragma (Node);
end Prev_Non_Pragma; end Prev_Non_Pragma;
...@@ -1194,10 +1221,10 @@ package body Nlists is ...@@ -1194,10 +1221,10 @@ package body Nlists is
-- Remove -- -- Remove --
------------ ------------
procedure Remove (Node : Node_Id) is procedure Remove (Node : Node_Or_Entity_Id) is
Lst : constant List_Id := List_Containing (Node); Lst : constant List_Id := List_Containing (Node);
Prv : constant Node_Id := Prev (Node); Prv : constant Node_Or_Entity_Id := Prev (Node);
Nxt : constant Node_Id := Next (Node); Nxt : constant Node_Or_Entity_Id := Next (Node);
procedure Remove_Debug; procedure Remove_Debug;
pragma Inline (Remove_Debug); pragma Inline (Remove_Debug);
...@@ -1241,8 +1268,8 @@ package body Nlists is ...@@ -1241,8 +1268,8 @@ package body Nlists is
-- Remove_Head -- -- Remove_Head --
----------------- -----------------
function Remove_Head (List : List_Id) return Node_Id is function Remove_Head (List : List_Id) return Node_Or_Entity_Id is
Frst : constant Node_Id := First (List); Frst : constant Node_Or_Entity_Id := First (List);
procedure Remove_Head_Debug; procedure Remove_Head_Debug;
pragma Inline (Remove_Head_Debug); pragma Inline (Remove_Head_Debug);
...@@ -1271,7 +1298,7 @@ package body Nlists is ...@@ -1271,7 +1298,7 @@ package body Nlists is
else else
declare declare
Nxt : constant Node_Id := Next (Frst); Nxt : constant Node_Or_Entity_Id := Next (Frst);
begin begin
Set_First (List, Nxt); Set_First (List, Nxt);
...@@ -1293,8 +1320,10 @@ package body Nlists is ...@@ -1293,8 +1320,10 @@ package body Nlists is
-- Remove_Next -- -- Remove_Next --
----------------- -----------------
function Remove_Next (Node : Node_Id) return Node_Id is function Remove_Next
Nxt : constant Node_Id := Next (Node); (Node : Node_Or_Entity_Id) return Node_Or_Entity_Id
is
Nxt : constant Node_Or_Entity_Id := Next (Node);
procedure Remove_Next_Debug; procedure Remove_Next_Debug;
pragma Inline (Remove_Next_Debug); pragma Inline (Remove_Next_Debug);
...@@ -1318,8 +1347,8 @@ package body Nlists is ...@@ -1318,8 +1347,8 @@ package body Nlists is
begin begin
if Present (Nxt) then if Present (Nxt) then
declare declare
Nxt2 : constant Node_Id := Next (Nxt); Nxt2 : constant Node_Or_Entity_Id := Next (Nxt);
LC : constant List_Id := List_Containing (Node); LC : constant List_Id := List_Containing (Node);
begin begin
pragma Debug (Remove_Next_Debug); pragma Debug (Remove_Next_Debug);
...@@ -1343,7 +1372,7 @@ package body Nlists is ...@@ -1343,7 +1372,7 @@ package body Nlists is
-- Set_First -- -- Set_First --
--------------- ---------------
procedure Set_First (List : List_Id; To : Node_Id) is procedure Set_First (List : List_Id; To : Node_Or_Entity_Id) is
begin begin
Lists.Table (List).First := To; Lists.Table (List).First := To;
end Set_First; end Set_First;
...@@ -1352,7 +1381,7 @@ package body Nlists is ...@@ -1352,7 +1381,7 @@ package body Nlists is
-- Set_Last -- -- Set_Last --
-------------- --------------
procedure Set_Last (List : List_Id; To : Node_Id) is procedure Set_Last (List : List_Id; To : Node_Or_Entity_Id) is
begin begin
Lists.Table (List).Last := To; Lists.Table (List).Last := To;
end Set_Last; end Set_Last;
...@@ -1361,7 +1390,7 @@ package body Nlists is ...@@ -1361,7 +1390,7 @@ package body Nlists is
-- Set_List_Link -- -- Set_List_Link --
------------------- -------------------
procedure Set_List_Link (Node : Node_Id; To : List_Id) is procedure Set_List_Link (Node : Node_Or_Entity_Id; To : List_Id) is
begin begin
Nodes.Table (Node).Link := Union_Id (To); Nodes.Table (Node).Link := Union_Id (To);
end Set_List_Link; end Set_List_Link;
...@@ -1370,7 +1399,7 @@ package body Nlists is ...@@ -1370,7 +1399,7 @@ package body Nlists is
-- Set_Next -- -- Set_Next --
-------------- --------------
procedure Set_Next (Node : Node_Id; To : Node_Id) is procedure Set_Next (Node : Node_Or_Entity_Id; To : Node_Or_Entity_Id) is
begin begin
Next_Node.Table (Node) := To; Next_Node.Table (Node) := To;
end Set_Next; end Set_Next;
...@@ -1379,7 +1408,7 @@ package body Nlists is ...@@ -1379,7 +1408,7 @@ package body Nlists is
-- Set_Parent -- -- Set_Parent --
---------------- ----------------
procedure Set_Parent (List : List_Id; Node : Node_Id) is procedure Set_Parent (List : List_Id; Node : Node_Or_Entity_Id) is
begin begin
pragma Assert (List <= Lists.Last); pragma Assert (List <= Lists.Last);
Lists.Table (List).Parent := Node; Lists.Table (List).Parent := Node;
...@@ -1389,7 +1418,7 @@ package body Nlists is ...@@ -1389,7 +1418,7 @@ package body Nlists is
-- Set_Prev -- -- Set_Prev --
-------------- --------------
procedure Set_Prev (Node : Node_Id; To : Node_Id) is procedure Set_Prev (Node : Node_Or_Entity_Id; To : Node_Or_Entity_Id) is
begin begin
Prev_Node.Table (Node) := To; Prev_Node.Table (Node) := To;
end Set_Prev; end Set_Prev;
......
gcc/ada/nlists.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2010, 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- --
...@@ -49,6 +49,10 @@ package Nlists is ...@@ -49,6 +49,10 @@ package Nlists is
-- Note: node lists can contain either nodes or entities (extended nodes) -- Note: node lists can contain either nodes or entities (extended nodes)
-- or a mixture of nodes and extended nodes. -- or a mixture of nodes and extended nodes.
function In_Same_List (N1, N2 : Node_Or_Entity_Id) return Boolean;
pragma Inline (In_Same_List);
-- Equivalent to List_Containing (N1) = List_Containing (N2)
function Last_List_Id return List_Id; function Last_List_Id return List_Id;
pragma Inline (Last_List_Id); pragma Inline (Last_List_Id);
-- Returns Id of last allocated list header -- Returns Id of last allocated list header
...@@ -70,33 +74,42 @@ package Nlists is ...@@ -70,33 +74,42 @@ package Nlists is
-- Used in contexts where an empty list (as opposed to an initially empty -- Used in contexts where an empty list (as opposed to an initially empty
-- list to be filled in) is required. -- list to be filled in) is required.
function New_List (Node : Node_Id) return List_Id; function New_List
(Node : Node_Or_Entity_Id) return List_Id;
-- Build a new list initially containing the given node -- Build a new list initially containing the given node
function New_List (Node1, Node2 : Node_Id) return List_Id; function New_List
(Node1 : Node_Or_Entity_Id;
Node2 : Node_Or_Entity_Id) return List_Id;
-- Build a new list initially containing the two given nodes -- Build a new list initially containing the two given nodes
function New_List (Node1, Node2, Node3 : Node_Id) return List_Id; function New_List
(Node1 : Node_Or_Entity_Id;
Node2 : Node_Or_Entity_Id;
Node3 : Node_Or_Entity_Id) return List_Id;
-- Build a new list initially containing the three given nodes -- Build a new list initially containing the three given nodes
function New_List (Node1, Node2, Node3, Node4 : Node_Id) return List_Id; function New_List
-- Build a new list initially containing the four given nodes (Node1 : Node_Or_Entity_Id;
Node2 : Node_Or_Entity_Id;
Node3 : Node_Or_Entity_Id;
Node4 : Node_Or_Entity_Id) return List_Id;
function New_List function New_List
(Node1 : Node_Id; (Node1 : Node_Or_Entity_Id;
Node2 : Node_Id; Node2 : Node_Or_Entity_Id;
Node3 : Node_Id; Node3 : Node_Or_Entity_Id;
Node4 : Node_Id; Node4 : Node_Or_Entity_Id;
Node5 : Node_Id) return List_Id; Node5 : Node_Or_Entity_Id) return List_Id;
-- Build a new list initially containing the five given nodes -- Build a new list initially containing the five given nodes
function New_List function New_List
(Node1 : Node_Id; (Node1 : Node_Or_Entity_Id;
Node2 : Node_Id; Node2 : Node_Or_Entity_Id;
Node3 : Node_Id; Node3 : Node_Or_Entity_Id;
Node4 : Node_Id; Node4 : Node_Or_Entity_Id;
Node5 : Node_Id; Node5 : Node_Or_Entity_Id;
Node6 : Node_Id) return List_Id; Node6 : Node_Or_Entity_Id) return List_Id;
-- Build a new list initially containing the six given nodes -- Build a new list initially containing the six given nodes
function New_Copy_List (List : List_Id) return List_Id; function New_Copy_List (List : List_Id) return List_Id;
...@@ -108,12 +121,12 @@ package Nlists is ...@@ -108,12 +121,12 @@ package Nlists is
function New_Copy_List_Original (List : List_Id) return List_Id; function New_Copy_List_Original (List : List_Id) return List_Id;
-- Same as New_Copy_List but copies only nodes coming from source -- Same as New_Copy_List but copies only nodes coming from source
function First (List : List_Id) return Node_Id; function First (List : List_Id) return Node_Or_Entity_Id;
pragma Inline (First); pragma Inline (First);
-- Obtains the first element of the given node list or, if the node list -- Obtains the first element of the given node list or, if the node list
-- has no items or is equal to No_List, then Empty is returned. -- has no items or is equal to No_List, then Empty is returned.
function First_Non_Pragma (List : List_Id) return Node_Id; function First_Non_Pragma (List : List_Id) return Node_Or_Entity_Id;
-- Used when dealing with a list that can contain pragmas to skip past -- Used when dealing with a list that can contain pragmas to skip past
-- any initial pragmas and return the first element that is not a pragma. -- any initial pragmas and return the first element that is not a pragma.
-- If the list is empty, or if it contains only pragmas, then Empty is -- If the list is empty, or if it contains only pragmas, then Empty is
...@@ -122,14 +135,14 @@ package Nlists is ...@@ -122,14 +135,14 @@ package Nlists is
-- This function also skips N_Null nodes which can result from rewriting -- This function also skips N_Null nodes which can result from rewriting
-- unrecognized or incorrect pragmas. -- unrecognized or incorrect pragmas.
function Last (List : List_Id) return Node_Id; function Last (List : List_Id) return Node_Or_Entity_Id;
pragma Inline (Last); pragma Inline (Last);
-- Obtains the last element of the given node list or, if the node list -- Obtains the last element of the given node list or, if the node list
-- has no items, then Empty is returned. It is an error to call Last with -- has no items, then Empty is returned. It is an error to call Last with
-- a Node_Id or No_List. (No_List is not considered to be the same as an -- a Node_Id or No_List. (No_List is not considered to be the same as an
-- empty node list). -- empty node list).
function Last_Non_Pragma (List : List_Id) return Node_Id; function Last_Non_Pragma (List : List_Id) return Node_Or_Entity_Id;
-- Obtains the last element of a given node list that is not a pragma. -- Obtains the last element of a given node list that is not a pragma.
-- If the list is empty, or if it contains only pragmas, then Empty is -- If the list is empty, or if it contains only pragmas, then Empty is
-- returned. It is an error to call Last_Non_Pragma with a Node_Id or -- returned. It is an error to call Last_Non_Pragma with a Node_Id or
...@@ -141,42 +154,44 @@ package Nlists is ...@@ -141,42 +154,44 @@ package Nlists is
-- this function with No_List (No_List is not considered to be the same -- this function with No_List (No_List is not considered to be the same
-- as an empty list). -- as an empty list).
function Next (Node : Node_Id) return Node_Id; function Next (Node : Node_Or_Entity_Id) return Node_Or_Entity_Id;
pragma Inline (Next); pragma Inline (Next);
-- This function returns the next node on a node list, or Empty if Node is -- This function returns the next node on a node list, or Empty if Node is
-- the last element of the node list. The argument must be a member of a -- the last element of the node list. The argument must be a member of a
-- node list. -- node list.
procedure Next (Node : in out Node_Id); procedure Next (Node : in out Node_Or_Entity_Id);
pragma Inline (Next); pragma Inline (Next);
-- Equivalent to Node := Next (Node); -- Equivalent to Node := Next (Node);
function Next_Non_Pragma (Node : Node_Id) return Node_Id; function Next_Non_Pragma
(Node : Node_Or_Entity_Id) return Node_Or_Entity_Id;
-- This function returns the next node on a node list, skipping past any -- This function returns the next node on a node list, skipping past any
-- pragmas, or Empty if there is no non-pragma entry left. The argument -- pragmas, or Empty if there is no non-pragma entry left. The argument
-- must be a member of a node list. This function also skips N_Null nodes -- must be a member of a node list. This function also skips N_Null nodes
-- which can result from rewriting unrecognized or incorrect pragmas. -- which can result from rewriting unrecognized or incorrect pragmas.
procedure Next_Non_Pragma (Node : in out Node_Id); procedure Next_Non_Pragma (Node : in out Node_Or_Entity_Id);
pragma Inline (Next_Non_Pragma); pragma Inline (Next_Non_Pragma);
-- Equivalent to Node := Next_Non_Pragma (Node); -- Equivalent to Node := Next_Non_Pragma (Node);
function Prev (Node : Node_Id) return Node_Id; function Prev (Node : Node_Or_Entity_Id) return Node_Or_Entity_Id;
pragma Inline (Prev); pragma Inline (Prev);
-- This function returns the previous node on a node list, or Empty -- This function returns the previous node on a node list, or Empty
-- if Node is the first element of the node list. The argument must be -- if Node is the first element of the node list. The argument must be
-- a member of a node list. Note: the implementation does maintain back -- a member of a node list. Note: the implementation does maintain back
-- pointers, so this function executes quickly in constant time. -- pointers, so this function executes quickly in constant time.
function Pick (List : List_Id; Index : Pos) return Node_Id; function Pick (List : List_Id; Index : Pos) return Node_Or_Entity_Id;
-- Given a list, picks out the Index'th entry (1 = first entry). The -- Given a list, picks out the Index'th entry (1 = first entry). The
-- caller must ensure that Index is in range. -- caller must ensure that Index is in range.
procedure Prev (Node : in out Node_Id); procedure Prev (Node : in out Node_Or_Entity_Id);
pragma Inline (Prev); pragma Inline (Prev);
-- Equivalent to Node := Prev (Node); -- Equivalent to Node := Prev (Node);
function Prev_Non_Pragma (Node : Node_Id) return Node_Id; function Prev_Non_Pragma
(Node : Node_Or_Entity_Id) return Node_Or_Entity_Id;
pragma Inline (Prev_Non_Pragma); pragma Inline (Prev_Non_Pragma);
-- This function returns the previous node on a node list, skipping any -- This function returns the previous node on a node list, skipping any
-- pragmas. If Node is the first element of the list, or if the only -- pragmas. If Node is the first element of the list, or if the only
...@@ -185,7 +200,7 @@ package Nlists is ...@@ -185,7 +200,7 @@ package Nlists is
-- does maintain back pointers, so this function executes quickly in -- does maintain back pointers, so this function executes quickly in
-- constant time. -- constant time.
procedure Prev_Non_Pragma (Node : in out Node_Id); procedure Prev_Non_Pragma (Node : in out Node_Or_Entity_Id);
pragma Inline (Prev_Non_Pragma); pragma Inline (Prev_Non_Pragma);
-- Equivalent to Node := Prev_Non_Pragma (Node); -- Equivalent to Node := Prev_Non_Pragma (Node);
...@@ -199,23 +214,23 @@ package Nlists is ...@@ -199,23 +214,23 @@ package Nlists is
-- This function determines if a given list id references a node list that -- This function determines if a given list id references a node list that
-- contains at least one item. No_List as an argument returns False. -- contains at least one item. No_List as an argument returns False.
function Is_List_Member (Node : Node_Id) return Boolean; function Is_List_Member (Node : Node_Or_Entity_Id) return Boolean;
pragma Inline (Is_List_Member); pragma Inline (Is_List_Member);
-- This function determines if a given node is a member of a node list. -- This function determines if a given node is a member of a node list.
-- It is an error for Node to be Empty, or to be a node list. -- It is an error for Node to be Empty, or to be a node list.
function List_Containing (Node : Node_Id) return List_Id; function List_Containing (Node : Node_Or_Entity_Id) return List_Id;
pragma Inline (List_Containing); pragma Inline (List_Containing);
-- This function provides a pointer to the node list containing Node. -- This function provides a pointer to the node list containing Node.
-- Node must be a member of a node list. -- Node must be a member of a node list.
procedure Append (Node : Node_Id; To : List_Id); procedure Append (Node : Node_Or_Entity_Id; To : List_Id);
-- Appends Node at the end of node list To. Node must be a non-empty node -- Appends Node at the end of node list To. Node must be a non-empty node
-- that is not already a member of a node list, and To must be a -- that is not already a member of a node list, and To must be a
-- node list. An attempt to append an error node is ignored without -- node list. An attempt to append an error node is ignored without
-- complaint and the list is unchanged. -- complaint and the list is unchanged.
procedure Append_To (To : List_Id; Node : Node_Id); procedure Append_To (To : List_Id; Node : Node_Or_Entity_Id);
pragma Inline (Append_To); pragma Inline (Append_To);
-- Like Append, but arguments are the other way round -- Like Append, but arguments are the other way round
...@@ -227,56 +242,72 @@ package Nlists is ...@@ -227,56 +242,72 @@ package Nlists is
pragma Inline (Append_List_To); pragma Inline (Append_List_To);
-- Like Append_List, but arguments are the other way round -- Like Append_List, but arguments are the other way round
procedure Insert_After (After : Node_Id; Node : Node_Id); procedure Insert_After
(After : Node_Or_Entity_Id;
Node : Node_Or_Entity_Id);
-- Insert Node, which must be a non-empty node that is not already a -- Insert Node, which must be a non-empty node that is not already a
-- member of a node list, immediately past node After, which must be a -- member of a node list, immediately past node After, which must be a
-- node that is currently a member of a node list. An attempt to insert -- node that is currently a member of a node list. An attempt to insert
-- an error node is ignored without complaint (and the list is unchanged). -- an error node is ignored without complaint (and the list is unchanged).
procedure Insert_List_After (After : Node_Id; List : List_Id); procedure Insert_List_After
(After : Node_Or_Entity_Id;
List : List_Id);
-- Inserts the entire contents of node list List immediately after node -- Inserts the entire contents of node list List immediately after node
-- After, which must be a member of a node list. On return, the node list -- After, which must be a member of a node list. On return, the node list
-- List is reset to be the empty node list. -- List is reset to be the empty node list.
procedure Insert_Before (Before : Node_Id; Node : Node_Id); procedure Insert_Before
(Before : Node_Or_Entity_Id;
Node : Node_Or_Entity_Id);
-- Insert Node, which must be a non-empty node that is not already a -- Insert Node, which must be a non-empty node that is not already a
-- member of a node list, immediately before Before, which must be a node -- member of a node list, immediately before Before, which must be a node
-- that is currently a member of a node list. An attempt to insert an -- that is currently a member of a node list. An attempt to insert an
-- error node is ignored without complaint (and the list is unchanged). -- error node is ignored without complaint (and the list is unchanged).
procedure Insert_List_Before (Before : Node_Id; List : List_Id); procedure Insert_List_Before
(Before : Node_Or_Entity_Id;
List : List_Id);
-- Inserts the entire contents of node list List immediately before node -- Inserts the entire contents of node list List immediately before node
-- Before, which must be a member of a node list. On return, the node list -- Before, which must be a member of a node list. On return, the node list
-- List is reset to be the empty node list. -- List is reset to be the empty node list.
procedure Prepend (Node : Node_Id; To : List_Id); procedure Prepend
(Node : Node_Or_Entity_Id;
To : List_Id);
-- Prepends Node at the start of node list To. Node must be a non-empty -- Prepends Node at the start of node list To. Node must be a non-empty
-- node that is not already a member of a node list, and To must be a -- node that is not already a member of a node list, and To must be a
-- node list. An attempt to prepend an error node is ignored without -- node list. An attempt to prepend an error node is ignored without
-- complaint and the list is unchanged. -- complaint and the list is unchanged.
procedure Prepend_To (To : List_Id; Node : Node_Id); procedure Prepend_To
(To : List_Id;
Node : Node_Or_Entity_Id);
pragma Inline (Prepend_To); pragma Inline (Prepend_To);
-- Like Prepend, but arguments are the other way round -- Like Prepend, but arguments are the other way round
procedure Prepend_List (List : List_Id; To : List_Id); procedure Prepend_List
(List : List_Id;
To : List_Id);
-- Prepends node list List to the start of node list To. On return, -- Prepends node list List to the start of node list To. On return,
-- List is reset to be empty. -- List is reset to be empty.
procedure Prepend_List_To (To : List_Id; List : List_Id); procedure Prepend_List_To
(To : List_Id;
List : List_Id);
pragma Inline (Prepend_List_To); pragma Inline (Prepend_List_To);
-- Like Prepend_List, but arguments are the other way round -- Like Prepend_List, but arguments are the other way round
procedure Remove (Node : Node_Id); procedure Remove (Node : Node_Or_Entity_Id);
-- Removes Node, which must be a node that is a member of a node list, -- Removes Node, which must be a node that is a member of a node list,
-- from this node list. The contents of Node are not otherwise affected. -- from this node list. The contents of Node are not otherwise affected.
function Remove_Head (List : List_Id) return Node_Id; function Remove_Head (List : List_Id) return Node_Or_Entity_Id;
-- Removes the head element of a node list, and returns the node (whose -- Removes the head element of a node list, and returns the node (whose
-- contents are not otherwise affected) as the result. If the node list -- contents are not otherwise affected) as the result. If the node list
-- is empty, then Empty is returned. -- is empty, then Empty is returned.
function Remove_Next (Node : Node_Id) return Node_Id; function Remove_Next (Node : Node_Or_Entity_Id) return Node_Or_Entity_Id;
-- Removes the item immediately following the given node, and returns it -- Removes the item immediately following the given node, and returns it
-- as the result. If Node is the last element of the list, then Empty is -- as the result. If Node is the last element of the list, then Empty is
-- returned. Node must be a member of a list. Unlike Remove, Remove_Next -- returned. Node must be a member of a list. Unlike Remove, Remove_Next
...@@ -302,13 +333,13 @@ package Nlists is ...@@ -302,13 +333,13 @@ package Nlists is
-- Writes out internal tables to current tree file using the relevant -- Writes out internal tables to current tree file using the relevant
-- Table.Tree_Write routines. -- Table.Tree_Write routines.
function Parent (List : List_Id) return Node_Id; function Parent (List : List_Id) return Node_Or_Entity_Id;
pragma Inline (Parent); pragma Inline (Parent);
-- Node lists may have a parent in the same way as a node. The function -- Node lists may have a parent in the same way as a node. The function
-- accesses the Parent value, which is either Empty when a list header -- accesses the Parent value, which is either Empty when a list header
-- is first created, or the value that has been set by Set_Parent. -- is first created, or the value that has been set by Set_Parent.
procedure Set_Parent (List : List_Id; Node : Node_Id); procedure Set_Parent (List : List_Id; Node : Node_Or_Entity_Id);
pragma Inline (Set_Parent); pragma Inline (Set_Parent);
-- Sets the parent field of the given list to reference the given node -- Sets the parent field of the given list to reference the given node
...@@ -322,7 +353,7 @@ package Nlists is ...@@ -322,7 +353,7 @@ package Nlists is
-- Tests given Id for inequality with No_List. This allows notations like -- Tests given Id for inequality with No_List. This allows notations like
-- "if Present (Statements)" as opposed to "if Statements /= No_List". -- "if Present (Statements)" as opposed to "if Statements /= No_List".
procedure Allocate_List_Tables (N : Node_Id); procedure Allocate_List_Tables (N : Node_Or_Entity_Id);
-- Called when nodes table is expanded to include node N. This call -- Called when nodes table is expanded to include node N. This call
-- makes sure that list structures internal to Nlists are adjusted -- makes sure that list structures internal to Nlists are adjusted
-- appropriately to reflect this increase in the size of the nodes table. -- appropriately to reflect this increase in the size of the nodes table.
...@@ -332,7 +363,7 @@ package Nlists is ...@@ -332,7 +363,7 @@ package Nlists is
-- These functions return the addresses of the Next_Node and Prev_Node -- These functions return the addresses of the Next_Node and Prev_Node
-- tables (used in Back_End for Gigi). -- tables (used in Back_End for Gigi).
function p (U : Union_Id) return Node_Id; function p (U : Union_Id) return Node_Or_Entity_Id;
-- This function is intended for use from the debugger, it determines -- This function is intended for use from the debugger, it determines
-- whether U is a Node_Id or List_Id, and calls the appropriate Parent -- whether U is a Node_Id or List_Id, and calls the appropriate Parent
-- function and returns the parent Node in either case. This is shorter -- function and returns the parent Node in either case. This is shorter
......
gcc/ada/par-ch5.adb
...@@ -334,10 +334,10 @@ package body Ch5 is ...@@ -334,10 +334,10 @@ package body Ch5 is
when Tok_Exception => when Tok_Exception =>
Test_Statement_Required; Test_Statement_Required;
-- If Extm not set and the exception is not to the left -- If Extm not set and the exception is not to the left of
-- of the expected column of the end for this sequence, then -- the expected column of the end for this sequence, then we
-- we assume it belongs to the current sequence, even though -- assume it belongs to the current sequence, even though it
-- it is not permitted. -- is not permitted.
if not SS_Flags.Extm and then if not SS_Flags.Extm and then
Start_Column >= Scope.Table (Scope.Last).Ecol Start_Column >= Scope.Table (Scope.Last).Ecol
...@@ -350,7 +350,7 @@ package body Ch5 is ...@@ -350,7 +350,7 @@ package body Ch5 is
-- Always return, in the case where we scanned out handlers -- Always return, in the case where we scanned out handlers
-- that we did not expect, Parse_Exception_Handlers returned -- that we did not expect, Parse_Exception_Handlers returned
-- with Token being either end or EOF, so we are OK -- with Token being either end or EOF, so we are OK.
exit; exit;
...@@ -358,8 +358,8 @@ package body Ch5 is ...@@ -358,8 +358,8 @@ package body Ch5 is
when Tok_Or => when Tok_Or =>
-- Terminate if Ortm set or if the or is to the left -- Terminate if Ortm set or if the or is to the left of the
-- of the expected column of the end for this sequence -- expected column of the end for this sequence.
if SS_Flags.Ortm if SS_Flags.Ortm
or else Start_Column < Scope.Table (Scope.Last).Ecol or else Start_Column < Scope.Table (Scope.Last).Ecol
...@@ -385,9 +385,9 @@ package body Ch5 is ...@@ -385,9 +385,9 @@ package body Ch5 is
exit when SS_Flags.Tatm and then Token = Tok_Abort; exit when SS_Flags.Tatm and then Token = Tok_Abort;
-- Otherwise we treat THEN as some kind of mess where we -- Otherwise we treat THEN as some kind of mess where we did
-- did not see the associated IF, but we pick up assuming -- not see the associated IF, but we pick up assuming it had
-- it had been there! -- been there!
Restore_Scan_State (Scan_State); -- to THEN Restore_Scan_State (Scan_State); -- to THEN
Append_To (Statement_List, P_If_Statement); Append_To (Statement_List, P_If_Statement);
...@@ -397,8 +397,8 @@ package body Ch5 is ...@@ -397,8 +397,8 @@ package body Ch5 is
when Tok_When | Tok_Others => when Tok_When | Tok_Others =>
-- Terminate if Whtm set or if the WHEN is to the left -- Terminate if Whtm set or if the WHEN is to the left of
-- of the expected column of the end for this sequence -- the expected column of the end for this sequence.
if SS_Flags.Whtm if SS_Flags.Whtm
or else Start_Column < Scope.Table (Scope.Last).Ecol or else Start_Column < Scope.Table (Scope.Last).Ecol
......
gcc/ada/par-labl.adb
...@@ -378,12 +378,10 @@ procedure Labl is ...@@ -378,12 +378,10 @@ procedure Labl is
-- If the label and the goto are both in the same statement -- If the label and the goto are both in the same statement
-- list, then we've found a loop. Note that labels and goto -- list, then we've found a loop. Note that labels and goto
-- statements are always part of some list, so -- statements are always part of some list, so In_Same_List
-- List_Containing always makes sense. -- always makes sense.
if List_Containing (Node (N)) = if In_Same_List (Node (N), Node (S1)) then
List_Containing (Node (S1))
then
Source := S1; Source := S1;
Found := True; Found := True;
......
gcc/ada/restrict.adb
...@@ -25,6 +25,7 @@ ...@@ -25,6 +25,7 @@
with Atree; use Atree; with Atree; use Atree;
with Casing; use Casing; with Casing; use Casing;
with Einfo; use Einfo;
with Errout; use Errout; with Errout; use Errout;
with Debug; use Debug; with Debug; use Debug;
with Fname; use Fname; with Fname; use Fname;
...@@ -396,6 +397,29 @@ package body Restrict is ...@@ -396,6 +397,29 @@ package body Restrict is
end loop; end loop;
end Check_Restriction_No_Dependence; end Check_Restriction_No_Dependence;
--------------------------------------
-- Check_Wide_Character_Restriction --
--------------------------------------
procedure Check_Wide_Character_Restriction (E : Entity_Id; N : Node_Id) is
begin
if Restriction_Active (No_Wide_Characters)
and then Comes_From_Source (N)
then
declare
T : constant Entity_Id := Root_Type (E);
begin
if T = Standard_Wide_Character or else
T = Standard_Wide_String or else
T = Standard_Wide_Wide_Character or else
T = Standard_Wide_Wide_String
then
Check_Restriction (No_Wide_Characters, N);
end if;
end;
end if;
end Check_Wide_Character_Restriction;
---------------------------------------- ----------------------------------------
-- Cunit_Boolean_Restrictions_Restore -- -- Cunit_Boolean_Restrictions_Restore --
---------------------------------------- ----------------------------------------
......
gcc/ada/restrict.ads
...@@ -239,6 +239,12 @@ package Restrict is ...@@ -239,6 +239,12 @@ package Restrict is
-- mechanism (e.g. a special pragma) to handle this case, but there are -- mechanism (e.g. a special pragma) to handle this case, but there are
-- only six cases, and it is not worth the effort to do something general. -- only six cases, and it is not worth the effort to do something general.
procedure Check_Wide_Character_Restriction (E : Entity_Id; N : Node_Id);
-- This procedure checks if the No_Wide_Character restriction is active,
-- and if so, if N Comes_From_Source, and the root type of E is one of
-- [Wide_]Wide_Character or [Wide_]Wide_String, then the restriction
-- violation is recorded, and an appropriate message given.
function Cunit_Boolean_Restrictions_Save function Cunit_Boolean_Restrictions_Save
return Save_Cunit_Boolean_Restrictions; return Save_Cunit_Boolean_Restrictions;
-- This function saves the compilation unit restriction settings, and -- This function saves the compilation unit restriction settings, and
......
gcc/ada/sem_ch3.adb
...@@ -2960,13 +2960,7 @@ package body Sem_Ch3 is ...@@ -2960,13 +2960,7 @@ package body Sem_Ch3 is
-- Check No_Wide_Characters restriction -- Check No_Wide_Characters restriction
if T = Standard_Wide_Character Check_Wide_Character_Restriction (T, Object_Definition (N));
or else T = Standard_Wide_Wide_Character
or else Root_Type (T) = Standard_Wide_String
or else Root_Type (T) = Standard_Wide_Wide_String
then
Check_Restriction (No_Wide_Characters, Object_Definition (N));
end if;
-- Indicate this is not set in source. Certainly true for constants, -- Indicate this is not set in source. Certainly true for constants,
-- and true for variables so far (will be reset for a variable if and -- and true for variables so far (will be reset for a variable if and
...@@ -13677,8 +13671,20 @@ package body Sem_Ch3 is ...@@ -13677,8 +13671,20 @@ package body Sem_Ch3 is
Generate_Definition (L); Generate_Definition (L);
Set_Convention (L, Convention_Intrinsic); Set_Convention (L, Convention_Intrinsic);
-- Case of character literal
if Nkind (L) = N_Defining_Character_Literal then if Nkind (L) = N_Defining_Character_Literal then
Set_Is_Character_Type (T, True); Set_Is_Character_Type (T, True);
-- Check violation of No_Wide_Characters
if Restriction_Active (No_Wide_Characters) then
Get_Name_String (Chars (L));
if Name_Len >= 3 and then Name_Buffer (1 .. 2) = "QW" then
Check_Restriction (No_Wide_Characters, L);
end if;
end if;
end if; end if;
Ev := Ev + 1; Ev := Ev + 1;
...@@ -14211,13 +14217,7 @@ package body Sem_Ch3 is ...@@ -14211,13 +14217,7 @@ package body Sem_Ch3 is
-- Check No_Wide_Characters restriction -- Check No_Wide_Characters restriction
if Typ = Standard_Wide_Character Check_Wide_Character_Restriction (Typ, S);
or else Typ = Standard_Wide_Wide_Character
or else Typ = Standard_Wide_String
or else Typ = Standard_Wide_Wide_String
then
Check_Restriction (No_Wide_Characters, S);
end if;
return Typ; return Typ;
end Find_Type_Of_Subtype_Indic; end Find_Type_Of_Subtype_Indic;
......
gcc/ada/sem_ch6.adb
...@@ -1638,9 +1638,7 @@ package body Sem_Ch6 is ...@@ -1638,9 +1638,7 @@ package body Sem_Ch6 is
if Present (Prag) then if Present (Prag) then
if Present (Spec_Id) then if Present (Spec_Id) then
if List_Containing (N) = if In_Same_List (N, Unit_Declaration_Node (Spec_Id)) then
List_Containing (Unit_Declaration_Node (Spec_Id))
then
Analyze (Prag); Analyze (Prag);
end if; end if;
...@@ -1649,10 +1647,12 @@ package body Sem_Ch6 is ...@@ -1649,10 +1647,12 @@ package body Sem_Ch6 is
declare declare
Subp : constant Entity_Id := Subp : constant Entity_Id :=
Make_Defining_Identifier (Loc, Chars (Body_Id)); Make_Defining_Identifier (Loc, Chars (Body_Id));
Decl : constant Node_Id := Decl : constant Node_Id :=
Make_Subprogram_Declaration (Loc, Make_Subprogram_Declaration (Loc,
Specification => New_Copy_Tree (Specification (N))); Specification =>
New_Copy_Tree (Specification (N)));
begin begin
Set_Defining_Unit_Name (Specification (Decl), Subp); Set_Defining_Unit_Name (Specification (Decl), Subp);
...@@ -7993,9 +7993,7 @@ package body Sem_Ch6 is ...@@ -7993,9 +7993,7 @@ package body Sem_Ch6 is
("equality operator must be declared " ("equality operator must be declared "
& "before type& is frozen", S, Typ); & "before type& is frozen", S, Typ);
elsif List_Containing (Parent (Typ)) elsif not In_Same_List (Parent (Typ), Decl)
/=
List_Containing (Decl)
and then not Is_Limited_Type (Typ) and then not Is_Limited_Type (Typ)
then then
Error_Msg_N Error_Msg_N
......
gcc/ada/sem_ch8.adb
...@@ -454,8 +454,9 @@ package body Sem_Ch8 is ...@@ -454,8 +454,9 @@ package body Sem_Ch8 is
-- private with on E. -- private with on E.
procedure Find_Expanded_Name (N : Node_Id); procedure Find_Expanded_Name (N : Node_Id);
-- Selected component is known to be expanded name. Verify legality of -- The input is a selected component is known to be expanded name. Verify
-- selector given the scope denoted by prefix. -- legality of selector given the scope denoted by prefix, and change node
-- N into a expanded name with a properly set Entity field.
function Find_Renamed_Entity function Find_Renamed_Entity
(N : Node_Id; (N : Node_Id;
...@@ -4411,6 +4412,10 @@ package body Sem_Ch8 is ...@@ -4411,6 +4412,10 @@ package body Sem_Ch8 is
<<Found>> begin <<Found>> begin
-- Check violation of No_Wide_Characters restriction
Check_Wide_Character_Restriction (E, N);
-- When distribution features are available (Get_PCS_Name /= -- When distribution features are available (Get_PCS_Name /=
-- Name_No_DSA), a remote access-to-subprogram type is converted -- Name_No_DSA), a remote access-to-subprogram type is converted
-- into a record type holding whatever information is needed to -- into a record type holding whatever information is needed to
...@@ -4960,6 +4965,10 @@ package body Sem_Ch8 is ...@@ -4960,6 +4965,10 @@ package body Sem_Ch8 is
Set_Etype (N, Get_Full_View (Etype (Id))); Set_Etype (N, Get_Full_View (Etype (Id)));
end if; end if;
-- Check for violation of No_Wide_Characters
Check_Wide_Character_Restriction (Id, N);
-- If the Ekind of the entity is Void, it means that all homonyms are -- If the Ekind of the entity is Void, it means that all homonyms are
-- hidden from all visibility (RM 8.3(5,14-20)). -- hidden from all visibility (RM 8.3(5,14-20)).
...@@ -7330,8 +7339,8 @@ package body Sem_Ch8 is ...@@ -7330,8 +7339,8 @@ package body Sem_Ch8 is
and then Scope (Id) /= Scope (Prev) and then Scope (Id) /= Scope (Prev)
and then Used_As_Generic_Actual (Scope (Prev)) and then Used_As_Generic_Actual (Scope (Prev))
and then Used_As_Generic_Actual (Scope (Id)) and then Used_As_Generic_Actual (Scope (Id))
and then List_Containing (Current_Use_Clause (Scope (Prev))) /= and then not In_Same_List (Current_Use_Clause (Scope (Prev)),
List_Containing (Current_Use_Clause (Scope (Id))) Current_Use_Clause (Scope (Id)))
then then
Set_Is_Potentially_Use_Visible (Prev, False); Set_Is_Potentially_Use_Visible (Prev, False);
Append_Elmt (Prev, Hidden_By_Use_Clause (N)); Append_Elmt (Prev, Hidden_By_Use_Clause (N));
......
gcc/ada/sem_type.adb
...@@ -1866,6 +1866,7 @@ package body Sem_Type is ...@@ -1866,6 +1866,7 @@ package body Sem_Type is
then then
declare declare
Opnd : Node_Id; Opnd : Node_Id;
begin begin
if Nkind (N) = N_Function_Call then if Nkind (N) = N_Function_Call then
Opnd := First_Actual (N); Opnd := First_Actual (N);
...@@ -1875,8 +1876,8 @@ package body Sem_Type is ...@@ -1875,8 +1876,8 @@ package body Sem_Type is
if Ekind (Etype (Opnd)) = E_Anonymous_Access_Type if Ekind (Etype (Opnd)) = E_Anonymous_Access_Type
and then and then
List_Containing (Parent (Designated_Type (Etype (Opnd)))) In_Same_List (Parent (Designated_Type (Etype (Opnd))),
= List_Containing (Unit_Declaration_Node (User_Subp)) Unit_Declaration_Node (User_Subp))
then then
if It2.Nam = Predef_Subp then if It2.Nam = Predef_Subp then
return It1; return It1;
......
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