-------- SIMTEL20 Ada Software Repository Prologue ------------
--                                                           -*
-- Unit name    : generic package PRIORITIZED_QUEUE
-- Version      : 1.0
-- Author       : John A. Anderson
--              : TEXAS INSTRUMENTS MS 8006
--              : P.O. BOX 801
--              : MCKINNEY, TEXAS   75069
-- DDN Address  : ANDERSON%TI-EG@CSNET-RELAY
-- Copyright    : (c) 1984 John A. Anderson
-- Date created :  OCTOBER  2, 1984
-- Release date :  NOVEMBER 27, 1984
-- Last update  :  ANDERSON Wed Nov 27, 1984
--                                                           -*
---------------------------------------------------------------
--                                                           -*
-- Keywords     :  QUEUE
----------------:  PRIORITIZED QUEUE
--
-- Abstract     :  This generic package creates a Prioritized
----------------:  Queue of objects. The Queue is First-In,
----------------:  First-Out except where overridden by the
----------------:  priority.
----------------:  The priority may be any discrete type.
----------------:  It is assumed that the priorities are from
----------------:  lowest to highest.  The type of data structure
----------------:  to be instantiated for the queue may be any
----------------:  type having assignment and equality.  Other
----------------:  types may be enqueued by using access types.
----------------:  (i.e. Access variable pointing to a task.)
----------------:  The space for the Queue is allocated dynamically
----------------:  with garbage collection left up to the target
----------------:  system.
--                                                           -*
------------------ Revision history ---------------------------
--                                                           -*
-- DATE         VERSION	AUTHOR                  HISTORY
-- 11/27/84	  1.0	Anderson		Initial Release
--                                                           -*
------------------ Distribution and Copyright -----------------
--                                                           -*
-- This prologue must be included in all copies of this software.
--
-- This software is copyright by the author.
--
-- This software is released to the Ada community.
-- This software is released to the Public Domain (note:
--   software released to the Public Domain is not subject
--   to copyright protection).
-- Restrictions on use or distribution:  NONE
--                                                           -*
------------------ Disclaimer ---------------------------------
--                                                           -*
-- This software and its documentation are provided "AS IS" and
-- without any expressed or implied warranties whatsoever.
-- No warranties as to performance, merchantability, or fitness
-- for a particular purpose exist.
--
-- Because of the diversity of conditions and hardware under
-- which this software may be used, no warranty of fitness for
-- a particular purpose is offered.  The user is advised to
-- test the software thoroughly before relying on it.  The user
-- must assume the entire risk and liability of using this
-- software.
--
-- In no event shall any person or organization of people be
-- held responsible for any direct, indirect, consequential
-- or inconsequential damages or lost profits.
--                                                           -*
-------------------END-PROLOGUE--------------------------------

generic
    type ELEMENT_TYPE is private;

    type PRIORITY_TYPE is (<>);

package PRIORITIZED_QUEUE is

    procedure ADD (ELEMENT  : ELEMENT_TYPE;
                   PRIORITY : PRIORITY_TYPE := PRIORITY_TYPE'FIRST);

    procedure REMOVE (ELEMENT : out ELEMENT_TYPE);

    function IS_EMPTY return BOOLEAN;

    UNDERFLOW : exception;

end PRIORITIZED_QUEUE;

package body PRIORITIZED_QUEUE is

    type NODE;

    type LINK is access NODE;

    type NODE is
        record
            VALUE : ELEMENT_TYPE;
            NEXT  : LINK;
        end record;

    type PRIORITY_ARRAY_TYPE is array (PRIORITY_TYPE
                                         range PRIORITY_TYPE'FIRST ..
                                               PRIORITY_TYPE'LAST) of LINK;

    LIST_HEADS : PRIORITY_ARRAY_TYPE;

    LIST_TAILS : PRIORITY_ARRAY_TYPE;

    function IS_EMPTY return BOOLEAN is
        EMPTY_HEADS : PRIORITY_ARRAY_TYPE;
    begin

-- EMPTY_HEADS was initialized to all null
        return (LIST_HEADS = EMPTY_HEADS);

    end IS_EMPTY;

    procedure ADD (ELEMENT  : ELEMENT_TYPE;
                   PRIORITY : PRIORITY_TYPE := PRIORITY_TYPE'FIRST) is

        POINTER : LINK;

    begin
        POINTER := new NODE; -- allocate memory
                             ---------
                             -- assign values to record
                             ---------
        POINTER.VALUE := ELEMENT;
        POINTER.NEXT := null;

---------
-- link to proper priority list of queue
---------
        if LIST_TAILS (PRIORITY) /= null then
            LIST_TAILS (PRIORITY).NEXT := POINTER;
            -- link onto tail of queue
        else
            -- this priority has nothing in it, so
            LIST_HEADS (PRIORITY) := POINTER;
            --   link it to the front
        end if;
        LIST_TAILS (PRIORITY) := POINTER;
        -- set this item to be last in queue
    end ADD;

    procedure REMOVE (ELEMENT : out ELEMENT_TYPE) is
        POINTER      : LINK;
        TEMP_ELEMENT : ELEMENT_TYPE;
        PRIORITY     : PRIORITY_TYPE;
    begin

        if IS_EMPTY then
            raise UNDERFLOW;
        end if;

---------
-- find highest priority with element to be removed
---------
        PRIORITY := PRIORITY_TYPE'LAST;
        while LIST_HEADS (PRIORITY) = null loop
            PRIORITY := PRIORITY_TYPE'PRED (PRIORITY);
        end loop;

---------
-- load ELEMENT with value
---------
        ELEMENT := LIST_HEADS (PRIORITY).VALUE;

        -- remove item from queue
        LIST_HEADS (PRIORITY) := LIST_HEADS (PRIORITY).NEXT;

        if LIST_HEADS (PRIORITY) = null then
            LIST_TAILS (PRIORITY) := null;
        end if;

    end REMOVE;

end PRIORITIZED_QUEUE;