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 ** $Id: ficl.c,v 1.16 2001/12/05 07:21:34 jsadler Exp $
   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 in the
  19 ** style of TCL.
  20 **
  21 ** Code is written in ANSI C for portability.
  22 */
  23 /*
  24 ** Copyright (c) 1997-2001 John Sadler (john_sadler@alum.mit.edu)
  25 ** All rights reserved.
  26 **
  27 ** Get the latest Ficl release at http://ficl.sourceforge.net
  28 **
  29 ** I am interested in hearing from anyone who uses ficl. If you have
  30 ** a problem, a success story, a defect, an enhancement request, or
  31 ** if you would like to contribute to the ficl release, please
  32 ** contact me by email at the address above.
  33 **
  34 ** L I C E N S E  and  D I S C L A I M E R
  35 **
  36 ** Redistribution and use in source and binary forms, with or without
  37 ** modification, are permitted provided that the following conditions
  38 ** are met:
  39 ** 1. Redistributions of source code must retain the above copyright
  40 **    notice, this list of conditions and the following disclaimer.
  41 ** 2. Redistributions in binary form must reproduce the above copyright
  42 **    notice, this list of conditions and the following disclaimer in the
  43 **    documentation and/or other materials provided with the distribution.
  44 **
  45 ** THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
  46 ** ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
  47 ** IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
  48 ** ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
  49 ** FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
  50 ** DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
  51 ** OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
  52 ** HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
  53 ** LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
  54 ** OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
  55 ** SUCH DAMAGE.
  56 */
  57
  58 /*
  59  * $FreeBSD: src/sys/boot/ficl/ficl.c,v 1.18 2002/04/09 17:45:11 dcs Exp $
  60  * $DragonFly: src/sys/boot/ficl/ficl.c,v 1.3 2003/11/10 06:08:33 dillon Exp $
  61  */
  62
  63 #ifdef TESTMAIN
  64 #include <stdlib.h>
  65 #else
  66 #include <stand.h>
  67 #endif
  68 #include <string.h>
  69 #include "ficl.h"
  70
  71
  72 /*
  73 ** System statics
  74 ** Each FICL_SYSTEM builds a global dictionary during its start
  75 ** sequence. This is shared by all virtual machines of that system.
  76 ** Therefore only one VM can update the dictionary
  77 ** at a time. The system imports a locking function that
  78 ** you can override in order to control update access to
  79 ** the dictionary. The function is stubbed out by default,
  80 ** but you can insert one: #define FICL_MULTITHREAD 1
  81 ** and supply your own version of ficlLockDictionary.
  82 */
  83 static int defaultStack = FICL_DEFAULT_STACK;
  84
  85
  86 static void ficlSetVersionEnv(FICL_SYSTEM *pSys);
  87
  88
  89 /**************************************************************************
  90                         f i c l I n i t S y s t e m
  91 ** Binds a global dictionary to the interpreter system.
  92 ** You specify the address and size of the allocated area.
  93 ** After that, ficl manages it.
  94 ** First step is to set up the static pointers to the area.
  95 ** Then write the "precompiled" portion of the dictionary in.
  96 ** The dictionary needs to be at least large enough to hold the
  97 ** precompiled part. Try 1K cells minimum. Use "words" to find
  98 ** out how much of the dictionary is used at any time.
  99 **************************************************************************/
 100 FICL_SYSTEM *ficlInitSystemEx(FICL_SYSTEM_INFO *fsi)
 101 {
 102     int nDictCells;
 103     int nEnvCells;
 104     FICL_SYSTEM *pSys = ficlMalloc(sizeof (FICL_SYSTEM));
 105
 106     assert(pSys);
 107     assert(fsi->size == sizeof (FICL_SYSTEM_INFO));
 108
 109     memset(pSys, 0, sizeof (FICL_SYSTEM));
 110
 111     nDictCells = fsi->nDictCells;
 112     if (nDictCells <= 0)
 113         nDictCells = FICL_DEFAULT_DICT;
 114
 115     nEnvCells = fsi->nEnvCells;
 116     if (nEnvCells <= 0)
 117         nEnvCells = FICL_DEFAULT_DICT;
 118
 119     pSys->dp = dictCreateHashed((unsigned)nDictCells, HASHSIZE);
 120     pSys->dp->pForthWords->name = "forth-wordlist";
 121
 122     pSys->envp = dictCreate((unsigned)nEnvCells);
 123     pSys->envp->pForthWords->name = "environment";
 124
 125     pSys->textOut = fsi->textOut;
 126     pSys->pExtend = fsi->pExtend;
 127
 128 #if FICL_WANT_LOCALS
 129     /*
 130     ** The locals dictionary is only searched while compiling,
 131     ** but this is where speed is most important. On the other
 132     ** hand, the dictionary gets emptied after each use of locals
 133     ** The need to balance search speed with the cost of the 'empty'
 134     ** operation led me to select a single-threaded list...
 135     */
 136     pSys->localp = dictCreate((unsigned)FICL_MAX_LOCALS * CELLS_PER_WORD);
 137 #endif
 138
 139     /*
 140     ** Build the precompiled dictionary and load softwords. We need a temporary
 141     ** VM to do this - ficlNewVM links one to the head of the system VM list.
 142     ** ficlCompilePlatform (defined in win32.c, for example) adds platform specific words.
 143     */
 144     ficlCompileCore(pSys);
 145     ficlCompilePrefix(pSys);
 146 #if FICL_WANT_FLOAT
 147     ficlCompileFloat(pSys);
 148 #endif
 149 #if FICL_PLATFORM_EXTEND
 150     ficlCompilePlatform(pSys);
 151 #endif
 152     ficlSetVersionEnv(pSys);
 153
 154     /*
 155     ** Establish the parse order. Note that prefixes precede numbers -
 156     ** this allows constructs like "0b101010" which might parse as a
 157     ** hex value otherwise.
 158     */
 159     ficlAddPrecompiledParseStep(pSys, "?prefix", ficlParsePrefix);
 160     ficlAddPrecompiledParseStep(pSys, "?number", ficlParseNumber);
 161 #if FICL_WANT_FLOAT
 162     ficlAddPrecompiledParseStep(pSys, ">float", ficlParseFloatNumber);
 163 #endif
 164
 165     /*
 166     ** Now create a temporary VM to compile the softwords. Since all VMs are
 167     ** linked into the vmList of FICL_SYSTEM, we don't have to pass the VM
 168     ** to ficlCompileSoftCore -- it just hijacks whatever it finds in the VM list.
 169     ** ficl 2.05: vmCreate no longer depends on the presence of INTERPRET in the
 170     ** dictionary, so a VM can be created before the dictionary is built. It just
 171     ** can't do much...
 172     */
 173     ficlNewVM(pSys);
 174     ficlCompileSoftCore(pSys);
 175     ficlFreeVM(pSys->vmList);
 176
 177
 178     return pSys;
 179 }
 180
 181
 182 FICL_SYSTEM *ficlInitSystem(int nDictCells)
 183 {
 184     FICL_SYSTEM_INFO fsi;
 185     ficlInitInfo(&fsi);
 186     fsi.nDictCells = nDictCells;
 187     return ficlInitSystemEx(&fsi);
 188 }
 189
 190
 191 /**************************************************************************
 192                         f i c l A d d P a r s e S t e p
 193 ** Appends a parse step function to the end of the parse list (see
 194 ** FICL_PARSE_STEP notes in ficl.h for details). Returns 0 if successful,
 195 ** nonzero if there's no more room in the list.
 196 **************************************************************************/
 197 int ficlAddParseStep(FICL_SYSTEM *pSys, FICL_WORD *pFW)
 198 {
 199     int i;
 200     for (i = 0; i < FICL_MAX_PARSE_STEPS; i++)
 201     {
 202         if (pSys->parseList[i] == NULL)
 203         {
 204             pSys->parseList[i] = pFW;
 205             return 0;
 206         }
 207     }
 208
 209     return 1;
 210 }
 211
 212
 213 /*
 214 ** Compile a word into the dictionary that invokes the specified FICL_PARSE_STEP
 215 ** function. It is up to the user (as usual in Forth) to make sure the stack
 216 ** preconditions are valid (there needs to be a counted string on top of the stack)
 217 ** before using the resulting word.
 218 */
 219 void ficlAddPrecompiledParseStep(FICL_SYSTEM *pSys, char *name, FICL_PARSE_STEP pStep)
 220 {
 221     FICL_DICT *dp = pSys->dp;
 222     FICL_WORD *pFW = dictAppendWord(dp, name, parseStepParen, FW_DEFAULT);
 223     dictAppendCell(dp, LVALUEtoCELL(pStep));
 224     ficlAddParseStep(pSys, pFW);
 225 }
 226
 227
 228 /*
 229 ** This word lists the parse steps in order
 230 */
 231 void ficlListParseSteps(FICL_VM *pVM)
 232 {
 233     int i;
 234     FICL_SYSTEM *pSys = pVM->pSys;
 235     assert(pSys);
 236
 237     vmTextOut(pVM, "Parse steps:", 1);
 238     vmTextOut(pVM, "lookup", 1);
 239
 240     for (i = 0; i < FICL_MAX_PARSE_STEPS; i++)
 241     {
 242         if (pSys->parseList[i] != NULL)
 243         {
 244             vmTextOut(pVM, pSys->parseList[i]->name, 1);
 245         }
 246         else break;
 247     }
 248     return;
 249 }
 250
 251
 252 /**************************************************************************
 253                         f i c l N e w V M
 254 ** Create a new virtual machine and link it into the system list
 255 ** of VMs for later cleanup by ficlTermSystem.
 256 **************************************************************************/
 257 FICL_VM *ficlNewVM(FICL_SYSTEM *pSys)
 258 {
 259     FICL_VM *pVM = vmCreate(NULL, defaultStack, defaultStack);
 260     pVM->link = pSys->vmList;
 261     pVM->pSys = pSys;
 262     pVM->pExtend = pSys->pExtend;
 263     vmSetTextOut(pVM, pSys->textOut);
 264
 265     pSys->vmList = pVM;
 266     return pVM;
 267 }
 268
 269
 270 /**************************************************************************
 271                         f i c l F r e e V M
 272 ** Removes the VM in question from the system VM list and deletes the
 273 ** memory allocated to it. This is an optional call, since ficlTermSystem
 274 ** will do this cleanup for you. This function is handy if you're going to
 275 ** do a lot of dynamic creation of VMs.
 276 **************************************************************************/
 277 void ficlFreeVM(FICL_VM *pVM)
 278 {
 279     FICL_SYSTEM *pSys = pVM->pSys;
 280     FICL_VM *pList = pSys->vmList;
 281
 282     assert(pVM != 0);
 283
 284     if (pSys->vmList == pVM)
 285     {
 286         pSys->vmList = pSys->vmList->link;
 287     }
 288     else for (; pList != NULL; pList = pList->link)
 289     {
 290         if (pList->link == pVM)
 291         {
 292             pList->link = pVM->link;
 293             break;
 294         }
 295     }
 296
 297     if (pList)
 298         vmDelete(pVM);
 299     return;
 300 }
 301
 302
 303 /**************************************************************************
 304                         f i c l B u i l d
 305 ** Builds a word into the dictionary.
 306 ** Preconditions: system must be initialized, and there must
 307 ** be enough space for the new word's header! Operation is
 308 ** controlled by ficlLockDictionary, so any initialization
 309 ** required by your version of the function (if you overrode
 310 ** it) must be complete at this point.
 311 ** Parameters:
 312 ** name  -- duh, the name of the word
 313 ** code  -- code to execute when the word is invoked - must take a single param
 314 **          pointer to a FICL_VM
 315 ** flags -- 0 or more of F_IMMEDIATE, F_COMPILE, use bitwise OR!
 316 **
 317 **************************************************************************/
 318 int ficlBuild(FICL_SYSTEM *pSys, char *name, FICL_CODE code, char flags)
 319 {
 320 #if FICL_MULTITHREAD
 321     int err = ficlLockDictionary(TRUE);
 322     if (err) return err;
 323 #endif /* FICL_MULTITHREAD */
 324
 325     assert(dictCellsAvail(pSys->dp) > sizeof (FICL_WORD) / sizeof (CELL));
 326     dictAppendWord(pSys->dp, name, code, flags);
 327
 328     ficlLockDictionary(FALSE);
 329     return 0;
 330 }
 331
 332
 333 /**************************************************************************
 334                     f i c l E v a l u a t e
 335 ** Wrapper for ficlExec() which sets SOURCE-ID to -1.
 336 **************************************************************************/
 337 int ficlEvaluate(FICL_VM *pVM, char *pText)
 338 {
 339     int returnValue;
 340     CELL id = pVM->sourceID;
 341     pVM->sourceID.i = -1;
 342     returnValue = ficlExecC(pVM, pText, -1);
 343     pVM->sourceID = id;
 344     return returnValue;
 345 }
 346
 347
 348 /**************************************************************************
 349                         f i c l E x e c
 350 ** Evaluates a block of input text in the context of the
 351 ** specified interpreter. Emits any requested output to the
 352 ** interpreter's output function.
 353 **
 354 ** Contains the "inner interpreter" code in a tight loop
 355 **
 356 ** Returns one of the VM_XXXX codes defined in ficl.h:
 357 ** VM_OUTOFTEXT is the normal exit condition
 358 ** VM_ERREXIT means that the interp encountered a syntax error
 359 **      and the vm has been reset to recover (some or all
 360 **      of the text block got ignored
 361 ** VM_USEREXIT means that the user executed the "bye" command
 362 **      to shut down the interpreter. This would be a good
 363 **      time to delete the vm, etc -- or you can ignore this
 364 **      signal.
 365 **************************************************************************/
 366 int ficlExec(FICL_VM *pVM, char *pText)
 367 {
 368     return ficlExecC(pVM, pText, -1);
 369 }
 370
 371 int ficlExecC(FICL_VM *pVM, char *pText, FICL_INT size)
 372 {
 373     FICL_SYSTEM *pSys = pVM->pSys;
 374     FICL_DICT   *dp   = pSys->dp;
 375
 376     int        except;
 377     jmp_buf    vmState;
 378     jmp_buf   *oldState;
 379     TIB        saveTib;
 380
 381     assert(pVM);
 382     assert(pSys->pInterp[0]);
 383
 384     if (size < 0)
 385         size = strlen(pText);
 386
 387     vmPushTib(pVM, pText, size, &saveTib);
 388
 389     /*
 390     ** Save and restore VM's jmp_buf to enable nested calls to ficlExec
 391     */
 392     oldState = pVM->pState;
 393     pVM->pState = &vmState; /* This has to come before the setjmp! */
 394     except = setjmp(vmState);
 395
 396     switch (except)
 397     {
 398     case 0:
 399         if (pVM->fRestart)
 400         {
 401             pVM->runningWord->code(pVM);
 402             pVM->fRestart = 0;
 403         }
 404         else
 405         {   /* set VM up to interpret text */
 406             vmPushIP(pVM, &(pSys->pInterp[0]));
 407         }
 408
 409         vmInnerLoop(pVM);
 410         break;
 411
 412     case VM_RESTART:
 413         pVM->fRestart = 1;
 414         except = VM_OUTOFTEXT;
 415         break;
 416
 417     case VM_OUTOFTEXT:
 418         vmPopIP(pVM);
 419 #ifdef TESTMAIN
 420         if ((pVM->state != COMPILE) && (pVM->sourceID.i == 0))
 421             ficlTextOut(pVM, FICL_PROMPT, 0);
 422 #endif
 423         break;
 424
 425     case VM_USEREXIT:
 426     case VM_INNEREXIT:
 427     case VM_BREAK:
 428         break;
 429
 430     case VM_QUIT:
 431         if (pVM->state == COMPILE)
 432         {
 433             dictAbortDefinition(dp);
 434 #if FICL_WANT_LOCALS
 435             dictEmpty(pSys->localp, pSys->localp->pForthWords->size);
 436 #endif
 437         }
 438         vmQuit(pVM);
 439         break;
 440
 441     case VM_ERREXIT:
 442     case VM_ABORT:
 443     case VM_ABORTQ:
 444     default:    /* user defined exit code?? */
 445         if (pVM->state == COMPILE)
 446         {
 447             dictAbortDefinition(dp);
 448 #if FICL_WANT_LOCALS
 449             dictEmpty(pSys->localp, pSys->localp->pForthWords->size);
 450 #endif
 451         }
 452         dictResetSearchOrder(dp);
 453         vmReset(pVM);
 454         break;
 455    }
 456
 457     pVM->pState    = oldState;
 458     vmPopTib(pVM, &saveTib);
 459     return (except);
 460 }
 461
 462
 463 /**************************************************************************
 464                         f i c l E x e c X T
 465 ** Given a pointer to a FICL_WORD, push an inner interpreter and
 466 ** execute the word to completion. This is in contrast with vmExecute,
 467 ** which does not guarantee that the word will have completed when
 468 ** the function returns (ie in the case of colon definitions, which
 469 ** need an inner interpreter to finish)
 470 **
 471 ** Returns one of the VM_XXXX exception codes listed in ficl.h. Normal
 472 ** exit condition is VM_INNEREXIT, ficl's private signal to exit the
 473 ** inner loop under normal circumstances. If another code is thrown to
 474 ** exit the loop, this function will re-throw it if it's nested under
 475 ** itself or ficlExec.
 476 **
 477 ** NOTE: this function is intended so that C code can execute ficlWords
 478 ** given their address in the dictionary (xt).
 479 **************************************************************************/
 480 int ficlExecXT(FICL_VM *pVM, FICL_WORD *pWord)
 481 {
 482     int        except;
 483     jmp_buf    vmState;
 484     jmp_buf   *oldState;
 485     FICL_WORD *oldRunningWord;
 486
 487     assert(pVM);
 488     assert(pVM->pSys->pExitInner);
 489
 490     /*
 491     ** Save the runningword so that RESTART behaves correctly
 492     ** over nested calls.
 493     */
 494     oldRunningWord = pVM->runningWord;
 495     /*
 496     ** Save and restore VM's jmp_buf to enable nested calls
 497     */
 498     oldState = pVM->pState;
 499     pVM->pState = &vmState; /* This has to come before the setjmp! */
 500     except = setjmp(vmState);
 501
 502     if (except)
 503         vmPopIP(pVM);
 504     else
 505         vmPushIP(pVM, &(pVM->pSys->pExitInner));
 506
 507     switch (except)
 508     {
 509     case 0:
 510         vmExecute(pVM, pWord);
 511         vmInnerLoop(pVM);
 512         break;
 513
 514     case VM_INNEREXIT:
 515     case VM_BREAK:
 516         break;
 517
 518     case VM_RESTART:
 519     case VM_OUTOFTEXT:
 520     case VM_USEREXIT:
 521     case VM_QUIT:
 522     case VM_ERREXIT:
 523     case VM_ABORT:
 524     case VM_ABORTQ:
 525     default:    /* user defined exit code?? */
 526         if (oldState)
 527         {
 528             pVM->pState = oldState;
 529             vmThrow(pVM, except);
 530         }
 531         break;
 532     }
 533
 534     pVM->pState    = oldState;
 535     pVM->runningWord = oldRunningWord;
 536     return (except);
 537 }
 538
 539
 540 /**************************************************************************
 541                         f i c l L o o k u p
 542 ** Look in the system dictionary for a match to the given name. If
 543 ** found, return the address of the corresponding FICL_WORD. Otherwise
 544 ** return NULL.
 545 **************************************************************************/
 546 FICL_WORD *ficlLookup(FICL_SYSTEM *pSys, char *name)
 547 {
 548     STRINGINFO si;
 549     SI_PSZ(si, name);
 550     return dictLookup(pSys->dp, si);
 551 }
 552
 553
 554 /**************************************************************************
 555                         f i c l G e t D i c t
 556 ** Returns the address of the system dictionary
 557 **************************************************************************/
 558 FICL_DICT *ficlGetDict(FICL_SYSTEM *pSys)
 559 {
 560     return pSys->dp;
 561 }
 562
 563
 564 /**************************************************************************
 565                         f i c l G e t E n v
 566 ** Returns the address of the system environment space
 567 **************************************************************************/
 568 FICL_DICT *ficlGetEnv(FICL_SYSTEM *pSys)
 569 {
 570     return pSys->envp;
 571 }
 572
 573
 574 /**************************************************************************
 575                         f i c l S e t E n v
 576 ** Create an environment variable with a one-CELL payload. ficlSetEnvD
 577 ** makes one with a two-CELL payload.
 578 **************************************************************************/
 579 void ficlSetEnv(FICL_SYSTEM *pSys, char *name, FICL_UNS value)
 580 {
 581     STRINGINFO si;
 582     FICL_WORD *pFW;
 583     FICL_DICT *envp = pSys->envp;
 584
 585     SI_PSZ(si, name);
 586     pFW = dictLookup(envp, si);
 587
 588     if (pFW == NULL)
 589     {
 590         dictAppendWord(envp, name, constantParen, FW_DEFAULT);
 591         dictAppendCell(envp, LVALUEtoCELL(value));
 592     }
 593     else
 594     {
 595         pFW->param[0] = LVALUEtoCELL(value);
 596     }
 597
 598     return;
 599 }
 600
 601 void ficlSetEnvD(FICL_SYSTEM *pSys, char *name, FICL_UNS hi, FICL_UNS lo)
 602 {
 603     FICL_WORD *pFW;
 604     STRINGINFO si;
 605     FICL_DICT *envp = pSys->envp;
 606     SI_PSZ(si, name);
 607     pFW = dictLookup(envp, si);
 608
 609     if (pFW == NULL)
 610     {
 611         dictAppendWord(envp, name, twoConstParen, FW_DEFAULT);
 612         dictAppendCell(envp, LVALUEtoCELL(lo));
 613         dictAppendCell(envp, LVALUEtoCELL(hi));
 614     }
 615     else
 616     {
 617         pFW->param[0] = LVALUEtoCELL(lo);
 618         pFW->param[1] = LVALUEtoCELL(hi);
 619     }
 620
 621     return;
 622 }
 623
 624
 625 /**************************************************************************
 626                         f i c l G e t L o c
 627 ** Returns the address of the system locals dictionary. This dict is
 628 ** only used during compilation, and is shared by all VMs.
 629 **************************************************************************/
 630 #if FICL_WANT_LOCALS
 631 FICL_DICT *ficlGetLoc(FICL_SYSTEM *pSys)
 632 {
 633     return pSys->localp;
 634 }
 635 #endif
 636
 637
 638
 639 /**************************************************************************
 640                         f i c l S e t S t a c k S i z e
 641 ** Set the stack sizes (return and parameter) to be used for all
 642 ** subsequently created VMs. Returns actual stack size to be used.
 643 **************************************************************************/
 644 int ficlSetStackSize(int nStackCells)
 645 {
 646     if (nStackCells >= FICL_DEFAULT_STACK)
 647         defaultStack = nStackCells;
 648     else
 649         defaultStack = FICL_DEFAULT_STACK;
 650
 651     return defaultStack;
 652 }
 653
 654
 655 /**************************************************************************
 656                         f i c l T e r m S y s t e m
 657 ** Tear the system down by deleting the dictionaries and all VMs.
 658 ** This saves you from having to keep track of all that stuff.
 659 **************************************************************************/
 660 void ficlTermSystem(FICL_SYSTEM *pSys)
 661 {
 662     if (pSys->dp)
 663         dictDelete(pSys->dp);
 664     pSys->dp = NULL;
 665
 666     if (pSys->envp)
 667         dictDelete(pSys->envp);
 668     pSys->envp = NULL;
 669
 670 #if FICL_WANT_LOCALS
 671     if (pSys->localp)
 672         dictDelete(pSys->localp);
 673     pSys->localp = NULL;
 674 #endif
 675
 676     while (pSys->vmList != NULL)
 677     {
 678         FICL_VM *pVM = pSys->vmList;
 679         pSys->vmList = pSys->vmList->link;
 680         vmDelete(pVM);
 681     }
 682
 683     ficlFree(pSys);
 684     pSys = NULL;
 685     return;
 686 }
 687
 688
 689 /**************************************************************************
 690                         f i c l S e t V e r s i o n E n v
 691 ** Create a double cell environment constant for the version ID
 692 **************************************************************************/
 693 static void ficlSetVersionEnv(FICL_SYSTEM *pSys)
 694 {
 695     ficlSetEnvD(pSys, "ficl-version", FICL_VER_MAJOR, FICL_VER_MINOR);
 696     ficlSetEnv (pSys, "ficl-robust",  FICL_ROBUST);
 697     return;
 698 }
 699