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 /* $FreeBSD$ */ 44 45 #ifdef TESTMAIN 46 #include <stdlib.h> 47 #else 48 #include <stand.h> 49 #endif 50 #include "ficl.h" 51 52 #define STKDEPTH(s) ((s)->sp - (s)->base) 53 54 /* 55 ** N O T E: Stack convention: 56 ** 57 ** sp points to the first available cell 58 ** push: store value at sp, increment sp 59 ** pop: decrement sp, fetch value at sp 60 ** Stack grows from low to high memory 61 */ 62 63 /******************************************************************* 64 v m C h e c k S t a c k 65 ** Check the parameter stack for underflow or overflow. 66 ** nCells controls the type of check: if nCells is zero, 67 ** the function checks the stack state for underflow and overflow. 68 ** If nCells > 0, checks to see that the stack has room to push 69 ** that many cells. If less than zero, checks to see that the 70 ** stack has room to pop that many cells. If any test fails, 71 ** the function throws (via vmThrow) a VM_ERREXIT exception. 72 *******************************************************************/ 73 void vmCheckStack(FICL_VM *pVM, int popCells, int pushCells) 74 { 75 FICL_STACK *pStack = pVM->pStack; 76 int nFree = pStack->base + pStack->nCells - pStack->sp; 77 78 if (popCells > STKDEPTH(pStack)) 79 { 80 vmThrowErr(pVM, "Error: stack underflow"); 81 } 82 83 if (nFree < pushCells - popCells) 84 { 85 vmThrowErr(pVM, "Error: stack overflow"); 86 } 87 88 return; 89 } 90 91 #if FICL_WANT_FLOAT 92 void vmCheckFStack(FICL_VM *pVM, int popCells, int pushCells) 93 { 94 FICL_STACK *fStack = pVM->fStack; 95 int nFree = fStack->base + fStack->nCells - fStack->sp; 96 97 if (popCells > STKDEPTH(fStack)) 98 { 99 vmThrowErr(pVM, "Error: float stack underflow"); 100 } 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 114 FICL_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 136 void 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 149 int 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 159 void 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 174 CELL stackFetch(FICL_STACK *pStack, int n) 175 { 176 return pStack->sp[-n-1]; 177 } 178 179 void 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 191 CELL 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 206 void 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 222 void 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 235 void 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 247 CELL stackPop(FICL_STACK *pStack) 248 { 249 return *--pStack->sp; 250 } 251 252 void *stackPopPtr(FICL_STACK *pStack) 253 { 254 return (*--pStack->sp).p; 255 } 256 257 FICL_UNS stackPopUNS(FICL_STACK *pStack) 258 { 259 return (*--pStack->sp).u; 260 } 261 262 FICL_INT stackPopINT(FICL_STACK *pStack) 263 { 264 return (*--pStack->sp).i; 265 } 266 267 #if (FICL_WANT_FLOAT) 268 float 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 279 void stackPush(FICL_STACK *pStack, CELL c) 280 { 281 *pStack->sp++ = c; 282 } 283 284 void stackPushPtr(FICL_STACK *pStack, void *ptr) 285 { 286 *pStack->sp++ = LVALUEtoCELL(ptr); 287 } 288 289 void stackPushUNS(FICL_STACK *pStack, FICL_UNS u) 290 { 291 *pStack->sp++ = LVALUEtoCELL(u); 292 } 293 294 void stackPushINT(FICL_STACK *pStack, FICL_INT i) 295 { 296 *pStack->sp++ = LVALUEtoCELL(i); 297 } 298 299 #if (FICL_WANT_FLOAT) 300 void 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 311 void 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 326 void 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 366 void stackSetTop(FICL_STACK *pStack, CELL c) 367 { 368 pStack->sp[-1] = c; 369 return; 370 } 371 372 373