-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2004 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- --
-- Local Subprograms --
-----------------------
- procedure Prepend_Debug (Node : Node_Id; To : List_Id);
- pragma Inline (Prepend_Debug);
- -- Output debug information if Debug_Flag_N set
-
- procedure Remove_Next_Debug (Node : Node_Id);
- pragma Inline (Remove_Next_Debug);
- -- Output debug information if Debug_Flag_N set
-
procedure Set_First (List : List_Id; To : Node_Id);
pragma Inline (Set_First);
-- Sets First field of list header List to reference To
pragma Inline (Append_Debug);
-- Output debug information if Debug_Flag_N set
+ ------------------
+ -- Append_Debug --
+ ------------------
+
procedure Append_Debug is
begin
if Debug_Flag_N then
pragma Inline (Append_List_Debug);
-- Output debug information if Debug_Flag_N set
+ -----------------------
+ -- Append_List_Debug --
+ -----------------------
+
procedure Append_List_Debug is
begin
if Debug_Flag_N then
-- First --
-----------
- -- This subprogram is deliberately placed early on, out of alphabetical
- -- order, so that it can be properly inlined from within this unit.
-
function First (List : List_Id) return Node_Id is
begin
if List = No_List then
pragma Inline (Insert_After_Debug);
-- Output debug information if Debug_Flag_N set
+ ------------------------
+ -- Insert_After_Debug --
+ ------------------------
+
procedure Insert_After_Debug is
begin
if Debug_Flag_N then
pragma Inline (Insert_Before_Debug);
-- Output debug information if Debug_Flag_N set
+ -------------------------
+ -- Insert_Before_Debug --
+ -------------------------
+
procedure Insert_Before_Debug is
begin
if Debug_Flag_N then
pragma Inline (Insert_List_After_Debug);
-- Output debug information if Debug_Flag_N set
+ -----------------------------
+ -- Insert_List_After_Debug --
+ -----------------------------
+
procedure Insert_List_After_Debug is
begin
if Debug_Flag_N then
pragma Inline (Insert_List_Before_Debug);
-- Output debug information if Debug_Flag_N set
+ ------------------------------
+ -- Insert_List_Before_Debug --
+ ------------------------------
+
procedure Insert_List_Before_Debug is
begin
if Debug_Flag_N then
-- Last --
----------
- -- This subprogram is deliberately placed early on, out of alphabetical
- -- order, so that it can be properly inlined from within this unit.
-
function Last (List : List_Id) return Node_Id is
begin
pragma Assert (List in First_List_Id .. Lists.Last);
pragma Inline (New_List_Debug);
-- Output debugging information if Debug_Flag_N is set
+ --------------------
+ -- New_List_Debug --
+ --------------------
+
procedure New_List_Debug is
begin
if Debug_Flag_N then
pragma Inline (New_List_Debug);
-- Output debugging information if Debug_Flag_N is set
+ --------------------
+ -- New_List_Debug --
+ --------------------
+
procedure New_List_Debug is
begin
if Debug_Flag_N then
function New_List (Node1, Node2 : Node_Id) return List_Id is
L : constant List_Id := New_List (Node1);
-
begin
Append (Node2, L);
return L;
function New_List (Node1, Node2, Node3 : Node_Id) return List_Id is
L : constant List_Id := New_List (Node1);
-
begin
Append (Node2, L);
Append (Node3, L);
function New_List (Node1, Node2, Node3, Node4 : Node_Id) return List_Id is
L : constant List_Id := New_List (Node1);
-
begin
Append (Node2, L);
Append (Node3, L);
Node2 : Node_Id;
Node3 : Node_Id;
Node4 : Node_Id;
- Node5 : Node_Id)
- return List_Id
+ Node5 : Node_Id) return List_Id
is
L : constant List_Id := New_List (Node1);
-
begin
Append (Node2, L);
Append (Node3, L);
Node3 : Node_Id;
Node4 : Node_Id;
Node5 : Node_Id;
- Node6 : Node_Id)
- return List_Id
+ Node6 : Node_Id) return List_Id
is
L : constant List_Id := New_List (Node1);
-
begin
Append (Node2, L);
Append (Node3, L);
-- Next --
----------
- -- This subprogram is deliberately placed early on, out of alphabetical
- -- order, so that it can be properly inlined from within this unit.
-
function Next (Node : Node_Id) return Node_Id is
begin
pragma Assert (Is_List_Member (Node));
loop
N := Next (N);
exit when Nkind (N) /= N_Pragma
- and then
+ and then
Nkind (N) /= N_Null_Statement;
end loop;
-- No --
--------
- -- This subprogram is deliberately placed early on, out of alphabetical
- -- order, so that it can be properly inlined from within this unit.
-
function No (List : List_Id) return Boolean is
begin
return List = No_List;
begin
if U in Node_Range then
return Parent (Node_Id (U));
-
elsif U in List_Range then
return Parent (List_Id (U));
-
else
return 99_999_999;
end if;
procedure Prepend (Node : Node_Id; To : List_Id) is
F : constant Node_Id := First (To);
+ procedure Prepend_Debug;
+ pragma Inline (Prepend_Debug);
+ -- Output debug information if Debug_Flag_N set
+
+ -------------------
+ -- Prepend_Debug --
+ -------------------
+
+ procedure Prepend_Debug is
+ begin
+ if Debug_Flag_N then
+ Write_Str ("Prepend node ");
+ Write_Int (Int (Node));
+ Write_Str (" to list ");
+ Write_Int (Int (To));
+ Write_Eol;
+ end if;
+ end Prepend_Debug;
+
+ -- Start of processing for Prepend_Debug
+
begin
pragma Assert (not Is_List_Member (Node));
return;
end if;
- pragma Debug (Prepend_Debug (Node, To));
+ pragma Debug (Prepend_Debug);
if No (F) then
Set_Last (To, Node);
Set_List_Link (Node, To);
end Prepend;
- -------------------
- -- Prepend_Debug --
- -------------------
-
- procedure Prepend_Debug (Node : Node_Id; To : List_Id) is
- begin
- if Debug_Flag_N then
- Write_Str ("Prepend node ");
- Write_Int (Int (Node));
- Write_Str (" to list ");
- Write_Int (Int (To));
- Write_Eol;
- end if;
- end Prepend_Debug;
-
----------------
-- Prepend_To --
----------------
-- Prev --
----------
- -- This subprogram is deliberately placed early on, out of alphabetical
- -- order, so that it can be properly inlined from within this unit.
-
function Prev (Node : Node_Id) return Node_Id is
begin
pragma Assert (Is_List_Member (Node));
pragma Inline (Remove_Debug);
-- Output debug information if Debug_Flag_N set
+ ------------------
+ -- Remove_Debug --
+ ------------------
+
procedure Remove_Debug is
begin
if Debug_Flag_N then
pragma Inline (Remove_Head_Debug);
-- Output debug information if Debug_Flag_N set
+ -----------------------
+ -- Remove_Head_Debug --
+ -----------------------
+
procedure Remove_Head_Debug is
begin
if Debug_Flag_N then
function Remove_Next (Node : Node_Id) return Node_Id is
Nxt : constant Node_Id := Next (Node);
+ procedure Remove_Next_Debug;
+ pragma Inline (Remove_Next_Debug);
+ -- Output debug information if Debug_Flag_N set
+
+ -----------------------
+ -- Remove_Next_Debug --
+ -----------------------
+
+ procedure Remove_Next_Debug is
+ begin
+ if Debug_Flag_N then
+ Write_Str ("Remove next node after ");
+ Write_Int (Int (Node));
+ Write_Eol;
+ end if;
+ end Remove_Next_Debug;
+
+ -- Start of processing for Remove_Next
+
begin
if Present (Nxt) then
declare
LC : constant List_Id := List_Containing (Node);
begin
- pragma Debug (Remove_Next_Debug (Node));
+ pragma Debug (Remove_Next_Debug);
Set_Next (Node, Nxt2);
if No (Nxt2) then
return Nxt;
end Remove_Next;
- -----------------------
- -- Remove_Next_Debug --
- -----------------------
-
- procedure Remove_Next_Debug (Node : Node_Id) is
- begin
- if Debug_Flag_N then
- Write_Str ("Remove next node after ");
- Write_Int (Int (Node));
- Write_Eol;
- end if;
- end Remove_Next_Debug;
-
---------------
-- Set_First --
---------------
- -- This subprogram is deliberately placed early on, out of alphabetical
- -- order, so that it can be properly inlined from within this unit.
-
procedure Set_First (List : List_Id; To : Node_Id) is
begin
Lists.Table (List).First := To;
-- Set_Last --
--------------
- -- This subprogram is deliberately placed early on, out of alphabetical
- -- order, so that it can be properly inlined from within this unit.
-
procedure Set_Last (List : List_Id; To : Node_Id) is
begin
Lists.Table (List).Last := To;
-- Set_List_Link --
-------------------
- -- This subprogram is deliberately placed early on, out of alphabetical
- -- order, so that it can be properly inlined from within this unit.
-
procedure Set_List_Link (Node : Node_Id; To : List_Id) is
begin
Nodes.Table (Node).Link := Union_Id (To);
-- Set_Next --
--------------
- -- This subprogram is deliberately placed early on, out of alphabetical
- -- order, so that it can be properly inlined from within this unit.
-
procedure Set_Next (Node : Node_Id; To : Node_Id) is
begin
Next_Node.Table (Node) := To;
-- Set_Prev --
--------------
- -- This subprogram is deliberately placed early on, out of alphabetical
- -- order, so that it can be properly inlined from within this unit.
-
procedure Set_Prev (Node : Node_Id; To : Node_Id) is
begin
Prev_Node.Table (Node) := To;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2003 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2004 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- --
Node2 : Node_Id;
Node3 : Node_Id;
Node4 : Node_Id;
- Node5 : Node_Id)
- return List_Id;
+ Node5 : Node_Id) return List_Id;
-- Build a new list initially containing the five given nodes
function New_List
Node3 : Node_Id;
Node4 : Node_Id;
Node5 : Node_Id;
- Node6 : Node_Id)
- return List_Id;
- -- Build a new list initially containing the five given nodes
+ Node6 : Node_Id) return List_Id;
+ -- Build a new list initially containing the six given nodes
function New_Copy_List (List : List_Id) return List_Id;
-- Creates a new list containing copies (made with Atree.New_Copy) of every
function Prev (Node : Node_Id) return Node_Id;
pragma Inline (Prev);
- -- This function returns the previous node on a node list list, or Empty if
- -- Node is the first element of the node list. The argument must be a
- -- member of a node list. Note that the implementation does not maintain
- -- back pointers, so this function potentially requires traversal of the
- -- entire list, or more accurately of the part of the list preceding Node.
+ -- This function returns the previous node on a node list list, or Empty
+ -- 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
+ -- pointers, so this function executes quickly in constant time.
function Pick (List : List_Id; Index : Pos) return Node_Id;
-- Given a list, picks out the Index'th entry (1 = first entry). The
-- 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
-- elements preceding it are pragmas, then Empty is returned. The
- -- argument must be a member of a node list. Like Prev, this function
- -- may require expensive traversal of the head section of the list.
+ -- argument must be a member of a node list. Note: the implementation
+ -- does maintain back pointers, so this function executes quickly in
+ -- constant time.
procedure Prev_Non_Pragma (Node : in out Node_Id);
pragma Inline (Prev_Non_Pragma);
-- List is reset to be the empty node list.
procedure Prepend (Node : Node_Id; To : List_Id);
- pragma Inline (Prepend);
-- 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 list. An attempt to prepend an error node is ignored without
-- is empty, then Empty is returned.
function Remove_Next (Node : Node_Id) return Node_Id;
- pragma Inline (Remove_Next);
-- 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
-- returned. Node must be a member of a list. Unlike Remove, Remove_Next
projects / platform / upstream / gcc.git / commitdiff