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
44#ifdef TESTMAIN
45#include <stdlib.h>
46#else
47#include <stand.h>
48#endif
49#include "ficl.h"
50
51#define STKDEPTH(s) ((s)->sp - (s)->base)
52
53/*
54** N O T E: Stack convention:
55**
56** sp points to the first available cell
57** push: store value at sp, increment sp
58** pop:  decrement sp, fetch value at sp
59** Stack grows from low to high memory
60*/
61
62/*******************************************************************
63                    v m C h e c k S t a c k
64** Check the parameter stack for underflow or overflow.
65** nCells controls the type of check: if nCells is zero,
66** the function checks the stack state for underflow and overflow.
67** If nCells > 0, checks to see that the stack has room to push
68** that many cells. If less than zero, checks to see that the
69** stack has room to pop that many cells. If any test fails,
70** the function throws (via vmThrow) a VM_ERREXIT exception.
71*******************************************************************/
72void vmCheckStack(FICL_VM *pVM, int popCells, int pushCells)
73{
74    FICL_STACK *pStack = pVM->pStack;
75    int nFree = pStack->base + pStack->nCells - pStack->sp;
76
77    if (popCells > STKDEPTH(pStack))
78    {
79        vmThrowErr(pVM, "Error: stack underflow");
80    }
81
82    if (nFree < pushCells - popCells)
83    {
84        vmThrowErr(pVM, "Error: stack overflow");
85    }
86
87    return;
88}
89
90#if FICL_WANT_FLOAT
91void vmCheckFStack(FICL_VM *pVM, int popCells, int pushCells)
92{
93    FICL_STACK *fStack = pVM->fStack;
94    int nFree = fStack->base + fStack->nCells - fStack->sp;
95
96    if (popCells > STKDEPTH(fStack))
97    {
98        vmThrowErr(pVM, "Error: float stack underflow");
99    }
100
101    if (nFree < pushCells - popCells)
102    {
103        vmThrowErr(pVM, "Error: float stack overflow");
104    }
105}
106#endif
107
108/*******************************************************************
109                    s t a c k C r e a t e
110**
111*******************************************************************/
112
113FICL_STACK *stackCreate(unsigned nCells)
114{
115    size_t size = sizeof (FICL_STACK) + nCells * sizeof (CELL);
116    FICL_STACK *pStack = ficlMalloc(size);
117
118#if FICL_ROBUST
119    assert (nCells != 0);
120    assert (pStack != NULL);
121#endif
122
123    pStack->nCells = nCells;
124    pStack->sp     = pStack->base;
125    pStack->pFrame = NULL;
126    return pStack;
127}
128
129
130/*******************************************************************
131                    s t a c k D e l e t e
132**
133*******************************************************************/
134
135void stackDelete(FICL_STACK *pStack)
136{
137    if (pStack)
138        ficlFree(pStack);
139    return;
140}
141
142
143/*******************************************************************
144                    s t a c k D e p t h
145**
146*******************************************************************/
147
148int stackDepth(FICL_STACK *pStack)
149{
150    return STKDEPTH(pStack);
151}
152
153/*******************************************************************
154                    s t a c k D r o p
155**
156*******************************************************************/
157
158void stackDrop(FICL_STACK *pStack, int n)
159{
160#if FICL_ROBUST
161    assert(n > 0);
162#endif
163    pStack->sp -= n;
164    return;
165}
166
167
168/*******************************************************************
169                    s t a c k F e t c h
170**
171*******************************************************************/
172
173CELL stackFetch(FICL_STACK *pStack, int n)
174{
175    return pStack->sp[-n-1];
176}
177
178void stackStore(FICL_STACK *pStack, int n, CELL c)
179{
180    pStack->sp[-n-1] = c;
181    return;
182}
183
184
185/*******************************************************************
186                    s t a c k G e t T o p
187**
188*******************************************************************/
189
190CELL stackGetTop(FICL_STACK *pStack)
191{
192    return pStack->sp[-1];
193}
194
195
196/*******************************************************************
197                    s t a c k L i n k
198** Link a frame using the stack's frame pointer. Allot space for
199** nCells cells in the frame
200** 1) Push pFrame
201** 2) pFrame = sp
202** 3) sp += nCells
203*******************************************************************/
204
205void stackLink(FICL_STACK *pStack, int nCells)
206{
207    stackPushPtr(pStack, pStack->pFrame);
208    pStack->pFrame = pStack->sp;
209    pStack->sp += nCells;
210    return;
211}
212
213
214/*******************************************************************
215                    s t a c k U n l i n k
216** Unink a stack frame previously created by stackLink
217** 1) sp = pFrame
218** 2) pFrame = pop()
219*******************************************************************/
220
221void stackUnlink(FICL_STACK *pStack)
222{
223    pStack->sp = pStack->pFrame;
224    pStack->pFrame = stackPopPtr(pStack);
225    return;
226}
227
228
229/*******************************************************************
230                    s t a c k P i c k
231**
232*******************************************************************/
233
234void stackPick(FICL_STACK *pStack, int n)
235{
236    stackPush(pStack, stackFetch(pStack, n));
237    return;
238}
239
240
241/*******************************************************************
242                    s t a c k P o p
243**
244*******************************************************************/
245
246CELL stackPop(FICL_STACK *pStack)
247{
248    return *--pStack->sp;
249}
250
251void *stackPopPtr(FICL_STACK *pStack)
252{
253    return (*--pStack->sp).p;
254}
255
256FICL_UNS stackPopUNS(FICL_STACK *pStack)
257{
258    return (*--pStack->sp).u;
259}
260
261FICL_INT stackPopINT(FICL_STACK *pStack)
262{
263    return (*--pStack->sp).i;
264}
265
266#if (FICL_WANT_FLOAT)
267float stackPopFloat(FICL_STACK *pStack)
268{
269    return (*(--pStack->sp)).f;
270}
271#endif
272
273/*******************************************************************
274                    s t a c k P u s h
275**
276*******************************************************************/
277
278void stackPush(FICL_STACK *pStack, CELL c)
279{
280    *pStack->sp++ = c;
281}
282
283void stackPushPtr(FICL_STACK *pStack, void *ptr)
284{
285    *pStack->sp++ = LVALUEtoCELL(ptr);
286}
287
288void stackPushUNS(FICL_STACK *pStack, FICL_UNS u)
289{
290    *pStack->sp++ = LVALUEtoCELL(u);
291}
292
293void stackPushINT(FICL_STACK *pStack, FICL_INT i)
294{
295    *pStack->sp++ = LVALUEtoCELL(i);
296}
297
298#if (FICL_WANT_FLOAT)
299void stackPushFloat(FICL_STACK *pStack, FICL_FLOAT f)
300{
301    *pStack->sp++ = LVALUEtoCELL(f);
302}
303#endif
304
305/*******************************************************************
306                    s t a c k R e s e t
307**
308*******************************************************************/
309
310void stackReset(FICL_STACK *pStack)
311{
312    pStack->sp = pStack->base;
313    return;
314}
315
316
317/*******************************************************************
318                    s t a c k R o l l
319** Roll nth stack entry to the top (counting from zero), if n is
320** >= 0. Drop other entries as needed to fill the hole.
321** If n < 0, roll top-of-stack to nth entry, pushing others
322** upward as needed to fill the hole.
323*******************************************************************/
324
325void stackRoll(FICL_STACK *pStack, int n)
326{
327    CELL c;
328    CELL *pCell;
329
330    if (n == 0)
331        return;
332    else if (n > 0)
333    {
334        pCell = pStack->sp - n - 1;
335        c = *pCell;
336
337        for (;n > 0; --n, pCell++)
338        {
339            *pCell = pCell[1];
340        }
341
342        *pCell = c;
343    }
344    else
345    {
346        pCell = pStack->sp - 1;
347        c = *pCell;
348
349        for (; n < 0; ++n, pCell--)
350        {
351            *pCell = pCell[-1];
352        }
353
354        *pCell = c;
355    }
356    return;
357}
358
359
360/*******************************************************************
361                    s t a c k S e t T o p
362**
363*******************************************************************/
364
365void stackSetTop(FICL_STACK *pStack, CELL c)
366{
367    pStack->sp[-1] = c;
368    return;
369}
370
371
372