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