/*
 * s t a c k . c
 * Forth Inspired Command Language
 * Author: John Sadler (john_sadler@alum.mit.edu)
 * Created: 16 Oct 1997
 * $Id: stack.c,v 1.11 2010/08/12 13:57:22 asau Exp $
 */
/*
 * Copyright (c) 1997-2001 John Sadler (john_sadler@alum.mit.edu)
 * All rights reserved.
 *
 * Get the latest Ficl release at http://ficl.sourceforge.net
 *
 * I am interested in hearing from anyone who uses Ficl. If you have
 * a problem, a success story, a defect, an enhancement request, or
 * if you would like to contribute to the Ficl release, please
 * contact me by email at the address above.
 *
 * L I C E N S E  and  D I S C L A I M E R
 *
 * Redistribution and use in source and binary forms, with or without
 * modification, are permitted provided that the following conditions
 * are met:
 * 1. Redistributions of source code must retain the above copyright
 *    notice, this list of conditions and the following disclaimer.
 * 2. Redistributions in binary form must reproduce the above copyright
 *    notice, this list of conditions and the following disclaimer in the
 *    documentation and/or other materials provided with the distribution.
 *
 * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
 * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
 * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
 * ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
 * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
 * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
 * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
 * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
 * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
 * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
 * SUCH DAMAGE.
 */

#include "ficl.h"

#define STKDEPTH(s)     (((s)->top - (s)->base) + 1)

/*
 * N O T E: Stack convention:
 *
 * THIS CHANGED IN FICL 4.0!
 *
 * top points to the *current* top data value
 * push: increment top, store value at top
 * pop:  fetch value at top, decrement top
 * Stack grows from low to high memory
 */

/*
 * v m C h e c k S t a c k
 * Check the parameter stack for underflow or overflow.
 * size controls the type of check: if size is zero,
 * the function checks the stack state for underflow and overflow.
 * If size > 0, checks to see that the stack has room to push
 * that many cells. If less than zero, checks to see that the
 * stack has room to pop that many cells. If any test fails,
 * the function throws (via vmThrow) a VM_ERREXIT exception.
 */
void
ficlStackCheck(ficlStack *stack, int popCells, int pushCells)
{
#if FICL_ROBUST >= 1
        int nFree = stack->size - STKDEPTH(stack);

        if (popCells > STKDEPTH(stack))
                ficlVmThrowError(stack->vm, "Error: %s stack underflow",
                    stack->name);

        if (nFree < pushCells - popCells)
                ficlVmThrowError(stack->vm, "Error: %s stack overflow",
                    stack->name);
#else /* FICL_ROBUST >= 1 */
        FICL_IGNORE(stack);
        FICL_IGNORE(popCells);
        FICL_IGNORE(pushCells);
#endif /* FICL_ROBUST >= 1 */
}

/*
 * s t a c k C r e a t e
 */

ficlStack *
ficlStackCreate(ficlVm *vm, char *name, unsigned size)
{
        size_t totalSize = sizeof (ficlStack) + (size * sizeof (ficlCell));
        ficlStack *stack = ficlMalloc(totalSize);

        FICL_VM_ASSERT(vm, size != 0);
        FICL_VM_ASSERT(vm, stack != NULL);

        stack->size = size;
        stack->frame = NULL;

        stack->vm = vm;
        stack->name = name;

        ficlStackReset(stack);
        return (stack);
}

/*
 *                  s t a c k D e l e t e
 */
void
ficlStackDestroy(ficlStack *stack)
{
        if (stack)
                ficlFree(stack);
}

/*
 * s t a c k D e p t h
 */
int
ficlStackDepth(ficlStack *stack)
{
        return (STKDEPTH(stack));
}

/*
 * s t a c k D r o p
 */
void
ficlStackDrop(ficlStack *stack, int n)
{
        FICL_VM_ASSERT(stack->vm, n > 0);
        stack->top -= n;
}

/*
 * s t a c k F e t c h
 */
ficlCell
ficlStackFetch(ficlStack *stack, int n)
{
        return (stack->top[-n]);
}

void
ficlStackStore(ficlStack *stack, int n, ficlCell c)
{
        stack->top[-n] = c;
}

/*
 * s t a c k G e t T o p
 */
ficlCell
ficlStackGetTop(ficlStack *stack)
{
        return (stack->top[0]);
}

#if FICL_WANT_LOCALS
/*
 * s t a c k L i n k
 * Link a frame using the stack's frame pointer. Allot space for
 * size cells in the frame
 * 1) Push frame
 * 2) frame = top
 * 3) top += size
 */
void
ficlStackLink(ficlStack *stack, int size)
{
        ficlStackPushPointer(stack, stack->frame);
        stack->frame = stack->top + 1;
        stack->top += size;
}

/*
 * s t a c k U n l i n k
 * Unink a stack frame previously created by stackLink
 * 1) top = frame
 * 2) frame = pop()
 */
