Deleted Added
sdiff udiff text old ( 76116 ) new ( 94290 )
full compact
ficl.c (76116) ficl.c (94290)
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
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.10 2001-04-26 21:41:42-07 jsadler Exp jsadler $
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

--- 6 unchanged lines hidden (view full) ---

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**
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

--- 6 unchanged lines hidden (view full) ---

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**
29** L I C E N S E and D I S C L A I M E R
30**
31** Redistribution and use in source and binary forms, with or without
32** modification, are permitted provided that the following conditions
33** are met:
34** 1. Redistributions of source code must retain the above copyright
35** notice, this list of conditions and the following disclaimer.
36** 2. Redistributions in binary form must reproduce the above copyright

--- 6 unchanged lines hidden (view full) ---

43** ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
44** FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
45** DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
46** OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
47** HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
48** LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
49** OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
50** SUCH DAMAGE.
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

--- 6 unchanged lines hidden (view full) ---

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.
51**
52** I am interested in hearing from anyone who uses ficl. If you have
53** a problem, a success story, a defect, an enhancement request, or
54** if you would like to contribute to the ficl release, please send
55** contact me by email at the address above.
56**
57** $Id: ficl.c,v 1.10 2001-04-26 21:41:42-07 jsadler Exp jsadler $
58*/
59
56*/
57
60/* $FreeBSD: head/sys/boot/ficl/ficl.c 76116 2001-04-29 02:36:36Z dcs $ */
58/* $FreeBSD: head/sys/boot/ficl/ficl.c 94290 2002-04-09 17:45:28Z dcs $ */
61
62#ifdef TESTMAIN
63#include <stdlib.h>
64#else
65#include <stand.h>
66#endif
67#include <string.h>
68#include "ficl.h"
69
70
71/*
72** System statics
59
60#ifdef TESTMAIN
61#include <stdlib.h>
62#else
63#include <stand.h>
64#endif
65#include <string.h>
66#include "ficl.h"
67
68
69/*
70** System statics
73** The system builds a global dictionary during its start
74** sequence. This is shared by all interpreter instances.
75** Therefore only one instance can update the dictionary
71** Each FICL_SYSTEM builds a global dictionary during its start
72** sequence. This is shared by all virtual machines of that system.
73** Therefore only one VM can update the dictionary
76** at a time. The system imports a locking function that
77** you can override in order to control update access to
78** the dictionary. The function is stubbed out by default,
79** but you can insert one: #define FICL_MULTITHREAD 1
80** and supply your own version of ficlLockDictionary.
81*/
74** at a time. The system imports a locking function that
75** you can override in order to control update access to
76** the dictionary. The function is stubbed out by default,
77** but you can insert one: #define FICL_MULTITHREAD 1
78** and supply your own version of ficlLockDictionary.
79*/
82static FICL_SYSTEM *pSys = NULL;
83
84static int defaultStack = FICL_DEFAULT_STACK;
80static int defaultStack = FICL_DEFAULT_STACK;
85static int defaultDict = FICL_DEFAULT_DICT;
86
87
81
82
83static void ficlSetVersionEnv(FICL_SYSTEM *pSys);
84
85
88/**************************************************************************
89 f i c l I n i t S y s t e m
90** Binds a global dictionary to the interpreter system.
91** You specify the address and size of the allocated area.
92** After that, ficl manages it.
93** First step is to set up the static pointers to the area.
94** Then write the "precompiled" portion of the dictionary in.
95** The dictionary needs to be at least large enough to hold the
96** precompiled part. Try 1K cells minimum. Use "words" to find
97** out how much of the dictionary is used at any time.
98**************************************************************************/
86/**************************************************************************
87 f i c l I n i t S y s t e m
88** Binds a global dictionary to the interpreter system.
89** You specify the address and size of the allocated area.
90** After that, ficl manages it.
91** First step is to set up the static pointers to the area.
92** Then write the "precompiled" portion of the dictionary in.
93** The dictionary needs to be at least large enough to hold the
94** precompiled part. Try 1K cells minimum. Use "words" to find
95** out how much of the dictionary is used at any time.
96**************************************************************************/
99void ficlInitSystem(int nDictCells)
97FICL_SYSTEM *ficlInitSystemEx(FICL_SYSTEM_INFO *fsi)
100{
98{
101 pSys = ficlMalloc(sizeof (FICL_SYSTEM));
99 int nDictCells;
100 int nEnvCells;
101 FICL_SYSTEM *pSys = ficlMalloc(sizeof (FICL_SYSTEM));
102
102 assert(pSys);
103 assert(pSys);
104 assert(fsi->size == sizeof (FICL_SYSTEM_INFO));
103
104 memset(pSys, 0, sizeof (FICL_SYSTEM));
105
105
106 memset(pSys, 0, sizeof (FICL_SYSTEM));
107
108 nDictCells = fsi->nDictCells;
106 if (nDictCells <= 0)
109 if (nDictCells <= 0)
107 nDictCells = defaultDict;
110 nDictCells = FICL_DEFAULT_DICT;
108
111
112 nEnvCells = fsi->nEnvCells;
113 if (nEnvCells <= 0)
114 nEnvCells = FICL_DEFAULT_DICT;
115
109 pSys->dp = dictCreateHashed((unsigned)nDictCells, HASHSIZE);
110 pSys->dp->pForthWords->name = "forth-wordlist";
111
116 pSys->dp = dictCreateHashed((unsigned)nDictCells, HASHSIZE);
117 pSys->dp->pForthWords->name = "forth-wordlist";
118
112 pSys->envp = dictCreate((unsigned)FICL_DEFAULT_ENV);
119 pSys->envp = dictCreate((unsigned)nEnvCells);
113 pSys->envp->pForthWords->name = "environment";
114
120 pSys->envp->pForthWords->name = "environment";
121
122 pSys->textOut = fsi->textOut;
123 pSys->pExtend = fsi->pExtend;
124
115#if FICL_WANT_LOCALS
116 /*
117 ** The locals dictionary is only searched while compiling,
118 ** but this is where speed is most important. On the other
119 ** hand, the dictionary gets emptied after each use of locals
125#if FICL_WANT_LOCALS
126 /*
127 ** The locals dictionary is only searched while compiling,
128 ** but this is where speed is most important. On the other
129 ** hand, the dictionary gets emptied after each use of locals
120 ** The need to balance search speed with the cost of the empty
130 ** The need to balance search speed with the cost of the 'empty'
121 ** operation led me to select a single-threaded list...
122 */
123 pSys->localp = dictCreate((unsigned)FICL_MAX_LOCALS * CELLS_PER_WORD);
124#endif
125
126 /*
131 ** operation led me to select a single-threaded list...
132 */
133 pSys->localp = dictCreate((unsigned)FICL_MAX_LOCALS * CELLS_PER_WORD);
134#endif
135
136 /*
127 ** Establish the parse order. Note that prefixes precede numbers -
128 ** this allows constructs like "0b101010" which would parse as a
129 ** valid hex value otherwise.
130 */
131 ficlCompilePrefix(pSys);
132 ficlAddPrecompiledParseStep(pSys, "number?", ficlParseNumber);
133
134 /*
135 ** Build the precompiled dictionary and load softwords. We need a temporary
136 ** VM to do this - ficlNewVM links one to the head of the system VM list.
137 ** ficlCompilePlatform (defined in win32.c, for example) adds platform specific words.
138 */
139 ficlCompileCore(pSys);
137 ** Build the precompiled dictionary and load softwords. We need a temporary
138 ** VM to do this - ficlNewVM links one to the head of the system VM list.
139 ** ficlCompilePlatform (defined in win32.c, for example) adds platform specific words.
140 */
141 ficlCompileCore(pSys);
142 ficlCompilePrefix(pSys);
140#if FICL_WANT_FLOAT
141 ficlCompileFloat(pSys);
142#endif
143#if FICL_WANT_FLOAT
144 ficlCompileFloat(pSys);
145#endif
143
144#if FICL_PLATFORM_EXTEND
145 ficlCompilePlatform(pSys);
146#endif
146#if FICL_PLATFORM_EXTEND
147 ficlCompilePlatform(pSys);
148#endif
149 ficlSetVersionEnv(pSys);
147
148 /*
150
151 /*
149 ** Now we can create a VM to compile the softwords. Note that the VM initialization
150 ** code needs to be able to find "interpret" in the dictionary in order to
151 ** succeed, so as presently constructed ficlCompileCore has to finish before
152 ** a VM can be created successfully.
152 ** Establish the parse order. Note that prefixes precede numbers -
153 ** this allows constructs like "0b101010" which might parse as a
154 ** hex value otherwise.
153 */
155 */
154 ficlNewVM();
156 ficlAddPrecompiledParseStep(pSys, "?prefix", ficlParsePrefix);
157 ficlAddPrecompiledParseStep(pSys, "?number", ficlParseNumber);
158#if FICL_WANT_FLOAT
159 ficlAddPrecompiledParseStep(pSys, ">float", ficlParseFloatNumber);
160#endif
161
162 /*
163 ** Now create a temporary VM to compile the softwords. Since all VMs are
164 ** linked into the vmList of FICL_SYSTEM, we don't have to pass the VM
165 ** to ficlCompileSoftCore -- it just hijacks whatever it finds in the VM list.
166 ** ficl 2.05: vmCreate no longer depends on the presence of INTERPRET in the
167 ** dictionary, so a VM can be created before the dictionary is built. It just
168 ** can't do much...
169 */
170 ficlNewVM(pSys);
155 ficlCompileSoftCore(pSys);
156 ficlFreeVM(pSys->vmList);
157
158
171 ficlCompileSoftCore(pSys);
172 ficlFreeVM(pSys->vmList);
173
174
159 return;
175 return pSys;
160}
161
162
176}
177
178
179FICL_SYSTEM *ficlInitSystem(int nDictCells)
180{
181 FICL_SYSTEM_INFO fsi;
182 ficlInitInfo(&fsi);
183 fsi.nDictCells = nDictCells;
184 return ficlInitSystemEx(&fsi);
185}
186
187
163/**************************************************************************
164 f i c l A d d P a r s e S t e p
165** Appends a parse step function to the end of the parse list (see
166** FICL_PARSE_STEP notes in ficl.h for details). Returns 0 if successful,
167** nonzero if there's no more room in the list.
168**************************************************************************/
169int ficlAddParseStep(FICL_SYSTEM *pSys, FICL_WORD *pFW)
170{

--- 50 unchanged lines hidden (view full) ---

221}
222
223
224/**************************************************************************
225 f i c l N e w V M
226** Create a new virtual machine and link it into the system list
227** of VMs for later cleanup by ficlTermSystem.
228**************************************************************************/
188/**************************************************************************
189 f i c l A d d P a r s e S t e p
190** Appends a parse step function to the end of the parse list (see
191** FICL_PARSE_STEP notes in ficl.h for details). Returns 0 if successful,
192** nonzero if there's no more room in the list.
193**************************************************************************/
194int ficlAddParseStep(FICL_SYSTEM *pSys, FICL_WORD *pFW)
195{

--- 50 unchanged lines hidden (view full) ---

246}
247
248
249/**************************************************************************
250 f i c l N e w V M
251** Create a new virtual machine and link it into the system list
252** of VMs for later cleanup by ficlTermSystem.
253**************************************************************************/
229FICL_VM *ficlNewVM(void)
254FICL_VM *ficlNewVM(FICL_SYSTEM *pSys)
230{
231 FICL_VM *pVM = vmCreate(NULL, defaultStack, defaultStack);
232 pVM->link = pSys->vmList;
233 pVM->pSys = pSys;
255{
256 FICL_VM *pVM = vmCreate(NULL, defaultStack, defaultStack);
257 pVM->link = pSys->vmList;
258 pVM->pSys = pSys;
259 pVM->pExtend = pSys->pExtend;
260 vmSetTextOut(pVM, pSys->textOut);
234
235 pSys->vmList = pVM;
236 return pVM;
237}
238
239
240/**************************************************************************
241 f i c l F r e e V M
242** Removes the VM in question from the system VM list and deletes the
243** memory allocated to it. This is an optional call, since ficlTermSystem
244** will do this cleanup for you. This function is handy if you're going to
245** do a lot of dynamic creation of VMs.
246**************************************************************************/
247void ficlFreeVM(FICL_VM *pVM)
248{
261
262 pSys->vmList = pVM;
263 return pVM;
264}
265
266
267/**************************************************************************
268 f i c l F r e e V M
269** Removes the VM in question from the system VM list and deletes the
270** memory allocated to it. This is an optional call, since ficlTermSystem
271** will do this cleanup for you. This function is handy if you're going to
272** do a lot of dynamic creation of VMs.
273**************************************************************************/
274void ficlFreeVM(FICL_VM *pVM)
275{
276 FICL_SYSTEM *pSys = pVM->pSys;
249 FICL_VM *pList = pSys->vmList;
250
251 assert(pVM != 0);
252
253 if (pSys->vmList == pVM)
254 {
255 pSys->vmList = pSys->vmList->link;
256 }

--- 22 unchanged lines hidden (view full) ---

279** it) must be complete at this point.
280** Parameters:
281** name -- duh, the name of the word
282** code -- code to execute when the word is invoked - must take a single param
283** pointer to a FICL_VM
284** flags -- 0 or more of F_IMMEDIATE, F_COMPILE, use bitwise OR!
285**
286**************************************************************************/
277 FICL_VM *pList = pSys->vmList;
278
279 assert(pVM != 0);
280
281 if (pSys->vmList == pVM)
282 {
283 pSys->vmList = pSys->vmList->link;
284 }

--- 22 unchanged lines hidden (view full) ---

307** it) must be complete at this point.
308** Parameters:
309** name -- duh, the name of the word
310** code -- code to execute when the word is invoked - must take a single param
311** pointer to a FICL_VM
312** flags -- 0 or more of F_IMMEDIATE, F_COMPILE, use bitwise OR!
313**
314**************************************************************************/
287int ficlBuild(char *name, FICL_CODE code, char flags)
315int ficlBuild(FICL_SYSTEM *pSys, char *name, FICL_CODE code, char flags)
288{
316{
317#if FICL_MULTITHREAD
289 int err = ficlLockDictionary(TRUE);
290 if (err) return err;
318 int err = ficlLockDictionary(TRUE);
319 if (err) return err;
320#endif /* FICL_MULTITHREAD */
291
292 assert(dictCellsAvail(pSys->dp) > sizeof (FICL_WORD) / sizeof (CELL));
293 dictAppendWord(pSys->dp, name, code, flags);
294
295 ficlLockDictionary(FALSE);
296 return 0;
297}
298
299
300/**************************************************************************
321
322 assert(dictCellsAvail(pSys->dp) > sizeof (FICL_WORD) / sizeof (CELL));
323 dictAppendWord(pSys->dp, name, code, flags);
324
325 ficlLockDictionary(FALSE);
326 return 0;
327}
328
329
330/**************************************************************************
331 f i c l E v a l u a t e
332** Wrapper for ficlExec() which sets SOURCE-ID to -1.
333**************************************************************************/
334int ficlEvaluate(FICL_VM *pVM, char *pText)
335{
336 int returnValue;
337 CELL id = pVM->sourceID;
338 pVM->sourceID.i = -1;
339 returnValue = ficlExecC(pVM, pText, -1);
340 pVM->sourceID = id;
341 return returnValue;
342}
343
344
345/**************************************************************************
301 f i c l E x e c
302** Evaluates a block of input text in the context of the
303** specified interpreter. Emits any requested output to the
304** interpreter's output function.
305**
306** Contains the "inner interpreter" code in a tight loop
307**
308** Returns one of the VM_XXXX codes defined in ficl.h:

--- 8 unchanged lines hidden (view full) ---

317**************************************************************************/
318int ficlExec(FICL_VM *pVM, char *pText)
319{
320 return ficlExecC(pVM, pText, -1);
321}
322
323int ficlExecC(FICL_VM *pVM, char *pText, FICL_INT size)
324{
346 f i c l E x e c
347** Evaluates a block of input text in the context of the
348** specified interpreter. Emits any requested output to the
349** interpreter's output function.
350**
351** Contains the "inner interpreter" code in a tight loop
352**
353** Returns one of the VM_XXXX codes defined in ficl.h:

--- 8 unchanged lines hidden (view full) ---

362**************************************************************************/
363int ficlExec(FICL_VM *pVM, char *pText)
364{
365 return ficlExecC(pVM, pText, -1);
366}
367
368int ficlExecC(FICL_VM *pVM, char *pText, FICL_INT size)
369{
325 FICL_WORD **pInterp = pSys->pInterp;
326 FICL_DICT *dp = pSys->dp;
370 FICL_SYSTEM *pSys = pVM->pSys;
371 FICL_DICT *dp = pSys->dp;
327
328 int except;
329 jmp_buf vmState;
330 jmp_buf *oldState;
331 TIB saveTib;
332
372
373 int except;
374 jmp_buf vmState;
375 jmp_buf *oldState;
376 TIB saveTib;
377
333 if (!pInterp[0])
334 {
335 pInterp[0] = ficlLookup("interpret");
336 pInterp[1] = ficlLookup("(branch)");
337 pInterp[2] = (FICL_WORD *)(void *)(-2);
338 }
339
340 assert(pInterp[0]);
341 assert(pVM);
378 assert(pVM);
379 assert(pSys->pInterp[0]);
342
343 if (size < 0)
344 size = strlen(pText);
345
346 vmPushTib(pVM, pText, size, &saveTib);
347
348 /*
349 ** Save and restore VM's jmp_buf to enable nested calls to ficlExec

--- 7 unchanged lines hidden (view full) ---

357 case 0:
358 if (pVM->fRestart)
359 {
360 pVM->runningWord->code(pVM);
361 pVM->fRestart = 0;
362 }
363 else
364 { /* set VM up to interpret text */
380
381 if (size < 0)
382 size = strlen(pText);
383
384 vmPushTib(pVM, pText, size, &saveTib);
385
386 /*
387 ** Save and restore VM's jmp_buf to enable nested calls to ficlExec

--- 7 unchanged lines hidden (view full) ---

395 case 0:
396 if (pVM->fRestart)
397 {
398 pVM->runningWord->code(pVM);
399 pVM->fRestart = 0;
400 }
401 else
402 { /* set VM up to interpret text */
365 vmPushIP(pVM, &pInterp[0]);
403 vmPushIP(pVM, &(pSys->pInterp[0]));
366 }
367
368 vmInnerLoop(pVM);
369 break;
370
371 case VM_RESTART:
372 pVM->fRestart = 1;
373 except = VM_OUTOFTEXT;

--- 59 unchanged lines hidden (view full) ---

433** exit the loop, this function will re-throw it if it's nested under
434** itself or ficlExec.
435**
436** NOTE: this function is intended so that C code can execute ficlWords
437** given their address in the dictionary (xt).
438**************************************************************************/
439int ficlExecXT(FICL_VM *pVM, FICL_WORD *pWord)
440{
404 }
405
406 vmInnerLoop(pVM);
407 break;
408
409 case VM_RESTART:
410 pVM->fRestart = 1;
411 except = VM_OUTOFTEXT;

--- 59 unchanged lines hidden (view full) ---

471** exit the loop, this function will re-throw it if it's nested under
472** itself or ficlExec.
473**
474** NOTE: this function is intended so that C code can execute ficlWords
475** given their address in the dictionary (xt).
476**************************************************************************/
477int ficlExecXT(FICL_VM *pVM, FICL_WORD *pWord)
478{
441 static FICL_WORD *pQuit = NULL;
442 int except;
443 jmp_buf vmState;
444 jmp_buf *oldState;
445 FICL_WORD *oldRunningWord;
446
479 int except;
480 jmp_buf vmState;
481 jmp_buf *oldState;
482 FICL_WORD *oldRunningWord;
483
447 if (!pQuit)
448 pQuit = ficlLookup("exit-inner");
449
450 assert(pVM);
484 assert(pVM);
451 assert(pQuit);
485 assert(pVM->pSys->pExitInner);
452
453 /*
454 ** Save the runningword so that RESTART behaves correctly
455 ** over nested calls.
456 */
457 oldRunningWord = pVM->runningWord;
458 /*
459 ** Save and restore VM's jmp_buf to enable nested calls
460 */
461 oldState = pVM->pState;
462 pVM->pState = &vmState; /* This has to come before the setjmp! */
463 except = setjmp(vmState);
464
465 if (except)
466 vmPopIP(pVM);
467 else
486
487 /*
488 ** Save the runningword so that RESTART behaves correctly
489 ** over nested calls.
490 */
491 oldRunningWord = pVM->runningWord;
492 /*
493 ** Save and restore VM's jmp_buf to enable nested calls
494 */
495 oldState = pVM->pState;
496 pVM->pState = &vmState; /* This has to come before the setjmp! */
497 except = setjmp(vmState);
498
499 if (except)
500 vmPopIP(pVM);
501 else
468 vmPushIP(pVM, &pQuit);
502 vmPushIP(pVM, &(pVM->pSys->pExitInner));
469
470 switch (except)
471 {
472 case 0:
473 vmExecute(pVM, pWord);
474 vmInnerLoop(pVM);
475 break;
476

--- 24 unchanged lines hidden (view full) ---

501
502
503/**************************************************************************
504 f i c l L o o k u p
505** Look in the system dictionary for a match to the given name. If
506** found, return the address of the corresponding FICL_WORD. Otherwise
507** return NULL.
508**************************************************************************/
503
504 switch (except)
505 {
506 case 0:
507 vmExecute(pVM, pWord);
508 vmInnerLoop(pVM);
509 break;
510

--- 24 unchanged lines hidden (view full) ---

535
536
537/**************************************************************************
538 f i c l L o o k u p
539** Look in the system dictionary for a match to the given name. If
540** found, return the address of the corresponding FICL_WORD. Otherwise
541** return NULL.
542**************************************************************************/
509FICL_WORD *ficlLookup(char *name)
543FICL_WORD *ficlLookup(FICL_SYSTEM *pSys, char *name)
510{
511 STRINGINFO si;
512 SI_PSZ(si, name);
513 return dictLookup(pSys->dp, si);
514}
515
516
517/**************************************************************************
518 f i c l G e t D i c t
519** Returns the address of the system dictionary
520**************************************************************************/
544{
545 STRINGINFO si;
546 SI_PSZ(si, name);
547 return dictLookup(pSys->dp, si);
548}
549
550
551/**************************************************************************
552 f i c l G e t D i c t
553** Returns the address of the system dictionary
554**************************************************************************/
521FICL_DICT *ficlGetDict(void)
555FICL_DICT *ficlGetDict(FICL_SYSTEM *pSys)
522{
523 return pSys->dp;
524}
525
526
527/**************************************************************************
528 f i c l G e t E n v
529** Returns the address of the system environment space
530**************************************************************************/
556{
557 return pSys->dp;
558}
559
560
561/**************************************************************************
562 f i c l G e t E n v
563** Returns the address of the system environment space
564**************************************************************************/
531FICL_DICT *ficlGetEnv(void)
565FICL_DICT *ficlGetEnv(FICL_SYSTEM *pSys)
532{
533 return pSys->envp;
534}
535
536
537/**************************************************************************
538 f i c l S e t E n v
539** Create an environment variable with a one-CELL payload. ficlSetEnvD
540** makes one with a two-CELL payload.
541**************************************************************************/
566{
567 return pSys->envp;
568}
569
570
571/**************************************************************************
572 f i c l S e t E n v
573** Create an environment variable with a one-CELL payload. ficlSetEnvD
574** makes one with a two-CELL payload.
575**************************************************************************/
542void ficlSetEnv(char *name, FICL_UNS value)
576void ficlSetEnv(FICL_SYSTEM *pSys, char *name, FICL_UNS value)
543{
544 STRINGINFO si;
545 FICL_WORD *pFW;
546 FICL_DICT *envp = pSys->envp;
547
548 SI_PSZ(si, name);
549 pFW = dictLookup(envp, si);
550

--- 5 unchanged lines hidden (view full) ---

556 else
557 {
558 pFW->param[0] = LVALUEtoCELL(value);
559 }
560
561 return;
562}
563
577{
578 STRINGINFO si;
579 FICL_WORD *pFW;
580 FICL_DICT *envp = pSys->envp;
581
582 SI_PSZ(si, name);
583 pFW = dictLookup(envp, si);
584

--- 5 unchanged lines hidden (view full) ---

590 else
591 {
592 pFW->param[0] = LVALUEtoCELL(value);
593 }
594
595 return;
596}
597
564void ficlSetEnvD(char *name, FICL_UNS hi, FICL_UNS lo)
598void ficlSetEnvD(FICL_SYSTEM *pSys, char *name, FICL_UNS hi, FICL_UNS lo)
565{
566 FICL_WORD *pFW;
567 STRINGINFO si;
568 FICL_DICT *envp = pSys->envp;
569 SI_PSZ(si, name);
570 pFW = dictLookup(envp, si);
571
572 if (pFW == NULL)

--- 13 unchanged lines hidden (view full) ---

586
587
588/**************************************************************************
589 f i c l G e t L o c
590** Returns the address of the system locals dictionary. This dict is
591** only used during compilation, and is shared by all VMs.
592**************************************************************************/
593#if FICL_WANT_LOCALS
599{
600 FICL_WORD *pFW;
601 STRINGINFO si;
602 FICL_DICT *envp = pSys->envp;
603 SI_PSZ(si, name);
604 pFW = dictLookup(envp, si);
605
606 if (pFW == NULL)

--- 13 unchanged lines hidden (view full) ---

620
621
622/**************************************************************************
623 f i c l G e t L o c
624** Returns the address of the system locals dictionary. This dict is
625** only used during compilation, and is shared by all VMs.
626**************************************************************************/
627#if FICL_WANT_LOCALS
594FICL_DICT *ficlGetLoc(void)
628FICL_DICT *ficlGetLoc(FICL_SYSTEM *pSys)
595{
596 return pSys->localp;
597}
598#endif
599
600
601
602/**************************************************************************

--- 12 unchanged lines hidden (view full) ---

615}
616
617
618/**************************************************************************
619 f i c l T e r m S y s t e m
620** Tear the system down by deleting the dictionaries and all VMs.
621** This saves you from having to keep track of all that stuff.
622**************************************************************************/
629{
630 return pSys->localp;
631}
632#endif
633
634
635
636/**************************************************************************

--- 12 unchanged lines hidden (view full) ---

649}
650
651
652/**************************************************************************
653 f i c l T e r m S y s t e m
654** Tear the system down by deleting the dictionaries and all VMs.
655** This saves you from having to keep track of all that stuff.
656**************************************************************************/
623void ficlTermSystem(void)
657void ficlTermSystem(FICL_SYSTEM *pSys)
624{
625 if (pSys->dp)
626 dictDelete(pSys->dp);
627 pSys->dp = NULL;
628
629 if (pSys->envp)
630 dictDelete(pSys->envp);
631 pSys->envp = NULL;

--- 12 unchanged lines hidden (view full) ---

644 }
645
646 ficlFree(pSys);
647 pSys = NULL;
648 return;
649}
650
651
658{
659 if (pSys->dp)
660 dictDelete(pSys->dp);
661 pSys->dp = NULL;
662
663 if (pSys->envp)
664 dictDelete(pSys->envp);
665 pSys->envp = NULL;

--- 12 unchanged lines hidden (view full) ---

678 }
679
680 ficlFree(pSys);
681 pSys = NULL;
682 return;
683}
684
685
686/**************************************************************************
687 f i c l S e t V e r s i o n E n v
688** Create a double cell environment constant for the version ID
689**************************************************************************/
690static void ficlSetVersionEnv(FICL_SYSTEM *pSys)
691{
692 ficlSetEnvD(pSys, "ficl-version", FICL_VER_MAJOR, FICL_VER_MINOR);
693 ficlSetEnv (pSys, "ficl-robust", FICL_ROBUST);
694 return;
695}
696