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