1 /*******************************************************************
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 *******************************************************************/
10 ** Copyright (c) 1997-2001 John Sadler (john_sadler@alum.mit.edu)
11 ** All rights reserved.
13 ** Get the latest Ficl release at http://ficl.sourceforge.net
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.
20 ** L I C E N S E and D I S C L A I M E R
22 ** Redistribution and use in source and binary forms, with or without
23 ** modification, are permitted provided that the following conditions
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.
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
45 * $FreeBSD: src/sys/boot/ficl/ficl.h,v 1.22 2007/03/23 22:26:01 jkim Exp $
46 * $DragonFly: src/sys/boot/ficl/ficl.h,v 1.4 2008/03/29 23:31:07 swildner Exp $
49 #if !defined (__FICL_H__)
52 ** Ficl (Forth-inspired command language) is an ANS Forth
53 ** interpreter written in C. Unlike traditional Forths, this
54 ** interpreter is designed to be embedded into other systems
55 ** as a command/macro/development prototype language.
57 ** Where Forths usually view themselves as the center of the system
58 ** and expect the rest of the system to be coded in Forth, Ficl
59 ** acts as a component of the system. It is easy to export
60 ** code written in C or ASM to Ficl in the style of TCL, or to invoke
61 ** Ficl code from a compiled module. This allows you to do incremental
62 ** development in a way that combines the best features of threaded
63 ** languages (rapid development, quick code/test/debug cycle,
64 ** reasonably fast) with the best features of C (everyone knows it,
65 ** easier to support large blocks of code, efficient, type checking).
67 ** Ficl provides facilities for interoperating
68 ** with programs written in C: C functions can be exported to Ficl,
69 ** and Ficl commands can be executed via a C calling interface. The
70 ** interpreter is re-entrant, so it can be used in multiple instances
71 ** in a multitasking system. Unlike Forth, Ficl's outer interpreter
72 ** expects a text block as input, and returns to the caller after each
73 ** text block, so the "data pump" is somewhere in external code. This
74 ** is more like TCL than Forth, which usually expcets to be at the center
75 ** of the system, requesting input at its convenience. Each Ficl virtual
76 ** machine can be bound to a different I/O channel, and is independent
77 ** of all others in in the same address space except that all virtual
78 ** machines share a common dictionary (a sort or open symbol table that
79 ** defines all of the elements of the language).
81 ** Code is written in ANSI C for portability.
83 ** Summary of Ficl features and constraints:
84 ** - Standard: Implements the ANSI Forth CORE word set and part
85 ** of the CORE EXT word-set, SEARCH and SEARCH EXT, TOOLS and
86 ** TOOLS EXT, LOCAL and LOCAL ext and various extras.
87 ** - Extensible: you can export code written in Forth, C,
88 ** or asm in a straightforward way. Ficl provides open
89 ** facilities for extending the language in an application
90 ** specific way. You can even add new control structures!
91 ** - Ficl and C can interact in two ways: Ficl can encapsulate
92 ** C code, or C code can invoke Ficl code.
93 ** - Thread-safe, re-entrant: The shared system dictionary
94 ** uses a locking mechanism that you can either supply
95 ** or stub out to provide exclusive access. Each Ficl
96 ** virtual machine has an otherwise complete state, and
97 ** each can be bound to a separate I/O channel (or none at all).
98 ** - Simple encapsulation into existing systems: a basic implementation
99 ** requires three function calls (see the example program in testmain.c).
100 ** - ROMable: Ficl is designed to work in RAM-based and ROM code / RAM data
101 ** environments. It does require somewhat more memory than a pure
102 ** ROM implementation because it builds its system dictionary in
103 ** RAM at startup time.
104 ** - Written an ANSI C to be as simple as I can make it to understand,
105 ** support, debug, and port. Compiles without complaint at /Az /W4
106 ** (require ANSI C, max warnings) under Microsoft VC++ 5.
107 ** - Does full 32 bit math (but you need to implement
108 ** two mixed precision math primitives (see sysdep.c))
109 ** - Indirect threaded interpreter is not the fastest kind of
110 ** Forth there is (see pForth 68K for a really fast subroutine
111 ** threaded interpreter), but it's the cleanest match to a
112 ** pure C implementation.
114 ** P O R T I N G F i c l
116 ** To install Ficl on your target system, you need an ANSI C compiler
117 ** and its runtime library. Inspect the system dependent macros and
118 ** functions in sysdep.h and sysdep.c and edit them to suit your
119 ** system. For example, INT16 is a short on some compilers and an
120 ** int on others. Check the default CELL alignment controlled by
121 ** FICL_ALIGN. If necessary, add new definitions of ficlMalloc, ficlFree,
122 ** ficlLockDictionary, and ficlTextOut to work with your operating system.
123 ** Finally, use testmain.c as a guide to installing the Ficl system and
124 ** one or more virtual machines into your code. You do not need to include
125 ** testmain.c in your build.
129 ** 1. Unimplemented system dependent CORE word: key
130 ** 2. Ficl uses the PAD in some CORE words - this violates the standard,
131 ** but it's cleaner for a multithreaded system. I'll have to make a
132 ** second pad for reference by the word PAD to fix this.
134 ** F o r M o r e I n f o r m a t i o n
137 ** http://ficl.sourceforge.net
138 ** Check this website for Forth literature (including the ANSI standard)
139 ** http://www.taygeta.com/forthlit.html
140 ** and here for software and more links
141 ** http://www.taygeta.com/forth.html
143 ** Obvious Performance enhancement opportunities
145 ** - work on interpret speed
146 ** - turn off locals (FICL_WANT_LOCALS)
148 ** - Change inner interpreter (and everything else)
149 ** so that a definition is a list of pointers to functions
150 ** and inline data rather than pointers to words. This gets
151 ** rid of vm->runningWord and a level of indirection in the
152 ** inner loop. I'll look at it for ficl 3.0
153 ** - Make the main hash table a bigger prime (HASHSIZE)
154 ** - FORGET about twiddling the hash function - my experience is
155 ** that that is a waste of time.
156 ** - Eliminate the need to pass the pVM parameter on the stack
157 ** by dedicating a register to it. Most words need access to the
158 ** vm, but the parameter passing overhead can be reduced. One way
159 ** requires that the host OS have a task switch callout. Create
160 ** a global variable for the running VM and refer to it in words
161 ** that need VM access. Alternative: use thread local storage.
162 ** For single threaded implementations, you can just use a global.
163 ** The first two solutions create portability problems, so I
164 ** haven't considered doing them. Another possibility is to
165 ** declare the pVm parameter to be "register", and hope the compiler
173 ** 15 Apr 1999 (sadler) Merged FreeBSD changes for exception wordset and
174 ** counted strings in ficlExec.
175 ** 12 Jan 1999 (sobral) Corrected EVALUATE behavior. Now TIB has an
176 ** "end" field, and all words respect this. ficlExec is passed a "size"
177 ** of TIB, as well as vmPushTib. This size is used to calculate the "end"
178 ** of the string, ie, base+size. If the size is not known, pass -1.
180 ** 10 Jan 1999 (sobral) EXCEPTION word set has been added, and existing
181 ** words has been modified to conform to EXCEPTION EXT word set.
183 ** 27 Aug 1998 (sadler) testing and corrections for LOCALS, LOCALS EXT,
184 ** SEARCH / SEARCH EXT, TOOLS / TOOLS EXT.
185 ** Added .X to display in hex, PARSE and PARSE-WORD to supplement WORD,
186 ** EMPTY to clear stack.
188 ** 29 jun 1998 (sadler) added variable sized hash table support
189 ** and ANS Forth optional SEARCH & SEARCH EXT word set.
190 ** 26 May 1998 (sadler)
192 ** 14 April 1998 (sadler) V1.04
193 ** Ficlwin: Windows version, Skip Carter's Linux port
194 ** 5 March 1998 (sadler) V1.03
195 ** Bug fixes -- passes John Ryan's ANS test suite "core.fr"
197 ** 24 February 1998 (sadler) V1.02
198 ** -Fixed bugs in <# # #>
199 ** -Changed FICL_WORD so that storage for the name characters
200 ** can be allocated from the dictionary as needed rather than
201 ** reserving 32 bytes in each word whether needed or not -
202 ** this saved 50% of the dictionary storage requirement.
203 ** -Added words in testmain for Win32 functions system,chdir,cwd,
204 ** also added a word that loads and evaluates a file.
206 ** December 1997 (sadler)
207 ** -Added VM_RESTART exception handling in ficlExec -- this lets words
208 ** that require additional text to succeed (like :, create, variable...)
209 ** recover gracefully from an empty input buffer rather than emitting
210 ** an error message. Definitions can span multiple input blocks with
212 ** -Changed #include order so that <assert.h> is included in sysdep.h,
213 ** and sysdep is included in all other files. This lets you define
214 ** NDEBUG in sysdep.h to disable assertions if you want to.
215 ** -Make PC specific system dependent code conditional on _M_IX86
216 ** defined so that ports can coexist in sysdep.h/sysdep.c
224 #include <limits.h> /* UCHAR_MAX */
227 ** Forward declarations... read on.
230 typedef struct ficl_word FICL_WORD
;
232 typedef struct vm FICL_VM
;
234 typedef struct ficl_dict FICL_DICT
;
236 typedef struct ficl_system FICL_SYSTEM
;
237 struct ficl_system_info
;
238 typedef struct ficl_system_info FICL_SYSTEM_INFO
;
241 ** the Good Stuff starts here...
243 #define FICL_VER "3.03"
244 #define FICL_VER_MAJOR 3
245 #define FICL_VER_MINOR 3
246 #if !defined (FICL_PROMPT)
247 #define FICL_PROMPT "ok> "
251 ** ANS Forth requires false to be zero, and true to be the ones
252 ** complement of false... that unifies logical and bitwise operations
255 #define FICL_TRUE ((unsigned long)~(0L))
256 #define FICL_FALSE (0)
257 #define FICL_BOOL(x) ((x) ? FICL_TRUE : FICL_FALSE)
261 ** A CELL is the main storage type. It must be large enough
262 ** to contain a pointer or a scalar. In order to accommodate
263 ** 32 bit and 64 bit processors, use abstract types for int,
264 ** unsigned, and float.
270 #if (FICL_WANT_FLOAT)
278 ** LVALUEtoCELL does a little pointer trickery to cast any CELL sized
279 ** lvalue (informal definition: an expression whose result has an
280 ** address) to CELL. Remember that constants and casts are NOT
281 ** themselves lvalues!
283 #define LVALUEtoCELL(v) (*(CELL *)&v)
286 ** PTRtoCELL is a cast through void * intended to satisfy the
287 ** most outrageously pedantic compiler... (I won't mention
290 #define PTRtoCELL (CELL *)(void *)
291 #define PTRtoSTRING (FICL_STRING *)(void *)
294 ** Strings in FICL are stored in Pascal style - with a count
295 ** preceding the text. We'll also NULL-terminate them so that
296 ** they work with the usual C lib string functions. (Belt &
297 ** suspenders? You decide.)
298 ** STRINGINFO hides the implementation with a couple of
299 ** macros for use in internal routines.
302 typedef unsigned char FICL_COUNT
;
303 #define FICL_STRING_MAX UCHAR_MAX
304 typedef struct _ficl_string
316 #define SI_COUNT(si) (si.count)
317 #define SI_PTR(si) (si.cp)
318 #define SI_SETLEN(si, len) (si.count = (FICL_UNS)(len))
319 #define SI_SETPTR(si, ptr) (si.cp = (char *)(ptr))
321 ** Init a STRINGINFO from a pointer to NULL-terminated string
323 #define SI_PSZ(si, psz) \
324 {si.cp = psz; si.count = (FICL_COUNT)strlen(psz);}
326 ** Init a STRINGINFO from a pointer to FICL_STRING
328 #define SI_PFS(si, pfs) \
329 {si.cp = pfs->text; si.count = pfs->count;}
332 ** Ficl uses this little structure to hold the address of
333 ** the block of text it's working on and an index to the next
334 ** unconsumed character in the string. Traditionally, this is
335 ** done by a Text Input Buffer, so I've called this struct TIB.
337 ** Since this structure also holds the size of the input buffer,
338 ** and since evaluate requires that, let's put the size here.
339 ** The size is stored as an end-pointer because that is what the
340 ** null-terminated string aware functions find most easy to deal
342 ** Notice, though, that nobody really uses this except evaluate,
343 ** so it might just be moved to FICL_VM instead. (sobral)
354 ** Stacks get heavy use in Ficl and Forth...
355 ** Each virtual machine implements two of them:
356 ** one holds parameters (data), and the other holds return
357 ** addresses and control flow information for the virtual
358 ** machine. (Note: C's automatic stack is implicitly used,
359 ** but not modeled because it doesn't need to be...)
360 ** Here's an abstract type for a stack
362 typedef struct _ficlStack
364 FICL_UNS nCells
; /* size of the stack */
365 CELL
*pFrame
; /* link reg for stack frame */
366 CELL
*sp
; /* stack pointer */
367 CELL base
[1]; /* Top of stack */
371 ** Stack methods... many map closely to required Forth words.
373 FICL_STACK
*stackCreate (unsigned nCells
);
374 void stackDelete (FICL_STACK
*pStack
);
375 int stackDepth (FICL_STACK
*pStack
);
376 void stackDrop (FICL_STACK
*pStack
, int n
);
377 CELL
stackFetch (FICL_STACK
*pStack
, int n
);
378 CELL
stackGetTop (FICL_STACK
*pStack
);
379 void stackLink (FICL_STACK
*pStack
, int nCells
);
380 void stackPick (FICL_STACK
*pStack
, int n
);
381 CELL
stackPop (FICL_STACK
*pStack
);
382 void *stackPopPtr (FICL_STACK
*pStack
);
383 FICL_UNS
stackPopUNS (FICL_STACK
*pStack
);
384 FICL_INT
stackPopINT (FICL_STACK
*pStack
);
385 void stackPush (FICL_STACK
*pStack
, CELL c
);
386 void stackPushPtr (FICL_STACK
*pStack
, void *ptr
);
387 void stackPushUNS (FICL_STACK
*pStack
, FICL_UNS u
);
388 void stackPushINT (FICL_STACK
*pStack
, FICL_INT i
);
389 void stackReset (FICL_STACK
*pStack
);
390 void stackRoll (FICL_STACK
*pStack
, int n
);
391 void stackSetTop (FICL_STACK
*pStack
, CELL c
);
392 void stackStore (FICL_STACK
*pStack
, int n
, CELL c
);
393 void stackUnlink (FICL_STACK
*pStack
);
395 #if (FICL_WANT_FLOAT)
396 float stackPopFloat (FICL_STACK
*pStack
);
397 void stackPushFloat(FICL_STACK
*pStack
, FICL_FLOAT f
);
401 ** Shortcuts (Guy Carver)
403 #define PUSHPTR(p) stackPushPtr(pVM->pStack,p)
404 #define PUSHUNS(u) stackPushUNS(pVM->pStack,u)
405 #define PUSHINT(i) stackPushINT(pVM->pStack,i)
406 #define PUSHFLOAT(f) stackPushFloat(pVM->fStack,f)
407 #define PUSH(c) stackPush(pVM->pStack,c)
408 #define POPPTR() stackPopPtr(pVM->pStack)
409 #define POPUNS() stackPopUNS(pVM->pStack)
410 #define POPINT() stackPopINT(pVM->pStack)
411 #define POPFLOAT() stackPopFloat(pVM->fStack)
412 #define POP() stackPop(pVM->pStack)
413 #define GETTOP() stackGetTop(pVM->pStack)
414 #define SETTOP(c) stackSetTop(pVM->pStack,LVALUEtoCELL(c))
415 #define GETTOPF() stackGetTop(pVM->fStack)
416 #define SETTOPF(c) stackSetTop(pVM->fStack,LVALUEtoCELL(c))
417 #define STORE(n,c) stackStore(pVM->pStack,n,LVALUEtoCELL(c))
418 #define DEPTH() stackDepth(pVM->pStack)
419 #define DROP(n) stackDrop(pVM->pStack,n)
420 #define DROPF(n) stackDrop(pVM->fStack,n)
421 #define FETCH(n) stackFetch(pVM->pStack,n)
422 #define PICK(n) stackPick(pVM->pStack,n)
423 #define PICKF(n) stackPick(pVM->fStack,n)
424 #define ROLL(n) stackRoll(pVM->pStack,n)
425 #define ROLLF(n) stackRoll(pVM->fStack,n)
428 ** The virtual machine (VM) contains the state for one interpreter.
429 ** Defined operations include:
430 ** Create & initialize
432 ** Execute a block of text
433 ** Parse a word out of the input stream
434 ** Call return, and branch
436 ** Throw an exception
439 typedef FICL_WORD
** IPTYPE
; /* the VM's instruction pointer */
442 ** Each VM has a placeholder for an output function -
443 ** this makes it possible to have each VM do I/O
444 ** through a different device. If you specify no
445 ** OUTFUNC, it defaults to ficlTextOut.
447 typedef void (*OUTFUNC
)(FICL_VM
*pVM
, char *text
, int fNewline
);
450 ** Each VM operates in one of two non-error states: interpreting
451 ** or compiling. When interpreting, words are simply executed.
452 ** When compiling, most words in the input stream have their
453 ** addresses inserted into the word under construction. Some words
454 ** (known as IMMEDIATE) are executed in the compile state, too.
456 /* values of STATE */
461 ** The pad is a small scratch area for text manipulation. ANS Forth
462 ** requires it to hold at least 84 characters.
469 ** ANS Forth requires that a word's name contain {1..31} characters.
471 #if !defined nFICLNAME
476 ** OK - now we can really define the VM...
480 FICL_SYSTEM
*pSys
; /* Which system this VM belongs to */
481 FICL_VM
*link
; /* Ficl keeps a VM list for simple teardown */
482 jmp_buf *pState
; /* crude exception mechanism... */
483 OUTFUNC textOut
; /* Output callback - see sysdep.c */
484 void * pExtend
; /* vm extension pointer for app use - initialized from FICL_SYSTEM */
485 short fRestart
; /* Set TRUE to restart runningWord */
486 IPTYPE ip
; /* instruction pointer */
487 FICL_WORD
*runningWord
;/* address of currently running word (often just *(ip-1) ) */
488 FICL_UNS state
; /* compiling or interpreting */
489 FICL_UNS base
; /* number conversion base */
490 FICL_STACK
*pStack
; /* param stack */
491 FICL_STACK
*rStack
; /* return stack */
493 FICL_STACK
*fStack
; /* float stack (optional) */
495 CELL sourceID
; /* -1 if EVALUATE, 0 if normal input */
496 TIB tib
; /* address of incoming text string */
498 CELL user
[FICL_USER_CELLS
];
500 char pad
[nPAD
]; /* the scratch area (see above) */
504 ** A FICL_CODE points to a function that gets called to help execute
505 ** a word in the dictionary. It always gets passed a pointer to the
506 ** running virtual machine, and from there it can get the address
507 ** of the parameter area of the word it's supposed to operate on.
508 ** For precompiled words, the code is all there is. For user defined
509 ** words, the code assumes that the word's parameter area is a list
510 ** of pointers to the code fields of other words to execute, and
511 ** may also contain inline data. The first parameter is always
512 ** a pointer to a code field.
514 typedef void (*FICL_CODE
)(FICL_VM
*pVm
);
517 #define VM_ASSERT(pVM) assert((*(pVM->ip - 1)) == pVM->runningWord)
519 #define VM_ASSERT(pVM)
523 ** Ficl models memory as a contiguous space divided into
524 ** words in a linked list called the dictionary.
525 ** A FICL_WORD starts each entry in the list.
526 ** Version 1.02: space for the name characters is allotted from
527 ** the dictionary ahead of the word struct, rather than using
528 ** a fixed size array for each name.
532 struct ficl_word
*link
; /* Previous word in the dictionary */
534 UNS8 flags
; /* Immediate, Smudge, Compile-only */
535 FICL_COUNT nName
; /* Number of chars in word name */
536 char *name
; /* First nFICLNAME chars of word name */
537 FICL_CODE code
; /* Native code to execute the word */
538 CELL param
[1]; /* First data cell of the word */
542 ** Worst-case size of a word header: nFICLNAME chars in name
544 #define CELLS_PER_WORD \
545 ( (sizeof (FICL_WORD) + nFICLNAME + sizeof (CELL)) \
548 int wordIsImmediate(FICL_WORD
*pFW
);
549 int wordIsCompileOnly(FICL_WORD
*pFW
);
551 /* flag values for word header */
552 #define FW_IMMEDIATE 1 /* execute me even if compiling */
553 #define FW_COMPILE 2 /* error if executed when not compiling */
554 #define FW_SMUDGE 4 /* definition in progress - hide me */
555 #define FW_ISOBJECT 8 /* word is an object or object member variable */
557 #define FW_COMPIMMED (FW_IMMEDIATE | FW_COMPILE)
562 ** Exit codes for vmThrow
564 #define VM_INNEREXIT -256 /* tell ficlExecXT to exit inner loop */
565 #define VM_OUTOFTEXT -257 /* hungry - normal exit */
566 #define VM_RESTART -258 /* word needs more text to succeed - re-run it */
567 #define VM_USEREXIT -259 /* user wants to quit */
568 #define VM_ERREXIT -260 /* interp found an error */
569 #define VM_BREAK -261 /* debugger breakpoint */
570 #define VM_ABORT -1 /* like errexit -- abort */
571 #define VM_ABORTQ -2 /* like errexit -- abort" */
572 #define VM_QUIT -56 /* like errexit, but leave pStack & base alone */
575 void vmBranchRelative(FICL_VM
*pVM
, int offset
);
576 FICL_VM
* vmCreate (FICL_VM
*pVM
, unsigned nPStack
, unsigned nRStack
);
577 void vmDelete (FICL_VM
*pVM
);
578 void vmExecute (FICL_VM
*pVM
, FICL_WORD
*pWord
);
579 FICL_DICT
*vmGetDict (FICL_VM
*pVM
);
580 char * vmGetString (FICL_VM
*pVM
, FICL_STRING
*spDest
, char delimiter
);
581 STRINGINFO
vmGetWord (FICL_VM
*pVM
);
582 STRINGINFO
vmGetWord0 (FICL_VM
*pVM
);
583 int vmGetWordToPad (FICL_VM
*pVM
);
584 STRINGINFO
vmParseString (FICL_VM
*pVM
, char delimiter
);
585 STRINGINFO
vmParseStringEx(FICL_VM
*pVM
, char delimiter
, char fSkipLeading
);
586 CELL
vmPop (FICL_VM
*pVM
);
587 void vmPush (FICL_VM
*pVM
, CELL c
);
588 void vmPopIP (FICL_VM
*pVM
);
589 void vmPushIP (FICL_VM
*pVM
, IPTYPE newIP
);
590 void vmQuit (FICL_VM
*pVM
);
591 void vmReset (FICL_VM
*pVM
);
592 void vmSetTextOut (FICL_VM
*pVM
, OUTFUNC textOut
);
593 void vmTextOut (FICL_VM
*pVM
, char *text
, int fNewline
);
594 void vmTextOut (FICL_VM
*pVM
, char *text
, int fNewline
);
595 void vmThrow (FICL_VM
*pVM
, int except
);
596 void vmThrowErr (FICL_VM
*pVM
, char *fmt
, ...);
598 #define vmGetRunningWord(pVM) ((pVM)->runningWord)
602 ** The inner interpreter - coded as a macro (see note for
603 ** INLINE_INNER_LOOP in sysdep.h for complaints about VC++ 5
605 #define M_VM_STEP(pVM) \
606 FICL_WORD *tempFW = *(pVM)->ip++; \
607 (pVM)->runningWord = tempFW; \
610 #define M_INNER_LOOP(pVM) \
611 for (;;) { M_VM_STEP(pVM) }
614 #if INLINE_INNER_LOOP != 0
615 #define vmInnerLoop(pVM) M_INNER_LOOP(pVM)
617 void vmInnerLoop(FICL_VM
*pVM
);
621 ** vmCheckStack needs a vm pointer because it might have to say
622 ** something if it finds a problem. Parms popCells and pushCells
623 ** correspond to the number of parameters on the left and right of
624 ** a word's stack effect comment.
626 void vmCheckStack(FICL_VM
*pVM
, int popCells
, int pushCells
);
628 void vmCheckFStack(FICL_VM
*pVM
, int popCells
, int pushCells
);
632 ** TIB access routines...
633 ** ANS forth seems to require the input buffer to be represented
634 ** as a pointer to the start of the buffer, and an index to the
635 ** next character to read.
636 ** PushTib points the VM to a new input string and optionally
637 ** returns a copy of the current state
638 ** PopTib restores the TIB state given a saved TIB from PushTib
639 ** GetInBuf returns a pointer to the next unused char of the TIB
641 void vmPushTib (FICL_VM
*pVM
, char *text
, FICL_INT nChars
, TIB
*pSaveTib
);
642 void vmPopTib (FICL_VM
*pVM
, TIB
*pTib
);
643 #define vmGetInBuf(pVM) ((pVM)->tib.cp + (pVM)->tib.index)
644 #define vmGetInBufLen(pVM) ((pVM)->tib.end - (pVM)->tib.cp)
645 #define vmGetInBufEnd(pVM) ((pVM)->tib.end)
646 #define vmGetTibIndex(pVM) (pVM)->tib.index
647 #define vmSetTibIndex(pVM, i) (pVM)->tib.index = i
648 #define vmUpdateTib(pVM, str) (pVM)->tib.index = (str) - (pVM)->tib.cp
651 ** Generally useful string manipulators omitted by ANSI C...
652 ** ltoa complements strtol
654 #if defined(_WIN32) && !FICL_MAIN
656 ** Why do Microsoft Meatballs insist on contaminating
657 ** my namespace with their string functions???
659 #pragma warning(disable: 4273)
662 int isPowerOfTwo(FICL_UNS u
);
664 char *ltoa( FICL_INT value
, char *string
, int radix
);
665 char *ultoa(FICL_UNS value
, char *string
, int radix
);
666 char digit_to_char(int value
);
667 char *strrev( char *string
);
668 char *skipSpace(char *cp
, char *end
);
669 char *caseFold(char *cp
);
670 int strincmp(char *cp1
, char *cp2
, FICL_UNS count
);
672 #if defined(_WIN32) && !FICL_MAIN
673 #pragma warning(default: 4273)
677 ** Ficl hash table - variable size.
679 ** If size is 1, the table degenerates into a linked list.
680 ** A WORDLIST (see the search order word set in DPANS) is
681 ** just a pointer to a FICL_HASH in this implementation.
683 #if !defined HASHSIZE /* Default size of hash table. For most uniform */
684 #define HASHSIZE 241 /* performance, use a prime number! */
687 typedef struct ficl_hash
689 struct ficl_hash
*link
; /* link to parent class wordlist for OO */
690 char *name
; /* optional pointer to \0 terminated wordlist name */
691 unsigned size
; /* number of buckets in the hash */
695 void hashForget (FICL_HASH
*pHash
, void *where
);
696 UNS16
hashHashCode (STRINGINFO si
);
697 void hashInsertWord(FICL_HASH
*pHash
, FICL_WORD
*pFW
);
698 FICL_WORD
*hashLookup (FICL_HASH
*pHash
, STRINGINFO si
, UNS16 hashCode
);
699 void hashReset (FICL_HASH
*pHash
);
702 ** A Dictionary is a linked list of FICL_WORDs. It is also Ficl's
703 ** memory model. Description of fields:
705 ** here -- points to the next free byte in the dictionary. This
706 ** pointer is forced to be CELL-aligned before a definition is added.
707 ** Do not assume any specific alignment otherwise - Use dictAlign().
709 ** smudge -- pointer to word currently being defined (or last defined word)
710 ** If the definition completes successfully, the word will be
711 ** linked into the hash table. If unsuccessful, dictUnsmudge
712 ** uses this pointer to restore the previous state of the dictionary.
713 ** Smudge prevents unintentional recursion as a side-effect: the
714 ** dictionary search algo examines only completed definitions, so a
715 ** word cannot invoke itself by name. See the ficl word "recurse".
716 ** NOTE: smudge always points to the last word defined. IMMEDIATE
717 ** makes use of this fact. Smudge is initially NULL.
719 ** pForthWords -- pointer to the default wordlist (FICL_HASH).
720 ** This is the initial compilation list, and contains all
721 ** ficl's precompiled words.
723 ** pCompile -- compilation wordlist - initially equal to pForthWords
724 ** pSearch -- array of pointers to wordlists. Managed as a stack.
725 ** Highest index is the first list in the search order.
726 ** nLists -- number of lists in pSearch. nLists-1 is the highest
727 ** filled slot in pSearch, and points to the first wordlist
728 ** in the search order
729 ** size -- number of cells in the dictionary (total)
730 ** dict -- start of data area. Must be at the end of the struct.
736 FICL_HASH
*pForthWords
;
738 FICL_HASH
*pSearch
[FICL_DEFAULT_VOCS
];
740 unsigned size
; /* Number of cells in dict (total)*/
741 CELL
*dict
; /* Base of dictionary memory */
744 void *alignPtr(void *ptr
);
745 void dictAbortDefinition(FICL_DICT
*pDict
);
746 void dictAlign (FICL_DICT
*pDict
);
747 int dictAllot (FICL_DICT
*pDict
, int n
);
748 int dictAllotCells (FICL_DICT
*pDict
, int nCells
);
749 void dictAppendCell (FICL_DICT
*pDict
, CELL c
);
750 void dictAppendChar (FICL_DICT
*pDict
, char c
);
751 FICL_WORD
*dictAppendWord (FICL_DICT
*pDict
,
755 FICL_WORD
*dictAppendWord2(FICL_DICT
*pDict
,
759 void dictAppendUNS (FICL_DICT
*pDict
, FICL_UNS u
);
760 int dictCellsAvail (FICL_DICT
*pDict
);
761 int dictCellsUsed (FICL_DICT
*pDict
);
762 void dictCheck (FICL_DICT
*pDict
, FICL_VM
*pVM
, int n
);
763 void dictCheckThreshold(FICL_DICT
* dp
);
764 FICL_DICT
*dictCreate(unsigned nCELLS
);
765 FICL_DICT
*dictCreateHashed(unsigned nCells
, unsigned nHash
);
766 FICL_HASH
*dictCreateWordlist(FICL_DICT
*dp
, int nBuckets
);
767 void dictDelete (FICL_DICT
*pDict
);
768 void dictEmpty (FICL_DICT
*pDict
, unsigned nHash
);
770 void dictHashSummary(FICL_VM
*pVM
);
772 int dictIncludes (FICL_DICT
*pDict
, void *p
);
773 FICL_WORD
*dictLookup (FICL_DICT
*pDict
, STRINGINFO si
);
775 FICL_WORD
*ficlLookupLoc (FICL_SYSTEM
*pSys
, STRINGINFO si
);
777 void dictResetSearchOrder(FICL_DICT
*pDict
);
778 void dictSetFlags (FICL_DICT
*pDict
, UNS8 set
, UNS8 clr
);
779 void dictSetImmediate(FICL_DICT
*pDict
);
780 void dictUnsmudge (FICL_DICT
*pDict
);
781 CELL
*dictWhere (FICL_DICT
*pDict
);
787 ** See words.c: interpWord
788 ** By default, ficl goes through two attempts to parse each token from its input
789 ** stream: it first attempts to match it with a word in the dictionary, and
790 ** if that fails, it attempts to convert it into a number. This mechanism is now
791 ** extensible by additional steps. This allows extensions like floating point and
792 ** double number support to be factored cleanly.
794 ** Each parse step is a function that receives the next input token as a STRINGINFO.
795 ** If the parse step matches the token, it must apply semantics to the token appropriate
796 ** to the present value of VM.state (compiling or interpreting), and return FICL_TRUE.
797 ** Otherwise it returns FICL_FALSE. See words.c: isNumber for an example
799 ** Note: for the sake of efficiency, it's a good idea both to limit the number
800 ** of parse steps and to code each parse step so that it rejects tokens that
801 ** do not match as quickly as possible.
804 typedef int (*FICL_PARSE_STEP
)(FICL_VM
*pVM
, STRINGINFO si
);
807 ** Appends a parse step function to the end of the parse list (see
808 ** FICL_PARSE_STEP notes in ficl.h for details). Returns 0 if successful,
809 ** nonzero if there's no more room in the list. Each parse step is a word in
810 ** the dictionary. Precompiled parse steps can use (PARSE-STEP) as their
811 ** CFA - see parenParseStep in words.c.
813 int ficlAddParseStep(FICL_SYSTEM
*pSys
, FICL_WORD
*pFW
); /* ficl.c */
814 void ficlAddPrecompiledParseStep(FICL_SYSTEM
*pSys
, char *name
, FICL_PARSE_STEP pStep
);
815 void ficlListParseSteps(FICL_VM
*pVM
);
818 ** FICL_BREAKPOINT record.
819 ** origXT - if NULL, this breakpoint is unused. Otherwise it stores the xt
820 ** that the breakpoint overwrote. This is restored to the dictionary when the
821 ** BP executes or gets cleared
822 ** address - the location of the breakpoint (address of the instruction that
823 ** has been replaced with the breakpoint trap
824 ** origXT - The original contents of the location with the breakpoint
825 ** Note: address is NULL when this breakpoint is empty
827 typedef struct FICL_BREAKPOINT
835 ** F I C L _ S Y S T E M
836 ** The top level data structure of the system - ficl_system ties a list of
837 ** virtual machines with their corresponding dictionaries. Ficl 3.0 will
838 ** support multiple Ficl systems, allowing multiple concurrent sessions
839 ** to separate dictionaries with some constraints.
840 ** The present model allows multiple sessions to one dictionary provided
841 ** you implement ficlLockDictionary() as specified in sysdep.h
842 ** Note: the pExtend pointer is there to provide context for applications. It is copied
843 ** to each VM's pExtend field as that VM is created.
848 void *pExtend
; /* Initializes VM's pExtend pointer (for application use) */
852 #ifdef FICL_WANT_LOCALS
855 FICL_WORD
*pInterp
[3];
856 FICL_WORD
*parseList
[FICL_MAX_PARSE_STEPS
];
859 FICL_WORD
*pBranchParen
;
861 FICL_WORD
*pDoesParen
;
862 FICL_WORD
*pExitInner
;
863 FICL_WORD
*pExitParen
;
865 FICL_WORD
*pInterpret
;
866 FICL_WORD
*pLitParen
;
867 FICL_WORD
*pTwoLitParen
;
868 FICL_WORD
*pLoopParen
;
869 FICL_WORD
*pPLoopParen
;
870 FICL_WORD
*pQDoParen
;
871 FICL_WORD
*pSemiParen
;
875 FICL_WORD
*pCStringLit
;
876 FICL_WORD
*pStringLit
;
879 FICL_WORD
*pGetLocalParen
;
880 FICL_WORD
*pGet2LocalParen
;
881 FICL_WORD
*pGetLocal0
;
882 FICL_WORD
*pGetLocal1
;
883 FICL_WORD
*pToLocalParen
;
884 FICL_WORD
*pTo2LocalParen
;
885 FICL_WORD
*pToLocal0
;
886 FICL_WORD
*pToLocal1
;
887 FICL_WORD
*pLinkParen
;
888 FICL_WORD
*pUnLinkParen
;
893 FICL_BREAKPOINT bpStep
;
896 struct ficl_system_info
898 int size
; /* structure size tag for versioning */
899 int nDictCells
; /* Size of system's Dictionary */
900 OUTFUNC textOut
; /* default textOut function */
901 void *pExtend
; /* Initializes VM's pExtend pointer - for application use */
902 int nEnvCells
; /* Size of Environment dictionary */
906 #define ficlInitInfo(x) { memset((x), 0, sizeof(FICL_SYSTEM_INFO)); \
907 (x)->size = sizeof(FICL_SYSTEM_INFO); }
910 ** External interface to FICL...
913 ** f i c l I n i t S y s t e m
914 ** Binds a global dictionary to the interpreter system and initializes
915 ** the dict to contain the ANSI CORE wordset.
916 ** You can specify the address and size of the allocated area.
917 ** Using ficlInitSystemEx you can also specify the text output function.
918 ** After that, ficl manages it.
919 ** First step is to set up the static pointers to the area.
920 ** Then write the "precompiled" portion of the dictionary in.
921 ** The dictionary needs to be at least large enough to hold the
922 ** precompiled part. Try 1K cells minimum. Use "words" to find
923 ** out how much of the dictionary is used at any time.
925 FICL_SYSTEM
*ficlInitSystemEx(FICL_SYSTEM_INFO
*fsi
);
927 /* Deprecated call */
928 FICL_SYSTEM
*ficlInitSystem(int nDictCells
);
931 ** f i c l T e r m S y s t e m
932 ** Deletes the system dictionary and all virtual machines that
933 ** were created with ficlNewVM (see below). Call this function to
934 ** reclaim all memory used by the dictionary and VMs.
936 void ficlTermSystem(FICL_SYSTEM
*pSys
);
939 ** f i c l E v a l u a t e
940 ** Evaluates a block of input text in the context of the
941 ** specified interpreter. Also sets SOURCE-ID properly.
943 ** PLEASE USE THIS FUNCTION when throwing a hard-coded
944 ** string to the FICL interpreter.
946 int ficlEvaluate(FICL_VM
*pVM
, char *pText
);
950 ** Evaluates a block of input text in the context of the
951 ** specified interpreter. Emits any requested output to the
952 ** interpreter's output function. If the input string is NULL
953 ** terminated, you can pass -1 as nChars rather than count it.
954 ** Execution returns when the text block has been executed,
955 ** or an error occurs.
956 ** Returns one of the VM_XXXX codes defined in ficl.h:
957 ** VM_OUTOFTEXT is the normal exit condition
958 ** VM_ERREXIT means that the interp encountered a syntax error
959 ** and the vm has been reset to recover (some or all
960 ** of the text block got ignored
961 ** VM_USEREXIT means that the user executed the "bye" command
962 ** to shut down the interpreter. This would be a good
963 ** time to delete the vm, etc -- or you can ignore this
965 ** VM_ABORT and VM_ABORTQ are generated by 'abort' and 'abort"'
967 ** Preconditions: successful execution of ficlInitSystem,
968 ** Successful creation and init of the VM by ficlNewVM (or equiv)
970 ** If you call ficlExec() or one of its brothers, you MUST
971 ** ensure pVM->sourceID was set to a sensible value.
972 ** ficlExec() explicitly DOES NOT manage SOURCE-ID for you.
974 int ficlExec (FICL_VM
*pVM
, char *pText
);
975 int ficlExecC(FICL_VM
*pVM
, char *pText
, FICL_INT nChars
);
976 int ficlExecXT(FICL_VM
*pVM
, FICL_WORD
*pWord
);
979 ** ficlExecFD(FICL_VM *pVM, int fd);
980 * Evaluates text from file passed in via fd.
981 * Execution returns when all of file has been executed or an
984 int ficlExecFD(FICL_VM
*pVM
, int fd
);
987 ** Create a new VM from the heap, and link it into the system VM list.
988 ** Initializes the VM and binds default sized stacks to it. Returns the
989 ** address of the VM, or NULL if an error occurs.
990 ** Precondition: successful execution of ficlInitSystem
992 FICL_VM
*ficlNewVM(FICL_SYSTEM
*pSys
);
995 ** Force deletion of a VM. You do not need to do this
996 ** unless you're creating and discarding a lot of VMs.
997 ** For systems that use a constant pool of VMs for the life
998 ** of the system, ficltermSystem takes care of VM cleanup
1001 void ficlFreeVM(FICL_VM
*pVM
);
1005 ** Set the stack sizes (return and parameter) to be used for all
1006 ** subsequently created VMs. Returns actual stack size to be used.
1008 int ficlSetStackSize(int nStackCells
);
1011 ** Returns the address of the most recently defined word in the system
1012 ** dictionary with the given name, or NULL if no match.
1013 ** Precondition: successful execution of ficlInitSystem
1015 FICL_WORD
*ficlLookup(FICL_SYSTEM
*pSys
, char *name
);
1018 ** f i c l G e t D i c t
1019 ** Utility function - returns the address of the system dictionary.
1020 ** Precondition: successful execution of ficlInitSystem
1022 FICL_DICT
*ficlGetDict(FICL_SYSTEM
*pSys
);
1023 FICL_DICT
*ficlGetEnv (FICL_SYSTEM
*pSys
);
1024 void ficlSetEnv (FICL_SYSTEM
*pSys
, char *name
, FICL_UNS value
);
1025 void ficlSetEnvD(FICL_SYSTEM
*pSys
, char *name
, FICL_UNS hi
, FICL_UNS lo
);
1026 #if FICL_WANT_LOCALS
1027 FICL_DICT
*ficlGetLoc (FICL_SYSTEM
*pSys
);
1030 ** f i c l B u i l d
1031 ** Builds a word into the system default dictionary in a thread-safe way.
1032 ** Preconditions: system must be initialized, and there must
1033 ** be enough space for the new word's header! Operation is
1034 ** controlled by ficlLockDictionary, so any initialization
1035 ** required by your version of the function (if you "overrode"
1036 ** it) must be complete at this point.
1038 ** name -- the name of the word to be built
1039 ** code -- code to execute when the word is invoked - must take a single param
1040 ** pointer to a FICL_VM
1041 ** flags -- 0 or more of FW_IMMEDIATE, FW_COMPILE, use bitwise OR!
1042 ** Most words can use FW_DEFAULT.
1043 ** nAllot - number of extra cells to allocate in the parameter area (usually zero)
1045 int ficlBuild(FICL_SYSTEM
*pSys
, char *name
, FICL_CODE code
, char flags
);
1048 ** f i c l C o m p i l e C o r e
1049 ** Builds the ANS CORE wordset into the dictionary - called by
1050 ** ficlInitSystem - no need to waste dict space by doing it again.
1052 void ficlCompileCore(FICL_SYSTEM
*pSys
);
1053 void ficlCompilePrefix(FICL_SYSTEM
*pSys
);
1054 void ficlCompileSearch(FICL_SYSTEM
*pSys
);
1055 void ficlCompileSoftCore(FICL_SYSTEM
*pSys
);
1056 void ficlCompileTools(FICL_SYSTEM
*pSys
);
1057 void ficlCompileFile(FICL_SYSTEM
*pSys
);
1059 void ficlCompileFloat(FICL_SYSTEM
*pSys
);
1060 int ficlParseFloatNumber( FICL_VM
*pVM
, STRINGINFO si
); /* float.c */
1062 #if FICL_PLATFORM_EXTEND
1063 void ficlCompilePlatform(FICL_SYSTEM
*pSys
);
1065 int ficlParsePrefix(FICL_VM
*pVM
, STRINGINFO si
);
1070 void constantParen(FICL_VM
*pVM
);
1071 void twoConstParen(FICL_VM
*pVM
);
1072 int ficlParseNumber(FICL_VM
*pVM
, STRINGINFO si
);
1073 void ficlTick(FICL_VM
*pVM
);
1074 void parseStepParen(FICL_VM
*pVM
);
1079 int isAFiclWord(FICL_DICT
*pd
, FICL_WORD
*pFW
);
1082 ** The following supports SEE and the debugger.
1107 WORDKIND
ficlWordClassify(FICL_WORD
*pFW
);
1110 ** Dictionary on-demand resizing
1112 extern CELL dictThreshold
;
1113 extern CELL dictIncrease
;
1116 ** Various FreeBSD goodies
1119 #if defined(__i386__) && !defined(TESTMAIN)
1120 extern void ficlOutb(FICL_VM
*pVM
);
1121 extern void ficlInb(FICL_VM
*pVM
);
1124 extern void ficlSetenv(FICL_VM
*pVM
);
1125 extern void ficlSetenvq(FICL_VM
*pVM
);
1126 extern void ficlGetenv(FICL_VM
*pVM
);
1127 extern void ficlUnsetenv(FICL_VM
*pVM
);
1128 extern void ficlCopyin(FICL_VM
*pVM
);
1129 extern void ficlCopyout(FICL_VM
*pVM
);
1130 extern void ficlFindfile(FICL_VM
*pVM
);
1131 extern void ficlCcall(FICL_VM
*pVM
);
1132 #if !defined(TESTMAIN)
1133 extern void ficlPnpdevices(FICL_VM
*pVM
);
1134 extern void ficlPnphandlers(FICL_VM
*pVM
);
1138 ** Used with File-Access wordset.
1140 #define FICL_FAM_READ 1
1141 #define FICL_FAM_WRITE 2
1142 #define FICL_FAM_APPEND 4
1143 #define FICL_FAM_BINARY 8
1145 #define FICL_FAM_OPEN_MODE(fam) ((fam) & (FICL_FAM_READ | FICL_FAM_WRITE | FICL_FAM_APPEND))
1148 #if (FICL_WANT_FILE)
1149 typedef struct ficlFILE
1160 #endif /* __FICL_H__ */