/* struct::queue - critcl - layer 3 definitions.
 *
 * -> Method functions.
 *    Implementations for all queue methods.
 */

#include "util.h"
#include "m.h"
#include "q.h"
#include "ms.h"

static Tcl_Size qsize  (Q* q, Tcl_Size* u, Tcl_Size* r, Tcl_Size* a);
static void     qshift (Q* q);

#undef QUEUE_DUMP
/*#define QUEUE_DUMP 1*/

#if QUEUE_DUMP
static void qdump  (Q* q);
#else
#define     qdump(q) /* Ignore */
#endif

/* .................................................. */

/*
 *---------------------------------------------------------------------------
 *
 * qum_CLEAR --
 *
 *	Removes all elements currently on the queue. I.e empties the queue.
 *
 * Results:
 *	A standard Tcl result code.
 *
 * Side effects:
 *	Only internal, memory allocation changes ...
 *
 *---------------------------------------------------------------------------
 */

int
qum_CLEAR (Q* q, Tcl_Interp* interp, Tcl_Size objc, Tcl_Obj* CONST* objv)
{
    /* Syntax: queue clear
     *	       [0]   [1]
     */

    if (objc != 2) {
	Tcl_WrongNumArgs (interp, 2, objv, NULL); /* OK tcl9 */
	return TCL_ERROR;
    }

    /*
     * Delete and recreate the queue memory. A combination of delete/new,
     * except the main structure is left unchanged
     */

    Tcl_DecrRefCount (q->unget);
    Tcl_DecrRefCount (q->queue);
    Tcl_DecrRefCount (q->append);

    q->at     = 0;
    q->unget  = Tcl_NewListObj (0,NULL); /* OK tcl9 */
    q->queue  = Tcl_NewListObj (0,NULL); /* OK tcl9 */
    q->append = Tcl_NewListObj (0,NULL); /* OK tcl9 */

    Tcl_IncrRefCount (q->unget); 
    Tcl_IncrRefCount (q->queue); 
    Tcl_IncrRefCount (q->append);

    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * qum_DESTROY --
 *
 *	Destroys the whole queue object.
 *
 * Results:
 *	A standard Tcl result code.
 *
 * Side effects:
 *	Releases memory.
 *
 *---------------------------------------------------------------------------
 */

int
qum_DESTROY (Q* q, Tcl_Interp* interp, Tcl_Size objc, Tcl_Obj* CONST* objv)
{
    /* Syntax: queue destroy
     *	       [0]   [1]
     */

    if (objc != 2) {
	Tcl_WrongNumArgs (interp, 2, objv, NULL); /* OK tcl9 */
	return TCL_ERROR;
    }

    Tcl_DeleteCommandFromToken(interp, q->cmd);
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * qum_PEEK/GET --
 *
 *	(Non-)destructively retrieves one or more elements from the top of the
 *	queue.
 *
 * Results:
 *	A standard Tcl result code.
 *
 * Side effects:
 *	Only internal, memory allocation changes ...
 *
 *---------------------------------------------------------------------------
 */

int
qum_PEEK (Q* q, Tcl_Interp* interp, Tcl_Size objc, Tcl_Obj* CONST* objv, Tcl_Size get)
{
    /* Syntax: queue peek|get ?n?
     *	       [0]  [1]       [2]
     */

    Tcl_Size  listc = 0, ungetc, queuec, appendc;
    Tcl_Obj** listv;
    Tcl_Obj*  r;
    Tcl_Size  n = 1;

    if ((objc != 2) && (objc != 3)) {
	Tcl_WrongNumArgs (interp, 2, objv, "?n?"); /* OK tcl9 */
	return TCL_ERROR;
    }

    if (objc == 3) {
	if (Tcl_GetSizeIntFromObj(interp, objv[2], &n) != TCL_OK) { /* OK tcl9 */
	    return TCL_ERROR;
	} else if (n < 1) {
	    Tcl_AppendResult (interp, "invalid item count ",
			      Tcl_GetString (objv[2]),
			      NULL);
	    return TCL_ERROR;
	}
    }

    if (n > qsize(q, &ungetc, &queuec, &appendc)) {
	Tcl_AppendResult (interp,
			  "insufficient items in queue to fill request",
			  NULL);
	return TCL_ERROR;
    }

    /* 1. We have item on the unget stack
     *    a. Enough to satisfy request.
     *    b. Not enough.
     * 2. We have items in the return buffer.
     *    a. Enough to satisfy request.
     *    b. Not enough.
     * 3. We have items in the append buffer.
     *    a. Enough to satisfy request.
     *    b. Not enough.
     *
     * Case 3. can assume 2b, because an empty return buffer will be filled
     * from the append buffer before looking at either. Case 3. cannot happen
     * for n==1, the return buffer will contain at least one element.
     *
     * We distinguish between single and multi-element requests.
     *
     * XXX AK optimizations - If we can return everything from a single
     * buffer, be it queue, or append, just return the buffer object, do not
     * create something new.
     */

    if (n == 1) {
	if (ungetc) {
	    /* Pull from unget stack */
	    Tcl_ListObjGetElements (interp, q->unget, &listc, &listv); /* OK tcl9 */
	    r = listv [listc-1];
	    Tcl_SetObjResult (interp, r);
	    if (get) {
		/* XXX AK : Should maintain max size info, and proper index, for discard. */
		Tcl_ListObjReplace (interp, q->unget, listc-1, 1, 0, NULL); /* OK tcl9 */
	    }
	} else {
	    qshift (q);
	    Tcl_ListObjGetElements (interp, q->queue, &listc, &listv); /* OK tcl9 */
	    ASSERT_BOUNDS(q->at,listc);
	    r = listv [q->at];
	    Tcl_SetObjResult (interp, r);
	    /*
	     * Note: Doing the SetObj now is important. It increments the
	     * refcount of 'r', allowing it to survive if the 'qshift' below
	     * kills the internal list (q->queue) holding it.
	     */
	    if (get) {
		q->at ++;
		qshift (q);
	    }
	}
    } else {
	/*
	 * Allocate buffer for result, then fill it using the various data
	 * sources.
	 */

	Tcl_Size  i = 0, j;
	Tcl_Obj** resv = NALLOC(n,Tcl_Obj*);

	if (ungetc) {
	    Tcl_ListObjGetElements (interp, q->unget, &listc, &listv); /* OK tcl9 */
	    /*
	     * Note how we are iterating backward in listv. unget is managed
	     * as a stack, avoiding mem-copy operations and both push and pop.
	     */
	    for (j = listc-1;
		 j >= 0 && i < n;
		 j--, i++) {
		ASSERT_BOUNDS(i,n);
		ASSERT_BOUNDS(j,listc);
		resv[i] = listv[j];
		Tcl_IncrRefCount (resv[i]);
	    }
	    if (get) {
		/* XXX AK : Should maintain max size info, and proper index, for discard. */
		Tcl_ListObjReplace (interp, q->unget, j, i, 0, NULL); /* OK tcl9 */
		/* XXX CHECK index calcs. */
	    }
	}
	if (i < n) {
	    qshift (q);
	    Tcl_ListObjGetElements (interp, q->queue, &listc, &listv); /* OK tcl9 */
	    for (j = q->at;
		 j < listc && i < n; 
		 j++, i++) {
		ASSERT_BOUNDS(i,n);
		ASSERT_BOUNDS(j,listc);
		resv[i] = listv[j];
		Tcl_IncrRefCount (resv[i]);
	    }

	    if (get) {
		q->at = j;
		qshift (q);
	    } else if (i < n) {
		/* XX */
		Tcl_ListObjGetElements (interp, q->append, &listc, &listv); /* OK tcl9 */
		for (j = 0;
		     j < listc && i < n; 
		     j++, i++) {
		    ASSERT_BOUNDS(i,n);
		    ASSERT_BOUNDS(j,listc);
		    resv[i] = listv[j];
		    Tcl_IncrRefCount (resv[i]);
		}
	    }
	}

	/*
	 * This can happend if and only if we have to pull data from append,
	 * and get is set. Without get XX would have run and filled the result
	 * to completion.
	 */

	if (i < n) {
	    ASSERT(get,"Impossible 2nd return pull witohut get");
	    qshift (q);
	    Tcl_ListObjGetElements (interp, q->queue, &listc, &listv); /* OK tcl9 */
	    for (j = q->at;
		 j < listc && i < n; 
		 j++, i++) {
		ASSERT_BOUNDS(i,n);
		ASSERT_BOUNDS(j,listc);
		resv[i] = listv[j];
		Tcl_IncrRefCount (resv[i]);
	    }
	    q->at = j;
	    qshift (q);
	}

	r = Tcl_NewListObj (n, resv); /* OK tcl9 */
	Tcl_SetObjResult (interp, r);

	for (i=0;i<n;i++) {
	    Tcl_DecrRefCount (resv[i]);
	}
	ckfree((char*)resv);
    }

    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * qum_PUT --
 *
 *	Adds one or more elements to the queue.
 *
 * Results:
 *	A standard Tcl result code.
 *
 * Side effects:
 *	May release and allocate memory.
 *
 *---------------------------------------------------------------------------
 */

int
qum_PUT (Q* q, Tcl_Interp* interp, Tcl_Size objc, Tcl_Obj* CONST* objv)
{
    /* Syntax: queue push item...
     *	       [0]   [1]  [2]
     */

    Tcl_Size i;

    if (objc < 3) {
	Tcl_WrongNumArgs (interp, 2, objv, "item ?item ...?"); /* OK tcl9 */
	return TCL_ERROR;
    }

    for (i = 2; i < objc; i++) {
	Tcl_ListObjAppendElement (interp, q->append, objv[i]);
    }

    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * qum_UNGET --
 *
 *	Pushes an element back into the queue.
 *
 * Results:
 *	A standard Tcl result code.
 *
 * Side effects:
 *	May release and allocate memory.
 *
 *---------------------------------------------------------------------------
 */

int
qum_UNGET (Q* q, Tcl_Interp* interp, Tcl_Size objc, Tcl_Obj* CONST* objv)
{
    /* Syntax: queue unget item
     *	       [0]   [1]   [2]
     */

    if (objc != 3) {
	Tcl_WrongNumArgs (interp, 2, objv, "item"); /* OK tcl9 */
	return TCL_ERROR;
    }

    if (q->at == 0) {
	/* Need the unget stack */
	Tcl_ListObjAppendElement (interp, q->unget, objv[2]);
    } else {
	/*
	 * We have room in the return buffer, so splice directly instead of
	 * using the unget stack.
	 */

	Tcl_Size queuec = 0;
	Tcl_ListObjLength (NULL, q->queue,  &queuec); /* OK tcl9 */

	q->at --;
	ASSERT_BOUNDS(q->at,queuec);
	Tcl_ListObjReplace (interp, q->queue, q->at, 1, 1, &objv[2]); /* OK tcl9 */
    }

    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * qum_SIZE --
 *
 *	Returns the number of elements currently held by the queue.
 *
 * Results:
 *	A standard Tcl result code.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

int
qum_SIZE (Q* q, Tcl_Interp* interp, Tcl_Size objc, Tcl_Obj* CONST* objv)
{
    /* Syntax: queue size
     *	       [0]   [1]
     */

    if ((objc != 2)) {
	Tcl_WrongNumArgs (interp, 2, objv, NULL); /* OK tcl9 */
	return TCL_ERROR;
    }

    Tcl_SetObjResult (interp, Tcl_NewSizeIntObj (qsize (q, NULL, NULL, NULL)));
    return TCL_OK;
}


static Tcl_Size
qsize (Q* q, Tcl_Size* u, Tcl_Size* r, Tcl_Size* a)
{
    Tcl_Size ungetc  = 0;
    Tcl_Size queuec  = 0;
    Tcl_Size appendc = 0;

    Tcl_ListObjLength (NULL, q->unget,  &ungetc ); /* OK tcl9 */
    Tcl_ListObjLength (NULL, q->queue,  &queuec ); /* OK tcl9 */
    Tcl_ListObjLength (NULL, q->append, &appendc); /* OK tcl9 */

    if (u) *u = ungetc;
    if (r) *r = queuec;
    if (a) *a = appendc;

    return ungetc + queuec + appendc - q->at;
}

static void
qshift (Q* q)
{
    Tcl_Size queuec  = 0;
    Tcl_Size appendc = 0;

    qdump (q);

    /* The queue is not done yet, no shift */
    Tcl_ListObjLength (NULL, q->queue, &queuec); /* OK tcl9 */
    if (q->at < queuec) return;

    /* The queue is done, however there is nothing
     * to shift into it, so we don't
     */
    Tcl_ListObjLength (NULL, q->append, &appendc); /* OK tcl9 */
    if (!appendc) return;

    q->at = 0;
    Tcl_DecrRefCount (q->queue);
    q->queue  = q->append;
    q->append = Tcl_NewListObj (0,NULL); /* OK tcl9 */
    Tcl_IncrRefCount (q->append);

    qdump (q);
}

#ifdef QUEUE_DUMP
static void
qdump (Q* q)
{
    Tcl_Size  listc = 0, k;
    Tcl_Obj** listv;

    fprintf(stderr,"qdump (%p, @%d)\n", q, q->at);fflush(stderr);

    fprintf(stderr,"\tunget %p\n", q->unget);fflush(stderr);
    Tcl_ListObjGetElements (NULL, q->unget, &listc, &listv); /* OK tcl9 */
    for (k=0; k < listc; k++) {
	fprintf(stderr,"\tunget %p [%d] = %p '%s' /%d\n", q->unget, k, listv[k], Tcl_GetString(listv[k]), listv[k]->refCount);fflush(stderr);
    }

    fprintf(stderr,"\tqueue %p\n", q->queue);fflush(stderr);
    Tcl_ListObjGetElements (NULL, q->queue, &listc, &listv); /* OK tcl9 */
    for (k=0; k < listc; k++) {
	fprintf(stderr,"\tqueue %p [%d] = %p '%s' /%d\n", q->queue, k, listv[k], Tcl_GetString(listv[k]), listv[k]->refCount);fflush(stderr);
    }

    fprintf(stderr,"\tapp.. %p\n", q->append);fflush(stderr);
    Tcl_ListObjGetElements (NULL, q->append, &listc, &listv); /* OK tcl9 */
    for (k=0; k < listc; k++) {
	fprintf(stderr,"\tapp.. %p [%d] = %p '%s' /%d\n", q->append, k, listv[k], Tcl_GetString(listv[k]), listv[k]->refCount);fflush(stderr);
    }

    fprintf(stderr,"qdump/ ___________________\n");fflush(stderr);
}
#endif

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */