xref: /freebsd/stand/ficl/ficl.h (revision d7d962ead0b6e5e8a39202d0590022082bf5bfb6)
1 /*******************************************************************
2 ** f i c l . h
3 ** Forth Inspired Command Language
4 ** Author: John Sadler (john_sadler@alum.mit.edu)
5 ** Created: 19 July 1997
6 ** Dedicated to RHS, in loving memory
7 ** $Id: ficl.h,v 1.18 2001/12/05 07:21:34 jsadler Exp $
8 *******************************************************************/
9 /*
10 ** Copyright (c) 1997-2001 John Sadler (john_sadler@alum.mit.edu)
11 ** All rights reserved.
12 **
13 ** Get the latest Ficl release at http://ficl.sourceforge.net
14 **
15 ** I am interested in hearing from anyone who uses ficl. If you have
16 ** a problem, a success story, a defect, an enhancement request, or
17 ** if you would like to contribute to the ficl release, please
18 ** contact me by email at the address above.
19 **
20 ** L I C E N S E  and  D I S C L A I M E R
21 **
22 ** Redistribution and use in source and binary forms, with or without
23 ** modification, are permitted provided that the following conditions
24 ** are met:
25 ** 1. Redistributions of source code must retain the above copyright
26 **    notice, this list of conditions and the following disclaimer.
27 ** 2. Redistributions in binary form must reproduce the above copyright
28 **    notice, this list of conditions and the following disclaimer in the
29 **    documentation and/or other materials provided with the distribution.
30 **
31 ** THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
32 ** ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
33 ** IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
34 ** ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
35 ** FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
36 ** DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
37 ** OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
38 ** HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
39 ** LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
40 ** OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
41 ** SUCH DAMAGE.
42 */
43 
44 /* $FreeBSD$ */
45 
46 #if !defined (__FICL_H__)
47 #define __FICL_H__
48 /*
49 ** Ficl (Forth-inspired command language) is an ANS Forth
50 ** interpreter written in C. Unlike traditional Forths, this
51 ** interpreter is designed to be embedded into other systems
52 ** as a command/macro/development prototype language.
53 **
54 ** Where Forths usually view themselves as the center of the system
55 ** and expect the rest of the system to be coded in Forth, Ficl
56 ** acts as a component of the system. It is easy to export
57 ** code written in C or ASM to Ficl in the style of TCL, or to invoke
58 ** Ficl code from a compiled module. This allows you to do incremental
59 ** development in a way that combines the best features of threaded
60 ** languages (rapid development, quick code/test/debug cycle,
61 ** reasonably fast) with the best features of C (everyone knows it,
62 ** easier to support large blocks of code, efficient, type checking).
63 **
64 ** Ficl provides facilities for interoperating
65 ** with programs written in C: C functions can be exported to Ficl,
66 ** and Ficl commands can be executed via a C calling interface. The
67 ** interpreter is re-entrant, so it can be used in multiple instances
68 ** in a multitasking system. Unlike Forth, Ficl's outer interpreter
69 ** expects a text block as input, and returns to the caller after each
70 ** text block, so the "data pump" is somewhere in external code. This
71 ** is more like TCL than Forth, which usually expcets to be at the center
72 ** of the system, requesting input at its convenience. Each Ficl virtual
73 ** machine can be bound to a different I/O channel, and is independent
74 ** of all others in in the same address space except that all virtual
75 ** machines share a common dictionary (a sort or open symbol table that
76 ** defines all of the elements of the language).
77 **
78 ** Code is written in ANSI C for portability.
79 **
80 ** Summary of Ficl features and constraints:
81 ** - Standard: Implements the ANSI Forth CORE word set and part
82 **   of the CORE EXT word-set, SEARCH and SEARCH EXT, TOOLS and
83 **   TOOLS EXT, LOCAL and LOCAL ext and various extras.
84 ** - Extensible: you can export code written in Forth, C,
85 **   or asm in a straightforward way. Ficl provides open
86 **   facilities for extending the language in an application
87 **   specific way. You can even add new control structures!
88 ** - Ficl and C can interact in two ways: Ficl can encapsulate
89 **   C code, or C code can invoke Ficl code.
90 ** - Thread-safe, re-entrant: The shared system dictionary
91 **   uses a locking mechanism that you can either supply
92 **   or stub out to provide exclusive access. Each Ficl
93 **   virtual machine has an otherwise complete state, and
94 **   each can be bound to a separate I/O channel (or none at all).
95 ** - Simple encapsulation into existing systems: a basic implementation
96 **   requires three function calls (see the example program in testmain.c).
97 ** - ROMable: Ficl is designed to work in RAM-based and ROM code / RAM data
98 **   environments. It does require somewhat more memory than a pure
99 **   ROM implementation because it builds its system dictionary in
100 **   RAM at startup time.
101 ** - Written an ANSI C to be as simple as I can make it to understand,
102 **   support, debug, and port. Compiles without complaint at /Az /W4
103 **   (require ANSI C, max warnings) under Microsoft VC++ 5.
104 ** - Does full 32 bit math (but you need to implement
105 **   two mixed precision math primitives (see sysdep.c))
106 ** - Indirect threaded interpreter is not the fastest kind of
107 **   Forth there is (see pForth 68K for a really fast subroutine
108 **   threaded interpreter), but it's the cleanest match to a
109 **   pure C implementation.
110 **
111 ** P O R T I N G   F i c l
112 **
113 ** To install Ficl on your target system, you need an ANSI C compiler
114 ** and its runtime library. Inspect the system dependent macros and
115 ** functions in sysdep.h and sysdep.c and edit them to suit your
116 ** system. For example, INT16 is a short on some compilers and an
117 ** int on others. Check the default CELL alignment controlled by
118 ** FICL_ALIGN. If necessary, add new definitions of ficlMalloc, ficlFree,
119 ** ficlLockDictionary, and ficlTextOut to work with your operating system.
120 ** Finally, use testmain.c as a guide to installing the Ficl system and
121 ** one or more virtual machines into your code. You do not need to include
122 ** testmain.c in your build.
123 **
124 ** T o   D o   L i s t
125 **
126 ** 1. Unimplemented system dependent CORE word: key
127 ** 2. Ficl uses the PAD in some CORE words - this violates the standard,
128 **    but it's cleaner for a multithreaded system. I'll have to make a
129 **    second pad for reference by the word PAD to fix this.
130 **
131 ** F o r   M o r e   I n f o r m a t i o n
132 **
133 ** Web home of ficl
134 **   http://ficl.sourceforge.net
135 ** Check this website for Forth literature (including the ANSI standard)
136 **   http://www.taygeta.com/forthlit.html
137 ** and here for software and more links
138 **   http://www.taygeta.com/forth.html
139 **
140 ** Obvious Performance enhancement opportunities
141 ** Compile speed
142 ** - work on interpret speed
143 ** - turn off locals (FICL_WANT_LOCALS)
144 ** Interpret speed
145 ** - Change inner interpreter (and everything else)
146 **   so that a definition is a list of pointers to functions
147 **   and inline data rather than pointers to words. This gets
148 **   rid of vm->runningWord and a level of indirection in the
149 **   inner loop. I'll look at it for ficl 3.0
150 ** - Make the main hash table a bigger prime (HASHSIZE)
151 ** - FORGET about twiddling the hash function - my experience is
152 **   that that is a waste of time.
153 ** - Eliminate the need to pass the pVM parameter on the stack
154 **   by dedicating a register to it. Most words need access to the
155 **   vm, but the parameter passing overhead can be reduced. One way
156 **   requires that the host OS have a task switch callout. Create
157 **   a global variable for the running VM and refer to it in words
158 **   that need VM access. Alternative: use thread local storage.
159 **   For single threaded implementations, you can just use a global.
160 **   The first two solutions create portability problems, so I
161 **   haven't considered doing them. Another possibility is to
162 **   declare the pVm parameter to be "register", and hope the compiler
163 **   pays attention.
164 **
165 */
166 
167 /*
168 ** Revision History:
169 **
170 ** 15 Apr 1999 (sadler) Merged FreeBSD changes for exception wordset and
171 ** counted strings in ficlExec.
172 ** 12 Jan 1999 (sobral) Corrected EVALUATE behavior. Now TIB has an
173 ** "end" field, and all words respect this. ficlExec is passed a "size"
174 ** of TIB, as well as vmPushTib. This size is used to calculate the "end"
175 ** of the string, ie, base+size. If the size is not known, pass -1.
176 **
177 ** 10 Jan 1999 (sobral) EXCEPTION word set has been added, and existing
178 ** words has been modified to conform to EXCEPTION EXT word set.
179 **
180 ** 27 Aug 1998 (sadler) testing and corrections for LOCALS, LOCALS EXT,
181 **  SEARCH / SEARCH EXT, TOOLS / TOOLS EXT.
182 **  Added .X to display in hex, PARSE and PARSE-WORD to supplement WORD,
183 **  EMPTY to clear stack.
184 **
185 ** 29 jun 1998 (sadler) added variable sized hash table support
186 **  and ANS Forth optional SEARCH & SEARCH EXT word set.
187 ** 26 May 1998 (sadler)
188 **  FICL_PROMPT macro
189 ** 14 April 1998 (sadler) V1.04
190 **  Ficlwin: Windows version, Skip Carter's Linux port
191 ** 5 March 1998 (sadler) V1.03
192 **  Bug fixes -- passes John Ryan's ANS test suite "core.fr"
193 **
194 ** 24 February 1998 (sadler) V1.02
195 ** -Fixed bugs in <# # #>
196 ** -Changed FICL_WORD so that storage for the name characters
197 **  can be allocated from the dictionary as needed rather than
198 **  reserving 32 bytes in each word whether needed or not -
199 **  this saved 50% of the dictionary storage requirement.
200 ** -Added words in testmain for Win32 functions system,chdir,cwd,
201 **  also added a word that loads and evaluates a file.
202 **
203 ** December 1997 (sadler)
204 ** -Added VM_RESTART exception handling in ficlExec -- this lets words
205 **  that require additional text to succeed (like :, create, variable...)
206 **  recover gracefully from an empty input buffer rather than emitting
207 **  an error message. Definitions can span multiple input blocks with
208 **  no restrictions.
209 ** -Changed #include order so that <assert.h> is included in sysdep.h,
210 **  and sysdep is included in all other files. This lets you define
211 **  NDEBUG in sysdep.h to disable assertions if you want to.
212 ** -Make PC specific system dependent code conditional on _M_IX86
213 **  defined so that ports can coexist in sysdep.h/sysdep.c
214 */
215 
216 #ifdef __cplusplus
217 extern "C" {
218 #endif
219 
220 #include "sysdep.h"
221 #include <limits.h> /* UCHAR_MAX */
222 
223 /*
224 ** Forward declarations... read on.
225 */
226 struct ficl_word;
227 typedef struct ficl_word FICL_WORD;
228 struct vm;
229 typedef struct vm FICL_VM;
230 struct ficl_dict;
231 typedef struct ficl_dict FICL_DICT;
232 struct ficl_system;
233 typedef struct ficl_system FICL_SYSTEM;
234 struct ficl_system_info;
235 typedef struct ficl_system_info FICL_SYSTEM_INFO;
236 
237 /*
238 ** the Good Stuff starts here...
239 */
240 #define FICL_VER        "3.03"
241 #define FICL_VER_MAJOR  3
242 #define FICL_VER_MINOR  3
243 #if !defined (FICL_PROMPT)
244 #define FICL_PROMPT "ok> "
245 #endif
246 
247 /*
248 ** ANS Forth requires false to be zero, and true to be the ones
249 ** complement of false... that unifies logical and bitwise operations
250 ** nicely.
251 */
252 #define FICL_TRUE  (~(FICL_UNS)0)
253 #define FICL_FALSE (0)
254 #define FICL_BOOL(x) ((x) ? FICL_TRUE : FICL_FALSE)
255 
256 
257 /*
258 ** A CELL is the main storage type. It must be large enough
259 ** to contain a pointer or a scalar. In order to accommodate
260 ** 32 bit and 64 bit processors, use abstract types for int,
261 ** unsigned, and float.
262 */
263 typedef union _cell
264 {
265     FICL_INT i;
266     FICL_UNS u;
267 #if (FICL_WANT_FLOAT)
268     FICL_FLOAT f;
269 #endif
270     void *p;
271     void (*fn)(void);
272 } CELL;
273 
274 /*
275 ** LVALUEtoCELL does a little pointer trickery to cast any CELL sized
276 ** lvalue (informal definition: an expression whose result has an
277 ** address) to CELL. Remember that constants and casts are NOT
278 ** themselves lvalues!
279 */
280 #define LVALUEtoCELL(v) (*(CELL *)&v)
281 
282 /*
283 ** PTRtoCELL is a cast through void * intended to satisfy the
284 ** most outrageously pedantic compiler... (I won't mention
285 ** its name)
286 */
287 #define PTRtoCELL (CELL *)(void *)
288 #define PTRtoSTRING (FICL_STRING *)(void *)
289 
290 /*
291 ** Strings in FICL are stored in Pascal style - with a count
292 ** preceding the text. We'll also NULL-terminate them so that
293 ** they work with the usual C lib string functions. (Belt &
294 ** suspenders? You decide.)
295 ** STRINGINFO hides the implementation with a couple of
296 ** macros for use in internal routines.
297 */
298 
299 typedef unsigned char FICL_COUNT;
300 #define FICL_STRING_MAX UCHAR_MAX
301 typedef struct _ficl_string
302 {
303     FICL_COUNT count;
304     char text[1];
305 } FICL_STRING;
306 
307 typedef struct
308 {
309     FICL_UNS count;
310     char *cp;
311 } STRINGINFO;
312 
313 #define SI_COUNT(si) (si.count)
314 #define SI_PTR(si)   (si.cp)
315 #define SI_SETLEN(si, len) (si.count = (FICL_UNS)(len))
316 #define SI_SETPTR(si, ptr) (si.cp = (char *)(ptr))
317 /*
318 ** Init a STRINGINFO from a pointer to NULL-terminated string
319 */
320 #define SI_PSZ(si, psz) \
321             {si.cp = psz; si.count = (FICL_COUNT)strlen(psz);}
322 /*
323 ** Init a STRINGINFO from a pointer to FICL_STRING
324 */
325 #define SI_PFS(si, pfs) \
326             {si.cp = pfs->text; si.count = pfs->count;}
327 
328 /*
329 ** Ficl uses this little structure to hold the address of
330 ** the block of text it's working on and an index to the next
331 ** unconsumed character in the string. Traditionally, this is
332 ** done by a Text Input Buffer, so I've called this struct TIB.
333 **
334 ** Since this structure also holds the size of the input buffer,
335 ** and since evaluate requires that, let's put the size here.
336 ** The size is stored as an end-pointer because that is what the
337 ** null-terminated string aware functions find most easy to deal
338 ** with.
339 ** Notice, though, that nobody really uses this except evaluate,
340 ** so it might just be moved to FICL_VM instead. (sobral)
341 */
342 typedef struct
343 {
344     FICL_INT index;
345     char *end;
346     char *cp;
347 } TIB;
348 
349 
350 /*
351 ** Stacks get heavy use in Ficl and Forth...
352 ** Each virtual machine implements two of them:
353 ** one holds parameters (data), and the other holds return
354 ** addresses and control flow information for the virtual
355 ** machine. (Note: C's automatic stack is implicitly used,
356 ** but not modeled because it doesn't need to be...)
357 ** Here's an abstract type for a stack
358 */
359 typedef struct _ficlStack
360 {
361     FICL_UNS nCells;    /* size of the stack */
362     CELL *pFrame;       /* link reg for stack frame */
363     CELL *sp;           /* stack pointer */
364     CELL base[1];       /* Top of stack */
365 } FICL_STACK;
366 
367 /*
368 ** Stack methods... many map closely to required Forth words.
369 */
370 FICL_STACK *stackCreate   (unsigned nCells);
371 void        stackDelete   (FICL_STACK *pStack);
372 int         stackDepth    (FICL_STACK *pStack);
373 void        stackDrop     (FICL_STACK *pStack, int n);
374 CELL        stackFetch    (FICL_STACK *pStack, int n);
375 CELL        stackGetTop   (FICL_STACK *pStack);
376 void        stackLink     (FICL_STACK *pStack, int nCells);
377 void        stackPick     (FICL_STACK *pStack, int n);
378 CELL        stackPop      (FICL_STACK *pStack);
379 void       *stackPopPtr   (FICL_STACK *pStack);
380 FICL_UNS    stackPopUNS   (FICL_STACK *pStack);
381 FICL_INT    stackPopINT   (FICL_STACK *pStack);
382 void        stackPush     (FICL_STACK *pStack, CELL c);
383 void        stackPushPtr  (FICL_STACK *pStack, void *ptr);
384 void        stackPushUNS  (FICL_STACK *pStack, FICL_UNS u);
385 void        stackPushINT  (FICL_STACK *pStack, FICL_INT i);
386 void        stackReset    (FICL_STACK *pStack);
387 void        stackRoll     (FICL_STACK *pStack, int n);
388 void        stackSetTop   (FICL_STACK *pStack, CELL c);
389 void        stackStore    (FICL_STACK *pStack, int n, CELL c);
390 void        stackUnlink   (FICL_STACK *pStack);
391 
392 #if (FICL_WANT_FLOAT)
393 float       stackPopFloat (FICL_STACK *pStack);
394 void        stackPushFloat(FICL_STACK *pStack, FICL_FLOAT f);
395 #endif
396 
397 /*
398 ** Shortcuts (Guy Carver)
399 */
400 #define PUSHPTR(p)   stackPushPtr(pVM->pStack,p)
401 #define PUSHUNS(u)   stackPushUNS(pVM->pStack,u)
402 #define PUSHINT(i)   stackPushINT(pVM->pStack,i)
403 #define PUSHFLOAT(f) stackPushFloat(pVM->fStack,f)
404 #define PUSH(c)      stackPush(pVM->pStack,c)
405 #define POPPTR()     stackPopPtr(pVM->pStack)
406 #define POPUNS()     stackPopUNS(pVM->pStack)
407 #define POPINT()     stackPopINT(pVM->pStack)
408 #define POPFLOAT()   stackPopFloat(pVM->fStack)
409 #define POP()        stackPop(pVM->pStack)
410 #define GETTOP()     stackGetTop(pVM->pStack)
411 #define SETTOP(c)    stackSetTop(pVM->pStack,LVALUEtoCELL(c))
412 #define GETTOPF()    stackGetTop(pVM->fStack)
413 #define SETTOPF(c)   stackSetTop(pVM->fStack,LVALUEtoCELL(c))
414 #define STORE(n,c)   stackStore(pVM->pStack,n,LVALUEtoCELL(c))
415 #define DEPTH()      stackDepth(pVM->pStack)
416 #define DROP(n)      stackDrop(pVM->pStack,n)
417 #define DROPF(n)     stackDrop(pVM->fStack,n)
418 #define FETCH(n)     stackFetch(pVM->pStack,n)
419 #define PICK(n)      stackPick(pVM->pStack,n)
420 #define PICKF(n)     stackPick(pVM->fStack,n)
421 #define ROLL(n)      stackRoll(pVM->pStack,n)
422 #define ROLLF(n)     stackRoll(pVM->fStack,n)
423 
424 /*
425 ** The virtual machine (VM) contains the state for one interpreter.
426 ** Defined operations include:
427 ** Create & initialize
428 ** Delete
429 ** Execute a block of text
430 ** Parse a word out of the input stream
431 ** Call return, and branch
432 ** Text output
433 ** Throw an exception
434 */
435 
436 typedef FICL_WORD ** IPTYPE; /* the VM's instruction pointer */
437 
438 /*
439 ** Each VM has a placeholder for an output function -
440 ** this makes it possible to have each VM do I/O
441 ** through a different device. If you specify no
442 ** OUTFUNC, it defaults to ficlTextOut.
443 */
444 typedef void (*OUTFUNC)(FICL_VM *pVM, char *text, int fNewline);
445 
446 /*
447 ** Each VM operates in one of two non-error states: interpreting
448 ** or compiling. When interpreting, words are simply executed.
449 ** When compiling, most words in the input stream have their
450 ** addresses inserted into the word under construction. Some words
451 ** (known as IMMEDIATE) are executed in the compile state, too.
452 */
453 /* values of STATE */
454 #define INTERPRET 0
455 #define COMPILE   1
456 
457 /*
458 ** The pad is a small scratch area for text manipulation. ANS Forth
459 ** requires it to hold at least 84 characters.
460 */
461 #if !defined nPAD
462 #define nPAD 256
463 #endif
464 
465 /*
466 ** ANS Forth requires that a word's name contain {1..31} characters.
467 */
468 #if !defined nFICLNAME
469 #define nFICLNAME       31
470 #endif
471 
472 /*
473 ** OK - now we can really define the VM...
474 */
475 struct vm
476 {
477     FICL_SYSTEM    *pSys;       /* Which system this VM belongs to  */
478     FICL_VM        *link;       /* Ficl keeps a VM list for simple teardown */
479     jmp_buf        *pState;     /* crude exception mechanism...     */
480     OUTFUNC         textOut;    /* Output callback - see sysdep.c   */
481     void *          pExtend;    /* vm extension pointer for app use - initialized from FICL_SYSTEM */
482     short           fRestart;   /* Set TRUE to restart runningWord  */
483     IPTYPE          ip;         /* instruction pointer              */
484     FICL_WORD      *runningWord;/* address of currently running word (often just *(ip-1) ) */
485     FICL_UNS        state;      /* compiling or interpreting        */
486     FICL_UNS        base;       /* number conversion base           */
487     FICL_STACK     *pStack;     /* param stack                      */
488     FICL_STACK     *rStack;     /* return stack                     */
489 #if FICL_WANT_FLOAT
490     FICL_STACK     *fStack;     /* float stack (optional)           */
491 #endif
492     CELL            sourceID;   /* -1 if EVALUATE, 0 if normal input */
493     TIB             tib;        /* address of incoming text string  */
494 #if FICL_WANT_USER
495     CELL            user[FICL_USER_CELLS];
496 #endif
497     char            pad[nPAD];  /* the scratch area (see above)     */
498 };
499 
500 /*
501 ** A FICL_CODE points to a function that gets called to help execute
502 ** a word in the dictionary. It always gets passed a pointer to the
503 ** running virtual machine, and from there it can get the address
504 ** of the parameter area of the word it's supposed to operate on.
505 ** For precompiled words, the code is all there is. For user defined
506 ** words, the code assumes that the word's parameter area is a list
507 ** of pointers to the code fields of other words to execute, and
508 ** may also contain inline data. The first parameter is always
509 ** a pointer to a code field.
510 */
511 typedef void (*FICL_CODE)(FICL_VM *pVm);
512 
513 #if 0
514 #define VM_ASSERT(pVM) assert((*(pVM->ip - 1)) == pVM->runningWord)
515 #else
516 #define VM_ASSERT(pVM)
517 #endif
518 
519 /*
520 ** Ficl models memory as a contiguous space divided into
521 ** words in a linked list called the dictionary.
522 ** A FICL_WORD starts each entry in the list.
523 ** Version 1.02: space for the name characters is allotted from
524 ** the dictionary ahead of the word struct, rather than using
525 ** a fixed size array for each name.
526 */
527 struct ficl_word
528 {
529     struct ficl_word *link;     /* Previous word in the dictionary      */
530     UNS16 hash;
531     UNS8 flags;                 /* Immediate, Smudge, Compile-only      */
532     FICL_COUNT nName;           /* Number of chars in word name         */
533     char *name;                 /* First nFICLNAME chars of word name   */
534     FICL_CODE code;             /* Native code to execute the word      */
535     CELL param[1];              /* First data cell of the word          */
536 };
537 
538 /*
539 ** Worst-case size of a word header: nFICLNAME chars in name
540 */
541 #define CELLS_PER_WORD  \
542     ( (sizeof (FICL_WORD) + nFICLNAME + sizeof (CELL)) \
543                           / (sizeof (CELL)) )
544 
545 int wordIsImmediate(FICL_WORD *pFW);
546 int wordIsCompileOnly(FICL_WORD *pFW);
547 
548 /* flag values for word header */
549 #define FW_IMMEDIATE    1   /* execute me even if compiling */
550 #define FW_COMPILE      2   /* error if executed when not compiling */
551 #define FW_SMUDGE       4   /* definition in progress - hide me */
552 #define FW_ISOBJECT     8   /* word is an object or object member variable */
553 
554 #define FW_COMPIMMED    (FW_IMMEDIATE | FW_COMPILE)
555 #define FW_DEFAULT      0
556 
557 
558 /*
559 ** Exit codes for vmThrow
560 */
561 #define VM_INNEREXIT -256   /* tell ficlExecXT to exit inner loop */
562 #define VM_OUTOFTEXT -257   /* hungry - normal exit */
563 #define VM_RESTART   -258   /* word needs more text to succeed - re-run it */
564 #define VM_USEREXIT  -259   /* user wants to quit */
565 #define VM_ERREXIT   -260   /* interp found an error */
566 #define VM_BREAK     -261   /* debugger breakpoint */
567 #define VM_ABORT       -1   /* like errexit -- abort */
568 #define VM_ABORTQ      -2   /* like errexit -- abort" */
569 #define VM_QUIT       -56   /* like errexit, but leave pStack & base alone */
570 
571 
572 void        vmBranchRelative(FICL_VM *pVM, int offset);
573 FICL_VM *   vmCreate       (FICL_VM *pVM, unsigned nPStack, unsigned nRStack);
574 void        vmDelete       (FICL_VM *pVM);
575 void        vmExecute      (FICL_VM *pVM, FICL_WORD *pWord);
576 FICL_DICT  *vmGetDict      (FICL_VM *pVM);
577 char *      vmGetString    (FICL_VM *pVM, FICL_STRING *spDest, char delimiter);
578 STRINGINFO  vmGetWord      (FICL_VM *pVM);
579 STRINGINFO  vmGetWord0     (FICL_VM *pVM);
580 int         vmGetWordToPad (FICL_VM *pVM);
581 STRINGINFO  vmParseString  (FICL_VM *pVM, char delimiter);
582 STRINGINFO  vmParseStringEx(FICL_VM *pVM, char delimiter, char fSkipLeading);
583 CELL        vmPop          (FICL_VM *pVM);
584 void        vmPush         (FICL_VM *pVM, CELL c);
585 void        vmPopIP        (FICL_VM *pVM);
586 void        vmPushIP       (FICL_VM *pVM, IPTYPE newIP);
587 void        vmQuit         (FICL_VM *pVM);
588 void        vmReset        (FICL_VM *pVM);
589 void        vmSetTextOut   (FICL_VM *pVM, OUTFUNC textOut);
590 void        vmTextOut      (FICL_VM *pVM, char *text, int fNewline);
591 void        vmTextOut      (FICL_VM *pVM, char *text, int fNewline);
592 void        vmThrow        (FICL_VM *pVM, int except);
593 void        vmThrowErr     (FICL_VM *pVM, char *fmt, ...);
594 
595 #define vmGetRunningWord(pVM) ((pVM)->runningWord)
596 
597 
598 /*
599 ** The inner interpreter - coded as a macro (see note for
600 ** INLINE_INNER_LOOP in sysdep.h for complaints about VC++ 5
601 */
602 #define M_VM_STEP(pVM) \
603         FICL_WORD *tempFW = *(pVM)->ip++; \
604         (pVM)->runningWord = tempFW; \
605         tempFW->code(pVM);
606 
607 #define M_INNER_LOOP(pVM) \
608     for (;;)  { M_VM_STEP(pVM) }
609 
610 
611 #if INLINE_INNER_LOOP != 0
612 #define     vmInnerLoop(pVM) M_INNER_LOOP(pVM)
613 #else
614 void        vmInnerLoop(FICL_VM *pVM);
615 #endif
616 
617 /*
618 ** vmCheckStack needs a vm pointer because it might have to say
619 ** something if it finds a problem. Parms popCells and pushCells
620 ** correspond to the number of parameters on the left and right of
621 ** a word's stack effect comment.
622 */
623 void        vmCheckStack(FICL_VM *pVM, int popCells, int pushCells);
624 #if FICL_WANT_FLOAT
625 void        vmCheckFStack(FICL_VM *pVM, int popCells, int pushCells);
626 #endif
627 
628 /*
629 ** TIB access routines...
630 ** ANS forth seems to require the input buffer to be represented
631 ** as a pointer to the start of the buffer, and an index to the
632 ** next character to read.
633 ** PushTib points the VM to a new input string and optionally
634 **  returns a copy of the current state
635 ** PopTib restores the TIB state given a saved TIB from PushTib
636 ** GetInBuf returns a pointer to the next unused char of the TIB
637 */
638 void        vmPushTib  (FICL_VM *pVM, char *text, FICL_INT nChars, TIB *pSaveTib);
639 void        vmPopTib   (FICL_VM *pVM, TIB *pTib);
640 #define     vmGetInBuf(pVM)      ((pVM)->tib.cp + (pVM)->tib.index)
641 #define     vmGetInBufLen(pVM)   ((pVM)->tib.end - (pVM)->tib.cp)
642 #define     vmGetInBufEnd(pVM)   ((pVM)->tib.end)
643 #define     vmGetTibIndex(pVM)    (pVM)->tib.index
644 #define     vmSetTibIndex(pVM, i) (pVM)->tib.index = i
645 #define     vmUpdateTib(pVM, str) (pVM)->tib.index = (str) - (pVM)->tib.cp
646 
647 /*
648 ** Generally useful string manipulators omitted by ANSI C...
649 ** ltoa complements strtol
650 */
651 #if defined(_WIN32) && !FICL_MAIN
652 /* #SHEESH
653 ** Why do Microsoft Meatballs insist on contaminating
654 ** my namespace with their string functions???
655 */
656 #pragma warning(disable: 4273)
657 #endif
658 
659 int        isPowerOfTwo(FICL_UNS u);
660 
661 char       *ltoa( FICL_INT value, char *string, int radix );
662 char       *ultoa(FICL_UNS value, char *string, int radix );
663 char        digit_to_char(int value);
664 char       *strrev( char *string );
665 char       *skipSpace(char *cp, char *end);
666 char       *caseFold(char *cp);
667 int         strincmp(char *cp1, char *cp2, FICL_UNS count);
668 
669 #if defined(_WIN32) && !FICL_MAIN
670 #pragma warning(default: 4273)
671 #endif
672 
673 /*
674 ** Ficl hash table - variable size.
675 ** assert(size > 0)
676 ** If size is 1, the table degenerates into a linked list.
677 ** A WORDLIST (see the search order word set in DPANS) is
678 ** just a pointer to a FICL_HASH in this implementation.
679 */
680 #if !defined HASHSIZE /* Default size of hash table. For most uniform */
681 #define HASHSIZE 241  /*   performance, use a prime number!   */
682 #endif
683 
684 typedef struct ficl_hash
685 {
686     struct ficl_hash *link;  /* link to parent class wordlist for OO */
687     char      *name;         /* optional pointer to \0 terminated wordlist name */
688     unsigned   size;         /* number of buckets in the hash */
689     FICL_WORD *table[1];
690 } FICL_HASH;
691 
692 void        hashForget    (FICL_HASH *pHash, void *where);
693 UNS16       hashHashCode  (STRINGINFO si);
694 void        hashInsertWord(FICL_HASH *pHash, FICL_WORD *pFW);
695 FICL_WORD  *hashLookup    (FICL_HASH *pHash, STRINGINFO si, UNS16 hashCode);
696 void        hashReset     (FICL_HASH *pHash);
697 
698 /*
699 ** A Dictionary is a linked list of FICL_WORDs. It is also Ficl's
700 ** memory model. Description of fields:
701 **
702 ** here -- points to the next free byte in the dictionary. This
703 **      pointer is forced to be CELL-aligned before a definition is added.
704 **      Do not assume any specific alignment otherwise - Use dictAlign().
705 **
706 ** smudge -- pointer to word currently being defined (or last defined word)
707 **      If the definition completes successfully, the word will be
708 **      linked into the hash table. If unsuccessful, dictUnsmudge
709 **      uses this pointer to restore the previous state of the dictionary.
710 **      Smudge prevents unintentional recursion as a side-effect: the
711 **      dictionary search algo examines only completed definitions, so a
712 **      word cannot invoke itself by name. See the ficl word "recurse".
713 **      NOTE: smudge always points to the last word defined. IMMEDIATE
714 **      makes use of this fact. Smudge is initially NULL.
715 **
716 ** pForthWords -- pointer to the default wordlist (FICL_HASH).
717 **      This is the initial compilation list, and contains all
718 **      ficl's precompiled words.
719 **
720 ** pCompile -- compilation wordlist - initially equal to pForthWords
721 ** pSearch  -- array of pointers to wordlists. Managed as a stack.
722 **      Highest index is the first list in the search order.
723 ** nLists   -- number of lists in pSearch. nLists-1 is the highest
724 **      filled slot in pSearch, and points to the first wordlist
725 **      in the search order
726 ** size -- number of cells in the dictionary (total)
727 ** dict -- start of data area. Must be at the end of the struct.
728 */
729 struct ficl_dict
730 {
731     CELL *here;
732     FICL_WORD *smudge;
733     FICL_HASH *pForthWords;
734     FICL_HASH *pCompile;
735     FICL_HASH *pSearch[FICL_DEFAULT_VOCS];
736     int        nLists;
737     unsigned   size;    /* Number of cells in dict (total)*/
738     CELL       *dict;   /* Base of dictionary memory      */
739 };
740 
741 void       *alignPtr(void *ptr);
742 void        dictAbortDefinition(FICL_DICT *pDict);
743 void        dictAlign      (FICL_DICT *pDict);
744 int         dictAllot      (FICL_DICT *pDict, int n);
745 int         dictAllotCells (FICL_DICT *pDict, int nCells);
746 void        dictAppendCell (FICL_DICT *pDict, CELL c);
747 void        dictAppendChar (FICL_DICT *pDict, char c);
748 FICL_WORD  *dictAppendWord (FICL_DICT *pDict,
749                            char *name,
750                            FICL_CODE pCode,
751                            UNS8 flags);
752 FICL_WORD  *dictAppendWord2(FICL_DICT *pDict,
753                            STRINGINFO si,
754                            FICL_CODE pCode,
755                            UNS8 flags);
756 void        dictAppendUNS  (FICL_DICT *pDict, FICL_UNS u);
757 int         dictCellsAvail (FICL_DICT *pDict);
758 int         dictCellsUsed  (FICL_DICT *pDict);
759 void        dictCheck      (FICL_DICT *pDict, FICL_VM *pVM, int n);
760 void        dictCheckThreshold(FICL_DICT* dp);
761 FICL_DICT  *dictCreate(unsigned nCELLS);
762 FICL_DICT  *dictCreateHashed(unsigned nCells, unsigned nHash);
763 FICL_HASH  *dictCreateWordlist(FICL_DICT *dp, int nBuckets);
764 void        dictDelete     (FICL_DICT *pDict);
765 void        dictEmpty      (FICL_DICT *pDict, unsigned nHash);
766 #if FICL_WANT_FLOAT
767 void        dictHashSummary(FICL_VM *pVM);
768 #endif
769 int         dictIncludes   (FICL_DICT *pDict, void *p);
770 FICL_WORD  *dictLookup     (FICL_DICT *pDict, STRINGINFO si);
771 #if FICL_WANT_LOCALS
772 FICL_WORD  *ficlLookupLoc  (FICL_SYSTEM *pSys, STRINGINFO si);
773 #endif
774 void        dictResetSearchOrder(FICL_DICT *pDict);
775 void        dictSetFlags   (FICL_DICT *pDict, UNS8 set, UNS8 clr);
776 void        dictSetImmediate(FICL_DICT *pDict);
777 void        dictUnsmudge   (FICL_DICT *pDict);
778 CELL       *dictWhere      (FICL_DICT *pDict);
779 
780 
781 /*
782 ** P A R S E   S T E P
783 ** (New for 2.05)
784 ** See words.c: interpWord
785 ** By default, ficl goes through two attempts to parse each token from its input
786 ** stream: it first attempts to match it with a word in the dictionary, and
787 ** if that fails, it attempts to convert it into a number. This mechanism is now
788 ** extensible by additional steps. This allows extensions like floating point and
789 ** double number support to be factored cleanly.
790 **
791 ** Each parse step is a function that receives the next input token as a STRINGINFO.
792 ** If the parse step matches the token, it must apply semantics to the token appropriate
793 ** to the present value of VM.state (compiling or interpreting), and return FICL_TRUE.
794 ** Otherwise it returns FICL_FALSE. See words.c: isNumber for an example
795 **
796 ** Note: for the sake of efficiency, it's a good idea both to limit the number
797 ** of parse steps and to code each parse step so that it rejects tokens that
798 ** do not match as quickly as possible.
799 */
800 
801 typedef int (*FICL_PARSE_STEP)(FICL_VM *pVM, STRINGINFO si);
802 
803 /*
804 ** Appends a parse step function to the end of the parse list (see
805 ** FICL_PARSE_STEP notes in ficl.h for details). Returns 0 if successful,
806 ** nonzero if there's no more room in the list. Each parse step is a word in
807 ** the dictionary. Precompiled parse steps can use (PARSE-STEP) as their
808 ** CFA - see parenParseStep in words.c.
809 */
810 int  ficlAddParseStep(FICL_SYSTEM *pSys, FICL_WORD *pFW); /* ficl.c */
811 void ficlAddPrecompiledParseStep(FICL_SYSTEM *pSys, char *name, FICL_PARSE_STEP pStep);
812 void ficlListParseSteps(FICL_VM *pVM);
813 
814 /*
815 ** FICL_BREAKPOINT record.
816 ** origXT - if NULL, this breakpoint is unused. Otherwise it stores the xt
817 ** that the breakpoint overwrote. This is restored to the dictionary when the
818 ** BP executes or gets cleared
819 ** address - the location of the breakpoint (address of the instruction that
820 **           has been replaced with the breakpoint trap
821 ** origXT  - The original contents of the location with the breakpoint
822 ** Note: address is NULL when this breakpoint is empty
823 */
824 typedef struct FICL_BREAKPOINT
825 {
826     void      *address;
827     FICL_WORD *origXT;
828 } FICL_BREAKPOINT;
829 
830 
831 /*
832 ** F I C L _ S Y S T E M
833 ** The top level data structure of the system - ficl_system ties a list of
834 ** virtual machines with their corresponding dictionaries. Ficl 3.0 will
835 ** support multiple Ficl systems, allowing multiple concurrent sessions
836 ** to separate dictionaries with some constraints.
837 ** The present model allows multiple sessions to one dictionary provided
838 ** you implement ficlLockDictionary() as specified in sysdep.h
839 ** Note: the pExtend pointer is there to provide context for applications. It is copied
840 ** to each VM's pExtend field as that VM is created.
841 */
842 struct ficl_system
843 {
844     FICL_SYSTEM *link;
845     void *pExtend;      /* Initializes VM's pExtend pointer (for application use) */
846     FICL_VM *vmList;
847     FICL_DICT *dp;
848     FICL_DICT *envp;
849 #ifdef FICL_WANT_LOCALS
850     FICL_DICT *localp;
851 #endif
852     FICL_WORD *pInterp[3];
853     FICL_WORD *parseList[FICL_MAX_PARSE_STEPS];
854 	OUTFUNC    textOut;
855 
856 	FICL_WORD *pBranchParen;
857 	FICL_WORD *pDoParen;
858 	FICL_WORD *pDoesParen;
859 	FICL_WORD *pExitInner;
860 	FICL_WORD *pExitParen;
861 	FICL_WORD *pBranch0;
862 	FICL_WORD *pInterpret;
863 	FICL_WORD *pLitParen;
864 	FICL_WORD *pTwoLitParen;
865 	FICL_WORD *pLoopParen;
866 	FICL_WORD *pPLoopParen;
867 	FICL_WORD *pQDoParen;
868 	FICL_WORD *pSemiParen;
869 	FICL_WORD *pOfParen;
870 	FICL_WORD *pStore;
871 	FICL_WORD *pDrop;
872 	FICL_WORD *pCStringLit;
873 	FICL_WORD *pStringLit;
874 
875 #if FICL_WANT_LOCALS
876 	FICL_WORD *pGetLocalParen;
877 	FICL_WORD *pGet2LocalParen;
878 	FICL_WORD *pGetLocal0;
879 	FICL_WORD *pGetLocal1;
880 	FICL_WORD *pToLocalParen;
881 	FICL_WORD *pTo2LocalParen;
882 	FICL_WORD *pToLocal0;
883 	FICL_WORD *pToLocal1;
884 	FICL_WORD *pLinkParen;
885 	FICL_WORD *pUnLinkParen;
886 	FICL_INT   nLocals;
887 	CELL *pMarkLocals;
888 #endif
889 
890 	FICL_BREAKPOINT bpStep;
891 };
892 
893 struct ficl_system_info
894 {
895 	int size;           /* structure size tag for versioning */
896 	int nDictCells;     /* Size of system's Dictionary */
897 	OUTFUNC textOut;    /* default textOut function */
898 	void *pExtend;      /* Initializes VM's pExtend pointer - for application use */
899     int nEnvCells;      /* Size of Environment dictionary */
900 };
901 
902 
903 #define ficlInitInfo(x) { memset((x), 0, sizeof(FICL_SYSTEM_INFO)); \
904          (x)->size = sizeof(FICL_SYSTEM_INFO); }
905 
906 /*
907 ** External interface to FICL...
908 */
909 /*
910 ** f i c l I n i t S y s t e m
911 ** Binds a global dictionary to the interpreter system and initializes
912 ** the dict to contain the ANSI CORE wordset.
913 ** You can specify the address and size of the allocated area.
914 ** Using ficlInitSystemEx you can also specify the text output function.
915 ** After that, ficl manages it.
916 ** First step is to set up the static pointers to the area.
917 ** Then write the "precompiled" portion of the dictionary in.
918 ** The dictionary needs to be at least large enough to hold the
919 ** precompiled part. Try 1K cells minimum. Use "words" to find
920 ** out how much of the dictionary is used at any time.
921 */
922 FICL_SYSTEM *ficlInitSystemEx(FICL_SYSTEM_INFO *fsi);
923 
924 /* Deprecated call */
925 FICL_SYSTEM *ficlInitSystem(int nDictCells);
926 
927 /*
928 ** f i c l T e r m S y s t e m
929 ** Deletes the system dictionary and all virtual machines that
930 ** were created with ficlNewVM (see below). Call this function to
931 ** reclaim all memory used by the dictionary and VMs.
932 */
933 void       ficlTermSystem(FICL_SYSTEM *pSys);
934 
935 /*
936 ** f i c l E v a l u a t e
937 ** Evaluates a block of input text in the context of the
938 ** specified interpreter. Also sets SOURCE-ID properly.
939 **
940 ** PLEASE USE THIS FUNCTION when throwing a hard-coded
941 ** string to the FICL interpreter.
942 */
943 int        ficlEvaluate(FICL_VM *pVM, char *pText);
944 
945 /*
946 ** f i c l E x e c
947 ** Evaluates a block of input text in the context of the
948 ** specified interpreter. Emits any requested output to the
949 ** interpreter's output function. If the input string is NULL
950 ** terminated, you can pass -1 as nChars rather than count it.
951 ** Execution returns when the text block has been executed,
952 ** or an error occurs.
953 ** Returns one of the VM_XXXX codes defined in ficl.h:
954 ** VM_OUTOFTEXT is the normal exit condition
955 ** VM_ERREXIT means that the interp encountered a syntax error
956 **      and the vm has been reset to recover (some or all
957 **      of the text block got ignored
958 ** VM_USEREXIT means that the user executed the "bye" command
959 **      to shut down the interpreter. This would be a good
960 **      time to delete the vm, etc -- or you can ignore this
961 **      signal.
962 ** VM_ABORT and VM_ABORTQ are generated by 'abort' and 'abort"'
963 **      commands.
964 ** Preconditions: successful execution of ficlInitSystem,
965 **      Successful creation and init of the VM by ficlNewVM (or equiv)
966 **
967 ** If you call ficlExec() or one of its brothers, you MUST
968 ** ensure pVM->sourceID was set to a sensible value.
969 ** ficlExec() explicitly DOES NOT manage SOURCE-ID for you.
970 */
971 int        ficlExec (FICL_VM *pVM, char *pText);
972 int        ficlExecC(FICL_VM *pVM, char *pText, FICL_INT nChars);
973 int        ficlExecXT(FICL_VM *pVM, FICL_WORD *pWord);
974 
975 /*
976 ** ficlExecFD(FICL_VM *pVM, int fd);
977  * Evaluates text from file passed in via fd.
978  * Execution returns when all of file has been executed or an
979  * error occurs.
980  */
981 int        ficlExecFD(FICL_VM *pVM, int fd);
982 
983 /*
984 ** Create a new VM from the heap, and link it into the system VM list.
985 ** Initializes the VM and binds default sized stacks to it. Returns the
986 ** address of the VM, or NULL if an error occurs.
987 ** Precondition: successful execution of ficlInitSystem
988 */
989 FICL_VM   *ficlNewVM(FICL_SYSTEM *pSys);
990 
991 /*
992 ** Force deletion of a VM. You do not need to do this
993 ** unless you're creating and discarding a lot of VMs.
994 ** For systems that use a constant pool of VMs for the life
995 ** of the system, ficltermSystem takes care of VM cleanup
996 ** automatically.
997 */
998 void ficlFreeVM(FICL_VM *pVM);
999 
1000 
1001 /*
1002 ** Set the stack sizes (return and parameter) to be used for all
1003 ** subsequently created VMs. Returns actual stack size to be used.
1004 */
1005 int ficlSetStackSize(int nStackCells);
1006 
1007 /*
1008 ** Returns the address of the most recently defined word in the system
1009 ** dictionary with the given name, or NULL if no match.
1010 ** Precondition: successful execution of ficlInitSystem
1011 */
1012 FICL_WORD *ficlLookup(FICL_SYSTEM *pSys, char *name);
1013 
1014 /*
1015 ** f i c l G e t D i c t
1016 ** Utility function - returns the address of the system dictionary.
1017 ** Precondition: successful execution of ficlInitSystem
1018 */
1019 FICL_DICT *ficlGetDict(FICL_SYSTEM *pSys);
1020 FICL_DICT *ficlGetEnv (FICL_SYSTEM *pSys);
1021 void       ficlSetEnv (FICL_SYSTEM *pSys, char *name, FICL_UNS value);
1022 void       ficlSetEnvD(FICL_SYSTEM *pSys, char *name, FICL_UNS hi, FICL_UNS lo);
1023 #if FICL_WANT_LOCALS
1024 FICL_DICT *ficlGetLoc (FICL_SYSTEM *pSys);
1025 #endif
1026 /*
1027 ** f i c l B u i l d
1028 ** Builds a word into the system default dictionary in a thread-safe way.
1029 ** Preconditions: system must be initialized, and there must
1030 ** be enough space for the new word's header! Operation is
1031 ** controlled by ficlLockDictionary, so any initialization
1032 ** required by your version of the function (if you "overrode"
1033 ** it) must be complete at this point.
1034 ** Parameters:
1035 ** name  -- the name of the word to be built
1036 ** code  -- code to execute when the word is invoked - must take a single param
1037 **          pointer to a FICL_VM
1038 ** flags -- 0 or more of FW_IMMEDIATE, FW_COMPILE, use bitwise OR!
1039 **          Most words can use FW_DEFAULT.
1040 ** nAllot - number of extra cells to allocate in the parameter area (usually zero)
1041 */
1042 int        ficlBuild(FICL_SYSTEM *pSys, char *name, FICL_CODE code, char flags);
1043 
1044 /*
1045 ** f i c l C o m p i l e C o r e
1046 ** Builds the ANS CORE wordset into the dictionary - called by
1047 ** ficlInitSystem - no need to waste dict space by doing it again.
1048 */
1049 void       ficlCompileCore(FICL_SYSTEM *pSys);
1050 void       ficlCompilePrefix(FICL_SYSTEM *pSys);
1051 void       ficlCompileSearch(FICL_SYSTEM *pSys);
1052 void       ficlCompileSoftCore(FICL_SYSTEM *pSys);
1053 void       ficlCompileTools(FICL_SYSTEM *pSys);
1054 void       ficlCompileFile(FICL_SYSTEM *pSys);
1055 #if FICL_WANT_FLOAT
1056 void       ficlCompileFloat(FICL_SYSTEM *pSys);
1057 int        ficlParseFloatNumber( FICL_VM *pVM, STRINGINFO si ); /* float.c */
1058 #endif
1059 #if FICL_PLATFORM_EXTEND
1060 void       ficlCompilePlatform(FICL_SYSTEM *pSys);
1061 #endif
1062 int        ficlParsePrefix(FICL_VM *pVM, STRINGINFO si);
1063 
1064 /*
1065 ** from words.c...
1066 */
1067 void       constantParen(FICL_VM *pVM);
1068 void       twoConstParen(FICL_VM *pVM);
1069 int        ficlParseNumber(FICL_VM *pVM, STRINGINFO si);
1070 void       ficlTick(FICL_VM *pVM);
1071 void       parseStepParen(FICL_VM *pVM);
1072 
1073 /*
1074 ** From tools.c
1075 */
1076 int        isAFiclWord(FICL_DICT *pd, FICL_WORD *pFW);
1077 
1078 /*
1079 ** The following supports SEE and the debugger.
1080 */
1081 typedef enum
1082 {
1083     BRANCH,
1084     COLON,
1085     CONSTANT,
1086     CREATE,
1087     DO,
1088     DOES,
1089     IF,
1090     LITERAL,
1091     LOOP,
1092     OF,
1093     PLOOP,
1094     PRIMITIVE,
1095     QDO,
1096     STRINGLIT,
1097     CSTRINGLIT,
1098 #if FICL_WANT_USER
1099     USER,
1100 #endif
1101     VARIABLE,
1102 } WORDKIND;
1103 
1104 WORDKIND   ficlWordClassify(FICL_WORD *pFW);
1105 
1106 /*
1107 ** Dictionary on-demand resizing
1108 */
1109 extern CELL dictThreshold;
1110 extern CELL dictIncrease;
1111 
1112 /*
1113 ** Various FreeBSD goodies
1114 */
1115 
1116 #if defined(__i386__) && !defined(TESTMAIN)
1117 extern void ficlOutb(FICL_VM *pVM);
1118 extern void ficlInb(FICL_VM *pVM);
1119 #endif
1120 
1121 extern void ficlSetenv(FICL_VM *pVM);
1122 extern void ficlSetenvq(FICL_VM *pVM);
1123 extern void ficlGetenv(FICL_VM *pVM);
1124 extern void ficlUnsetenv(FICL_VM *pVM);
1125 extern void ficlCopyin(FICL_VM *pVM);
1126 extern void ficlCopyout(FICL_VM *pVM);
1127 extern void ficlFindfile(FICL_VM *pVM);
1128 extern void ficlCcall(FICL_VM *pVM);
1129 #if !defined(TESTMAIN)
1130 extern void ficlPnpdevices(FICL_VM *pVM);
1131 extern void ficlPnphandlers(FICL_VM *pVM);
1132 #endif
1133 
1134 /*
1135 ** Used with File-Access wordset.
1136 */
1137 #define FICL_FAM_READ	1
1138 #define FICL_FAM_WRITE	2
1139 #define FICL_FAM_APPEND	4
1140 #define FICL_FAM_BINARY	8
1141 
1142 #define FICL_FAM_OPEN_MODE(fam)	((fam) & (FICL_FAM_READ | FICL_FAM_WRITE | FICL_FAM_APPEND))
1143 
1144 
1145 #if (FICL_WANT_FILE)
1146 typedef struct ficlFILE
1147 {
1148 	FILE *f;
1149 	char filename[256];
1150 } ficlFILE;
1151 #endif
1152 
1153 #include <sys/linker_set.h>
1154 
1155 typedef void ficlCompileFcn(FICL_SYSTEM *);
1156 #define FICL_COMPILE_SET(func)	\
1157 	DATA_SET(Xficl_compile_set, func)
1158 SET_DECLARE(Xficl_compile_set, ficlCompileFcn);
1159 
1160 #ifdef LOADER_VERIEXEC
1161 #include <verify_file.h>
1162 #endif
1163 
1164 #ifdef __cplusplus
1165 }
1166 #endif
1167 
1168 #endif /* __FICL_H__ */
1169