--synopsys synthesis_off
----------------------------------------------------------------------------
--
-- Copyright (c) 1990, 1991, 1992 by Synopsys, Inc.  All rights reserved. 
--
--	This program is proprietary and confidential information of
--	Synopsys, Inc. and may be used and disclosed only as authorized 
--	in a license agreement controlling such use and disclosure.
--
--	Package name: vhdlq.vhd
--
--	Purpose: This package defines a queue type and operations on that
--		 type.  This package can be copied and changed to allow
--		 queueing different types and to allow a different maximum
--		 queue length.
--
--	Author: PH
--
----------------------------------------------------------------------------

--
-- Generic non-zero length queue package.
--
-- To make you own queue type:
--	1. Make a copy of this package.
--	2. Change the name of the package (both specification and body).
--	3. Change the subtype indication in the declaration of QE_TYPE.
--	4. Change the initial value of QMAX.
--
-- To use a queue:
--	1. Declare a signal of the queue type:
--		signal IQ: INTEGER_QUEUES.QTYPE;
--	2. Use PUT and SEND to enqueue data:
--		PUT(E, IQ);
--	3. Use GET and RECEIVE to dequeue data:
--		RECEIVE(E, IQ);
--	4. Notes about PUT, SEND, GET, RECEIVE:
--		a. PUT/GET raises an error if the queue is full/empty;
--		    SEND/RECEIVE blocks until the operation can be completed.
--		b. These four procedures take an optional parameter (PRIORITY)
--		    that is used to choose between multiple processes that
--		    want to operate on the queue at the same instant of
--		    simulated time.  An error is raised if multiple processes
--		    want to operate simultaneously on the queue and each
--		    process does not have a unique priority.
--		c. Lower PRIORITY numbers are serviced before higher PRIORITY
--		    numbers.
--		d. Each of these procedures will consume at least 2
--		    simulation cycles (more if an operation blocks or multiple
--		    processes wish to operate on the queue simultaneously).
--	5. Use EMPTY, FULL, and LENGTH to inspect the current state of the
--	    queue.
--	6. To ensure the consistency of the queue abstraction, the queue object
--	    should not be directly read or updated (except through port
--	    association), but manipulated only through the PUT, GET, SEND,
--	    RECEIVE, EMPTY, FULL, and LENGTH subprograms.  (Exception is
--	    instrumentation, see next point).
--	7. Several components of the queue data structure are maintained
--	    so that the user can instrument the use of the queue.  These
--	    components can be safely read, monitored, and traced from
--	    within the simulator.  For a queue Q, these components are:
--		Q.Q.length	The length of the queue.  Same value as
--				returned by the function LENGTH.
--		Q.Q.Qput	Last value inserted into Q by a put operation.
--		Q.Q.Qget	Last value removed from Q by a get operation.
--		Q.Q.Qsend	Last value inserted into Q by a send operation.
--				This is updated when a process returns from
--				a call on SEND.
--		Q.Q.Qreceive	Last value removed from Q by a receive
--				operation.  This is updated when a process
--				returns from a call on RECEIVE.
--		Q.Q.Qswait	The length of time the last process which
--				returned from a SEND waited.
--		Q.Q.Qrwait	The length of time the last process which
--				returned from a RECEIVE waited.
--		Q.Q.Qwait	The length of time the last queue element
--				removed from the queue by either a GET or
--				RECEIVE operation was in the queue plus the
--				length of time its sender was delayed.
--				(I.e. the length of time between when the
--				value was sent and when it was received.)
--		Q.C.Qslength	The number of waiting senders.
--		Q.C.Qrlength	The number of waiting receivers.
--	8. If you don't want this instrumentation, you can delete all the
--	    lines in this file that contain --INSTRUMENTATION--.  This
--	    will make your queue take less space.
--
library SYNOPSYS;
use SYNOPSYS.ATTRIBUTES.REFLEXIVE;
package INTEGER_QUEUES is

  subtype QE_TYPE is INTEGER;	-- replace INTEGER with type to be queued.
  constant QMAX: positive := 1;	-- replace 1 with desired maximum queue length.

  --
  -- The rest of the declarations in the package specification and body
  -- should not be modified.
  --

  subtype QRANGE is integer range 0 to QMAX-1;
  type QA_TYPE is array (QRANGE) of QE_TYPE;
  type Qta is array (QRANGE) of TIME;	--INSTRUMENTATION--

  --
  -- QDATA is a record which describes the current state of the queue.  The
  -- queue is implemented as a circular buffer.
  --	A is an array of the elements which are being queued.
  --	LENGTH is the number of elements currently queued.
  --	HEAD points to the next available slot in the queue.
  --	TAIL points to the item that has been in the queue the longest.
  --	SEQUENCE is used by the queue data resolution function to determine
  --	    what the current state of the queue is.
  --
  type QDATA is record
    A: QA_TYPE;
    HEAD, TAIL: QRANGE;
    LENGTH: integer range 0 to QMAX;
    SEQUENCE: integer;
    --INSTRUMENTATION-- The following components are for instrumentation only.
    Qput, Qget, Qsend, Qreceive: QE_TYPE;	--INSTRUMENTATION--
    Qswait, Qrwait: TIME;	--INSTRUMENTATION--
    Qtarray: Qta;	--INSTRUMENTATION--
    Qwait: TIME;	--INSTRUMENTATION--
  end record;

  type QOP is (Q_NOP, Q_GET, Q_PUT);

  --
  -- QCONTROL is a record which controls access to the data part of the queue
  -- object.
  --	PRIORITY is the priority of the process requesting access to the queue.
  --	OP is used to determine if a process is currently requesting access
  --	    to the queue.
  --
  type QCONTROL is record
    PRIORITY: natural;
    OP: QOP;
    --INSTRUMENTATION-- The following components are for instrumentation only.
    Qslength, Qrlength: NATURAL;	--INSTRUMENTATION--
  end record;

  type QDA is array (natural range <>) of QDATA;
  type QCA is array (natural range <>) of QCONTROL;
  function QDRF (X: QDA) return QDATA;
  function QCRF (X: QCA) return QCONTROL;
  -- For performance improvement on Synopsys's simulator:
  attribute REFLEXIVE of QDRF, QCRF: function is TRUE;

  type QTYPE is record
    Q: QDRF QDATA;
    C: QCRF QCONTROL;
  end record;

  procedure PUT(E: QE_TYPE;
		signal Q: inout QTYPE;
		PRIORITY: natural := 0);

  procedure GET(E: out QE_TYPE;
		signal Q: inout QTYPE;
		PRIORITY: natural := 0);

  procedure SEND(E: QE_TYPE;
		 signal Q: inout QTYPE;
		 PRIORITY: natural := 0);

  procedure RECEIVE(E: out QE_TYPE;
		    signal Q: inout QTYPE;
		    PRIORITY: natural := 0);

  function EMPTY(Q: QTYPE) return boolean;

  function FULL(Q: QTYPE) return boolean;

  function LENGTH(Q: QTYPE) return natural;
