This patch improves the efficiency of Ada.Containers.Unbounded_Priority_Queues,
especially in the case where many same-priority items are enqueued.
No test, because no change in behavior.
Tested on x86_64-pc-linux-gnu, committed on trunk
2016-04-18 Bob Duff <d...@adacore.com>
* a-cuprqu.ads: Change the representation of List_Type from a
singly-linked list to a doubly-linked list. In addition, add a
pointer Next_Unequal, which points past a possibly-long chain
of equal-priority items. This increases efficiency, especially
in the case of many equal-priority items.
* a-cuprqu.adb (Dequeue, Enqueue): Rewrite algorithms to take
advantage of new data structure.
(Finalize): Rewrite in terms of Dequeue, for simplicity.
Index: a-cuprqu.adb
===================================================================
--- a-cuprqu.adb (revision 235093)
+++ a-cuprqu.adb (working copy)
@@ -37,9 +37,22 @@
-- Local Subprograms --
-----------------------
+ function Before_Or_Equal (X, Y : Queue_Priority) return Boolean;
+ -- True if X is before or equal to Y. Equal means both Before(X,Y) and
+ -- Before(Y,X) are False.
+
procedure Free is
- new Ada.Unchecked_Deallocation (Node_Type, Node_Access);
+ new Ada.Unchecked_Deallocation (Node_Type, Node_Access);
+ ---------------------
+ -- Before_Or_Equal --
+ ---------------------
+
+ function Before_Or_Equal (X, Y : Queue_Priority) return Boolean is
+ begin
+ return (if Before (X, Y) then True else not Before (Y, X));
+ end Before_Or_Equal;
+
-------------
-- Dequeue --
-------------
@@ -48,20 +61,36 @@
(List : in out List_Type;
Element : out Queue_Interfaces.Element_Type)
is
- X : Node_Access;
+ H : constant Node_Access := List.Header'Unchecked_Access;
+ pragma Assert (List.Length /= 0);
+ pragma Assert (List.Header.Next /= H);
+ -- List can't be empty; see the barrier
- begin
- Element := List.First.Element;
+ pragma Assert
+ (List.Header.Next.Next = H or else
+ Before_Or_Equal (Get_Priority (List.Header.Next.Element),
+ Get_Priority (List.Header.Next.Next.Element)));
+ -- The first item is before-or-equal to the second
- X := List.First;
- List.First := List.First.Next;
+ pragma Assert
+ (List.Header.Next.Next_Unequal = H or else
+ Before (Get_Priority (List.Header.Next.Element),
+ Get_Priority (List.Header.Next.Next_Unequal.Element)));
+ -- The first item is before its Next_Unequal item
- if List.First = null then
- List.Last := null;
- end if;
+ -- The highest-priority item is always first; just remove it and
+ -- return that element.
+ X : Node_Access := List.Header.Next;
+
+ -- Start of processing for Dequeue
+
+ begin
+ Element := X.Element;
+ X.Next.Prev := H;
+ List.Header.Next := X.Next;
+ List.Header.Next_Unequal := X.Next;
List.Length := List.Length - 1;
-
Free (X);
end Dequeue;
@@ -93,15 +122,13 @@
-- dequeue an item. If it's false, it means no item is dequeued, and
-- we return False as the Success value.
- if List.Length = 0
- or else Before (At_Least, Get_Priority (List.First.Element))
- then
- Success := False;
- return;
+ Success := List.Length > 0
+ and then
+ not Before (At_Least, Get_Priority (List.Header.Next.Element));
+
+ if Success then
+ List.Dequeue (Element);
end if;
-
- List.Dequeue (Element);
- Success := True;
end Dequeue;
-------------
@@ -113,41 +140,55 @@
New_Item : Queue_Interfaces.Element_Type)
is
P : constant Queue_Priority := Get_Priority (New_Item);
+ H : constant Node_Access := List.Header'Unchecked_Access;
- Node : Node_Access;
- Prev : Node_Access;
+ function Next return Node_Access;
+ -- The node before which we wish to insert the new node
- begin
- Node := new Node_Type'(New_Item, null);
+ ----------
+ -- Next --
+ ----------
- if List.First = null then
- List.First := Node;
- List.Last := List.First;
+ function Next return Node_Access is
+ begin
+ return Result : Node_Access := H.Next_Unequal do
+ while Result /= H
+ and then not Before (P, Get_Priority (Result.Element))
+ loop
+ Result := Result.Next_Unequal;
+ end loop;
+ end return;
+ end Next;
- else
- Prev := List.First;
+ -- Local varaibles
- if Before (P, Get_Priority (Prev.Element)) then
- Node.Next := List.First;
- List.First := Node;
+ Prev : constant Node_Access := Next.Prev;
+ -- The node after which we wish to insert the new node. So Prev must
+ -- be the header, or be higher or equal priority to the new item.
+ -- Prev.Next must be the header, or be lower priority than the
+ -- new item.
- else
- while Prev.Next /= null loop
- if Before (P, Get_Priority (Prev.Next.Element)) then
- Node.Next := Prev.Next;
- Prev.Next := Node;
+ pragma Assert
+ (Prev = H or else Before_Or_Equal (Get_Priority (Prev.Element), P));
+ pragma Assert
+ (Prev.Next = H
+ or else Before (P, Get_Priority (Prev.Next.Element)));
+ pragma Assert (Prev.Next = Prev.Next_Unequal);
- exit;
- end if;
+ Node : constant Node_Access :=
+ new Node_Type'(New_Item,
+ Prev => Prev,
+ Next => Prev.Next,
+ Next_Unequal => Prev.Next);
- Prev := Prev.Next;
- end loop;
+ -- Start of processing for Enqueue
- if Prev.Next = null then
- List.Last.Next := Node;
- List.Last := Node;
- end if;
- end if;
+ begin
+ Prev.Next.Prev := Node;
+ Prev.Next := Node;
+
+ if List.Length = 0 then
+ List.Header.Next_Unequal := Node;
end if;
List.Length := List.Length + 1;
@@ -162,12 +203,10 @@
--------------
procedure Finalize (List : in out List_Type) is
- X : Node_Access;
+ Ignore : Queue_Interfaces.Element_Type;
begin
- while List.First /= null loop
- X := List.First;
- List.First := List.First.Next;
- Free (X);
+ while List.Length > 0 loop
+ List.Dequeue (Ignore);
end loop;
end Finalize;
Index: a-cuprqu.ads
===================================================================
--- a-cuprqu.ads (revision 235093)
+++ a-cuprqu.ads (working copy)
@@ -81,18 +81,35 @@
private
+ -- List_Type is implemented as a circular doubly-linked list with a
+ -- dummy header node; Prev and Next are the links. The list is in
+ -- decreasing priority order, so the highest-priority item is always
+ -- first. (If there are multiple items with the highest priority, the
+ -- oldest one is first.) Header.Element is undefined and not used.
+ --
+ -- In addition, Next_Unequal points to the next item with a different
+ -- (i.e. strictly lower) priority. This is used to speed up the search
+ -- for the next lower-priority item, in cases where there are many items
+ -- with the same priority.
+ --
+ -- An empty list has Header.Prev, Header.Next, and Header.Next_Unequal
+ -- all pointing to Header. A nonempty list has Header.Next_Unequal
+ -- pointing to the first "real" item, and the last item has Next_Unequal
+ -- pointing back to Header.
+
type Node_Type;
- type Node_Access is access Node_Type;
+ type Node_Access is access all Node_Type;
type Node_Type is limited record
- Element : Queue_Interfaces.Element_Type;
- Next : Node_Access;
+ Element : Queue_Interfaces.Element_Type;
+ Prev, Next : Node_Access := Node_Type'Unchecked_Access;
+ Next_Unequal : Node_Access := Node_Type'Unchecked_Access;
end record;
type List_Type is new Ada.Finalization.Limited_Controlled with record
- First, Last : Node_Access;
- Length : Count_Type := 0;
- Max_Length : Count_Type := 0;
+ Header : aliased Node_Type;
+ Length : Count_Type := 0;
+ Max_Length : Count_Type := 0;
end record;
overriding procedure Finalize (List : in out List_Type);
