usr/src/common/ficl/stack.c

   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 }