stand/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.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 *******************************************************************/
  72 void 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
  91 void 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
 113 FICL_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
 135 void 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
 148 int 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
 158 void 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
 173 CELL stackFetch(FICL_STACK *pStack, int n)
 174 {
 175     return pStack->sp[-n-1];
 176 }
 177
 178 void 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
 190 CELL 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
 205 void 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
 221 void 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
 234 void 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
 246 CELL stackPop(FICL_STACK *pStack)
 247 {
 248     return *--pStack->sp;
 249 }
 250
 251 void *stackPopPtr(FICL_STACK *pStack)
 252 {
 253     return (*--pStack->sp).p;
 254 }
 255
 256 FICL_UNS stackPopUNS(FICL_STACK *pStack)
 257 {
 258     return (*--pStack->sp).u;
 259 }
 260
 261 FICL_INT stackPopINT(FICL_STACK *pStack)
 262 {
 263     return (*--pStack->sp).i;
 264 }
 265
 266 #if (FICL_WANT_FLOAT)
 267 float 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
 278 void stackPush(FICL_STACK *pStack, CELL c)
 279 {
 280     *pStack->sp++ = c;
 281 }
 282
 283 void stackPushPtr(FICL_STACK *pStack, void *ptr)
 284 {
 285     *pStack->sp++ = LVALUEtoCELL(ptr);
 286 }
 287
 288 void stackPushUNS(FICL_STACK *pStack, FICL_UNS u)
 289 {
 290     *pStack->sp++ = LVALUEtoCELL(u);
 291 }
 292
 293 void stackPushINT(FICL_STACK *pStack, FICL_INT i)
 294 {
 295     *pStack->sp++ = LVALUEtoCELL(i);
 296 }
 297
 298 #if (FICL_WANT_FLOAT)
 299 void 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
 310 void 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
 325 void 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
 365 void stackSetTop(FICL_STACK *pStack, CELL c)
 366 {
 367     pStack->sp[-1] = c;
 368     return;
 369 }
 370
 371