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