ficl.c revision 40927
1/******************************************************************* 2** f i c l . c 3** Forth Inspired Command Language - external interface 4** Author: John Sadler (john_sadler@alum.mit.edu) 5** Created: 19 July 1997 6** 7*******************************************************************/ 8/* 9** This is an ANS Forth interpreter written in C. 10** Ficl uses Forth syntax for its commands, but turns the Forth 11** model on its head in other respects. 12** Ficl provides facilities for interoperating 13** with programs written in C: C functions can be exported to Ficl, 14** and Ficl commands can be executed via a C calling interface. The 15** interpreter is re-entrant, so it can be used in multiple instances 16** in a multitasking system. Unlike Forth, Ficl's outer interpreter 17** expects a text block as input, and returns to the caller after each 18** text block, so the data pump is somewhere in external code. This 19** is more like TCL than Forth. 20** 21** Code is written in ANSI C for portability. 22*/ 23 24#ifdef TESTMAIN 25#include <stdlib.h> 26#else 27#include <stand.h> 28#endif 29#include <string.h> 30#include "ficl.h" 31 32 33/* 34** Local prototypes 35*/ 36 37 38/* 39** System statics 40** The system builds a global dictionary during its start 41** sequence. This is shared by all interpreter instances. 42** Therefore only one instance can update the dictionary 43** at a time. The system imports a locking function that 44** you can override in order to control update access to 45** the dictionary. The function is stubbed out by default, 46** but you can insert one: #define FICL_MULTITHREAD 1 47** and supply your own version of ficlLockDictionary. 48*/ 49static FICL_DICT *dp = NULL; 50static FICL_DICT *envp = NULL; 51#if FICL_WANT_LOCALS 52static FICL_DICT *localp = NULL; 53#endif 54static FICL_VM *vmList = NULL; 55 56static int defaultStack = FICL_DEFAULT_STACK; 57static int defaultDict = FICL_DEFAULT_DICT; 58 59 60/************************************************************************** 61 f i c l I n i t S y s t e m 62** Binds a global dictionary to the interpreter system. 63** You specify the address and size of the allocated area. 64** After that, ficl manages it. 65** First step is to set up the static pointers to the area. 66** Then write the "precompiled" portion of the dictionary in. 67** The dictionary needs to be at least large enough to hold the 68** precompiled part. Try 1K cells minimum. Use "words" to find 69** out how much of the dictionary is used at any time. 70**************************************************************************/ 71void ficlInitSystem(int nDictCells) 72{ 73 if (dp) 74 dictDelete(dp); 75 76 if (envp) 77 dictDelete(envp); 78 79#if FICL_WANT_LOCALS 80 if (localp) 81 dictDelete(localp); 82#endif 83 84 if (nDictCells <= 0) 85 nDictCells = defaultDict; 86 87 dp = dictCreateHashed((unsigned)nDictCells, HASHSIZE); 88 envp = dictCreate( (unsigned)FICL_DEFAULT_ENV); 89#if FICL_WANT_LOCALS 90 /* 91 ** The locals dictionary is only searched while compiling, 92 ** but this is where speed is most important. On the other 93 ** hand, the dictionary gets emptied after each use of locals 94 ** The need to balance search speed with the cost of the empty 95 ** operation led me to select a single-threaded list... 96 */ 97 localp = dictCreate( (unsigned)FICL_MAX_LOCALS * CELLS_PER_WORD); 98#endif 99 100 ficlCompileCore(dp); 101 102 return; 103} 104 105 106/************************************************************************** 107 f i c l N e w V M 108** Create a new virtual machine and link it into the system list 109** of VMs for later cleanup by ficlTermSystem. If this is the first 110** VM to be created, use it to compile the words in softcore.c 111**************************************************************************/ 112FICL_VM *ficlNewVM(void) 113{ 114 FICL_VM *pVM = vmCreate(NULL, defaultStack, defaultStack); 115 pVM->link = vmList; 116 117 /* 118 ** Borrow the first vm to build the soft words in softcore.c 119 */ 120 if (vmList == NULL) 121 ficlCompileSoftCore(pVM); 122 123 vmList = pVM; 124 return pVM; 125} 126 127 128/************************************************************************** 129 f i c l B u i l d 130** Builds a word into the dictionary. 131** Preconditions: system must be initialized, and there must 132** be enough space for the new word's header! Operation is 133** controlled by ficlLockDictionary, so any initialization 134** required by your version of the function (if you overrode 135** it) must be complete at this point. 136** Parameters: 137** name -- duh, the name of the word 138** code -- code to execute when the word is invoked - must take a single param 139** pointer to a FICL_VM 140** flags -- 0 or more of F_IMMEDIATE, F_COMPILE, use bitwise OR! 141** 142**************************************************************************/ 143int ficlBuild(char *name, FICL_CODE code, char flags) 144{ 145 int err = ficlLockDictionary(TRUE); 146 if (err) return err; 147 148 dictAppendWord(dp, name, code, flags); 149 150 ficlLockDictionary(FALSE); 151 return 0; 152} 153 154 155/************************************************************************** 156 f i c l E x e c 157** Evaluates a block of input text in the context of the 158** specified interpreter. Emits any requested output to the 159** interpreter's output function. 160** 161** Contains the "inner interpreter" code in a tight loop 162** 163** Returns one of the VM_XXXX codes defined in ficl.h: 164** VM_OUTOFTEXT is the normal exit condition 165** VM_ERREXIT means that the interp encountered a syntax error 166** and the vm has been reset to recover (some or all 167** of the text block got ignored 168** VM_USEREXIT means that the user executed the "bye" command 169** to shut down the interpreter. This would be a good 170** time to delete the vm, etc -- or you can ignore this 171** signal. 172**************************************************************************/ 173int ficlExec(FICL_VM *pVM, char *pText) 174{ 175 int except; 176 FICL_WORD *tempFW; 177 jmp_buf vmState; 178 jmp_buf *oldState; 179 TIB saveTib; 180 181 assert(pVM); 182 183 vmPushTib(pVM, pText, &saveTib); 184 185 /* 186 ** Save and restore VM's jmp_buf to enable nested calls to ficlExec 187 */ 188 oldState = pVM->pState; 189 pVM->pState = &vmState; /* This has to come before the setjmp! */ 190 except = setjmp(vmState); 191 192 switch (except) 193 { 194 case 0: 195 if (pVM->fRestart) 196 { 197 pVM->fRestart = 0; 198 pVM->runningWord->code(pVM); 199 } 200 201 /* 202 ** the mysterious inner interpreter... 203 ** vmThrow gets you out of this loop with a longjmp() 204 */ 205 for (;;) 206 { 207 tempFW = *pVM->ip++; 208 /* 209 ** inline code for 210 ** vmExecute(pVM, tempFW); 211 */ 212 pVM->runningWord = tempFW; 213 tempFW->code(pVM); 214 } 215 216 break; 217 218 case VM_RESTART: 219 pVM->fRestart = 1; 220 except = VM_OUTOFTEXT; 221 break; 222 223#ifdef TESTMAIN 224 case VM_OUTOFTEXT: 225 if ((pVM->state != COMPILE) && (pVM->sourceID.i == 0)) 226 ficlTextOut(pVM, FICL_PROMPT, 0); 227 break; 228#endif 229 230 case VM_USEREXIT: 231 break; 232 233 case VM_QUIT: 234 if (pVM->state == COMPILE) 235 dictAbortDefinition(dp); 236 vmQuit(pVM); 237 break; 238 239 case VM_ERREXIT: 240 default: /* user defined exit code?? */ 241 if (pVM->state == COMPILE) 242 { 243 dictAbortDefinition(dp); 244#if FICL_WANT_LOCALS 245 dictEmpty(localp, localp->pForthWords->size); 246#endif 247 } 248 dictResetSearchOrder(dp); 249 vmReset(pVM); 250 break; 251 } 252 253 pVM->pState = oldState; 254 vmPopTib(pVM, &saveTib); 255 return (except); 256} 257 258 259/************************************************************************** 260 f i c l L o o k u p 261** Look in the system dictionary for a match to the given name. If 262** found, return the address of the corresponding FICL_WORD. Otherwise 263** return NULL. 264**************************************************************************/ 265FICL_WORD *ficlLookup(char *name) 266{ 267 STRINGINFO si; 268 SI_PSZ(si, name); 269 return dictLookup(dp, si); 270} 271 272 273/************************************************************************** 274 f i c l G e t D i c t 275** Returns the address of the system dictionary 276**************************************************************************/ 277FICL_DICT *ficlGetDict(void) 278{ 279 return dp; 280} 281 282 283/************************************************************************** 284 f i c l G e t E n v 285** Returns the address of the system environment space 286**************************************************************************/ 287FICL_DICT *ficlGetEnv(void) 288{ 289 return envp; 290} 291 292 293/************************************************************************** 294 f i c l S e t E n v 295** Create an environment variable with a one-CELL payload. ficlSetEnvD 296** makes one with a two-CELL payload. 297**************************************************************************/ 298void ficlSetEnv(char *name, UNS32 value) 299{ 300 STRINGINFO si; 301 FICL_WORD *pFW; 302 303 SI_PSZ(si, name); 304 pFW = dictLookup(envp, si); 305 306 if (pFW == NULL) 307 { 308 dictAppendWord(envp, name, constantParen, FW_DEFAULT); 309 dictAppendCell(envp, LVALUEtoCELL(value)); 310 } 311 else 312 { 313 pFW->param[0] = LVALUEtoCELL(value); 314 } 315 316 return; 317} 318 319void ficlSetEnvD(char *name, UNS32 hi, UNS32 lo) 320{ 321 FICL_WORD *pFW; 322 STRINGINFO si; 323 SI_PSZ(si, name); 324 pFW = dictLookup(envp, si); 325 326 if (pFW == NULL) 327 { 328 dictAppendWord(envp, name, twoConstParen, FW_DEFAULT); 329 dictAppendCell(envp, LVALUEtoCELL(lo)); 330 dictAppendCell(envp, LVALUEtoCELL(hi)); 331 } 332 else 333 { 334 pFW->param[0] = LVALUEtoCELL(lo); 335 pFW->param[1] = LVALUEtoCELL(hi); 336 } 337 338 return; 339} 340 341 342/************************************************************************** 343 f i c l G e t L o c 344** Returns the address of the system locals dictionary. This dict is 345** only used during compilation, and is shared by all VMs. 346**************************************************************************/ 347#if FICL_WANT_LOCALS 348FICL_DICT *ficlGetLoc(void) 349{ 350 return localp; 351} 352#endif 353 354 355/************************************************************************** 356 f i c l T e r m S y s t e m 357** Tear the system down by deleting the dictionaries and all VMs. 358** This saves you from having to keep track of all that stuff. 359**************************************************************************/ 360void ficlTermSystem(void) 361{ 362 if (dp) 363 dictDelete(dp); 364 dp = NULL; 365 366 if (envp) 367 dictDelete(envp); 368 envp = NULL; 369 370#if FICL_WANT_LOCALS 371 if (localp) 372 dictDelete(localp); 373 localp = NULL; 374#endif 375 376 while (vmList != NULL) 377 { 378 FICL_VM *pVM = vmList; 379 vmList = vmList->link; 380 vmDelete(pVM); 381 } 382 383 return; 384} 385 386 387