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