home *** CD-ROM | disk | FTP | other *** search
/ Mega CD-ROM 1 / megacd_rom_1.zip / megacd_rom_1 / MAGAZINE / PROGJOUR / PJ_9_4.ZIP / DLRING.ADB < prev    next >
Text File  |  1991-05-09  |  5KB  |  147 lines
  1. -- ========================== begin comment ==================================
  2. -- dlring.adb
  3. --
  4. --
  5. --             *******    **  PACKAGE BODY  **       ******
  6. --                        Doubly-Linked Ring
  7. --
  8. --     There would be some benefit in adding a storage management
  9. --     capability, such as a free list handler, to this package.
  10. --     Also, a storage_error exception would enhance the reliability
  11. --     of the Insert procedure.
  12. -- ========================== end comment ====================================
  13.  
  14. package body DLRing is
  15.            --
  16.         ZERO : constant INTEGER := 0;  -- named constant
  17.  
  18.         type CELL is
  19.              record
  20.                     ITEM        : DLRing_Type;
  21.                     PREV_CELL   : POINTER;
  22.                     NEXT_CELL   : POINTER;
  23.              end record;
  24.  
  25.    function Is_Count (Finger : Finger_Type) return Natural is
  26.    begin
  27.         return Finger.Cntr;
  28.    end Is_Count;
  29.  
  30.    procedure ROTATE   (DIRECTION : in DIRECTION_TYPE;
  31.                        FINGER    : in out FINGER_TYPE) is
  32.    begin  -- ROTATE
  33.           --
  34.         if (DIRECTION = FORWARD) then
  35.            FINGER.PTR := FINGER.PTR.NEXT_CELL;
  36.         else
  37.            FINGER.PTR := FINGER.PTR.PREV_CELL;
  38.         end if;
  39.    exception
  40.         when CONSTRAINT_ERROR =>
  41.             Text_IO.Put_Line("Constraint Error during Rotate ");
  42.  
  43.    end ROTATE;
  44.  
  45.  
  46.    procedure INSERT   (ITEM      : in     DLRing_Type;
  47.                        FINGER    : in out FINGER_TYPE) is
  48.              ForWard_Walker  : POINTER;
  49.              BackWard_Walker : POINTER;
  50.    begin  -- INSERT
  51.           --
  52.          if FINGER.CNTR = ZERO then
  53.             FINGER.PTR  := new CELL'(ITEM,null, null);
  54.             FINGER.PTR.NEXT_CELL := FINGER.PTR;
  55.             FINGER.PTR.PREV_CELL := FINGER.PTR;
  56.          else
  57.             BackWard_Walker  := FINGER.PTR.PREV_CELL;
  58.             ForWard_Walker   := FINGER.PTR;
  59.             FINGER.PTR       := new CELL'(ITEM, BackWard_Walker,
  60.                                                 ForWard_Walker);
  61.             BackWard_Walker.NEXT_CELL :=  FINGER.PTR;
  62.             ForWard_Walker.PREV_CELL  :=  FINGER.PTR;
  63.          end if;
  64.  
  65.          FINGER.CNTR := FINGER.CNTR + 1;  -- could be dangerous unless every
  66.                                           -- subprogram handles the count in
  67.                                           -- consistent manner.
  68.  
  69.    exception
  70.          when others =>
  71.             Text_IO.Put_Line("Some error during Insert ");
  72.    end INSERT;
  73.  
  74.    procedure REPLACE  (ITEM      : in     DLRing_Type;
  75.                        FINGER    : in out FINGER_TYPE) is
  76.    begin --  REPLACE
  77.  
  78.              FINGER.PTR.ITEM  := ITEM;
  79.  
  80.    end REPLACE;
  81.  
  82.    procedure DELETE   (FINGER       : in out FINGER_TYPE;
  83.                        EMPTY_ERROR  :    out BOOLEAN)   is
  84.  
  85.              BackWard_Walker, ForWard_Walker  : POINTER;
  86.  
  87.    begin
  88.  
  89.         EMPTY_ERROR := FALSE;
  90.         if FINGER.CNTR  = ZERO  then
  91.            EMPTY_ERROR  := TRUE;
  92.         elsif
  93.            FINGER.CNTR = 1 then
  94.            FINGER.PTR  := null;
  95.            FINGER.CNTR := ZERO;
  96.         else
  97.            BackWard_Walker           := FINGER.PTR.PREV_CELL;
  98.            ForWard_Walker            := FINGER.PTR.NEXT_CELL;
  99.            BackWard_Walker.NEXT_CELL := ForWard_Walker;
  100.            ForWard_Walker.PREV_CELL  := BackWard_Walker;
  101.            FINGER.CNTR               := FINGER.CNTR - 1;
  102.            FINGER.PTR                := ForWard_Walker;
  103.         end if;
  104.    end DELETE;
  105.  
  106.    procedure PEEK     (ITEM         :    out DLRing_Type;
  107.                        FINGER       : in out FINGER_TYPE;
  108.                        EMPTY_ERROR  :    out BOOLEAN)   is
  109.    begin
  110.  
  111.         if (FINGER.CNTR  /=  ZERO)  then
  112.             ITEM        := FINGER.PTR.ITEM;
  113.             EMPTY_ERROR := FALSE;
  114.         else
  115.             EMPTY_ERROR  := TRUE;
  116.         end if;
  117.    exception
  118.         when Constraint_Error =>
  119.            Text_IO.Put_Line("Constraint Error in Peek ");
  120.    end PEEK;
  121.  
  122.  
  123.    procedure SEARCH   (FINGER       : in out FINGER_TYPE;
  124.                        ITEM         : in     DLRing_Type;
  125.                        FOUND        :    out BOOLEAN)   is
  126.  
  127.              NUMBER : INTEGER := FINGER.CNTR;
  128.  
  129.    begin -- SEARCH
  130.  
  131.          for I in 1 .. NUMBER  loop
  132.              if (EQUAL(FINGER.PTR.ITEM, ITEM)) then
  133.                  FOUND := TRUE;
  134.                  return;
  135.              else
  136.                  ROTATE(FORWARD, FINGER);
  137.              end if;
  138.          end loop;
  139.          FOUND := FALSE;
  140.          ROTATE(FORWARD, FINGER);
  141.    exception
  142.          when CONSTRAINT_ERROR =>
  143.               Text_IO.Put_Line("Constraint error in Rotate ");
  144.    end SEARCH;
  145.  
  146. end DLRing;
  147. -- ++++++++++++++++++++ End of Package Body +++++++++++++++++++