ficl.c revision 60959
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/* $FreeBSD: head/sys/boot/ficl/ficl.c 60959 2000-05-26 21:35:08Z dcs $ */ 25 26#ifdef TESTMAIN 27#include <stdlib.h> 28#else 29#include <stand.h> 30#endif 31#include <string.h> 32#include "ficl.h" 33 34#ifdef FICL_TRACE 35int ficl_trace = 0; 36#endif 37 38 39/* 40** Local prototypes 41*/ 42 43 44/* 45** System statics 46** The system builds a global dictionary during its start 47** sequence. This is shared by all interpreter instances. 48** Therefore only one instance can update the dictionary 49** at a time. The system imports a locking function that 50** you can override in order to control update access to 51** the dictionary. The function is stubbed out by default, 52** but you can insert one: #define FICL_MULTITHREAD 1 53** and supply your own version of ficlLockDictionary. 54*/ 55static FICL_DICT *dp = NULL; 56static FICL_DICT *envp = NULL; 57#if FICL_WANT_LOCALS 58static FICL_DICT *localp = NULL; 59#endif 60static FICL_VM *vmList = NULL; 61 62static int defaultStack = FICL_DEFAULT_STACK; 63static int defaultDict = FICL_DEFAULT_DICT; 64 65 66/************************************************************************** 67 f i c l I n i t S y s t e m 68** Binds a global dictionary to the interpreter system. 69** You specify the address and size of the allocated area. 70** After that, ficl manages it. 71** First step is to set up the static pointers to the area. 72** Then write the "precompiled" portion of the dictionary in. 73** The dictionary needs to be at least large enough to hold the 74** precompiled part. Try 1K cells minimum. Use "words" to find 75** out how much of the dictionary is used at any time. 76**************************************************************************/ 77void ficlInitSystem(int nDictCells) 78{ 79 if (dp) 80 dictDelete(dp); 81 82 if (envp) 83 dictDelete(envp); 84 85#if FICL_WANT_LOCALS 86 if (localp) 87 dictDelete(localp); 88#endif 89 90 if (nDictCells <= 0) 91 nDictCells = defaultDict; 92 93 dp = dictCreateHashed((unsigned)nDictCells, HASHSIZE); 94 envp = dictCreate( (unsigned)FICL_DEFAULT_ENV); 95#if FICL_WANT_LOCALS 96 /* 97 ** The locals dictionary is only searched while compiling, 98 ** but this is where speed is most important. On the other 99 ** hand, the dictionary gets emptied after each use of locals 100 ** The need to balance search speed with the cost of the empty 101 ** operation led me to select a single-threaded list... 102 */ 103 localp = dictCreate( (unsigned)FICL_MAX_LOCALS * CELLS_PER_WORD); 104#endif 105 106 ficlCompileCore(dp); 107 108 return; 109} 110 111 112/************************************************************************** 113 f i c l N e w V M 114** Create a new virtual machine and link it into the system list 115** of VMs for later cleanup by ficlTermSystem. If this is the first 116** VM to be created, use it to compile the words in softcore.c 117**************************************************************************/ 118FICL_VM *ficlNewVM(void) 119{ 120 FICL_VM *pVM = vmCreate(NULL, defaultStack, defaultStack); 121 pVM->link = vmList; 122 123 /* 124 ** Borrow the first vm to build the soft words in softcore.c 125 */ 126 if (vmList == NULL) 127 ficlCompileSoftCore(pVM); 128 129 vmList = pVM; 130 return pVM; 131} 132 133 134/************************************************************************** 135 f i c l F r e e V M 136** Removes the VM in question from the system VM list and deletes the 137** memory allocated to it. This is an optional call, since ficlTermSystem 138** will do this cleanup for you. This function is handy if you're going to 139** do a lot of dynamic creation of VMs. 140**************************************************************************/ 141void ficlFreeVM(FICL_VM *pVM) 142{ 143 FICL_VM *pList = vmList; 144 145 assert(pVM != 0); 146 147 if (vmList == pVM) 148 { 149 vmList = vmList->link; 150 } 151 else for (pList; pList != 0; pList = pList->link) 152 { 153 if (pList->link == pVM) 154 { 155 pList->link = pVM->link; 156 break; 157 } 158 } 159 160 if (pList) 161 vmDelete(pVM); 162 return; 163} 164 165 166/************************************************************************** 167 f i c l B u i l d 168** Builds a word into the dictionary. 169** Preconditions: system must be initialized, and there must 170** be enough space for the new word's header! Operation is 171** controlled by ficlLockDictionary, so any initialization 172** required by your version of the function (if you overrode 173** it) must be complete at this point. 174** Parameters: 175** name -- duh, the name of the word 176** code -- code to execute when the word is invoked - must take a single param 177** pointer to a FICL_VM 178** flags -- 0 or more of F_IMMEDIATE, F_COMPILE, use bitwise OR! 179** 180**************************************************************************/ 181int ficlBuild(char *name, FICL_CODE code, char flags) 182{ 183 int err = ficlLockDictionary(TRUE); 184 if (err) return err; 185 186 assert(dictCellsAvail(dp) > sizeof (FICL_WORD) / sizeof (CELL)); 187 dictAppendWord(dp, name, code, flags); 188 189 ficlLockDictionary(FALSE); 190 return 0; 191} 192 193 194/************************************************************************** 195 f i c l E x e c 196** Evaluates a block of input text in the context of the 197** specified interpreter. Emits any requested output to the 198** interpreter's output function. 199** 200** Contains the "inner interpreter" code in a tight loop 201** 202** Returns one of the VM_XXXX codes defined in ficl.h: 203** VM_OUTOFTEXT is the normal exit condition 204** VM_ERREXIT means that the interp encountered a syntax error 205** and the vm has been reset to recover (some or all 206** of the text block got ignored 207** VM_USEREXIT means that the user executed the "bye" command 208** to shut down the interpreter. This would be a good 209** time to delete the vm, etc -- or you can ignore this 210** signal. 211**************************************************************************/ 212int ficlExec(FICL_VM *pVM, char *pText) 213{ 214 return ficlExecC(pVM, pText, -1); 215} 216 217int ficlExecC(FICL_VM *pVM, char *pText, FICL_INT size) 218{ 219 static FICL_WORD *pInterp = NULL; 220 221 int except; 222 jmp_buf vmState; 223 jmp_buf *oldState; 224 TIB saveTib; 225 226 if (!pInterp) 227 pInterp = ficlLookup("interpret"); 228 229 assert(pInterp); 230 assert(pVM); 231 232 if (size < 0) 233 size = strlen(pText); 234 235 vmPushTib(pVM, pText, size, &saveTib); 236 237 /* 238 ** Save and restore VM's jmp_buf to enable nested calls to ficlExec 239 */ 240 oldState = pVM->pState; 241 pVM->pState = &vmState; /* This has to come before the setjmp! */ 242 except = setjmp(vmState); 243 244 switch (except) 245 { 246 case 0: 247 if (pVM->fRestart) 248 { 249 pVM->fRestart = 0; 250 pVM->runningWord->code(pVM); 251 } 252 else 253 { /* set VM up to interpret text */ 254 vmPushIP(pVM, &pInterp); 255 } 256 257 vmInnerLoop(pVM); 258 break; 259 260 case VM_RESTART: 261 pVM->fRestart = 1; 262 except = VM_OUTOFTEXT; 263 break; 264 265 case VM_OUTOFTEXT: 266 vmPopIP(pVM); 267#ifdef TESTMAIN 268 if ((pVM->state != COMPILE) && (pVM->sourceID.i == 0)) 269 ficlTextOut(pVM, FICL_PROMPT, 0); 270#endif 271 break; 272 273 case VM_USEREXIT: 274 case VM_INNEREXIT: 275 break; 276 277 case VM_QUIT: 278 if (pVM->state == COMPILE) 279 { 280 dictAbortDefinition(dp); 281#if FICL_WANT_LOCALS 282 dictEmpty(localp, localp->pForthWords->size); 283#endif 284 } 285 vmQuit(pVM); 286 break; 287 288 case VM_ERREXIT: 289 case VM_ABORT: 290 case VM_ABORTQ: 291 default: /* user defined exit code?? */ 292 if (pVM->state == COMPILE) 293 { 294 dictAbortDefinition(dp); 295#if FICL_WANT_LOCALS 296 dictEmpty(localp, localp->pForthWords->size); 297#endif 298 } 299 dictResetSearchOrder(dp); 300 vmReset(pVM); 301 break; 302 } 303 304 pVM->pState = oldState; 305 vmPopTib(pVM, &saveTib); 306 return (except); 307} 308 309/************************************************************************** 310 f i c l E x e c F D 311** reads in text from file fd and passes it to ficlExec() 312 * returns VM_OUTOFTEXT on success or the ficlExec() error code on 313 * failure. 314 */ 315#define nLINEBUF 256 316int ficlExecFD(FICL_VM *pVM, int fd) 317{ 318 char cp[nLINEBUF]; 319 int i, nLine = 0, rval = VM_OUTOFTEXT; 320 char ch; 321 CELL id; 322 323 id = pVM->sourceID; 324 pVM->sourceID.i = fd; 325 326 /* feed each line to ficlExec */ 327 while (1) { 328 int status, i; 329 330 i = 0; 331 while ((status = read(fd, &ch, 1)) > 0 && ch != '\n') 332 cp[i++] = ch; 333 nLine++; 334 if (!i) { 335 if (status < 1) 336 break; 337 continue; 338 } 339 rval = ficlExecC(pVM, cp, i); 340 if(rval != VM_QUIT && rval != VM_USEREXIT && rval != VM_OUTOFTEXT) 341 { 342 pVM->sourceID = id; 343 return rval; 344 } 345 } 346 /* 347 ** Pass an empty line with SOURCE-ID == 0 to flush 348 ** any pending REFILLs (as required by FILE wordset) 349 */ 350 pVM->sourceID.i = -1; 351 ficlExec(pVM, ""); 352 353 pVM->sourceID = id; 354 return rval; 355} 356 357/************************************************************************** 358 f i c l E x e c X T 359** Given a pointer to a FICL_WORD, push an inner interpreter and 360** execute the word to completion. This is in contrast with vmExecute, 361** which does not guarantee that the word will have completed when 362** the function returns (ie in the case of colon definitions, which 363** need an inner interpreter to finish) 364** 365** Returns one of the VM_XXXX exception codes listed in ficl.h. Normal 366** exit condition is VM_INNEREXIT, ficl's private signal to exit the 367** inner loop under normal circumstances. If another code is thrown to 368** exit the loop, this function will re-throw it if it's nested under 369** itself or ficlExec. 370** 371** NOTE: this function is intended so that C code can execute ficlWords 372** given their address in the dictionary (xt). 373**************************************************************************/ 374int ficlExecXT(FICL_VM *pVM, FICL_WORD *pWord) 375{ 376 static FICL_WORD *pQuit = NULL; 377 int except; 378 jmp_buf vmState; 379 jmp_buf *oldState; 380 381 if (!pQuit) 382 pQuit = ficlLookup("exit-inner"); 383 384 assert(pVM); 385 assert(pQuit); 386 387 /* 388 ** Save and restore VM's jmp_buf to enable nested calls 389 */ 390 oldState = pVM->pState; 391 pVM->pState = &vmState; /* This has to come before the setjmp! */ 392 except = setjmp(vmState); 393 394 if (except) 395 vmPopIP(pVM); 396 else 397 vmPushIP(pVM, &pQuit); 398 399 switch (except) 400 { 401 case 0: 402 vmExecute(pVM, pWord); 403 vmInnerLoop(pVM); 404 break; 405 406 case VM_INNEREXIT: 407 break; 408 409 case VM_RESTART: 410 case VM_OUTOFTEXT: 411 case VM_USEREXIT: 412 case VM_QUIT: 413 case VM_ERREXIT: 414 case VM_ABORT: 415 case VM_ABORTQ: 416 default: /* user defined exit code?? */ 417 if (oldState) 418 { 419 pVM->pState = oldState; 420 vmThrow(pVM, except); 421 } 422 break; 423 } 424 425 pVM->pState = oldState; 426 return (except); 427} 428 429 430/************************************************************************** 431 f i c l L o o k u p 432** Look in the system dictionary for a match to the given name. If 433** found, return the address of the corresponding FICL_WORD. Otherwise 434** return NULL. 435**************************************************************************/ 436FICL_WORD *ficlLookup(char *name) 437{ 438 STRINGINFO si; 439 SI_PSZ(si, name); 440 return dictLookup(dp, si); 441} 442 443 444/************************************************************************** 445 f i c l G e t D i c t 446** Returns the address of the system dictionary 447**************************************************************************/ 448FICL_DICT *ficlGetDict(void) 449{ 450 return dp; 451} 452 453 454/************************************************************************** 455 f i c l G e t E n v 456** Returns the address of the system environment space 457**************************************************************************/ 458FICL_DICT *ficlGetEnv(void) 459{ 460 return envp; 461} 462 463 464/************************************************************************** 465 f i c l S e t E n v 466** Create an environment variable with a one-CELL payload. ficlSetEnvD 467** makes one with a two-CELL payload. 468**************************************************************************/ 469void ficlSetEnv(char *name, FICL_UNS value) 470{ 471 STRINGINFO si; 472 FICL_WORD *pFW; 473 474 SI_PSZ(si, name); 475 pFW = dictLookup(envp, si); 476 477 if (pFW == NULL) 478 { 479 dictAppendWord(envp, name, constantParen, FW_DEFAULT); 480 dictAppendCell(envp, LVALUEtoCELL(value)); 481 } 482 else 483 { 484 pFW->param[0] = LVALUEtoCELL(value); 485 } 486 487 return; 488} 489 490void ficlSetEnvD(char *name, FICL_UNS hi, FICL_UNS lo) 491{ 492 FICL_WORD *pFW; 493 STRINGINFO si; 494 SI_PSZ(si, name); 495 pFW = dictLookup(envp, si); 496 497 if (pFW == NULL) 498 { 499 dictAppendWord(envp, name, twoConstParen, FW_DEFAULT); 500 dictAppendCell(envp, LVALUEtoCELL(lo)); 501 dictAppendCell(envp, LVALUEtoCELL(hi)); 502 } 503 else 504 { 505 pFW->param[0] = LVALUEtoCELL(lo); 506 pFW->param[1] = LVALUEtoCELL(hi); 507 } 508 509 return; 510} 511 512 513/************************************************************************** 514 f i c l G e t L o c 515** Returns the address of the system locals dictionary. This dict is 516** only used during compilation, and is shared by all VMs. 517**************************************************************************/ 518#if FICL_WANT_LOCALS 519FICL_DICT *ficlGetLoc(void) 520{ 521 return localp; 522} 523#endif 524 525 526 527/************************************************************************** 528 f i c l S e t S t a c k S i z e 529** Set the stack sizes (return and parameter) to be used for all 530** subsequently created VMs. Returns actual stack size to be used. 531**************************************************************************/ 532int ficlSetStackSize(int nStackCells) 533{ 534 if (nStackCells >= FICL_DEFAULT_STACK) 535 defaultStack = nStackCells; 536 else 537 defaultStack = FICL_DEFAULT_STACK; 538 539 return defaultStack; 540} 541 542 543/************************************************************************** 544 f i c l T e r m S y s t e m 545** Tear the system down by deleting the dictionaries and all VMs. 546** This saves you from having to keep track of all that stuff. 547**************************************************************************/ 548void ficlTermSystem(void) 549{ 550 if (dp) 551 dictDelete(dp); 552 dp = NULL; 553 554 if (envp) 555 dictDelete(envp); 556 envp = NULL; 557 558#if FICL_WANT_LOCALS 559 if (localp) 560 dictDelete(localp); 561 localp = NULL; 562#endif 563 564 while (vmList != NULL) 565 { 566 FICL_VM *pVM = vmList; 567 vmList = vmList->link; 568 vmDelete(pVM); 569 } 570 571 return; 572} 573 574 575