void
ficlStackUnlink(ficlStack *stack)
{
        stack->top = stack->frame - 1;
        stack->frame = ficlStackPopPointer(stack);
}
#endif /* FICL_WANT_LOCALS */

/*
 *                  s t a c k P i c k
 */
void
ficlStackPick(ficlStack *stack, int n)
{
        ficlStackPush(stack, ficlStackFetch(stack, n));
}

/*
 * s t a c k P o p
 */
ficlCell
ficlStackPop(ficlStack *stack)
{
        return (*stack->top--);
}

void *
ficlStackPopPointer(ficlStack *stack)
{
        return ((*stack->top--).p);
}

ficlUnsigned
ficlStackPopUnsigned(ficlStack *stack)
{
        return ((*stack->top--).u);
}

ficlInteger
ficlStackPopInteger(ficlStack *stack)
{
        return ((*stack->top--).i);
}

ficl2Integer
ficlStackPop2Integer(ficlStack *stack)
{
        ficl2Integer ret;
        ficlInteger high = ficlStackPopInteger(stack);
        ficlInteger low = ficlStackPopInteger(stack);
        FICL_2INTEGER_SET(high, low, ret);
        return (ret);
}

ficl2Unsigned
ficlStackPop2Unsigned(ficlStack *stack)
{
        ficl2Unsigned ret;
        ficlUnsigned high = ficlStackPopUnsigned(stack);
        ficlUnsigned low = ficlStackPopUnsigned(stack);
        FICL_2UNSIGNED_SET(high, low, ret);
        return (ret);
}

#if (FICL_WANT_FLOAT)
ficlFloat
ficlStackPopFloat(ficlStack *stack)
{
        return ((*stack->top--).f);
}
#endif

/*
 * s t a c k P u s h
 */
void
ficlStackPush(ficlStack *stack, ficlCell c)
{
        *++stack->top = c;
}

void
ficlStackPushPointer(ficlStack *stack, void *ptr)
{
        ficlCell c;

        c.p = ptr;
        *++stack->top = c;
}

void
ficlStackPushInteger(ficlStack *stack, ficlInteger i)
{
        ficlCell c;

        c.i = i;
        *++stack->top = c;
}

void
ficlStackPushUnsigned(ficlStack *stack, ficlUnsigned u)
{
        ficlCell c;

        c.u = u;
        *++stack->top = c;
}

void
ficlStackPush2Unsigned(ficlStack *stack, ficl2Unsigned du)
{
        ficlStackPushUnsigned(stack, FICL_2UNSIGNED_GET_LOW(du));
        ficlStackPushUnsigned(stack, FICL_2UNSIGNED_GET_HIGH(du));
}

void
ficlStackPush2Integer(ficlStack *stack, ficl2Integer di)
{
        ficl2Unsigned du;
        FICL_2UNSIGNED_SET(FICL_2UNSIGNED_GET_HIGH(di),
            FICL_2UNSIGNED_GET_LOW(di), du);
        ficlStackPush2Unsigned(stack, du);
}

#if (FICL_WANT_FLOAT)
void
ficlStackPushFloat(ficlStack *stack, ficlFloat f)
{
        ficlCell c;

        c.f = f;
        *++stack->top = c;
}
#endif

/*
 * s t a c k R e s e t
 */
void
ficlStackReset(ficlStack *stack)
{
        stack->top = stack->base - 1;
}

/*
 * s t a c k R o l l
 * Roll nth stack entry to the top (counting from zero), if n is
 * >= 0. Drop other entries as needed to fill the hole.
 * If n < 0, roll top-of-stack to nth entry, pushing others
 * upward as needed to fill the hole.
 */
void
ficlStackRoll(ficlStack *stack, int n)
{
        ficlCell c;
        ficlCell *cell;

        if (n == 0)
                return;
        else if (n > 0) {
                cell = stack->top - n;
                c = *cell;

                for (; n > 0; --n, cell++) {
                        *cell = cell[1];
                }

                *cell = c;
        } else {
                cell = stack->top;
                c = *cell;

                for (; n < 0; ++n, cell--) {
                        *cell = cell[-1];
                }

                *cell = c;
        }
}

/*
 * s t a c k S e t T o p
 */
void
ficlStackSetTop(ficlStack *stack, ficlCell c)
{
        FICL_STACK_CHECK(stack, 1, 1);
        stack->top[0] = c;
}

void
ficlStackWalk(ficlStack *stack, ficlStackWalkFunction callback,
    void *context, ficlInteger bottomToTop)
{
        int i;
        int depth;
        ficlCell *cell;
        FICL_STACK_CHECK(stack, 0, 0);

        depth = ficlStackDepth(stack);
        cell = bottomToTop ? stack->base : stack->top;
        for (i = 0; i < depth; i++) {
                if (callback(context, cell) == FICL_FALSE)
                        break;
                cell += bottomToTop ? 1 : -1;
        }
}