1/*******************************************************************
2** s t a c k . c
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*******************************************************************/
8/*
9** Copyright (c) 1997-2001 John Sadler (john_sadler@alum.mit.edu)
10** All rights reserved.
11**
12** Get the latest Ficl release at http://ficl.sourceforge.net
13**
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.
18**
19** L I C E N S E  and  D I S C L A I M E R
20**
21** Redistribution and use in source and binary forms, with or without
22** modification, are permitted provided that the following conditions
23** are met:
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.
29**
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
40** SUCH DAMAGE.
41*/
42
43/* $FreeBSD$ */
44
45#ifdef TESTMAIN
46#include <stdlib.h>
47#else
48#include <stand.h>
49#endif
50#include "ficl.h"
51
52#define STKDEPTH(s) ((s)->sp - (s)->base)
53
54/*
55** N O T E: Stack convention:
56**
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
61*/
62
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*******************************************************************/
73void vmCheckStack(FICL_VM *pVM, int popCells, int pushCells)
74{
75    FICL_STACK *pStack = pVM->pStack;
76    int nFree = pStack->base + pStack->nCells - pStack->sp;
77
78    if (popCells > STKDEPTH(pStack))
79    {
80        vmThrowErr(pVM, "Error: stack underflow");
81    }
82
83    if (nFree < pushCells - popCells)
84    {
85        vmThrowErr(pVM, "Error: stack overflow");
86    }
87
88    return;
89}
90
91#if FICL_WANT_FLOAT
92void vmCheckFStack(FICL_VM *pVM, int popCells, int pushCells)
93{
94    FICL_STACK *fStack = pVM->fStack;
95    int nFree = fStack->base + fStack->nCells - fStack->sp;
96
97    if (popCells > STKDEPTH(fStack))
98    {
99        vmThrowErr(pVM, "Error: float stack underflow");
100    }
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