ficl.c revision 51786
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 640843Smsmith** 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 1840843Smsmith** text block, so the data pump is somewhere in external code. This 1940843Smsmith** is more like TCL than Forth. 2040843Smsmith** 2140843Smsmith** Code is written in ANSI C for portability. 2240843Smsmith*/ 2340843Smsmith 2451786Sdcs/* $FreeBSD: head/sys/boot/ficl/ficl.c 51786 1999-09-29 04:43:16Z dcs $ */ 2551786Sdcs 2640883Smsmith#ifdef TESTMAIN 2740843Smsmith#include <stdlib.h> 2840883Smsmith#else 2940883Smsmith#include <stand.h> 3040883Smsmith#endif 3140843Smsmith#include <string.h> 3240843Smsmith#include "ficl.h" 3340843Smsmith 3443139Smsmith#ifdef FICL_TRACE 3543139Smsmithint ficl_trace = 0; 3643139Smsmith#endif 3740843Smsmith 3843139Smsmith 3940843Smsmith/* 4040843Smsmith** Local prototypes 4140843Smsmith*/ 4240843Smsmith 4340843Smsmith 4440843Smsmith/* 4540843Smsmith** System statics 4640843Smsmith** The system builds a global dictionary during its start 4740843Smsmith** sequence. This is shared by all interpreter instances. 4840843Smsmith** Therefore only one instance can update the dictionary 4940843Smsmith** at a time. The system imports a locking function that 5040843Smsmith** you can override in order to control update access to 5140843Smsmith** the dictionary. The function is stubbed out by default, 5240843Smsmith** but you can insert one: #define FICL_MULTITHREAD 1 5340843Smsmith** and supply your own version of ficlLockDictionary. 5440843Smsmith*/ 5540843Smsmithstatic FICL_DICT *dp = NULL; 5640843Smsmithstatic FICL_DICT *envp = NULL; 5740843Smsmith#if FICL_WANT_LOCALS 5840843Smsmithstatic FICL_DICT *localp = NULL; 5940843Smsmith#endif 6040843Smsmithstatic FICL_VM *vmList = NULL; 6140843Smsmith 6240843Smsmithstatic int defaultStack = FICL_DEFAULT_STACK; 6340843Smsmithstatic int defaultDict = FICL_DEFAULT_DICT; 6440843Smsmith 6540843Smsmith 6640843Smsmith/************************************************************************** 6740843Smsmith f i c l I n i t S y s t e m 6840843Smsmith** Binds a global dictionary to the interpreter system. 6940843Smsmith** You specify the address and size of the allocated area. 7040843Smsmith** After that, ficl manages it. 7140843Smsmith** First step is to set up the static pointers to the area. 7240843Smsmith** Then write the "precompiled" portion of the dictionary in. 7340843Smsmith** The dictionary needs to be at least large enough to hold the 7440843Smsmith** precompiled part. Try 1K cells minimum. Use "words" to find 7540843Smsmith** out how much of the dictionary is used at any time. 7640843Smsmith**************************************************************************/ 7740843Smsmithvoid ficlInitSystem(int nDictCells) 7840843Smsmith{ 7940843Smsmith if (dp) 8040843Smsmith dictDelete(dp); 8140843Smsmith 8240843Smsmith if (envp) 8340843Smsmith dictDelete(envp); 8440843Smsmith 8540843Smsmith#if FICL_WANT_LOCALS 8640843Smsmith if (localp) 8740843Smsmith dictDelete(localp); 8840843Smsmith#endif 8940843Smsmith 9040843Smsmith if (nDictCells <= 0) 9140843Smsmith nDictCells = defaultDict; 9240843Smsmith 9340843Smsmith dp = dictCreateHashed((unsigned)nDictCells, HASHSIZE); 9440843Smsmith envp = dictCreate( (unsigned)FICL_DEFAULT_ENV); 9540843Smsmith#if FICL_WANT_LOCALS 9640843Smsmith /* 9740843Smsmith ** The locals dictionary is only searched while compiling, 9840843Smsmith ** but this is where speed is most important. On the other 9940843Smsmith ** hand, the dictionary gets emptied after each use of locals 10040843Smsmith ** The need to balance search speed with the cost of the empty 10140843Smsmith ** operation led me to select a single-threaded list... 10240843Smsmith */ 10340843Smsmith localp = dictCreate( (unsigned)FICL_MAX_LOCALS * CELLS_PER_WORD); 10440843Smsmith#endif 10540843Smsmith 10640843Smsmith ficlCompileCore(dp); 10740843Smsmith 10840843Smsmith return; 10940843Smsmith} 11040843Smsmith 11140843Smsmith 11240843Smsmith/************************************************************************** 11340843Smsmith f i c l N e w V M 11440843Smsmith** Create a new virtual machine and link it into the system list 11540843Smsmith** of VMs for later cleanup by ficlTermSystem. If this is the first 11640843Smsmith** VM to be created, use it to compile the words in softcore.c 11740843Smsmith**************************************************************************/ 11840843SmsmithFICL_VM *ficlNewVM(void) 11940843Smsmith{ 12040843Smsmith FICL_VM *pVM = vmCreate(NULL, defaultStack, defaultStack); 12140843Smsmith pVM->link = vmList; 12240843Smsmith 12340843Smsmith /* 12440843Smsmith ** Borrow the first vm to build the soft words in softcore.c 12540843Smsmith */ 12640843Smsmith if (vmList == NULL) 12740843Smsmith ficlCompileSoftCore(pVM); 12840843Smsmith 12940843Smsmith vmList = pVM; 13040843Smsmith return pVM; 13140843Smsmith} 13240843Smsmith 13340843Smsmith 13440843Smsmith/************************************************************************** 13540843Smsmith f i c l B u i l d 13640843Smsmith** Builds a word into the dictionary. 13740843Smsmith** Preconditions: system must be initialized, and there must 13840843Smsmith** be enough space for the new word's header! Operation is 13940843Smsmith** controlled by ficlLockDictionary, so any initialization 14040843Smsmith** required by your version of the function (if you overrode 14140843Smsmith** it) must be complete at this point. 14240843Smsmith** Parameters: 14340843Smsmith** name -- duh, the name of the word 14440843Smsmith** code -- code to execute when the word is invoked - must take a single param 14540843Smsmith** pointer to a FICL_VM 14640843Smsmith** flags -- 0 or more of F_IMMEDIATE, F_COMPILE, use bitwise OR! 14740843Smsmith** 14840843Smsmith**************************************************************************/ 14940843Smsmithint ficlBuild(char *name, FICL_CODE code, char flags) 15040843Smsmith{ 15140843Smsmith int err = ficlLockDictionary(TRUE); 15240843Smsmith if (err) return err; 15340843Smsmith 15440843Smsmith dictAppendWord(dp, name, code, flags); 15540843Smsmith 15640843Smsmith ficlLockDictionary(FALSE); 15740843Smsmith return 0; 15840843Smsmith} 15940843Smsmith 16040843Smsmith 16140843Smsmith/************************************************************************** 16240843Smsmith f i c l E x e c 16340843Smsmith** Evaluates a block of input text in the context of the 16440843Smsmith** specified interpreter. Emits any requested output to the 16540843Smsmith** interpreter's output function. 16640843Smsmith** 16740843Smsmith** Contains the "inner interpreter" code in a tight loop 16840843Smsmith** 16940843Smsmith** Returns one of the VM_XXXX codes defined in ficl.h: 17040843Smsmith** VM_OUTOFTEXT is the normal exit condition 17140843Smsmith** VM_ERREXIT means that the interp encountered a syntax error 17240843Smsmith** and the vm has been reset to recover (some or all 17340843Smsmith** of the text block got ignored 17440843Smsmith** VM_USEREXIT means that the user executed the "bye" command 17540843Smsmith** to shut down the interpreter. This would be a good 17640843Smsmith** time to delete the vm, etc -- or you can ignore this 17740843Smsmith** signal. 17840843Smsmith**************************************************************************/ 17951786Sdcsint ficlExec(FICL_VM *pVM, char *pText) 18040843Smsmith{ 18151786Sdcs return ficlExecC(pVM, pText, -1); 18251786Sdcs} 18351786Sdcs 18451786Sdcsint ficlExecC(FICL_VM *pVM, char *pText, FICL_INT size) 18551786Sdcs{ 18651786Sdcs static FICL_WORD *pInterp = NULL; 18751786Sdcs 18840843Smsmith int except; 18940843Smsmith jmp_buf vmState; 19040843Smsmith TIB saveTib; 19143613Sdcs FICL_VM VM; 19243613Sdcs FICL_STACK rStack; 19340843Smsmith 19451786Sdcs if (!pInterp) 19551786Sdcs pInterp = ficlLookup("interpret"); 19651786Sdcs 19751786Sdcs assert(pInterp); 19840843Smsmith assert(pVM); 19940843Smsmith 20051786Sdcs if (size < 0) 20151786Sdcs size = strlen(pText); 20251786Sdcs 20343078Smsmith vmPushTib(pVM, pText, size, &saveTib); 20440843Smsmith 20540843Smsmith /* 20643613Sdcs ** Save and restore pVM and pVM->rStack to enable nested calls to ficlExec 20740843Smsmith */ 20843613Sdcs memcpy((void*)&VM, (void*)pVM, sizeof(FICL_VM)); 20943613Sdcs memcpy((void*)&rStack, (void*)pVM->rStack, sizeof(FICL_STACK)); 21043613Sdcs 21140843Smsmith pVM->pState = &vmState; /* This has to come before the setjmp! */ 21240843Smsmith except = setjmp(vmState); 21340843Smsmith 21440843Smsmith switch (except) 21540843Smsmith { 21640843Smsmith case 0: 21740843Smsmith if (pVM->fRestart) 21840843Smsmith { 21940843Smsmith pVM->fRestart = 0; 22040843Smsmith pVM->runningWord->code(pVM); 22140843Smsmith } 22251786Sdcs else 22351786Sdcs { /* set VM up to interpret text */ 22451786Sdcs vmPushIP(pVM, &pInterp); 22540843Smsmith } 22640843Smsmith 22751786Sdcs vmInnerLoop(pVM); 22840843Smsmith break; 22940843Smsmith 23040843Smsmith case VM_RESTART: 23140843Smsmith pVM->fRestart = 1; 23240843Smsmith except = VM_OUTOFTEXT; 23340843Smsmith break; 23440843Smsmith 23540843Smsmith case VM_OUTOFTEXT: 23651786Sdcs vmPopIP(pVM); 23740977Sjkh#ifdef TESTMAIN 23840843Smsmith if ((pVM->state != COMPILE) && (pVM->sourceID.i == 0)) 23940843Smsmith ficlTextOut(pVM, FICL_PROMPT, 0); 24040977Sjkh#endif 24140843Smsmith break; 24240843Smsmith 24340843Smsmith case VM_USEREXIT: 24451786Sdcs case VM_INNEREXIT: 24540843Smsmith break; 24640843Smsmith 24740843Smsmith case VM_QUIT: 24840843Smsmith if (pVM->state == COMPILE) 24951786Sdcs { 25040843Smsmith dictAbortDefinition(dp); 25151786Sdcs#if FICL_WANT_LOCALS 25251786Sdcs dictEmpty(localp, localp->pForthWords->size); 25351786Sdcs#endif 25451786Sdcs } 25551786Sdcs vmQuit(pVM); 25640843Smsmith break; 25740843Smsmith 25840843Smsmith case VM_ERREXIT: 25943078Smsmith case VM_ABORT: 26043078Smsmith case VM_ABORTQ: 26140843Smsmith default: /* user defined exit code?? */ 26240843Smsmith if (pVM->state == COMPILE) 26340843Smsmith { 26440843Smsmith dictAbortDefinition(dp); 26540843Smsmith#if FICL_WANT_LOCALS 26640843Smsmith dictEmpty(localp, localp->pForthWords->size); 26740843Smsmith#endif 26840843Smsmith } 26940843Smsmith dictResetSearchOrder(dp); 27043613Sdcs memcpy((void*)pVM, (void*)&VM, sizeof(FICL_VM)); 27143613Sdcs memcpy((void*)pVM->rStack, (void*)&rStack, sizeof(FICL_STACK)); 27243613Sdcs stackReset(pVM->pStack); 27343613Sdcs pVM->base = 10; 27440843Smsmith break; 27540843Smsmith } 27640843Smsmith 27743613Sdcs pVM->pState = VM.pState; 27840843Smsmith vmPopTib(pVM, &saveTib); 27940843Smsmith return (except); 28040843Smsmith} 28140843Smsmith 28240989Sjkh/************************************************************************** 28340989Sjkh f i c l E x e c F D 28440989Sjkh** reads in text from file fd and passes it to ficlExec() 28540989Sjkh * returns VM_OUTOFTEXT on success or the ficlExec() error code on 28640989Sjkh * failure. 28740989Sjkh */ 28840989Sjkh#define nLINEBUF 256 28940989Sjkhint ficlExecFD(FICL_VM *pVM, int fd) 29040989Sjkh{ 29140989Sjkh char cp[nLINEBUF]; 29240989Sjkh int i, nLine = 0, rval = VM_OUTOFTEXT; 29340989Sjkh char ch; 29440989Sjkh CELL id; 29540843Smsmith 29640989Sjkh id = pVM->sourceID; 29740989Sjkh pVM->sourceID.i = fd; 29840989Sjkh 29940989Sjkh /* feed each line to ficlExec */ 30040989Sjkh while (1) { 30140989Sjkh int status, i; 30240989Sjkh 30340989Sjkh i = 0; 30440989Sjkh while ((status = read(fd, &ch, 1)) > 0 && ch != '\n') 30540989Sjkh cp[i++] = ch; 30640989Sjkh nLine++; 30740989Sjkh if (!i) { 30840989Sjkh if (status < 1) 30940989Sjkh break; 31040989Sjkh continue; 31140989Sjkh } 31251786Sdcs rval = ficlExecC(pVM, cp, i); 31343602Sdcs if(rval != VM_QUIT && rval != VM_USEREXIT && rval != VM_OUTOFTEXT) 31440989Sjkh { 31540989Sjkh pVM->sourceID = id; 31643602Sdcs return rval; 31740989Sjkh } 31840989Sjkh } 31940989Sjkh /* 32040989Sjkh ** Pass an empty line with SOURCE-ID == 0 to flush 32140989Sjkh ** any pending REFILLs (as required by FILE wordset) 32240989Sjkh */ 32340989Sjkh pVM->sourceID.i = -1; 32451786Sdcs ficlExec(pVM, ""); 32540989Sjkh 32640989Sjkh pVM->sourceID = id; 32740989Sjkh return rval; 32840989Sjkh} 32940989Sjkh 33040843Smsmith/************************************************************************** 33151786Sdcs f i c l E x e c X T 33251786Sdcs** Given a pointer to a FICL_WORD, push an inner interpreter and 33351786Sdcs** execute the word to completion. This is in contrast with vmExecute, 33451786Sdcs** which does not guarantee that the word will have completed when 33551786Sdcs** the function returns (ie in the case of colon definitions, which 33651786Sdcs** need an inner interpreter to finish) 33751786Sdcs** 33851786Sdcs** Returns one of the VM_XXXX exception codes listed in ficl.h. Normal 33951786Sdcs** exit condition is VM_INNEREXIT, ficl's private signal to exit the 34051786Sdcs** inner loop under normal circumstances. If another code is thrown to 34151786Sdcs** exit the loop, this function will re-throw it if it's nested under 34251786Sdcs** itself or ficlExec. 34351786Sdcs** 34451786Sdcs** NOTE: this function is intended so that C code can execute ficlWords 34551786Sdcs** given their address in the dictionary (xt). 34651786Sdcs**************************************************************************/ 34751786Sdcsint ficlExecXT(FICL_VM *pVM, FICL_WORD *pWord) 34851786Sdcs{ 34951786Sdcs static FICL_WORD *pQuit = NULL; 35051786Sdcs int except; 35151786Sdcs jmp_buf vmState; 35251786Sdcs jmp_buf *oldState; 35351786Sdcs 35451786Sdcs if (!pQuit) 35551786Sdcs pQuit = ficlLookup("exit-inner"); 35651786Sdcs 35751786Sdcs assert(pVM); 35851786Sdcs assert(pQuit); 35951786Sdcs 36051786Sdcs /* 36151786Sdcs ** Save and restore VM's jmp_buf to enable nested calls 36251786Sdcs */ 36351786Sdcs oldState = pVM->pState; 36451786Sdcs pVM->pState = &vmState; /* This has to come before the setjmp! */ 36551786Sdcs except = setjmp(vmState); 36651786Sdcs 36751786Sdcs if (except) 36851786Sdcs vmPopIP(pVM); 36951786Sdcs else 37051786Sdcs vmPushIP(pVM, &pQuit); 37151786Sdcs 37251786Sdcs switch (except) 37351786Sdcs { 37451786Sdcs case 0: 37551786Sdcs vmExecute(pVM, pWord); 37651786Sdcs vmInnerLoop(pVM); 37751786Sdcs break; 37851786Sdcs 37951786Sdcs case VM_INNEREXIT: 38051786Sdcs break; 38151786Sdcs 38251786Sdcs case VM_RESTART: 38351786Sdcs case VM_OUTOFTEXT: 38451786Sdcs case VM_USEREXIT: 38551786Sdcs case VM_QUIT: 38651786Sdcs case VM_ERREXIT: 38751786Sdcs case VM_ABORT: 38851786Sdcs case VM_ABORTQ: 38951786Sdcs default: /* user defined exit code?? */ 39051786Sdcs if (oldState) 39151786Sdcs { 39251786Sdcs pVM->pState = oldState; 39351786Sdcs vmThrow(pVM, except); 39451786Sdcs } 39551786Sdcs break; 39651786Sdcs } 39751786Sdcs 39851786Sdcs pVM->pState = oldState; 39951786Sdcs return (except); 40051786Sdcs} 40151786Sdcs 40251786Sdcs 40351786Sdcs/************************************************************************** 40440843Smsmith f i c l L o o k u p 40540843Smsmith** Look in the system dictionary for a match to the given name. If 40640843Smsmith** found, return the address of the corresponding FICL_WORD. Otherwise 40740843Smsmith** return NULL. 40840843Smsmith**************************************************************************/ 40940843SmsmithFICL_WORD *ficlLookup(char *name) 41040843Smsmith{ 41140843Smsmith STRINGINFO si; 41240843Smsmith SI_PSZ(si, name); 41340843Smsmith return dictLookup(dp, si); 41440843Smsmith} 41540843Smsmith 41640843Smsmith 41740843Smsmith/************************************************************************** 41840843Smsmith f i c l G e t D i c t 41940843Smsmith** Returns the address of the system dictionary 42040843Smsmith**************************************************************************/ 42140843SmsmithFICL_DICT *ficlGetDict(void) 42240843Smsmith{ 42340843Smsmith return dp; 42440843Smsmith} 42540843Smsmith 42640843Smsmith 42740843Smsmith/************************************************************************** 42840843Smsmith f i c l G e t E n v 42940843Smsmith** Returns the address of the system environment space 43040843Smsmith**************************************************************************/ 43140843SmsmithFICL_DICT *ficlGetEnv(void) 43240843Smsmith{ 43340843Smsmith return envp; 43440843Smsmith} 43540843Smsmith 43640843Smsmith 43740843Smsmith/************************************************************************** 43840843Smsmith f i c l S e t E n v 43940843Smsmith** Create an environment variable with a one-CELL payload. ficlSetEnvD 44040843Smsmith** makes one with a two-CELL payload. 44140843Smsmith**************************************************************************/ 44251786Sdcsvoid ficlSetEnv(char *name, FICL_UNS value) 44340843Smsmith{ 44440843Smsmith STRINGINFO si; 44540843Smsmith FICL_WORD *pFW; 44640843Smsmith 44740843Smsmith SI_PSZ(si, name); 44840843Smsmith pFW = dictLookup(envp, si); 44940843Smsmith 45040843Smsmith if (pFW == NULL) 45140843Smsmith { 45240843Smsmith dictAppendWord(envp, name, constantParen, FW_DEFAULT); 45340843Smsmith dictAppendCell(envp, LVALUEtoCELL(value)); 45440843Smsmith } 45540843Smsmith else 45640843Smsmith { 45740843Smsmith pFW->param[0] = LVALUEtoCELL(value); 45840843Smsmith } 45940843Smsmith 46040843Smsmith return; 46140843Smsmith} 46240843Smsmith 46351786Sdcsvoid ficlSetEnvD(char *name, FICL_UNS hi, FICL_UNS lo) 46440843Smsmith{ 46540843Smsmith FICL_WORD *pFW; 46640843Smsmith STRINGINFO si; 46740843Smsmith SI_PSZ(si, name); 46840843Smsmith pFW = dictLookup(envp, si); 46940843Smsmith 47040843Smsmith if (pFW == NULL) 47140843Smsmith { 47240843Smsmith dictAppendWord(envp, name, twoConstParen, FW_DEFAULT); 47340843Smsmith dictAppendCell(envp, LVALUEtoCELL(lo)); 47440843Smsmith dictAppendCell(envp, LVALUEtoCELL(hi)); 47540843Smsmith } 47640843Smsmith else 47740843Smsmith { 47840843Smsmith pFW->param[0] = LVALUEtoCELL(lo); 47940843Smsmith pFW->param[1] = LVALUEtoCELL(hi); 48040843Smsmith } 48140843Smsmith 48240843Smsmith return; 48340843Smsmith} 48440843Smsmith 48540843Smsmith 48640843Smsmith/************************************************************************** 48740843Smsmith f i c l G e t L o c 48840843Smsmith** Returns the address of the system locals dictionary. This dict is 48940843Smsmith** only used during compilation, and is shared by all VMs. 49040843Smsmith**************************************************************************/ 49140843Smsmith#if FICL_WANT_LOCALS 49240843SmsmithFICL_DICT *ficlGetLoc(void) 49340843Smsmith{ 49440843Smsmith return localp; 49540843Smsmith} 49640843Smsmith#endif 49740843Smsmith 49840843Smsmith 49951786Sdcs 50040843Smsmith/************************************************************************** 50151786Sdcs f i c l S e t S t a c k S i z e 50251786Sdcs** Set the stack sizes (return and parameter) to be used for all 50351786Sdcs** subsequently created VMs. Returns actual stack size to be used. 50451786Sdcs**************************************************************************/ 50551786Sdcsint ficlSetStackSize(int nStackCells) 50651786Sdcs{ 50751786Sdcs if (nStackCells >= FICL_DEFAULT_STACK) 50851786Sdcs defaultStack = nStackCells; 50951786Sdcs else 51051786Sdcs defaultStack = FICL_DEFAULT_STACK; 51151786Sdcs 51251786Sdcs return defaultStack; 51351786Sdcs} 51451786Sdcs 51551786Sdcs 51651786Sdcs/************************************************************************** 51740843Smsmith f i c l T e r m S y s t e m 51840843Smsmith** Tear the system down by deleting the dictionaries and all VMs. 51940843Smsmith** This saves you from having to keep track of all that stuff. 52040843Smsmith**************************************************************************/ 52140843Smsmithvoid ficlTermSystem(void) 52240843Smsmith{ 52340843Smsmith if (dp) 52440843Smsmith dictDelete(dp); 52540843Smsmith dp = NULL; 52640843Smsmith 52740843Smsmith if (envp) 52840843Smsmith dictDelete(envp); 52940843Smsmith envp = NULL; 53040843Smsmith 53140843Smsmith#if FICL_WANT_LOCALS 53240843Smsmith if (localp) 53340843Smsmith dictDelete(localp); 53440843Smsmith localp = NULL; 53540843Smsmith#endif 53640843Smsmith 53740843Smsmith while (vmList != NULL) 53840843Smsmith { 53940843Smsmith FICL_VM *pVM = vmList; 54040843Smsmith vmList = vmList->link; 54140843Smsmith vmDelete(pVM); 54240843Smsmith } 54340843Smsmith 54440843Smsmith return; 54540843Smsmith} 546