sys/boot/ficl/ficl.c

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