140843Smsmith/******************************************************************* 240843Smsmith** s t a c k . c 340843Smsmith** Forth Inspired Command Language 440843Smsmith** Author: John Sadler (john_sadler@alum.mit.edu) 540843Smsmith** Created: 16 Oct 1997 694290Sdcs** $Id: stack.c,v 1.10 2001/12/05 07:21:34 jsadler Exp $ 776116Sdcs*******************************************************************/ 876116Sdcs/* 976116Sdcs** Copyright (c) 1997-2001 John Sadler (john_sadler@alum.mit.edu) 1076116Sdcs** All rights reserved. 1176116Sdcs** 1276116Sdcs** Get the latest Ficl release at http://ficl.sourceforge.net 1376116Sdcs** 1494290Sdcs** I am interested in hearing from anyone who uses ficl. If you have 1594290Sdcs** a problem, a success story, a defect, an enhancement request, or 1694290Sdcs** if you would like to contribute to the ficl release, please 1794290Sdcs** contact me by email at the address above. 1894290Sdcs** 1976116Sdcs** L I C E N S E and D I S C L A I M E R 2040843Smsmith** 2176116Sdcs** Redistribution and use in source and binary forms, with or without 2276116Sdcs** modification, are permitted provided that the following conditions 2376116Sdcs** are met: 2476116Sdcs** 1. Redistributions of source code must retain the above copyright 2576116Sdcs** notice, this list of conditions and the following disclaimer. 2676116Sdcs** 2. Redistributions in binary form must reproduce the above copyright 2776116Sdcs** notice, this list of conditions and the following disclaimer in the 2876116Sdcs** documentation and/or other materials provided with the distribution. 2976116Sdcs** 3076116Sdcs** THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND 3176116Sdcs** ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 3276116Sdcs** IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 3376116Sdcs** ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE 3476116Sdcs** FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 3576116Sdcs** DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS 3676116Sdcs** OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) 3776116Sdcs** HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 3876116Sdcs** LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY 3976116Sdcs** OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF 4076116Sdcs** SUCH DAMAGE. 4176116Sdcs*/ 4240883Smsmith 4351786Sdcs/* $FreeBSD$ */ 4451786Sdcs 4540883Smsmith#ifdef TESTMAIN 4640843Smsmith#include <stdlib.h> 4740883Smsmith#else 4840883Smsmith#include <stand.h> 4940883Smsmith#endif 5040843Smsmith#include "ficl.h" 5140843Smsmith 5240843Smsmith#define STKDEPTH(s) ((s)->sp - (s)->base) 5340843Smsmith 5440843Smsmith/* 5540843Smsmith** N O T E: Stack convention: 5640843Smsmith** 5740843Smsmith** sp points to the first available cell 5840843Smsmith** push: store value at sp, increment sp 5940843Smsmith** pop: decrement sp, fetch value at sp 6040843Smsmith** Stack grows from low to high memory 6140843Smsmith*/ 6240843Smsmith 6340843Smsmith/******************************************************************* 6440843Smsmith v m C h e c k S t a c k 6540843Smsmith** Check the parameter stack for underflow or overflow. 6640843Smsmith** nCells controls the type of check: if nCells is zero, 6740843Smsmith** the function checks the stack state for underflow and overflow. 6840843Smsmith** If nCells > 0, checks to see that the stack has room to push 6940843Smsmith** that many cells. If less than zero, checks to see that the 7040843Smsmith** stack has room to pop that many cells. If any test fails, 7140843Smsmith** the function throws (via vmThrow) a VM_ERREXIT exception. 7240843Smsmith*******************************************************************/ 7340843Smsmithvoid vmCheckStack(FICL_VM *pVM, int popCells, int pushCells) 7440843Smsmith{ 7540843Smsmith FICL_STACK *pStack = pVM->pStack; 7640843Smsmith int nFree = pStack->base + pStack->nCells - pStack->sp; 7740843Smsmith 7840843Smsmith if (popCells > STKDEPTH(pStack)) 7940843Smsmith { 8040843Smsmith vmThrowErr(pVM, "Error: stack underflow"); 8140843Smsmith } 8240843Smsmith 8340843Smsmith if (nFree < pushCells - popCells) 8440843Smsmith { 8540843Smsmith vmThrowErr(pVM, "Error: stack overflow"); 8640843Smsmith } 8740843Smsmith 8840843Smsmith return; 8940843Smsmith} 9040843Smsmith 9176116Sdcs#if FICL_WANT_FLOAT 9276116Sdcsvoid vmCheckFStack(FICL_VM *pVM, int popCells, int pushCells) 9376116Sdcs{ 9476116Sdcs FICL_STACK *fStack = pVM->fStack; 9576116Sdcs int nFree = fStack->base + fStack->nCells - fStack->sp; 9676116Sdcs 9776116Sdcs if (popCells > STKDEPTH(fStack)) 9876116Sdcs { 9976116Sdcs vmThrowErr(pVM, "Error: float stack underflow"); 10076116Sdcs } 10176116Sdcs 10276116Sdcs if (nFree < pushCells - popCells) 10376116Sdcs { 10476116Sdcs vmThrowErr(pVM, "Error: float stack overflow"); 10576116Sdcs } 10676116Sdcs} 10776116Sdcs#endif 10876116Sdcs 10940843Smsmith/******************************************************************* 11040843Smsmith s t a c k C r e a t e 11140843Smsmith** 11240843Smsmith*******************************************************************/ 11340843Smsmith 11440843SmsmithFICL_STACK *stackCreate(unsigned nCells) 11540843Smsmith{ 11640843Smsmith size_t size = sizeof (FICL_STACK) + nCells * sizeof (CELL); 11740843Smsmith FICL_STACK *pStack = ficlMalloc(size); 11840843Smsmith 11940843Smsmith#if FICL_ROBUST 12040843Smsmith assert (nCells != 0); 12140843Smsmith assert (pStack != NULL); 12240843Smsmith#endif 12340843Smsmith 12440843Smsmith pStack->nCells = nCells; 12540843Smsmith pStack->sp = pStack->base; 12640843Smsmith pStack->pFrame = NULL; 12740843Smsmith return pStack; 12840843Smsmith} 12940843Smsmith 13040843Smsmith 13140843Smsmith/******************************************************************* 13240843Smsmith s t a c k D e l e t e 13340843Smsmith** 13440843Smsmith*******************************************************************/ 13540843Smsmith 13640843Smsmithvoid stackDelete(FICL_STACK *pStack) 13740843Smsmith{ 13840843Smsmith if (pStack) 13940843Smsmith ficlFree(pStack); 14040843Smsmith return; 14140843Smsmith} 14240843Smsmith 14340843Smsmith 14440843Smsmith/******************************************************************* 14540843Smsmith s t a c k D e p t h 14640843Smsmith** 14740843Smsmith*******************************************************************/ 14840843Smsmith 14940843Smsmithint stackDepth(FICL_STACK *pStack) 15040843Smsmith{ 15140843Smsmith return STKDEPTH(pStack); 15240843Smsmith} 15340843Smsmith 15440843Smsmith/******************************************************************* 15540843Smsmith s t a c k D r o p 15640843Smsmith** 15740843Smsmith*******************************************************************/ 15840843Smsmith 15940843Smsmithvoid stackDrop(FICL_STACK *pStack, int n) 16040843Smsmith{ 16140843Smsmith#if FICL_ROBUST 16240843Smsmith assert(n > 0); 16340843Smsmith#endif 16440843Smsmith pStack->sp -= n; 16540843Smsmith return; 16640843Smsmith} 16740843Smsmith 16840843Smsmith 16940843Smsmith/******************************************************************* 17040843Smsmith s t a c k F e t c h 17140843Smsmith** 17240843Smsmith*******************************************************************/ 17340843Smsmith 17440843SmsmithCELL stackFetch(FICL_STACK *pStack, int n) 17540843Smsmith{ 17640843Smsmith return pStack->sp[-n-1]; 17740843Smsmith} 17840843Smsmith 17940843Smsmithvoid stackStore(FICL_STACK *pStack, int n, CELL c) 18040843Smsmith{ 18140843Smsmith pStack->sp[-n-1] = c; 18240843Smsmith return; 18340843Smsmith} 18440843Smsmith 18540843Smsmith 18640843Smsmith/******************************************************************* 18740843Smsmith s t a c k G e t T o p 18840843Smsmith** 18940843Smsmith*******************************************************************/ 19040843Smsmith 19140843SmsmithCELL stackGetTop(FICL_STACK *pStack) 19240843Smsmith{ 19340843Smsmith return pStack->sp[-1]; 19440843Smsmith} 19540843Smsmith 19640843Smsmith 19740843Smsmith/******************************************************************* 19840843Smsmith s t a c k L i n k 19940843Smsmith** Link a frame using the stack's frame pointer. Allot space for 20040843Smsmith** nCells cells in the frame 20140843Smsmith** 1) Push pFrame 20240843Smsmith** 2) pFrame = sp 20340843Smsmith** 3) sp += nCells 20440843Smsmith*******************************************************************/ 20540843Smsmith 20640843Smsmithvoid stackLink(FICL_STACK *pStack, int nCells) 20740843Smsmith{ 20840843Smsmith stackPushPtr(pStack, pStack->pFrame); 20940843Smsmith pStack->pFrame = pStack->sp; 21040843Smsmith pStack->sp += nCells; 21140843Smsmith return; 21240843Smsmith} 21340843Smsmith 21440843Smsmith 21540843Smsmith/******************************************************************* 21640843Smsmith s t a c k U n l i n k 21740843Smsmith** Unink a stack frame previously created by stackLink 21840843Smsmith** 1) sp = pFrame 21940843Smsmith** 2) pFrame = pop() 22040843Smsmith*******************************************************************/ 22140843Smsmith 22240843Smsmithvoid stackUnlink(FICL_STACK *pStack) 22340843Smsmith{ 22440843Smsmith pStack->sp = pStack->pFrame; 22540843Smsmith pStack->pFrame = stackPopPtr(pStack); 22640843Smsmith return; 22740843Smsmith} 22840843Smsmith 22940843Smsmith 23040843Smsmith/******************************************************************* 23140843Smsmith s t a c k P i c k 23240843Smsmith** 23340843Smsmith*******************************************************************/ 23440843Smsmith 23540843Smsmithvoid stackPick(FICL_STACK *pStack, int n) 23640843Smsmith{ 23740843Smsmith stackPush(pStack, stackFetch(pStack, n)); 23840843Smsmith return; 23940843Smsmith} 24040843Smsmith 24140843Smsmith 24240843Smsmith/******************************************************************* 24340843Smsmith s t a c k P o p 24440843Smsmith** 24540843Smsmith*******************************************************************/ 24640843Smsmith 24740843SmsmithCELL stackPop(FICL_STACK *pStack) 24840843Smsmith{ 24940843Smsmith return *--pStack->sp; 25040843Smsmith} 25140843Smsmith 25240843Smsmithvoid *stackPopPtr(FICL_STACK *pStack) 25340843Smsmith{ 25440843Smsmith return (*--pStack->sp).p; 25540843Smsmith} 25640843Smsmith 25751786SdcsFICL_UNS stackPopUNS(FICL_STACK *pStack) 25840843Smsmith{ 25940843Smsmith return (*--pStack->sp).u; 26040843Smsmith} 26140843Smsmith 26251786SdcsFICL_INT stackPopINT(FICL_STACK *pStack) 26340843Smsmith{ 26440843Smsmith return (*--pStack->sp).i; 26540843Smsmith} 26640843Smsmith 26776116Sdcs#if (FICL_WANT_FLOAT) 26876116Sdcsfloat stackPopFloat(FICL_STACK *pStack) 26976116Sdcs{ 27076116Sdcs return (*(--pStack->sp)).f; 27176116Sdcs} 27276116Sdcs#endif 27340843Smsmith 27440843Smsmith/******************************************************************* 27540843Smsmith s t a c k P u s h 27640843Smsmith** 27740843Smsmith*******************************************************************/ 27840843Smsmith 27940843Smsmithvoid stackPush(FICL_STACK *pStack, CELL c) 28040843Smsmith{ 28140843Smsmith *pStack->sp++ = c; 28240843Smsmith} 28340843Smsmith 28440843Smsmithvoid stackPushPtr(FICL_STACK *pStack, void *ptr) 28540843Smsmith{ 28640843Smsmith *pStack->sp++ = LVALUEtoCELL(ptr); 28740843Smsmith} 28840843Smsmith 28951786Sdcsvoid stackPushUNS(FICL_STACK *pStack, FICL_UNS u) 29040843Smsmith{ 29140843Smsmith *pStack->sp++ = LVALUEtoCELL(u); 29240843Smsmith} 29340843Smsmith 29451786Sdcsvoid stackPushINT(FICL_STACK *pStack, FICL_INT i) 29540843Smsmith{ 29640843Smsmith *pStack->sp++ = LVALUEtoCELL(i); 29740843Smsmith} 29840843Smsmith 29976116Sdcs#if (FICL_WANT_FLOAT) 30094290Sdcsvoid stackPushFloat(FICL_STACK *pStack, FICL_FLOAT f) 30176116Sdcs{ 30276116Sdcs *pStack->sp++ = LVALUEtoCELL(f); 30376116Sdcs} 30476116Sdcs#endif 30576116Sdcs 30640843Smsmith/******************************************************************* 30740843Smsmith s t a c k R e s e t 30840843Smsmith** 30940843Smsmith*******************************************************************/ 31040843Smsmith 31140843Smsmithvoid stackReset(FICL_STACK *pStack) 31240843Smsmith{ 31340843Smsmith pStack->sp = pStack->base; 31440843Smsmith return; 31540843Smsmith} 31640843Smsmith 31740843Smsmith 31840843Smsmith/******************************************************************* 31940843Smsmith s t a c k R o l l 32040843Smsmith** Roll nth stack entry to the top (counting from zero), if n is 32140843Smsmith** >= 0. Drop other entries as needed to fill the hole. 32240843Smsmith** If n < 0, roll top-of-stack to nth entry, pushing others 32340843Smsmith** upward as needed to fill the hole. 32440843Smsmith*******************************************************************/ 32540843Smsmith 32640843Smsmithvoid stackRoll(FICL_STACK *pStack, int n) 32740843Smsmith{ 32840843Smsmith CELL c; 32940843Smsmith CELL *pCell; 33040843Smsmith 33140843Smsmith if (n == 0) 33240843Smsmith return; 33340843Smsmith else if (n > 0) 33440843Smsmith { 33540843Smsmith pCell = pStack->sp - n - 1; 33640843Smsmith c = *pCell; 33740843Smsmith 33840843Smsmith for (;n > 0; --n, pCell++) 33940843Smsmith { 34040843Smsmith *pCell = pCell[1]; 34140843Smsmith } 34240843Smsmith 34340843Smsmith *pCell = c; 34440843Smsmith } 34540843Smsmith else 34640843Smsmith { 34740843Smsmith pCell = pStack->sp - 1; 34840843Smsmith c = *pCell; 34940843Smsmith 35040843Smsmith for (; n < 0; ++n, pCell--) 35140843Smsmith { 35240843Smsmith *pCell = pCell[-1]; 35340843Smsmith } 35440843Smsmith 35540843Smsmith *pCell = c; 35640843Smsmith } 35740843Smsmith return; 35840843Smsmith} 35940843Smsmith 36040843Smsmith 36140843Smsmith/******************************************************************* 36240843Smsmith s t a c k S e t T o p 36340843Smsmith** 36440843Smsmith*******************************************************************/ 36540843Smsmith 36640843Smsmithvoid stackSetTop(FICL_STACK *pStack, CELL c) 36740843Smsmith{ 36840843Smsmith pStack->sp[-1] = c; 36940843Smsmith return; 37040843Smsmith} 37140843Smsmith 37240843Smsmith 373