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