140843Smsmith/******************************************************************* 240843Smsmith** f i c l . c 340843Smsmith** Forth Inspired Command Language - external interface 440843Smsmith** Author: John Sadler (john_sadler@alum.mit.edu) 540843Smsmith** Created: 19 July 1997 694290Sdcs** $Id: ficl.c,v 1.16 2001/12/05 07:21:34 jsadler Exp $ 740843Smsmith*******************************************************************/ 840843Smsmith/* 940843Smsmith** This is an ANS Forth interpreter written in C. 1040843Smsmith** Ficl uses Forth syntax for its commands, but turns the Forth 1140843Smsmith** model on its head in other respects. 1240843Smsmith** Ficl provides facilities for interoperating 1340843Smsmith** with programs written in C: C functions can be exported to Ficl, 1440843Smsmith** and Ficl commands can be executed via a C calling interface. The 1540843Smsmith** interpreter is re-entrant, so it can be used in multiple instances 1640843Smsmith** in a multitasking system. Unlike Forth, Ficl's outer interpreter 1740843Smsmith** expects a text block as input, and returns to the caller after each 1876116Sdcs** text block, so the data pump is somewhere in external code in the 1976116Sdcs** style of TCL. 2040843Smsmith** 2140843Smsmith** Code is written in ANSI C for portability. 2240843Smsmith*/ 2376116Sdcs/* 2476116Sdcs** Copyright (c) 1997-2001 John Sadler (john_sadler@alum.mit.edu) 2576116Sdcs** All rights reserved. 2676116Sdcs** 2776116Sdcs** Get the latest Ficl release at http://ficl.sourceforge.net 2876116Sdcs** 2994290Sdcs** I am interested in hearing from anyone who uses ficl. If you have 3094290Sdcs** a problem, a success story, a defect, an enhancement request, or 3194290Sdcs** if you would like to contribute to the ficl release, please 3294290Sdcs** contact me by email at the address above. 3394290Sdcs** 3476116Sdcs** L I C E N S E and D I S C L A I M E R 3576116Sdcs** 3676116Sdcs** Redistribution and use in source and binary forms, with or without 3776116Sdcs** modification, are permitted provided that the following conditions 3876116Sdcs** are met: 3976116Sdcs** 1. Redistributions of source code must retain the above copyright 4076116Sdcs** notice, this list of conditions and the following disclaimer. 4176116Sdcs** 2. Redistributions in binary form must reproduce the above copyright 4276116Sdcs** notice, this list of conditions and the following disclaimer in the 4376116Sdcs** documentation and/or other materials provided with the distribution. 4476116Sdcs** 4576116Sdcs** THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND 4676116Sdcs** ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 4776116Sdcs** IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 4876116Sdcs** ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE 4976116Sdcs** FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 5076116Sdcs** DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS 5176116Sdcs** OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) 5276116Sdcs** HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 5376116Sdcs** LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY 5476116Sdcs** OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF 5576116Sdcs** SUCH DAMAGE. 5676116Sdcs*/ 5740843Smsmith 5851786Sdcs/* $FreeBSD$ */ 5951786Sdcs 6040883Smsmith#ifdef TESTMAIN 6140843Smsmith#include <stdlib.h> 6240883Smsmith#else 6340883Smsmith#include <stand.h> 6440883Smsmith#endif 6540843Smsmith#include <string.h> 6640843Smsmith#include "ficl.h" 6740843Smsmith 6840843Smsmith 6940843Smsmith/* 7040843Smsmith** System statics 7194290Sdcs** Each FICL_SYSTEM builds a global dictionary during its start 7294290Sdcs** sequence. This is shared by all virtual machines of that system. 7394290Sdcs** Therefore only one VM can update the dictionary 7440843Smsmith** at a time. The system imports a locking function that 7540843Smsmith** you can override in order to control update access to 7640843Smsmith** the dictionary. The function is stubbed out by default, 7740843Smsmith** but you can insert one: #define FICL_MULTITHREAD 1 7840843Smsmith** and supply your own version of ficlLockDictionary. 7940843Smsmith*/ 8040843Smsmithstatic int defaultStack = FICL_DEFAULT_STACK; 8140843Smsmith 8240843Smsmith 8394290Sdcsstatic void ficlSetVersionEnv(FICL_SYSTEM *pSys); 8494290Sdcs 8594290Sdcs 8640843Smsmith/************************************************************************** 8740843Smsmith f i c l I n i t S y s t e m 8840843Smsmith** Binds a global dictionary to the interpreter system. 8940843Smsmith** You specify the address and size of the allocated area. 9040843Smsmith** After that, ficl manages it. 9140843Smsmith** First step is to set up the static pointers to the area. 9240843Smsmith** Then write the "precompiled" portion of the dictionary in. 9340843Smsmith** The dictionary needs to be at least large enough to hold the 9440843Smsmith** precompiled part. Try 1K cells minimum. Use "words" to find 9540843Smsmith** out how much of the dictionary is used at any time. 9640843Smsmith**************************************************************************/ 9794290SdcsFICL_SYSTEM *ficlInitSystemEx(FICL_SYSTEM_INFO *fsi) 9840843Smsmith{ 9994290Sdcs int nDictCells; 10094290Sdcs int nEnvCells; 10194290Sdcs FICL_SYSTEM *pSys = ficlMalloc(sizeof (FICL_SYSTEM)); 10294290Sdcs 10376116Sdcs assert(pSys); 10494290Sdcs assert(fsi->size == sizeof (FICL_SYSTEM_INFO)); 10540843Smsmith 10676116Sdcs memset(pSys, 0, sizeof (FICL_SYSTEM)); 10740843Smsmith 10894290Sdcs nDictCells = fsi->nDictCells; 10940843Smsmith if (nDictCells <= 0) 11094290Sdcs nDictCells = FICL_DEFAULT_DICT; 11140843Smsmith 11294290Sdcs nEnvCells = fsi->nEnvCells; 11394290Sdcs if (nEnvCells <= 0) 11494290Sdcs nEnvCells = FICL_DEFAULT_DICT; 11594290Sdcs 11676116Sdcs pSys->dp = dictCreateHashed((unsigned)nDictCells, HASHSIZE); 11776116Sdcs pSys->dp->pForthWords->name = "forth-wordlist"; 11876116Sdcs 11994290Sdcs pSys->envp = dictCreate((unsigned)nEnvCells); 12076116Sdcs pSys->envp->pForthWords->name = "environment"; 12176116Sdcs 12294290Sdcs pSys->textOut = fsi->textOut; 12394290Sdcs pSys->pExtend = fsi->pExtend; 12494290Sdcs 12540843Smsmith#if FICL_WANT_LOCALS 12640843Smsmith /* 12740843Smsmith ** The locals dictionary is only searched while compiling, 12840843Smsmith ** but this is where speed is most important. On the other 12940843Smsmith ** hand, the dictionary gets emptied after each use of locals 13094290Sdcs ** The need to balance search speed with the cost of the 'empty' 13140843Smsmith ** operation led me to select a single-threaded list... 13240843Smsmith */ 13376116Sdcs pSys->localp = dictCreate((unsigned)FICL_MAX_LOCALS * CELLS_PER_WORD); 13440843Smsmith#endif 13540843Smsmith 13676116Sdcs /* 13776116Sdcs ** Build the precompiled dictionary and load softwords. We need a temporary 13876116Sdcs ** VM to do this - ficlNewVM links one to the head of the system VM list. 13976116Sdcs ** ficlCompilePlatform (defined in win32.c, for example) adds platform specific words. 14076116Sdcs */ 14176116Sdcs ficlCompileCore(pSys); 14294290Sdcs ficlCompilePrefix(pSys); 14376116Sdcs#if FICL_WANT_FLOAT 14476116Sdcs ficlCompileFloat(pSys); 14576116Sdcs#endif 14676116Sdcs#if FICL_PLATFORM_EXTEND 14776116Sdcs ficlCompilePlatform(pSys); 14876116Sdcs#endif 14994290Sdcs ficlSetVersionEnv(pSys); 15076116Sdcs 15176116Sdcs /* 15294290Sdcs ** Establish the parse order. Note that prefixes precede numbers - 15394290Sdcs ** this allows constructs like "0b101010" which might parse as a 15494290Sdcs ** hex value otherwise. 15576116Sdcs */ 15694290Sdcs ficlAddPrecompiledParseStep(pSys, "?prefix", ficlParsePrefix); 15794290Sdcs ficlAddPrecompiledParseStep(pSys, "?number", ficlParseNumber); 15894290Sdcs#if FICL_WANT_FLOAT 15994290Sdcs ficlAddPrecompiledParseStep(pSys, ">float", ficlParseFloatNumber); 16094290Sdcs#endif 16194290Sdcs 16294290Sdcs /* 16394290Sdcs ** Now create a temporary VM to compile the softwords. Since all VMs are 16494290Sdcs ** linked into the vmList of FICL_SYSTEM, we don't have to pass the VM 16594290Sdcs ** to ficlCompileSoftCore -- it just hijacks whatever it finds in the VM list. 16694290Sdcs ** ficl 2.05: vmCreate no longer depends on the presence of INTERPRET in the 16794290Sdcs ** dictionary, so a VM can be created before the dictionary is built. It just 16894290Sdcs ** can't do much... 16994290Sdcs */ 17094290Sdcs ficlNewVM(pSys); 17176116Sdcs ficlCompileSoftCore(pSys); 17276116Sdcs ficlFreeVM(pSys->vmList); 17376116Sdcs 17476116Sdcs 17594290Sdcs return pSys; 17640843Smsmith} 17740843Smsmith 17840843Smsmith 17994290SdcsFICL_SYSTEM *ficlInitSystem(int nDictCells) 18094290Sdcs{ 18194290Sdcs FICL_SYSTEM_INFO fsi; 18294290Sdcs ficlInitInfo(&fsi); 18394290Sdcs fsi.nDictCells = nDictCells; 18494290Sdcs return ficlInitSystemEx(&fsi); 18594290Sdcs} 18694290Sdcs 18794290Sdcs 18840843Smsmith/************************************************************************** 18976116Sdcs f i c l A d d P a r s e S t e p 19076116Sdcs** Appends a parse step function to the end of the parse list (see 19176116Sdcs** FICL_PARSE_STEP notes in ficl.h for details). Returns 0 if successful, 19276116Sdcs** nonzero if there's no more room in the list. 19376116Sdcs**************************************************************************/ 19476116Sdcsint ficlAddParseStep(FICL_SYSTEM *pSys, FICL_WORD *pFW) 19576116Sdcs{ 19676116Sdcs int i; 19776116Sdcs for (i = 0; i < FICL_MAX_PARSE_STEPS; i++) 19876116Sdcs { 19976116Sdcs if (pSys->parseList[i] == NULL) 20076116Sdcs { 20176116Sdcs pSys->parseList[i] = pFW; 20276116Sdcs return 0; 20376116Sdcs } 20476116Sdcs } 20576116Sdcs 20676116Sdcs return 1; 20776116Sdcs} 20876116Sdcs 20976116Sdcs 21076116Sdcs/* 21176116Sdcs** Compile a word into the dictionary that invokes the specified FICL_PARSE_STEP 21276116Sdcs** function. It is up to the user (as usual in Forth) to make sure the stack 21376116Sdcs** preconditions are valid (there needs to be a counted string on top of the stack) 21476116Sdcs** before using the resulting word. 21576116Sdcs*/ 21676116Sdcsvoid ficlAddPrecompiledParseStep(FICL_SYSTEM *pSys, char *name, FICL_PARSE_STEP pStep) 21776116Sdcs{ 21876116Sdcs FICL_DICT *dp = pSys->dp; 21976116Sdcs FICL_WORD *pFW = dictAppendWord(dp, name, parseStepParen, FW_DEFAULT); 22076116Sdcs dictAppendCell(dp, LVALUEtoCELL(pStep)); 22176116Sdcs ficlAddParseStep(pSys, pFW); 22276116Sdcs} 22376116Sdcs 22476116Sdcs 22576116Sdcs/* 22676116Sdcs** This word lists the parse steps in order 22776116Sdcs*/ 22876116Sdcsvoid ficlListParseSteps(FICL_VM *pVM) 22976116Sdcs{ 23076116Sdcs int i; 23176116Sdcs FICL_SYSTEM *pSys = pVM->pSys; 23276116Sdcs assert(pSys); 23376116Sdcs 23476116Sdcs vmTextOut(pVM, "Parse steps:", 1); 23576116Sdcs vmTextOut(pVM, "lookup", 1); 23676116Sdcs 23776116Sdcs for (i = 0; i < FICL_MAX_PARSE_STEPS; i++) 23876116Sdcs { 23976116Sdcs if (pSys->parseList[i] != NULL) 24076116Sdcs { 24176116Sdcs vmTextOut(pVM, pSys->parseList[i]->name, 1); 24276116Sdcs } 24376116Sdcs else break; 24476116Sdcs } 24576116Sdcs return; 24676116Sdcs} 24776116Sdcs 24876116Sdcs 24976116Sdcs/************************************************************************** 25040843Smsmith f i c l N e w V M 25140843Smsmith** Create a new virtual machine and link it into the system list 25276116Sdcs** of VMs for later cleanup by ficlTermSystem. 25340843Smsmith**************************************************************************/ 25494290SdcsFICL_VM *ficlNewVM(FICL_SYSTEM *pSys) 25540843Smsmith{ 25640843Smsmith FICL_VM *pVM = vmCreate(NULL, defaultStack, defaultStack); 25776116Sdcs pVM->link = pSys->vmList; 25876116Sdcs pVM->pSys = pSys; 25994290Sdcs pVM->pExtend = pSys->pExtend; 26094290Sdcs vmSetTextOut(pVM, pSys->textOut); 26140843Smsmith 26276116Sdcs pSys->vmList = pVM; 26340843Smsmith return pVM; 26440843Smsmith} 26540843Smsmith 26640843Smsmith 26740843Smsmith/************************************************************************** 26860959Sdcs f i c l F r e e V M 26960959Sdcs** Removes the VM in question from the system VM list and deletes the 27060959Sdcs** memory allocated to it. This is an optional call, since ficlTermSystem 27160959Sdcs** will do this cleanup for you. This function is handy if you're going to 27260959Sdcs** do a lot of dynamic creation of VMs. 27360959Sdcs**************************************************************************/ 27460959Sdcsvoid ficlFreeVM(FICL_VM *pVM) 27560959Sdcs{ 27694290Sdcs FICL_SYSTEM *pSys = pVM->pSys; 27776116Sdcs FICL_VM *pList = pSys->vmList; 27860959Sdcs 27976116Sdcs assert(pVM != 0); 28060959Sdcs 28176116Sdcs if (pSys->vmList == pVM) 28276116Sdcs { 28376116Sdcs pSys->vmList = pSys->vmList->link; 28476116Sdcs } 28576116Sdcs else for (; pList != NULL; pList = pList->link) 28676116Sdcs { 28776116Sdcs if (pList->link == pVM) 28876116Sdcs { 28976116Sdcs pList->link = pVM->link; 29076116Sdcs break; 29176116Sdcs } 29276116Sdcs } 29360959Sdcs 29476116Sdcs if (pList) 29576116Sdcs vmDelete(pVM); 29676116Sdcs return; 29760959Sdcs} 29860959Sdcs 29960959Sdcs 30060959Sdcs/************************************************************************** 30140843Smsmith f i c l B u i l d 30240843Smsmith** Builds a word into the dictionary. 30340843Smsmith** Preconditions: system must be initialized, and there must 30440843Smsmith** be enough space for the new word's header! Operation is 30540843Smsmith** controlled by ficlLockDictionary, so any initialization 30640843Smsmith** required by your version of the function (if you overrode 30740843Smsmith** it) must be complete at this point. 30840843Smsmith** Parameters: 30940843Smsmith** name -- duh, the name of the word 31040843Smsmith** code -- code to execute when the word is invoked - must take a single param 31140843Smsmith** pointer to a FICL_VM 31240843Smsmith** flags -- 0 or more of F_IMMEDIATE, F_COMPILE, use bitwise OR! 31340843Smsmith** 31440843Smsmith**************************************************************************/ 31594290Sdcsint ficlBuild(FICL_SYSTEM *pSys, char *name, FICL_CODE code, char flags) 31640843Smsmith{ 31794290Sdcs#if FICL_MULTITHREAD 31876116Sdcs int err = ficlLockDictionary(TRUE); 31976116Sdcs if (err) return err; 32094290Sdcs#endif /* FICL_MULTITHREAD */ 32140843Smsmith 32276116Sdcs assert(dictCellsAvail(pSys->dp) > sizeof (FICL_WORD) / sizeof (CELL)); 32376116Sdcs dictAppendWord(pSys->dp, name, code, flags); 32440843Smsmith 32576116Sdcs ficlLockDictionary(FALSE); 32676116Sdcs return 0; 32740843Smsmith} 32840843Smsmith 32940843Smsmith 33040843Smsmith/************************************************************************** 33194290Sdcs f i c l E v a l u a t e 33294290Sdcs** Wrapper for ficlExec() which sets SOURCE-ID to -1. 33394290Sdcs**************************************************************************/ 33494290Sdcsint ficlEvaluate(FICL_VM *pVM, char *pText) 33594290Sdcs{ 33694290Sdcs int returnValue; 33794290Sdcs CELL id = pVM->sourceID; 33894290Sdcs pVM->sourceID.i = -1; 33994290Sdcs returnValue = ficlExecC(pVM, pText, -1); 34094290Sdcs pVM->sourceID = id; 34194290Sdcs return returnValue; 34294290Sdcs} 34394290Sdcs 34494290Sdcs 34594290Sdcs/************************************************************************** 34640843Smsmith f i c l E x e c 34740843Smsmith** Evaluates a block of input text in the context of the 34840843Smsmith** specified interpreter. Emits any requested output to the 34940843Smsmith** interpreter's output function. 35040843Smsmith** 35140843Smsmith** Contains the "inner interpreter" code in a tight loop 35240843Smsmith** 35340843Smsmith** Returns one of the VM_XXXX codes defined in ficl.h: 35440843Smsmith** VM_OUTOFTEXT is the normal exit condition 35540843Smsmith** VM_ERREXIT means that the interp encountered a syntax error 35640843Smsmith** and the vm has been reset to recover (some or all 35740843Smsmith** of the text block got ignored 35840843Smsmith** VM_USEREXIT means that the user executed the "bye" command 35940843Smsmith** to shut down the interpreter. This would be a good 36040843Smsmith** time to delete the vm, etc -- or you can ignore this 36140843Smsmith** signal. 36240843Smsmith**************************************************************************/ 36351786Sdcsint ficlExec(FICL_VM *pVM, char *pText) 36440843Smsmith{ 36551786Sdcs return ficlExecC(pVM, pText, -1); 36651786Sdcs} 36751786Sdcs 36851786Sdcsint ficlExecC(FICL_VM *pVM, char *pText, FICL_INT size) 36951786Sdcs{ 37094290Sdcs FICL_SYSTEM *pSys = pVM->pSys; 37194290Sdcs FICL_DICT *dp = pSys->dp; 37251786Sdcs 37340843Smsmith int except; 37440843Smsmith jmp_buf vmState; 37560959Sdcs jmp_buf *oldState; 37640843Smsmith TIB saveTib; 37740843Smsmith 37840843Smsmith assert(pVM); 37994290Sdcs assert(pSys->pInterp[0]); 38040843Smsmith 38151786Sdcs if (size < 0) 38251786Sdcs size = strlen(pText); 38351786Sdcs 38443078Smsmith vmPushTib(pVM, pText, size, &saveTib); 38540843Smsmith 38640843Smsmith /* 38760959Sdcs ** Save and restore VM's jmp_buf to enable nested calls to ficlExec 38840843Smsmith */ 38960959Sdcs oldState = pVM->pState; 39040843Smsmith pVM->pState = &vmState; /* This has to come before the setjmp! */ 39140843Smsmith except = setjmp(vmState); 39240843Smsmith 39340843Smsmith switch (except) 39440843Smsmith { 39540843Smsmith case 0: 39640843Smsmith if (pVM->fRestart) 39740843Smsmith { 39876116Sdcs pVM->runningWord->code(pVM); 39940843Smsmith pVM->fRestart = 0; 40040843Smsmith } 40151786Sdcs else 40251786Sdcs { /* set VM up to interpret text */ 40394290Sdcs vmPushIP(pVM, &(pSys->pInterp[0])); 40440843Smsmith } 40540843Smsmith 40651786Sdcs vmInnerLoop(pVM); 40740843Smsmith break; 40840843Smsmith 40940843Smsmith case VM_RESTART: 41040843Smsmith pVM->fRestart = 1; 41140843Smsmith except = VM_OUTOFTEXT; 41240843Smsmith break; 41340843Smsmith 41440843Smsmith case VM_OUTOFTEXT: 41551786Sdcs vmPopIP(pVM); 41640977Sjkh#ifdef TESTMAIN 41740843Smsmith if ((pVM->state != COMPILE) && (pVM->sourceID.i == 0)) 41840843Smsmith ficlTextOut(pVM, FICL_PROMPT, 0); 41940977Sjkh#endif 42040843Smsmith break; 42140843Smsmith 42240843Smsmith case VM_USEREXIT: 42351786Sdcs case VM_INNEREXIT: 42476116Sdcs case VM_BREAK: 42540843Smsmith break; 42640843Smsmith 42740843Smsmith case VM_QUIT: 42840843Smsmith if (pVM->state == COMPILE) 42951786Sdcs { 43040843Smsmith dictAbortDefinition(dp); 43151786Sdcs#if FICL_WANT_LOCALS 43276116Sdcs dictEmpty(pSys->localp, pSys->localp->pForthWords->size); 43351786Sdcs#endif 43451786Sdcs } 43551786Sdcs vmQuit(pVM); 43640843Smsmith break; 43740843Smsmith 43840843Smsmith case VM_ERREXIT: 43943078Smsmith case VM_ABORT: 44043078Smsmith case VM_ABORTQ: 44140843Smsmith default: /* user defined exit code?? */ 44240843Smsmith if (pVM->state == COMPILE) 44340843Smsmith { 44440843Smsmith dictAbortDefinition(dp); 44540843Smsmith#if FICL_WANT_LOCALS 44676116Sdcs dictEmpty(pSys->localp, pSys->localp->pForthWords->size); 44740843Smsmith#endif 44840843Smsmith } 44940843Smsmith dictResetSearchOrder(dp); 45060959Sdcs vmReset(pVM); 45140843Smsmith break; 45240843Smsmith } 45340843Smsmith 45460959Sdcs pVM->pState = oldState; 45540843Smsmith vmPopTib(pVM, &saveTib); 45640843Smsmith return (except); 45740843Smsmith} 45840843Smsmith 45940843Smsmith 46040843Smsmith/************************************************************************** 46151786Sdcs f i c l E x e c X T 46251786Sdcs** Given a pointer to a FICL_WORD, push an inner interpreter and 46351786Sdcs** execute the word to completion. This is in contrast with vmExecute, 46451786Sdcs** which does not guarantee that the word will have completed when 46551786Sdcs** the function returns (ie in the case of colon definitions, which 46651786Sdcs** need an inner interpreter to finish) 46751786Sdcs** 46851786Sdcs** Returns one of the VM_XXXX exception codes listed in ficl.h. Normal 46951786Sdcs** exit condition is VM_INNEREXIT, ficl's private signal to exit the 47051786Sdcs** inner loop under normal circumstances. If another code is thrown to 47151786Sdcs** exit the loop, this function will re-throw it if it's nested under 47251786Sdcs** itself or ficlExec. 47351786Sdcs** 47451786Sdcs** NOTE: this function is intended so that C code can execute ficlWords 47551786Sdcs** given their address in the dictionary (xt). 47651786Sdcs**************************************************************************/ 47751786Sdcsint ficlExecXT(FICL_VM *pVM, FICL_WORD *pWord) 47851786Sdcs{ 47951786Sdcs int except; 48051786Sdcs jmp_buf vmState; 48151786Sdcs jmp_buf *oldState; 48276116Sdcs FICL_WORD *oldRunningWord; 48351786Sdcs 48451786Sdcs assert(pVM); 48594290Sdcs assert(pVM->pSys->pExitInner); 48651786Sdcs 48776116Sdcs /* 48876116Sdcs ** Save the runningword so that RESTART behaves correctly 48976116Sdcs ** over nested calls. 49076116Sdcs */ 49176116Sdcs oldRunningWord = pVM->runningWord; 49251786Sdcs /* 49351786Sdcs ** Save and restore VM's jmp_buf to enable nested calls 49451786Sdcs */ 49551786Sdcs oldState = pVM->pState; 49651786Sdcs pVM->pState = &vmState; /* This has to come before the setjmp! */ 49751786Sdcs except = setjmp(vmState); 49851786Sdcs 49951786Sdcs if (except) 50051786Sdcs vmPopIP(pVM); 50151786Sdcs else 50294290Sdcs vmPushIP(pVM, &(pVM->pSys->pExitInner)); 50351786Sdcs 50451786Sdcs switch (except) 50551786Sdcs { 50651786Sdcs case 0: 50751786Sdcs vmExecute(pVM, pWord); 50851786Sdcs vmInnerLoop(pVM); 50951786Sdcs break; 51051786Sdcs 51151786Sdcs case VM_INNEREXIT: 51276116Sdcs case VM_BREAK: 51351786Sdcs break; 51451786Sdcs 51551786Sdcs case VM_RESTART: 51651786Sdcs case VM_OUTOFTEXT: 51751786Sdcs case VM_USEREXIT: 51851786Sdcs case VM_QUIT: 51951786Sdcs case VM_ERREXIT: 52051786Sdcs case VM_ABORT: 52151786Sdcs case VM_ABORTQ: 52251786Sdcs default: /* user defined exit code?? */ 52351786Sdcs if (oldState) 52451786Sdcs { 52551786Sdcs pVM->pState = oldState; 52651786Sdcs vmThrow(pVM, except); 52751786Sdcs } 52851786Sdcs break; 52960959Sdcs } 53051786Sdcs 53151786Sdcs pVM->pState = oldState; 53276116Sdcs pVM->runningWord = oldRunningWord; 53351786Sdcs return (except); 53451786Sdcs} 53551786Sdcs 53651786Sdcs 53751786Sdcs/************************************************************************** 53840843Smsmith f i c l L o o k u p 53940843Smsmith** Look in the system dictionary for a match to the given name. If 54040843Smsmith** found, return the address of the corresponding FICL_WORD. Otherwise 54140843Smsmith** return NULL. 54240843Smsmith**************************************************************************/ 54394290SdcsFICL_WORD *ficlLookup(FICL_SYSTEM *pSys, char *name) 54440843Smsmith{ 54540843Smsmith STRINGINFO si; 54640843Smsmith SI_PSZ(si, name); 54776116Sdcs return dictLookup(pSys->dp, si); 54840843Smsmith} 54940843Smsmith 55040843Smsmith 55140843Smsmith/************************************************************************** 55240843Smsmith f i c l G e t D i c t 55340843Smsmith** Returns the address of the system dictionary 55440843Smsmith**************************************************************************/ 55594290SdcsFICL_DICT *ficlGetDict(FICL_SYSTEM *pSys) 55640843Smsmith{ 55776116Sdcs return pSys->dp; 55840843Smsmith} 55940843Smsmith 56040843Smsmith 56140843Smsmith/************************************************************************** 56240843Smsmith f i c l G e t E n v 56340843Smsmith** Returns the address of the system environment space 56440843Smsmith**************************************************************************/ 56594290SdcsFICL_DICT *ficlGetEnv(FICL_SYSTEM *pSys) 56640843Smsmith{ 56776116Sdcs return pSys->envp; 56840843Smsmith} 56940843Smsmith 57040843Smsmith 57140843Smsmith/************************************************************************** 57240843Smsmith f i c l S e t E n v 57340843Smsmith** Create an environment variable with a one-CELL payload. ficlSetEnvD 57440843Smsmith** makes one with a two-CELL payload. 57540843Smsmith**************************************************************************/ 57694290Sdcsvoid ficlSetEnv(FICL_SYSTEM *pSys, char *name, FICL_UNS value) 57740843Smsmith{ 57840843Smsmith STRINGINFO si; 57940843Smsmith FICL_WORD *pFW; 58076116Sdcs FICL_DICT *envp = pSys->envp; 58140843Smsmith 58240843Smsmith SI_PSZ(si, name); 58340843Smsmith pFW = dictLookup(envp, si); 58440843Smsmith 58540843Smsmith if (pFW == NULL) 58640843Smsmith { 58740843Smsmith dictAppendWord(envp, name, constantParen, FW_DEFAULT); 58840843Smsmith dictAppendCell(envp, LVALUEtoCELL(value)); 58940843Smsmith } 59040843Smsmith else 59140843Smsmith { 59240843Smsmith pFW->param[0] = LVALUEtoCELL(value); 59340843Smsmith } 59440843Smsmith 59540843Smsmith return; 59640843Smsmith} 59740843Smsmith 59894290Sdcsvoid ficlSetEnvD(FICL_SYSTEM *pSys, char *name, FICL_UNS hi, FICL_UNS lo) 59940843Smsmith{ 60040843Smsmith FICL_WORD *pFW; 60140843Smsmith STRINGINFO si; 60276116Sdcs FICL_DICT *envp = pSys->envp; 60340843Smsmith SI_PSZ(si, name); 60440843Smsmith pFW = dictLookup(envp, si); 60540843Smsmith 60640843Smsmith if (pFW == NULL) 60740843Smsmith { 60840843Smsmith dictAppendWord(envp, name, twoConstParen, FW_DEFAULT); 60940843Smsmith dictAppendCell(envp, LVALUEtoCELL(lo)); 61040843Smsmith dictAppendCell(envp, LVALUEtoCELL(hi)); 61140843Smsmith } 61240843Smsmith else 61340843Smsmith { 61440843Smsmith pFW->param[0] = LVALUEtoCELL(lo); 61540843Smsmith pFW->param[1] = LVALUEtoCELL(hi); 61640843Smsmith } 61740843Smsmith 61840843Smsmith return; 61940843Smsmith} 62040843Smsmith 62140843Smsmith 62240843Smsmith/************************************************************************** 62340843Smsmith f i c l G e t L o c 62440843Smsmith** Returns the address of the system locals dictionary. This dict is 62540843Smsmith** only used during compilation, and is shared by all VMs. 62640843Smsmith**************************************************************************/ 62740843Smsmith#if FICL_WANT_LOCALS 62894290SdcsFICL_DICT *ficlGetLoc(FICL_SYSTEM *pSys) 62940843Smsmith{ 63076116Sdcs return pSys->localp; 63140843Smsmith} 63240843Smsmith#endif 63340843Smsmith 63440843Smsmith 63551786Sdcs 63640843Smsmith/************************************************************************** 63751786Sdcs f i c l S e t S t a c k S i z e 63851786Sdcs** Set the stack sizes (return and parameter) to be used for all 63951786Sdcs** subsequently created VMs. Returns actual stack size to be used. 64051786Sdcs**************************************************************************/ 64151786Sdcsint ficlSetStackSize(int nStackCells) 64251786Sdcs{ 64351786Sdcs if (nStackCells >= FICL_DEFAULT_STACK) 64451786Sdcs defaultStack = nStackCells; 64551786Sdcs else 64651786Sdcs defaultStack = FICL_DEFAULT_STACK; 64751786Sdcs 64851786Sdcs return defaultStack; 64951786Sdcs} 65051786Sdcs 65151786Sdcs 65251786Sdcs/************************************************************************** 65340843Smsmith f i c l T e r m S y s t e m 65440843Smsmith** Tear the system down by deleting the dictionaries and all VMs. 65540843Smsmith** This saves you from having to keep track of all that stuff. 65640843Smsmith**************************************************************************/ 65794290Sdcsvoid ficlTermSystem(FICL_SYSTEM *pSys) 65840843Smsmith{ 65976116Sdcs if (pSys->dp) 66076116Sdcs dictDelete(pSys->dp); 66176116Sdcs pSys->dp = NULL; 66240843Smsmith 66376116Sdcs if (pSys->envp) 66476116Sdcs dictDelete(pSys->envp); 66576116Sdcs pSys->envp = NULL; 66640843Smsmith 66740843Smsmith#if FICL_WANT_LOCALS 66876116Sdcs if (pSys->localp) 66976116Sdcs dictDelete(pSys->localp); 67076116Sdcs pSys->localp = NULL; 67140843Smsmith#endif 67240843Smsmith 67376116Sdcs while (pSys->vmList != NULL) 67440843Smsmith { 67576116Sdcs FICL_VM *pVM = pSys->vmList; 67676116Sdcs pSys->vmList = pSys->vmList->link; 67740843Smsmith vmDelete(pVM); 67840843Smsmith } 67940843Smsmith 68076116Sdcs ficlFree(pSys); 68176116Sdcs pSys = NULL; 68240843Smsmith return; 68340843Smsmith} 68460959Sdcs 68560959Sdcs 68694290Sdcs/************************************************************************** 68794290Sdcs f i c l S e t V e r s i o n E n v 68894290Sdcs** Create a double cell environment constant for the version ID 68994290Sdcs**************************************************************************/ 69094290Sdcsstatic void ficlSetVersionEnv(FICL_SYSTEM *pSys) 69194290Sdcs{ 69294290Sdcs ficlSetEnvD(pSys, "ficl-version", FICL_VER_MAJOR, FICL_VER_MINOR); 69394290Sdcs ficlSetEnv (pSys, "ficl-robust", FICL_ROBUST); 69494290Sdcs return; 69594290Sdcs} 69694290Sdcs 697