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