ref: 7c76dac1b268038f567939a70a18228e790a5cbc
dir: /ficl.h/
/******************************************************************* ** f i c l . h ** Forth Inspired Command Language ** Author: John Sadler (john_sadler@alum.mit.edu) ** Created: 19 July 1997 ** Dedicated to RHS, in loving memory ** $Id: ficl.h,v 1.31 2010/12/22 10:24:03 asau Exp $ ******************************************************************** ** ** Copyright (c) 1997-2001 John Sadler (john_sadler@alum.mit.edu) ** All rights reserved. ** ** Get the latest Ficl release at http://ficl.sourceforge.net ** ** I am interested in hearing from anyone who uses Ficl. If you have ** a problem, a success story, a defect, an enhancement request, or ** if you would like to contribute to the Ficl release, please ** contact me by email at the address above. ** ** L I C E N S E and D I S C L A I M E R ** ** Redistribution and use in source and binary forms, with or without ** modification, are permitted provided that the following conditions ** are met: ** 1. Redistributions of source code must retain the above copyright ** notice, this list of conditions and the following disclaimer. ** 2. Redistributions in binary form must reproduce the above copyright ** notice, this list of conditions and the following disclaimer in the ** documentation and/or other materials provided with the distribution. ** ** THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND ** ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE ** IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ** ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE ** FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL ** DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS ** OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) ** HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT ** LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY ** OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF ** SUCH DAMAGE. */ #if !defined (__FICL_H__) #define __FICL_H__ /* ** Ficl (Forth-inspired command language) is an ANS Forth ** interpreter written in C. Unlike traditional Forths, this ** interpreter is designed to be embedded into other systems ** as a command/macro/development prototype language. ** ** Where Forths usually view themselves as the center of the system ** and expect the rest of the system to be coded in Forth, Ficl ** acts as a component of the system. It is easy to export ** code written in C or ASM to Ficl in the style of TCL, or to invoke ** Ficl code from a compiled module. This allows you to do incremental ** development in a way that combines the best features of threaded ** languages (rapid development, quick code/test/debug cycle, ** reasonably fast) with the best features of C (everyone knows it, ** easier to support large blocks of code, efficient, type checking). ** ** Ficl provides facilities for interoperating ** with programs written in C: C functions can be exported to Ficl, ** and Ficl commands can be executed via a C calling interface. The ** interpreter is re-entrant, so it can be used in multiple instances ** in a multitasking system. Unlike Forth, Ficl's outer interpreter ** expects a text block as input, and returns to the caller after each ** text block, so the "data pump" is somewhere in external code. This ** is more like TCL than Forth, which usually expects to be at the center ** of the system, requesting input at its convenience. Each Ficl virtual ** machine can be bound to a different I/O channel, and is independent ** of all others in in the same address space except that all virtual ** machines share a common dictionary (a sort or open symbol table that ** defines all of the elements of the language). ** ** Code is written in ANSI C for portability. ** ** Summary of Ficl features and constraints: ** - Standard: Implements the ANSI Forth CORE word set and part ** of the CORE EXT word-set, SEARCH and SEARCH EXT, TOOLS and ** TOOLS EXT, LOCAL and LOCAL ext and various extras. ** - Extensible: you can export code written in Forth, C, ** or asm in a straightforward way. Ficl provides open ** facilities for extending the language in an application ** specific way. You can even add new control structures! ** - Ficl and C can interact in two ways: Ficl can encapsulate ** C code, or C code can invoke Ficl code. ** - Thread-safe, re-entrant: The shared system dictionary ** uses a locking mechanism that you can either supply ** or stub out to provide exclusive access. Each Ficl ** virtual machine has an otherwise complete state, and ** each can be bound to a separate I/O channel (or none at all). ** - Simple encapsulation into existing systems: a basic implementation ** requires three function calls (see the example program in testmain.c). ** - ROMable: Ficl is designed to work in RAM-based and ROM code / RAM data ** environments. It does require somewhat more memory than a pure ** ROM implementation because it builds its system dictionary in ** RAM at startup time. ** - Written an ANSI C to be as simple as I can make it to understand, ** support, debug, and port. Compiles without complaint at /Az /W4 ** (require ANSI C, max warnings) under Microsoft VC++ 5. ** - Does full 32 bit math (but you need to implement ** two mixed precision math primitives (see sysdep.c)) ** - Indirect threaded interpreter is not the fastest kind of ** Forth there is (see pForth 68K for a really fast subroutine ** threaded interpreter), but it's the cleanest match to a ** pure C implementation. ** ** P O R T I N G F i c l ** ** To install Ficl on your target system, you need an ANSI C compiler ** and its runtime library. Inspect the system dependent macros and ** functions in sysdep.h and sysdep.c and edit them to suit your ** system. For example, INT16 is a short on some compilers and an ** int on others. Check the default CELL alignment controlled by ** FICL_ALIGN. If necessary, add new definitions of ficlMalloc, ficlFree, ** ficlLockDictionary, and ficlCallbackDefaultTextOut to work with your ** operating system. Finally, use testmain.c as a guide to installing the ** Ficl system and one or more virtual machines into your code. You do not ** need to include testmain.c in your build. ** ** T o D o L i s t ** ** 1. Unimplemented system dependent CORE word: key ** 2. Ficl uses the PAD in some CORE words - this violates the standard, ** but it's cleaner for a multithreaded system. I'll have to make a ** second pad for reference by the word PAD to fix this. ** ** F o r M o r e I n f o r m a t i o n ** ** Web home of Ficl ** http://ficl.sourceforge.net ** Check this website for Forth literature (including the ANSI standard) ** http://www.taygeta.com/forthlit.html ** and here for software and more links ** http://www.taygeta.com/forth.html */ #ifdef __cplusplus extern "C" { #endif #include <limits.h> #include <setjmp.h> #include <stdarg.h> #include <stddef.h> #include <stdio.h> #include <stdlib.h> #include <string.h> /* ** Put all your local defines in ficllocal.h, ** rather than editing the makefile/project/etc. ** ficllocal.h will always ship as an inert file. */ #include "ficllocal.h" #if defined(FICL_ANSI) #include "ficlplatform/ansi.h" #elif defined(_WIN32) #include "ficlplatform/win32.h" #elif defined(unix) || defined(__unix__) || defined(__unix) || defined(__plan9__) #include "ficlplatform/unix.h" #else /* catch-all */ #include "ficlplatform/ansi.h" #endif /* platform */ /* ** ** B U I L D C O N T R O L S ** ** First, the FICL_WANT_* settings. ** These are all optional settings that you may or may not ** want Ficl to use. ** */ /* ** FICL_WANT_MINIMAL ** If set to nonzero, build the smallest possible Ficl interpreter. */ #if !defined(FICL_WANT_MINIMAL) #define FICL_WANT_MINIMAL (0) #endif #if FICL_WANT_MINIMAL #define FICL_WANT_SOFTWORDS (0) #define FICL_WANT_FILE (0) #define FICL_WANT_FLOAT (0) #define FICL_WANT_USER (0) #define FICL_WANT_LOCALS (0) #define FICL_WANT_DEBUGGER (0) #define FICL_WANT_OOP (0) #define FICL_WANT_PLATFORM (0) #define FICL_WANT_MULTITHREADED (0) #define FICL_WANT_EXTENDED_PREFIX (0) #define FICL_ROBUST (0) #endif /* FICL_WANT_MINIMAL */ /* ** FICL_WANT_PLATFORM ** Includes words defined in ficlCompilePlatform ** (see ficlplatform/win32.c and ficlplatform/unix.c for example) */ #if !defined (FICL_WANT_PLATFORM) #define FICL_WANT_PLATFORM (1) #endif /* FICL_WANT_PLATFORM */ /* ** FICL_WANT_COMPATIBILITY ** Changes Ficl 4 at compile-time so it is source-compatible ** with the Ficl 3 API. If you are a new user to Ficl you ** don't need to worry about this setting; if you are upgrading ** from a pre-4.0 version of Ficl, see doc/upgrading.html for ** more information. */ #if !defined FICL_WANT_COMPATIBILITY #define FICL_WANT_COMPATIBILITY (0) #endif /* !defined FICL_WANT_COMPATIBILITY */ /* ** FICL_WANT_LZ_SOFTCORE ** If nonzero, the softcore words are stored compressed ** with patent-unencumbered Lempel-Ziv '77 compression. ** This results in a smaller Ficl interpreter, and adds ** only a *tiny* runtime speed hit. ** ** As of version 4.0.27, all the runtime code for the decompressor ** is 688 bytes on a single-threaded release build, but saves 14179 ** bytes of data. That's a net savings of over 13k! Plus, it makes ** the resulting executable harder to hack :) ** ** On my 850MHz Duron machine, decompression took 0.00384 seconds ** if QueryPerformanceCounter() can be believed... it claims that it ** took 13765 cycles to complete, and that my machine runs 3579545 ** cycles/second. ** ** Contributed by Larry Hastings. */ #if !defined (FICL_WANT_LZ_SOFTCORE) #define FICL_WANT_LZ_SOFTCORE (1) #endif /* FICL_WANT_LZ_SOFTCORE */ /* ** FICL_WANT_FILE ** Includes the FILE and FILE-EXT wordset and associated code. ** Turn this off if you do not have a file system! ** Contributed by Larry Hastings */ #if !defined (FICL_WANT_FILE) #define FICL_WANT_FILE (1) #endif /* FICL_WANT_FILE */ /* ** FICL_WANT_FLOAT ** Includes a floating point stack for the VM, and words to do float operations. ** Contributed by Guy Carver */ #if !defined (FICL_WANT_FLOAT) #define FICL_WANT_FLOAT (1) #endif /* FICL_WANT_FLOAT */ /* ** FICL_WANT_DEBUGGER ** Inludes a simple source level debugger */ #if !defined (FICL_WANT_DEBUGGER) #define FICL_WANT_DEBUGGER (1) #endif /* FICL_WANT_DEBUGGER */ /* ** FICL_EXTENDED_PREFIX ** Enables a bunch of extra prefixes in prefix.c ** and prefix.fr (if included as part of softcore.c) */ #if !defined FICL_WANT_EXTENDED_PREFIX #define FICL_WANT_EXTENDED_PREFIX (1) #endif /* FICL_WANT_EXTENDED_PREFIX */ /* ** FICL_WANT_USER ** Enables user variables: per-instance variables bound to the VM. ** Kind of like thread-local storage. Could be implemented in a ** VM private dictionary, but I've chosen the lower overhead ** approach of an array of CELLs instead. */ #if !defined FICL_WANT_USER #define FICL_WANT_USER (1) #endif /* FICL_WANT_USER */ /* ** FICL_WANT_LOCALS ** Controls the creation of the LOCALS wordset ** and a private dictionary for local variable compilation. */ #if !defined FICL_WANT_LOCALS #define FICL_WANT_LOCALS (1) #endif /* FICL_WANT_LOCALS */ /* ** FICL_WANT_OOP ** Inludes object oriented programming support (in softwords) ** OOP support requires locals and user variables! */ #if !defined (FICL_WANT_OOP) #define FICL_WANT_OOP ((FICL_WANT_LOCALS) && (FICL_WANT_USER)) #endif /* FICL_WANT_OOP */ /* ** FICL_WANT_SOFTWORDS ** Controls inclusion of all softwords in softcore.c. */ #if !defined (FICL_WANT_SOFTWORDS) #define FICL_WANT_SOFTWORDS (1) #endif /* FICL_WANT_SOFTWORDS */ /* ** FICL_WANT_MULTITHREADED ** Enables dictionary mutual exclusion wia the ** ficlLockDictionary() system dependent function. ** ** Note: this implementation is experimental and poorly ** tested. Further, it's unnecessary unless you really ** intend to have multiple SESSIONS (poor choice of name ** on my part) - that is, threads that modify the dictionary ** at the same time. */ #if !defined FICL_WANT_MULTITHREADED #define FICL_WANT_MULTITHREADED (0) #endif /* FICL_WANT_MULTITHREADED */ /* ** FICL_WANT_OPTIMIZE ** Do you want to optimize for size, or for speed? ** Note that this doesn't affect Ficl very much one way ** or the other at the moment. ** Contributed by Larry Hastings */ #define FICL_OPTIMIZE_FOR_SPEED (1) #define FICL_OPTIMIZE_FOR_SIZE (2) #if !defined (FICL_WANT_OPTIMIZE) #define FICL_WANT_OPTIMIZE FICL_OPTIMIZE_FOR_SPEED #endif /* FICL_WANT_OPTIMIZE */ /* ** FICL_WANT_VCALL ** Ficl OO support for calling vtable methods. Win32 only. ** Contributed by Guy Carver */ #if !defined (FICL_WANT_VCALL) #define FICL_WANT_VCALL (0) #endif /* FICL_WANT_VCALL */ /* ** P L A T F O R M S E T T I N G S ** ** The FICL_PLATFORM_* settings. ** These indicate attributes about the local platform. */ /* ** FICL_PLATFORM_OS ** String constant describing the current hardware architecture. */ #if !defined (FICL_PLATFORM_ARCHITECTURE) #define FICL_PLATFORM_ARCHITECTURE "unknown" #endif /* ** FICL_PLATFORM_OS ** String constant describing the current operating system. */ #if !defined (FICL_PLATFORM_OS) #define FICL_PLATFORM_OS "plan9" #endif /* ** FICL_PLATFORM_HAS_2INTEGER ** Indicates whether or not the current architecture ** supports a native double-width integer type. ** If you set this to 1 in your ficlplatform/ *.h file, ** you *must* create typedefs for the following two types: ** ficl2Unsigned ** ficl2Integer ** If this is set to 0, Ficl will implement double-width ** integer math in C, which is both bigger *and* slower ** (the double whammy!). Make sure your compiler really ** genuinely doesn't support native double-width integers ** before setting this to 0. */ #if !defined (FICL_PLATFORM_HAS_2INTEGER) #define FICL_PLATFORM_HAS_2INTEGER (0) #endif /* ** FICL_PLATFORM_HAS_FTRUNCATE ** Indicates whether or not the current platform provides ** the ftruncate() function (available on most UNIXes). ** This function is necessary to provide the complete ** File-Access wordset. ** ** If your platform does not have ftruncate() per se, ** but does have some method of truncating files, you ** should be able to implement ftruncate() yourself and ** set this constant to 1. For an example of this see ** "ficlplatform/win32.c". */ #if !defined (FICL_PLATFORM_HAS_FTRUNCATE) #define FICL_PLATFORM_HAS_FTRUNCATE (0) #endif /* ** FICL_PLATFORM_INLINE ** Must be defined, should be a function prototype type-modifying ** keyword that makes a function "inline". Ficl does not assume ** that the local platform supports inline functions; it therefore ** only uses "inline" where "static" would also work, and uses "static" ** in the absence of another keyword. */ #if !defined FICL_PLATFORM_INLINE #define FICL_PLATFORM_INLINE static inline #endif /* !defined FICL_PLATFORM_INLINE */ /* ** FICL_PLATFORM_EXTERN ** Must be defined, should be a keyword used to declare ** a function prototype as being a genuine prototype. ** You should only have to fiddle with this setting if ** you're not using an ANSI-compliant compiler, in which ** case, good luck! */ #if !defined FICL_PLATFORM_EXTERN #define FICL_PLATFORM_EXTERN extern #endif /* !defined FICL_PLATFORM_EXTERN */ /* ** FICL_PLATFORM_BASIC_TYPES ** ** If not defined yet, */ #if !defined(FICL_PLATFORM_BASIC_TYPES) typedef char ficlInteger8; typedef unsigned char ficlUnsigned8; typedef short ficlInteger16; typedef unsigned short ficlUnsigned16; typedef long ficlInteger32; typedef unsigned long ficlUnsigned32; typedef ficlInteger32 ficlInteger; typedef ficlUnsigned32 ficlUnsigned; typedef float ficlFloat; #endif /* !defined(FICL_PLATFORM_BASIC_TYPES) */ /* ** FICL_ROBUST enables bounds checking of stacks and the dictionary. ** This will detect stack over and underflows and dictionary overflows. ** Any exceptional condition will result in an assertion failure. ** (As generated by the ANSI assert macro) ** FICL_ROBUST == 1 --> stack checking in the outer interpreter ** FICL_ROBUST == 2 also enables checking in many primitives */ #if !defined FICL_ROBUST #define FICL_ROBUST (2) #endif /* FICL_ROBUST */ /* ** FICL_DEFAULT_STACK_SIZE Specifies the default size (in CELLs) of ** a new virtual machine's stacks, unless overridden at ** create time. */ #if !defined FICL_DEFAULT_STACK_SIZE #define FICL_DEFAULT_STACK_SIZE (128) #endif /* ** FICL_DEFAULT_DICTIONARY_SIZE specifies the number of ficlCells to allocate ** for the system dictionary by default. The value ** can be overridden at startup time as well. */ #if !defined FICL_DEFAULT_DICTIONARY_SIZE #define FICL_DEFAULT_DICTIONARY_SIZE (12288) #endif /* ** FICL_DEFAULT_ENVIRONMENT_SIZE specifies the number of cells ** to allot for the environment-query dictionary. */ #if !defined FICL_DEFAULT_ENVIRONMENT_SIZE #define FICL_DEFAULT_ENVIRONMENT_SIZE (512) #endif /* ** FICL_MAX_WORDLISTS specifies the maximum number of wordlists in ** the dictionary search order. See Forth DPANS sec 16.3.3 ** (file://dpans16.htm#16.3.3) */ #if !defined FICL_MAX_WORDLISTS #define FICL_MAX_WORDLISTS (16) #endif /* ** FICL_MAX_PARSE_STEPS controls the size of an array in the FICL_SYSTEM structure ** that stores pointers to parser extension functions. I would never expect to have ** more than 8 of these, so that's the default limit. Too many of these functions ** will probably exact a nasty performance penalty. */ #if !defined FICL_MAX_PARSE_STEPS #define FICL_MAX_PARSE_STEPS (8) #endif /* ** Maximum number of local variables per definition. ** This only affects the size of the locals dictionary, ** and there's only one per entire ficlSystem, so it ** doesn't make sense to be a piker here. */ #if (!defined(FICL_MAX_LOCALS)) && FICL_WANT_LOCALS #define FICL_MAX_LOCALS (64) #endif /* ** The pad is a small scratch area for text manipulation. ANS Forth ** requires it to hold at least 84 characters. */ #if !defined FICL_PAD_SIZE #define FICL_PAD_SIZE (256) #endif /* ** ANS Forth requires that a word's name contain {1..31} characters. */ #if !defined FICL_NAME_LENGTH #define FICL_NAME_LENGTH (31) #endif /* ** Default size of hash table. For most uniform ** performance, use a prime number! */ #if !defined FICL_HASH_SIZE #define FICL_HASH_SIZE (241) #endif /* ** Default number of USER flags. */ #if (!defined(FICL_USER_CELLS)) && FICL_WANT_USER #define FICL_USER_CELLS (16) #endif /* ** Forward declarations... read on. */ struct ficlWord; typedef struct ficlWord ficlWord; struct ficlVm; typedef struct ficlVm ficlVm; struct ficlDictionary; typedef struct ficlDictionary ficlDictionary; struct ficlSystem; typedef struct ficlSystem ficlSystem; struct ficlSystemInformation; typedef struct ficlSystemInformation ficlSystemInformation; struct ficlCallback; typedef struct ficlCallback ficlCallback; struct ficlCountedString; typedef struct ficlCountedString ficlCountedString; struct ficlString; typedef struct ficlString ficlString; /* ** System dependent routines: ** Edit the implementations in your appropriate ficlplatform/ *.c to be ** compatible with your runtime environment. ** ** ficlCallbackDefaultTextOut sends a zero-terminated string to the ** default output device - used for system error messages. ** ** ficlMalloc(), ficlRealloc() and ficlFree() have the same semantics ** as the functions malloc(), realloc(), and free() from the standard C library. */ FICL_PLATFORM_EXTERN void ficlCallbackDefaultTextOut(ficlCallback *callback, char *text); FICL_PLATFORM_EXTERN void *ficlMalloc (size_t size); FICL_PLATFORM_EXTERN void ficlFree (void *p); FICL_PLATFORM_EXTERN void *ficlRealloc(void *p, size_t size); /* ** the Good Stuff starts here... */ #define FICL_VERSION "4.1.0" #if !defined (FICL_PROMPT) #define FICL_PROMPT "ok> " #endif /* ** ANS Forth requires false to be zero, and true to be the ones ** complement of false... that unifies logical and bitwise operations ** nicely. */ #define FICL_TRUE ((unsigned long)~(0L)) #define FICL_FALSE (0) #define FICL_BOOL(x) ((x) ? FICL_TRUE : FICL_FALSE) #if !defined FICL_IGNORE /* Macro to silence unused param warnings */ #define FICL_IGNORE(x) (void)x #endif /* !defined FICL_IGNORE */ #if !defined NULL #define NULL ((void *)0) #endif /* ** Jiggery-pokery for the FICL_WANT_COMPATIBILITY compatibility layer. ** Even if you're not using it, compatibility.c won't compile properly ** unless FICL_WANT_COMPATIBILITY is turned on. Hence, we force it to ** always be turned on. */ #ifdef FICL_FORCE_COMPATIBILITY #undef FICL_WANT_COMPATIBILITY #define FICL_WANT_COMPATIBILITY (1) #endif /* FICL_FORCE_COMPATIBILITY */ /* ** 2integer structures */ #if FICL_PLATFORM_HAS_2INTEGER #define FICL_2INTEGER_SET(high, low, doublei) ((doublei) = (ficl2Integer)(((ficlUnsigned)(low)) | (((ficl2Integer)(high)) << FICL_BITS_PER_CELL))) #define FICL_2INTEGER_TO_2UNSIGNED(doublei) ((ficl2Unsigned)(doublei)) #define FICL_2UNSIGNED_SET(high, low, doubleu) ((doubleu) = ((ficl2Unsigned)(low)) | (((ficl2Unsigned)(high)) << FICL_BITS_PER_CELL)) #define FICL_2UNSIGNED_GET_LOW(doubleu) ((ficlUnsigned)(doubleu & ((((ficl2Integer)1) << FICL_BITS_PER_CELL) - 1))) #define FICL_2UNSIGNED_GET_HIGH(doubleu) ((ficlUnsigned)(doubleu >> FICL_BITS_PER_CELL)) #define FICL_2UNSIGNED_NOT_ZERO(doubleu) ((doubleu) != 0) #define FICL_2UNSIGNED_TO_2INTEGER(doubleu) ((ficl2Integer)(doubleu)) #define FICL_INTEGER_TO_2INTEGER(i, doublei) ((doublei) = (i)) #define FICL_UNSIGNED_TO_2UNSIGNED(u, doubleu) ((doubleu) = (u)) #define ficl2IntegerIsNegative(doublei) ((doublei) < 0) #define ficl2IntegerNegate(doublei) (-(doublei)) #define ficl2IntegerMultiply(x, y) (((ficl2Integer)(x)) * ((ficl2Integer)(y))) #define ficl2IntegerDecrement(x) (((ficl2Integer)(x)) - 1) #define ficl2UnsignedAdd(x, y) (((ficl2Unsigned)(x)) + ((ficl2Unsigned)(y))) #define ficl2UnsignedSubtract(x, y) (((ficl2Unsigned)(x)) - ((ficl2Unsigned)(y))) #define ficl2UnsignedMultiply(x, y) (((ficl2Unsigned)(x)) * ((ficl2Unsigned)(y))) #define ficl2UnsignedMultiplyAccumulate(u, mul, add) (((u) * (mul)) + (add)) #define ficl2UnsignedArithmeticShiftLeft(x) ((x) << 1) #define ficl2UnsignedArithmeticShiftRight(x) ((x) >> 1) #define ficl2UnsignedCompare(x, y) ficl2UnsignedSubtract(x, y) #define ficl2UnsignedOr(x, y) ((x) | (y)) #else /* FICL_PLATFORM_HAS_2INTEGER */ typedef struct { ficlUnsigned high; ficlUnsigned low; } ficl2Unsigned; typedef struct { ficlInteger high; ficlInteger low; } ficl2Integer; #define FICL_2INTEGER_SET(hi, lo, doublei) { ficl2Integer x; x.low = (lo); x.high = (hi); (doublei) = x; } #define FICL_2INTEGER_TO_2UNSIGNED(doublei) (*(ficl2Unsigned *)(&(doublei))) #define FICL_2UNSIGNED_SET(hi, lo, doubleu) { ficl2Unsigned x; x.low = (lo); x.high = (hi); (doubleu) = x; } #define FICL_2UNSIGNED_GET_LOW(doubleu) ((doubleu).low) #define FICL_2UNSIGNED_GET_HIGH(doubleu) ((doubleu).high) #define FICL_2UNSIGNED_NOT_ZERO(doubleu) ((doubleu).high || (doubleu).low) #define FICL_2UNSIGNED_TO_2INTEGER(doubleu) (*(ficl2Integer *)(&(doubleu))) #define FICL_INTEGER_TO_2INTEGER(i, doublei) { ficlInteger __x = (ficlInteger)(i); FICL_2INTEGER_SET((__x < 0) ? -1L : 0, __x, doublei) } #define FICL_UNSIGNED_TO_2UNSIGNED(u, doubleu) FICL_2UNSIGNED_SET(0, u, doubleu) FICL_PLATFORM_EXTERN int ficl2IntegerIsNegative(ficl2Integer x); FICL_PLATFORM_EXTERN ficl2Integer ficl2IntegerNegate(ficl2Integer x); FICL_PLATFORM_EXTERN ficl2Integer ficl2IntegerMultiply(ficlInteger x, ficlInteger y); FICL_PLATFORM_EXTERN ficl2Integer ficl2IntegerDecrement(ficl2Integer x); FICL_PLATFORM_EXTERN ficl2Unsigned ficl2UnsignedAdd(ficl2Unsigned x, ficl2Unsigned y); FICL_PLATFORM_EXTERN ficl2Unsigned ficl2UnsignedSubtract(ficl2Unsigned x, ficl2Unsigned y); FICL_PLATFORM_EXTERN ficl2Unsigned ficl2UnsignedMultiply(ficlUnsigned x, ficlUnsigned y); FICL_PLATFORM_EXTERN ficl2Unsigned ficl2UnsignedMultiplyAccumulate(ficl2Unsigned u, ficlUnsigned mul, ficlUnsigned add); FICL_PLATFORM_EXTERN ficl2Unsigned ficl2UnsignedArithmeticShiftLeft( ficl2Unsigned x ); FICL_PLATFORM_EXTERN ficl2Unsigned ficl2UnsignedArithmeticShiftRight( ficl2Unsigned x ); FICL_PLATFORM_EXTERN int ficl2UnsignedCompare(ficl2Unsigned x, ficl2Unsigned y); FICL_PLATFORM_EXTERN ficl2Unsigned ficl2UnsignedOr( ficl2Unsigned x, ficl2Unsigned y ); #endif /* FICL_PLATFORM_HAS_2INTEGER */ FICL_PLATFORM_EXTERN ficl2Integer ficl2IntegerAbsoluteValue(ficl2Integer x); /* ** These structures represent the result of division. */ typedef struct { ficl2Unsigned quotient; ficlUnsigned remainder; } ficl2UnsignedQR; typedef struct { ficl2Integer quotient; ficlInteger remainder; } ficl2IntegerQR; #define FICL_2INTEGERQR_TO_2UNSIGNEDQR(doubleiqr) (*(ficl2UnsignedQR *)(&(doubleiqr))) #define FICL_2UNSIGNEDQR_TO_2INTEGERQR(doubleuqr) (*(ficl2IntegerQR *)(&(doubleuqr))) /* ** 64 bit integer math support routines: multiply two UNS32s ** to get a 64 bit product, & divide the product by an UNS32 ** to get an UNS32 quotient and remainder. Much easier in asm ** on a 32 bit CPU than in C, which usually doesn't support ** the double length result (but it should). */ FICL_PLATFORM_EXTERN ficl2IntegerQR ficl2IntegerDivideFloored(ficl2Integer num, ficlInteger den); FICL_PLATFORM_EXTERN ficl2IntegerQR ficl2IntegerDivideSymmetric(ficl2Integer num, ficlInteger den); FICL_PLATFORM_EXTERN ficl2UnsignedQR ficl2UnsignedDivide(ficl2Unsigned q, ficlUnsigned y); /* ** A ficlCell is the main storage type. It must be large enough ** to contain a pointer or a scalar. In order to accommodate ** 32 bit and 64 bit processors, use abstract types for int, ** unsigned, and float. ** ** A ficlUnsigned, ficlInteger, and ficlFloat *MUST* be the same ** size as a "void *" on the target system. (Sorry, but that's ** a design constraint of FORTH.) */ typedef union ficlCell { ficlInteger i; ficlUnsigned u; #if (FICL_WANT_FLOAT) ficlFloat f; #endif void *p; void (*fn)(void); } ficlCell; #define FICL_BITS_PER_CELL (sizeof(ficlCell) * 8) /* ** FICL_PLATFORM_ALIGNMENT is the number of bytes to which ** the dictionary pointer address must be aligned. This value ** is usually either 2 or 4, depending on the memory architecture ** of the target system; 4 is safe on any 16 or 32 bit ** machine. 8 would be appropriate for a 64 bit machine. */ #if !defined FICL_PLATFORM_ALIGNMENT #define FICL_PLATFORM_ALIGNMENT (4) #endif /* ** FICL_LVALUE_TO_CELL does a little pointer trickery to cast any CELL sized ** lvalue (informal definition: an expression whose result has an ** address) to CELL. Remember that constants and casts are NOT ** themselves lvalues! */ #define FICL_LVALUE_TO_CELL(v) (*(ficlCell *)&v) /* ** PTRtoCELL is a cast through void * intended to satisfy the ** most outrageously pedantic compiler... (I won't mention ** its name) */ #define FICL_POINTER_TO_CELL(p) ((ficlCell *)(void *)p) /* ** FORTH defines the "counted string" data type. This is ** a "Pascal-style" string, where the first byte is an unsigned ** count of characters, followed by the characters themselves. ** The Ficl structure for this is ficlCountedString. ** Ficl also often zero-terminates them so that they work with the ** usual C runtime library string functions... strlen(), strcmp(), ** and the like. (Belt & suspenders? You decide.) ** ** The problem is, this limits strings to 255 characters, which ** can be a bit constricting to us wordy types. So FORTH only ** uses counted strings for backwards compatibility, and all new ** words are "c-addr u" style, where the address and length are ** stored separately, and the length is a full unsigned "cell" size. ** (For more on this trend, see DPANS94 section A.3.1.3.4.) ** Ficl represents this with the ficlString structure. Note that ** these are frequently *not* zero-terminated! Don't depend on ** it--that way lies madness. */ struct ficlCountedString { ficlUnsigned8 length; char text[1]; }; #define FICL_COUNTED_STRING_GET_LENGTH(cs) ((cs).length) #define FICL_COUNTED_STRING_GET_POINTER(cs) ((cs).text) #define FICL_COUNTED_STRING_MAX (256) #define FICL_POINTER_TO_COUNTED_STRING(p) ((ficlCountedString *)(void *)p) struct ficlString { ficlUnsigned length; char *text; }; #define FICL_STRING_GET_LENGTH(fs) ((fs).length) #define FICL_STRING_GET_POINTER(fs) ((fs).text) #define FICL_STRING_SET_LENGTH(fs, l) ((fs).length = (ficlUnsigned)(l)) #define FICL_STRING_SET_POINTER(fs, p) ((fs).text = (char *)(p)) #define FICL_STRING_SET_FROM_COUNTED_STRING(string, countedstring) \ {(string).text = (countedstring).text; (string).length = (countedstring).length;} /* ** Init a FICL_STRING from a pointer to a zero-terminated string */ #define FICL_STRING_SET_FROM_CSTRING(string, cstring) \ {(string).text = (cstring); (string).length = strlen(cstring);} /* ** Ficl uses this little structure to hold the address of ** the block of text it's working on and an index to the next ** unconsumed character in the string. Traditionally, this is ** done by a Text Input Buffer, so I've called this struct TIB. ** ** Since this structure also holds the size of the input buffer, ** and since evaluate requires that, let's put the size here. ** The size is stored as an end-pointer because that is what the ** null-terminated string aware functions find most easy to deal ** with. ** Notice, though, that nobody really uses this except evaluate, ** so it might just be moved to ficlVm instead. (sobral) */ typedef struct { ficlInteger index; char *end; char *text; } ficlTIB; /* ** Stacks get heavy use in Ficl and Forth... ** Each virtual machine implements two of them: ** one holds parameters (data), and the other holds return ** addresses and control flow information for the virtual ** machine. (Note: C's automatic stack is implicitly used, ** but not modeled because it doesn't need to be...) ** Here's an abstract type for a stack */ typedef struct ficlStack { ficlUnsigned size; /* size of the stack, in cells */ ficlCell *frame; /* link reg for stack frame */ ficlCell *top; /* stack pointer */ ficlVm *vm; /* used for debugging */ char *name; /* used for debugging */ ficlCell *base; /* Top of stack */ } ficlStack; /* ** Stack methods... many map closely to required Forth words. */ FICL_PLATFORM_EXTERN ficlStack *ficlStackCreate (ficlVm *vm, char *name, unsigned nCells); FICL_PLATFORM_EXTERN void ficlStackDestroy (ficlStack *stack); FICL_PLATFORM_EXTERN int ficlStackDepth (ficlStack *stack); FICL_PLATFORM_EXTERN void ficlStackDrop (ficlStack *stack, int n); FICL_PLATFORM_EXTERN ficlCell ficlStackFetch (ficlStack *stack, int n); FICL_PLATFORM_EXTERN ficlCell ficlStackGetTop (ficlStack *stack); FICL_PLATFORM_EXTERN void ficlStackPick (ficlStack *stack, int n); FICL_PLATFORM_EXTERN ficlCell ficlStackPop (ficlStack *stack); FICL_PLATFORM_EXTERN void ficlStackPush (ficlStack *stack, ficlCell c); FICL_PLATFORM_EXTERN void ficlStackReset (ficlStack *stack); FICL_PLATFORM_EXTERN void ficlStackRoll (ficlStack *stack, int n); FICL_PLATFORM_EXTERN void ficlStackSetTop (ficlStack *stack, ficlCell c); FICL_PLATFORM_EXTERN void ficlStackStore (ficlStack *stack, int n, ficlCell c); #if FICL_WANT_LOCALS FICL_PLATFORM_EXTERN void ficlStackLink (ficlStack *stack, int nCells); FICL_PLATFORM_EXTERN void ficlStackUnlink (ficlStack *stack); #endif /* FICL_WANT_LOCALS */ FICL_PLATFORM_EXTERN void *ficlStackPopPointer (ficlStack *stack); FICL_PLATFORM_EXTERN ficlUnsigned ficlStackPopUnsigned (ficlStack *stack); FICL_PLATFORM_EXTERN ficlInteger ficlStackPopInteger (ficlStack *stack); FICL_PLATFORM_EXTERN void ficlStackPushPointer (ficlStack *stack, void *ptr); FICL_PLATFORM_EXTERN void ficlStackPushUnsigned (ficlStack *stack, ficlUnsigned u); FICL_PLATFORM_EXTERN void ficlStackPushInteger (ficlStack *stack, ficlInteger i); #if (FICL_WANT_FLOAT) FICL_PLATFORM_EXTERN ficlFloat ficlStackPopFloat (ficlStack *stack); FICL_PLATFORM_EXTERN void ficlStackPushFloat (ficlStack *stack, ficlFloat f); #endif FICL_PLATFORM_EXTERN void ficlStackPush2Integer (ficlStack *stack, ficl2Integer i64); FICL_PLATFORM_EXTERN ficl2Integer ficlStackPop2Integer (ficlStack *stack); FICL_PLATFORM_EXTERN void ficlStackPush2Unsigned(ficlStack *stack, ficl2Unsigned u64); FICL_PLATFORM_EXTERN ficl2Unsigned ficlStackPop2Unsigned (ficlStack *stack); #if FICL_ROBUST >= 1 FICL_PLATFORM_EXTERN void ficlStackCheck (ficlStack *stack, int popCells, int pushCells); #define FICL_STACK_CHECK(stack, popCells, pushCells) ficlStackCheck(stack, popCells, pushCells) #else /* FICL_ROBUST >= 1 */ #define FICL_STACK_CHECK(stack, popCells, pushCells) #endif /* FICL_ROBUST >= 1 */ typedef ficlInteger (*ficlStackWalkFunction)(void *constant, ficlCell *cell); FICL_PLATFORM_EXTERN void ficlStackWalk(ficlStack *stack, ficlStackWalkFunction callback, void *context, ficlInteger bottomToTop); FICL_PLATFORM_EXTERN void ficlStackDisplay(ficlStack *stack, ficlStackWalkFunction callback, void *context); typedef ficlWord **ficlIp; /* the VM's instruction pointer */ typedef void (*ficlPrimitive)(ficlVm *vm); typedef void (*ficlOutputFunction)(ficlCallback *callback, char *text); /* ** Each VM has a placeholder for an output function - ** this makes it possible to have each VM do I/O ** through a different device. If you specify no ** ficlOutputFunction, it defaults to ficlCallbackDefaultTextOut. ** ** You can also set a specific handler just for errors. ** If you don't specify one, it defaults to using textOut. */ struct ficlCallback { void *context; ficlOutputFunction textOut; ficlOutputFunction errorOut; ficlSystem *system; ficlVm *vm; }; FICL_PLATFORM_EXTERN void ficlCallbackTextOut(ficlCallback *callback, char *text); FICL_PLATFORM_EXTERN void ficlCallbackErrorOut(ficlCallback *callback, char *text); /* ** For backwards compatibility. */ typedef void (*ficlCompatibilityOutputFunction)(ficlVm *vm, char *text, int newline); FICL_PLATFORM_EXTERN void ficlCompatibilityTextOutCallback(ficlCallback *callback, char *text, ficlCompatibilityOutputFunction oldFunction); /* ** Starting with Ficl 4.0, Ficl uses a "switch-threaded" inner loop, ** where each primitive word is represented with a numeric constant, ** and words are (more or less) arrays of these constants. In Ficl ** these constants are an enumerated type called ficlInstruction. */ enum ficlInstruction { #define FICL_TOKEN(token, description) token, #define FICL_INSTRUCTION_TOKEN(token, description, flags) token, #include "ficltokens.h" #undef FICL_TOKEN #undef FICL_INSTRUCTION_TOKEN ficlInstructionLast, ficlInstructionFourByteTrick = 0x10000000 }; typedef ficlInteger ficlInstruction; /* ** The virtual machine (VM) contains the state for one interpreter. ** Defined operations include: ** Create & initialize ** Delete ** Execute a block of text ** Parse a word out of the input stream ** Call return, and branch ** Text output ** Throw an exception */ struct ficlVm { ficlCallback callback; ficlVm *link; /* Ficl keeps a VM list for simple teardown */ jmp_buf *exceptionHandler; /* crude exception mechanism... */ short restart; /* Set TRUE to restart runningWord */ ficlIp ip; /* instruction pointer */ ficlWord *runningWord;/* address of currently running word (often just *(ip-1) ) */ ficlUnsigned state; /* compiling or interpreting */ ficlUnsigned base; /* number conversion base */ ficlStack *dataStack; ficlStack *returnStack; /* return stack */ #if FICL_WANT_FLOAT ficlStack *floatStack; /* float stack (optional) */ #endif ficlCell sourceId; /* -1 if EVALUATE, 0 if normal input, >0 if a file */ ficlTIB tib; /* address of incoming text string */ #if FICL_WANT_USER ficlCell user[FICL_USER_CELLS]; #endif char pad[FICL_PAD_SIZE]; /* the scratch area (see above) */ #if FICL_WANT_COMPATIBILITY ficlCompatibilityOutputFunction thunkedTextout; #endif /* FICL_WANT_COMPATIBILITY */ }; /* ** Each VM operates in one of two non-error states: interpreting ** or compiling. When interpreting, words are simply executed. ** When compiling, most words in the input stream have their ** addresses inserted into the word under construction. Some words ** (known as IMMEDIATE) are executed in the compile state, too. */ /* values of STATE */ #define FICL_VM_STATE_INTERPRET (0) #define FICL_VM_STATE_COMPILE (1) /* ** Exit codes for vmThrow */ #define FICL_VM_STATUS_INNER_EXIT (-256) /* tell ficlVmExecuteXT to exit inner loop */ #define FICL_VM_STATUS_OUT_OF_TEXT (-257) /* hungry - normal exit */ #define FICL_VM_STATUS_RESTART (-258) /* word needs more text to succeed -- re-run it */ #define FICL_VM_STATUS_USER_EXIT (-259) /* user wants to quit */ #define FICL_VM_STATUS_ERROR_EXIT (-260) /* interpreter found an error */ #define FICL_VM_STATUS_BREAK (-261) /* debugger breakpoint */ #define FICL_VM_STATUS_ABORT ( -1) /* like FICL_VM_STATUS_ERROR_EXIT -- abort */ #define FICL_VM_STATUS_ABORTQ ( -2) /* like FICL_VM_STATUS_ERROR_EXIT -- abort" */ #define FICL_VM_STATUS_QUIT ( -56) /* like FICL_VM_STATUS_ERROR_EXIT, but leave dataStack & base alone */ FICL_PLATFORM_EXTERN void ficlVmBranchRelative(ficlVm *vm, int offset); FICL_PLATFORM_EXTERN ficlVm * ficlVmCreate (ficlVm *vm, unsigned nPStack, unsigned nRStack); FICL_PLATFORM_EXTERN void ficlVmDestroy (ficlVm *vm); FICL_PLATFORM_EXTERN ficlDictionary *ficlVmGetDictionary(ficlVm *vm); FICL_PLATFORM_EXTERN char * ficlVmGetString (ficlVm *vm, ficlCountedString *spDest, char delimiter); FICL_PLATFORM_EXTERN ficlString ficlVmGetWord (ficlVm *vm); FICL_PLATFORM_EXTERN ficlString ficlVmGetWord0 (ficlVm *vm); FICL_PLATFORM_EXTERN int ficlVmGetWordToPad (ficlVm *vm); FICL_PLATFORM_EXTERN void ficlVmInnerLoop (ficlVm *vm, ficlWord *word); FICL_PLATFORM_EXTERN ficlString ficlVmParseString (ficlVm *vm, char delimiter); FICL_PLATFORM_EXTERN ficlString ficlVmParseStringEx(ficlVm *vm, char delimiter, char fSkipLeading); FICL_PLATFORM_EXTERN ficlCell ficlVmPop (ficlVm *vm); FICL_PLATFORM_EXTERN void ficlVmPush (ficlVm *vm, ficlCell c); FICL_PLATFORM_EXTERN void ficlVmPopIP (ficlVm *vm); FICL_PLATFORM_EXTERN void ficlVmPushIP (ficlVm *vm, ficlIp newIP); FICL_PLATFORM_EXTERN void ficlVmQuit (ficlVm *vm); FICL_PLATFORM_EXTERN void ficlVmReset (ficlVm *vm); FICL_PLATFORM_EXTERN void ficlVmSetTextOut (ficlVm *vm, ficlOutputFunction textOut); FICL_PLATFORM_EXTERN void ficlVmThrow (ficlVm *vm, int except); FICL_PLATFORM_EXTERN void ficlVmThrowError (ficlVm *vm, char *fmt, ...); FICL_PLATFORM_EXTERN void ficlVmThrowErrorVararg(ficlVm *vm, char *fmt, va_list list); FICL_PLATFORM_EXTERN void ficlVmTextOut (ficlVm *vm, char *text); FICL_PLATFORM_EXTERN void ficlVmErrorOut (ficlVm *vm, char *text); #define ficlVmGetContext(vm) ((vm)->context) #define ficlVmGetDataStack(vm) ((vm)->dataStack) #define ficlVmGetFloatStack(vm) ((vm)->floatStack) #define ficlVmGetReturnStack(vm) ((vm)->returnStack) #define ficlVmGetRunningWord(vm) ((vm)->runningWord) FICL_PLATFORM_EXTERN void ficlVmDisplayDataStack(ficlVm *vm); FICL_PLATFORM_EXTERN void ficlVmDisplayDataStackSimple(ficlVm *vm); FICL_PLATFORM_EXTERN void ficlVmDisplayReturnStack(ficlVm *vm); #if FICL_WANT_FLOAT FICL_PLATFORM_EXTERN void ficlVmDisplayFloatStack(ficlVm *vm); #endif /* FICL_WANT_FLOAT */ /* ** f i c l E v a l u a t e ** Evaluates a block of input text in the context of the ** specified interpreter. Also sets SOURCE-ID properly. ** ** PLEASE USE THIS FUNCTION when throwing a hard-coded ** string to the Ficl interpreter. */ FICL_PLATFORM_EXTERN int ficlVmEvaluate(ficlVm *vm, char *s); /* ** f i c l V m E x e c * ** Evaluates a block of input text in the context of the ** specified interpreter. Emits any requested output to the ** interpreter's output function. If the input string is NULL ** terminated, you can pass -1 as nChars rather than count it. ** Execution returns when the text block has been executed, ** or an error occurs. ** Returns one of the FICL_VM_STATUS_... codes defined in ficl.h: ** FICL_VM_STATUS_OUT_OF_TEXT is the normal exit condition ** FICL_VM_STATUS_ERROR_EXIT means that the interpreter encountered a syntax error ** and the vm has been reset to recover (some or all ** of the text block got ignored ** FICL_VM_STATUS_USER_EXIT means that the user executed the "bye" command ** to shut down the interpreter. This would be a good ** time to delete the vm, etc -- or you can ignore this ** signal. ** FICL_VM_STATUS_ABORT and FICL_VM_STATUS_ABORTQ are generated by 'abort' and 'abort"' ** commands. ** Preconditions: successful execution of ficlInitSystem, ** Successful creation and init of the VM by ficlNewVM (or equivalent) ** ** If you call ficlExec() or one of its brothers, you MUST ** ensure vm->sourceId was set to a sensible value. ** ficlExec() explicitly DOES NOT manage SOURCE-ID for you. */ FICL_PLATFORM_EXTERN int ficlVmExecuteString(ficlVm *vm, ficlString s); FICL_PLATFORM_EXTERN int ficlVmExecuteXT(ficlVm *vm, ficlWord *pWord); FICL_PLATFORM_EXTERN void ficlVmExecuteInstruction(ficlVm *vm, ficlInstruction i); FICL_PLATFORM_EXTERN void ficlVmExecuteWord(ficlVm *vm, ficlWord *pWord); FICL_PLATFORM_EXTERN void ficlVmDictionaryAllot(ficlVm *vm, ficlDictionary *dictionary, int n); FICL_PLATFORM_EXTERN void ficlVmDictionaryAllotCells(ficlVm *vm, ficlDictionary *dictionary, int cells); FICL_PLATFORM_EXTERN int ficlVmParseWord(ficlVm *vm, ficlString s); /* ** TIB access routines... ** ANS forth seems to require the input buffer to be represented ** as a pointer to the start of the buffer, and an index to the ** next character to read. ** PushTib points the VM to a new input string and optionally ** returns a copy of the current state ** PopTib restores the TIB state given a saved TIB from PushTib ** GetInBuf returns a pointer to the next unused char of the TIB */ FICL_PLATFORM_EXTERN void ficlVmPushTib (ficlVm *vm, char *text, ficlInteger nChars, ficlTIB *pSaveTib); FICL_PLATFORM_EXTERN void ficlVmPopTib (ficlVm *vm, ficlTIB *pTib); #define ficlVmGetInBuf(vm) ((vm)->tib.text + (vm)->tib.index) #define ficlVmGetInBufLen(vm) ((vm)->tib.end - (vm)->tib.text) #define ficlVmGetInBufEnd(vm) ((vm)->tib.end) #define ficlVmGetTibIndex(vm) ((vm)->tib.index) #define ficlVmSetTibIndex(vm, i) ((vm)->tib.index = i) #define ficlVmUpdateTib(vm, str) ((vm)->tib.index = (str) - (vm)->tib.text) #if FICL_ROBUST >= 1 FICL_PLATFORM_EXTERN void ficlVmDictionaryCheck(ficlVm *vm, ficlDictionary *dictionary, int n); FICL_PLATFORM_EXTERN void ficlVmDictionarySimpleCheck(ficlVm *vm, ficlDictionary *dictionary, int n); #define FICL_VM_DICTIONARY_CHECK(vm, dictionary, n) ficlVmDictionaryCheck(vm, dictionary, n) #define FICL_VM_DICTIONARY_SIMPLE_CHECK(vm, dictionary, n) ficlVmDictionarySimpleCheck(vm, dictionary, n) #else #define FICL_VM_DICTIONARY_CHECK(vm, dictionary, n) #define FICL_VM_DICTIONARY_SIMPLE_CHECK(vm, dictionary, n) #endif /* FICL_ROBUST >= 1 */ FICL_PLATFORM_EXTERN void ficlPrimitiveLiteralIm(ficlVm *vm); /* ** A FICL_CODE points to a function that gets called to help execute ** a word in the dictionary. It always gets passed a pointer to the ** running virtual machine, and from there it can get the address ** of the parameter area of the word it's supposed to operate on. ** For precompiled words, the code is all there is. For user defined ** words, the code assumes that the word's parameter area is a list ** of pointers to the code fields of other words to execute, and ** may also contain inline data. The first parameter is always ** a pointer to a code field. */ /* ** Ficl models memory as a contiguous space divided into ** words in a linked list called the dictionary. ** A ficlWord starts each entry in the list. ** Version 1.02: space for the name characters is allotted from ** the dictionary ahead of the word struct, rather than using ** a fixed size array for each name. */ struct ficlWord { struct ficlWord *link; /* Previous word in the dictionary */ ficlUnsigned16 hash; ficlUnsigned8 flags; /* Immediate, Smudge, Compile-only, IsOjbect, Instruction */ ficlUnsigned8 length; /* Number of chars in word name */ char *name; /* First nFICLNAME chars of word name */ ficlPrimitive code; /* Native code to execute the word */ ficlInstruction semiParen; /* Native code to execute the word */ ficlCell param[1]; /* First data cell of the word */ }; /* ** ficlWord.flag bitfield values: */ /* ** FICL_WORD_IMMEDIATE: ** This word is always executed immediately when ** encountered, even when compiling. */ #define FICL_WORD_IMMEDIATE ( 1) /* ** FICL_WORD_COMPILE_ONLY: ** This word is only valid during compilation. ** Ficl will throw a runtime error if this word executed ** while not compiling. */ #define FICL_WORD_COMPILE_ONLY ( 2) /* ** FICL_WORD_SMUDGED ** This word's definition is in progress. ** The word is hidden from dictionary lookups ** until it is "un-smudged". */ #define FICL_WORD_SMUDGED ( 4) /* ** FICL_WORD_OBJECT ** This word is an object or object member variable. ** (Currently only used by "my=[".) */ #define FICL_WORD_OBJECT ( 8) /* ** FICL_WORD_INSTRUCTION ** This word represents a ficlInstruction, not a normal word. ** param[0] is the instruction. ** When compiled, Ficl will simply copy over the instruction, ** rather than executing the word as normal. ** ** (Do *not* use this flag for words that need their PFA pushed ** before executing!) */ #define FICL_WORD_INSTRUCTION (16) /* ** FICL_WORD_COMPILE_ONLY_IMMEDIATE ** Most words that are "immediate" are also ** "compile-only". */ #define FICL_WORD_COMPILE_ONLY_IMMEDIATE (FICL_WORD_IMMEDIATE | FICL_WORD_COMPILE_ONLY) #define FICL_WORD_DEFAULT ( 0) /* ** Worst-case size of a word header: FICL_NAME_LENGTH chars in name */ #define FICL_CELLS_PER_WORD \ ( (sizeof (ficlWord) + FICL_NAME_LENGTH + sizeof (ficlCell)) \ / (sizeof (ficlCell)) ) FICL_PLATFORM_EXTERN int ficlWordIsImmediate(ficlWord *word); FICL_PLATFORM_EXTERN int ficlWordIsCompileOnly(ficlWord *word); #if FICL_ROBUST >= 1 FICL_PLATFORM_EXTERN void ficlCallbackAssert(ficlCallback *callback, int expression, char *expressionString, char *filename, int line); #define FICL_ASSERT(callback, expression) (ficlCallbackAssert((callback), (expression) != 0, #expression, __FILE__, __LINE__)) #else #define FICL_ASSERT(callback, expression) #endif /* FICL_ROBUST >= 1 */ #define FICL_VM_ASSERT(vm, expression) FICL_ASSERT((ficlCallback *)(vm), (expression)) #define FICL_SYSTEM_ASSERT(system, expression) FICL_ASSERT((ficlCallback *)(system), (expression)) /* ** Generally useful string manipulators omitted by ANSI C... ** ltoa complements strtol */ FICL_PLATFORM_EXTERN int ficlIsPowerOfTwo(ficlUnsigned u); FICL_PLATFORM_EXTERN char *ficlLtoa(ficlInteger value, char *string, int radix ); FICL_PLATFORM_EXTERN char *ficlUltoa(ficlUnsigned value, char *string, int radix ); FICL_PLATFORM_EXTERN char ficlDigitToCharacter(int value); FICL_PLATFORM_EXTERN char *ficlStringReverse( char *string ); FICL_PLATFORM_EXTERN char *ficlStringSkipSpace(char *s, char *end); FICL_PLATFORM_EXTERN char *ficlStringCaseFold(char *s); FICL_PLATFORM_EXTERN int ficlStrincmp(char *s1, char *s2, ficlUnsigned length); FICL_PLATFORM_EXTERN void *ficlAlignPointer(void *ptr); /* ** Ficl hash table - variable size. ** assert(size > 0) ** If size is 1, the table degenerates into a linked list. ** A WORDLIST (see the search order word set in DPANS) is ** just a pointer to a FICL_HASH in this implementation. */ typedef struct ficlHash { struct ficlHash *link; /* link to parent class wordlist for OO */ char *name; /* optional pointer to \0 terminated wordlist name */ unsigned size; /* number of buckets in the hash */ ficlWord *table[1]; } ficlHash; FICL_PLATFORM_EXTERN void ficlHashForget (ficlHash *hash, void *where); FICL_PLATFORM_EXTERN ficlUnsigned16 ficlHashCode (ficlString s); FICL_PLATFORM_EXTERN void ficlHashInsertWord(ficlHash *hash, ficlWord *word); FICL_PLATFORM_EXTERN ficlWord *ficlHashLookup (ficlHash *hash, ficlString name, ficlUnsigned16 hashCode); FICL_PLATFORM_EXTERN void ficlHashReset (ficlHash *hash); /* ** A Dictionary is a linked list of FICL_WORDs. It is also Ficl's ** memory model. Description of fields: ** ** here -- points to the next free byte in the dictionary. This ** pointer is forced to be CELL-aligned before a definition is added. ** Do not assume any specific alignment otherwise - Use dictAlign(). ** ** smudge -- pointer to word currently being defined (or last defined word) ** If the definition completes successfully, the word will be ** linked into the hash table. If unsuccessful, dictUnsmudge ** uses this pointer to restore the previous state of the dictionary. ** Smudge prevents unintentional recursion as a side-effect: the ** dictionary search algo examines only completed definitions, so a ** word cannot invoke itself by name. See the Ficl word "recurse". ** NOTE: smudge always points to the last word defined. IMMEDIATE ** makes use of this fact. Smudge is initially NULL. ** ** forthWordlist -- pointer to the default wordlist (FICL_HASH). ** This is the initial compilation list, and contains all ** Ficl's precompiled words. ** ** compilationWordlist -- compilation wordlist - initially equal to forthWordlist ** wordlists -- array of pointers to wordlists. Managed as a stack. ** Highest index is the first list in the search order. ** wordlistCount -- number of lists in wordlists. wordlistCount-1 is the highest ** filled slot in wordlists, and points to the first wordlist ** in the search order ** size -- number of cells in the dictionary (total) ** base -- start of data area. Must be at the end of the struct. */ struct ficlDictionary { ficlCell *here; void *context; /* for your use, particularly with ficlDictionaryLock() */ ficlWord *smudge; ficlHash *forthWordlist; ficlHash *compilationWordlist; ficlHash *wordlists[FICL_MAX_WORDLISTS]; int wordlistCount; unsigned size; /* Number of cells in dictionary (total)*/ ficlSystem *system; /* used for debugging */ ficlCell base[1]; /* Base of dictionary memory */ }; FICL_PLATFORM_EXTERN void ficlDictionaryAbortDefinition(ficlDictionary *dictionary); FICL_PLATFORM_EXTERN void ficlDictionaryAlign (ficlDictionary *dictionary); FICL_PLATFORM_EXTERN void ficlDictionaryAllot (ficlDictionary *dictionary, int n); FICL_PLATFORM_EXTERN void ficlDictionaryAllotCells (ficlDictionary *dictionary, int nCells); FICL_PLATFORM_EXTERN void ficlDictionaryAppendCell (ficlDictionary *dictionary, ficlCell c); FICL_PLATFORM_EXTERN void ficlDictionaryAppendCharacter(ficlDictionary *dictionary, char c); FICL_PLATFORM_EXTERN void ficlDictionaryAppendUnsigned(ficlDictionary *dictionary, ficlUnsigned u); FICL_PLATFORM_EXTERN void *ficlDictionaryAppendData(ficlDictionary *dictionary, void *data, ficlInteger length); FICL_PLATFORM_EXTERN char *ficlDictionaryAppendString(ficlDictionary *dictionary, ficlString s); FICL_PLATFORM_EXTERN ficlWord *ficlDictionaryAppendWord(ficlDictionary *dictionary, ficlString name, ficlPrimitive pCode, ficlUnsigned8 flags); FICL_PLATFORM_EXTERN ficlWord *ficlDictionaryAppendPrimitive(ficlDictionary *dictionary, char *name, ficlPrimitive pCode, ficlUnsigned8 flags); FICL_PLATFORM_EXTERN ficlWord *ficlDictionaryAppendInstruction(ficlDictionary *dictionary, char *name, ficlInstruction i, ficlUnsigned8 flags); FICL_PLATFORM_EXTERN ficlWord *ficlDictionaryAppendConstantInstruction(ficlDictionary *dictionary, ficlString name, ficlInstruction instruction, ficlInteger value); FICL_PLATFORM_EXTERN ficlWord *ficlDictionaryAppend2ConstantInstruction(ficlDictionary *dictionary, ficlString name, ficlInstruction instruction, ficl2Integer value); FICL_PLATFORM_EXTERN ficlWord *ficlDictionaryAppendConstant(ficlDictionary *dictionary, char *name, ficlInteger value); FICL_PLATFORM_EXTERN ficlWord *ficlDictionaryAppend2Constant(ficlDictionary *dictionary, char *name, ficl2Integer value); #define ficlDictionaryAppendConstantPointer(dictionary, name, pointer) \ (ficlDictionaryAppendConstant(dictionary, name, (ficlInteger)pointer)) #if FICL_WANT_FLOAT FICL_PLATFORM_EXTERN ficlWord *ficlDictionaryAppendFConstant(ficlDictionary *dictionary, char *name, float value); FICL_PLATFORM_EXTERN ficlWord *ficlDictionaryAppendF2Constant(ficlDictionary *dictionary, char *name, double value); #endif /* FICL_WANT_FLOAT */ FICL_PLATFORM_EXTERN ficlWord *ficlDictionarySetConstantInstruction(ficlDictionary *dictionary, ficlString name, ficlInstruction instruction, ficlInteger value); FICL_PLATFORM_EXTERN ficlWord *ficlDictionarySet2ConstantInstruction(ficlDictionary *dictionary, ficlString name, ficlInstruction instruction, ficl2Integer value); FICL_PLATFORM_EXTERN ficlWord *ficlDictionarySetConstant(ficlDictionary *dictionary, char *name, ficlInteger value); #define ficlDictionarySetConstantPointer(dictionary, name, pointer) \ (ficlDictionarySetConstant(dictionary, name, (ficlInteger)pointer)) FICL_PLATFORM_EXTERN ficlWord *ficlDictionarySet2Constant(ficlDictionary *dictionary, char *name, ficl2Integer value); FICL_PLATFORM_EXTERN ficlWord *ficlDictionarySetConstantString(ficlDictionary *dictionary, char *name, char *value); FICL_PLATFORM_EXTERN ficlWord *ficlDictionarySetPrimitive(ficlDictionary *dictionary, char *name, ficlPrimitive code, ficlUnsigned8 flags); FICL_PLATFORM_EXTERN ficlWord *ficlDictionarySetInstruction(ficlDictionary *dictionary, char *name, ficlInstruction i, ficlUnsigned8 flags); #if FICL_WANT_FLOAT FICL_PLATFORM_EXTERN ficlWord *ficlDictionarySetFConstant(ficlDictionary *dictionary, char *name, float value); FICL_PLATFORM_EXTERN ficlWord *ficlDictionarySetF2Constant(ficlDictionary *dictionary, char *name, double value); #endif /* FICL_WANT_FLOAT */ FICL_PLATFORM_EXTERN int ficlDictionaryCellsAvailable (ficlDictionary *dictionary); FICL_PLATFORM_EXTERN int ficlDictionaryCellsUsed (ficlDictionary *dictionary); FICL_PLATFORM_EXTERN ficlDictionary *ficlDictionaryCreate(ficlSystem *system, unsigned nCELLS); FICL_PLATFORM_EXTERN ficlDictionary *ficlDictionaryCreateHashed(ficlSystem *system, unsigned nCells, unsigned nHash); FICL_PLATFORM_EXTERN ficlHash *ficlDictionaryCreateWordlist(ficlDictionary *dictionary, int nBuckets); FICL_PLATFORM_EXTERN void ficlDictionaryDestroy (ficlDictionary *dictionary); FICL_PLATFORM_EXTERN void ficlDictionaryEmpty (ficlDictionary *dictionary, unsigned nHash); FICL_PLATFORM_EXTERN int ficlDictionaryIncludes (ficlDictionary *dictionary, void *p); FICL_PLATFORM_EXTERN ficlWord *ficlDictionaryLookup (ficlDictionary *dictionary, ficlString name); FICL_PLATFORM_EXTERN void ficlDictionaryResetSearchOrder(ficlDictionary *dictionary); FICL_PLATFORM_EXTERN void ficlDictionarySetFlags (ficlDictionary *dictionary, ficlUnsigned8 set); FICL_PLATFORM_EXTERN void ficlDictionaryClearFlags(ficlDictionary *dictionary, ficlUnsigned8 clear); FICL_PLATFORM_EXTERN void ficlDictionarySetImmediate(ficlDictionary *dictionary); FICL_PLATFORM_EXTERN void ficlDictionaryUnsmudge (ficlDictionary *dictionary); FICL_PLATFORM_EXTERN ficlCell *ficlDictionaryWhere (ficlDictionary *dictionary); FICL_PLATFORM_EXTERN int ficlDictionaryIsAWord(ficlDictionary *dictionary, ficlWord *word); FICL_PLATFORM_EXTERN void ficlDictionarySee(ficlDictionary *dictionary, ficlWord *word, ficlCallback *callback); FICL_PLATFORM_EXTERN ficlWord *ficlDictionaryFindEnclosingWord(ficlDictionary *dictionary, ficlCell *cell); /* ** Stub function for dictionary access control - does nothing ** by default, user can redefine to guarantee exclusive dictionary ** access to a single thread for updates. All dictionary update code ** must be bracketed as follows: ** ficlLockDictionary(dictionary, FICL_TRUE); // any non-zero value will do ** <code that updates dictionary> ** ficlLockDictionary(dictionary, FICL_FALSE); ** ** Returns zero if successful, nonzero if unable to acquire lock ** before timeout (optional - could also block forever) ** ** NOTE: this function must be implemented with lock counting ** semantics: nested calls must behave properly. */ #if FICL_MULTITHREAD FICL_PLATFORM_EXTERN int ficlDictionaryLock(ficlDictionary *dictionary, short lockIncrement); #else #define ficlDictionaryLock(dictionary, lock) (void)0 /* ignore */ #endif /* ** P A R S E S T E P ** (New for 2.05) ** See words.c: interpWord ** By default, Ficl goes through two attempts to parse each token from its input ** stream: it first attempts to match it with a word in the dictionary, and ** if that fails, it attempts to convert it into a number. This mechanism is now ** extensible by additional steps. This allows extensions like floating point and ** double number support to be factored cleanly. ** ** Each parse step is a function that receives the next input token as a STRINGINFO. ** If the parse step matches the token, it must apply semantics to the token appropriate ** to the present value of VM.state (compiling or interpreting), and return FICL_TRUE. ** Otherwise it returns FICL_FALSE. See words.c: isNumber for an example ** ** Note: for the sake of efficiency, it's a good idea both to limit the number ** of parse steps and to code each parse step so that it rejects tokens that ** do not match as quickly as possible. */ typedef int (*ficlParseStep)(ficlVm *vm, ficlString s); /* ** FICL_BREAKPOINT record. ** oldXT - if NULL, this breakpoint is unused. Otherwise it stores the xt ** that the breakpoint overwrote. This is restored to the dictionary when the ** BP executes or gets cleared ** address - the location of the breakpoint (address of the instruction that ** has been replaced with the breakpoint trap ** oldXT - The original contents of the location with the breakpoint ** Note: address is NULL when this breakpoint is empty */ typedef struct ficlBreakpoint { void *address; ficlWord *oldXT; } ficlBreakpoint; /* ** F I C L _ S Y S T E M ** The top level data structure of the system - ficl_system ties a list of ** virtual machines with their corresponding dictionaries. Ficl 3.0 added ** support for multiple Ficl systems, allowing multiple concurrent sessions ** to separate dictionaries with some constraints. ** Note: the context pointer is there to provide context for applications. It is copied ** to each VM's context field as that VM is created. */ struct ficlSystemInformation { int size; /* structure size tag for versioning */ void *context; /* Initializes VM's context pointer - for application use */ int dictionarySize; /* Size of system's Dictionary, in cells */ int stackSize; /* Size of all stacks created, in cells */ ficlOutputFunction textOut; /* default textOut function */ ficlOutputFunction errorOut; /* textOut function used for errors */ int environmentSize; /* Size of Environment dictionary, in cells */ }; #define ficlSystemInformationInitialize(x) { memset((x), 0, sizeof(ficlSystemInformation)); \ (x)->size = sizeof(ficlSystemInformation); } struct ficlSystem { ficlCallback callback; ficlSystem *link; ficlVm *vmList; ficlDictionary *dictionary; ficlDictionary *environment; ficlInstruction interpreterLoop[3]; ficlWord *parseList[FICL_MAX_PARSE_STEPS]; ficlWord *exitInnerWord; ficlWord *interpretWord; #if FICL_WANT_LOCALS ficlDictionary *locals; ficlInteger localsCount; ficlCell *localsFixup; #endif ficlInteger stackSize; ficlBreakpoint breakpoint; #if FICL_WANT_COMPATIBILITY ficlCompatibilityOutputFunction thunkedTextout; #endif /* FICL_WANT_COMPATIBILITY */ }; #define ficlSystemGetContext(system) ((system)->context) /* ** External interface to Ficl... */ /* ** f i c l S y s t e m C r e a t e ** Binds a global dictionary to the interpreter system and initializes ** the dictionary to contain the ANSI CORE wordset. ** You can specify the address and size of the allocated area. ** You can also specify the text output function at creation time. ** After that, Ficl manages it. ** First step is to set up the static pointers to the area. ** Then write the "precompiled" portion of the dictionary in. ** The dictionary needs to be at least large enough to hold the ** precompiled part. Try 1K cells minimum. Use "words" to find ** out how much of the dictionary is used at any time. */ FICL_PLATFORM_EXTERN ficlSystem *ficlSystemCreate(ficlSystemInformation *fsi); /* ** f i c l S y s t e m D e s t r o y ** Deletes the system dictionary and all virtual machines that ** were created with ficlNewVM (see below). Call this function to ** reclaim all memory used by the dictionary and VMs. */ FICL_PLATFORM_EXTERN void ficlSystemDestroy(ficlSystem *system); /* ** Create a new VM from the heap, and link it into the system VM list. ** Initializes the VM and binds default sized stacks to it. Returns the ** address of the VM, or NULL if an error occurs. ** Precondition: successful execution of ficlInitSystem */ FICL_PLATFORM_EXTERN ficlVm *ficlSystemCreateVm(ficlSystem *system); /* ** Force deletion of a VM. You do not need to do this ** unless you're creating and discarding a lot of VMs. ** For systems that use a constant pool of VMs for the life ** of the system, ficltermSystem takes care of VM cleanup ** automatically. */ FICL_PLATFORM_EXTERN void ficlSystemDestroyVm(ficlVm *vm); /* ** Returns the address of the most recently defined word in the system ** dictionary with the given name, or NULL if no match. ** Precondition: successful execution of ficlInitSystem */ FICL_PLATFORM_EXTERN ficlWord *ficlSystemLookup(ficlSystem *system, char *name); /* ** f i c l G e t D i c t ** Utility function - returns the address of the system dictionary. ** Precondition: successful execution of ficlInitSystem */ ficlDictionary *ficlSystemGetDictionary(ficlSystem *system); ficlDictionary *ficlSystemGetEnvironment(ficlSystem *system); #if FICL_WANT_LOCALS ficlDictionary *ficlSystemGetLocals(ficlSystem *system); #endif /* ** f i c l C o m p i l e C o r e ** Builds the ANS CORE wordset into the dictionary - called by ** ficlInitSystem - no need to waste dictionary space by doing it again. */ FICL_PLATFORM_EXTERN void ficlSystemCompileCore(ficlSystem *system); FICL_PLATFORM_EXTERN void ficlSystemCompilePrefix(ficlSystem *system); FICL_PLATFORM_EXTERN void ficlSystemCompileSearch(ficlSystem *system); FICL_PLATFORM_EXTERN void ficlSystemCompileSoftCore(ficlSystem *system); FICL_PLATFORM_EXTERN void ficlSystemCompileTools(ficlSystem *system); FICL_PLATFORM_EXTERN void ficlSystemCompileFile(ficlSystem *system); #if FICL_WANT_FLOAT FICL_PLATFORM_EXTERN void ficlSystemCompileFloat(ficlSystem *system); FICL_PLATFORM_EXTERN int ficlVmParseFloatNumber(ficlVm *vm, ficlString s); #endif /* FICL_WANT_FLOAT */ #if FICL_WANT_PLATFORM FICL_PLATFORM_EXTERN void ficlSystemCompilePlatform(ficlSystem *system); #endif /* FICL_WANT_PLATFORM */ FICL_PLATFORM_EXTERN void ficlSystemCompileExtras(ficlSystem *system); FICL_PLATFORM_EXTERN int ficlVmParsePrefix(ficlVm *vm, ficlString s); #if FICL_WANT_LOCALS FICL_PLATFORM_EXTERN ficlWord *ficlSystemLookupLocal(ficlSystem *system, ficlString name); #endif /* ** from words.c... */ FICL_PLATFORM_EXTERN int ficlVmParseNumber(ficlVm *vm, ficlString s); FICL_PLATFORM_EXTERN void ficlPrimitiveTick(ficlVm *vm); FICL_PLATFORM_EXTERN void ficlPrimitiveParseStepParen(ficlVm *vm); #if FICL_WANT_LOCALS FICL_PLATFORM_EXTERN void ficlLocalParen(ficlVm *vm, int isDouble, int isFloat); #endif /* FICL_WANT_LOCALS */ /* ** Appends a parse step function to the end of the parse list (see ** FICL_PARSE_STEP notes in ficl.h for details). Returns 0 if successful, ** nonzero if there's no more room in the list. Each parse step is a word in ** the dictionary. Precompiled parse steps can use (PARSE-STEP) as their ** CFA - see parenParseStep in words.c. */ FICL_PLATFORM_EXTERN int ficlSystemAddParseStep(ficlSystem *system, ficlWord *word); /* ficl.c */ FICL_PLATFORM_EXTERN void ficlSystemAddPrimitiveParseStep(ficlSystem *system, char *name, ficlParseStep pStep); /* ** From tools.c */ /* ** The following supports SEE and the debugger. */ typedef enum { FICL_WORDKIND_BRANCH, FICL_WORDKIND_BRANCH0, FICL_WORDKIND_COLON, FICL_WORDKIND_CONSTANT, FICL_WORDKIND_2CONSTANT, FICL_WORDKIND_CREATE, FICL_WORDKIND_DO, FICL_WORDKIND_DOES, FICL_WORDKIND_LITERAL, FICL_WORDKIND_2LITERAL, #if FICL_WANT_FLOAT FICL_WORDKIND_FLITERAL, #endif /* FICL_WANT_FLOAT */ FICL_WORDKIND_LOOP, FICL_WORDKIND_OF, FICL_WORDKIND_PLOOP, FICL_WORDKIND_PRIMITIVE, FICL_WORDKIND_QDO, FICL_WORDKIND_STRING_LITERAL, FICL_WORDKIND_CSTRING_LITERAL, #if FICL_WANT_USER FICL_WORDKIND_USER, #endif FICL_WORDKIND_VARIABLE, FICL_WORDKIND_INSTRUCTION, FICL_WORDKIND_INSTRUCTION_WORD, FICL_WORDKIND_INSTRUCTION_WITH_ARGUMENT, } ficlWordKind; ficlWordKind ficlWordClassify(ficlWord *word); /* ** Used with File-Access wordset. */ #define FICL_FAM_READ 1 #define FICL_FAM_WRITE 2 #define FICL_FAM_APPEND 4 #define FICL_FAM_BINARY 8 #define FICL_FAM_OPEN_MODE(fam) ((fam) & (FICL_FAM_READ | FICL_FAM_WRITE | FICL_FAM_APPEND)) typedef struct ficlFile { FILE *f; char filename[256]; } ficlFile; #if defined (FICL_PLATFORM_HAS_FTRUNCATE) FICL_PLATFORM_EXTERN int ficlFileTruncate(ficlFile *ff, ficlUnsigned size); #endif FICL_PLATFORM_EXTERN int ficlFileStatus(char *filename, int *status); FICL_PLATFORM_EXTERN long ficlFileSize(ficlFile *ff); /* ** Used with compressed softcore. ** */ #ifndef FICL_BIT_NUMBER #define FICL_BIT_NUMBER(x) (1 << (x)) #endif /* FICL_BIT_NUMBER */ #ifndef FICL_BIT_SET #define FICL_BIT_SET(value, flag) ((value) |= (flag)) #endif /* FICL_BIT_SET */ #ifndef FICL_BIT_CLEAR #define FICL_BIT_CLEAR(value, flag) ((value) &= ~(flag)) #endif /* FICL_BIT_CLEAR */ #ifndef FICL_BIT_CHECK #define FICL_BIT_CHECK(value, flag) ((value) & (flag)) #endif /* FICL_BIT_CHECK */ #define FICL_LZ_TYPE_BITS (1) #define FICL_LZ_OFFSET_BITS (12) #define FICL_LZ_LENGTH_BITS (5) #define FICL_LZ_NEXT_BITS (8) #define FICL_LZ_PHRASE_BITS (FICL_LZ_TYPE_BITS + FICL_LZ_OFFSET_BITS + FICL_LZ_LENGTH_BITS + FICL_LZ_NEXT_BITS) #define FICL_LZ_SYMBOL_BITS (FICL_LZ_TYPE_BITS + FICL_LZ_NEXT_BITS) /* ** if you match fewer characters than this, don't bother, ** it's smaller to encode it as a sequence of symbol tokens. **/ #define FICL_LZ_MINIMUM_USEFUL_MATCH ((int)(FICL_LZ_PHRASE_BITS / FICL_LZ_SYMBOL_BITS)) #define FICL_LZ_WINDOW_SIZE (FICL_BIT_NUMBER(FICL_LZ_OFFSET_BITS)) #define FICL_LZ_BUFFER_SIZE (FICL_BIT_NUMBER(FICL_LZ_LENGTH_BITS) + FICL_LZ_MINIMUM_USEFUL_MATCH) FICL_PLATFORM_EXTERN int ficlBitGet(const unsigned char *bits, size_t index); FICL_PLATFORM_EXTERN void ficlBitSet(unsigned char *bits, size_t size_t, int value); FICL_PLATFORM_EXTERN void ficlBitGetString(unsigned char *destination, const unsigned char *source, int offset, int count, int destAlignment); FICL_PLATFORM_EXTERN ficlUnsigned16 ficlNetworkUnsigned16(ficlUnsigned16 number); FICL_PLATFORM_EXTERN ficlUnsigned32 ficlNetworkUnsigned32(ficlUnsigned32 number); #define FICL_MIN(a, b) (((a) < (b)) ? (a) : (b)) FICL_PLATFORM_EXTERN int ficlLzCompress(const char *uncompressed, size_t uncompressedSize, unsigned char **compressed, size_t *compressedSize); FICL_PLATFORM_EXTERN int ficlLzUncompress(const unsigned char *compressed, char **uncompressed, size_t *uncompressedSize); #if FICL_WANT_COMPATIBILITY #include "ficlcompatibility.h" #endif /* FICL_WANT_COMPATIBILITY */ #ifdef __cplusplus } #endif #endif /* __FICL_H__ */