/* * 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.25 2010/10/03 09:52:12 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. */ #ifndef _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 #ifdef _STANDALONE #include #include #include #else #include #include #include #include #include #define __dead2 __NORETURN extern void pager_open(void); extern int pager_output(const char *); extern void pager_close(void); #endif #include #include /* * 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" #include "ficlplatform/unix.h" /* * * 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_LZ4_SOFTCORE * If nonzero, the softcore words are stored compressed * with patent-unencumbered LZ4 compression. * This results in a smaller Ficl interpreter, and adds * only a *tiny* runtime speed hit. * * Original LZ77 contributed by Larry Hastings. * Updated to LZ4 which is even more space efficient. */ #if !defined(FICL_WANT_LZ4_SOFTCORE) #define FICL_WANT_LZ4_SOFTCORE (1) #endif /* FICL_WANT_LZ4_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 (0) #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 "unknown" #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 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" #define FICL_VERSION_MAJOR 4 #define FICL_VERSION_MINOR 1 #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 /* * 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_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_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_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_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 */ /* * These structures represent the result of division. */ typedef struct { ficl2Unsigned quotient; ficlUnsigned remainder; } __attribute__((may_alias)) ficl2UnsignedQR; typedef struct { ficl2Integer quotient; ficlInteger remainder; } __attribute__((may_alias)) 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); } __attribute__((may_alias)) 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 /* * 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[1]; /* 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 intptr_t 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 */ /* address of currently running word (often just *(ip-1) ) */ ficlWord *runningWord; 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) */ }; /* * 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 */ /* tell ficlVmExecuteXT to exit inner loop */ #define FICL_VM_STATUS_INNER_EXIT (-256) /* hungry - normal exit */ #define FICL_VM_STATUS_OUT_OF_TEXT (-257) /* word needs more text to succeed -- re-run it */ #define FICL_VM_STATUS_RESTART (-258) /* user wants to quit */ #define FICL_VM_STATUS_USER_EXIT (-259) /* interpreter found an error */ #define FICL_VM_STATUS_ERROR_EXIT (-260) /* debugger breakpoint */ #define FICL_VM_STATUS_BREAK (-261) /* like FICL_VM_STATUS_ERROR_EXIT -- abort */ #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, but leave dataStack & base alone */ #define FICL_VM_STATUS_QUIT (-56) 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, ...) __dead2; FICL_PLATFORM_EXTERN void ficlVmThrowErrorVararg(ficlVm *vm, char *fmt, va_list list) __dead2; FICL_PLATFORM_EXTERN void ficlVmTextOut(ficlVm *vm, char *text); FICL_PLATFORM_EXTERN void ficlVmErrorOut(ficlVm *vm, char *text); #define ficlVmGetContext(vm) ((vm)->callback.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 int ficlExecFD(ficlVm *vm, int fd); 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; /* Immediate, Smudge, Compile-only, IsOjbect, Instruction */ ficlUnsigned8 flags; 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, ficlFloat value); FICL_PLATFORM_EXTERN ficlWord * ficlDictionaryAppendF2Constant(ficlDictionary *dictionary, char *name, ficlFloat 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, ficlFloat value); FICL_PLATFORM_EXTERN ficlWord * ficlDictionarySetF2Constant(ficlDictionary *dictionary, char *name, ficlFloat 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 * * 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 */ /* Initializes VM's context pointer - for application use */ void *context; 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; ficlWord *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; }; #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); FICL_PLATFORM_EXTERN void ficlPrimitiveSiftingImpl(ficlVm *vm, char *ss); #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); #if FICL_WANT_FILE /* * 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); #endif /* Support for linker set inclusions. */ #ifdef _STANDALONE typedef void ficlCompileFcn(ficlSystem *); #define FICL_COMPILE_SET(func) \ DATA_SET(Xficl_compile_set, func) SET_DECLARE(Xficl_compile_set, ficlCompileFcn); #endif /* _STANDALONE */ #ifdef __cplusplus } #endif #endif /* _FICL_H */