122708Smpp/*******************************************************************
222708Smpp** s t a c k . c
322708Smpp** Forth Inspired Command Language
422708Smpp** Author: John Sadler (john_sadler@alum.mit.edu)
522708Smpp** Created: 16 Oct 1997
622708Smpp** $Id: stack.c,v 1.10 2001/12/05 07:21:34 jsadler Exp $
722708Smpp*******************************************************************/
822708Smpp/*
922708Smpp** Copyright (c) 1997-2001 John Sadler (john_sadler@alum.mit.edu)
1022708Smpp** All rights reserved.
1122708Smpp**
1222708Smpp** Get the latest Ficl release at http://ficl.sourceforge.net
1322708Smpp**
1422708Smpp** I am interested in hearing from anyone who uses ficl. If you have
1522708Smpp** a problem, a success story, a defect, an enhancement request, or
1622708Smpp** if you would like to contribute to the ficl release, please
1722708Smpp** contact me by email at the address above.
1822708Smpp**
1922708Smpp** L I C E N S E  and  D I S C L A I M E R
2022708Smpp**
2122708Smpp** Redistribution and use in source and binary forms, with or without
2222708Smpp** modification, are permitted provided that the following conditions
2322708Smpp** are met:
2422708Smpp** 1. Redistributions of source code must retain the above copyright
2522708Smpp**    notice, this list of conditions and the following disclaimer.
2622708Smpp** 2. Redistributions in binary form must reproduce the above copyright
2722708Smpp**    notice, this list of conditions and the following disclaimer in the
2822708Smpp**    documentation and/or other materials provided with the distribution.
2922708Smpp**
3022708Smpp** THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
3122708Smpp** ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
3222708Smpp** IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
3322708Smpp** ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
3422708Smpp** FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
3550476Speter** DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
3648795Snik** OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
3722708Smpp** HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
3822708Smpp** LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
3922708Smpp** OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
4022708Smpp** SUCH DAMAGE.
4122708Smpp*/
4222708Smpp
4322708Smpp/* $FreeBSD$ */
4484306Sru
4584306Sru#ifdef TESTMAIN
4684306Sru#include <stdlib.h>
4722708Smpp#else
4822708Smpp#include <stand.h>
4922708Smpp#endif
5022708Smpp#include "ficl.h"
5122708Smpp
5222708Smpp#define STKDEPTH(s) ((s)->sp - (s)->base)
53121378Shmp
54121378Shmp/*
5522708Smpp** N O T E: Stack convention:
5622708Smpp**
5722708Smpp** sp points to the first available cell
5822708Smpp** push: store value at sp, increment sp
5922708Smpp** pop:  decrement sp, fetch value at sp
6022708Smpp** Stack grows from low to high memory
6122708Smpp*/
6222708Smpp
6322708Smpp/*******************************************************************
6422708Smpp                    v m C h e c k S t a c k
6522708Smpp** Check the parameter stack for underflow or overflow.
6622708Smpp** nCells controls the type of check: if nCells is zero,
6722708Smpp** the function checks the stack state for underflow and overflow.
6822708Smpp** If nCells > 0, checks to see that the stack has room to push
6922708Smpp** that many cells. If less than zero, checks to see that the
7022708Smpp** stack has room to pop that many cells. If any test fails,
7122708Smpp** the function throws (via vmThrow) a VM_ERREXIT exception.
7222708Smpp*******************************************************************/
7322708Smppvoid vmCheckStack(FICL_VM *pVM, int popCells, int pushCells)
74131530Sru{
7522708Smpp    FICL_STACK *pStack = pVM->pStack;
7622708Smpp    int nFree = pStack->base + pStack->nCells - pStack->sp;
7722708Smpp
7822708Smpp    if (popCells > STKDEPTH(pStack))
7922708Smpp    {
8022708Smpp        vmThrowErr(pVM, "Error: stack underflow");
8122708Smpp    }
8282878Sdd
8322708Smpp    if (nFree < pushCells - popCells)
8422708Smpp    {
8522708Smpp        vmThrowErr(pVM, "Error: stack overflow");
8622708Smpp    }
8722708Smpp
8822708Smpp    return;
8922708Smpp}
9022708Smpp
9122708Smpp#if FICL_WANT_FLOAT
9222708Smppvoid vmCheckFStack(FICL_VM *pVM, int popCells, int pushCells)
9322708Smpp{
9422708Smpp    FICL_STACK *fStack = pVM->fStack;
9522708Smpp    int nFree = fStack->base + fStack->nCells - fStack->sp;
9622708Smpp
9782954Sru    if (popCells > STKDEPTH(fStack))
9822708Smpp    {
9922708Smpp        vmThrowErr(pVM, "Error: float stack underflow");
10022708Smpp    }
101
102    if (nFree < pushCells - popCells)
103    {
104        vmThrowErr(pVM, "Error: float stack overflow");
105    }
106}
107#endif
108
109/*******************************************************************
110                    s t a c k C r e a t e
111**
112*******************************************************************/
113
114FICL_STACK *stackCreate(unsigned nCells)
115{
116    size_t size = sizeof (FICL_STACK) + nCells * sizeof (CELL);
117    FICL_STACK *pStack = ficlMalloc(size);
118
119#if FICL_ROBUST
120    assert (nCells != 0);
121    assert (pStack != NULL);
122#endif
123
124    pStack->nCells = nCells;
125    pStack->sp     = pStack->base;
126    pStack->pFrame = NULL;
127    return pStack;
128}
129
130
131/*******************************************************************
132                    s t a c k D e l e t e
133**
134*******************************************************************/
135
136void stackDelete(FICL_STACK *pStack)
137{
138    if (pStack)
139        ficlFree(pStack);
140    return;
141}
142
143
144/*******************************************************************
145                    s t a c k D e p t h
146**
147*******************************************************************/
148
149int stackDepth(FICL_STACK *pStack)
150{
151    return STKDEPTH(pStack);
152}
153
154/*******************************************************************
155                    s t a c k D r o p
156**
157*******************************************************************/
158
159void stackDrop(FICL_STACK *pStack, int n)
160{
161#if FICL_ROBUST
162    assert(n > 0);
163#endif
164    pStack->sp -= n;
165    return;
166}
167
168
169/*******************************************************************
170                    s t a c k F e t c h
171**
172*******************************************************************/
173
174CELL stackFetch(FICL_STACK *pStack, int n)
175{
176    return pStack->sp[-n-1];
177}
178
179void stackStore(FICL_STACK *pStack, int n, CELL c)
180{
181    pStack->sp[-n-1] = c;
182    return;
183}
184
185
186/*******************************************************************
187                    s t a c k G e t T o p
188**
189*******************************************************************/
190
191CELL stackGetTop(FICL_STACK *pStack)
192{
193    return pStack->sp[-1];
194}
195
196
197/*******************************************************************
198                    s t a c k L i n k
199** Link a frame using the stack's frame pointer. Allot space for
200** nCells cells in the frame
201** 1) Push pFrame
202** 2) pFrame = sp
203** 3) sp += nCells
204*******************************************************************/
205
206void stackLink(FICL_STACK *pStack, int nCells)
207{
208    stackPushPtr(pStack, pStack->pFrame);
209    pStack->pFrame = pStack->sp;
210    pStack->sp += nCells;
211    return;
212}
213
214
215/*******************************************************************
216                    s t a c k U n l i n k
217** Unink a stack frame previously created by stackLink
218** 1) sp = pFrame
219** 2) pFrame = pop()
220*******************************************************************/
221
222void stackUnlink(FICL_STACK *pStack)
223{
224    pStack->sp = pStack->pFrame;
225    pStack->pFrame = stackPopPtr(pStack);
226    return;
227}
228
229
230/*******************************************************************
231                    s t a c k P i c k
232**
233*******************************************************************/
234
235void stackPick(FICL_STACK *pStack, int n)
236{
237    stackPush(pStack, stackFetch(pStack, n));
238    return;
239}
240
241
242/*******************************************************************
243                    s t a c k P o p
244**
245*******************************************************************/
246
247CELL stackPop(FICL_STACK *pStack)
248{
249    return *--pStack->sp;
250}
251
252void *stackPopPtr(FICL_STACK *pStack)
253{
254    return (*--pStack->sp).p;
255}
256
257FICL_UNS stackPopUNS(FICL_STACK *pStack)
258{
259    return (*--pStack->sp).u;
260}
261
262FICL_INT stackPopINT(FICL_STACK *pStack)
263{
264    return (*--pStack->sp).i;
265}
266
267#if (FICL_WANT_FLOAT)
268float stackPopFloat(FICL_STACK *pStack)
269{
270    return (*(--pStack->sp)).f;
271}
272#endif
273
274/*******************************************************************
275                    s t a c k P u s h
276**
277*******************************************************************/
278
279void stackPush(FICL_STACK *pStack, CELL c)
280{
281    *pStack->sp++ = c;
282}
283
284void stackPushPtr(FICL_STACK *pStack, void *ptr)
285{
286    *pStack->sp++ = LVALUEtoCELL(ptr);
287}
288
289void stackPushUNS(FICL_STACK *pStack, FICL_UNS u)
290{
291    *pStack->sp++ = LVALUEtoCELL(u);
292}
293
294void stackPushINT(FICL_STACK *pStack, FICL_INT i)
295{
296    *pStack->sp++ = LVALUEtoCELL(i);
297}
298
299#if (FICL_WANT_FLOAT)
300void stackPushFloat(FICL_STACK *pStack, FICL_FLOAT f)
301{
302    *pStack->sp++ = LVALUEtoCELL(f);
303}
304#endif
305
306/*******************************************************************
307                    s t a c k R e s e t
308**
309*******************************************************************/
310
311void stackReset(FICL_STACK *pStack)
312{
313    pStack->sp = pStack->base;
314    return;
315}
316
317
318/*******************************************************************
319                    s t a c k R o l l
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*******************************************************************/
325
326void stackRoll(FICL_STACK *pStack, int n)
327{
328    CELL c;
329    CELL *pCell;
330
331    if (n == 0)
332        return;
333    else if (n > 0)
334    {
335        pCell = pStack->sp - n - 1;
336        c = *pCell;
337
338        for (;n > 0; --n, pCell++)
339        {
340            *pCell = pCell[1];
341        }
342
343        *pCell = c;
344    }
345    else
346    {
347        pCell = pStack->sp - 1;
348        c = *pCell;
349
350        for (; n < 0; ++n, pCell--)
351        {
352            *pCell = pCell[-1];
353        }
354
355        *pCell = c;
356    }
357    return;
358}
359
360
361/*******************************************************************
362                    s t a c k S e t T o p
363**
364*******************************************************************/
365
366void stackSetTop(FICL_STACK *pStack, CELL c)
367{
368    pStack->sp[-1] = c;
369    return;
370}
371
372
373