-------- SIMTEL20 Ada Software Repository Prologue ------------ -- -* -- Unit name : generic package LIMITED_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 a User-defined Limited number 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.) -- -* ------------------ 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 SIZE : INTEGER; type ELEMENT_TYPE is private; type PRIORITY_TYPE is (<>); package LIMITED_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; function IS_FULL return BOOLEAN; UNDERFLOW : exception; OVERFLOW : exception; end LIMITED_PRIORITIZED_QUEUE; package body LIMITED_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; POOL_HEAD : LINK; POOL_ELEMENT : LINK; 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; function IS_FULL return BOOLEAN is begin -- if the POOL_HEAD is null all -- available resources are in queue return POOL_HEAD = null; end IS_FULL; procedure ADD (ELEMENT : ELEMENT_TYPE; PRIORITY : PRIORITY_TYPE := PRIORITY_TYPE'FIRST) is POINTER : LINK; begin if IS_FULL then raise OVERFLOW; end if; --------- -- obtain record from pool --------- POINTER := POOL_HEAD; -- set POINTER to next available cell POOL_HEAD := POINTER.NEXT; -- reset POOL_HEAD to next available cell --------- -- 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 ELEMENT from queue --------- POINTER := LIST_HEADS (PRIORITY); -- set POINTER to cell to be released LIST_HEADS (PRIORITY) := LIST_HEADS (PRIORITY).NEXT; -- reset queue if LIST_HEADS (PRIORITY) = null then LIST_TAILS (PRIORITY) := null; end if; --------- -- return cell to resource pool --------- POINTER.NEXT := POOL_HEAD; -- link POINTER to Pool POOL_HEAD := POINTER; -- reset POOL_HEAD end REMOVE; begin for COUNT in 1 .. SIZE loop POOL_ELEMENT := new NODE; -- allocate memory POOL_ELEMENT.NEXT := POOL_HEAD; -- link to old head POOL_HEAD := POOL_ELEMENT; -- make this new -- header end loop; end LIMITED_PRIORITIZED_QUEUE;