1 /*******************************************************************
3 ** Forth Inspired Command Language
4 ** Author: John Sadler (john_sadler@alum.mit.edu)
5 ** Created: 16 Oct 1997
6 ** $Id: stack.c,v 1.10 2001/12/05 07:21:34 jsadler Exp $
7 *******************************************************************/
9 ** Copyright (c) 1997-2001 John Sadler (john_sadler@alum.mit.edu)
10 ** All rights reserved.
12 ** Get the latest Ficl release at http://ficl.sourceforge.net
14 ** I am interested in hearing from anyone who uses ficl. If you have
15 ** a problem, a success story, a defect, an enhancement request, or
16 ** if you would like to contribute to the ficl release, please
17 ** contact me by email at the address above.
19 ** L I C E N S E and D I S C L A I M E R
21 ** Redistribution and use in source and binary forms, with or without
22 ** modification, are permitted provided that the following conditions
24 ** 1. Redistributions of source code must retain the above copyright
25 ** notice, this list of conditions and the following disclaimer.
26 ** 2. Redistributions in binary form must reproduce the above copyright
27 ** notice, this list of conditions and the following disclaimer in the
28 ** documentation and/or other materials provided with the distribution.
30 ** THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
31 ** ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
32 ** IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
33 ** ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
34 ** FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
35 ** DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
36 ** OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
37 ** HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
38 ** LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
39 ** OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
52 #define STKDEPTH(s) ((s)->sp - (s)->base)
55 ** N O T E: Stack convention:
57 ** sp points to the first available cell
58 ** push: store value at sp, increment sp
59 ** pop: decrement sp, fetch value at sp
60 ** Stack grows from low to high memory
63 /*******************************************************************
64 v m C h e c k S t a c k
65 ** Check the parameter stack for underflow or overflow.
66 ** nCells controls the type of check: if nCells is zero,
67 ** the function checks the stack state for underflow and overflow.
68 ** If nCells > 0, checks to see that the stack has room to push
69 ** that many cells. If less than zero, checks to see that the
70 ** stack has room to pop that many cells. If any test fails,
71 ** the function throws (via vmThrow) a VM_ERREXIT exception.
72 *******************************************************************/
73 void vmCheckStack(FICL_VM *pVM, int popCells, int pushCells)
75 FICL_STACK *pStack = pVM->pStack;
76 int nFree = pStack->base + pStack->nCells - pStack->sp;
78 if (popCells > STKDEPTH(pStack))
80 vmThrowErr(pVM, "Error: stack underflow");
83 if (nFree < pushCells - popCells)
85 vmThrowErr(pVM, "Error: stack overflow");
92 void vmCheckFStack(FICL_VM *pVM, int popCells, int pushCells)
94 FICL_STACK *fStack = pVM->fStack;
95 int nFree = fStack->base + fStack->nCells - fStack->sp;
97 if (popCells > STKDEPTH(fStack))
99 vmThrowErr(pVM, "Error: float stack underflow");
102 if (nFree < pushCells - popCells)
104 vmThrowErr(pVM, "Error: float stack overflow");
109 /*******************************************************************
110 s t a c k C r e a t e
112 *******************************************************************/
114 FICL_STACK *stackCreate(unsigned nCells)
116 size_t size = sizeof (FICL_STACK) + nCells * sizeof (CELL);
117 FICL_STACK *pStack = ficlMalloc(size);
120 assert (nCells != 0);
121 assert (pStack != NULL);
124 pStack->nCells = nCells;
125 pStack->sp = pStack->base;
126 pStack->pFrame = NULL;
131 /*******************************************************************
132 s t a c k D e l e t e
134 *******************************************************************/
136 void stackDelete(FICL_STACK *pStack)
144 /*******************************************************************
147 *******************************************************************/
149 int stackDepth(FICL_STACK *pStack)
151 return STKDEPTH(pStack);
154 /*******************************************************************
157 *******************************************************************/
159 void stackDrop(FICL_STACK *pStack, int n)
169 /*******************************************************************
172 *******************************************************************/
174 CELL stackFetch(FICL_STACK *pStack, int n)
176 return pStack->sp[-n-1];
179 void stackStore(FICL_STACK *pStack, int n, CELL c)
181 pStack->sp[-n-1] = c;
186 /*******************************************************************
187 s t a c k G e t T o p
189 *******************************************************************/
191 CELL stackGetTop(FICL_STACK *pStack)
193 return pStack->sp[-1];
197 /*******************************************************************
199 ** Link a frame using the stack's frame pointer. Allot space for
200 ** nCells cells in the frame
204 *******************************************************************/
206 void stackLink(FICL_STACK *pStack, int nCells)
208 stackPushPtr(pStack, pStack->pFrame);
209 pStack->pFrame = pStack->sp;
210 pStack->sp += nCells;
215 /*******************************************************************
216 s t a c k U n l i n k
217 ** Unink a stack frame previously created by stackLink
220 *******************************************************************/
222 void stackUnlink(FICL_STACK *pStack)
224 pStack->sp = pStack->pFrame;
225 pStack->pFrame = stackPopPtr(pStack);
230 /*******************************************************************
233 *******************************************************************/
235 void stackPick(FICL_STACK *pStack, int n)
237 stackPush(pStack, stackFetch(pStack, n));
242 /*******************************************************************
245 *******************************************************************/
247 CELL stackPop(FICL_STACK *pStack)
249 return *--pStack->sp;
252 void *stackPopPtr(FICL_STACK *pStack)
254 return (*--pStack->sp).p;
257 FICL_UNS stackPopUNS(FICL_STACK *pStack)
259 return (*--pStack->sp).u;
262 FICL_INT stackPopINT(FICL_STACK *pStack)
264 return (*--pStack->sp).i;
267 #if (FICL_WANT_FLOAT)
268 float stackPopFloat(FICL_STACK *pStack)
270 return (*(--pStack->sp)).f;
274 /*******************************************************************
277 *******************************************************************/
279 void stackPush(FICL_STACK *pStack, CELL c)
284 void stackPushPtr(FICL_STACK *pStack, void *ptr)
286 *pStack->sp++ = LVALUEtoCELL(ptr);
289 void stackPushUNS(FICL_STACK *pStack, FICL_UNS u)
291 *pStack->sp++ = LVALUEtoCELL(u);
294 void stackPushINT(FICL_STACK *pStack, FICL_INT i)
296 *pStack->sp++ = LVALUEtoCELL(i);
299 #if (FICL_WANT_FLOAT)
300 void stackPushFloat(FICL_STACK *pStack, FICL_FLOAT f)
302 *pStack->sp++ = LVALUEtoCELL(f);
306 /*******************************************************************
309 *******************************************************************/
311 void stackReset(FICL_STACK *pStack)
313 pStack->sp = pStack->base;
318 /*******************************************************************
320 ** Roll nth stack entry to the top (counting from zero), if n is
321 ** >= 0. Drop other entries as needed to fill the hole.
322 ** If n < 0, roll top-of-stack to nth entry, pushing others
323 ** upward as needed to fill the hole.
324 *******************************************************************/
326 void stackRoll(FICL_STACK *pStack, int n)
335 pCell = pStack->sp - n - 1;
338 for (;n > 0; --n, pCell++)
347 pCell = pStack->sp - 1;
350 for (; n < 0; ++n, pCell--)
361 /*******************************************************************
362 s t a c k S e t T o p
364 *******************************************************************/
366 void stackSetTop(FICL_STACK *pStack, CELL c)