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