1/*******************************************************************
2** f i c l . c
3** Forth Inspired Command Language - external interface
4** Author: John Sadler (john_sadler@alum.mit.edu)
5** Created: 19 July 1997
6**
7*******************************************************************/
8/*
9** This is an ANS Forth interpreter written in C.
10** Ficl uses Forth syntax for its commands, but turns the Forth
11** model on its head in other respects.
12** Ficl provides facilities for interoperating
13** with programs written in C: C functions can be exported to Ficl,
14** and Ficl commands can be executed via a C calling interface. The
15** interpreter is re-entrant, so it can be used in multiple instances
16** in a multitasking system. Unlike Forth, Ficl's outer interpreter
17** expects a text block as input, and returns to the caller after each
18** text block, so the data pump is somewhere in external code. This
19** is more like TCL than Forth.
20**
21** Code is written in ANSI C for portability.
22*/
23
24#ifdef TESTMAIN
25#include <stdlib.h>
26#else
27#include <stand.h>
28#endif
29#include <string.h>
30#include "ficl.h"
31
32
33/*
34** Local prototypes
35*/
36
37
38/*
39** System statics
40** The system builds a global dictionary during its start
41** sequence. This is shared by all interpreter instances.
42** Therefore only one instance can update the dictionary
43** at a time. The system imports a locking function that
44** you can override in order to control update access to
45** the dictionary. The function is stubbed out by default,
46** but you can insert one: #define FICL_MULTITHREAD 1
47** and supply your own version of ficlLockDictionary.
48*/
49static FICL_DICT *dp = NULL;
50static FICL_DICT *envp = NULL;
51#if FICL_WANT_LOCALS
52static FICL_DICT *localp = NULL;
53#endif
54static FICL_VM *vmList = NULL;
55
56static int defaultStack = FICL_DEFAULT_STACK;
57static int defaultDict = FICL_DEFAULT_DICT;
58
59
60/**************************************************************************
61 f i c l I n i t S y s t e m
62** Binds a global dictionary to the interpreter system.
63** You specify the address and size of the allocated area.
64** After that, ficl manages it.
65** First step is to set up the static pointers to the area.
66** Then write the "precompiled" portion of the dictionary in.
67** The dictionary needs to be at least large enough to hold the
68** precompiled part. Try 1K cells minimum. Use "words" to find
69** out how much of the dictionary is used at any time.
70**************************************************************************/
71void ficlInitSystem(int nDictCells)
72{
73 if (dp)
74 dictDelete(dp);
75
76 if (envp)
77 dictDelete(envp);
78
79#if FICL_WANT_LOCALS
80 if (localp)
81 dictDelete(localp);
82#endif
83
84 if (nDictCells <= 0)
85 nDictCells = defaultDict;
86
87 dp = dictCreateHashed((unsigned)nDictCells, HASHSIZE);
88 envp = dictCreate( (unsigned)FICL_DEFAULT_ENV);
89#if FICL_WANT_LOCALS
90 /*
91 ** The locals dictionary is only searched while compiling,
92 ** but this is where speed is most important. On the other
93 ** hand, the dictionary gets emptied after each use of locals
94 ** The need to balance search speed with the cost of the empty
95 ** operation led me to select a single-threaded list...
96 */
97 localp = dictCreate( (unsigned)FICL_MAX_LOCALS * CELLS_PER_WORD);
98#endif
99
100 ficlCompileCore(dp);
101
102 return;
103}
104
105
106/**************************************************************************
107 f i c l N e w V M
108** Create a new virtual machine and link it into the system list
109** of VMs for later cleanup by ficlTermSystem. If this is the first
110** VM to be created, use it to compile the words in softcore.c
111**************************************************************************/
112FICL_VM *ficlNewVM(void)
113{
114 FICL_VM *pVM = vmCreate(NULL, defaultStack, defaultStack);
115 pVM->link = vmList;
116
117 /*
118 ** Borrow the first vm to build the soft words in softcore.c
119 */
120 if (vmList == NULL)
121 ficlCompileSoftCore(pVM);
122
123 vmList = pVM;
124 return pVM;
125}
126
127
128/**************************************************************************
129 f i c l B u i l d
130** Builds a word into the dictionary.
131** Preconditions: system must be initialized, and there must
132** be enough space for the new word's header! Operation is
133** controlled by ficlLockDictionary, so any initialization
134** required by your version of the function (if you overrode
135** it) must be complete at this point.
136** Parameters:
137** name -- duh, the name of the word
138** code -- code to execute when the word is invoked - must take a single param
139** pointer to a FICL_VM
140** flags -- 0 or more of F_IMMEDIATE, F_COMPILE, use bitwise OR!
141**
142**************************************************************************/
143int ficlBuild(char *name, FICL_CODE code, char flags)
144{
145 int err = ficlLockDictionary(TRUE);
146 if (err) return err;
147
148 dictAppendWord(dp, name, code, flags);
149
150 ficlLockDictionary(FALSE);
151 return 0;
152}
153
154
155/**************************************************************************
156 f i c l E x e c
157** Evaluates a block of input text in the context of the
158** specified interpreter. Emits any requested output to the
159** interpreter's output function.
160**
161** Contains the "inner interpreter" code in a tight loop
162**
163** Returns one of the VM_XXXX codes defined in ficl.h:
164** VM_OUTOFTEXT is the normal exit condition
165** VM_ERREXIT means that the interp encountered a syntax error
166** and the vm has been reset to recover (some or all
167** of the text block got ignored
168** VM_USEREXIT means that the user executed the "bye" command
169** to shut down the interpreter. This would be a good
170** time to delete the vm, etc -- or you can ignore this
171** signal.
172**************************************************************************/
173int ficlExec(FICL_VM *pVM, char *pText, INT32 size)
174{
175 int except;
176 FICL_WORD *tempFW;
177 jmp_buf vmState;
178 jmp_buf *oldState;
179 TIB saveTib;
180
181 assert(pVM);
182
183 vmPushTib(pVM, pText, size, &saveTib);
184
185 /*
186 ** Save and restore VM's jmp_buf to enable nested calls to ficlExec
187 */
188 oldState = pVM->pState;
189 pVM->pState = &vmState; /* This has to come before the setjmp! */
190 except = setjmp(vmState);
191
192 switch (except)
193 {
194 case 0:
195 if (pVM->fRestart)
196 {
197 pVM->fRestart = 0;
198 pVM->runningWord->code(pVM);
199 }
200
201 /*
202 ** the mysterious inner interpreter...
203 ** vmThrow gets you out of this loop with a longjmp()
204 */
205 for (;;)
206 {
207 tempFW = *pVM->ip++;
208 /*
209 ** inline code for
210 ** vmExecute(pVM, tempFW);
211 */
212 pVM->runningWord = tempFW;
213 tempFW->code(pVM);
214 }
215
216 break;
217
218 case VM_RESTART:
219 pVM->fRestart = 1;
220 except = VM_OUTOFTEXT;
221 break;
222
223 case VM_OUTOFTEXT:
224#ifdef TESTMAIN
225 if ((pVM->state != COMPILE) && (pVM->sourceID.i == 0))
226 ficlTextOut(pVM, FICL_PROMPT, 0);
227#endif
228 break;
229
230 case VM_USEREXIT:
231 break;
232
233 case VM_QUIT:
234 if (pVM->state == COMPILE)
235 dictAbortDefinition(dp);
236 vmQuit(pVM);
237 break;
238
239 case VM_ERREXIT:
240 case VM_ABORT:
241 case VM_ABORTQ:
242 default: /* user defined exit code?? */
243 if (pVM->state == COMPILE)
244 {
245 dictAbortDefinition(dp);
246#if FICL_WANT_LOCALS
247 dictEmpty(localp, localp->pForthWords->size);
248#endif
249 }
250 dictResetSearchOrder(dp);
251 vmReset(pVM);
252 break;
253 }
254
255 pVM->pState = oldState;
256 vmPopTib(pVM, &saveTib);
257 return (except);
258}
259
260/**************************************************************************
261 f i c l E x e c F D
262** reads in text from file fd and passes it to ficlExec()
263 * returns VM_OUTOFTEXT on success or the ficlExec() error code on
264 * failure.
265 */
266#define nLINEBUF 256
267int ficlExecFD(FICL_VM *pVM, int fd)
268{
269 char cp[nLINEBUF];
270 int i, nLine = 0, rval = VM_OUTOFTEXT;
271 char ch;
272 CELL id;
273
274 id = pVM->sourceID;
275 pVM->sourceID.i = fd;
276
277 /* feed each line to ficlExec */
278 while (1) {
279 int status, i;
280
281 i = 0;
282 while ((status = read(fd, &ch, 1)) > 0 && ch != '\n')
283 cp[i++] = ch;
284 nLine++;
285 if (!i) {
286 if (status < 1)
287 break;
288 continue;
289 }
290 if ((rval = ficlExec(pVM, cp, i)) >= VM_ERREXIT)
291 {
292 pVM->sourceID = id;
293 vmThrowErr(pVM, "ficlExecFD: Error at line %d", nLine);
294 break;
295 }
296 }
297 /*
298 ** Pass an empty line with SOURCE-ID == 0 to flush
299 ** any pending REFILLs (as required by FILE wordset)
300 */
301 pVM->sourceID.i = -1;
302 ficlExec(pVM, "", 0);
303
304 pVM->sourceID = id;
305 return rval;
306}
307
308/**************************************************************************
309 f i c l L o o k u p
310** Look in the system dictionary for a match to the given name. If
311** found, return the address of the corresponding FICL_WORD. Otherwise
312** return NULL.
313**************************************************************************/
314FICL_WORD *ficlLookup(char *name)
315{
316 STRINGINFO si;
317 SI_PSZ(si, name);
318 return dictLookup(dp, si);
319}
320
321
322/**************************************************************************
323 f i c l G e t D i c t
324** Returns the address of the system dictionary
325**************************************************************************/
326FICL_DICT *ficlGetDict(void)
327{
328 return dp;
329}
330
331
332/**************************************************************************
333 f i c l G e t E n v
334** Returns the address of the system environment space
335**************************************************************************/
336FICL_DICT *ficlGetEnv(void)
337{
338 return envp;
339}
340
341
342/**************************************************************************
343 f i c l S e t E n v
344** Create an environment variable with a one-CELL payload. ficlSetEnvD
345** makes one with a two-CELL payload.
346**************************************************************************/
347void ficlSetEnv(char *name, UNS32 value)
348{
349 STRINGINFO si;
350 FICL_WORD *pFW;
351
352 SI_PSZ(si, name);
353 pFW = dictLookup(envp, si);
354
355 if (pFW == NULL)
356 {
357 dictAppendWord(envp, name, constantParen, FW_DEFAULT);
358 dictAppendCell(envp, LVALUEtoCELL(value));
359 }
360 else
361 {
362 pFW->param[0] = LVALUEtoCELL(value);
363 }
364
365 return;
366}
367
368void ficlSetEnvD(char *name, UNS32 hi, UNS32 lo)
369{
370 FICL_WORD *pFW;
371 STRINGINFO si;
372 SI_PSZ(si, name);
373 pFW = dictLookup(envp, si);
374
375 if (pFW == NULL)
376 {
377 dictAppendWord(envp, name, twoConstParen, FW_DEFAULT);
378 dictAppendCell(envp, LVALUEtoCELL(lo));
379 dictAppendCell(envp, LVALUEtoCELL(hi));
380 }
381 else
382 {
383 pFW->param[0] = LVALUEtoCELL(lo);
384 pFW->param[1] = LVALUEtoCELL(hi);
385 }
386
387 return;
388}
389
390
391/**************************************************************************
392 f i c l G e t L o c
393** Returns the address of the system locals dictionary. This dict is
394** only used during compilation, and is shared by all VMs.
395**************************************************************************/
396#if FICL_WANT_LOCALS
397FICL_DICT *ficlGetLoc(void)
398{
399 return localp;
400}
401#endif
402
403
404/**************************************************************************
405 f i c l T e r m S y s t e m
406** Tear the system down by deleting the dictionaries and all VMs.
407** This saves you from having to keep track of all that stuff.
408**************************************************************************/
409void ficlTermSystem(void)
410{
411 if (dp)
412 dictDelete(dp);
413 dp = NULL;
414
415 if (envp)
416 dictDelete(envp);
417 envp = NULL;
418
419#if FICL_WANT_LOCALS
420 if (localp)
421 dictDelete(localp);
422 localp = NULL;
423#endif
424
425 while (vmList != NULL)
426 {
427 FICL_VM *pVM = vmList;
428 vmList = vmList->link;
429 vmDelete(pVM);
430 }
431
432 return;
433}