end;

package body INTEGER_QUEUES is
  --
  -- Resolving the data part of the queue object is simply picking the
  -- record with the largest sequence number.  We can gaurantee uniqueness of
  -- sequence numbers by requiring a process to gain mutual exclusion of the
  -- data part of the queue object (using the control part) before reading/
  -- updating it.
  --
  function QDRF (X: QDA) return QDATA is
    variable MAX: integer;
    variable MAX_I: integer range X'range;
  begin
    for I in X'RANGE loop
      next when X(I).SEQUENCE < MAX;
      assert X(I).SEQUENCE = integer'left or X(I).SEQUENCE /= MAX
        report "Internal Queueing Error in resolution function QDRF"
        severity failure;
      MAX := X(I).SEQUENCE;
      MAX_I := I;
    end loop;
    return X(MAX_I);
  end;

  --
  -- We Resolve the control part of the queue object by picking the control
  -- record with the lowest PRIORITY number that is requesting access to
  -- the queue (OP /= Q_NOP).  An error is raised if multiple processes
  -- with the same PRIORITY request access to the queue simultaneously.
  --
  function QCRF (X: QCA) return QCONTROL is
    variable R: QCONTROL;
  begin
    for I in X'RANGE loop
      R.Qslength := R.Qslength + X(I).Qslength;	--INSTRUMENTATION--
      R.Qrlength := R.Qrlength + X(I).Qrlength;	--INSTRUMENTATION--
      next when X(I).OP = Q_NOP;
      if R.OP = Q_NOP or X(I).PRIORITY < R.PRIORITY then
	R.OP := X(I).OP;
	R.PRIORITY := X(I).PRIORITY;
	next;
      end if;
      assert X(I).PRIORITY > R.PRIORITY
	report "Two processes operating on the same queue at the same time with the same priority"
	severity FAILURE;
    end loop;
    return R;
  end;

  --
  -- ENTER is used to enter a critical section of code.  When this procedure
  -- returns, the caller knows he has mutual exclusion over the queue.
  --
  procedure ENTER(signal Q: inout QTYPE; PRIORITY: natural; OP: QOP) is
  begin
    Q.C.PRIORITY <= PRIORITY;
    Q.C.OP <= OP;
    wait on Q.C until Q.C.PRIORITY = PRIORITY;
  end;

  --
  -- LEAVE signals the end of a critical section of code.  This procedure
  -- relinquishes mutually exclusive access to the queue.
  --
  procedure LEAVE(signal Q: inout QTYPE) is
  begin
    Q.C.OP <= Q_NOP;
    wait for 0 ns;
  end;

  function EMPTY(Q: QTYPE) return boolean is
  begin
    return Q.Q.LENGTH = 0;
  end;

  function FULL(Q: QTYPE) return boolean is
  begin
    return Q.Q.LENGTH = QMAX;
  end;

  function LENGTH(Q: QTYPE) return natural is
    variable R: integer := Q.Q.HEAD - Q.Q.TAIL;
  begin
    return Q.Q.LENGTH;
  end;

  --
  -- ENQUEUE enqueues an item on the given queue.  This procedure assumes
  -- that there is space in the queue for the item, and that mutual exclusion
  -- over the queue has been acquired.
  --
  procedure ENQUEUE(E: QE_TYPE; signal Q: inout QTYPE; T: Time := 0 ns) is
    variable R: QDATA := Q.Q;
  begin
    R.SEQUENCE := R.SEQUENCE + 1;
    R.LENGTH := R.LENGTH + 1;
    R.A(R.HEAD) := E;
    R.Qtarray(R.HEAD) := NOW-T;	--INSTRUMENTATION--
    if (R.HEAD = QRANGE'RIGHT) then
      R.HEAD := QRANGE'LEFT;
    else
      R.HEAD := QRANGE'SUCC(R.HEAD);
    end if;
    Q.Q <= R;
  end;

  --
  -- DEQUEUE dequeues the next element from the given queue.  This procedure
  -- assumes that the queue is not empty and that mutual exclusion over the
  -- the queue has been acquired.
  --
  procedure DEQUEUE(E: out QE_TYPE; signal Q: inout QTYPE) is
    variable R: QDATA := Q.Q;
  begin
    R.SEQUENCE := R.SEQUENCE + 1;
    E := R.A(R.TAIL);
    R.Qwait := NOW-R.Qtarray(R.TAIL);	--INSTRUMENTATION--
    if R.TAIL = QRANGE'RIGHT then
      R.TAIL := QRANGE'LEFT;
    else
      R.TAIL := QRANGE'SUCC(R.TAIL);
    end if;
    R.LENGTH := R.LENGTH - 1;
    Q.Q <= R;
  end;

  procedure PUT(E: QE_TYPE; signal Q: inout QTYPE; PRIORITY: natural := 0) is
  begin
    ENTER(Q, PRIORITY, Q_PUT);
    assert not FULL(Q) and QA_TYPE'length > 0
      report "Tried to PUT on full queue"
      severity FAILURE;
    ENQUEUE(E, Q);
    Q.Q.Qput <= E;	--INSTRUMENTATION--
    LEAVE(Q);
  end PUT;

  procedure GET(E: out QE_TYPE; signal Q: inout QTYPE; PRIORITY: natural := 0) is
    variable X: QE_TYPE;
  begin
    ENTER(Q, PRIORITY, Q_GET);
    assert not EMPTY(Q) and QA_TYPE'length > 0
      report "Tried to GET from empty queue"
      severity FAILURE;
    DEQUEUE(X, Q);
    E := X;
    Q.Q.Qget <= X;	--INSTRUMENTATION--
    LEAVE(Q);
  end GET;

  procedure SEND(E: QE_TYPE; signal Q: inout QTYPE; PRIORITY: natural := 0) is
    variable XT: TIME := NOW;
  begin
    Q.C.Qslength <= 1;	--INSTRUMENTATION--
    loop
      if FULL(Q) then
	wait until not FULL(Q);
      end if;
      ENTER(Q, PRIORITY, Q_PUT);
      if FULL(Q) then
	LEAVE(Q);
	next;
      end if;
      exit;
    end loop;
    ENQUEUE(E, Q, NOW-XT);
    Q.C.Qslength <= 0;	--INSTRUMENTATION--
    Q.Q.Qswait <= NOW - XT;	--INSTRUMENTATION--
    Q.Q.Qsend <= E;	--INSTRUMENTATION--
    LEAVE(Q);
  end SEND;

  procedure RECEIVE(E: out QE_TYPE; signal Q: inout QTYPE; PRIORITY: natural := 0) is
    variable XT: TIME := NOW;	--INSTRUMENTATION--
    variable X: QE_TYPE;
  begin
    Q.C.Qrlength <= 1;	--INSTRUMENTATION--
    loop
      if EMPTY(Q) then
	wait until not EMPTY(Q);
      end if;
      ENTER(Q, PRIORITY, Q_GET);
      if EMPTY(Q) then
	LEAVE(Q);
	next;
      end if;
      exit;
    end loop;
    DEQUEUE(X, Q);
    E := X;
    Q.C.Qrlength <= 0;	--INSTRUMENTATION--
    Q.Q.Qrwait <= NOW - XT;	--INSTRUMENTATION--
    Q.Q.Qreceive <= X;	--INSTRUMENTATION--
    LEAVE(Q);
  end RECEIVE;
end;
--synopsys synthesis_on