common/ficl/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: 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;
	}
}