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