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