home *** CD-ROM | disk | FTP | other *** search
/ Programmer's ROM - The Computer Language Library / programmersrom.iso / ada / misc / prior.ada < prev    next >
Encoding:
Text File  |  1988-05-03  |  6.2 KB  |  182 lines
  1.  
  2. -------- SIMTEL20 Ada Software Repository Prologue ------------
  3. --                                                           -*
  4. -- Unit name    : generic package PRIORITIZED_QUEUE
  5. -- Version      : 1.0
  6. -- Author       : John A. Anderson
  7. --              : TEXAS INSTRUMENTS MS 8006
  8. --              : P.O. BOX 801
  9. --              : MCKINNEY, TEXAS   75069
  10. -- DDN Address  : ANDERSON%TI-EG@CSNET-RELAY
  11. -- Copyright    : (c) 1984 John A. Anderson
  12. -- Date created :  OCTOBER  2, 1984
  13. -- Release date :  NOVEMBER 27, 1984
  14. -- Last update  :  ANDERSON Wed Nov 27, 1984
  15. --                                                           -*
  16. ---------------------------------------------------------------
  17. --                                                           -*
  18. -- Keywords     :  QUEUE
  19. ----------------:  PRIORITIZED QUEUE
  20. --
  21. -- Abstract     :  This generic package creates a Prioritized
  22. ----------------:  Queue of objects. The Queue is First-In,
  23. ----------------:  First-Out except where overridden by the
  24. ----------------:  priority.
  25. ----------------:  The priority may be any discrete type.
  26. ----------------:  It is assumed that the priorities are from
  27. ----------------:  lowest to highest.  The type of data structure
  28. ----------------:  to be instantiated for the queue may be any
  29. ----------------:  type having assignment and equality.  Other
  30. ----------------:  types may be enqueued by using access types.
  31. ----------------:  (i.e. Access variable pointing to a task.)
  32. ----------------:  The space for the Queue is allocated dynamically
  33. ----------------:  with garbage collection left up to the target
  34. ----------------:  system.
  35. --                                                           -*
  36. ------------------ Revision history ---------------------------
  37. --                                                           -*
  38. -- DATE         VERSION    AUTHOR                  HISTORY
  39. -- 11/27/84      1.0    Anderson        Initial Release
  40. --                                                           -*
  41. ------------------ Distribution and Copyright -----------------
  42. --                                                           -*
  43. -- This prologue must be included in all copies of this software.
  44. --
  45. -- This software is copyright by the author.
  46. --
  47. -- This software is released to the Ada community.
  48. -- This software is released to the Public Domain (note:
  49. --   software released to the Public Domain is not subject
  50. --   to copyright protection).
  51. -- Restrictions on use or distribution:  NONE
  52. --                                                           -*
  53. ------------------ Disclaimer ---------------------------------
  54. --                                                           -*
  55. -- This software and its documentation are provided "AS IS" and
  56. -- without any expressed or implied warranties whatsoever.
  57. -- No warranties as to performance, merchantability, or fitness
  58. -- for a particular purpose exist.
  59. --
  60. -- Because of the diversity of conditions and hardware under
  61. -- which this software may be used, no warranty of fitness for
  62. -- a particular purpose is offered.  The user is advised to
  63. -- test the software thoroughly before relying on it.  The user
  64. -- must assume the entire risk and liability of using this
  65. -- software.
  66. --
  67. -- In no event shall any person or organization of people be
  68. -- held responsible for any direct, indirect, consequential
  69. -- or inconsequential damages or lost profits.
  70. --                                                           -*
  71. -------------------END-PROLOGUE--------------------------------
  72.  
  73. generic
  74.     type ELEMENT_TYPE is private;
  75.  
  76.     type PRIORITY_TYPE is (<>);
  77.  
  78. package PRIORITIZED_QUEUE is
  79.  
  80.     procedure ADD (ELEMENT  : ELEMENT_TYPE;
  81.                    PRIORITY : PRIORITY_TYPE := PRIORITY_TYPE'FIRST);
  82.  
  83.     procedure REMOVE (ELEMENT : out ELEMENT_TYPE);
  84.  
  85.     function IS_EMPTY return BOOLEAN;
  86.  
  87.     UNDERFLOW : exception;
  88.  
  89. end PRIORITIZED_QUEUE;
  90.  
  91. package body PRIORITIZED_QUEUE is
  92.  
  93.     type NODE;
  94.  
  95.     type LINK is access NODE;
  96.  
  97.     type NODE is
  98.         record
  99.             VALUE : ELEMENT_TYPE;
  100.             NEXT  : LINK;
  101.         end record;
  102.  
  103.     type PRIORITY_ARRAY_TYPE is array (PRIORITY_TYPE
  104.                                          range PRIORITY_TYPE'FIRST ..
  105.                                                PRIORITY_TYPE'LAST) of LINK;
  106.  
  107.     LIST_HEADS : PRIORITY_ARRAY_TYPE;
  108.  
  109.     LIST_TAILS : PRIORITY_ARRAY_TYPE;
  110.  
  111.     function IS_EMPTY return BOOLEAN is
  112.         EMPTY_HEADS : PRIORITY_ARRAY_TYPE;
  113.     begin
  114.  
  115. -- EMPTY_HEADS was initialized to all null
  116.         return (LIST_HEADS = EMPTY_HEADS);
  117.  
  118.     end IS_EMPTY;
  119.  
  120.     procedure ADD (ELEMENT  : ELEMENT_TYPE;
  121.                    PRIORITY : PRIORITY_TYPE := PRIORITY_TYPE'FIRST) is
  122.  
  123.         POINTER : LINK;
  124.  
  125.     begin
  126.         POINTER := new NODE; -- allocate memory
  127.                              ---------
  128.                              -- assign values to record
  129.                              ---------
  130.         POINTER.VALUE := ELEMENT;
  131.         POINTER.NEXT := null;
  132.  
  133. ---------
  134. -- link to proper priority list of queue
  135. ---------
  136.         if LIST_TAILS (PRIORITY) /= null then
  137.             LIST_TAILS (PRIORITY).NEXT := POINTER;
  138.             -- link onto tail of queue
  139.         else
  140.             -- this priority has nothing in it, so
  141.             LIST_HEADS (PRIORITY) := POINTER;
  142.             --   link it to the front
  143.         end if;
  144.         LIST_TAILS (PRIORITY) := POINTER;
  145.         -- set this item to be last in queue
  146.     end ADD;
  147.  
  148.     procedure REMOVE (ELEMENT : out ELEMENT_TYPE) is
  149.         POINTER      : LINK;
  150.         TEMP_ELEMENT : ELEMENT_TYPE;
  151.         PRIORITY     : PRIORITY_TYPE;
  152.     begin
  153.  
  154.         if IS_EMPTY then
  155.             raise UNDERFLOW;
  156.         end if;
  157.  
  158. ---------
  159. -- find highest priority with element to be removed
  160. ---------
  161.         PRIORITY := PRIORITY_TYPE'LAST;
  162.         while LIST_HEADS (PRIORITY) = null loop
  163.             PRIORITY := PRIORITY_TYPE'PRED (PRIORITY);
  164.         end loop;
  165.  
  166. ---------
  167. -- load ELEMENT with value
  168. ---------
  169.         ELEMENT := LIST_HEADS (PRIORITY).VALUE;
  170.  
  171.         -- remove item from queue
  172.         LIST_HEADS (PRIORITY) := LIST_HEADS (PRIORITY).NEXT;
  173.  
  174.         if LIST_HEADS (PRIORITY) = null then
  175.             LIST_TAILS (PRIORITY) := null;
  176.         end if;
  177.  
  178.     end REMOVE;
  179.  
  180. end PRIORITIZED_QUEUE;
  181.  
  182.