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