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