122708Smpp/******************************************************************* 222708Smpp** s t a c k . c 322708Smpp** Forth Inspired Command Language 422708Smpp** Author: John Sadler (john_sadler@alum.mit.edu) 522708Smpp** Created: 16 Oct 1997 622708Smpp** $Id: stack.c,v 1.10 2001/12/05 07:21:34 jsadler Exp $ 722708Smpp*******************************************************************/ 822708Smpp/* 922708Smpp** Copyright (c) 1997-2001 John Sadler (john_sadler@alum.mit.edu) 1022708Smpp** All rights reserved. 1122708Smpp** 1222708Smpp** Get the latest Ficl release at http://ficl.sourceforge.net 1322708Smpp** 1422708Smpp** I am interested in hearing from anyone who uses ficl. If you have 1522708Smpp** a problem, a success story, a defect, an enhancement request, or 1622708Smpp** if you would like to contribute to the ficl release, please 1722708Smpp** contact me by email at the address above. 1822708Smpp** 1922708Smpp** L I C E N S E and D I S C L A I M E R 2022708Smpp** 2122708Smpp** Redistribution and use in source and binary forms, with or without 2222708Smpp** modification, are permitted provided that the following conditions 2322708Smpp** are met: 2422708Smpp** 1. Redistributions of source code must retain the above copyright 2522708Smpp** notice, this list of conditions and the following disclaimer. 2622708Smpp** 2. Redistributions in binary form must reproduce the above copyright 2722708Smpp** notice, this list of conditions and the following disclaimer in the 2822708Smpp** documentation and/or other materials provided with the distribution. 2922708Smpp** 3022708Smpp** THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND 3122708Smpp** ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 3222708Smpp** IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 3322708Smpp** ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE 3422708Smpp** FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 3550476Speter** DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS 3648795Snik** OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) 3722708Smpp** HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 3822708Smpp** LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY 3922708Smpp** OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF 4022708Smpp** SUCH DAMAGE. 4122708Smpp*/ 4222708Smpp 4322708Smpp/* $FreeBSD$ */ 4484306Sru 4584306Sru#ifdef TESTMAIN 4684306Sru#include <stdlib.h> 4722708Smpp#else 4822708Smpp#include <stand.h> 4922708Smpp#endif 5022708Smpp#include "ficl.h" 5122708Smpp 5222708Smpp#define STKDEPTH(s) ((s)->sp - (s)->base) 53121378Shmp 54121378Shmp/* 5522708Smpp** N O T E: Stack convention: 5622708Smpp** 5722708Smpp** sp points to the first available cell 5822708Smpp** push: store value at sp, increment sp 5922708Smpp** pop: decrement sp, fetch value at sp 6022708Smpp** Stack grows from low to high memory 6122708Smpp*/ 6222708Smpp 6322708Smpp/******************************************************************* 6422708Smpp v m C h e c k S t a c k 6522708Smpp** Check the parameter stack for underflow or overflow. 6622708Smpp** nCells controls the type of check: if nCells is zero, 6722708Smpp** the function checks the stack state for underflow and overflow. 6822708Smpp** If nCells > 0, checks to see that the stack has room to push 6922708Smpp** that many cells. If less than zero, checks to see that the 7022708Smpp** stack has room to pop that many cells. If any test fails, 7122708Smpp** the function throws (via vmThrow) a VM_ERREXIT exception. 7222708Smpp*******************************************************************/ 7322708Smppvoid vmCheckStack(FICL_VM *pVM, int popCells, int pushCells) 74131530Sru{ 7522708Smpp FICL_STACK *pStack = pVM->pStack; 7622708Smpp int nFree = pStack->base + pStack->nCells - pStack->sp; 7722708Smpp 7822708Smpp if (popCells > STKDEPTH(pStack)) 7922708Smpp { 8022708Smpp vmThrowErr(pVM, "Error: stack underflow"); 8122708Smpp } 8282878Sdd 8322708Smpp if (nFree < pushCells - popCells) 8422708Smpp { 8522708Smpp vmThrowErr(pVM, "Error: stack overflow"); 8622708Smpp } 8722708Smpp 8822708Smpp return; 8922708Smpp} 9022708Smpp 9122708Smpp#if FICL_WANT_FLOAT 9222708Smppvoid vmCheckFStack(FICL_VM *pVM, int popCells, int pushCells) 9322708Smpp{ 9422708Smpp FICL_STACK *fStack = pVM->fStack; 9522708Smpp int nFree = fStack->base + fStack->nCells - fStack->sp; 9622708Smpp 9782954Sru if (popCells > STKDEPTH(fStack)) 9822708Smpp { 9922708Smpp vmThrowErr(pVM, "Error: float stack underflow"); 10022708Smpp } 101 102 if (nFree < pushCells - popCells) 103 { 104 vmThrowErr(pVM, "Error: float stack overflow"); 105 } 106} 107#endif 108 109/******************************************************************* 110 s t a c k C r e a t e 111** 112*******************************************************************/ 113 114FICL_STACK *stackCreate(unsigned nCells) 115{ 116 size_t size = sizeof (FICL_STACK) + nCells * sizeof (CELL); 117 FICL_STACK *pStack = ficlMalloc(size); 118 119#if FICL_ROBUST 120 assert (nCells != 0); 121 assert (pStack != NULL); 122#endif 123 124 pStack->nCells = nCells; 125 pStack->sp = pStack->base; 126 pStack->pFrame = NULL; 127 return pStack; 128} 129 130 131/******************************************************************* 132 s t a c k D e l e t e 133** 134*******************************************************************/ 135 136void stackDelete(FICL_STACK *pStack) 137{ 138 if (pStack) 139 ficlFree(pStack); 140 return; 141} 142 143 144/******************************************************************* 145 s t a c k D e p t h 146** 147*******************************************************************/ 148 149int stackDepth(FICL_STACK *pStack) 150{ 151 return STKDEPTH(pStack); 152} 153 154/******************************************************************* 155 s t a c k D r o p 156** 157*******************************************************************/ 158 159void stackDrop(FICL_STACK *pStack, int n) 160{ 161#if FICL_ROBUST 162 assert(n > 0); 163#endif 164 pStack->sp -= n; 165 return; 166} 167 168 169/******************************************************************* 170 s t a c k F e t c h 171** 172*******************************************************************/ 173 174CELL stackFetch(FICL_STACK *pStack, int n) 175{ 176 return pStack->sp[-n-1]; 177} 178 179void stackStore(FICL_STACK *pStack, int n, CELL c) 180{ 181 pStack->sp[-n-1] = c; 182 return; 183} 184 185 186/******************************************************************* 187 s t a c k G e t T o p 188** 189*******************************************************************/ 190 191CELL stackGetTop(FICL_STACK *pStack) 192{ 193 return pStack->sp[-1]; 194} 195 196 197/******************************************************************* 198 s t a c k L i n k 199** Link a frame using the stack's frame pointer. Allot space for 200** nCells cells in the frame 201** 1) Push pFrame 202** 2) pFrame = sp 203** 3) sp += nCells 204*******************************************************************/ 205 206void stackLink(FICL_STACK *pStack, int nCells) 207{ 208 stackPushPtr(pStack, pStack->pFrame); 209 pStack->pFrame = pStack->sp; 210 pStack->sp += nCells; 211 return; 212} 213 214 215/******************************************************************* 216 s t a c k U n l i n k 217** Unink a stack frame previously created by stackLink 218** 1) sp = pFrame 219** 2) pFrame = pop() 220*******************************************************************/ 221 222void stackUnlink(FICL_STACK *pStack) 223{ 224 pStack->sp = pStack->pFrame; 225 pStack->pFrame = stackPopPtr(pStack); 226 return; 227} 228 229 230/******************************************************************* 231 s t a c k P i c k 232** 233*******************************************************************/ 234 235void stackPick(FICL_STACK *pStack, int n) 236{ 237 stackPush(pStack, stackFetch(pStack, n)); 238 return; 239} 240 241 242/******************************************************************* 243 s t a c k P o p 244** 245*******************************************************************/ 246 247CELL stackPop(FICL_STACK *pStack) 248{ 249 return *--pStack->sp; 250} 251 252void *stackPopPtr(FICL_STACK *pStack) 253{ 254 return (*--pStack->sp).p; 255} 256 257FICL_UNS stackPopUNS(FICL_STACK *pStack) 258{ 259 return (*--pStack->sp).u; 260} 261 262FICL_INT stackPopINT(FICL_STACK *pStack) 263{ 264 return (*--pStack->sp).i; 265} 266 267#if (FICL_WANT_FLOAT) 268float stackPopFloat(FICL_STACK *pStack) 269{ 270 return (*(--pStack->sp)).f; 271} 272#endif 273 274/******************************************************************* 275 s t a c k P u s h 276** 277*******************************************************************/ 278 279void stackPush(FICL_STACK *pStack, CELL c) 280{ 281 *pStack->sp++ = c; 282} 283 284void stackPushPtr(FICL_STACK *pStack, void *ptr) 285{ 286 *pStack->sp++ = LVALUEtoCELL(ptr); 287} 288 289void stackPushUNS(FICL_STACK *pStack, FICL_UNS u) 290{ 291 *pStack->sp++ = LVALUEtoCELL(u); 292} 293 294void stackPushINT(FICL_STACK *pStack, FICL_INT i) 295{ 296 *pStack->sp++ = LVALUEtoCELL(i); 297} 298 299#if (FICL_WANT_FLOAT) 300void stackPushFloat(FICL_STACK *pStack, FICL_FLOAT f) 301{ 302 *pStack->sp++ = LVALUEtoCELL(f); 303} 304#endif 305 306/******************************************************************* 307 s t a c k R e s e t 308** 309*******************************************************************/ 310 311void stackReset(FICL_STACK *pStack) 312{ 313 pStack->sp = pStack->base; 314 return; 315} 316 317 318/******************************************************************* 319 s t a c k R o l l 320** Roll nth stack entry to the top (counting from zero), if n is 321** >= 0. Drop other entries as needed to fill the hole. 322** If n < 0, roll top-of-stack to nth entry, pushing others 323** upward as needed to fill the hole. 324*******************************************************************/ 325 326void stackRoll(FICL_STACK *pStack, int n) 327{ 328 CELL c; 329 CELL *pCell; 330 331 if (n == 0) 332 return; 333 else if (n > 0) 334 { 335 pCell = pStack->sp - n - 1; 336 c = *pCell; 337 338 for (;n > 0; --n, pCell++) 339 { 340 *pCell = pCell[1]; 341 } 342 343 *pCell = c; 344 } 345 else 346 { 347 pCell = pStack->sp - 1; 348 c = *pCell; 349 350 for (; n < 0; ++n, pCell--) 351 { 352 *pCell = pCell[-1]; 353 } 354 355 *pCell = c; 356 } 357 return; 358} 359 360 361/******************************************************************* 362 s t a c k S e t T o p 363** 364*******************************************************************/ 365 366void stackSetTop(FICL_STACK *pStack, CELL c) 367{ 368 pStack->sp[-1] = c; 369 return; 370} 371 372 373