697 lines
21 KiB
C
697 lines
21 KiB
C
/*******************************************************************
|
|
** f i c l . c
|
|
** Forth Inspired Command Language - external interface
|
|
** Author: John Sadler (john_sadler@alum.mit.edu)
|
|
** Created: 19 July 1997
|
|
** $Id: ficl.c,v 1.16 2001/12/05 07:21:34 jsadler Exp $
|
|
*******************************************************************/
|
|
/*
|
|
** This is an ANS Forth interpreter written in C.
|
|
** Ficl uses Forth syntax for its commands, but turns the Forth
|
|
** model on its head in other respects.
|
|
** Ficl provides facilities for interoperating
|
|
** with programs written in C: C functions can be exported to Ficl,
|
|
** and Ficl commands can be executed via a C calling interface. The
|
|
** interpreter is re-entrant, so it can be used in multiple instances
|
|
** in a multitasking system. Unlike Forth, Ficl's outer interpreter
|
|
** expects a text block as input, and returns to the caller after each
|
|
** text block, so the data pump is somewhere in external code in the
|
|
** style of TCL.
|
|
**
|
|
** Code is written in ANSI C for portability.
|
|
*/
|
|
/*
|
|
** Copyright (c) 1997-2001 John Sadler (john_sadler@alum.mit.edu)
|
|
** All rights reserved.
|
|
**
|
|
** Get the latest Ficl release at http://ficl.sourceforge.net
|
|
**
|
|
** I am interested in hearing from anyone who uses ficl. If you have
|
|
** a problem, a success story, a defect, an enhancement request, or
|
|
** if you would like to contribute to the ficl release, please
|
|
** contact me by email at the address above.
|
|
**
|
|
** L I C E N S E and D I S C L A I M E R
|
|
**
|
|
** Redistribution and use in source and binary forms, with or without
|
|
** modification, are permitted provided that the following conditions
|
|
** are met:
|
|
** 1. Redistributions of source code must retain the above copyright
|
|
** notice, this list of conditions and the following disclaimer.
|
|
** 2. Redistributions in binary form must reproduce the above copyright
|
|
** notice, this list of conditions and the following disclaimer in the
|
|
** documentation and/or other materials provided with the distribution.
|
|
**
|
|
** THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
|
|
** ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
|
|
** IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
|
|
** ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
|
|
** FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
|
|
** DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
|
|
** OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
|
|
** HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
|
|
** LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
|
|
** OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
|
|
** SUCH DAMAGE.
|
|
*/
|
|
|
|
/* $FreeBSD$ */
|
|
|
|
#ifdef TESTMAIN
|
|
#include <stdlib.h>
|
|
#else
|
|
#include <stand.h>
|
|
#endif
|
|
#include <string.h>
|
|
#include "ficl.h"
|
|
|
|
|
|
/*
|
|
** System statics
|
|
** Each FICL_SYSTEM builds a global dictionary during its start
|
|
** sequence. This is shared by all virtual machines of that system.
|
|
** Therefore only one VM can update the dictionary
|
|
** at a time. The system imports a locking function that
|
|
** you can override in order to control update access to
|
|
** the dictionary. The function is stubbed out by default,
|
|
** but you can insert one: #define FICL_MULTITHREAD 1
|
|
** and supply your own version of ficlLockDictionary.
|
|
*/
|
|
static int defaultStack = FICL_DEFAULT_STACK;
|
|
|
|
|
|
static void ficlSetVersionEnv(FICL_SYSTEM *pSys);
|
|
|
|
|
|
/**************************************************************************
|
|
f i c l I n i t S y s t e m
|
|
** Binds a global dictionary to the interpreter system.
|
|
** You specify the address and size of the allocated area.
|
|
** After that, ficl manages it.
|
|
** First step is to set up the static pointers to the area.
|
|
** Then write the "precompiled" portion of the dictionary in.
|
|
** The dictionary needs to be at least large enough to hold the
|
|
** precompiled part. Try 1K cells minimum. Use "words" to find
|
|
** out how much of the dictionary is used at any time.
|
|
**************************************************************************/
|
|
FICL_SYSTEM *ficlInitSystemEx(FICL_SYSTEM_INFO *fsi)
|
|
{
|
|
int nDictCells;
|
|
int nEnvCells;
|
|
FICL_SYSTEM *pSys = ficlMalloc(sizeof (FICL_SYSTEM));
|
|
|
|
assert(pSys);
|
|
assert(fsi->size == sizeof (FICL_SYSTEM_INFO));
|
|
|
|
memset(pSys, 0, sizeof (FICL_SYSTEM));
|
|
|
|
nDictCells = fsi->nDictCells;
|
|
if (nDictCells <= 0)
|
|
nDictCells = FICL_DEFAULT_DICT;
|
|
|
|
nEnvCells = fsi->nEnvCells;
|
|
if (nEnvCells <= 0)
|
|
nEnvCells = FICL_DEFAULT_DICT;
|
|
|
|
pSys->dp = dictCreateHashed((unsigned)nDictCells, HASHSIZE);
|
|
pSys->dp->pForthWords->name = "forth-wordlist";
|
|
|
|
pSys->envp = dictCreate((unsigned)nEnvCells);
|
|
pSys->envp->pForthWords->name = "environment";
|
|
|
|
pSys->textOut = fsi->textOut;
|
|
pSys->pExtend = fsi->pExtend;
|
|
|
|
#if FICL_WANT_LOCALS
|
|
/*
|
|
** The locals dictionary is only searched while compiling,
|
|
** but this is where speed is most important. On the other
|
|
** hand, the dictionary gets emptied after each use of locals
|
|
** The need to balance search speed with the cost of the 'empty'
|
|
** operation led me to select a single-threaded list...
|
|
*/
|
|
pSys->localp = dictCreate((unsigned)FICL_MAX_LOCALS * CELLS_PER_WORD);
|
|
#endif
|
|
|
|
/*
|
|
** Build the precompiled dictionary and load softwords. We need a temporary
|
|
** VM to do this - ficlNewVM links one to the head of the system VM list.
|
|
** ficlCompilePlatform (defined in win32.c, for example) adds platform specific words.
|
|
*/
|
|
ficlCompileCore(pSys);
|
|
ficlCompilePrefix(pSys);
|
|
#if FICL_WANT_FLOAT
|
|
ficlCompileFloat(pSys);
|
|
#endif
|
|
#if FICL_PLATFORM_EXTEND
|
|
ficlCompilePlatform(pSys);
|
|
#endif
|
|
ficlSetVersionEnv(pSys);
|
|
|
|
/*
|
|
** Establish the parse order. Note that prefixes precede numbers -
|
|
** this allows constructs like "0b101010" which might parse as a
|
|
** hex value otherwise.
|
|
*/
|
|
ficlAddPrecompiledParseStep(pSys, "?prefix", ficlParsePrefix);
|
|
ficlAddPrecompiledParseStep(pSys, "?number", ficlParseNumber);
|
|
#if FICL_WANT_FLOAT
|
|
ficlAddPrecompiledParseStep(pSys, ">float", ficlParseFloatNumber);
|
|
#endif
|
|
|
|
/*
|
|
** Now create a temporary VM to compile the softwords. Since all VMs are
|
|
** linked into the vmList of FICL_SYSTEM, we don't have to pass the VM
|
|
** to ficlCompileSoftCore -- it just hijacks whatever it finds in the VM list.
|
|
** ficl 2.05: vmCreate no longer depends on the presence of INTERPRET in the
|
|
** dictionary, so a VM can be created before the dictionary is built. It just
|
|
** can't do much...
|
|
*/
|
|
ficlNewVM(pSys);
|
|
ficlCompileSoftCore(pSys);
|
|
ficlFreeVM(pSys->vmList);
|
|
|
|
|
|
return pSys;
|
|
}
|
|
|
|
|
|
FICL_SYSTEM *ficlInitSystem(int nDictCells)
|
|
{
|
|
FICL_SYSTEM_INFO fsi;
|
|
ficlInitInfo(&fsi);
|
|
fsi.nDictCells = nDictCells;
|
|
return ficlInitSystemEx(&fsi);
|
|
}
|
|
|
|
|
|
/**************************************************************************
|
|
f i c l A d d P a r s e S t e p
|
|
** Appends a parse step function to the end of the parse list (see
|
|
** FICL_PARSE_STEP notes in ficl.h for details). Returns 0 if successful,
|
|
** nonzero if there's no more room in the list.
|
|
**************************************************************************/
|
|
int ficlAddParseStep(FICL_SYSTEM *pSys, FICL_WORD *pFW)
|
|
{
|
|
int i;
|
|
for (i = 0; i < FICL_MAX_PARSE_STEPS; i++)
|
|
{
|
|
if (pSys->parseList[i] == NULL)
|
|
{
|
|
pSys->parseList[i] = pFW;
|
|
return 0;
|
|
}
|
|
}
|
|
|
|
return 1;
|
|
}
|
|
|
|
|
|
/*
|
|
** Compile a word into the dictionary that invokes the specified FICL_PARSE_STEP
|
|
** function. It is up to the user (as usual in Forth) to make sure the stack
|
|
** preconditions are valid (there needs to be a counted string on top of the stack)
|
|
** before using the resulting word.
|
|
*/
|
|
void ficlAddPrecompiledParseStep(FICL_SYSTEM *pSys, char *name, FICL_PARSE_STEP pStep)
|
|
{
|
|
FICL_DICT *dp = pSys->dp;
|
|
FICL_WORD *pFW = dictAppendWord(dp, name, parseStepParen, FW_DEFAULT);
|
|
dictAppendCell(dp, LVALUEtoCELL(pStep));
|
|
ficlAddParseStep(pSys, pFW);
|
|
}
|
|
|
|
|
|
/*
|
|
** This word lists the parse steps in order
|
|
*/
|
|
void ficlListParseSteps(FICL_VM *pVM)
|
|
{
|
|
int i;
|
|
FICL_SYSTEM *pSys = pVM->pSys;
|
|
assert(pSys);
|
|
|
|
vmTextOut(pVM, "Parse steps:", 1);
|
|
vmTextOut(pVM, "lookup", 1);
|
|
|
|
for (i = 0; i < FICL_MAX_PARSE_STEPS; i++)
|
|
{
|
|
if (pSys->parseList[i] != NULL)
|
|
{
|
|
vmTextOut(pVM, pSys->parseList[i]->name, 1);
|
|
}
|
|
else break;
|
|
}
|
|
return;
|
|
}
|
|
|
|
|
|
/**************************************************************************
|
|
f i c l N e w V M
|
|
** Create a new virtual machine and link it into the system list
|
|
** of VMs for later cleanup by ficlTermSystem.
|
|
**************************************************************************/
|
|
FICL_VM *ficlNewVM(FICL_SYSTEM *pSys)
|
|
{
|
|
FICL_VM *pVM = vmCreate(NULL, defaultStack, defaultStack);
|
|
pVM->link = pSys->vmList;
|
|
pVM->pSys = pSys;
|
|
pVM->pExtend = pSys->pExtend;
|
|
vmSetTextOut(pVM, pSys->textOut);
|
|
|
|
pSys->vmList = pVM;
|
|
return pVM;
|
|
}
|
|
|
|
|
|
/**************************************************************************
|
|
f i c l F r e e V M
|
|
** Removes the VM in question from the system VM list and deletes the
|
|
** memory allocated to it. This is an optional call, since ficlTermSystem
|
|
** will do this cleanup for you. This function is handy if you're going to
|
|
** do a lot of dynamic creation of VMs.
|
|
**************************************************************************/
|
|
void ficlFreeVM(FICL_VM *pVM)
|
|
{
|
|
FICL_SYSTEM *pSys = pVM->pSys;
|
|
FICL_VM *pList = pSys->vmList;
|
|
|
|
assert(pVM != NULL);
|
|
|
|
if (pSys->vmList == pVM)
|
|
{
|
|
pSys->vmList = pSys->vmList->link;
|
|
}
|
|
else for (; pList != NULL; pList = pList->link)
|
|
{
|
|
if (pList->link == pVM)
|
|
{
|
|
pList->link = pVM->link;
|
|
break;
|
|
}
|
|
}
|
|
|
|
if (pList)
|
|
vmDelete(pVM);
|
|
return;
|
|
}
|
|
|
|
|
|
/**************************************************************************
|
|
f i c l B u i l d
|
|
** Builds a word into the dictionary.
|
|
** Preconditions: system must be initialized, and there must
|
|
** be enough space for the new word's header! Operation is
|
|
** controlled by ficlLockDictionary, so any initialization
|
|
** required by your version of the function (if you overrode
|
|
** it) must be complete at this point.
|
|
** Parameters:
|
|
** name -- duh, the name of the word
|
|
** code -- code to execute when the word is invoked - must take a single param
|
|
** pointer to a FICL_VM
|
|
** flags -- 0 or more of F_IMMEDIATE, F_COMPILE, use bitwise OR!
|
|
**
|
|
**************************************************************************/
|
|
int ficlBuild(FICL_SYSTEM *pSys, char *name, FICL_CODE code, char flags)
|
|
{
|
|
#if FICL_MULTITHREAD
|
|
int err = ficlLockDictionary(TRUE);
|
|
if (err) return err;
|
|
#endif /* FICL_MULTITHREAD */
|
|
|
|
assert(dictCellsAvail(pSys->dp) > sizeof (FICL_WORD) / sizeof (CELL));
|
|
dictAppendWord(pSys->dp, name, code, flags);
|
|
|
|
ficlLockDictionary(FALSE);
|
|
return 0;
|
|
}
|
|
|
|
|
|
/**************************************************************************
|
|
f i c l E v a l u a t e
|
|
** Wrapper for ficlExec() which sets SOURCE-ID to -1.
|
|
**************************************************************************/
|
|
int ficlEvaluate(FICL_VM *pVM, char *pText)
|
|
{
|
|
int returnValue;
|
|
CELL id = pVM->sourceID;
|
|
pVM->sourceID.i = -1;
|
|
returnValue = ficlExecC(pVM, pText, -1);
|
|
pVM->sourceID = id;
|
|
return returnValue;
|
|
}
|
|
|
|
|
|
/**************************************************************************
|
|
f i c l E x e c
|
|
** Evaluates a block of input text in the context of the
|
|
** specified interpreter. Emits any requested output to the
|
|
** interpreter's output function.
|
|
**
|
|
** Contains the "inner interpreter" code in a tight loop
|
|
**
|
|
** Returns one of the VM_XXXX codes defined in ficl.h:
|
|
** VM_OUTOFTEXT is the normal exit condition
|
|
** VM_ERREXIT means that the interp encountered a syntax error
|
|
** and the vm has been reset to recover (some or all
|
|
** of the text block got ignored
|
|
** VM_USEREXIT means that the user executed the "bye" command
|
|
** to shut down the interpreter. This would be a good
|
|
** time to delete the vm, etc -- or you can ignore this
|
|
** signal.
|
|
**************************************************************************/
|
|
int ficlExec(FICL_VM *pVM, char *pText)
|
|
{
|
|
return ficlExecC(pVM, pText, -1);
|
|
}
|
|
|
|
int ficlExecC(FICL_VM *pVM, char *pText, FICL_INT size)
|
|
{
|
|
FICL_SYSTEM *pSys = pVM->pSys;
|
|
FICL_DICT *dp = pSys->dp;
|
|
|
|
int except;
|
|
jmp_buf vmState;
|
|
jmp_buf *oldState;
|
|
TIB saveTib;
|
|
|
|
assert(pVM);
|
|
assert(pSys->pInterp[0]);
|
|
|
|
if (size < 0)
|
|
size = strlen(pText);
|
|
|
|
vmPushTib(pVM, pText, size, &saveTib);
|
|
|
|
/*
|
|
** Save and restore VM's jmp_buf to enable nested calls to ficlExec
|
|
*/
|
|
oldState = pVM->pState;
|
|
pVM->pState = &vmState; /* This has to come before the setjmp! */
|
|
except = setjmp(vmState);
|
|
|
|
switch (except)
|
|
{
|
|
case 0:
|
|
if (pVM->fRestart)
|
|
{
|
|
pVM->runningWord->code(pVM);
|
|
pVM->fRestart = 0;
|
|
}
|
|
else
|
|
{ /* set VM up to interpret text */
|
|
vmPushIP(pVM, &(pSys->pInterp[0]));
|
|
}
|
|
|
|
vmInnerLoop(pVM);
|
|
break;
|
|
|
|
case VM_RESTART:
|
|
pVM->fRestart = 1;
|
|
except = VM_OUTOFTEXT;
|
|
break;
|
|
|
|
case VM_OUTOFTEXT:
|
|
vmPopIP(pVM);
|
|
#ifdef TESTMAIN
|
|
if ((pVM->state != COMPILE) && (pVM->sourceID.i == 0))
|
|
ficlTextOut(pVM, FICL_PROMPT, 0);
|
|
#endif
|
|
break;
|
|
|
|
case VM_USEREXIT:
|
|
case VM_INNEREXIT:
|
|
case VM_BREAK:
|
|
break;
|
|
|
|
case VM_QUIT:
|
|
if (pVM->state == COMPILE)
|
|
{
|
|
dictAbortDefinition(dp);
|
|
#if FICL_WANT_LOCALS
|
|
dictEmpty(pSys->localp, pSys->localp->pForthWords->size);
|
|
#endif
|
|
}
|
|
vmQuit(pVM);
|
|
break;
|
|
|
|
case VM_ERREXIT:
|
|
case VM_ABORT:
|
|
case VM_ABORTQ:
|
|
default: /* user defined exit code?? */
|
|
if (pVM->state == COMPILE)
|
|
{
|
|
dictAbortDefinition(dp);
|
|
#if FICL_WANT_LOCALS
|
|
dictEmpty(pSys->localp, pSys->localp->pForthWords->size);
|
|
#endif
|
|
}
|
|
dictResetSearchOrder(dp);
|
|
vmReset(pVM);
|
|
break;
|
|
}
|
|
|
|
pVM->pState = oldState;
|
|
vmPopTib(pVM, &saveTib);
|
|
return (except);
|
|
}
|
|
|
|
|
|
/**************************************************************************
|
|
f i c l E x e c X T
|
|
** Given a pointer to a FICL_WORD, push an inner interpreter and
|
|
** execute the word to completion. This is in contrast with vmExecute,
|
|
** which does not guarantee that the word will have completed when
|
|
** the function returns (ie in the case of colon definitions, which
|
|
** need an inner interpreter to finish)
|
|
**
|
|
** Returns one of the VM_XXXX exception codes listed in ficl.h. Normal
|
|
** exit condition is VM_INNEREXIT, ficl's private signal to exit the
|
|
** inner loop under normal circumstances. If another code is thrown to
|
|
** exit the loop, this function will re-throw it if it's nested under
|
|
** itself or ficlExec.
|
|
**
|
|
** NOTE: this function is intended so that C code can execute ficlWords
|
|
** given their address in the dictionary (xt).
|
|
**************************************************************************/
|
|
int ficlExecXT(FICL_VM *pVM, FICL_WORD *pWord)
|
|
{
|
|
int except;
|
|
jmp_buf vmState;
|
|
jmp_buf *oldState;
|
|
FICL_WORD *oldRunningWord;
|
|
|
|
assert(pVM);
|
|
assert(pVM->pSys->pExitInner);
|
|
|
|
/*
|
|
** Save the runningword so that RESTART behaves correctly
|
|
** over nested calls.
|
|
*/
|
|
oldRunningWord = pVM->runningWord;
|
|
/*
|
|
** Save and restore VM's jmp_buf to enable nested calls
|
|
*/
|
|
oldState = pVM->pState;
|
|
pVM->pState = &vmState; /* This has to come before the setjmp! */
|
|
except = setjmp(vmState);
|
|
|
|
if (except)
|
|
vmPopIP(pVM);
|
|
else
|
|
vmPushIP(pVM, &(pVM->pSys->pExitInner));
|
|
|
|
switch (except)
|
|
{
|
|
case 0:
|
|
vmExecute(pVM, pWord);
|
|
vmInnerLoop(pVM);
|
|
break;
|
|
|
|
case VM_INNEREXIT:
|
|
case VM_BREAK:
|
|
break;
|
|
|
|
case VM_RESTART:
|
|
case VM_OUTOFTEXT:
|
|
case VM_USEREXIT:
|
|
case VM_QUIT:
|
|
case VM_ERREXIT:
|
|
case VM_ABORT:
|
|
case VM_ABORTQ:
|
|
default: /* user defined exit code?? */
|
|
if (oldState)
|
|
{
|
|
pVM->pState = oldState;
|
|
vmThrow(pVM, except);
|
|
}
|
|
break;
|
|
}
|
|
|
|
pVM->pState = oldState;
|
|
pVM->runningWord = oldRunningWord;
|
|
return (except);
|
|
}
|
|
|
|
|
|
/**************************************************************************
|
|
f i c l L o o k u p
|
|
** Look in the system dictionary for a match to the given name. If
|
|
** found, return the address of the corresponding FICL_WORD. Otherwise
|
|
** return NULL.
|
|
**************************************************************************/
|
|
FICL_WORD *ficlLookup(FICL_SYSTEM *pSys, char *name)
|
|
{
|
|
STRINGINFO si;
|
|
SI_PSZ(si, name);
|
|
return dictLookup(pSys->dp, si);
|
|
}
|
|
|
|
|
|
/**************************************************************************
|
|
f i c l G e t D i c t
|
|
** Returns the address of the system dictionary
|
|
**************************************************************************/
|
|
FICL_DICT *ficlGetDict(FICL_SYSTEM *pSys)
|
|
{
|
|
return pSys->dp;
|
|
}
|
|
|
|
|
|
/**************************************************************************
|
|
f i c l G e t E n v
|
|
** Returns the address of the system environment space
|
|
**************************************************************************/
|
|
FICL_DICT *ficlGetEnv(FICL_SYSTEM *pSys)
|
|
{
|
|
return pSys->envp;
|
|
}
|
|
|
|
|
|
/**************************************************************************
|
|
f i c l S e t E n v
|
|
** Create an environment variable with a one-CELL payload. ficlSetEnvD
|
|
** makes one with a two-CELL payload.
|
|
**************************************************************************/
|
|
void ficlSetEnv(FICL_SYSTEM *pSys, char *name, FICL_UNS value)
|
|
{
|
|
STRINGINFO si;
|
|
FICL_WORD *pFW;
|
|
FICL_DICT *envp = pSys->envp;
|
|
|
|
SI_PSZ(si, name);
|
|
pFW = dictLookup(envp, si);
|
|
|
|
if (pFW == NULL)
|
|
{
|
|
dictAppendWord(envp, name, constantParen, FW_DEFAULT);
|
|
dictAppendCell(envp, LVALUEtoCELL(value));
|
|
}
|
|
else
|
|
{
|
|
pFW->param[0] = LVALUEtoCELL(value);
|
|
}
|
|
|
|
return;
|
|
}
|
|
|
|
void ficlSetEnvD(FICL_SYSTEM *pSys, char *name, FICL_UNS hi, FICL_UNS lo)
|
|
{
|
|
FICL_WORD *pFW;
|
|
STRINGINFO si;
|
|
FICL_DICT *envp = pSys->envp;
|
|
SI_PSZ(si, name);
|
|
pFW = dictLookup(envp, si);
|
|
|
|
if (pFW == NULL)
|
|
{
|
|
dictAppendWord(envp, name, twoConstParen, FW_DEFAULT);
|
|
dictAppendCell(envp, LVALUEtoCELL(lo));
|
|
dictAppendCell(envp, LVALUEtoCELL(hi));
|
|
}
|
|
else
|
|
{
|
|
pFW->param[0] = LVALUEtoCELL(lo);
|
|
pFW->param[1] = LVALUEtoCELL(hi);
|
|
}
|
|
|
|
return;
|
|
}
|
|
|
|
|
|
/**************************************************************************
|
|
f i c l G e t L o c
|
|
** Returns the address of the system locals dictionary. This dict is
|
|
** only used during compilation, and is shared by all VMs.
|
|
**************************************************************************/
|
|
#if FICL_WANT_LOCALS
|
|
FICL_DICT *ficlGetLoc(FICL_SYSTEM *pSys)
|
|
{
|
|
return pSys->localp;
|
|
}
|
|
#endif
|
|
|
|
|
|
|
|
/**************************************************************************
|
|
f i c l S e t S t a c k S i z e
|
|
** Set the stack sizes (return and parameter) to be used for all
|
|
** subsequently created VMs. Returns actual stack size to be used.
|
|
**************************************************************************/
|
|
int ficlSetStackSize(int nStackCells)
|
|
{
|
|
if (nStackCells >= FICL_DEFAULT_STACK)
|
|
defaultStack = nStackCells;
|
|
else
|
|
defaultStack = FICL_DEFAULT_STACK;
|
|
|
|
return defaultStack;
|
|
}
|
|
|
|
|
|
/**************************************************************************
|
|
f i c l T e r m S y s t e m
|
|
** Tear the system down by deleting the dictionaries and all VMs.
|
|
** This saves you from having to keep track of all that stuff.
|
|
**************************************************************************/
|
|
void ficlTermSystem(FICL_SYSTEM *pSys)
|
|
{
|
|
if (pSys->dp)
|
|
dictDelete(pSys->dp);
|
|
pSys->dp = NULL;
|
|
|
|
if (pSys->envp)
|
|
dictDelete(pSys->envp);
|
|
pSys->envp = NULL;
|
|
|
|
#if FICL_WANT_LOCALS
|
|
if (pSys->localp)
|
|
dictDelete(pSys->localp);
|
|
pSys->localp = NULL;
|
|
#endif
|
|
|
|
while (pSys->vmList != NULL)
|
|
{
|
|
FICL_VM *pVM = pSys->vmList;
|
|
pSys->vmList = pSys->vmList->link;
|
|
vmDelete(pVM);
|
|
}
|
|
|
|
ficlFree(pSys);
|
|
pSys = NULL;
|
|
return;
|
|
}
|
|
|
|
|
|
/**************************************************************************
|
|
f i c l S e t V e r s i o n E n v
|
|
** Create a double cell environment constant for the version ID
|
|
**************************************************************************/
|
|
static void ficlSetVersionEnv(FICL_SYSTEM *pSys)
|
|
{
|
|
ficlSetEnvD(pSys, "ficl-version", FICL_VER_MAJOR, FICL_VER_MINOR);
|
|
ficlSetEnv (pSys, "ficl-robust", FICL_ROBUST);
|
|
return;
|
|
}
|
|
|