stack.c

/*******************************************************************
** s t a c k . c
** Forth Inspired Command Language
** Author: John Sadler (john_sadler@alum.mit.edu)
** Created: 16 Oct 1997
** $Id: //depot/gamejones/ficl/stack.c#10 $
*******************************************************************/
/*
** 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 <stdlib.h>

#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);

    // fprintf(stderr,"poCells:%d depth: %d (%p,%p)\n",popCells,STKDEPTH(stack),stack->top,stack->base);

    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);
    }

    return;
}
#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) {
#if defined(DEBUG)
        memset(stack, 0xEF, stack->size * sizeof(ficlCell) + sizeof(ficlStack));
#endif
        ficlFree(stack);
    }
    return;
}


/*******************************************************************
                    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;
    return;
}


/*******************************************************************
                    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;
    return;
}


/*******************************************************************
                    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;
    return;
}


/*******************************************************************
                    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);
    return;
}
#endif /* FICL_WANT_LOCALS */


/*******************************************************************
                    s t a c k P i c k
** 
*******************************************************************/

void ficlStackPick(ficlStack *stack, int n)
{
    ficlStackPush(stack, ficlStackFetch(stack, n));
    return;
}


/*******************************************************************
                    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)
{
    *++stack->top = FICL_LVALUE_TO_CELL(ptr);
}

void ficlStackPushInteger(ficlStack *stack, ficlInteger i)
{
    *++stack->top = FICL_LVALUE_TO_CELL(i);
}

void ficlStackPushUnsigned(ficlStack *stack, ficlUnsigned u)
{
    *++stack->top = FICL_LVALUE_TO_CELL(u);
}

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

void  ficlStackPush2Integer(ficlStack *stack, ficl2Integer di)
{
	ficlStackPush2Unsigned(stack, FICL_2INTEGER_TO_2UNSIGNED(di));
    return;
}

#if (FICL_WANT_FLOAT)
void ficlStackPushFloat(ficlStack *stack, ficlFloat f)
{
    *++stack->top = FICL_LVALUE_TO_CELL(f);
}
#endif


/*******************************************************************
                    s t a c k R e s e t
** 
*******************************************************************/

void ficlStackReset(ficlStack *stack)
{
    int i;
    ficlCell cell;

    // fprintf(stderr,"called ficlStackReset()\n");
    cell.u = 0xDEADC0DE;
    for (i = 0; i < 4; i++)
        stack->fence[i] = cell;
    stack->top = stack->base - 1;
    return;
}


/*******************************************************************
                    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;
    }
    return;
}


/*******************************************************************
                    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;
    return;
}




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;
    }
    return;
}