Current Path : /sys/amd64/compile/hs32/modules/usr/src/sys/modules/libalias/modules/irc/@/amd64/compile/hs32/modules/usr/src/sys/modules/ispfw/ispfw/@/boot/ficl/ |
FreeBSD hs32.drive.ne.jp 9.1-RELEASE FreeBSD 9.1-RELEASE #1: Wed Jan 14 12:18:08 JST 2015 root@hs32.drive.ne.jp:/sys/amd64/compile/hs32 amd64 |
Current File : //sys/amd64/compile/hs32/modules/usr/src/sys/modules/libalias/modules/irc/@/amd64/compile/hs32/modules/usr/src/sys/modules/ispfw/ispfw/@/boot/ficl/ficl.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: release/9.1.0/sys/boot/ficl/ficl.c 94290 2002-04-09 17:45:28Z dcs $ */ #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 != 0); 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; }