xref: /titanic_51/usr/src/common/ficl/stack.c (revision a1bf3f785ae05c419b339c3a2061f2b18c024f61)
1*a1bf3f78SToomas Soome /*
2*a1bf3f78SToomas Soome  * s t a c k . c
3*a1bf3f78SToomas Soome  * Forth Inspired Command Language
4*a1bf3f78SToomas Soome  * Author: John Sadler (john_sadler@alum.mit.edu)
5*a1bf3f78SToomas Soome  * Created: 16 Oct 1997
6*a1bf3f78SToomas Soome  * $Id: stack.c,v 1.11 2010/08/12 13:57:22 asau Exp $
7*a1bf3f78SToomas Soome  */
8*a1bf3f78SToomas Soome /*
9*a1bf3f78SToomas Soome  * Copyright (c) 1997-2001 John Sadler (john_sadler@alum.mit.edu)
10*a1bf3f78SToomas Soome  * All rights reserved.
11*a1bf3f78SToomas Soome  *
12*a1bf3f78SToomas Soome  * Get the latest Ficl release at http://ficl.sourceforge.net
13*a1bf3f78SToomas Soome  *
14*a1bf3f78SToomas Soome  * I am interested in hearing from anyone who uses Ficl. If you have
15*a1bf3f78SToomas Soome  * a problem, a success story, a defect, an enhancement request, or
16*a1bf3f78SToomas Soome  * if you would like to contribute to the Ficl release, please
17*a1bf3f78SToomas Soome  * contact me by email at the address above.
18*a1bf3f78SToomas Soome  *
19*a1bf3f78SToomas Soome  * L I C E N S E  and  D I S C L A I M E R
20*a1bf3f78SToomas Soome  *
21*a1bf3f78SToomas Soome  * Redistribution and use in source and binary forms, with or without
22*a1bf3f78SToomas Soome  * modification, are permitted provided that the following conditions
23*a1bf3f78SToomas Soome  * are met:
24*a1bf3f78SToomas Soome  * 1. Redistributions of source code must retain the above copyright
25*a1bf3f78SToomas Soome  *    notice, this list of conditions and the following disclaimer.
26*a1bf3f78SToomas Soome  * 2. Redistributions in binary form must reproduce the above copyright
27*a1bf3f78SToomas Soome  *    notice, this list of conditions and the following disclaimer in the
28*a1bf3f78SToomas Soome  *    documentation and/or other materials provided with the distribution.
29*a1bf3f78SToomas Soome  *
30*a1bf3f78SToomas Soome  * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
31*a1bf3f78SToomas Soome  * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
32*a1bf3f78SToomas Soome  * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
33*a1bf3f78SToomas Soome  * ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
34*a1bf3f78SToomas Soome  * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
35*a1bf3f78SToomas Soome  * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
36*a1bf3f78SToomas Soome  * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
37*a1bf3f78SToomas Soome  * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
38*a1bf3f78SToomas Soome  * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
39*a1bf3f78SToomas Soome  * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
40*a1bf3f78SToomas Soome  * SUCH DAMAGE.
41*a1bf3f78SToomas Soome  */
42*a1bf3f78SToomas Soome 
43*a1bf3f78SToomas Soome #include "ficl.h"
44*a1bf3f78SToomas Soome 
45*a1bf3f78SToomas Soome #define	STKDEPTH(s)	(((s)->top - (s)->base) + 1)
46*a1bf3f78SToomas Soome 
47*a1bf3f78SToomas Soome /*
48*a1bf3f78SToomas Soome  * N O T E: Stack convention:
49*a1bf3f78SToomas Soome  *
50*a1bf3f78SToomas Soome  * THIS CHANGED IN FICL 4.0!
51*a1bf3f78SToomas Soome  *
52*a1bf3f78SToomas Soome  * top points to the *current* top data value
53*a1bf3f78SToomas Soome  * push: increment top, store value at top
54*a1bf3f78SToomas Soome  * pop:  fetch value at top, decrement top
55*a1bf3f78SToomas Soome  * Stack grows from low to high memory
56*a1bf3f78SToomas Soome  */
57*a1bf3f78SToomas Soome 
58*a1bf3f78SToomas Soome /*
59*a1bf3f78SToomas Soome  * v m C h e c k S t a c k
60*a1bf3f78SToomas Soome  * Check the parameter stack for underflow or overflow.
61*a1bf3f78SToomas Soome  * size controls the type of check: if size is zero,
62*a1bf3f78SToomas Soome  * the function checks the stack state for underflow and overflow.
63*a1bf3f78SToomas Soome  * If size > 0, checks to see that the stack has room to push
64*a1bf3f78SToomas Soome  * that many cells. If less than zero, checks to see that the
65*a1bf3f78SToomas Soome  * stack has room to pop that many cells. If any test fails,
66*a1bf3f78SToomas Soome  * the function throws (via vmThrow) a VM_ERREXIT exception.
67*a1bf3f78SToomas Soome  */
68*a1bf3f78SToomas Soome void
69*a1bf3f78SToomas Soome ficlStackCheck(ficlStack *stack, int popCells, int pushCells)
70*a1bf3f78SToomas Soome {
71*a1bf3f78SToomas Soome #if FICL_ROBUST >= 1
72*a1bf3f78SToomas Soome 	int nFree = stack->size - STKDEPTH(stack);
73*a1bf3f78SToomas Soome 
74*a1bf3f78SToomas Soome 	if (popCells > STKDEPTH(stack))
75*a1bf3f78SToomas Soome 		ficlVmThrowError(stack->vm, "Error: %s stack underflow",
76*a1bf3f78SToomas Soome 		    stack->name);
77*a1bf3f78SToomas Soome 
78*a1bf3f78SToomas Soome 	if (nFree < pushCells - popCells)
79*a1bf3f78SToomas Soome 		ficlVmThrowError(stack->vm, "Error: %s stack overflow",
80*a1bf3f78SToomas Soome 		    stack->name);
81*a1bf3f78SToomas Soome #else /* FICL_ROBUST >= 1 */
82*a1bf3f78SToomas Soome 	FICL_IGNORE(stack);
83*a1bf3f78SToomas Soome 	FICL_IGNORE(popCells);
84*a1bf3f78SToomas Soome 	FICL_IGNORE(pushCells);
85*a1bf3f78SToomas Soome #endif /* FICL_ROBUST >= 1 */
86*a1bf3f78SToomas Soome }
87*a1bf3f78SToomas Soome 
88*a1bf3f78SToomas Soome /*
89*a1bf3f78SToomas Soome  * s t a c k C r e a t e
90*a1bf3f78SToomas Soome  */
91*a1bf3f78SToomas Soome 
92*a1bf3f78SToomas Soome ficlStack *
93*a1bf3f78SToomas Soome ficlStackCreate(ficlVm *vm, char *name, unsigned size)
94*a1bf3f78SToomas Soome {
95*a1bf3f78SToomas Soome 	size_t totalSize = sizeof (ficlStack) + (size * sizeof (ficlCell));
96*a1bf3f78SToomas Soome 	ficlStack *stack = ficlMalloc(totalSize);
97*a1bf3f78SToomas Soome 
98*a1bf3f78SToomas Soome 	FICL_VM_ASSERT(vm, size != 0);
99*a1bf3f78SToomas Soome 	FICL_VM_ASSERT(vm, stack != NULL);
100*a1bf3f78SToomas Soome 
101*a1bf3f78SToomas Soome 	stack->size = size;
102*a1bf3f78SToomas Soome 	stack->frame = NULL;
103*a1bf3f78SToomas Soome 
104*a1bf3f78SToomas Soome 	stack->vm = vm;
105*a1bf3f78SToomas Soome 	stack->name = name;
106*a1bf3f78SToomas Soome 
107*a1bf3f78SToomas Soome 	ficlStackReset(stack);
108*a1bf3f78SToomas Soome 	return (stack);
109*a1bf3f78SToomas Soome }
110*a1bf3f78SToomas Soome 
111*a1bf3f78SToomas Soome /*
112*a1bf3f78SToomas Soome  *                  s t a c k D e l e t e
113*a1bf3f78SToomas Soome  */
114*a1bf3f78SToomas Soome void
115*a1bf3f78SToomas Soome ficlStackDestroy(ficlStack *stack)
116*a1bf3f78SToomas Soome {
117*a1bf3f78SToomas Soome 	if (stack)
118*a1bf3f78SToomas Soome 		ficlFree(stack);
119*a1bf3f78SToomas Soome }
120*a1bf3f78SToomas Soome 
121*a1bf3f78SToomas Soome /*
122*a1bf3f78SToomas Soome  * s t a c k D e p t h
123*a1bf3f78SToomas Soome  */
124*a1bf3f78SToomas Soome int
125*a1bf3f78SToomas Soome ficlStackDepth(ficlStack *stack)
126*a1bf3f78SToomas Soome {
127*a1bf3f78SToomas Soome 	return (STKDEPTH(stack));
128*a1bf3f78SToomas Soome }
129*a1bf3f78SToomas Soome 
130*a1bf3f78SToomas Soome /*
131*a1bf3f78SToomas Soome  * s t a c k D r o p
132*a1bf3f78SToomas Soome  */
133*a1bf3f78SToomas Soome void
134*a1bf3f78SToomas Soome ficlStackDrop(ficlStack *stack, int n)
135*a1bf3f78SToomas Soome {
136*a1bf3f78SToomas Soome 	FICL_VM_ASSERT(stack->vm, n > 0);
137*a1bf3f78SToomas Soome 	stack->top -= n;
138*a1bf3f78SToomas Soome }
139*a1bf3f78SToomas Soome 
140*a1bf3f78SToomas Soome /*
141*a1bf3f78SToomas Soome  * s t a c k F e t c h
142*a1bf3f78SToomas Soome  */
143*a1bf3f78SToomas Soome ficlCell
144*a1bf3f78SToomas Soome ficlStackFetch(ficlStack *stack, int n)
145*a1bf3f78SToomas Soome {
146*a1bf3f78SToomas Soome 	return (stack->top[-n]);
147*a1bf3f78SToomas Soome }
148*a1bf3f78SToomas Soome 
149*a1bf3f78SToomas Soome void
150*a1bf3f78SToomas Soome ficlStackStore(ficlStack *stack, int n, ficlCell c)
151*a1bf3f78SToomas Soome {
152*a1bf3f78SToomas Soome 	stack->top[-n] = c;
153*a1bf3f78SToomas Soome }
154*a1bf3f78SToomas Soome 
155*a1bf3f78SToomas Soome /*
156*a1bf3f78SToomas Soome  * s t a c k G e t T o p
157*a1bf3f78SToomas Soome  */
158*a1bf3f78SToomas Soome ficlCell
159*a1bf3f78SToomas Soome ficlStackGetTop(ficlStack *stack)
160*a1bf3f78SToomas Soome {
161*a1bf3f78SToomas Soome 	return (stack->top[0]);
162*a1bf3f78SToomas Soome }
163*a1bf3f78SToomas Soome 
164*a1bf3f78SToomas Soome #if FICL_WANT_LOCALS
165*a1bf3f78SToomas Soome /*
166*a1bf3f78SToomas Soome  * s t a c k L i n k
167*a1bf3f78SToomas Soome  * Link a frame using the stack's frame pointer. Allot space for
168*a1bf3f78SToomas Soome  * size cells in the frame
169*a1bf3f78SToomas Soome  * 1) Push frame
170*a1bf3f78SToomas Soome  * 2) frame = top
171*a1bf3f78SToomas Soome  * 3) top += size
172*a1bf3f78SToomas Soome  */
173*a1bf3f78SToomas Soome void
174*a1bf3f78SToomas Soome ficlStackLink(ficlStack *stack, int size)
175*a1bf3f78SToomas Soome {
176*a1bf3f78SToomas Soome 	ficlStackPushPointer(stack, stack->frame);
177*a1bf3f78SToomas Soome 	stack->frame = stack->top + 1;
178*a1bf3f78SToomas Soome 	stack->top += size;
179*a1bf3f78SToomas Soome }
180*a1bf3f78SToomas Soome 
181*a1bf3f78SToomas Soome /*
182*a1bf3f78SToomas Soome  * s t a c k U n l i n k
183*a1bf3f78SToomas Soome  * Unink a stack frame previously created by stackLink
184*a1bf3f78SToomas Soome  * 1) top = frame
185*a1bf3f78SToomas Soome  * 2) frame = pop()
186*a1bf3f78SToomas Soome  */
187*a1bf3f78SToomas Soome void
188*a1bf3f78SToomas Soome ficlStackUnlink(ficlStack *stack)
189*a1bf3f78SToomas Soome {
190*a1bf3f78SToomas Soome 	stack->top = stack->frame - 1;
191*a1bf3f78SToomas Soome 	stack->frame = ficlStackPopPointer(stack);
192*a1bf3f78SToomas Soome }
193*a1bf3f78SToomas Soome #endif /* FICL_WANT_LOCALS */
194*a1bf3f78SToomas Soome 
195*a1bf3f78SToomas Soome /*
196*a1bf3f78SToomas Soome  *                  s t a c k P i c k
197*a1bf3f78SToomas Soome  */
198*a1bf3f78SToomas Soome void
199*a1bf3f78SToomas Soome ficlStackPick(ficlStack *stack, int n)
200*a1bf3f78SToomas Soome {
201*a1bf3f78SToomas Soome 	ficlStackPush(stack, ficlStackFetch(stack, n));
202*a1bf3f78SToomas Soome }
203*a1bf3f78SToomas Soome 
204*a1bf3f78SToomas Soome /*
205*a1bf3f78SToomas Soome  * s t a c k P o p
206*a1bf3f78SToomas Soome  */
207*a1bf3f78SToomas Soome ficlCell
208*a1bf3f78SToomas Soome ficlStackPop(ficlStack *stack)
209*a1bf3f78SToomas Soome {
210*a1bf3f78SToomas Soome 	return (*stack->top--);
211*a1bf3f78SToomas Soome }
212*a1bf3f78SToomas Soome 
213*a1bf3f78SToomas Soome void *
214*a1bf3f78SToomas Soome ficlStackPopPointer(ficlStack *stack)
215*a1bf3f78SToomas Soome {
216*a1bf3f78SToomas Soome 	return ((*stack->top--).p);
217*a1bf3f78SToomas Soome }
218*a1bf3f78SToomas Soome 
219*a1bf3f78SToomas Soome ficlUnsigned
220*a1bf3f78SToomas Soome ficlStackPopUnsigned(ficlStack *stack)
221*a1bf3f78SToomas Soome {
222*a1bf3f78SToomas Soome 	return ((*stack->top--).u);
223*a1bf3f78SToomas Soome }
224*a1bf3f78SToomas Soome 
225*a1bf3f78SToomas Soome ficlInteger
226*a1bf3f78SToomas Soome ficlStackPopInteger(ficlStack *stack)
227*a1bf3f78SToomas Soome {
228*a1bf3f78SToomas Soome 	return ((*stack->top--).i);
229*a1bf3f78SToomas Soome }
230*a1bf3f78SToomas Soome 
231*a1bf3f78SToomas Soome ficl2Integer
232*a1bf3f78SToomas Soome ficlStackPop2Integer(ficlStack *stack)
233*a1bf3f78SToomas Soome {
234*a1bf3f78SToomas Soome 	ficl2Integer ret;
235*a1bf3f78SToomas Soome 	ficlInteger high = ficlStackPopInteger(stack);
236*a1bf3f78SToomas Soome 	ficlInteger low = ficlStackPopInteger(stack);
237*a1bf3f78SToomas Soome 	FICL_2INTEGER_SET(high, low, ret);
238*a1bf3f78SToomas Soome 	return (ret);
239*a1bf3f78SToomas Soome }
240*a1bf3f78SToomas Soome 
241*a1bf3f78SToomas Soome ficl2Unsigned
242*a1bf3f78SToomas Soome ficlStackPop2Unsigned(ficlStack *stack)
243*a1bf3f78SToomas Soome {
244*a1bf3f78SToomas Soome 	ficl2Unsigned ret;
245*a1bf3f78SToomas Soome 	ficlUnsigned high = ficlStackPopUnsigned(stack);
246*a1bf3f78SToomas Soome 	ficlUnsigned low = ficlStackPopUnsigned(stack);
247*a1bf3f78SToomas Soome 	FICL_2UNSIGNED_SET(high, low, ret);
248*a1bf3f78SToomas Soome 	return (ret);
249*a1bf3f78SToomas Soome }
250*a1bf3f78SToomas Soome 
251*a1bf3f78SToomas Soome #if (FICL_WANT_FLOAT)
252*a1bf3f78SToomas Soome ficlFloat
253*a1bf3f78SToomas Soome ficlStackPopFloat(ficlStack *stack)
254*a1bf3f78SToomas Soome {
255*a1bf3f78SToomas Soome 	return ((*stack->top--).f);
256*a1bf3f78SToomas Soome }
257*a1bf3f78SToomas Soome #endif
258*a1bf3f78SToomas Soome 
259*a1bf3f78SToomas Soome /*
260*a1bf3f78SToomas Soome  * s t a c k P u s h
261*a1bf3f78SToomas Soome  */
262*a1bf3f78SToomas Soome void
263*a1bf3f78SToomas Soome ficlStackPush(ficlStack *stack, ficlCell c)
264*a1bf3f78SToomas Soome {
265*a1bf3f78SToomas Soome 	*++stack->top = c;
266*a1bf3f78SToomas Soome }
267*a1bf3f78SToomas Soome 
268*a1bf3f78SToomas Soome void
269*a1bf3f78SToomas Soome ficlStackPushPointer(ficlStack *stack, void *ptr)
270*a1bf3f78SToomas Soome {
271*a1bf3f78SToomas Soome 	ficlCell c;
272*a1bf3f78SToomas Soome 
273*a1bf3f78SToomas Soome 	c.p = ptr;
274*a1bf3f78SToomas Soome 	*++stack->top = c;
275*a1bf3f78SToomas Soome }
276*a1bf3f78SToomas Soome 
277*a1bf3f78SToomas Soome void
278*a1bf3f78SToomas Soome ficlStackPushInteger(ficlStack *stack, ficlInteger i)
279*a1bf3f78SToomas Soome {
280*a1bf3f78SToomas Soome 	ficlCell c;
281*a1bf3f78SToomas Soome 
282*a1bf3f78SToomas Soome 	c.i = i;
283*a1bf3f78SToomas Soome 	*++stack->top = c;
284*a1bf3f78SToomas Soome }
285*a1bf3f78SToomas Soome 
286*a1bf3f78SToomas Soome void
287*a1bf3f78SToomas Soome ficlStackPushUnsigned(ficlStack *stack, ficlUnsigned u)
288*a1bf3f78SToomas Soome {
289*a1bf3f78SToomas Soome 	ficlCell c;
290*a1bf3f78SToomas Soome 
291*a1bf3f78SToomas Soome 	c.u = u;
292*a1bf3f78SToomas Soome 	*++stack->top = c;
293*a1bf3f78SToomas Soome }
294*a1bf3f78SToomas Soome 
295*a1bf3f78SToomas Soome void
296*a1bf3f78SToomas Soome ficlStackPush2Unsigned(ficlStack *stack, ficl2Unsigned du)
297*a1bf3f78SToomas Soome {
298*a1bf3f78SToomas Soome 	ficlStackPushUnsigned(stack, FICL_2UNSIGNED_GET_LOW(du));
299*a1bf3f78SToomas Soome 	ficlStackPushUnsigned(stack, FICL_2UNSIGNED_GET_HIGH(du));
300*a1bf3f78SToomas Soome }
301*a1bf3f78SToomas Soome 
302*a1bf3f78SToomas Soome void
303*a1bf3f78SToomas Soome ficlStackPush2Integer(ficlStack *stack, ficl2Integer di)
304*a1bf3f78SToomas Soome {
305*a1bf3f78SToomas Soome 	ficl2Unsigned du;
306*a1bf3f78SToomas Soome 	FICL_2UNSIGNED_SET(FICL_2UNSIGNED_GET_HIGH(di),
307*a1bf3f78SToomas Soome 	    FICL_2UNSIGNED_GET_LOW(di), du);
308*a1bf3f78SToomas Soome 	ficlStackPush2Unsigned(stack, du);
309*a1bf3f78SToomas Soome }
310*a1bf3f78SToomas Soome 
311*a1bf3f78SToomas Soome #if (FICL_WANT_FLOAT)
312*a1bf3f78SToomas Soome void
313*a1bf3f78SToomas Soome ficlStackPushFloat(ficlStack *stack, ficlFloat f)
314*a1bf3f78SToomas Soome {
315*a1bf3f78SToomas Soome 	ficlCell c;
316*a1bf3f78SToomas Soome 
317*a1bf3f78SToomas Soome 	c.f = f;
318*a1bf3f78SToomas Soome 	*++stack->top = c;
319*a1bf3f78SToomas Soome }
320*a1bf3f78SToomas Soome #endif
321*a1bf3f78SToomas Soome 
322*a1bf3f78SToomas Soome /*
323*a1bf3f78SToomas Soome  * s t a c k R e s e t
324*a1bf3f78SToomas Soome  */
325*a1bf3f78SToomas Soome void
326*a1bf3f78SToomas Soome ficlStackReset(ficlStack *stack)
327*a1bf3f78SToomas Soome {
328*a1bf3f78SToomas Soome 	stack->top = stack->base - 1;
329*a1bf3f78SToomas Soome }
330*a1bf3f78SToomas Soome 
331*a1bf3f78SToomas Soome /*
332*a1bf3f78SToomas Soome  * s t a c k R o l l
333*a1bf3f78SToomas Soome  * Roll nth stack entry to the top (counting from zero), if n is
334*a1bf3f78SToomas Soome  * >= 0. Drop other entries as needed to fill the hole.
335*a1bf3f78SToomas Soome  * If n < 0, roll top-of-stack to nth entry, pushing others
336*a1bf3f78SToomas Soome  * upward as needed to fill the hole.
337*a1bf3f78SToomas Soome  */
338*a1bf3f78SToomas Soome void
339*a1bf3f78SToomas Soome ficlStackRoll(ficlStack *stack, int n)
340*a1bf3f78SToomas Soome {
341*a1bf3f78SToomas Soome 	ficlCell c;
342*a1bf3f78SToomas Soome 	ficlCell *cell;
343*a1bf3f78SToomas Soome 
344*a1bf3f78SToomas Soome 	if (n == 0)
345*a1bf3f78SToomas Soome 		return;
346*a1bf3f78SToomas Soome 	else if (n > 0) {
347*a1bf3f78SToomas Soome 		cell = stack->top - n;
348*a1bf3f78SToomas Soome 		c = *cell;
349*a1bf3f78SToomas Soome 
350*a1bf3f78SToomas Soome 		for (; n > 0; --n, cell++) {
351*a1bf3f78SToomas Soome 			*cell = cell[1];
352*a1bf3f78SToomas Soome 		}
353*a1bf3f78SToomas Soome 
354*a1bf3f78SToomas Soome 		*cell = c;
355*a1bf3f78SToomas Soome 	} else {
356*a1bf3f78SToomas Soome 		cell = stack->top;
357*a1bf3f78SToomas Soome 		c = *cell;
358*a1bf3f78SToomas Soome 
359*a1bf3f78SToomas Soome 		for (; n < 0; ++n, cell--) {
360*a1bf3f78SToomas Soome 			*cell = cell[-1];
361*a1bf3f78SToomas Soome 		}
362*a1bf3f78SToomas Soome 
363*a1bf3f78SToomas Soome 		*cell = c;
364*a1bf3f78SToomas Soome 	}
365*a1bf3f78SToomas Soome }
366*a1bf3f78SToomas Soome 
367*a1bf3f78SToomas Soome /*
368*a1bf3f78SToomas Soome  * s t a c k S e t T o p
369*a1bf3f78SToomas Soome  */
370*a1bf3f78SToomas Soome void
371*a1bf3f78SToomas Soome ficlStackSetTop(ficlStack *stack, ficlCell c)
372*a1bf3f78SToomas Soome {
373*a1bf3f78SToomas Soome 	FICL_STACK_CHECK(stack, 1, 1);
374*a1bf3f78SToomas Soome 	stack->top[0] = c;
375*a1bf3f78SToomas Soome }
376*a1bf3f78SToomas Soome 
377*a1bf3f78SToomas Soome void
378*a1bf3f78SToomas Soome ficlStackWalk(ficlStack *stack, ficlStackWalkFunction callback,
379*a1bf3f78SToomas Soome     void *context, ficlInteger bottomToTop)
380*a1bf3f78SToomas Soome {
381*a1bf3f78SToomas Soome 	int i;
382*a1bf3f78SToomas Soome 	int depth;
383*a1bf3f78SToomas Soome 	ficlCell *cell;
384*a1bf3f78SToomas Soome 	FICL_STACK_CHECK(stack, 0, 0);
385*a1bf3f78SToomas Soome 
386*a1bf3f78SToomas Soome 	depth = ficlStackDepth(stack);
387*a1bf3f78SToomas Soome 	cell = bottomToTop ? stack->base : stack->top;
388*a1bf3f78SToomas Soome 	for (i = 0; i < depth; i++) {
389*a1bf3f78SToomas Soome 		if (callback(context, cell) == FICL_FALSE)
390*a1bf3f78SToomas Soome 			break;
391*a1bf3f78SToomas Soome 		cell += bottomToTop ? 1 : -1;
392*a1bf3f78SToomas Soome 	}
393*a1bf3f78SToomas Soome }
394