From patchwork Thu Sep 1 10:32:23 2011 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 112856 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) by ozlabs.org (Postfix) with SMTP id DA1D9B6F7B for ; Thu, 1 Sep 2011 20:32:59 +1000 (EST) Received: (qmail 16916 invoked by alias); 1 Sep 2011 10:32:57 -0000 Received: (qmail 16893 invoked by uid 22791); 1 Sep 2011 10:32:52 -0000 X-SWARE-Spam-Status: No, hits=-1.8 required=5.0 tests=AWL,BAYES_00 X-Spam-Check-By: sourceware.org Received: from rock.gnat.com (HELO rock.gnat.com) (205.232.38.15) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Thu, 01 Sep 2011 10:32:24 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id 5E0482BB39E; Thu, 1 Sep 2011 06:32:23 -0400 (EDT) Received: from rock.gnat.com ([127.0.0.1]) by localhost (rock.gnat.com [127.0.0.1]) (amavisd-new, port 10024) with LMTP id NaFmVBZeaiqh; Thu, 1 Sep 2011 06:32:23 -0400 (EDT) Received: from kwai.gnat.com (kwai.gnat.com [205.232.38.4]) by rock.gnat.com (Postfix) with ESMTP id 411582BB39D; Thu, 1 Sep 2011 06:32:23 -0400 (EDT) Received: by kwai.gnat.com (Postfix, from userid 4192) id 3356E3FEE8; Thu, 1 Sep 2011 06:32:23 -0400 (EDT) Date: Thu, 1 Sep 2011 06:32:23 -0400 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Matthew Heaney Subject: [Ada] Add queue containers to standard library Message-ID: <20110901103223.GA18634@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.20 (2009-06-14) Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Ada 2012 added queue containers to the standard library; see AI05-0159 for details. Tested on x86_64-pc-linux-gnu, committed on trunk 2011-09-01 Matthew Heaney * Makefile.rtl, impunit.adb: Add a-csquin.ads, a-cusyqu.ad[sb], a-cuprqu.ad[sb], a-cbsyqu.ad[sb], a-cbprqu.ad[sb] * a-csquin.ads: New Ada 2012 unit that specifies the queue interface * a-cusyqu.ads, a-cusyqu.adb: New Ada 2012 unit that specifies the unbounded queue container. * a-cbsyqu.ads, a-cbsyqu.adb: New Ada 2012 unit that specifies the bounded queue container. * a-cuprqu.ads, a-cuprqu.adb: New Ada 2012 unit that specifies the unbounded priority queue container. * a-cbprqu.ads, a-cbprqu.adb: New Ada 2012 unit that specifies the bounded priority queue container. Index: impunit.adb =================================================================== --- impunit.adb (revision 178381) +++ impunit.adb (working copy) @@ -519,6 +519,11 @@ "a-comutr", -- Ada.Containers.Multiway_Trees "a-cimutr", -- Ada.Containers.Indefinite_Multiway_Trees "a-cbmutr", -- Ada.Containers.Bounded_Multiway_Trees + "a-csquin", -- Ada.Containers.Synchronized_Queue_Interfaces + "a-cusyqu", -- Ada.Containers.Unbounded_Synchronized_Queues + "a-cuprqu", -- Ada.Containers.Unbounded_Priority_Queues + "a-cbsyqu", -- Ada.Containers.Bounded_Synchronized_Queues + "a-cbprqu", -- Ada.Containers.Bounded_Priority_Queues "a-extiin", -- Ada.Execution_Time.Interrupts "a-iteint", -- Ada.Iterator_Interfaces "a-synbar", -- Ada.Synchronous_Barriers Index: a-cusyqu.adb =================================================================== --- a-cusyqu.adb (revision 0) +++ a-cusyqu.adb (revision 0) @@ -0,0 +1,174 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT LIBRARY COMPONENTS -- +-- -- +-- ADA.CONTAINERS.UNBOUNDED_SYNCHRONIZED_QUEUES -- +-- -- +-- B o d y -- +-- -- +-- Copyright (C) 2004-2011, 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- -- +-- ware Foundation; either version 3, or (at your option) any later ver- -- +-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. -- +-- -- +-- As a special exception under Section 7 of GPL version 3, you are granted -- +-- additional permissions described in the GCC Runtime Library Exception, -- +-- version 3.1, as published by the Free Software Foundation. -- +-- -- +-- You should have received a copy of the GNU General Public License and -- +-- a copy of the GCC Runtime Library Exception along with this program; -- +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- +-- . -- +-- -- +-- This unit was originally developed by Matthew J Heaney. -- +------------------------------------------------------------------------------ + +with Ada.Unchecked_Deallocation; + +package body Ada.Containers.Unbounded_Synchronized_Queues is + + package body Implementation is + + ----------------------- + -- Local Subprograms -- + ----------------------- + + procedure Free is + new Ada.Unchecked_Deallocation (Node_Type, Node_Access); + + ------------- + -- Dequeue -- + ------------- + + procedure Dequeue + (List : in out List_Type; + Element : out Queue_Interfaces.Element_Type) + is + X : Node_Access; + + begin + Element := List.First.Element; + + X := List.First; + List.First := List.First.Next; + + if List.First = null then + List.Last := null; + end if; + + List.Length := List.Length - 1; + + Free (X); + end Dequeue; + + ------------- + -- Enqueue -- + ------------- + + procedure Enqueue + (List : in out List_Type; + New_Item : Queue_Interfaces.Element_Type) + is + Node : Node_Access; + + begin + Node := new Node_Type'(New_Item, null); + + if List.First = null then + List.First := Node; + List.Last := List.First; + + else + List.Last.Next := Node; + List.Last := Node; + end if; + + List.Length := List.Length + 1; + + if List.Length > List.Max_Length then + List.Max_Length := List.Length; + end if; + end Enqueue; + + -------------- + -- Finalize -- + -------------- + + procedure Finalize (List : in out List_Type) is + X : Node_Access; + + begin + while List.First /= null loop + X := List.First; + List.First := List.First.Next; + Free (X); + end loop; + end Finalize; + + ------------ + -- Length -- + ------------ + + function Length (List : List_Type) return Count_Type is + begin + return List.Length; + end Length; + + ---------------- + -- Max_Length -- + ---------------- + + function Max_Length (List : List_Type) return Count_Type is + begin + return List.Max_Length; + end Max_Length; + + end Implementation; + + protected body Queue is + + ----------------- + -- Current_Use -- + ----------------- + + function Current_Use return Count_Type is + begin + return List.Length; + end Current_Use; + + ------------- + -- Dequeue -- + ------------- + + entry Dequeue (Element : out Queue_Interfaces.Element_Type) + when List.Length > 0 + is + begin + List.Dequeue (Element); + end Dequeue; + + ------------- + -- Enqueue -- + ------------- + + entry Enqueue (New_Item : Queue_Interfaces.Element_Type) when True is + begin + List.Enqueue (New_Item); + end Enqueue; + + -------------- + -- Peak_Use -- + -------------- + + function Peak_Use return Count_Type is + begin + return List.Max_Length; + end Peak_Use; + + end Queue; + +end Ada.Containers.Unbounded_Synchronized_Queues; Index: a-cusyqu.ads =================================================================== --- a-cusyqu.ads (revision 0) +++ a-cusyqu.ads (revision 0) @@ -0,0 +1,107 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT LIBRARY COMPONENTS -- +-- -- +-- ADA.CONTAINERS.UNBOUNDED_SYNCHRONIZED_QUEUES -- +-- -- +-- S p e c -- +-- -- +-- Copyright (C) 2004-2011, Free Software Foundation, Inc. -- +-- -- +-- This specification is derived from the Ada Reference Manual for use with -- +-- GNAT. The copyright notice above, and the license provisions that follow -- +-- apply solely to the contents of the part following the private keyword. -- +-- -- +-- 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- -- +-- ware Foundation; either version 3, or (at your option) any later ver- -- +-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. -- +-- -- +-- As a special exception under Section 7 of GPL version 3, you are granted -- +-- additional permissions described in the GCC Runtime Library Exception, -- +-- version 3.1, as published by the Free Software Foundation. -- +-- -- +-- You should have received a copy of the GNU General Public License and -- +-- a copy of the GCC Runtime Library Exception along with this program; -- +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- +-- . -- +-- -- +-- This unit was originally developed by Matthew J Heaney. -- +------------------------------------------------------------------------------ + +with System; +with Ada.Containers.Synchronized_Queue_Interfaces; +with Ada.Finalization; + +generic + with package Queue_Interfaces is + new Ada.Containers.Synchronized_Queue_Interfaces (<>); + + Default_Ceiling : System.Any_Priority := System.Priority'Last; + +package Ada.Containers.Unbounded_Synchronized_Queues is + pragma Preelaborate; + + package Implementation is + + type List_Type is tagged limited private; + + procedure Enqueue + (List : in out List_Type; + New_Item : Queue_Interfaces.Element_Type); + + procedure Dequeue + (List : in out List_Type; + Element : out Queue_Interfaces.Element_Type); + + function Length (List : List_Type) return Count_Type; + + function Max_Length (List : List_Type) return Count_Type; + + private + + type Node_Type; + type Node_Access is access Node_Type; + + type Node_Type is limited record + Element : Queue_Interfaces.Element_Type; + Next : Node_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; + end record; + + overriding + procedure Finalize (List : in out List_Type); + + end Implementation; + + protected type Queue (Ceiling : System.Any_Priority := Default_Ceiling) + -- ??? + -- with Priority => Ceiling is new Queue_Interfaces.Queue with + is new Queue_Interfaces.Queue with + + overriding + entry Enqueue (New_Item : Queue_Interfaces.Element_Type); + + overriding + entry Dequeue (Element : out Queue_Interfaces.Element_Type); + + overriding + function Current_Use return Count_Type; + + overriding + function Peak_Use return Count_Type; + + private + + List : Implementation.List_Type; + + end Queue; + +end Ada.Containers.Unbounded_Synchronized_Queues; Index: a-csquin.ads =================================================================== --- a-csquin.ads (revision 0) +++ a-csquin.ads (revision 0) @@ -0,0 +1,56 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT LIBRARY COMPONENTS -- +-- -- +-- ADA.CONTAINERS.SYNCHRONIZED_QUEUE_INTERFACES -- +-- -- +-- S p e c -- +-- -- +-- Copyright (C) 2004-2011, Free Software Foundation, Inc. -- +-- -- +-- This specification is derived from the Ada Reference Manual for use with -- +-- GNAT. The copyright notice above, and the license provisions that follow -- +-- apply solely to the contents of the part following the private keyword. -- +-- -- +-- 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- -- +-- ware Foundation; either version 3, or (at your option) any later ver- -- +-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. -- +-- -- +-- As a special exception under Section 7 of GPL version 3, you are granted -- +-- additional permissions described in the GCC Runtime Library Exception, -- +-- version 3.1, as published by the Free Software Foundation. -- +-- -- +-- You should have received a copy of the GNU General Public License and -- +-- a copy of the GCC Runtime Library Exception along with this program; -- +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- +-- . -- +-- -- +-- This unit was originally developed by Matthew J Heaney. -- +------------------------------------------------------------------------------ + +generic + type Element_Type is private; + +package Ada.Containers.Synchronized_Queue_Interfaces is + pragma Pure; + + type Queue is synchronized interface; + + procedure Enqueue + (Container : in out Queue; + New_Item : Element_Type) is abstract; + -- with Is_Synchronized => By_Entry; ??? + + procedure Dequeue + (Container : in out Queue; + Element : out Element_Type) is abstract; + -- with Is_Synchronized => By_Entry; ??? + + function Current_Use (Container : Queue) return Count_Type is abstract; + + function Peak_Use (Container : Queue) return Count_Type is abstract; + +end Ada.Containers.Synchronized_Queue_Interfaces; Index: a-cbprqu.adb =================================================================== --- a-cbprqu.adb (revision 0) +++ a-cbprqu.adb (revision 0) @@ -0,0 +1,159 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT LIBRARY COMPONENTS -- +-- -- +-- ADA.CONTAINERS.BOUNDED_PRIORITY_QUEUES -- +-- -- +-- B o d y -- +-- -- +-- Copyright (C) 2004-2011, 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- -- +-- ware Foundation; either version 3, or (at your option) any later ver- -- +-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. -- +-- -- +-- As a special exception under Section 7 of GPL version 3, you are granted -- +-- additional permissions described in the GCC Runtime Library Exception, -- +-- version 3.1, as published by the Free Software Foundation. -- +-- -- +-- You should have received a copy of the GNU General Public License and -- +-- a copy of the GCC Runtime Library Exception along with this program; -- +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- +-- . -- +-- -- +-- This unit was originally developed by Matthew J Heaney. -- +------------------------------------------------------------------------------ + +package body Ada.Containers.Bounded_Priority_Queues is + + package body Implementation is + + ------------- + -- Dequeue -- + ------------- + + procedure Dequeue + (List : in out List_Type; + Element : out Queue_Interfaces.Element_Type) + is + begin + Element := List.Container.First_Element; + List.Container.Delete_First; + end Dequeue; + + ------------- + -- Enqueue -- + ------------- + + procedure Enqueue + (List : in out List_Type; + New_Item : Queue_Interfaces.Element_Type) + is + P : constant Queue_Priority := Get_Priority (New_Item); + + C : List_Types.Cursor; + use List_Types; + + Count : Count_Type; + + begin + C := List.Container.First; + while Has_Element (C) loop + -- ??? + -- if Before (P, Get_Priority (List.Constant_Reference (C))) then + if Before (P, Get_Priority (Element (C))) then + List.Container.Insert (C, New_Item); + exit; + end if; + + Next (C); + end loop; + + if not Has_Element (C) then + List.Container.Append (New_Item); + end if; + + Count := List.Container.Length; + + if Count > List.Max_Length then + List.Max_Length := Count; + end if; + end Enqueue; + + ------------ + -- Length -- + ------------ + + function Length (List : List_Type) return Count_Type is + begin + return List.Container.Length; + end Length; + + ---------------- + -- Max_Length -- + ---------------- + + function Max_Length (List : List_Type) return Count_Type is + begin + return List.Max_Length; + end Max_Length; + + end Implementation; + + protected body Queue is + + ------------------ + -- Current_Use -- + ------------------ + + function Current_Use return Count_Type is + begin + return List.Length; + end Current_Use; + + -------------- + -- Dequeue -- + -------------- + + entry Dequeue (Element : out Queue_Interfaces.Element_Type) + when List.Length > 0 + is + begin + List.Dequeue (Element); + end Dequeue; + + -- ??? + -- entry Dequeue_Only_High_Priority + -- (Low_Priority : Queue_Priority; + -- Element : out Queue_Interfaces.Element_Type) when True + -- is + -- begin + -- null; + -- end Dequeue_Only_High_Priority; + + -------------- + -- Enqueue -- + -------------- + + entry Enqueue (New_Item : Queue_Interfaces.Element_Type) + when List.Length < Capacity + is + begin + List.Enqueue (New_Item); + end Enqueue; + + --------------- + -- Peak_Use -- + --------------- + + function Peak_Use return Count_Type is + begin + return List.Max_Length; + end Peak_Use; + + end Queue; + +end Ada.Containers.Bounded_Priority_Queues; Index: a-cbprqu.ads =================================================================== --- a-cbprqu.ads (revision 0) +++ a-cbprqu.ads (revision 0) @@ -0,0 +1,118 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT LIBRARY COMPONENTS -- +-- -- +-- ADA.CONTAINERS.BOUNDED_PRIORITY_QUEUES -- +-- -- +-- S p e c -- +-- -- +-- Copyright (C) 2004-2011, Free Software Foundation, Inc. -- +-- -- +-- This specification is derived from the Ada Reference Manual for use with -- +-- GNAT. The copyright notice above, and the license provisions that follow -- +-- apply solely to the contents of the part following the private keyword. -- +-- -- +-- 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- -- +-- ware Foundation; either version 3, or (at your option) any later ver- -- +-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. -- +-- -- +-- As a special exception under Section 7 of GPL version 3, you are granted -- +-- additional permissions described in the GCC Runtime Library Exception, -- +-- version 3.1, as published by the Free Software Foundation. -- +-- -- +-- You should have received a copy of the GNU General Public License and -- +-- a copy of the GCC Runtime Library Exception along with this program; -- +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- +-- . -- +-- -- +-- This unit was originally developed by Matthew J Heaney. -- +------------------------------------------------------------------------------ + +with System; +with Ada.Containers.Synchronized_Queue_Interfaces; +with Ada.Containers.Bounded_Doubly_Linked_Lists; + +generic + with package Queue_Interfaces is + new Ada.Containers.Synchronized_Queue_Interfaces (<>); + + type Queue_Priority is private; + + with function Get_Priority + (Element : Queue_Interfaces.Element_Type) return Queue_Priority is <>; + + with function Before + (Left, Right : Queue_Priority) return Boolean is <>; + + Default_Capacity : Count_Type; + Default_Ceiling : System.Any_Priority := System.Priority'Last; + +package Ada.Containers.Bounded_Priority_Queues is + pragma Preelaborate; + + package Implementation is + + type List_Type (Capacity : Count_Type) is tagged limited private; + + procedure Enqueue + (List : in out List_Type; + New_Item : Queue_Interfaces.Element_Type); + + procedure Dequeue + (List : in out List_Type; + Element : out Queue_Interfaces.Element_Type); + + function Length (List : List_Type) return Count_Type; + + function Max_Length (List : List_Type) return Count_Type; + + private + + -- We need a better data structure here, such as a proper heap. ??? + + package List_Types is new Bounded_Doubly_Linked_Lists + (Element_Type => Queue_Interfaces.Element_Type, + "=" => Queue_Interfaces."="); + + type List_Type (Capacity : Count_Type) is tagged limited record + Container : List_Types.List (Capacity); + Max_Length : Count_Type := 0; + end record; + + end Implementation; + + protected type Queue + (Capacity : Count_Type := Default_Capacity; + Ceiling : System.Any_Priority := Default_Ceiling) + -- ??? + -- with Priority => Ceiling is new Queue_Interfaces.Queue with + is new Queue_Interfaces.Queue with + + overriding + entry Enqueue (New_Item : Queue_Interfaces.Element_Type); + + overriding + entry Dequeue (Element : out Queue_Interfaces.Element_Type); + + -- ??? + -- not overriding + -- entry Dequeue_Only_High_Priority + -- (Low_Priority : Queue_Priority; + -- Element : out Queue_Interfaces.Element_Type); + + overriding + function Current_Use return Count_Type; + + overriding + function Peak_Use return Count_Type; + + private + + List : Implementation.List_Type (Capacity); + + end Queue; + +end Ada.Containers.Bounded_Priority_Queues; Index: a-cuprqu.adb =================================================================== --- a-cuprqu.adb (revision 0) +++ a-cuprqu.adb (revision 0) @@ -0,0 +1,223 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT LIBRARY COMPONENTS -- +-- -- +-- ADA.CONTAINERS.UNBOUNDED_PRIORITY_QUEUES -- +-- -- +-- B o d y -- +-- -- +-- Copyright (C) 2004-2011, 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- -- +-- ware Foundation; either version 3, or (at your option) any later ver- -- +-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. -- +-- -- +-- As a special exception under Section 7 of GPL version 3, you are granted -- +-- additional permissions described in the GCC Runtime Library Exception, -- +-- version 3.1, as published by the Free Software Foundation. -- +-- -- +-- You should have received a copy of the GNU General Public License and -- +-- a copy of the GCC Runtime Library Exception along with this program; -- +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- +-- . -- +-- -- +-- This unit was originally developed by Matthew J Heaney. -- +------------------------------------------------------------------------------ + +with Ada.Unchecked_Deallocation; + +package body Ada.Containers.Unbounded_Priority_Queues is + + package body Implementation is + + ----------------------- + -- Local Subprograms -- + ----------------------- + + procedure Free is + new Ada.Unchecked_Deallocation (Node_Type, Node_Access); + + ------------- + -- Dequeue -- + ------------- + + procedure Dequeue + (List : in out List_Type; + Element : out Queue_Interfaces.Element_Type) + is + X : Node_Access; + + begin + Element := List.First.Element; + + X := List.First; + List.First := List.First.Next; + + if List.First = null then + List.Last := null; + end if; + + List.Length := List.Length - 1; + + Free (X); + end Dequeue; + + ------------- + -- Enqueue -- + ------------- + + procedure Enqueue + (List : in out List_Type; + New_Item : Queue_Interfaces.Element_Type) + is + P : constant Queue_Priority := Get_Priority (New_Item); + + Node : Node_Access; + Prev : Node_Access; + + begin + Node := new Node_Type'(New_Item, null); + + if List.First = null then + List.First := Node; + List.Last := List.First; + + else + Prev := List.First; + + if Before (P, Get_Priority (Prev.Element)) then + Node.Next := List.First; + List.First := Node; + + else + while Prev.Next /= null loop + if Before (P, Get_Priority (Prev.Next.Element)) then + Node.Next := Prev.Next; + Prev.Next := Node; + + exit; + end if; + + Prev := Prev.Next; + end loop; + + if Prev.Next = null then + List.Last.Next := Node; + List.Last := Node; + end if; + end if; + end if; + + List.Length := List.Length + 1; + + if List.Length > List.Max_Length then + List.Max_Length := List.Length; + end if; + end Enqueue; + + -------------- + -- Finalize -- + -------------- + + procedure Finalize (List : in out List_Type) is + X : Node_Access; + + begin + while List.First /= null loop + X := List.First; + List.First := List.First.Next; + Free (X); + end loop; + end Finalize; + + ------------------------ + -- Have_High_Priority -- + ------------------------ + + -- ??? + -- function Have_High_Priority + -- (List : List_Type; + -- Low_Priority : Queue_Priority) return Boolean + -- is + -- begin + -- if List.Length = 0 then + -- return False; + -- end if; + -- return Before (Get_Priority (List.First.Element), Low_Priority); + -- end Have_High_Priority; + + ------------ + -- Length -- + ------------ + + function Length (List : List_Type) return Count_Type is + begin + return List.Length; + end Length; + + ---------------- + -- Max_Length -- + ---------------- + + function Max_Length (List : List_Type) return Count_Type is + begin + return List.Max_Length; + end Max_Length; + + end Implementation; + + protected body Queue is + + ----------------- + -- Current_Use -- + ----------------- + + function Current_Use return Count_Type is + begin + return List.Length; + end Current_Use; + + ------------- + -- Dequeue -- + ------------- + + entry Dequeue (Element : out Queue_Interfaces.Element_Type) + when List.Length > 0 + is + begin + List.Dequeue (Element); + end Dequeue; + + -- ??? + -- entry Dequeue_Only_High_Priority + -- (Low_Priority : Queue_Priority; + -- Element : out Queue_Interfaces.Element_Type) when True + -- is + -- begin + -- null; + -- end Dequeue_Only_High_Priority; + + ------------- + -- Enqueue -- + ------------- + + entry Enqueue (New_Item : Queue_Interfaces.Element_Type) when True is + begin + List.Enqueue (New_Item); + end Enqueue; + + -------------- + -- Peak_Use -- + -------------- + + function Peak_Use return Count_Type is + begin + return List.Max_Length; + end Peak_Use; + + end Queue; + +end Ada.Containers.Unbounded_Priority_Queues; Index: a-cuprqu.ads =================================================================== --- a-cuprqu.ads (revision 0) +++ a-cuprqu.ads (revision 0) @@ -0,0 +1,127 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT LIBRARY COMPONENTS -- +-- -- +-- ADA.CONTAINERS.UNBOUNDED_PRIORITY_QUEUES -- +-- -- +-- S p e c -- +-- -- +-- Copyright (C) 2004-2011, Free Software Foundation, Inc. -- +-- -- +-- This specification is derived from the Ada Reference Manual for use with -- +-- GNAT. The copyright notice above, and the license provisions that follow -- +-- apply solely to the contents of the part following the private keyword. -- +-- -- +-- 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- -- +-- ware Foundation; either version 3, or (at your option) any later ver- -- +-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. -- +-- -- +-- As a special exception under Section 7 of GPL version 3, you are granted -- +-- additional permissions described in the GCC Runtime Library Exception, -- +-- version 3.1, as published by the Free Software Foundation. -- +-- -- +-- You should have received a copy of the GNU General Public License and -- +-- a copy of the GCC Runtime Library Exception along with this program; -- +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- +-- . -- +-- -- +-- This unit was originally developed by Matthew J Heaney. -- +------------------------------------------------------------------------------ + +with System; +with Ada.Containers.Synchronized_Queue_Interfaces; +with Ada.Finalization; + +generic + with package Queue_Interfaces is + new Ada.Containers.Synchronized_Queue_Interfaces (<>); + + type Queue_Priority is private; + + with function Get_Priority + (Element : Queue_Interfaces.Element_Type) return Queue_Priority is <>; + + with function Before + (Left, Right : Queue_Priority) return Boolean is <>; + + Default_Ceiling : System.Any_Priority := System.Priority'Last; + +package Ada.Containers.Unbounded_Priority_Queues is + pragma Preelaborate; + + package Implementation is + + type List_Type is tagged limited private; + + procedure Enqueue + (List : in out List_Type; + New_Item : Queue_Interfaces.Element_Type); + + procedure Dequeue + (List : in out List_Type; + Element : out Queue_Interfaces.Element_Type); + + function Length (List : List_Type) return Count_Type; + + function Max_Length (List : List_Type) return Count_Type; + + private + + type Node_Type; + type Node_Access is access Node_Type; + + type Node_Type is limited record + Element : Queue_Interfaces.Element_Type; + Next : Node_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; + end record; + + overriding + procedure Finalize (List : in out List_Type); + + -- ??? + -- not overriding + -- function Have_High_Priority + -- (List : List_Type; + -- Low_Priority : Queue_Priority) return Boolean; + + end Implementation; + + protected type Queue (Ceiling : System.Any_Priority := Default_Ceiling) + -- ??? + -- with Priority => Ceiling is new Queue_Interfaces.Queue with + is new Queue_Interfaces.Queue with + + overriding + entry Enqueue (New_Item : Queue_Interfaces.Element_Type); + + overriding + entry Dequeue (Element : out Queue_Interfaces.Element_Type); + + -- ??? + -- not overriding + -- entry Dequeue_Only_High_Priority + -- (Low_Priority : Queue_Priority; + -- Element : out Queue_Interfaces.Element_Type); + + overriding + function Current_Use return Count_Type; + + overriding + function Peak_Use return Count_Type; + + private + + List : Implementation.List_Type; + + end Queue; + +end Ada.Containers.Unbounded_Priority_Queues; Index: Makefile.rtl =================================================================== --- Makefile.rtl (revision 178381) +++ Makefile.rtl (working copy) @@ -94,6 +94,8 @@ a-cbdlli$(objext) \ a-cbmutr$(objext) \ a-cborma$(objext) \ + a-cbprqu$(objext) \ + a-cbsyqu$(objext) \ a-cdlili$(objext) \ a-cfdlli$(objext) \ a-cfhama$(objext) \ @@ -144,6 +146,9 @@ a-crdlli$(objext) \ a-comutr$(objext) \ a-cimutr$(objext) \ + a-csquin$(objext) \ + a-cuprqu$(objext) \ + a-cusyqu$(objext) \ a-cwila1$(objext) \ a-cwila9$(objext) \ a-decima$(objext) \ Index: a-cbsyqu.adb =================================================================== --- a-cbsyqu.adb (revision 0) +++ a-cbsyqu.adb (revision 0) @@ -0,0 +1,168 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT LIBRARY COMPONENTS -- +-- -- +-- ADA.CONTAINERS.BOUNDED_SYNCHRONIZED_QUEUES -- +-- -- +-- B o d y -- +-- -- +-- Copyright (C) 2004-2011, 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- -- +-- ware Foundation; either version 3, or (at your option) any later ver- -- +-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. -- +-- -- +-- As a special exception under Section 7 of GPL version 3, you are granted -- +-- additional permissions described in the GCC Runtime Library Exception, -- +-- version 3.1, as published by the Free Software Foundation. -- +-- -- +-- You should have received a copy of the GNU General Public License and -- +-- a copy of the GCC Runtime Library Exception along with this program; -- +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- +-- . -- +-- -- +-- This unit was originally developed by Matthew J Heaney. -- +------------------------------------------------------------------------------ + +package body Ada.Containers.Bounded_Synchronized_Queues is + + package body Implementation is + + ------------- + -- Dequeue -- + ------------- + + procedure Dequeue + (List : in out List_Type; + Element : out Queue_Interfaces.Element_Type) + is + EE : Element_Array renames List.Elements; + + begin + Element := EE (List.First); + List.Length := List.Length - 1; + + if List.Length = 0 then + List.First := 0; + List.Last := 0; + + elsif List.First <= List.Last then + List.First := List.First + 1; + + else + List.First := List.First + 1; + + if List.First > List.Capacity then + List.First := 1; + end if; + end if; + end Dequeue; + + ------------- + -- Enqueue -- + ------------- + + procedure Enqueue + (List : in out List_Type; + New_Item : Queue_Interfaces.Element_Type) + is + begin + if List.Length >= List.Capacity then + raise Capacity_Error with "No capacity for insertion"; + end if; + + if List.Length = 0 then + List.Elements (1) := New_Item; + List.First := 1; + List.Last := 1; + + elsif List.First <= List.Last then + if List.Last < List.Capacity then + List.Elements (List.Last + 1) := New_Item; + List.Last := List.Last + 1; + + else + List.Elements (1) := New_Item; + List.Last := 1; + end if; + + else + List.Elements (List.Last + 1) := New_Item; + List.Last := List.Last + 1; + end if; + + List.Length := List.Length + 1; + + if List.Length > List.Max_Length then + List.Max_Length := List.Length; + end if; + end Enqueue; + + ------------ + -- Length -- + ------------ + + function Length (List : List_Type) return Count_Type is + begin + return List.Length; + end Length; + + ---------------- + -- Max_Length -- + ---------------- + + function Max_Length (List : List_Type) return Count_Type is + begin + return List.Max_Length; + end Max_Length; + + end Implementation; + + protected body Queue is + + ----------------- + -- Current_Use -- + ----------------- + + function Current_Use return Count_Type is + begin + return List.Length; + end Current_Use; + + ------------- + -- Dequeue -- + ------------- + + entry Dequeue (Element : out Queue_Interfaces.Element_Type) + when List.Length > 0 + is + begin + List.Dequeue (Element); + end Dequeue; + + ------------- + -- Enqueue -- + ------------- + + entry Enqueue (New_Item : Queue_Interfaces.Element_Type) + when List.Length < Capacity + is + begin + List.Enqueue (New_Item); + end Enqueue; + + -------------- + -- Peak_Use -- + -------------- + + function Peak_Use return Count_Type is + begin + return List.Max_Length; + end Peak_Use; + + end Queue; + +end Ada.Containers.Bounded_Synchronized_Queues; Index: a-cbsyqu.ads =================================================================== --- a-cbsyqu.ads (revision 0) +++ a-cbsyqu.ads (revision 0) @@ -0,0 +1,104 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT LIBRARY COMPONENTS -- +-- -- +-- ADA.CONTAINERS.BOUNDED_SYNCHRONIZED_QUEUES -- +-- -- +-- S p e c -- +-- -- +-- Copyright (C) 2004-2011, Free Software Foundation, Inc. -- +-- -- +-- This specification is derived from the Ada Reference Manual for use with -- +-- GNAT. The copyright notice above, and the license provisions that follow -- +-- apply solely to the contents of the part following the private keyword. -- +-- -- +-- 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- -- +-- ware Foundation; either version 3, or (at your option) any later ver- -- +-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. -- +-- -- +-- As a special exception under Section 7 of GPL version 3, you are granted -- +-- additional permissions described in the GCC Runtime Library Exception, -- +-- version 3.1, as published by the Free Software Foundation. -- +-- -- +-- You should have received a copy of the GNU General Public License and -- +-- a copy of the GCC Runtime Library Exception along with this program; -- +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- +-- . -- +-- -- +-- This unit was originally developed by Matthew J Heaney. -- +------------------------------------------------------------------------------ + +with System; +with Ada.Containers.Synchronized_Queue_Interfaces; + +generic + with package Queue_Interfaces is + new Ada.Containers.Synchronized_Queue_Interfaces (<>); + + Default_Capacity : Count_Type; + Default_Ceiling : System.Any_Priority := System.Priority'Last; + +package Ada.Containers.Bounded_Synchronized_Queues is + pragma Preelaborate; + + package Implementation is + + type List_Type (Capacity : Count_Type) is tagged limited private; + + procedure Enqueue + (List : in out List_Type; + New_Item : Queue_Interfaces.Element_Type); + + procedure Dequeue + (List : in out List_Type; + Element : out Queue_Interfaces.Element_Type); + + function Length (List : List_Type) return Count_Type; + + function Max_Length (List : List_Type) return Count_Type; + + private + + -- Need proper heap data structure here ??? + + type Element_Array is + array (Count_Type range <>) of Queue_Interfaces.Element_Type; + + type List_Type (Capacity : Count_Type) is tagged limited record + First, Last : Count_Type := 0; + Length : Count_Type := 0; + Max_Length : Count_Type := 0; + Elements : Element_Array (1 .. Capacity) := (others => <>); + end record; + + end Implementation; + + protected type Queue + (Capacity : Count_Type := Default_Capacity; + Ceiling : System.Any_Priority := Default_Ceiling) + -- ??? + -- with Priority => Ceiling is new Queue_Interfaces.Queue with + is new Queue_Interfaces.Queue with + + overriding + entry Enqueue (New_Item : Queue_Interfaces.Element_Type); + + overriding + entry Dequeue (Element : out Queue_Interfaces.Element_Type); + + overriding + function Current_Use return Count_Type; + + overriding + function Peak_Use return Count_Type; + + private + + List : Implementation.List_Type (Capacity); + + end Queue; + +end Ada.Containers.Bounded_Synchronized_Queues;