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 **************************************************************************/
ficlInitSystemEx(FICL_SYSTEM_INFO * fsi)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
ficlInitSystem(int nDictCells)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 **************************************************************************/
ficlAddParseStep(FICL_SYSTEM * pSys,FICL_WORD * pFW)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 */
ficlAddPrecompiledParseStep(FICL_SYSTEM * pSys,char * name,FICL_PARSE_STEP pStep)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 */
ficlListParseSteps(FICL_VM * pVM)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 **************************************************************************/
ficlNewVM(FICL_SYSTEM * pSys)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 **************************************************************************/
ficlFreeVM(FICL_VM * pVM)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 **************************************************************************/
ficlBuild(FICL_SYSTEM * pSys,char * name,FICL_CODE code,char flags)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 **************************************************************************/
ficlEvaluate(FICL_VM * pVM,char * pText)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 **************************************************************************/
ficlExec(FICL_VM * pVM,char * pText)362 int ficlExec(FICL_VM *pVM, char *pText)
363 {
364 return ficlExecC(pVM, pText, -1);
365 }
366
ficlExecC(FICL_VM * pVM,char * pText,FICL_INT size)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 **************************************************************************/
ficlExecXT(FICL_VM * pVM,FICL_WORD * pWord)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 **************************************************************************/
ficlLookup(FICL_SYSTEM * pSys,char * name)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 **************************************************************************/
ficlGetDict(FICL_SYSTEM * pSys)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 **************************************************************************/
ficlGetEnv(FICL_SYSTEM * pSys)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 **************************************************************************/
ficlSetEnv(FICL_SYSTEM * pSys,char * name,FICL_UNS value)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
ficlSetEnvD(FICL_SYSTEM * pSys,char * name,FICL_UNS hi,FICL_UNS lo)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
ficlGetLoc(FICL_SYSTEM * pSys)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 **************************************************************************/
ficlSetStackSize(int nStackCells)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 **************************************************************************/
ficlTermSystem(FICL_SYSTEM * pSys)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 **************************************************************************/
ficlSetVersionEnv(FICL_SYSTEM * pSys)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
696