-- Environment source for exception exercise -- Currently number 4 in queue module -- Reduced -debug version--19-10-83 -- author: Bob Laddaga Package QUEUE_PKG is --a package implementing circular queues. MAX_COUNT : constant INTEGER := 4; type QUEUE is private; Q_IS_EMPTY, Q_IS_FULL : exception; function EMPTY_Q ( Q : QUEUE ) return BOOLEAN; -- Returns TRUE if Q is empty, FALSE otherwise. function FULL_Q ( Q : QUEUE ) return BOOLEAN; -- Returns TRUE if QUEUE is full, FALSE otherwise. procedure ENQUEUE ( Q : in out QUEUE; IN_ITEM : in INTEGER ); -- Adds IN_ITEM to the front of Q. -- Raises Q_IS_FULL if Q is full. procedure DEQUEUE ( Q : in out QUEUE; OUT_ITEM : out INTEGER ); -- Removes an item from the rear of Q, returning it in OUT_ITEM. -- Raises Q_IS_EMPTY if Q is empty. procedure PRINT( STR : in STRING; Q : in QUEUE ); --add echo parameter? -- Prints queues. Str can be any string, but is usually the name. procedure MAKE_Q( Q : in out QUEUE ); private MAX_SIZE : constant INTEGER := MAX_COUNT - 1; subtype MODNUM is INTEGER range 0 .. MAX_SIZE; subtype COUNTNUM is INTEGER range 0 .. MAX_COUNT; type Q_ARR is array ( 0 .. MAX_SIZE ) of INTEGER; type QUEUE is record FRONT : MODNUM := 1; REAR : MODNUM := 0; COUNT : COUNTNUM := 0; ITEM : Q_ARR; end record; end QUEUE_PKG; with TEXT_IO; use TEXT_IO; package body QUEUE_PKG is package INT_IO is new INTEGER_IO( INTEGER ); use INT_IO; function MODADD1( I : MODNUM ) return MODNUM is -- the function which takes an integer between 0 and -- MAX_SIZE and returns the integer incremented by 1 -- modulo MAX_SIZE + 1. begin return ( (I + 1) mod MAX_COUNT ); end MODADD1; function EMPTY_Q ( Q : QUEUE ) return BOOLEAN is -- Returns TRUE if the Q is empty FALSE otherwise. begin return ( Q.COUNT = 0 ); end EMPTY_Q; function FULL_Q ( Q : QUEUE ) return BOOLEAN is -- Returns TRUE if the Q is full FALSE otherwise. begin return ( Q.COUNT = MAX_COUNT ); end FULL_Q; procedure ENQUEUE ( Q : in out QUEUE; IN_ITEM : in INTEGER ) is -- Adds IN_ITEM to the front of Q. -- Does nothing (just returns) if Q is full. begin if FULL_Q( Q ) then raise Q_IS_FULL; end if; Q.REAR := MODADD1( Q.REAR ); Q.ITEM(Q.REAR) := IN_ITEM; Q.COUNT := Q.COUNT + 1; end ENQUEUE; procedure DEQUEUE ( Q : in out QUEUE; OUT_ITEM : out INTEGER ) is -- Removes an item from the rear of Q, returning it in OUT_ITEM. -- Does nothing (just returns) if Q is empty. begin if EMPTY_Q( Q ) then raise Q_IS_EMPTY; end if; OUT_ITEM := Q.ITEM( Q.FRONT ); Q.FRONT := MODADD1( Q.FRONT ); Q.COUNT := Q.COUNT - 1; end DEQUEUE; procedure PRINT( STR : in STRING; Q : in QUEUE ) is begin put( STR ); NEW_LINE(1); PUT( "FRONT : " ); PUT( Q.FRONT ); NEW_LINE(1); PUT( "REAR : " ); PUT( Q.REAR ); NEW_LINE(1); PUT( "COUNT : " ); PUT( Q.COUNT ); NEW_LINE(1); for I in Q.FRONT .. Q.REAR loop PUT( I ); PUT( " : " ); PUT( Q.ITEM(I) ); NEW_LINE(1); end loop; NEW_LINE(1); end PRINT; procedure MAKE_Q( Q : in out QUEUE ) is begin -- Q := ( 1, 3, 3, (0,1,2,3)); Q := (FRONT => 1, REAR => 3, COUNT => 3, ITEM => (0,1,2,3)); end MAKE_Q; end QUEUE_PKG; with QUEUE_PKG, TEXT_IO; use QUEUE_PKG, TEXT_IO; procedure EXERCISE_EXCEPTION_Q is INPUT_LENGTH : constant INTEGER := 30; INPUT_STRING : STRING (1 .. INPUT_LENGTH) := "a2 A4 A8 ra9 rrRa2 a4 a8 a9 q "; THE_Q : QUEUE; procedure MANAGE_Q( Q : in out QUEUE ) is NUM_STR : STRING (1..1) := " "; IN_CHAR : CHARACTER; QVAL : INTEGER; J : INTEGER := 1; begin -- MANAGE_Q while J <= INPUT_LENGTH loop IN_CHAR := INPUT_STRING (J); J := J + 1; if IN_CHAR = 'Q' or IN_CHAR = 'q' then exit; elsif IN_CHAR = 'A' or IN_CHAR = 'a' then ENQUEUE_BLK: declare II : INTEGER; begin NUM_STR := INPUT_STRING(J..J); J := J + 1; QVAL := INTEGER'VALUE( NUM_STR ); ENQUEUE( Q, QVAL ); exception when Q_IS_FULL => PRINT( "Queue is full:", Q ); when DATA_ERROR => PUT( "Data Error, try again."); end ENQUEUE_BLK; elsif IN_CHAR = 'R' or IN_CHAR = 'r' then DEQUEUE_BLK: declare II : INTEGER; begin DEQUEUE( Q, QVAL ); exception when Q_IS_EMPTY => PRINT( "Queue is empty:", Q ); end DEQUEUE_BLK; end if; end loop; exception when others => PUT( "What happened?" ); end MANAGE_Q; begin -- EXERCISE_EXCEPTION_Q MAKE_Q( THE_Q ); MANAGE_Q( THE_Q ); end EXERCISE_EXCEPTION_Q;