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.11 2010/08/12 13:57:22 asau 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 #include "ficl.h"
44
45 #define STKDEPTH(s) (((s)->top - (s)->base) + 1)
46
47 /*
48 * N O T E: Stack convention:
49 *
50 * THIS CHANGED IN FICL 4.0!
51 *
52 * top points to the *current* top data value
53 * push: increment top, store value at top
54 * pop: fetch value at top, decrement top
55 * Stack grows from low to high memory
56 */
57
58 /*
59 * v m C h e c k S t a c k
60 * Check the parameter stack for underflow or overflow.
61 * size controls the type of check: if size is zero,
62 * the function checks the stack state for underflow and overflow.
63 * If size > 0, checks to see that the stack has room to push
64 * that many cells. If less than zero, checks to see that the
65 * stack has room to pop that many cells. If any test fails,
66 * the function throws (via vmThrow) a VM_ERREXIT exception.
67 */
68 void
ficlStackCheck(ficlStack * stack,int popCells,int pushCells)69 ficlStackCheck(ficlStack *stack, int popCells, int pushCells)
70 {
71 #if FICL_ROBUST >= 1
72 int nFree = stack->size - STKDEPTH(stack);
73
74 if (popCells > STKDEPTH(stack))
75 ficlVmThrowError(stack->vm, "Error: %s stack underflow",
76 stack->name);
77
78 if (nFree < pushCells - popCells)
79 ficlVmThrowError(stack->vm, "Error: %s stack overflow",
80 stack->name);
81 #else /* FICL_ROBUST >= 1 */
82 FICL_IGNORE(stack);
83 FICL_IGNORE(popCells);
84 FICL_IGNORE(pushCells);
85 #endif /* FICL_ROBUST >= 1 */
86 }
87
88 /*
89 * s t a c k C r e a t e
90 */
91
92 ficlStack *
ficlStackCreate(ficlVm * vm,char * name,unsigned size)93 ficlStackCreate(ficlVm *vm, char *name, unsigned size)
94 {
95 size_t totalSize = sizeof (ficlStack) + (size * sizeof (ficlCell));
96 ficlStack *stack = ficlMalloc(totalSize);
97
98 FICL_VM_ASSERT(vm, size != 0);
99 FICL_VM_ASSERT(vm, stack != NULL);
100
101 stack->size = size;
102 stack->frame = NULL;
103
104 stack->vm = vm;
105 stack->name = name;
106
107 ficlStackReset(stack);
108 return (stack);
109 }
110
111 /*
112 * s t a c k D e l e t e
113 */
114 void
ficlStackDestroy(ficlStack * stack)115 ficlStackDestroy(ficlStack *stack)
116 {
117 if (stack)
118 ficlFree(stack);
119 }
120
121 /*
122 * s t a c k D e p t h
123 */
124 int
ficlStackDepth(ficlStack * stack)125 ficlStackDepth(ficlStack *stack)
126 {
127 return (STKDEPTH(stack));
128 }
129
130 /*
131 * s t a c k D r o p
132 */
133 void
ficlStackDrop(ficlStack * stack,int n)134 ficlStackDrop(ficlStack *stack, int n)
135 {
136 FICL_VM_ASSERT(stack->vm, n > 0);
137 stack->top -= n;
138 }
139
140 /*
141 * s t a c k F e t c h
142 */
143 ficlCell
ficlStackFetch(ficlStack * stack,int n)144 ficlStackFetch(ficlStack *stack, int n)
145 {
146 return (stack->top[-n]);
147 }
148
149 void
ficlStackStore(ficlStack * stack,int n,ficlCell c)150 ficlStackStore(ficlStack *stack, int n, ficlCell c)
151 {
152 stack->top[-n] = c;
153 }
154
155 /*
156 * s t a c k G e t T o p
157 */
158 ficlCell
ficlStackGetTop(ficlStack * stack)159 ficlStackGetTop(ficlStack *stack)
160 {
161 return (stack->top[0]);
162 }
163
164 #if FICL_WANT_LOCALS
165 /*
166 * s t a c k L i n k
167 * Link a frame using the stack's frame pointer. Allot space for
168 * size cells in the frame
169 * 1) Push frame
170 * 2) frame = top
171 * 3) top += size
172 */
173 void
ficlStackLink(ficlStack * stack,int size)174 ficlStackLink(ficlStack *stack, int size)
175 {
176 ficlStackPushPointer(stack, stack->frame);
177 stack->frame = stack->top + 1;
178 stack->top += size;
179 }
180
181 /*
182 * s t a c k U n l i n k
183 * Unink a stack frame previously created by stackLink
184 * 1) top = frame
185 * 2) frame = pop()
186 */
187 void
ficlStackUnlink(ficlStack * stack)188 ficlStackUnlink(ficlStack *stack)
189 {
190 stack->top = stack->frame - 1;
191 stack->frame = ficlStackPopPointer(stack);
192 }
193 #endif /* FICL_WANT_LOCALS */
194
195 /*
196 * s t a c k P i c k
197 */
198 void
ficlStackPick(ficlStack * stack,int n)199 ficlStackPick(ficlStack *stack, int n)
200 {
201 ficlStackPush(stack, ficlStackFetch(stack, n));
202 }
203
204 /*
205 * s t a c k P o p
206 */
207 ficlCell
ficlStackPop(ficlStack * stack)208 ficlStackPop(ficlStack *stack)
209 {
210 return (*stack->top--);
211 }
212
213 void *
ficlStackPopPointer(ficlStack * stack)214 ficlStackPopPointer(ficlStack *stack)
215 {
216 return ((*stack->top--).p);
217 }
218
219 ficlUnsigned
ficlStackPopUnsigned(ficlStack * stack)220 ficlStackPopUnsigned(ficlStack *stack)
221 {
222 return ((*stack->top--).u);
223 }
224
225 ficlInteger
ficlStackPopInteger(ficlStack * stack)226 ficlStackPopInteger(ficlStack *stack)
227 {
228 return ((*stack->top--).i);
229 }
230
231 ficl2Integer
ficlStackPop2Integer(ficlStack * stack)232 ficlStackPop2Integer(ficlStack *stack)
233 {
234 ficl2Integer ret;
235 ficlInteger high = ficlStackPopInteger(stack);
236 ficlInteger low = ficlStackPopInteger(stack);
237 FICL_2INTEGER_SET(high, low, ret);
238 return (ret);
239 }
240
241 ficl2Unsigned
ficlStackPop2Unsigned(ficlStack * stack)242 ficlStackPop2Unsigned(ficlStack *stack)
243 {
244 ficl2Unsigned ret;
245 ficlUnsigned high = ficlStackPopUnsigned(stack);
246 ficlUnsigned low = ficlStackPopUnsigned(stack);
247 FICL_2UNSIGNED_SET(high, low, ret);
248 return (ret);
249 }
250
251 #if (FICL_WANT_FLOAT)
252 ficlFloat
ficlStackPopFloat(ficlStack * stack)253 ficlStackPopFloat(ficlStack *stack)
254 {
255 return ((*stack->top--).f);
256 }
257 #endif
258
259 /*
260 * s t a c k P u s h
261 */
262 void
ficlStackPush(ficlStack * stack,ficlCell c)263 ficlStackPush(ficlStack *stack, ficlCell c)
264 {
265 *++stack->top = c;
266 }
267
268 void
ficlStackPushPointer(ficlStack * stack,void * ptr)269 ficlStackPushPointer(ficlStack *stack, void *ptr)
270 {
271 ficlCell c;
272
273 c.p = ptr;
274 *++stack->top = c;
275 }
276
277 void
ficlStackPushInteger(ficlStack * stack,ficlInteger i)278 ficlStackPushInteger(ficlStack *stack, ficlInteger i)
279 {
280 ficlCell c;
281
282 c.i = i;
283 *++stack->top = c;
284 }
285
286 void
ficlStackPushUnsigned(ficlStack * stack,ficlUnsigned u)287 ficlStackPushUnsigned(ficlStack *stack, ficlUnsigned u)
288 {
289 ficlCell c;
290
291 c.u = u;
292 *++stack->top = c;
293 }
294
295 void
ficlStackPush2Unsigned(ficlStack * stack,ficl2Unsigned du)296 ficlStackPush2Unsigned(ficlStack *stack, ficl2Unsigned du)
297 {
298 ficlStackPushUnsigned(stack, FICL_2UNSIGNED_GET_LOW(du));
299 ficlStackPushUnsigned(stack, FICL_2UNSIGNED_GET_HIGH(du));
300 }
301
302 void
ficlStackPush2Integer(ficlStack * stack,ficl2Integer di)303 ficlStackPush2Integer(ficlStack *stack, ficl2Integer di)
304 {
305 ficl2Unsigned du;
306 FICL_2UNSIGNED_SET(FICL_2UNSIGNED_GET_HIGH(di),
307 FICL_2UNSIGNED_GET_LOW(di), du);
308 ficlStackPush2Unsigned(stack, du);
309 }
310
311 #if (FICL_WANT_FLOAT)
312 void
ficlStackPushFloat(ficlStack * stack,ficlFloat f)313 ficlStackPushFloat(ficlStack *stack, ficlFloat f)
314 {
315 ficlCell c;
316
317 c.f = f;
318 *++stack->top = c;
319 }
320 #endif
321
322 /*
323 * s t a c k R e s e t
324 */
325 void
ficlStackReset(ficlStack * stack)326 ficlStackReset(ficlStack *stack)
327 {
328 stack->top = stack->base - 1;
329 }
330
331 /*
332 * s t a c k R o l l
333 * Roll nth stack entry to the top (counting from zero), if n is
334 * >= 0. Drop other entries as needed to fill the hole.
335 * If n < 0, roll top-of-stack to nth entry, pushing others
336 * upward as needed to fill the hole.
337 */
338 void
ficlStackRoll(ficlStack * stack,int n)339 ficlStackRoll(ficlStack *stack, int n)
340 {
341 ficlCell c;
342 ficlCell *cell;
343
344 if (n == 0)
345 return;
346 else if (n > 0) {
347 cell = stack->top - n;
348 c = *cell;
349
350 for (; n > 0; --n, cell++) {
351 *cell = cell[1];
352 }
353
354 *cell = c;
355 } else {
356 cell = stack->top;
357 c = *cell;
358
359 for (; n < 0; ++n, cell--) {
360 *cell = cell[-1];
361 }
362
363 *cell = c;
364 }
365 }
366
367 /*
368 * s t a c k S e t T o p
369 */
370 void
ficlStackSetTop(ficlStack * stack,ficlCell c)371 ficlStackSetTop(ficlStack *stack, ficlCell c)
372 {
373 FICL_STACK_CHECK(stack, 1, 1);
374 stack->top[0] = c;
375 }
376
377 void
ficlStackWalk(ficlStack * stack,ficlStackWalkFunction callback,void * context,ficlInteger bottomToTop)378 ficlStackWalk(ficlStack *stack, ficlStackWalkFunction callback,
379 void *context, ficlInteger bottomToTop)
380 {
381 int i;
382 int depth;
383 ficlCell *cell;
384 FICL_STACK_CHECK(stack, 0, 0);
385
386 depth = ficlStackDepth(stack);
387 cell = bottomToTop ? stack->base : stack->top;
388 for (i = 0; i < depth; i++) {
389 if (callback(context, cell) == FICL_FALSE)
390 break;
391 cell += bottomToTop ? 1 : -1;
392 }
393 }
394