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 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 * 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 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 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 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 144 ficlStackFetch(ficlStack *stack, int n) 145 { 146 return (stack->top[-n]); 147 } 148 149 void 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 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 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 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 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 208 ficlStackPop(ficlStack *stack) 209 { 210 return (*stack->top--); 211 } 212 213 void * 214 ficlStackPopPointer(ficlStack *stack) 215 { 216 return ((*stack->top--).p); 217 } 218 219 ficlUnsigned 220 ficlStackPopUnsigned(ficlStack *stack) 221 { 222 return ((*stack->top--).u); 223 } 224 225 ficlInteger 226 ficlStackPopInteger(ficlStack *stack) 227 { 228 return ((*stack->top--).i); 229 } 230 231 ficl2Integer 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 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 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 263 ficlStackPush(ficlStack *stack, ficlCell c) 264 { 265 *++stack->top = c; 266 } 267 268 void 269 ficlStackPushPointer(ficlStack *stack, void *ptr) 270 { 271 ficlCell c; 272 273 c.p = ptr; 274 *++stack->top = c; 275 } 276 277 void 278 ficlStackPushInteger(ficlStack *stack, ficlInteger i) 279 { 280 ficlCell c; 281 282 c.i = i; 283 *++stack->top = c; 284 } 285 286 void 287 ficlStackPushUnsigned(ficlStack *stack, ficlUnsigned u) 288 { 289 ficlCell c; 290 291 c.u = u; 292 *++stack->top = c; 293 } 294 295 void 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 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 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 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 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 371 ficlStackSetTop(ficlStack *stack, ficlCell c) 372 { 373 FICL_STACK_CHECK(stack, 1, 1); 374 stack->top[0] = c; 375 } 376 377 void 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