xref: /illumos-gate/usr/src/common/ficl/ficl.h (revision c0bb4f73)
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.25 2010/10/03 09:52:12 asau 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 #ifndef	_FICL_H
45 #define	_FICL_H
46 /*
47  * Ficl (Forth-inspired command language) is an ANS Forth
48  * interpreter written in C. Unlike traditional Forths, this
49  * interpreter is designed to be embedded into other systems
50  * as a command/macro/development prototype language.
51  *
52  * Where Forths usually view themselves as the center of the system
53  * and expect the rest of the system to be coded in Forth, Ficl
54  * acts as a component of the system. It is easy to export
55  * code written in C or ASM to Ficl in the style of TCL, or to invoke
56  * Ficl code from a compiled module. This allows you to do incremental
57  * development in a way that combines the best features of threaded
58  * languages (rapid development, quick code/test/debug cycle,
59  * reasonably fast) with the best features of C (everyone knows it,
60  * easier to support large blocks of code, efficient, type checking).
61  *
62  * Ficl provides facilities for interoperating
63  * with programs written in C: C functions can be exported to Ficl,
64  * and Ficl commands can be executed via a C calling interface. The
65  * interpreter is re-entrant, so it can be used in multiple instances
66  * in a multitasking system. Unlike Forth, Ficl's outer interpreter
67  * expects a text block as input, and returns to the caller after each
68  * text block, so the "data pump" is somewhere in external code. This
69  * is more like TCL than Forth, which usually expects to be at the center
70  * of the system, requesting input at its convenience. Each Ficl virtual
71  * machine can be bound to a different I/O channel, and is independent
72  * of all others in in the same address space except that all virtual
73  * machines share a common dictionary (a sort or open symbol table that
74  * defines all of the elements of the language).
75  *
76  * Code is written in ANSI C for portability.
77  *
78  * Summary of Ficl features and constraints:
79  * - Standard: Implements the ANSI Forth CORE word set and part
80  *   of the CORE EXT word-set, SEARCH and SEARCH EXT, TOOLS and
81  *   TOOLS EXT, LOCAL and LOCAL ext and various extras.
82  * - Extensible: you can export code written in Forth, C,
83  *   or asm in a straightforward way. Ficl provides open
84  *   facilities for extending the language in an application
85  *   specific way. You can even add new control structures!
86  * - Ficl and C can interact in two ways: Ficl can encapsulate
87  *   C code, or C code can invoke Ficl code.
88  * - Thread-safe, re-entrant: The shared system dictionary
89  *   uses a locking mechanism that you can either supply
90  *   or stub out to provide exclusive access. Each Ficl
91  *   virtual machine has an otherwise complete state, and
92  *   each can be bound to a separate I/O channel (or none at all).
93  * - Simple encapsulation into existing systems: a basic implementation
94  *   requires three function calls (see the example program in testmain.c).
95  * - ROMable: Ficl is designed to work in RAM-based and ROM code / RAM data
96  *   environments. It does require somewhat more memory than a pure
97  *   ROM implementation because it builds its system dictionary in
98  *   RAM at startup time.
99  * - Written an ANSI C to be as simple as I can make it to understand,
100  *   support, debug, and port. Compiles without complaint at /Az /W4
101  *   (require ANSI C, max warnings) under Microsoft VC++ 5.
102  * - Does full 32 bit math (but you need to implement
103  *   two mixed precision math primitives (see sysdep.c))
104  * - Indirect threaded interpreter is not the fastest kind of
105  *   Forth there is (see pForth 68K for a really fast subroutine
106  *   threaded interpreter), but it's the cleanest match to a
107  *   pure C implementation.
108  *
109  * P O R T I N G   F i c l
110  *
111  * To install Ficl on your target system, you need an ANSI C compiler
112  * and its runtime library. Inspect the system dependent macros and
113  * functions in sysdep.h and sysdep.c and edit them to suit your
114  * system. For example, INT16 is a short on some compilers and an
115  * int on others. Check the default CELL alignment controlled by
116  * FICL_ALIGN. If necessary, add new definitions of ficlMalloc, ficlFree,
117  * ficlLockDictionary, and ficlCallbackDefaultTextOut to work with your
118  * operating system.  Finally, use testmain.c as a guide to installing the
119  * Ficl system and one or more virtual machines into your code. You do not
120  * need to include testmain.c in your build.
121  *
122  * T o   D o   L i s t
123  *
124  * 1. Unimplemented system dependent CORE word: key
125  * 2. Ficl uses the PAD in some CORE words - this violates the standard,
126  *    but it's cleaner for a multithreaded system. I'll have to make a
127  *    second pad for reference by the word PAD to fix this.
128  *
129  * F o r   M o r e   I n f o r m a t i o n
130  *
131  * Web home of Ficl
132  *   http://ficl.sourceforge.net
133  * Check this website for Forth literature (including the ANSI standard)
134  *   http://www.taygeta.com/forthlit.html
135  * and here for software and more links
136  *   http://www.taygeta.com/forth.html
137  */
138 
139 #ifdef __cplusplus
140 extern "C" {
141 #endif
142 
143 #ifdef _STANDALONE
144 #include <stand.h>
145 #include <sys/stdint.h>
146 #include <sys/linker_set.h>
147 #else
148 #include <ctype.h>
149 #include <stdio.h>
150 #include <stdlib.h>
151 #include <stdint.h>
152 #include <string.h>
153 
154 #define	__dead2	__NORETURN
155 extern void pager_open(void);
156 extern int pager_output(const char *);
157 extern void pager_close(void);
158 #endif
159 #include <setjmp.h>
160 #include <stdarg.h>
161 
162 /*
163  * Put all your local defines in ficllocal.h,
164  * rather than editing the makefile/project/etc.
165  * ficllocal.h will always ship as an inert file.
166  */
167 
168 #include "ficllocal.h"
169 #include "ficlplatform/unix.h"
170 
171 /*
172  *
173  * B U I L D   C O N T R O L S
174  *
175  * First, the FICL_WANT_* settings.
176  * These are all optional settings that you may or may not
177  * want Ficl to use.
178  *
179  */
180 
181 /*
182  * FICL_WANT_MINIMAL
183  * If set to nonzero, build the smallest possible Ficl interpreter.
184  */
185 #if !defined(FICL_WANT_MINIMAL)
186 #define	FICL_WANT_MINIMAL		(0)
187 #endif
188 
189 #if FICL_WANT_MINIMAL
190 #define	FICL_WANT_SOFTWORDS		(0)
191 #define	FICL_WANT_FILE			(0)
192 #define	FICL_WANT_FLOAT			(0)
193 #define	FICL_WANT_USER			(0)
194 #define	FICL_WANT_LOCALS		(0)
195 #define	FICL_WANT_DEBUGGER		(0)
196 #define	FICL_WANT_OOP			(0)
197 #define	FICL_WANT_PLATFORM		(0)
198 #define	FICL_WANT_MULTITHREADED		(0)
199 #define	FICL_WANT_EXTENDED_PREFIX	(0)
200 
201 #define	FICL_ROBUST			(0)
202 
203 #endif /* FICL_WANT_MINIMAL */
204 
205 /*
206  * FICL_WANT_PLATFORM
207  * Includes words defined in ficlCompilePlatform
208  * (see ficlplatform/win32.c and ficlplatform/unix.c for example)
209  */
210 #if !defined(FICL_WANT_PLATFORM)
211 #define	FICL_WANT_PLATFORM	(1)
212 #endif /* FICL_WANT_PLATFORM */
213 
214 /*
215  * FICL_WANT_LZ4_SOFTCORE
216  * If nonzero, the softcore words are stored compressed
217  * with patent-unencumbered LZ4 compression.
218  * This results in a smaller Ficl interpreter, and adds
219  * only a *tiny* runtime speed hit.
220  *
221  * Original LZ77 contributed by Larry Hastings.
222  * Updated to LZ4 which is even more space efficient.
223  */
224 #if !defined(FICL_WANT_LZ4_SOFTCORE)
225 #define	FICL_WANT_LZ4_SOFTCORE	(1)
226 #endif /* FICL_WANT_LZ4_SOFTCORE */
227 
228 /*
229  * FICL_WANT_FILE
230  * Includes the FILE and FILE-EXT wordset and associated code.
231  * Turn this off if you do not have a file system!
232  * Contributed by Larry Hastings
233  */
234 #if !defined(FICL_WANT_FILE)
235 #define	FICL_WANT_FILE	(0)
236 #endif /* FICL_WANT_FILE */
237 
238 /*
239  * FICL_WANT_FLOAT
240  * Includes a floating point stack for the VM, and words to do float operations.
241  * Contributed by Guy Carver
242  */
243 #if !defined(FICL_WANT_FLOAT)
244 #define	FICL_WANT_FLOAT	(1)
245 #endif /* FICL_WANT_FLOAT */
246 
247 /*
248  * FICL_WANT_DEBUGGER
249  * Inludes a simple source level debugger
250  */
251 #if !defined(FICL_WANT_DEBUGGER)
252 #define	FICL_WANT_DEBUGGER	(1)
253 #endif /* FICL_WANT_DEBUGGER */
254 
255 /*
256  * FICL_EXTENDED_PREFIX
257  * Enables a bunch of extra prefixes in prefix.c
258  * and prefix.fr (if included as part of softcore.c)
259  */
260 #if !defined(FICL_WANT_EXTENDED_PREFIX)
261 #define	FICL_WANT_EXTENDED_PREFIX	(1)
262 #endif /* FICL_WANT_EXTENDED_PREFIX */
263 
264 /*
265  * FICL_WANT_USER
266  * Enables user variables: per-instance variables bound to the VM.
267  * Kind of like thread-local storage. Could be implemented in a
268  * VM private dictionary, but I've chosen the lower overhead
269  * approach of an array of CELLs instead.
270  */
271 #if !defined(FICL_WANT_USER)
272 #define	FICL_WANT_USER	(1)
273 #endif /* FICL_WANT_USER */
274 
275 /*
276  * FICL_WANT_LOCALS
277  * Controls the creation of the LOCALS wordset
278  * and a private dictionary for local variable compilation.
279  */
280 #if !defined FICL_WANT_LOCALS
281 #define	FICL_WANT_LOCALS	(1)
282 #endif /* FICL_WANT_LOCALS */
283 
284 /*
285  * FICL_WANT_OOP
286  * Inludes object oriented programming support (in softwords)
287  * OOP support requires locals and user variables!
288  */
289 #if !defined(FICL_WANT_OOP)
290 #define	FICL_WANT_OOP	((FICL_WANT_LOCALS) && (FICL_WANT_USER))
291 #endif /* FICL_WANT_OOP */
292 
293 /*
294  * FICL_WANT_SOFTWORDS
295  * Controls inclusion of all softwords in softcore.c.
296  */
297 #if !defined(FICL_WANT_SOFTWORDS)
298 #define	FICL_WANT_SOFTWORDS	(1)
299 #endif /* FICL_WANT_SOFTWORDS */
300 
301 /*
302  * FICL_WANT_MULTITHREADED
303  * Enables dictionary mutual exclusion wia the
304  * ficlLockDictionary() system dependent function.
305  *
306  * Note: this implementation is experimental and poorly
307  * tested. Further, it's unnecessary unless you really
308  * intend to have multiple SESSIONS (poor choice of name
309  * on my part) - that is, threads that modify the dictionary
310  * at the same time.
311  */
312 #if !defined FICL_WANT_MULTITHREADED
313 #define	FICL_WANT_MULTITHREADED	(0)
314 #endif /* FICL_WANT_MULTITHREADED */
315 
316 /*
317  * FICL_WANT_OPTIMIZE
318  * Do you want to optimize for size, or for speed?
319  * Note that this doesn't affect Ficl very much one way
320  * or the other at the moment.
321  * Contributed by Larry Hastings
322  */
323 #define	FICL_OPTIMIZE_FOR_SPEED	(1)
324 #define	FICL_OPTIMIZE_FOR_SIZE	(2)
325 #if !defined(FICL_WANT_OPTIMIZE)
326 #define	FICL_WANT_OPTIMIZE FICL_OPTIMIZE_FOR_SPEED
327 #endif /* FICL_WANT_OPTIMIZE */
328 
329 /*
330  * FICL_WANT_VCALL
331  * Ficl OO support for calling vtable methods.  Win32 only.
332  * Contributed by Guy Carver
333  */
334 #if !defined(FICL_WANT_VCALL)
335 #define	FICL_WANT_VCALL	(0)
336 #endif /* FICL_WANT_VCALL */
337 
338 /*
339  * P L A T F O R M   S E T T I N G S
340  *
341  * The FICL_PLATFORM_* settings.
342  * These indicate attributes about the local platform.
343  */
344 
345 /*
346  * FICL_PLATFORM_OS
347  * String constant describing the current hardware architecture.
348  */
349 #if !defined(FICL_PLATFORM_ARCHITECTURE)
350 #define	FICL_PLATFORM_ARCHITECTURE	"unknown"
351 #endif
352 
353 /*
354  * FICL_PLATFORM_OS
355  * String constant describing the current operating system.
356  */
357 #if !defined(FICL_PLATFORM_OS)
358 #define	FICL_PLATFORM_OS	"unknown"
359 #endif
360 
361 /*
362  * FICL_PLATFORM_HAS_2INTEGER
363  * Indicates whether or not the current architecture
364  * supports a native double-width integer type.
365  * If you set this to 1 in your ficlplatform/ *.h file,
366  * you *must* create typedefs for the following two types:
367  *        ficl2Unsigned
368  *        ficl2Integer
369  * If this is set to 0, Ficl will implement double-width
370  * integer math in C, which is both bigger *and* slower
371  * (the double whammy!).  Make sure your compiler really
372  * genuinely doesn't support native double-width integers
373  * before setting this to 0.
374  */
375 #if !defined(FICL_PLATFORM_HAS_2INTEGER)
376 #define	FICL_PLATFORM_HAS_2INTEGER	(0)
377 #endif
378 
379 /*
380  * FICL_PLATFORM_HAS_FTRUNCATE
381  * Indicates whether or not the current platform provides
382  * the ftruncate() function (available on most UNIXes).
383  * This function is necessary to provide the complete
384  * File-Access wordset.
385  *
386  * If your platform does not have ftruncate() per se,
387  * but does have some method of truncating files, you
388  * should be able to implement ftruncate() yourself and
389  * set this constant to 1.  For an example of this see
390  * "ficlplatform/win32.c".
391  */
392 #if !defined(FICL_PLATFORM_HAS_FTRUNCATE)
393 #define	FICL_PLATFORM_HAS_FTRUNCATE	(0)
394 #endif
395 
396 /*
397  * FICL_PLATFORM_INLINE
398  * Must be defined, should be a function prototype type-modifying
399  * keyword that makes a function "inline".  Ficl does not assume
400  * that the local platform supports inline functions; it therefore
401  * only uses "inline" where "static" would also work, and uses "static"
402  * in the absence of another keyword.
403  */
404 #if !defined FICL_PLATFORM_INLINE
405 #define	FICL_PLATFORM_INLINE	inline
406 #endif /* !defined FICL_PLATFORM_INLINE */
407 
408 /*
409  * FICL_PLATFORM_EXTERN
410  * Must be defined, should be a keyword used to declare
411  * a function prototype as being a genuine prototype.
412  * You should only have to fiddle with this setting if
413  * you're not using an ANSI-compliant compiler, in which
414  * case, good luck!
415  */
416 #if !defined FICL_PLATFORM_EXTERN
417 #define	FICL_PLATFORM_EXTERN	extern
418 #endif /* !defined FICL_PLATFORM_EXTERN */
419 
420 /*
421  * FICL_PLATFORM_BASIC_TYPES
422  *
423  * If not defined yet,
424  */
425 #if !defined(FICL_PLATFORM_BASIC_TYPES)
426 typedef char ficlInteger8;
427 typedef unsigned char ficlUnsigned8;
428 typedef short ficlInteger16;
429 typedef unsigned short ficlUnsigned16;
430 typedef long ficlInteger32;
431 typedef unsigned long ficlUnsigned32;
432 
433 typedef ficlInteger32 ficlInteger;
434 typedef ficlUnsigned32 ficlUnsigned;
435 typedef float ficlFloat;
436 
437 #endif /* !defined(FICL_PLATFORM_BASIC_TYPES) */
438 
439 /*
440  * FICL_ROBUST enables bounds checking of stacks and the dictionary.
441  * This will detect stack over and underflows and dictionary overflows.
442  * Any exceptional condition will result in an assertion failure.
443  * (As generated by the ANSI assert macro)
444  * FICL_ROBUST == 1 --> stack checking in the outer interpreter
445  * FICL_ROBUST == 2 also enables checking in many primitives
446  */
447 
448 #if !defined FICL_ROBUST
449 #define	FICL_ROBUST	(2)
450 #endif /* FICL_ROBUST */
451 
452 /*
453  * FICL_DEFAULT_STACK_SIZE Specifies the default size (in CELLs) of
454  * a new virtual machine's stacks, unless overridden at
455  * create time.
456  */
457 #if !defined FICL_DEFAULT_STACK_SIZE
458 #define	FICL_DEFAULT_STACK_SIZE	(128)
459 #endif
460 
461 /*
462  * FICL_DEFAULT_DICTIONARY_SIZE specifies the number of ficlCells to allocate
463  * for the system dictionary by default. The value
464  * can be overridden at startup time as well.
465  */
466 #if !defined FICL_DEFAULT_DICTIONARY_SIZE
467 #define	FICL_DEFAULT_DICTIONARY_SIZE	(12288)
468 #endif
469 
470 /*
471  * FICL_DEFAULT_ENVIRONMENT_SIZE specifies the number of cells
472  * to allot for the environment-query dictionary.
473  */
474 #if !defined FICL_DEFAULT_ENVIRONMENT_SIZE
475 #define	FICL_DEFAULT_ENVIRONMENT_SIZE	(512)
476 #endif
477 
478 /*
479  * FICL_MAX_WORDLISTS specifies the maximum number of wordlists in
480  * the dictionary search order. See Forth DPANS sec 16.3.3
481  * (file://dpans16.htm#16.3.3)
482  */
483 #if !defined FICL_MAX_WORDLISTS
484 #define	FICL_MAX_WORDLISTS	(16)
485 #endif
486 
487 /*
488  * FICL_MAX_PARSE_STEPS controls the size of an array in the FICL_SYSTEM
489  * structure that stores pointers to parser extension functions. I would
490  * never expect to have more than 8 of these, so that's the default limit.
491  * Too many of these functions will probably exact a nasty performance penalty.
492  */
493 #if !defined FICL_MAX_PARSE_STEPS
494 #define	FICL_MAX_PARSE_STEPS	(8)
495 #endif
496 
497 /*
498  * Maximum number of local variables per definition.
499  * This only affects the size of the locals dictionary,
500  * and there's only one per entire ficlSystem, so it
501  * doesn't make sense to be a piker here.
502  */
503 #if (!defined(FICL_MAX_LOCALS)) && FICL_WANT_LOCALS
504 #define	FICL_MAX_LOCALS	(64)
505 #endif
506 
507 /*
508  * The pad is a small scratch area for text manipulation. ANS Forth
509  * requires it to hold at least 84 characters.
510  */
511 #if !defined FICL_PAD_SIZE
512 #define	FICL_PAD_SIZE	(256)
513 #endif
514 
515 /*
516  * ANS Forth requires that a word's name contain {1..31} characters.
517  */
518 #if !defined FICL_NAME_LENGTH
519 #define	FICL_NAME_LENGTH	(31)
520 #endif
521 
522 /*
523  * Default size of hash table. For most uniform
524  * performance, use a prime number!
525  */
526 #if !defined FICL_HASH_SIZE
527 #define	FICL_HASH_SIZE	(241)
528 #endif
529 
530 /*
531  * Default number of USER flags.
532  */
533 #if (!defined(FICL_USER_CELLS)) && FICL_WANT_USER
534 #define	FICL_USER_CELLS	(16)
535 #endif
536 
537 /*
538  * Forward declarations... read on.
539  */
540 struct ficlWord;
541 typedef struct ficlWord ficlWord;
542 struct ficlVm;
543 typedef struct ficlVm ficlVm;
544 struct ficlDictionary;
545 typedef struct ficlDictionary ficlDictionary;
546 struct ficlSystem;
547 typedef struct ficlSystem ficlSystem;
548 struct ficlSystemInformation;
549 typedef struct ficlSystemInformation ficlSystemInformation;
550 struct ficlCallback;
551 typedef struct ficlCallback ficlCallback;
552 struct ficlCountedString;
553 typedef struct ficlCountedString ficlCountedString;
554 struct ficlString;
555 typedef struct ficlString ficlString;
556 
557 
558 /*
559  * System dependent routines:
560  * Edit the implementations in your appropriate ficlplatform/ *.c to be
561  * compatible with your runtime environment.
562  *
563  * ficlCallbackDefaultTextOut sends a zero-terminated string to the
564  *	default output device - used for system error messages.
565  *
566  * ficlMalloc(), ficlRealloc() and ficlFree() have the same semantics
567  * as the functions malloc(), realloc(), and free() from the standard C library.
568  */
569 FICL_PLATFORM_EXTERN void ficlCallbackDefaultTextOut(ficlCallback *callback,
570     char *text);
571 FICL_PLATFORM_EXTERN void *ficlMalloc(size_t size);
572 FICL_PLATFORM_EXTERN void  ficlFree(void *p);
573 FICL_PLATFORM_EXTERN void *ficlRealloc(void *p, size_t size);
574 
575 /*
576  * the Good Stuff starts here...
577  */
578 #define	FICL_VERSION	"4.1.0"
579 #define	FICL_VERSION_MAJOR	4
580 #define	FICL_VERSION_MINOR	1
581 
582 #if !defined(FICL_PROMPT)
583 #define	FICL_PROMPT		"ok> "
584 #endif
585 
586 /*
587  * ANS Forth requires false to be zero, and true to be the ones
588  * complement of false... that unifies logical and bitwise operations
589  * nicely.
590  */
591 #define	FICL_TRUE	((unsigned long)~(0L))
592 #define	FICL_FALSE	(0)
593 #define	FICL_BOOL(x)	((x) ? FICL_TRUE : FICL_FALSE)
594 
595 
596 #if !defined FICL_IGNORE	/* Macro to silence unused param warnings */
597 #define	FICL_IGNORE(x)	(void)x
598 #endif /*  !defined FICL_IGNORE */
599 
600 #if !defined NULL
601 #define	NULL	((void *)0)
602 #endif
603 
604 /*
605  * 2integer structures
606  */
607 #if FICL_PLATFORM_HAS_2INTEGER
608 
609 #define	FICL_2INTEGER_SET(high, low, doublei)	\
610 	((doublei) = (ficl2Integer)(((ficlUnsigned)(low)) | \
611 	(((ficl2Integer)(high)) << FICL_BITS_PER_CELL)))
612 #define	FICL_2UNSIGNED_SET(high, low, doubleu)	\
613 	((doubleu) = ((ficl2Unsigned)(low)) | \
614 	(((ficl2Unsigned)(high)) << FICL_BITS_PER_CELL))
615 #define	FICL_2UNSIGNED_GET_LOW(doubleu)	\
616 	((ficlUnsigned)(doubleu & ((((ficl2Integer)1) << \
617 	FICL_BITS_PER_CELL) - 1)))
618 #define	FICL_2UNSIGNED_GET_HIGH(doubleu)	\
619 	((ficlUnsigned)(doubleu >> FICL_BITS_PER_CELL))
620 #define	FICL_2UNSIGNED_NOT_ZERO(doubleu)	((doubleu) != 0)
621 
622 #define	FICL_INTEGER_TO_2INTEGER(i, doublei)	((doublei) = (i))
623 #define	FICL_UNSIGNED_TO_2UNSIGNED(u, doubleu)	((doubleu) = (u))
624 
625 #define	ficl2IntegerIsNegative(doublei)	((doublei) < 0)
626 #define	ficl2IntegerNegate(doublei)	(-(doublei))
627 
628 #define	ficl2IntegerMultiply(x, y)	\
629 	(((ficl2Integer)(x)) * ((ficl2Integer)(y)))
630 #define	ficl2IntegerDecrement(x)	(((ficl2Integer)(x)) - 1)
631 
632 #define	ficl2UnsignedAdd(x, y)	(((ficl2Unsigned)(x)) + ((ficl2Unsigned)(y)))
633 #define	ficl2UnsignedSubtract(x, y)	\
634 	(((ficl2Unsigned)(x)) - ((ficl2Unsigned)(y)))
635 #define	ficl2UnsignedMultiply(x, y)	\
636 	(((ficl2Unsigned)(x)) * ((ficl2Unsigned)(y)))
637 #define	ficl2UnsignedMultiplyAccumulate(u, mul, add)	(((u) * (mul)) + (add))
638 #define	ficl2UnsignedArithmeticShiftLeft(x)	((x) << 1)
639 #define	ficl2UnsignedArithmeticShiftRight(x)	((x) >> 1)
640 #define	ficl2UnsignedCompare(x, y)	ficl2UnsignedSubtract(x, y)
641 #define	ficl2UnsignedOr(x, y)	((x) | (y))
642 
643 #else /* FICL_PLATFORM_HAS_2INTEGER */
644 
645 typedef struct
646 {
647 	ficlUnsigned high;
648 	ficlUnsigned low;
649 } ficl2Unsigned;
650 
651 typedef struct
652 {
653 	ficlInteger high;
654 	ficlInteger low;
655 } ficl2Integer;
656 
657 
658 #define	FICL_2INTEGER_SET(hi, lo, doublei)	\
659 	{ ficl2Integer x; x.low = (lo); x.high = (hi); (doublei) = x; }
660 #define	FICL_2UNSIGNED_SET(hi, lo, doubleu)	\
661 	{ ficl2Unsigned x; x.low = (lo); x.high = (hi); (doubleu) = x; }
662 #define	FICL_2UNSIGNED_GET_LOW(doubleu)	((doubleu).low)
663 #define	FICL_2UNSIGNED_GET_HIGH(doubleu)	((doubleu).high)
664 #define	FICL_2UNSIGNED_NOT_ZERO(doubleu) ((doubleu).high || (doubleu).low)
665 
666 #define	FICL_INTEGER_TO_2INTEGER(i, doublei)	\
667 	{ ficlInteger __x = (ficlInteger)(i);	\
668 	FICL_2INTEGER_SET((__x < 0) ? -1L : 0, __x, doublei) }
669 #define	FICL_UNSIGNED_TO_2UNSIGNED(u, doubleu)	\
670 	FICL_2UNSIGNED_SET(0, u, doubleu)
671 
672 FICL_PLATFORM_EXTERN int ficl2IntegerIsNegative(ficl2Integer x);
673 FICL_PLATFORM_EXTERN ficl2Integer ficl2IntegerNegate(ficl2Integer x);
674 
675 FICL_PLATFORM_EXTERN ficl2Integer ficl2IntegerMultiply(ficlInteger x,
676     ficlInteger y);
677 FICL_PLATFORM_EXTERN ficl2Integer ficl2IntegerDecrement(ficl2Integer x);
678 
679 FICL_PLATFORM_EXTERN ficl2Unsigned ficl2UnsignedAdd(ficl2Unsigned x,
680     ficl2Unsigned y);
681 FICL_PLATFORM_EXTERN ficl2Unsigned ficl2UnsignedSubtract(ficl2Unsigned x,
682     ficl2Unsigned y);
683 FICL_PLATFORM_EXTERN ficl2Unsigned ficl2UnsignedMultiply(ficlUnsigned x,
684     ficlUnsigned y);
685 FICL_PLATFORM_EXTERN ficl2Unsigned
686     ficl2UnsignedMultiplyAccumulate(ficl2Unsigned u, ficlUnsigned mul,
687     ficlUnsigned add);
688 FICL_PLATFORM_EXTERN ficl2Unsigned
689     ficl2UnsignedArithmeticShiftLeft(ficl2Unsigned x);
690 FICL_PLATFORM_EXTERN ficl2Unsigned
691     ficl2UnsignedArithmeticShiftRight(ficl2Unsigned x);
692 FICL_PLATFORM_EXTERN int ficl2UnsignedCompare(ficl2Unsigned x,
693     ficl2Unsigned y);
694 FICL_PLATFORM_EXTERN ficl2Unsigned
695     ficl2UnsignedOr(ficl2Unsigned x, ficl2Unsigned y);
696 
697 #endif /* FICL_PLATFORM_HAS_2INTEGER */
698 
699 /*
700  * These structures represent the result of division.
701  */
702 typedef struct
703 {
704 	ficl2Unsigned quotient;
705 	ficlUnsigned remainder;
706 } __attribute__((may_alias)) ficl2UnsignedQR;
707 
708 typedef struct
709 {
710 	ficl2Integer quotient;
711 	ficlInteger remainder;
712 } __attribute__((may_alias)) ficl2IntegerQR;
713 
714 
715 #define	FICL_2INTEGERQR_TO_2UNSIGNEDQR(doubleiqr)	\
716 	(*(ficl2UnsignedQR *)(&(doubleiqr)))
717 #define	FICL_2UNSIGNEDQR_TO_2INTEGERQR(doubleuqr)	\
718 	(*(ficl2IntegerQR *)(&(doubleuqr)))
719 
720 /*
721  * 64 bit integer math support routines: multiply two UNS32s
722  * to get a 64 bit product, & divide the product by an UNS32
723  * to get an UNS32 quotient and remainder. Much easier in asm
724  * on a 32 bit CPU than in C, which usually doesn't support
725  * the double length result (but it should).
726  */
727 FICL_PLATFORM_EXTERN ficl2IntegerQR
728     ficl2IntegerDivideFloored(ficl2Integer num, ficlInteger den);
729 FICL_PLATFORM_EXTERN ficl2IntegerQR
730     ficl2IntegerDivideSymmetric(ficl2Integer num, ficlInteger den);
731 
732 FICL_PLATFORM_EXTERN ficl2UnsignedQR
733     ficl2UnsignedDivide(ficl2Unsigned q, ficlUnsigned y);
734 
735 /*
736  * A ficlCell is the main storage type. It must be large enough
737  * to contain a pointer or a scalar. In order to accommodate
738  * 32 bit and 64 bit processors, use abstract types for int,
739  * unsigned, and float.
740  *
741  * A ficlUnsigned, ficlInteger, and ficlFloat *MUST* be the same
742  * size as a "void *" on the target system.  (Sorry, but that's
743  * a design constraint of FORTH.)
744  */
745 typedef union ficlCell
746 {
747     ficlInteger i;
748     ficlUnsigned u;
749 #if (FICL_WANT_FLOAT)
750     ficlFloat f;
751 #endif
752     void *p;
753     void (*fn)(void);
754 } __attribute__((may_alias)) ficlCell;
755 
756 
757 #define	FICL_BITS_PER_CELL	(sizeof (ficlCell) * 8)
758 
759 /*
760  * FICL_PLATFORM_ALIGNMENT is the number of bytes to which
761  * the dictionary pointer address must be aligned. This value
762  * is usually either 2 or 4, depending on the memory architecture
763  * of the target system; 4 is safe on any 16 or 32 bit
764  * machine.  8 would be appropriate for a 64 bit machine.
765  */
766 #if !defined FICL_PLATFORM_ALIGNMENT
767 #define	FICL_PLATFORM_ALIGNMENT	(4)
768 #endif
769 
770 /*
771  * PTRtoCELL is a cast through void * intended to satisfy the
772  * most outrageously pedantic compiler... (I won't mention
773  * its name)
774  */
775 #define	FICL_POINTER_TO_CELL(p)	((ficlCell *)(void *)p)
776 
777 /*
778  * FORTH defines the "counted string" data type.  This is
779  * a "Pascal-style" string, where the first byte is an unsigned
780  * count of characters, followed by the characters themselves.
781  * The Ficl structure for this is ficlCountedString.
782  * Ficl also often zero-terminates them so that they work with the
783  * usual C runtime library string functions... strlen(), strcmp(),
784  * and the like.  (Belt & suspenders?  You decide.)
785  *
786  * The problem is, this limits strings to 255 characters, which
787  * can be a bit constricting to us wordy types.  So FORTH only
788  * uses counted strings for backwards compatibility, and all new
789  * words are "c-addr u" style, where the address and length are
790  * stored separately, and the length is a full unsigned "cell" size.
791  * (For more on this trend, see DPANS94 section A.3.1.3.4.)
792  * Ficl represents this with the ficlString structure.  Note that
793  * these are frequently *not* zero-terminated!  Don't depend on
794  * it--that way lies madness.
795  */
796 
797 struct ficlCountedString
798 {
799     ficlUnsigned8 length;
800     char text[1];
801 };
802 
803 #define	FICL_COUNTED_STRING_GET_LENGTH(cs)	((cs).length)
804 #define	FICL_COUNTED_STRING_GET_POINTER(cs)	((cs).text)
805 
806 #define	FICL_COUNTED_STRING_MAX	(256)
807 #define	FICL_POINTER_TO_COUNTED_STRING(p)	((ficlCountedString *)(void *)p)
808 
809 struct ficlString
810 {
811     ficlUnsigned length;
812     char *text;
813 };
814 
815 
816 #define	FICL_STRING_GET_LENGTH(fs)	((fs).length)
817 #define	FICL_STRING_GET_POINTER(fs)	((fs).text)
818 #define	FICL_STRING_SET_LENGTH(fs, l)	((fs).length = (ficlUnsigned)(l))
819 #define	FICL_STRING_SET_POINTER(fs, p)	((fs).text = (char *)(p))
820 #define	FICL_STRING_SET_FROM_COUNTED_STRING(string, countedstring)	\
821 	{(string).text = (countedstring).text;	\
822 	(string).length = (countedstring).length; }
823 /*
824  * Init a FICL_STRING from a pointer to a zero-terminated string
825  */
826 #define	FICL_STRING_SET_FROM_CSTRING(string, cstring) \
827 	{(string).text = (cstring); (string).length = strlen(cstring); }
828 
829 /*
830  * Ficl uses this little structure to hold the address of
831  * the block of text it's working on and an index to the next
832  * unconsumed character in the string. Traditionally, this is
833  * done by a Text Input Buffer, so I've called this struct TIB.
834  *
835  * Since this structure also holds the size of the input buffer,
836  * and since evaluate requires that, let's put the size here.
837  * The size is stored as an end-pointer because that is what the
838  * null-terminated string aware functions find most easy to deal
839  * with.
840  * Notice, though, that nobody really uses this except evaluate,
841  * so it might just be moved to ficlVm instead. (sobral)
842  */
843 typedef struct
844 {
845     ficlInteger index;
846     char *end;
847     char *text;
848 } ficlTIB;
849 
850 /*
851  * Stacks get heavy use in Ficl and Forth...
852  * Each virtual machine implements two of them:
853  * one holds parameters (data), and the other holds return
854  * addresses and control flow information for the virtual
855  * machine. (Note: C's automatic stack is implicitly used,
856  * but not modeled because it doesn't need to be...)
857  * Here's an abstract type for a stack
858  */
859 typedef struct ficlStack
860 {
861     ficlUnsigned size;	/* size of the stack, in cells */
862     ficlCell *frame;	/* link reg for stack frame */
863     ficlCell *top;	/* stack pointer */
864     ficlVm *vm;		/* used for debugging */
865     char *name;		/* used for debugging */
866     ficlCell base[1];	/* Top of stack */
867 } ficlStack;
868 
869 /*
870  * Stack methods... many map closely to required Forth words.
871  */
872 FICL_PLATFORM_EXTERN ficlStack *
873     ficlStackCreate(ficlVm *vm, char *name, unsigned nCells);
874 FICL_PLATFORM_EXTERN void ficlStackDestroy(ficlStack *stack);
875 FICL_PLATFORM_EXTERN int ficlStackDepth(ficlStack *stack);
876 FICL_PLATFORM_EXTERN void ficlStackDrop(ficlStack *stack, int n);
877 FICL_PLATFORM_EXTERN ficlCell ficlStackFetch(ficlStack *stack, int n);
878 FICL_PLATFORM_EXTERN ficlCell ficlStackGetTop(ficlStack *stack);
879 FICL_PLATFORM_EXTERN void ficlStackPick(ficlStack *stack, int n);
880 FICL_PLATFORM_EXTERN ficlCell ficlStackPop(ficlStack *stack);
881 FICL_PLATFORM_EXTERN void ficlStackPush(ficlStack *stack, ficlCell c);
882 FICL_PLATFORM_EXTERN void ficlStackReset(ficlStack *stack);
883 FICL_PLATFORM_EXTERN void ficlStackRoll(ficlStack *stack, int n);
884 FICL_PLATFORM_EXTERN void ficlStackSetTop(ficlStack *stack, ficlCell c);
885 FICL_PLATFORM_EXTERN void ficlStackStore(ficlStack *stack, int n, ficlCell c);
886 
887 #if FICL_WANT_LOCALS
888 FICL_PLATFORM_EXTERN void ficlStackLink(ficlStack *stack, int nCells);
889 FICL_PLATFORM_EXTERN void ficlStackUnlink(ficlStack *stack);
890 #endif /* FICL_WANT_LOCALS */
891 
892 FICL_PLATFORM_EXTERN void *ficlStackPopPointer(ficlStack *stack);
893 FICL_PLATFORM_EXTERN ficlUnsigned ficlStackPopUnsigned(ficlStack *stack);
894 FICL_PLATFORM_EXTERN ficlInteger ficlStackPopInteger(ficlStack *stack);
895 FICL_PLATFORM_EXTERN void ficlStackPushPointer(ficlStack *stack, void *ptr);
896 FICL_PLATFORM_EXTERN void
897 	ficlStackPushUnsigned(ficlStack *stack, ficlUnsigned u);
898 FICL_PLATFORM_EXTERN void ficlStackPushInteger(ficlStack *stack, ficlInteger i);
899 
900 #if (FICL_WANT_FLOAT)
901 FICL_PLATFORM_EXTERN ficlFloat ficlStackPopFloat(ficlStack *stack);
902 FICL_PLATFORM_EXTERN void ficlStackPushFloat(ficlStack *stack, ficlFloat f);
903 #endif
904 
905 FICL_PLATFORM_EXTERN void
906 	ficlStackPush2Integer(ficlStack *stack, ficl2Integer i64);
907 FICL_PLATFORM_EXTERN ficl2Integer ficlStackPop2Integer(ficlStack *stack);
908 FICL_PLATFORM_EXTERN void
909 	ficlStackPush2Unsigned(ficlStack *stack, ficl2Unsigned u64);
910 FICL_PLATFORM_EXTERN ficl2Unsigned ficlStackPop2Unsigned(ficlStack *stack);
911 
912 #if FICL_ROBUST >= 1
913 FICL_PLATFORM_EXTERN void
914 	ficlStackCheck(ficlStack *stack, int popCells, int pushCells);
915 #define	FICL_STACK_CHECK(stack, popCells, pushCells)	\
916 	ficlStackCheck(stack, popCells, pushCells)
917 #else /* FICL_ROBUST >= 1 */
918 #define	FICL_STACK_CHECK(stack, popCells, pushCells)
919 #endif /* FICL_ROBUST >= 1 */
920 
921 typedef ficlInteger (*ficlStackWalkFunction)(void *constant, ficlCell *cell);
922 FICL_PLATFORM_EXTERN void
923 	ficlStackWalk(ficlStack *stack, ficlStackWalkFunction callback,
924 	void *context, ficlInteger bottomToTop);
925 FICL_PLATFORM_EXTERN void ficlStackDisplay(ficlStack *stack,
926 	ficlStackWalkFunction callback, void *context);
927 
928 typedef ficlWord **ficlIp; /* the VM's instruction pointer */
929 typedef void (*ficlPrimitive)(ficlVm *vm);
930 typedef void (*ficlOutputFunction)(ficlCallback *callback, char *text);
931 
932 /*
933  * Each VM has a placeholder for an output function -
934  * this makes it possible to have each VM do I/O
935  * through a different device. If you specify no
936  * ficlOutputFunction, it defaults to ficlCallbackDefaultTextOut.
937  *
938  * You can also set a specific handler just for errors.
939  * If you don't specify one, it defaults to using textOut.
940  */
941 
942 struct ficlCallback
943 {
944     void *context;
945     ficlOutputFunction textOut;
946     ficlOutputFunction errorOut;
947     ficlSystem *system;
948     ficlVm *vm;
949 };
950 
951 FICL_PLATFORM_EXTERN void
952     ficlCallbackTextOut(ficlCallback *callback, char *text);
953 FICL_PLATFORM_EXTERN void
954     ficlCallbackErrorOut(ficlCallback *callback, char *text);
955 
956 /*
957  * For backwards compatibility.
958  */
959 typedef void
960 (*ficlCompatibilityOutputFunction)(ficlVm *vm, char *text, int newline);
961 FICL_PLATFORM_EXTERN void
962     ficlCompatibilityTextOutCallback(ficlCallback *callback, char *text,
963     ficlCompatibilityOutputFunction oldFunction);
964 
965 /*
966  * Starting with Ficl 4.0, Ficl uses a "switch-threaded" inner loop,
967  * where each primitive word is represented with a numeric constant,
968  * and words are (more or less) arrays of these constants.  In Ficl
969  * these constants are an enumerated type called ficlInstruction.
970  */
971 enum ficlInstruction
972 {
973 #define	FICL_TOKEN(token, description) token,
974 #define	FICL_INSTRUCTION_TOKEN(token, description, flags) token,
975 #include "ficltokens.h"
976 #undef	FICL_TOKEN
977 #undef	FICL_INSTRUCTION_TOKEN
978 
979 	ficlInstructionLast,
980 
981 	ficlInstructionFourByteTrick = 0x10000000
982 };
983 typedef intptr_t ficlInstruction;
984 
985 /*
986  * The virtual machine (VM) contains the state for one interpreter.
987  * Defined operations include:
988  * Create & initialize
989  * Delete
990  * Execute a block of text
991  * Parse a word out of the input stream
992  * Call return, and branch
993  * Text output
994  * Throw an exception
995  */
996 
997 struct ficlVm
998 {
999 	ficlCallback callback;
1000 	ficlVm *link;		/* Ficl keeps a VM list for simple teardown */
1001 	jmp_buf *exceptionHandler; /* crude exception mechanism... */
1002 	short restart;		/* Set TRUE to restart runningWord */
1003 	ficlIp ip;		/* instruction pointer */
1004 		/* address of currently running word (often just *(ip-1) ) */
1005 	ficlWord *runningWord;
1006 	ficlUnsigned state;	/* compiling or interpreting */
1007 	ficlUnsigned base;	/* number conversion base */
1008 	ficlStack *dataStack;
1009 	ficlStack *returnStack;	/* return stack */
1010 #if FICL_WANT_FLOAT
1011 	ficlStack *floatStack;	/* float stack (optional) */
1012 #endif
1013 	ficlCell sourceId; /* -1 if EVALUATE, 0 if normal input, >0 if a file */
1014 	ficlTIB	 tib;		/* address of incoming text string  */
1015 #if FICL_WANT_USER
1016 	ficlCell user[FICL_USER_CELLS];
1017 #endif
1018 	char pad[FICL_PAD_SIZE];	/* the scratch area (see above) */
1019 };
1020 
1021 /*
1022  * Each VM operates in one of two non-error states: interpreting
1023  * or compiling. When interpreting, words are simply executed.
1024  * When compiling, most words in the input stream have their
1025  * addresses inserted into the word under construction. Some words
1026  * (known as IMMEDIATE) are executed in the compile state, too.
1027  */
1028 /* values of STATE */
1029 #define	FICL_VM_STATE_INTERPRET	(0)
1030 #define	FICL_VM_STATE_COMPILE	(1)
1031 
1032 /*
1033  * Exit codes for vmThrow
1034  */
1035 /* tell ficlVmExecuteXT to exit inner loop */
1036 #define	FICL_VM_STATUS_INNER_EXIT	(-256)
1037 /* hungry - normal exit */
1038 #define	FICL_VM_STATUS_OUT_OF_TEXT	(-257)
1039 /* word needs more text to succeed -- re-run it */
1040 #define	FICL_VM_STATUS_RESTART		(-258)
1041 /* user wants to quit */
1042 #define	FICL_VM_STATUS_USER_EXIT	(-259)
1043 /* interpreter found an error */
1044 #define	FICL_VM_STATUS_ERROR_EXIT	(-260)
1045 /* debugger breakpoint */
1046 #define	FICL_VM_STATUS_BREAK		(-261)
1047 /* like FICL_VM_STATUS_ERROR_EXIT -- abort */
1048 #define	FICL_VM_STATUS_ABORT		(-1)
1049 /* like FICL_VM_STATUS_ERROR_EXIT -- abort" */
1050 #define	FICL_VM_STATUS_ABORTQ		(-2)
1051 /* like FICL_VM_STATUS_ERROR_EXIT, but leave dataStack & base alone */
1052 #define	FICL_VM_STATUS_QUIT		(-56)
1053 
1054 FICL_PLATFORM_EXTERN void ficlVmBranchRelative(ficlVm *vm, int offset);
1055 FICL_PLATFORM_EXTERN ficlVm *
1056 ficlVmCreate(ficlVm *vm, unsigned nPStack, unsigned nRStack);
1057 FICL_PLATFORM_EXTERN void ficlVmDestroy(ficlVm *vm);
1058 FICL_PLATFORM_EXTERN ficlDictionary *ficlVmGetDictionary(ficlVm *vm);
1059 FICL_PLATFORM_EXTERN char *
1060 ficlVmGetString(ficlVm *vm, ficlCountedString *spDest, char delimiter);
1061 FICL_PLATFORM_EXTERN ficlString ficlVmGetWord(ficlVm *vm);
1062 FICL_PLATFORM_EXTERN ficlString ficlVmGetWord0(ficlVm *vm);
1063 FICL_PLATFORM_EXTERN int ficlVmGetWordToPad(ficlVm *vm);
1064 FICL_PLATFORM_EXTERN void ficlVmInnerLoop(ficlVm *vm, ficlWord *word);
1065 FICL_PLATFORM_EXTERN ficlString ficlVmParseString(ficlVm *vm, char delimiter);
1066 FICL_PLATFORM_EXTERN ficlString
1067 ficlVmParseStringEx(ficlVm *vm, char delimiter, char fSkipLeading);
1068 FICL_PLATFORM_EXTERN ficlCell ficlVmPop(ficlVm *vm);
1069 FICL_PLATFORM_EXTERN void ficlVmPush(ficlVm *vm, ficlCell c);
1070 FICL_PLATFORM_EXTERN void ficlVmPopIP(ficlVm *vm);
1071 FICL_PLATFORM_EXTERN void ficlVmPushIP(ficlVm *vm, ficlIp newIP);
1072 FICL_PLATFORM_EXTERN void ficlVmQuit(ficlVm *vm);
1073 FICL_PLATFORM_EXTERN void ficlVmReset(ficlVm *vm);
1074 FICL_PLATFORM_EXTERN void
1075 ficlVmSetTextOut(ficlVm *vm, ficlOutputFunction textOut);
1076 FICL_PLATFORM_EXTERN void ficlVmThrow(ficlVm *vm, int except);
1077 FICL_PLATFORM_EXTERN void ficlVmThrowError(ficlVm *vm, char *fmt, ...) __dead2;
1078 FICL_PLATFORM_EXTERN void
1079 ficlVmThrowErrorVararg(ficlVm *vm, char *fmt, va_list list) __dead2;
1080 FICL_PLATFORM_EXTERN void ficlVmTextOut(ficlVm *vm, char *text);
1081 FICL_PLATFORM_EXTERN void ficlVmErrorOut(ficlVm *vm, char *text);
1082 
1083 #define	ficlVmGetContext(vm)		((vm)->callback.context)
1084 #define	ficlVmGetDataStack(vm)		((vm)->dataStack)
1085 #define	ficlVmGetFloatStack(vm)		((vm)->floatStack)
1086 #define	ficlVmGetReturnStack(vm)	((vm)->returnStack)
1087 #define	ficlVmGetRunningWord(vm)	((vm)->runningWord)
1088 
1089 FICL_PLATFORM_EXTERN void ficlVmDisplayDataStack(ficlVm *vm);
1090 FICL_PLATFORM_EXTERN void ficlVmDisplayDataStackSimple(ficlVm *vm);
1091 FICL_PLATFORM_EXTERN void ficlVmDisplayReturnStack(ficlVm *vm);
1092 #if FICL_WANT_FLOAT
1093 FICL_PLATFORM_EXTERN void ficlVmDisplayFloatStack(ficlVm *vm);
1094 #endif /* FICL_WANT_FLOAT */
1095 
1096 /*
1097  * f i c l E v a l u a t e
1098  * Evaluates a block of input text in the context of the
1099  * specified interpreter. Also sets SOURCE-ID properly.
1100  *
1101  * PLEASE USE THIS FUNCTION when throwing a hard-coded
1102  * string to the Ficl interpreter.
1103  */
1104 FICL_PLATFORM_EXTERN int ficlVmEvaluate(ficlVm *vm, char *s);
1105 
1106 /*
1107  * f i c l V m E x e c *
1108  * Evaluates a block of input text in the context of the
1109  * specified interpreter. Emits any requested output to the
1110  * interpreter's output function. If the input string is NULL
1111  * terminated, you can pass -1 as nChars rather than count it.
1112  * Execution returns when the text block has been executed,
1113  * or an error occurs.
1114  * Returns one of the FICL_VM_STATUS_... codes defined in ficl.h:
1115  * FICL_VM_STATUS_OUT_OF_TEXT is the normal exit condition
1116  * FICL_VM_STATUS_ERROR_EXIT means that the interpreter encountered a syntax
1117  *	error and the vm has been reset to recover (some or all
1118  *      of the text block got ignored
1119  * FICL_VM_STATUS_USER_EXIT means that the user executed the "bye" command
1120  *      to shut down the interpreter. This would be a good
1121  *      time to delete the vm, etc -- or you can ignore this
1122  *      signal.
1123  * FICL_VM_STATUS_ABORT and FICL_VM_STATUS_ABORTQ are generated by 'abort'
1124  *	 and 'abort"' commands.
1125  * Preconditions: successful execution of ficlInitSystem,
1126  *      Successful creation and init of the VM by ficlNewVM (or equivalent)
1127  *
1128  * If you call ficlExec() or one of its brothers, you MUST
1129  * ensure vm->sourceId was set to a sensible value.
1130  * ficlExec() explicitly DOES NOT manage SOURCE-ID for you.
1131  */
1132 FICL_PLATFORM_EXTERN int ficlVmExecuteString(ficlVm *vm, ficlString s);
1133 FICL_PLATFORM_EXTERN int ficlVmExecuteXT(ficlVm *vm, ficlWord *pWord);
1134 FICL_PLATFORM_EXTERN void
1135 ficlVmExecuteInstruction(ficlVm *vm, ficlInstruction i);
1136 FICL_PLATFORM_EXTERN void ficlVmExecuteWord(ficlVm *vm, ficlWord *pWord);
1137 FICL_PLATFORM_EXTERN int ficlExecFD(ficlVm *vm, int fd);
1138 
1139 FICL_PLATFORM_EXTERN void
1140 ficlVmDictionaryAllot(ficlVm *vm, ficlDictionary *dictionary, int n);
1141 FICL_PLATFORM_EXTERN void
1142 ficlVmDictionaryAllotCells(ficlVm *vm, ficlDictionary *dictionary, int cells);
1143 
1144 FICL_PLATFORM_EXTERN int ficlVmParseWord(ficlVm *vm, ficlString s);
1145 
1146 /*
1147  * TIB access routines...
1148  * ANS forth seems to require the input buffer to be represented
1149  * as a pointer to the start of the buffer, and an index to the
1150  * next character to read.
1151  * PushTib points the VM to a new input string and optionally
1152  *  returns a copy of the current state
1153  * PopTib restores the TIB state given a saved TIB from PushTib
1154  * GetInBuf returns a pointer to the next unused char of the TIB
1155  */
1156 FICL_PLATFORM_EXTERN void
1157 ficlVmPushTib(ficlVm *vm, char *text, ficlInteger nChars, ficlTIB *pSaveTib);
1158 FICL_PLATFORM_EXTERN void ficlVmPopTib(ficlVm *vm, ficlTIB *pTib);
1159 #define	ficlVmGetInBuf(vm)	((vm)->tib.text + (vm)->tib.index)
1160 #define	ficlVmGetInBufLen(vm)	((vm)->tib.end - (vm)->tib.text)
1161 #define	ficlVmGetInBufEnd(vm)	((vm)->tib.end)
1162 #define	ficlVmGetTibIndex(vm)	((vm)->tib.index)
1163 #define	ficlVmSetTibIndex(vm, i)	((vm)->tib.index = i)
1164 #define	ficlVmUpdateTib(vm, str)	\
1165 	((vm)->tib.index = (str) - (vm)->tib.text)
1166 
1167 #if FICL_ROBUST >= 1
1168 FICL_PLATFORM_EXTERN void
1169 ficlVmDictionaryCheck(ficlVm *vm, ficlDictionary *dictionary, int n);
1170 FICL_PLATFORM_EXTERN void
1171 ficlVmDictionarySimpleCheck(ficlVm *vm, ficlDictionary *dictionary, int n);
1172 #define	FICL_VM_DICTIONARY_CHECK(vm, dictionary, n)	\
1173 	ficlVmDictionaryCheck(vm, dictionary, n)
1174 #define	FICL_VM_DICTIONARY_SIMPLE_CHECK(vm, dictionary, n)	\
1175 	ficlVmDictionarySimpleCheck(vm, dictionary, n)
1176 #else
1177 #define	FICL_VM_DICTIONARY_CHECK(vm, dictionary, n)
1178 #define	FICL_VM_DICTIONARY_SIMPLE_CHECK(vm, dictionary, n)
1179 #endif /* FICL_ROBUST >= 1 */
1180 
1181 FICL_PLATFORM_EXTERN void ficlPrimitiveLiteralIm(ficlVm *vm);
1182 
1183 /*
1184  * A FICL_CODE points to a function that gets called to help execute
1185  * a word in the dictionary. It always gets passed a pointer to the
1186  * running virtual machine, and from there it can get the address
1187  * of the parameter area of the word it's supposed to operate on.
1188  * For precompiled words, the code is all there is. For user defined
1189  * words, the code assumes that the word's parameter area is a list
1190  * of pointers to the code fields of other words to execute, and
1191  * may also contain inline data. The first parameter is always
1192  * a pointer to a code field.
1193  */
1194 
1195 /*
1196  * Ficl models memory as a contiguous space divided into
1197  * words in a linked list called the dictionary.
1198  * A ficlWord starts each entry in the list.
1199  * Version 1.02: space for the name characters is allotted from
1200  * the dictionary ahead of the word struct, rather than using
1201  * a fixed size array for each name.
1202  */
1203 struct ficlWord
1204 {
1205     struct ficlWord *link;	/* Previous word in the dictionary */
1206     ficlUnsigned16 hash;
1207 		/* Immediate, Smudge, Compile-only, IsOjbect, Instruction */
1208     ficlUnsigned8 flags;
1209     ficlUnsigned8 length;	/* Number of chars in word name */
1210     char *name;			/* First nFICLNAME chars of word name */
1211     ficlPrimitive code;		/* Native code to execute the word */
1212     ficlInstruction semiParen;	/* Native code to execute the word */
1213     ficlCell param[1];		/* First data cell of the word */
1214 };
1215 
1216 /*
1217  * ficlWord.flag bitfield values:
1218  */
1219 
1220 /*
1221  * FICL_WORD_IMMEDIATE:
1222  * This word is always executed immediately when
1223  * encountered, even when compiling.
1224  */
1225 #define	FICL_WORD_IMMEDIATE	(1)
1226 
1227 /*
1228  * FICL_WORD_COMPILE_ONLY:
1229  * This word is only valid during compilation.
1230  * Ficl will throw a runtime error if this word executed
1231  * while not compiling.
1232  */
1233 #define	FICL_WORD_COMPILE_ONLY	(2)
1234 
1235 /*
1236  * FICL_WORD_SMUDGED
1237  * This word's definition is in progress.
1238  * The word is hidden from dictionary lookups
1239  * until it is "un-smudged".
1240  */
1241 #define	FICL_WORD_SMUDGED	(4)
1242 
1243 /*
1244  * FICL_WORD_OBJECT
1245  * This word is an object or object member variable.
1246  * (Currently only used by "my=[".)
1247  */
1248 #define	FICL_WORD_OBJECT	(8)
1249 
1250 /*
1251  * FICL_WORD_INSTRUCTION
1252  * This word represents a ficlInstruction, not a normal word.
1253  * param[0] is the instruction.
1254  * When compiled, Ficl will simply copy over the instruction,
1255  * rather than executing the word as normal.
1256  *
1257  * (Do *not* use this flag for words that need their PFA pushed
1258  * before executing!)
1259  */
1260 #define	FICL_WORD_INSTRUCTION	(16)
1261 
1262 /*
1263  * FICL_WORD_COMPILE_ONLY_IMMEDIATE
1264  * Most words that are "immediate" are also
1265  * "compile-only".
1266  */
1267 #define	FICL_WORD_COMPILE_ONLY_IMMEDIATE	\
1268 	(FICL_WORD_IMMEDIATE | FICL_WORD_COMPILE_ONLY)
1269 #define	FICL_WORD_DEFAULT	(0)
1270 
1271 /*
1272  * Worst-case size of a word header: FICL_NAME_LENGTH chars in name
1273  */
1274 #define	FICL_CELLS_PER_WORD	\
1275 	((sizeof (ficlWord) + FICL_NAME_LENGTH + sizeof (ficlCell)) \
1276 	/ (sizeof (ficlCell)))
1277 
1278 FICL_PLATFORM_EXTERN int ficlWordIsImmediate(ficlWord *word);
1279 FICL_PLATFORM_EXTERN int ficlWordIsCompileOnly(ficlWord *word);
1280 
1281 #if FICL_ROBUST >= 1
1282 FICL_PLATFORM_EXTERN void
1283 ficlCallbackAssert(ficlCallback *callback, int expression,
1284     char *expressionString, char *filename, int line);
1285 #define	FICL_ASSERT(callback, expression)	\
1286 (ficlCallbackAssert((callback), (expression) != 0, \
1287 #expression, __FILE__, __LINE__))
1288 #else
1289 #define	FICL_ASSERT(callback, expression)
1290 #endif /* FICL_ROBUST >= 1 */
1291 
1292 #define	FICL_VM_ASSERT(vm, expression)	\
1293 	FICL_ASSERT((ficlCallback *)(vm), (expression))
1294 #define	FICL_SYSTEM_ASSERT(system, expression)	\
1295 	FICL_ASSERT((ficlCallback *)(system), (expression))
1296 
1297 /*
1298  * Generally useful string manipulators omitted by ANSI C...
1299  * ltoa complements strtol
1300  */
1301 
1302 FICL_PLATFORM_EXTERN int ficlIsPowerOfTwo(ficlUnsigned u);
1303 FICL_PLATFORM_EXTERN char *
1304 ficlLtoa(ficlInteger value, char *string, int radix);
1305 FICL_PLATFORM_EXTERN char *
1306 ficlUltoa(ficlUnsigned value, char *string, int radix);
1307 FICL_PLATFORM_EXTERN char ficlDigitToCharacter(int value);
1308 FICL_PLATFORM_EXTERN char *ficlStringReverse(char *string);
1309 FICL_PLATFORM_EXTERN char *ficlStringSkipSpace(char *s, char *end);
1310 FICL_PLATFORM_EXTERN char *ficlStringCaseFold(char *s);
1311 FICL_PLATFORM_EXTERN int ficlStrincmp(char *s1, char *s2, ficlUnsigned length);
1312 FICL_PLATFORM_EXTERN void *ficlAlignPointer(void *ptr);
1313 
1314 /*
1315  * Ficl hash table - variable size.
1316  * assert(size > 0)
1317  * If size is 1, the table degenerates into a linked list.
1318  * A WORDLIST (see the search order word set in DPANS) is
1319  * just a pointer to a FICL_HASH in this implementation.
1320  */
1321 typedef struct ficlHash
1322 {
1323     struct ficlHash *link;	/* link to parent class wordlist for OO */
1324     char *name;		/* optional pointer to \0 terminated wordlist name */
1325     unsigned size;		/* number of buckets in the hash */
1326     ficlWord *table[1];
1327 } ficlHash;
1328 
1329 FICL_PLATFORM_EXTERN void ficlHashForget(ficlHash *hash, void *where);
1330 FICL_PLATFORM_EXTERN ficlUnsigned16 ficlHashCode(ficlString s);
1331 FICL_PLATFORM_EXTERN void ficlHashInsertWord(ficlHash *hash, ficlWord *word);
1332 FICL_PLATFORM_EXTERN ficlWord *
1333 ficlHashLookup(ficlHash *hash, ficlString name, ficlUnsigned16 hashCode);
1334 FICL_PLATFORM_EXTERN void ficlHashReset(ficlHash *hash);
1335 
1336 /*
1337  * A Dictionary is a linked list of FICL_WORDs. It is also Ficl's
1338  * memory model. Description of fields:
1339  *
1340  * here -- points to the next free byte in the dictionary. This
1341  *	pointer is forced to be CELL-aligned before a definition is added.
1342  *	Do not assume any specific alignment otherwise - Use dictAlign().
1343  *
1344  * smudge -- pointer to word currently being defined (or last defined word)
1345  *	If the definition completes successfully, the word will be
1346  *	linked into the hash table. If unsuccessful, dictUnsmudge
1347  *	uses this pointer to restore the previous state of the dictionary.
1348  *	Smudge prevents unintentional recursion as a side-effect: the
1349  *	dictionary search algo examines only completed definitions, so a
1350  *	word cannot invoke itself by name. See the Ficl word "recurse".
1351  *	NOTE: smudge always points to the last word defined. IMMEDIATE
1352  *	makes use of this fact. Smudge is initially NULL.
1353  *
1354  * forthWordlist -- pointer to the default wordlist (FICL_HASH).
1355  *	This is the initial compilation list, and contains all
1356  *	Ficl's precompiled words.
1357  *
1358  * compilationWordlist -- compilation wordlist - initially equal to
1359  * forthWordlist wordlists  -- array of pointers to wordlists.
1360  *	Managed as a stack.
1361  *	Highest index is the first list in the search order.
1362  * wordlistCount   -- number of lists in wordlists. wordlistCount-1 is the
1363  *	highest filled slot in wordlists, and points to the first wordlist
1364  *	in the search order
1365  * size -- number of cells in the dictionary (total)
1366  * base -- start of data area. Must be at the end of the struct.
1367  */
1368 struct ficlDictionary
1369 {
1370     ficlCell *here;
1371     void *context; /* for your use, particularly with ficlDictionaryLock() */
1372     ficlWord *smudge;
1373     ficlHash *forthWordlist;
1374     ficlHash *compilationWordlist;
1375     ficlHash *wordlists[FICL_MAX_WORDLISTS];
1376     int wordlistCount;
1377     unsigned size;		/* Number of cells in dictionary (total) */
1378     ficlSystem *system;		/* used for debugging */
1379     ficlCell base[1];		/* Base of dictionary memory */
1380 };
1381 
1382 FICL_PLATFORM_EXTERN void
1383 ficlDictionaryAbortDefinition(ficlDictionary *dictionary);
1384 FICL_PLATFORM_EXTERN void ficlDictionaryAlign(ficlDictionary *dictionary);
1385 FICL_PLATFORM_EXTERN void
1386 ficlDictionaryAllot(ficlDictionary *dictionary, int n);
1387 FICL_PLATFORM_EXTERN void
1388 ficlDictionaryAllotCells(ficlDictionary *dictionary, int nCells);
1389 FICL_PLATFORM_EXTERN void
1390 ficlDictionaryAppendCell(ficlDictionary *dictionary, ficlCell c);
1391 FICL_PLATFORM_EXTERN void
1392 ficlDictionaryAppendCharacter(ficlDictionary *dictionary, char c);
1393 FICL_PLATFORM_EXTERN void
1394 ficlDictionaryAppendUnsigned(ficlDictionary *dictionary, ficlUnsigned u);
1395 FICL_PLATFORM_EXTERN void *
1396 ficlDictionaryAppendData(ficlDictionary *dictionary, void *data,
1397     ficlInteger length);
1398 FICL_PLATFORM_EXTERN char *
1399 ficlDictionaryAppendString(ficlDictionary *dictionary, ficlString s);
1400 FICL_PLATFORM_EXTERN ficlWord *
1401 ficlDictionaryAppendWord(ficlDictionary *dictionary, ficlString name,
1402     ficlPrimitive pCode, ficlUnsigned8 flags);
1403 FICL_PLATFORM_EXTERN ficlWord *
1404 ficlDictionaryAppendPrimitive(ficlDictionary *dictionary, char *name,
1405     ficlPrimitive pCode, ficlUnsigned8 flags);
1406 FICL_PLATFORM_EXTERN ficlWord *
1407 ficlDictionaryAppendInstruction(ficlDictionary *dictionary, char *name,
1408     ficlInstruction i, ficlUnsigned8 flags);
1409 
1410 FICL_PLATFORM_EXTERN ficlWord *
1411 ficlDictionaryAppendConstantInstruction(ficlDictionary *dictionary,
1412     ficlString name, ficlInstruction instruction, ficlInteger value);
1413 FICL_PLATFORM_EXTERN ficlWord *
1414 ficlDictionaryAppend2ConstantInstruction(ficlDictionary *dictionary,
1415     ficlString name, ficlInstruction instruction, ficl2Integer value);
1416 
1417 FICL_PLATFORM_EXTERN ficlWord *
1418 ficlDictionaryAppendConstant(ficlDictionary *dictionary, char *name,
1419     ficlInteger value);
1420 FICL_PLATFORM_EXTERN ficlWord *
1421 ficlDictionaryAppend2Constant(ficlDictionary *dictionary, char *name,
1422     ficl2Integer value);
1423 #define	ficlDictionaryAppendConstantPointer(dictionary, name, pointer)	\
1424 	(ficlDictionaryAppendConstant(dictionary, name, (ficlInteger)pointer))
1425 #if FICL_WANT_FLOAT
1426 FICL_PLATFORM_EXTERN ficlWord *
1427 ficlDictionaryAppendFConstant(ficlDictionary *dictionary, char *name,
1428     ficlFloat value);
1429 FICL_PLATFORM_EXTERN ficlWord *
1430 ficlDictionaryAppendF2Constant(ficlDictionary *dictionary, char *name,
1431     ficlFloat value);
1432 #endif /* FICL_WANT_FLOAT */
1433 
1434 
1435 FICL_PLATFORM_EXTERN ficlWord *
1436 ficlDictionarySetConstantInstruction(ficlDictionary *dictionary,
1437     ficlString name, ficlInstruction instruction, ficlInteger value);
1438 FICL_PLATFORM_EXTERN ficlWord *
1439 ficlDictionarySet2ConstantInstruction(ficlDictionary *dictionary,
1440     ficlString name, ficlInstruction instruction, ficl2Integer value);
1441 
1442 FICL_PLATFORM_EXTERN ficlWord *
1443 ficlDictionarySetConstant(ficlDictionary *dictionary, char *name,
1444     ficlInteger value);
1445 #define	ficlDictionarySetConstantPointer(dictionary, name, pointer) \
1446 	(ficlDictionarySetConstant(dictionary, name, (ficlInteger)pointer))
1447 
1448 FICL_PLATFORM_EXTERN ficlWord *
1449 ficlDictionarySet2Constant(ficlDictionary *dictionary, char *name,
1450     ficl2Integer value);
1451 FICL_PLATFORM_EXTERN ficlWord *
1452 ficlDictionarySetConstantString(ficlDictionary *dictionary, char *name,
1453     char *value);
1454 FICL_PLATFORM_EXTERN ficlWord *
1455 ficlDictionarySetPrimitive(ficlDictionary *dictionary, char *name,
1456     ficlPrimitive code, ficlUnsigned8 flags);
1457 FICL_PLATFORM_EXTERN ficlWord *
1458 ficlDictionarySetInstruction(ficlDictionary *dictionary, char *name,
1459     ficlInstruction i, ficlUnsigned8 flags);
1460 #if FICL_WANT_FLOAT
1461 FICL_PLATFORM_EXTERN ficlWord *
1462 ficlDictionarySetFConstant(ficlDictionary *dictionary, char *name,
1463     ficlFloat value);
1464 FICL_PLATFORM_EXTERN ficlWord *
1465 ficlDictionarySetF2Constant(ficlDictionary *dictionary, char *name,
1466     ficlFloat value);
1467 #endif /* FICL_WANT_FLOAT */
1468 
1469 FICL_PLATFORM_EXTERN int
1470 ficlDictionaryCellsAvailable(ficlDictionary *dictionary);
1471 FICL_PLATFORM_EXTERN int ficlDictionaryCellsUsed(ficlDictionary *dictionary);
1472 FICL_PLATFORM_EXTERN ficlDictionary *
1473 ficlDictionaryCreate(ficlSystem *system, unsigned nCELLS);
1474 FICL_PLATFORM_EXTERN ficlDictionary *
1475 ficlDictionaryCreateHashed(ficlSystem *system, unsigned nCells, unsigned nHash);
1476 FICL_PLATFORM_EXTERN ficlHash *
1477 ficlDictionaryCreateWordlist(ficlDictionary *dictionary, int nBuckets);
1478 FICL_PLATFORM_EXTERN void ficlDictionaryDestroy(ficlDictionary *dictionary);
1479 FICL_PLATFORM_EXTERN void
1480 ficlDictionaryEmpty(ficlDictionary *dictionary, unsigned nHash);
1481 FICL_PLATFORM_EXTERN int
1482 ficlDictionaryIncludes(ficlDictionary *dictionary, void *p);
1483 FICL_PLATFORM_EXTERN ficlWord *
1484 ficlDictionaryLookup(ficlDictionary *dictionary, ficlString name);
1485 FICL_PLATFORM_EXTERN void
1486 ficlDictionaryResetSearchOrder(ficlDictionary *dictionary);
1487 FICL_PLATFORM_EXTERN void
1488 ficlDictionarySetFlags(ficlDictionary *dictionary, ficlUnsigned8 set);
1489 FICL_PLATFORM_EXTERN void
1490 ficlDictionaryClearFlags(ficlDictionary *dictionary, ficlUnsigned8 clear);
1491 FICL_PLATFORM_EXTERN void
1492 ficlDictionarySetImmediate(ficlDictionary *dictionary);
1493 FICL_PLATFORM_EXTERN void
1494 ficlDictionaryUnsmudge(ficlDictionary *dictionary);
1495 FICL_PLATFORM_EXTERN ficlCell *ficlDictionaryWhere(ficlDictionary *dictionary);
1496 
1497 FICL_PLATFORM_EXTERN int
1498 ficlDictionaryIsAWord(ficlDictionary *dictionary, ficlWord *word);
1499 FICL_PLATFORM_EXTERN void
1500 ficlDictionarySee(ficlDictionary *dictionary, ficlWord *word,
1501     ficlCallback *callback);
1502 FICL_PLATFORM_EXTERN ficlWord *
1503 ficlDictionaryFindEnclosingWord(ficlDictionary *dictionary, ficlCell *cell);
1504 
1505 /*
1506  * Stub function for dictionary access control - does nothing
1507  * by default, user can redefine to guarantee exclusive dictionary
1508  * access to a single thread for updates. All dictionary update code
1509  * must be bracketed as follows:
1510  * ficlLockDictionary(dictionary, FICL_TRUE); // any non-zero value will do
1511  * <code that updates dictionary>
1512  * ficlLockDictionary(dictionary, FICL_FALSE);
1513  *
1514  * Returns zero if successful, nonzero if unable to acquire lock
1515  * before timeout (optional - could also block forever)
1516  *
1517  * NOTE: this function must be implemented with lock counting
1518  * semantics: nested calls must behave properly.
1519  */
1520 #if FICL_MULTITHREAD
1521 FICL_PLATFORM_EXTERN int
1522 	ficlDictionaryLock(ficlDictionary *dictionary, short lockIncrement);
1523 #else
1524 #define	ficlDictionaryLock(dictionary, lock) (void)0 /* ignore */
1525 #endif
1526 
1527 /*
1528  * P A R S E   S T E P
1529  * (New for 2.05)
1530  * See words.c: interpWord
1531  * By default, Ficl goes through two attempts to parse each token from its
1532  * input stream: it first attempts to match it with a word in the dictionary,
1533  * and if that fails, it attempts to convert it into a number. This mechanism
1534  * is now extensible by additional steps. This allows extensions like floating
1535  * point and double number support to be factored cleanly.
1536  *
1537  * Each parse step is a function that receives the next input token as a
1538  * STRINGINFO. If the parse step matches the token, it must apply semantics
1539  * to the token appropriate to the present value of VM.state (compiling or
1540  * interpreting), and return FICL_TRUE.
1541  * Otherwise it returns FICL_FALSE. See words.c: isNumber for an example
1542  *
1543  * Note: for the sake of efficiency, it's a good idea both to limit the number
1544  * of parse steps and to code each parse step so that it rejects tokens that
1545  * do not match as quickly as possible.
1546  */
1547 
1548 typedef int (*ficlParseStep)(ficlVm *vm, ficlString s);
1549 
1550 /*
1551  * FICL_BREAKPOINT record.
1552  * oldXT - if NULL, this breakpoint is unused. Otherwise it stores the xt
1553  * that the breakpoint overwrote. This is restored to the dictionary when the
1554  * BP executes or gets cleared
1555  * address - the location of the breakpoint (address of the instruction that
1556  *           has been replaced with the breakpoint trap
1557  * oldXT  - The original contents of the location with the breakpoint
1558  * Note: address is NULL when this breakpoint is empty
1559  */
1560 typedef struct ficlBreakpoint
1561 {
1562 	void *address;
1563 	ficlWord *oldXT;
1564 } ficlBreakpoint;
1565 
1566 
1567 /*
1568  * F I C L _ S Y S T E M
1569  * The top level data structure of the system - ficl_system ties a list of
1570  * virtual machines with their corresponding dictionaries. Ficl 3.0 added
1571  * support for multiple Ficl systems, allowing multiple concurrent sessions
1572  * to separate dictionaries with some constraints.
1573  * Note: the context pointer is there to provide context for applications.
1574  * It is copied to each VM's context field as that VM is created.
1575  */
1576 struct ficlSystemInformation
1577 {
1578     int size;			/* structure size tag for versioning */
1579 		/* Initializes VM's context pointer - for application use */
1580     void *context;
1581     int dictionarySize;		/* Size of system's Dictionary, in cells */
1582     int stackSize;		/* Size of all stacks created, in cells */
1583     ficlOutputFunction textOut;		/* default textOut function */
1584     ficlOutputFunction errorOut;	/* textOut function used for errors */
1585     int environmentSize;	/* Size of Environment dictionary, in cells */
1586 };
1587 
1588 #define	ficlSystemInformationInitialize(x)	\
1589 	{ memset((x), 0, sizeof (ficlSystemInformation)); \
1590 	(x)->size = sizeof (ficlSystemInformation); }
1591 
1592 struct ficlSystem
1593 {
1594     ficlCallback callback;
1595     ficlSystem *link;
1596     ficlVm *vmList;
1597     ficlDictionary *dictionary;
1598     ficlDictionary *environment;
1599 
1600     ficlWord *interpreterLoop[3];
1601     ficlWord *parseList[FICL_MAX_PARSE_STEPS];
1602 
1603     ficlWord *exitInnerWord;
1604     ficlWord *interpretWord;
1605 
1606 #if FICL_WANT_LOCALS
1607     ficlDictionary *locals;
1608     ficlInteger   localsCount;
1609     ficlCell *localsFixup;
1610 #endif
1611 
1612     ficlInteger stackSize;
1613 
1614     ficlBreakpoint breakpoint;
1615 };
1616 
1617 #define	ficlSystemGetContext(system)	((system)->context)
1618 
1619 /*
1620  * External interface to Ficl...
1621  */
1622 /*
1623  * f i c l S y s t e m C r e a t e
1624  * Binds a global dictionary to the interpreter system and initializes
1625  * the dictionary to contain the ANSI CORE wordset.
1626  * You can specify the address and size of the allocated area.
1627  * You can also specify the text output function at creation time.
1628  * After that, Ficl manages it.
1629  * First step is to set up the static pointers to the area.
1630  * Then write the "precompiled" portion of the dictionary in.
1631  * The dictionary needs to be at least large enough to hold the
1632  * precompiled part. Try 1K cells minimum. Use "words" to find
1633  * out how much of the dictionary is used at any time.
1634  */
1635 FICL_PLATFORM_EXTERN ficlSystem *ficlSystemCreate(ficlSystemInformation *fsi);
1636 
1637 /*
1638  * f i c l S y s t e m D e s t r o y
1639  * Deletes the system dictionary and all virtual machines that
1640  * were created with ficlNewVM (see below). Call this function to
1641  * reclaim all memory used by the dictionary and VMs.
1642  */
1643 FICL_PLATFORM_EXTERN void ficlSystemDestroy(ficlSystem *system);
1644 
1645 /*
1646  * Create a new VM from the heap, and link it into the system VM list.
1647  * Initializes the VM and binds default sized stacks to it. Returns the
1648  * address of the VM, or NULL if an error occurs.
1649  * Precondition: successful execution of ficlInitSystem
1650  */
1651 FICL_PLATFORM_EXTERN ficlVm   *ficlSystemCreateVm(ficlSystem *system);
1652 
1653 /*
1654  * Force deletion of a VM. You do not need to do this
1655  * unless you're creating and discarding a lot of VMs.
1656  * For systems that use a constant pool of VMs for the life
1657  * of the system, ficltermSystem takes care of VM cleanup
1658  * automatically.
1659  */
1660 FICL_PLATFORM_EXTERN void ficlSystemDestroyVm(ficlVm *vm);
1661 
1662 
1663 /*
1664  * Returns the address of the most recently defined word in the system
1665  * dictionary with the given name, or NULL if no match.
1666  * Precondition: successful execution of ficlInitSystem
1667  */
1668 FICL_PLATFORM_EXTERN ficlWord *ficlSystemLookup(ficlSystem *system, char *name);
1669 
1670 /*
1671  * f i c l G e t D i c t
1672  * Utility function - returns the address of the system dictionary.
1673  * Precondition: successful execution of ficlInitSystem
1674  */
1675 ficlDictionary *ficlSystemGetDictionary(ficlSystem *system);
1676 ficlDictionary *ficlSystemGetEnvironment(ficlSystem *system);
1677 #if FICL_WANT_LOCALS
1678 ficlDictionary *ficlSystemGetLocals(ficlSystem *system);
1679 #endif
1680 
1681 /*
1682  * f i c l C o m p i l e C o r e
1683  * Builds the ANS CORE wordset into the dictionary - called by
1684  * ficlInitSystem - no need to waste dictionary space by doing it again.
1685  */
1686 FICL_PLATFORM_EXTERN void ficlSystemCompileCore(ficlSystem *system);
1687 FICL_PLATFORM_EXTERN void ficlSystemCompilePrefix(ficlSystem *system);
1688 FICL_PLATFORM_EXTERN void ficlSystemCompileSearch(ficlSystem *system);
1689 FICL_PLATFORM_EXTERN void ficlSystemCompileSoftCore(ficlSystem *system);
1690 FICL_PLATFORM_EXTERN void ficlSystemCompileTools(ficlSystem *system);
1691 FICL_PLATFORM_EXTERN void ficlSystemCompileFile(ficlSystem *system);
1692 #if FICL_WANT_FLOAT
1693 FICL_PLATFORM_EXTERN void ficlSystemCompileFloat(ficlSystem *system);
1694 FICL_PLATFORM_EXTERN int ficlVmParseFloatNumber(ficlVm *vm, ficlString s);
1695 #endif /* FICL_WANT_FLOAT */
1696 #if FICL_WANT_PLATFORM
1697 FICL_PLATFORM_EXTERN void ficlSystemCompilePlatform(ficlSystem *system);
1698 #endif /* FICL_WANT_PLATFORM */
1699 FICL_PLATFORM_EXTERN void ficlSystemCompileExtras(ficlSystem *system);
1700 
1701 
1702 FICL_PLATFORM_EXTERN int ficlVmParsePrefix(ficlVm *vm, ficlString s);
1703 
1704 #if FICL_WANT_LOCALS
1705 FICL_PLATFORM_EXTERN ficlWord *ficlSystemLookupLocal(ficlSystem *system,
1706     ficlString name);
1707 #endif
1708 
1709 /*
1710  * from words.c...
1711  */
1712 FICL_PLATFORM_EXTERN int ficlVmParseNumber(ficlVm *vm, ficlString s);
1713 FICL_PLATFORM_EXTERN void ficlPrimitiveTick(ficlVm *vm);
1714 FICL_PLATFORM_EXTERN void ficlPrimitiveParseStepParen(ficlVm *vm);
1715 FICL_PLATFORM_EXTERN void ficlPrimitiveSiftingImpl(ficlVm *vm, char *ss);
1716 #if FICL_WANT_LOCALS
1717 FICL_PLATFORM_EXTERN void ficlLocalParen(ficlVm *vm, int isDouble, int isFloat);
1718 #endif /* FICL_WANT_LOCALS */
1719 
1720 /*
1721  * Appends a parse step function to the end of the parse list (see
1722  * FICL_PARSE_STEP notes in ficl.h for details). Returns 0 if successful,
1723  * nonzero if there's no more room in the list. Each parse step is a word in
1724  * the dictionary. Precompiled parse steps can use (PARSE-STEP) as their
1725  * CFA - see parenParseStep in words.c.
1726  */
1727 FICL_PLATFORM_EXTERN int ficlSystemAddParseStep(ficlSystem *system,
1728     ficlWord *word); /* ficl.c */
1729 FICL_PLATFORM_EXTERN void ficlSystemAddPrimitiveParseStep(ficlSystem *system,
1730     char *name, ficlParseStep pStep);
1731 
1732 /*
1733  * From tools.c
1734  */
1735 
1736 /*
1737  * The following supports SEE and the debugger.
1738  */
1739 typedef enum
1740 {
1741     FICL_WORDKIND_BRANCH,
1742     FICL_WORDKIND_BRANCH0,
1743     FICL_WORDKIND_COLON,
1744     FICL_WORDKIND_CONSTANT,
1745     FICL_WORDKIND_2CONSTANT,
1746     FICL_WORDKIND_CREATE,
1747     FICL_WORDKIND_DO,
1748     FICL_WORDKIND_DOES,
1749     FICL_WORDKIND_LITERAL,
1750     FICL_WORDKIND_2LITERAL,
1751 #if FICL_WANT_FLOAT
1752     FICL_WORDKIND_FLITERAL,
1753 #endif /* FICL_WANT_FLOAT */
1754     FICL_WORDKIND_LOOP,
1755     FICL_WORDKIND_OF,
1756     FICL_WORDKIND_PLOOP,
1757     FICL_WORDKIND_PRIMITIVE,
1758     FICL_WORDKIND_QDO,
1759     FICL_WORDKIND_STRING_LITERAL,
1760     FICL_WORDKIND_CSTRING_LITERAL,
1761 #if FICL_WANT_USER
1762     FICL_WORDKIND_USER,
1763 #endif
1764     FICL_WORDKIND_VARIABLE,
1765     FICL_WORDKIND_INSTRUCTION,
1766     FICL_WORDKIND_INSTRUCTION_WORD,
1767     FICL_WORDKIND_INSTRUCTION_WITH_ARGUMENT
1768 } ficlWordKind;
1769 
1770 ficlWordKind   ficlWordClassify(ficlWord *word);
1771 
1772 #if FICL_WANT_FILE
1773 /*
1774  * Used with File-Access wordset.
1775  */
1776 #define	FICL_FAM_READ	1
1777 #define	FICL_FAM_WRITE	2
1778 #define	FICL_FAM_APPEND	4
1779 #define	FICL_FAM_BINARY	8
1780 
1781 #define	FICL_FAM_OPEN_MODE(fam)	\
1782 	((fam) & (FICL_FAM_READ | FICL_FAM_WRITE | FICL_FAM_APPEND))
1783 
1784 typedef struct ficlFile
1785 {
1786     FILE *f;
1787     char filename[256];
1788 } ficlFile;
1789 
1790 #if defined(FICL_PLATFORM_HAS_FTRUNCATE)
1791 FICL_PLATFORM_EXTERN int ficlFileTruncate(ficlFile *ff, ficlUnsigned size);
1792 #endif
1793 
1794 FICL_PLATFORM_EXTERN int ficlFileStatus(char *filename, int *status);
1795 FICL_PLATFORM_EXTERN long ficlFileSize(ficlFile *ff);
1796 #endif
1797 
1798 /* Support for linker set inclusions. */
1799 #ifdef _STANDALONE
1800 typedef void ficlCompileFcn(ficlSystem *);
1801 
1802 #define	FICL_COMPILE_SET(func)  \
1803 	DATA_SET(Xficl_compile_set, func)
1804 SET_DECLARE(Xficl_compile_set, ficlCompileFcn);
1805 #endif	/* _STANDALONE */
1806 
1807 #ifdef __cplusplus
1808 }
1809 #endif
1810 
1811 #endif /* _FICL_H */
1812