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 /*- 45 * Adapted to work with FTH 46 * 47 * Copyright (c) 2004-2017 Michael Scholz <mi-scholz@users.sourceforge.net> 48 * All rights reserved. 49 * 50 * Redistribution and use in source and binary forms, with or without 51 * modification, are permitted provided that the following conditions 52 * are met: 53 * 1. Redistributions of source code must retain the above copyright 54 * notice, this list of conditions and the following disclaimer. 55 * 2. Redistributions in binary form must reproduce the above copyright 56 * notice, this list of conditions and the following disclaimer in the 57 * documentation and/or other materials provided with the distribution. 58 * 59 * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND 60 * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 61 * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 62 * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE 63 * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 64 * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS 65 * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) 66 * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 67 * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY 68 * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF 69 * SUCH DAMAGE. 70 * 71 * @(#)ficl.h 1.96 12/31/17 72 */ 73 74 #if !defined (__FICL_H__) 75 #define __FICL_H__ 76 /* 77 ** Ficl (Forth-inspired command language) is an ANS Forth 78 ** interpreter written in C. Unlike traditional Forths, this 79 ** interpreter is designed to be embedded into other systems 80 ** as a command/macro/development prototype language. 81 ** 82 ** Where Forths usually view themselves as the center of the system 83 ** and expect the rest of the system to be coded in Forth, Ficl 84 ** acts as a component of the system. It is easy to export 85 ** code written in C or ASM to Ficl in the style of TCL, or to invoke 86 ** Ficl code from a compiled module. This allows you to do incremental 87 ** development in a way that combines the best features of threaded 88 ** languages (rapid development, quick code/test/debug cycle, 89 ** reasonably fast) with the best features of C (everyone knows it, 90 ** easier to support large blocks of code, efficient, type checking). 91 ** 92 ** Ficl provides facilities for interoperating 93 ** with programs written in C: C functions can be exported to Ficl, 94 ** and Ficl commands can be executed via a C calling interface. The 95 ** interpreter is re-entrant, so it can be used in multiple instances 96 ** in a multitasking system. Unlike Forth, Ficl's outer interpreter 97 ** expects a text block as input, and returns to the caller after each 98 ** text block, so the "data pump" is somewhere in external code. This 99 ** is more like TCL than Forth, which usually expects to be at the center 100 ** of the system, requesting input at its convenience. Each Ficl virtual 101 ** machine can be bound to a different I/O channel, and is independent 102 ** of all others in in the same address space except that all virtual 103 ** machines share a common dictionary (a sort or open symbol table that 104 ** defines all of the elements of the language). 105 ** 106 ** Code is written in ANSI C for portability. 107 ** 108 ** Summary of Ficl features and constraints: 109 ** - Standard: Implements the ANSI Forth CORE word set and part 110 ** of the CORE EXT word-set, SEARCH and SEARCH EXT, TOOLS and 111 ** TOOLS EXT, LOCAL and LOCAL ext and various extras. 112 ** - Extensible: you can export code written in Forth, C, 113 ** or asm in a straightforward way. Ficl provides open 114 ** facilities for extending the language in an application 115 ** specific way. You can even add new control structures! 116 ** - Ficl and C can interact in two ways: Ficl can encapsulate 117 ** C code, or C code can invoke Ficl code. 118 ** - Thread-safe, re-entrant: The shared system dictionary 119 ** uses a locking mechanism that you can either supply 120 ** or stub out to provide exclusive access. Each Ficl 121 ** virtual machine has an otherwise complete state, and 122 ** each can be bound to a separate I/O channel (or none at all). 123 ** - Simple encapsulation into existing systems: a basic implementation 124 ** requires three function calls (see the example program in testmain.c). 125 ** - ROMable: Ficl is designed to work in RAM-based and ROM code / RAM data 126 ** environments. It does require somewhat more memory than a pure 127 ** ROM implementation because it builds its system dictionary in 128 ** RAM at startup time. 129 ** - Written an ANSI C to be as simple as I can make it to understand, 130 ** support, debug, and port. Compiles without complaint at /Az /W4 131 ** (require ANSI C, max warnings) under Microsoft VC++ 5. 132 ** - Does full 32 bit math (but you need to implement 133 ** two mixed precision math primitives (see sysdep.c)) 134 ** - Indirect threaded interpreter is not the fastest kind of 135 ** Forth there is (see pForth 68K for a really fast subroutine 136 ** threaded interpreter), but it's the cleanest match to a 137 ** pure C implementation. 138 ** 139 ** P O R T I N G F i c l 140 ** 141 ** To install Ficl on your target system, you need an ANSI C compiler 142 ** and its runtime library. Inspect the system dependent macros and 143 ** functions in sysdep.h and sysdep.c and edit them to suit your 144 ** system. For example, INT16 is a short on some compilers and an 145 ** int on others. Check the default CELL alignment controlled by 146 ** FICL_ALIGN. If necessary, add new definitions of ficlMalloc, ficlFree, 147 ** ficlLockDictionary, and ficlCallbackDefaultTextOut to work with your 148 ** operating system. Finally, use testmain.c as a guide to installing the 149 ** Ficl system and one or more virtual machines into your code. You do not 150 ** need to include testmain.c in your build. 151 ** 152 ** T o D o L i s t 153 ** 154 ** 1. Unimplemented system dependent CORE word: key 155 ** 2. Ficl uses the PAD in some CORE words - this violates the standard, 156 ** but it's cleaner for a multithreaded system. I'll have to make a 157 ** second pad for reference by the word PAD to fix this. 158 ** 159 ** F o r M o r e I n f o r m a t i o n 160 ** 161 ** Web home of Ficl 162 ** http://ficl.sourceforge.net 163 ** Check this website for Forth literature (including the ANSI standard) 164 ** http://www.taygeta.com/forthlit.html 165 ** and here for software and more links 166 ** http://www.taygeta.com/forth.html 167 */ 168 169 #undef __BEGIN_DECLS 170 #undef __END_DECLS 171 #if defined(__cplusplus) 172 #define __BEGIN_DECLS extern "C" { 173 #define __END_DECLS } 174 #else 175 #define __BEGIN_DECLS 176 #define __END_DECLS 177 #endif 178 179 #include <stdio.h> 180 #include <stdlib.h> 181 #include <string.h> 182 #include <stdarg.h> 183 #include <stddef.h> 184 #include <limits.h> 185 #include <setjmp.h> 186 187 /* 188 ** Put all your local defines in ficllocal.h, 189 ** rather than editing the makefile/project/etc. 190 ** ficllocal.h will always ship as an inert file. 191 */ 192 #include "ficllocal.h" 193 194 /* 195 ** P L A T F O R M S E T T I N G S 196 ** 197 ** The FICL_PLATFORM_* settings. 198 ** These indicate attributes about the local platform. 199 */ 200 201 #define FICL_NAME "ficl" 202 #define FICL_VERSION "4.0.31" 203 204 /* 205 ** 206 ** Forth name. 207 */ 208 #if !defined (FICL_FORTH_NAME) 209 #define FICL_FORTH_NAME FICL_NAME 210 #endif 211 212 /* 213 ** 214 ** Forth version. 215 */ 216 #if !defined (FICL_FORTH_VERSION) 217 #define FICL_FORTH_VERSION FICL_VERSION 218 #endif 219 220 /* 221 ** FICL_PLATFORM_ARCHITECTURE 222 ** String constant describing the current hardware architecture. 223 */ 224 #if !defined (FICL_PLATFORM_ARCHITECTURE) 225 #define FICL_PLATFORM_ARCHITECTURE FTH_TARGET_CPU 226 #endif 227 228 /* 229 ** FICL_PLATFORM_OS 230 ** String constant describing the current operating system. 231 */ 232 #if !defined (FICL_PLATFORM_OS) 233 #define FICL_PLATFORM_OS FTH_TARGET_OS 234 #endif 235 236 /* 237 ** FICL_PLATFORM_VENDOR 238 ** String constant describing the current vendor. 239 */ 240 #if !defined (FICL_PLATFORM_VENDOR) 241 #define FICL_PLATFORM_VENDOR FTH_TARGET_VENDOR 242 #endif 243 244 /* 245 ** FICL_EXTERN 246 ** Must be defined, should be a keyword used to declare 247 ** a function prototype as being a genuine prototype. 248 ** You should only have to fiddle with this setting if 249 ** you're not using an ANSI-compliant compiler, in which 250 ** case, good luck! 251 ** 252 ** [ms] FICL_EXTERN removed 253 */ 254 #if !defined (FICL_EXTERN) 255 #define FICL_EXTERN extern 256 #endif /* !defined FICL_EXTERN */ 257 258 /* 259 ** FICL_PLATFORM_BASIC_TYPES 260 ** 261 ** If not defined yet, 262 */ 263 #if !defined (FICL_PLATFORM_BASIC_TYPES) 264 typedef char ficlInteger8; 265 typedef unsigned char ficlUnsigned8; 266 typedef short ficlInteger16; 267 typedef unsigned short ficlUnsigned16; 268 typedef long ficlInteger32; 269 typedef unsigned long ficlUnsigned32; 270 271 typedef ficlInteger32 ficlInteger; 272 typedef ficlUnsigned32 ficlUnsigned; 273 typedef float ficlFloat; 274 #endif /* !defined(FICL_PLATFORM_BASIC_TYPES) */ 275 276 /* 277 ** FICL_ROBUST enables bounds checking of stacks and the dictionary. 278 ** This will detect stack over and underflows and dictionary overflows. 279 ** Any exceptional condition will result in an assertion failure. 280 ** (As generated by the ANSI assert macro) 281 ** FICL_ROBUST == 1 --> stack checking in the outer interpreter 282 ** FICL_ROBUST == 2 also enables checking in many primitives 283 */ 284 /* FICL_ROBUST removed [ms] */ 285 286 /* 287 ** FICL_DEFAULT_STACK_SIZE Specifies the default size (in CELLs) of 288 ** a new virtual machine's stacks, unless overridden at 289 ** create time. 290 */ 291 #if !defined (FICL_DEFAULT_STACK_SIZE) 292 #define FICL_DEFAULT_STACK_SIZE (128) 293 #endif 294 295 /* 296 ** FICL_DEFAULT_DICTIONARY_SIZE specifies the number of ficlCells to allocate 297 ** for the system dictionary by default. The value 298 ** can be overridden at startup time as well. 299 */ 300 #if !defined (FICL_DEFAULT_DICTIONARY_SIZE) 301 #define FICL_DEFAULT_DICTIONARY_SIZE (12288) 302 #endif 303 304 /* 305 ** FICL_DEFAULT_ENVIRONMENT_SIZE specifies the number of cells 306 ** to allot for the environment-query dictionary. 307 */ 308 #if !defined (FICL_DEFAULT_ENVIRONMENT_SIZE) 309 #define FICL_DEFAULT_ENVIRONMENT_SIZE (512) 310 #endif 311 312 /* 313 ** FICL_MAX_WORDLISTS specifies the maximum number of wordlists in 314 ** the dictionary search order. See Forth DPANS sec 16.3.3 315 ** (file://dpans16.htm#16.3.3) 316 */ 317 #if !defined (FICL_MAX_WORDLISTS) 318 #define FICL_MAX_WORDLISTS (16) 319 #endif 320 321 /* 322 ** FICL_MAX_PARSE_STEPS controls the size of an array in the FICL_SYSTEM structure 323 ** that stores pointers to parser extension functions. I would never expect to have 324 ** more than 8 of these, so that's the default limit. Too many of these functions 325 ** will probably exact a nasty performance penalty. 326 */ 327 #if !defined (FICL_MAX_PARSE_STEPS) 328 #define FICL_MAX_PARSE_STEPS (8) 329 #endif 330 331 /* 332 ** Maximum number of local variables per definition. 333 ** This only affects the size of the locals dictionary, 334 ** and there's only one per entire ficlSystem, so it 335 ** doesn't make sense to be a piker here. 336 */ 337 #if !defined (FICL_MAX_LOCALS) 338 #define FICL_MAX_LOCALS (64) 339 #endif 340 341 /* 342 ** The pad is a small scratch area for text manipulation. ANS Forth 343 ** requires it to hold at least 84 characters. 344 */ 345 #if !defined (FICL_PAD_SIZE) 346 #define FICL_PAD_SIZE (256) 347 #endif 348 349 /* 350 ** ANS Forth requires that a word's name contain {1..31} characters. 351 */ 352 #if !defined (FICL_NAME_LENGTH) 353 #define FICL_NAME_LENGTH (31) 354 #endif 355 356 /* 357 ** Default size of hash table. For most uniform 358 ** performance, use a prime number! 359 */ 360 #if !defined (FICL_HASH_SIZE) 361 #define FICL_HASH_SIZE (241) 362 #endif 363 364 /* 365 ** Default number of USER flags. 366 */ 367 #if !defined (FICL_USER_CELLS) 368 #define FICL_USER_CELLS (16) 369 #endif 370 371 /* 372 ** Forward declarations... read on. 373 */ 374 struct ficlWord; 375 typedef struct ficlWord ficlWord; 376 struct ficlVm; 377 typedef struct ficlVm ficlVm; 378 struct ficlDictionary; 379 typedef struct ficlDictionary ficlDictionary; 380 struct ficlSystem; 381 typedef struct ficlSystem ficlSystem; 382 struct ficlSystemInformation; 383 typedef struct ficlSystemInformation ficlSystemInformation; 384 struct ficlCallback; 385 typedef struct ficlCallback ficlCallback; 386 struct ficlCountedString; 387 typedef struct ficlCountedString ficlCountedString; 388 struct ficlString; 389 typedef struct ficlString ficlString; 390 391 392 __BEGIN_DECLS 393 394 /* 395 ** System dependent routines: 396 ** Edit the implementations in your appropriate ficlplatform/xxx.c to be 397 ** compatible with your runtime environment. 398 ** 399 ** ficlCallbackDefaultTextOut sends a zero-terminated string to the 400 ** default output device - used for system error messages. 401 ** 402 ** ficlMalloc(), ficlRealloc() and ficlFree() have the same semantics 403 ** as the functions malloc(), realloc(), and free() 404 ** from the standard C library. 405 */ 406 char *ficlCallbackDefaultTextIn(ficlCallback *); 407 void ficlCallbackDefaultTextOut(ficlCallback *, char *); 408 void ficlCallbackDefaultErrorOut(ficlCallback *, char *); 409 410 /* 411 ** the Good Stuff starts here... 412 */ 413 414 /* 415 ** ANS Forth requires false to be zero, and true to be the ones 416 ** complement of false... that unifies logical and bitwise operations 417 ** nicely. 418 */ 419 #define FICL_TRUE (-1) 420 #define FICL_FALSE (0) 421 #define FICL_BOOL(x) ((x) ? FICL_TRUE : FICL_FALSE) 422 423 #if !defined (NULL) 424 #define NULL ((void *)0) 425 #endif 426 427 /* 428 ** These structures represent the result of division. 429 */ 430 typedef struct { 431 ficl2Unsigned quotient; 432 ficlUnsigned remainder; 433 } ficl2UnsignedQR; 434 435 typedef struct { 436 ficl2Integer quotient; 437 ficlInteger remainder; 438 } ficl2IntegerQR; 439 440 /* 441 ** 64 bit integer math support routines: multiply two UNS32s 442 ** to get a 64 bit product, & divide the product by an UNS32 443 ** to get an UNS32 quotient and remainder. Much easier in asm 444 ** on a 32 bit CPU than in C, which usually doesn't support 445 ** the double length result (but it should). 446 */ 447 ficl2IntegerQR ficl2IntegerDivideSymmetric(ficl2Integer, ficlInteger); 448 ficl2UnsignedQR ficl2UnsignedDivide(ficl2Unsigned, ficlUnsigned); 449 450 /* 451 ** A ficlCell is the main storage type. It must be large enough 452 ** to contain a pointer or a scalar. In order to accommodate 453 ** 32 bit and 64 bit processors, use abstract types for int, 454 ** unsigned, and float. 455 ** 456 ** A ficlUnsigned, ficlInteger, and ficlFloat *MUST* be the same 457 ** size as a "void *" on the target system. (Sorry, but that's 458 ** a design constraint of FORTH.) 459 */ 460 461 typedef union { 462 ficlInteger i; 463 ficlUnsigned u; 464 FTH fp; 465 void *p; 466 void (*fn) (void); 467 } ficlCell; 468 469 #define CELL_REF(Obj) ((ficlCell *)(Obj)) 470 #define CELL_FICL_TO_FTH(Obj) ficl_to_fth(CELL_FTH_REF(Obj)) 471 472 #define CELL_INT_REF(Obj) CELL_REF(Obj)->i 473 #define CELL_UINT_REF(Obj) CELL_REF(Obj)->u 474 #define CELL_FTH_REF(Obj) CELL_REF(Obj)->fp 475 #define CELL_VOIDP_REF(Obj) CELL_REF(Obj)->p 476 #define CELL_FN_REF(Obj) CELL_REF(Obj)->fn 477 #define CELL_LONG_REF(Obj) fth_long_long_ref(CELL_FICL_TO_FTH(Obj)) 478 #define CELL_ULONG_REF(Obj) fth_ulong_long_ref(CELL_FICL_TO_FTH(Obj)) 479 #define CELL_FLOAT_REF(Obj) fth_float_ref(CELL_FICL_TO_FTH(Obj)) 480 #define CELL_BOOL_REF(Obj) (FTH_TO_BOOL((CELL_FTH_REF(Obj)))) 481 482 #define CELL_INT_SET(Obj, Val) \ 483 CELL_INT_REF(Obj) = (ficlInteger)(Val) 484 #define CELL_UINT_SET(Obj, Val) \ 485 CELL_UINT_REF(Obj) = (ficlUnsigned)(Val) 486 #define CELL_FTH_SET(Obj, Val) \ 487 CELL_FTH_REF(Obj) = (FTH)(Val) 488 #define CELL_VOIDP_SET(Obj, Val) \ 489 CELL_VOIDP_REF(Obj) = (void *)(Val) 490 #define CELL_FN_SET(Obj, Val) \ 491 CELL_FN_REF(Obj) = (void (*fn)(void))(Val) 492 #define CELL_LONG_SET(Obj, Val) \ 493 CELL_FTH_REF(Obj) = fth_make_llong((ficl2Integer)(Val)) 494 #define CELL_ULONG_SET(Obj, Val) \ 495 CELL_FTH_REF(Obj) = fth_make_ullong((ficl2Unsigned)(Val)) 496 #define CELL_FLOAT_SET(Obj, Val) \ 497 CELL_FTH_REF(Obj) = fth_make_float((ficlFloat)(Val)) 498 #define CELL_BOOL_SET(Obj, Val) \ 499 CELL_FTH_REF(Obj) = BOOL_TO_FTH(Val) 500 501 #define FICL_BITS_PER_CELL (sizeof(ficlCell) * 8) 502 503 /* 504 ** FICL_PLATFORM_ALIGNMENT is the number of bytes to which 505 ** the dictionary pointer address must be aligned. This value 506 ** is usually either 2 or 4, depending on the memory architecture 507 ** of the target system; 4 is safe on any 16 or 32 bit 508 ** machine. 8 would be appropriate for a 64 bit machine. 509 */ 510 #if !defined (FICL_PLATFORM_ALIGNMENT) 511 #define FICL_PLATFORM_ALIGNMENT FTH_ALIGNOF_VOID_P 512 #endif 513 514 /* 515 ** FICL_LVALUE_TO_CELL does a little pointer trickery to cast any CELL sized 516 ** lvalue (informal definition: an expression whose result has an 517 ** address) to CELL. Remember that constants and casts are NOT 518 ** themselves lvalues! 519 */ 520 #define FICL_LVALUE_TO_CELL(v) (*(ficlCell *)&(v)) 521 522 /* 523 ** PTRtoCELL is a cast through void * intended to satisfy the 524 ** most outrageously pedantic compiler... (I won't mention 525 ** its name) 526 */ 527 #define FICL_POINTER_TO_CELL(p) ((ficlCell *)(void *)p) 528 529 /* 530 ** FORTH defines the "counted string" data type. This is 531 ** a "Pascal-style" string, where the first byte is an unsigned 532 ** count of characters, followed by the characters themselves. 533 ** The Ficl structure for this is ficlCountedString. 534 ** Ficl also often zero-terminates them so that they work with the 535 ** usual C runtime library string functions... strlen(), strcmp(), 536 ** and the like. (Belt & suspenders? You decide.) 537 ** 538 ** The problem is, this limits strings to 255 characters, which 539 ** can be a bit constricting to us wordy types. So FORTH only 540 ** uses counted strings for backwards compatibility, and all new 541 ** words are "c-addr u" style, where the address and length are 542 ** stored separately, and the length is a full unsigned "cell" size. 543 ** (For more on this trend, see DPANS94 section A.3.1.3.4.) 544 ** Ficl represents this with the ficlString structure. Note that 545 ** these are frequently *not* zero-terminated! Don't depend on 546 ** it--that way lies madness. 547 */ 548 549 /* 550 * XXX: char text[FICL_COUNTED_STRING_MAX + 1]; 551 */ 552 #define FICL_COUNTED_STRING_MAX (FICL_PAD_SIZE) 553 554 struct ficlCountedString { 555 ficlUnsigned length; 556 char text[FICL_COUNTED_STRING_MAX + 1]; 557 }; 558 559 #define FICL_COUNTED_STRING_GET_LENGTH(cs) ((cs).length) 560 #define FICL_COUNTED_STRING_GET_POINTER(cs) ((cs).text) 561 562 #define FICL_POINTER_TO_COUNTED_STRING(p) ((ficlCountedString *)(void *)(p)) 563 564 struct ficlString { 565 ficlUnsigned length; 566 char *text; 567 }; 568 569 #define FICL_STRING_GET_LENGTH(fs) ((fs).length) 570 #define FICL_STRING_GET_POINTER(fs) ((fs).text) 571 #define FICL_STRING_SET_LENGTH(fs, l) ((fs).length = (ficlUnsigned)(l)) 572 #define FICL_STRING_SET_POINTER(fs, p) ((fs).text = (char *)(p)) 573 #define FICL_STRING_SET_FROM_COUNTED_STRING(string, countedstring) \ 574 { \ 575 (string).text = (countedstring).text; \ 576 (string).length = (countedstring).length; \ 577 } 578 /* 579 ** Init a FICL_STRING from a pointer to a zero-terminated string 580 */ 581 #define FICL_STRING_SET_FROM_CSTRING(string, cstring) \ 582 { \ 583 (string).text = ((char *)(cstring)); \ 584 (string).length = (ficlUnsigned)fth_strlen(cstring); \ 585 } 586 587 /* 588 ** Ficl uses this little structure to hold the address of 589 ** the block of text it's working on and an index to the next 590 ** unconsumed character in the string. Traditionally, this is 591 ** done by a Text Input Buffer, so I've called this struct TIB. 592 ** 593 ** Since this structure also holds the size of the input buffer, 594 ** and since evaluate requires that, let's put the size here. 595 ** The size is stored as an end-pointer because that is what the 596 ** null-terminated string aware functions find most easy to deal 597 ** with. 598 ** Notice, though, that nobody really uses this except evaluate, 599 ** so it might just be moved to ficlVm instead. (sobral) 600 */ 601 typedef struct { 602 ficlInteger index; 603 char *end; 604 char *text; 605 } ficlTIB; 606 607 /* 608 ** Stacks get heavy use in Ficl and Forth... 609 ** Each virtual machine implements two of them: 610 ** one holds parameters (data), and the other holds return 611 ** addresses and control flow information for the virtual 612 ** machine. (Note: C's automatic stack is implicitly used, 613 ** but not modeled because it doesn't need to be...) 614 ** Here's an abstract type for a stack 615 */ 616 617 /* [ms] */ 618 619 typedef struct { 620 ficlUnsigned size; /* size of the stack, in cells */ 621 ficlCell *frame; /* link reg for stack frame */ 622 ficlCell *top; /* stack pointer */ 623 ficlVm *vm; /* used for debugging */ 624 char *name; /* used for debugging */ 625 ficlCell base[1];/* Top of stack */ 626 } ficlStack; 627 628 #define STACK_REF(Obj) ((ficlStack *)(Obj)) 629 #define STACK_TOP_REF(Obj) STACK_REF(Obj)->top 630 #define STACK_FRAME_REF(Obj) STACK_REF(Obj)->frame 631 #define STACK_BASE_REF(Obj) STACK_REF(Obj)->base[1] 632 633 #define STACK_INT_REF(Obj) CELL_INT_REF(STACK_TOP_REF(Obj)) 634 #define STACK_UINT_REF(Obj) CELL_UINT_REF(STACK_TOP_REF(Obj)) 635 #define STACK_FTH_REF(Obj) CELL_FTH_REF(STACK_TOP_REF(Obj)) 636 #define STACK_VOIDP_REF(Obj) CELL_VOIDP_REF(STACK_TOP_REF(Obj)) 637 #define STACK_FN_REF(Obj) CELL_FN_REF(STACK_TOP_REF(Obj)) 638 #define STACK_LONG_REF(Obj) CELL_LONG_REF(STACK_TOP_REF(Obj)) 639 #define STACK_ULONG_REF(Obj) CELL_ULONG_REF(STACK_TOP_REF(Obj)) 640 #define STACK_FLOAT_REF(Obj) CELL_FLOAT_REF(STACK_TOP_REF(Obj)) 641 #define STACK_BOOL_REF(Obj) CELL_BOOL_REF(STACK_TOP_REF(Obj)) 642 643 #define STACK_INT_SET(Obj, Val) CELL_INT_SET(STACK_TOP_REF(Obj), Val) 644 #define STACK_UINT_SET(Obj, Val) CELL_UINT_SET(STACK_TOP_REF(Obj), Val) 645 #define STACK_LONG_SET(Obj, Val) CELL_LONG_SET(STACK_TOP_REF(Obj), Val) 646 #define STACK_ULONG_SET(Obj, Val) CELL_ULONG_SET(STACK_TOP_REF(Obj), Val) 647 #define STACK_FLOAT_SET(Obj, Val) CELL_FLOAT_SET(STACK_TOP_REF(Obj), Val) 648 #define STACK_FTH_SET(Obj, Val) CELL_FTH_SET(STACK_TOP_REF(Obj), Val) 649 #define STACK_VOIDP_SET(Obj, Val) CELL_VOIDP_SET(STACK_TOP_REF(Obj), Val) 650 #define STACK_FN_SET(Obj, Val) CELL_FN_SET(STACK_TOP_REF(Obj), Val) 651 #define STACK_BOOL_SET(Obj, Val) CELL_BOOL_SET(STACK_TOP_REF(Obj), Val) 652 653 #define VM_STACK_INT_REF(Obj) CELL_INT_REF(Obj) 654 #define VM_STACK_UINT_REF(Obj) CELL_UINT_REF(Obj) 655 #define VM_STACK_FTH_REF(Obj) CELL_FTH_REF(Obj) 656 #define VM_STACK_VOIDP_REF(Obj) CELL_VOIDP_REF(Obj) 657 #define VM_STACK_LONG_REF(Obj) CELL_LONG_REF(Obj) 658 #define VM_STACK_ULONG_REF(Obj) CELL_ULONG_REF(Obj) 659 #define VM_STACK_FLOAT_REF(Obj) CELL_FLOAT_REF(Obj) 660 #define VM_STACK_BOOL_REF(Obj) CELL_BOOL_REF(Obj) 661 662 #define VM_STACK_INT_SET(Obj, Val) CELL_INT_SET(Obj, Val) 663 #define VM_STACK_UINT_SET(Obj, Val) CELL_UINT_SET(Obj, Val) 664 #define VM_STACK_FTH_SET(Obj, Val) CELL_FTH_SET(Obj, Val) 665 #define VM_STACK_VOIDP_SET(Obj, Val) CELL_VOIDP_SET(Obj, Val) 666 #define VM_STACK_LONG_SET(Obj, Val) CELL_LONG_SET(Obj, Val) 667 #define VM_STACK_ULONG_SET(Obj, Val) CELL_ULONG_SET(Obj, Val) 668 #define VM_STACK_FLOAT_SET(Obj, Val) CELL_FLOAT_SET(Obj, Val) 669 #define VM_STACK_BOOL_SET(Obj, Val) CELL_BOOL_SET(Obj, Val) 670 671 #define STACK_FTH_INDEX_REF(Stack, Idx) \ 672 CELL_FTH_REF(&STACK_REF(Stack)->top[-Idx]) 673 #define STACK_FTH_INDEX_SET(Stack, Idx, Val) \ 674 CELL_FTH_SET(&STACK_REF(Stack)->top[-Idx], Val) 675 676 /* 677 ** Stack methods... many map closely to required Forth words. 678 */ 679 680 ficlStack *ficlStackCreate(ficlVm *, char *, unsigned); 681 int ficlStackDepth(ficlStack *); 682 void ficlStackDrop(ficlStack *, int); 683 ficlCell ficlStackFetch(ficlStack *, int); 684 ficlCell ficlStackGetTop(ficlStack *); 685 void ficlStackPick(ficlStack *, int); 686 void ficlStackReset(ficlStack *); 687 void ficlStackRoll(ficlStack *, int); 688 void ficlStackSetTop(ficlStack *, ficlCell); 689 void ficlStackStore(ficlStack *, int, ficlCell); 690 void ficlStackLink(ficlStack *, int); 691 void ficlStackUnlink(ficlStack *); 692 void ficlStackCheck(ficlStack *, int, int); 693 ficlCell ficlStackPop(ficlStack *); 694 ficlInteger ficlStackPopInteger(ficlStack *); 695 ficlUnsigned ficlStackPopUnsigned(ficlStack *); 696 ficl2Unsigned ficlStackPop2Unsigned(ficlStack *); 697 ficl2Integer ficlStackPop2Integer(ficlStack *); 698 int ficlStackPopBoolean(ficlStack *); 699 void *ficlStackPopPointer(ficlStack *); 700 FTH ficlStackPopFTH(ficlStack *); 701 ficlFloat ficlStackPopFloat(ficlStack *); 702 703 void ficlStackPush(ficlStack *, ficlCell); 704 void ficlStackPushInteger(ficlStack *, ficlInteger); 705 void ficlStackPushUnsigned(ficlStack *, ficlUnsigned); 706 void ficlStackPush2Integer(ficlStack *, ficl2Integer); 707 void ficlStackPush2Unsigned(ficlStack *, ficl2Unsigned); 708 void ficlStackPushBoolean(ficlStack *, int); 709 void ficlStackPushPointer(ficlStack *, void *); 710 void ficlStackPushFTH(ficlStack *, FTH); 711 void ficlStackPushFloat(ficlStack *, ficlFloat); 712 713 #define FICL_STACK_CHECK(stack, popCells, pushCells) \ 714 ficlStackCheck(stack, popCells, pushCells) 715 716 typedef ficlInteger (*ficlStackWalkFunction)(void *constant, ficlCell *cell); 717 718 void ficlStackWalk(ficlStack *, 719 ficlStackWalkFunction, void *, ficlInteger); 720 void ficlStackDisplay(ficlStack *, ficlStackWalkFunction, void *); 721 722 typedef ficlWord **ficlIp; /* the VM's instruction pointer */ 723 typedef void (*ficlPrimitive)(ficlVm *vm); 724 typedef char *(*ficlInputFunction)(ficlCallback *callback); 725 typedef void (*ficlOutputFunction)(ficlCallback *callback, char *text); 726 727 /* 728 ** Each VM has a placeholder for an output function - 729 ** this makes it possible to have each VM do I/O 730 ** through a different device. If you specify no 731 ** ficlOutputFunction, it defaults to ficlCallbackDefaultTextOut. 732 ** 733 ** You can also set a specific handler just for errors. 734 ** If you don't specify one, it defaults to using textOut. 735 */ 736 struct ficlCallback { 737 void *context; 738 ficlInputFunction textIn; 739 ficlOutputFunction textOut; 740 ficlOutputFunction errorOut; 741 ficlSystem *system; 742 ficlVm *vm; 743 FTH port_in; 744 FTH port_out; 745 FTH port_err; 746 int stdin_fileno; 747 int stdout_fileno; 748 int stderr_fileno; 749 FILE *stdin_ptr; 750 FILE *stdout_ptr; 751 FILE *stderr_ptr; 752 }; 753 754 /* 755 ** Starting with Ficl 4.0, Ficl uses a "switch-threaded" inner loop, 756 ** where each primitive word is represented with a numeric constant, 757 ** and words are (more or less) arrays of these constants. In Ficl 758 ** these constants are an enumerated type called ficlInstruction. 759 */ 760 typedef enum { 761 #define FICL_TOKEN(token, description) token, 762 #define FICL_INSTRUCTION_TOKEN(token, description, flags) token, 763 #include "ficltokens.h" 764 #undef FICL_TOKEN 765 #undef FICL_INSTRUCTION_TOKEN 766 ficlInstructionLast, 767 #if (FTH_SIZEOF_LONG == 4) 768 ficlInstructionFourByteTrick = 0x10000000 769 #else 770 ficlInstructionEightByteTrick = 0x1000000010000000 771 #endif 772 } ficlInstruction; 773 774 /* 775 ** The virtual machine (VM) contains the state for one interpreter. 776 ** Defined operations include: 777 ** Create & initialize 778 ** Delete 779 ** Execute a block of text 780 ** Parse a word out of the input stream 781 ** Call return, and branch 782 ** Text output 783 ** Throw an exception 784 */ 785 786 #define GC_FRAME_SIZE 128 787 788 struct ficlVm { 789 void *context; 790 void *repl; /* [ms] for libtecla's GetLine *gl */ 791 ficlCallback callback; 792 ficlVm *link; /* Ficl keeps a VM list for simple teardown */ 793 jmp_buf *exceptionHandler; /* crude exception 794 * mechanism... */ 795 short restart;/* Set TRUE to restart runningWord */ 796 ficlIp ip; /* instruction pointer */ 797 ficlWord *runningWord; /* address of currently running word 798 * (often just *(ip-1) ) */ 799 ficlUnsigned state; /* compiling or interpreting */ 800 ficlUnsigned base; /* number conversion base */ 801 ficlStack *dataStack; 802 ficlStack *returnStack; /* return stack */ 803 int fth_catch_p; /* are we in fth-catch? [ms] */ 804 int gc_frame_level; /* [ms] gc_push/pop */ 805 ficlCell sourceId; /* -1 if EVALUATE, 0 if normal input, 806 * >0 if a file */ 807 ficlTIB tib; /* address of incoming text string */ 808 ficlCell user[FICL_USER_CELLS]; 809 ficlWord *gc_word[GC_FRAME_SIZE]; /* [ms] gc_push/pop */ 810 void *gc_inst[GC_FRAME_SIZE]; /* [ms] gc_push/pop */ 811 char pad_eval[FICL_PAD_SIZE + 1]; /* second scratch area 812 * (ficlVmEvaluate) */ 813 char pad[FICL_PAD_SIZE + 1]; /* the scratch area 814 * (see above) */ 815 }; 816 817 /* 818 ** Each VM operates in one of two non-error states: interpreting 819 ** or compiling. When interpreting, words are simply executed. 820 ** When compiling, most words in the input stream have their 821 ** addresses inserted into the word under construction. Some words 822 ** (known as IMMEDIATE) are executed in the compile state, too. 823 */ 824 /* values of STATE */ 825 #define FICL_VM_STATE_INTERPRET (0) 826 #define FICL_VM_STATE_COMPILE (1) 827 828 /* 829 ** Exit codes for vmThrow 830 */ 831 #define FICL_VM_STATUS_OFFSET 256 832 #define FICL_VM_STATUS_INNER_EXIT \ 833 (-(FICL_VM_STATUS_OFFSET + 0)) /* tell ficlVmExecuteXT 834 * to exit inner loop */ 835 #define FICL_VM_STATUS_OUT_OF_TEXT \ 836 (-(FICL_VM_STATUS_OFFSET + 1)) /* hungry - normal exit */ 837 #define FICL_VM_STATUS_RESTART \ 838 (-(FICL_VM_STATUS_OFFSET + 2)) /* word needs more text 839 * to succeed -- re-run it */ 840 #define FICL_VM_STATUS_USER_EXIT \ 841 (-(FICL_VM_STATUS_OFFSET + 3)) /* user wants to quit */ 842 #define FICL_VM_STATUS_ERROR_EXIT \ 843 (-(FICL_VM_STATUS_OFFSET + 4)) /* interpreter found 844 * an error */ 845 #define FICL_VM_STATUS_BREAK \ 846 (-(FICL_VM_STATUS_OFFSET + 5)) /* debugger breakpoint */ 847 #define FICL_VM_STATUS_SKIP_FILE \ 848 (-(FICL_VM_STATUS_OFFSET + 6)) /* [ms] skip loading file */ 849 #define FICL_VM_STATUS_LAST_FICL_ERROR \ 850 (-(FICL_VM_STATUS_OFFSET + 7)) 851 #define FICL_VM_STATUS_LAST_FICL \ 852 (-FICL_VM_STATUS_LAST_FICL_ERROR - FICL_VM_STATUS_OFFSET) 853 854 855 /* [ms] Access to the ANS exception strings. */ 856 char *ficl_ans_exc_name(int); 857 char *ficl_ans_exc_msg(int); 858 859 /* [ms] Full list of ANS exceptions. */ 860 #define FICL_VM_STATUS_ABORT (-1) /* like FICL_VM_STATUS_ERROR_EXIT 861 * -- abort */ 862 #define FICL_VM_STATUS_ABORTQ (-2) /* like FICL_VM_STATUS_ERROR_EXIT 863 * -- abort" */ 864 #define FICL_VM_STATUS_STACK_OVERFLOW (-3) /* stack overflow */ 865 #define FICL_VM_STATUS_STACK_UNDERFLOW (-4) /* stack underflow */ 866 #define FICL_VM_STATUS_RSTACK_OVERFLOW (-5) /* return stack overflow */ 867 #define FICL_VM_STATUS_RSTACK_UNDERFLOW (-6) /* return stack underflow */ 868 #define FICL_VM_STATUS_TOO_DEEP (-7) /* do-loops nested too deeply 869 * during execution */ 870 #define FICL_VM_STATUS_DICT_OVERFLOW (-8) /* dictionary overflow */ 871 #define FICL_VM_STATUS_MEMORY_ACCESS (-9) /* invalid memory address */ 872 #define FICL_VM_STATUS_DIVISION_BY_ZERO (-10) /* division by zero */ 873 #define FICL_VM_STATUS_RANGE_ERROR (-11) /* result out of range */ 874 #define FICL_VM_STATUS_ARGUMENT_ERROR (-12) /* argument type mismatch */ 875 #define FICL_VM_STATUS_UNDEFINED (-13) /* undefined word */ 876 #define FICL_VM_STATUS_COMPILE_ONLY (-14) /* interpreting a compile-only 877 * word */ 878 #define FICL_VM_STATUS_INVALID_FORGET (-15) /* invalid FORGET */ 879 #define FICL_VM_STATUS_ZERO_STRING (-16) /* attempt to use zero-length 880 * string as a name */ 881 #define FICL_VM_STATUS_PNO_OVERFLOW (-17) /* pictured numeric output 882 * string overflow */ 883 #define FICL_VM_STATUS_PARSE_OVERFLOW (-18) /* parsed string overflow */ 884 #define FICL_VM_STATUS_NAME_TOO_LONG (-19) /* definition name too long */ 885 #define FICL_VM_STATUS_MEMORY_WRITE_ERROR (-20) /* write to a read-only 886 * location */ 887 #define FICL_VM_STATUS_NOT_IMPLEMENTED (-21) /* unsupported operation */ 888 #define FICL_VM_STATUS_CONTROL_MISMATCH (-22) /* control structure mismatch */ 889 #define FICL_VM_STATUS_ALIGNMENT_ERROR (-23) /* address alignment exception */ 890 #define FICL_VM_STATUS_NUMERIC_ARG_ERROR (-24) /* invalid numeric argument */ 891 #define FICL_VM_STATUS_RSTACK_IMBALANCE (-25) /* return stack imbalance */ 892 #define FICL_VM_STATUS_MISSING_LPARAMETER (-26) /* loop parameters 893 * unavailable */ 894 #define FICL_VM_STATUS_RECURSION_ERROR (-27) /* invalid recursion */ 895 #define FICL_VM_STATUS_INTERRUPT (-28) /* user interrupt */ 896 #define FICL_VM_STATUS_COMPILER_NESTING (-29) /* compiler nesting */ 897 #define FICL_VM_STATUS_OBSOLETE (-30) /* obsolescent feature */ 898 #define FICL_VM_STATUS_TO_BODY_ERROR (-31) /* >BODY used on non-CREATEd 899 * definition */ 900 #define FICL_VM_STATUS_NAME_ARG_ERROR (-32) /* invalid name argument 901 * (e.g., TO xxx) */ 902 #define FICL_VM_STATUS_BREAD_ERROR (-33) /* block read exception */ 903 #define FICL_VM_STATUS_BWRITE_ERROR (-34) /* block write exception */ 904 #define FICL_VM_STATUS_BNUMBER_ERROR (-35) /* invalid block number */ 905 #define FICL_VM_STATUS_FPOSITION_ERROR (-36) /* invalid file position */ 906 #define FICL_VM_STATUS_FILE_IO_ERROR (-37) /* file I/O exception */ 907 #define FICL_VM_STATUS_NO_SUCH_FILE (-38) /* non-existent file */ 908 #define FICL_VM_STATUS_EOF_ERROR (-39) /* unexpected end of file */ 909 #define FICL_VM_STATUS_FBASE_ERROR (-40) /* invalid BASE for 910 * floating point conversion */ 911 #define FICL_VM_STATUS_PRECISION_ERROR (-41) /* loss of precision */ 912 #define FICL_VM_STATUS_FDIVIDE_BY_ZERO (-42) /* floating-point divide 913 * by zero */ 914 #define FICL_VM_STATUS_FRANGE_ERROR (-43) /* floating-point result 915 * out of range */ 916 #define FICL_VM_STATUS_FSTACK_OVERFLOW (-44) /* floating-point stack 917 * overflow */ 918 #define FICL_VM_STATUS_FSTACK_UNDERFLOW (-45) /* floating-point stack underflow */ 919 #define FICL_VM_STATUS_FNUMBER_ERROR (-46) /* floating-point invalid 920 * argument */ 921 #define FICL_VM_STATUS_WORD_LIST_ERROR (-47) /* compilation word list 922 * deleted */ 923 #define FICL_VM_STATUS_POSTPONE_ERROR (-48) /* invalid POSTPONE */ 924 #define FICL_VM_STATUS_SEARCH_OVERFLOW (-49) /* search-order overflow */ 925 #define FICL_VM_STATUS_SEARCH_UNDERFLOW (-50) /* search-order underflow */ 926 #define FICL_VM_STATUS_WORD_LIST_CHANGED (-51) /* compilation word list 927 * changed */ 928 #define FICL_VM_STATUS_CS_OVERFLOW (-52) /* control-flow stack overflow */ 929 #define FICL_VM_STATUS_ES_OVERFLOW (-53) /* exception stack overflow */ 930 #define FICL_VM_STATUS_FP_UNDERFLOW (-54) /* floating-point underflow */ 931 #define FICL_VM_STATUS_FP_ERROR (-55) /* floating-point unidentified 932 * fault */ 933 #define FICL_VM_STATUS_QUIT (-56) /* like FICL_VM_STATUS_ERROR_EXIT, 934 * but leave dataStack & 935 * base alone */ 936 #define FICL_VM_STATUS_CHAR_ERROR (-57) /* exception in sending or 937 * receiving a character */ 938 #define FICL_VM_STATUS_BRANCH_ERROR (-58) /* [IF], [ELSE], or [THEN] 939 * exception */ 940 #define FICL_VM_STATUS_LAST_ERROR (-59) 941 #define FICL_VM_STATUS_LAST_ANS (-FICL_VM_STATUS_LAST_ERROR) 942 943 void ficlVmBranchRelative(ficlVm *, int); 944 ficlVm *ficlVmCreate(ficlVm *, unsigned, unsigned); 945 void ficlVmDestroy(ficlVm *); 946 ficlDictionary *ficlVmGetDictionary(ficlVm *); 947 char *ficlVmGetString(ficlVm *, ficlCountedString *, char); 948 ficlString ficlVmGetWord(ficlVm *); 949 ficlString ficlVmGetWord0(ficlVm *); 950 int ficlVmGetWordToPad(ficlVm *); 951 void ficlVmInnerLoop(ficlVm *, ficlWord *volatile); 952 ficlString ficlVmParseString(ficlVm *, char); 953 ficlString ficlVmParseStringEx(ficlVm *, char, int); 954 ficlCell ficlVmPop(ficlVm *); 955 void ficlVmPush(ficlVm *, ficlCell); 956 void ficlVmPopIP(ficlVm *); 957 void ficlVmPushIP(ficlVm *, ficlIp); 958 void ficlVmQuit(ficlVm *); 959 void ficlVmReset(ficlVm *); 960 void ficlVmSetTextIn(ficlVm *, ficlInputFunction); 961 void ficlVmSetTextOut(ficlVm *, ficlOutputFunction); 962 void ficlVmSetErrorOut(ficlVm *, ficlOutputFunction); 963 void ficlVmThrow(ficlVm *, int); 964 void ficlVmThrowError(ficlVm *, const char *,...); 965 void ficlVmThrowErrorVararg(ficlVm *, int, const char *, va_list); 966 /* [ms]*/ 967 void ficlVmThrowException(ficlVm *, int, const char *,...); 968 969 #define ficlVmGetContext(vm) ((vm)->context) 970 #define ficlVmGetDataStack(vm) ((vm)->dataStack) 971 #define ficlVmGetFloatStack(vm) ((vm)->dataStack) 972 #define ficlVmGetRepl(vm) ((vm)->repl) 973 #define ficlVmGetReturnStack(vm) ((vm)->returnStack) 974 #define ficlVmGetRunningWord(vm) ((vm)->runningWord) 975 976 #define ficlVmGetPortIn(vm) ((vm)->callback.port_in) 977 #define ficlVmGetPortOut(vm) ((vm)->callback.port_out) 978 #define ficlVmGetPortErr(vm) ((vm)->callback.port_err) 979 #define ficlVmGetStdin(vm) ((vm)->callback.stdin_ptr) 980 #define ficlVmGetStdout(vm) ((vm)->callback.stdout_ptr) 981 #define ficlVmGetStderr(vm) ((vm)->callback.stderr_ptr) 982 #define ficlVmGetFilenoIn(vm) ((vm)->callback.stdin_fileno) 983 #define ficlVmGetFilenoOut(vm) ((vm)->callback.stdout_fileno) 984 #define ficlVmGetFilenoErr(vm) ((vm)->callback.stderr_fileno) 985 986 char *ficl_running_word(ficlVm *); 987 void ficlVmDisplayDataStack(ficlVm *); 988 void ficlVmDisplayDataStackSimple(ficlVm *); 989 void ficlVmDisplayReturnStack(ficlVm *); 990 991 /* 992 ** f i c l E v a l u a t e 993 ** Evaluates a block of input text in the context of the 994 ** specified interpreter. Also sets SOURCE-ID properly. 995 ** 996 ** PLEASE USE THIS FUNCTION when throwing a hard-coded 997 ** string to the Ficl interpreter. 998 */ 999 int ficlVmEvaluate(ficlVm *, char *); 1000 1001 /* 1002 ** f i c l V m E x e c * 1003 ** Evaluates a block of input text in the context of the 1004 ** specified interpreter. Emits any requested output to the 1005 ** interpreter's output function. If the input string is NULL 1006 ** terminated, you can pass -1 as nChars rather than count it. 1007 ** Execution returns when the text block has been executed, 1008 ** or an error occurs. 1009 ** Returns one of the FICL_VM_STATUS_... codes defined in ficl.h: 1010 ** FICL_VM_STATUS_OUT_OF_TEXT is the normal exit condition 1011 ** FICL_VM_STATUS_ERROR_EXIT means that the interpreter encountered a 1012 ** syntax error and the vm has been reset to recover (some or all 1013 ** of the text block got ignored 1014 ** FICL_VM_STATUS_USER_EXIT means that the user executed the "bye" command 1015 ** to shut down the interpreter. This would be a good 1016 ** time to delete the vm, etc -- or you can ignore this 1017 ** signal. 1018 ** FICL_VM_STATUS_ABORT and FICL_VM_STATUS_ABORTQ are generated by 1019 ** 'abort' and 'abort"' commands. 1020 ** Preconditions: successful execution of ficlInitSystem, 1021 ** Successful creation and init of the VM by ficlNewVM (or equivalent) 1022 ** 1023 ** If you call ficlExec() or one of its brothers, you MUST 1024 ** ensure vm->sourceId was set to a sensible value. 1025 ** ficlExec() explicitly DOES NOT manage SOURCE-ID for you. 1026 */ 1027 int ficlVmExecuteString(ficlVm *, ficlString); 1028 int ficlVmExecuteXT(ficlVm *, ficlWord *); 1029 void ficlVmExecuteInstruction(ficlVm *, ficlInstruction); 1030 #if 1 1031 #define ficlVmExecuteWord(vm, word) ficlVmInnerLoop(vm, word) 1032 #else 1033 void ficlVmExecuteWord(ficlVm *, ficlWord *); 1034 #endif 1035 void ficlVmDictionaryAllot(ficlDictionary *, int); 1036 void ficlVmDictionaryAllotCells(ficlDictionary *, int); 1037 int ficlVmParseWord(ficlVm *, ficlString); 1038 1039 /* 1040 ** TIB access routines... 1041 ** ANS forth seems to require the input buffer to be represented 1042 ** as a pointer to the start of the buffer, and an index to the 1043 ** next character to read. 1044 ** PushTib points the VM to a new input string and optionally 1045 ** returns a copy of the current state 1046 ** PopTib restores the TIB state given a saved TIB from PushTib 1047 ** GetInBuf returns a pointer to the next unused char of the TIB 1048 */ 1049 void ficlVmPushTib(ficlVm *, char *, ficlInteger, ficlTIB *); 1050 void ficlVmPopTib(ficlVm *, ficlTIB *); 1051 1052 #define ficlVmGetInBuf(vm) ((vm)->tib.text + (vm)->tib.index) 1053 #define ficlVmGetInBufLen(vm) ((vm)->tib.end - (vm)->tib.text) 1054 #define ficlVmGetInBufEnd(vm) ((vm)->tib.end) 1055 #define ficlVmGetTibIndex(vm) ((vm)->tib.index) 1056 #define ficlVmSetTibIndex(vm, i) ((vm)->tib.index = i) 1057 #define ficlVmUpdateTib(vm, str) ((vm)->tib.index = (str) - (vm)->tib.text) 1058 1059 void ficlVmDictionaryCheck(ficlDictionary *, int); 1060 void ficlVmDictionarySimpleCheck(ficlDictionary *, int); 1061 void ficlPrimitiveLiteralIm(ficlVm *); 1062 1063 /* 1064 ** A FICL_CODE points to a function that gets called to help execute 1065 ** a word in the dictionary. It always gets passed a pointer to the 1066 ** running virtual machine, and from there it can get the address 1067 ** of the parameter area of the word it's supposed to operate on. 1068 ** For precompiled words, the code is all there is. For user defined 1069 ** words, the code assumes that the word's parameter area is a list 1070 ** of pointers to the code fields of other words to execute, and 1071 ** may also contain inline data. The first parameter is always 1072 ** a pointer to a code field. 1073 */ 1074 1075 /* 1076 ** Ficl models memory as a contiguous space divided into 1077 ** words in a linked list called the dictionary. 1078 ** A ficlWord starts each entry in the list. 1079 ** Version 1.02: space for the name characters is allotted from 1080 ** the dictionary ahead of the word struct, rather than using 1081 ** a fixed size array for each name. 1082 */ 1083 1084 struct ficlWord { 1085 struct ficlWord *link; /* Previous word in the dictionary */ 1086 struct ficlWord *current_word; /* word where ficlWord is used [ms] */ 1087 ficlPrimitive code; /* Native code to execute the word */ 1088 ficlInstruction semiParen; /* native code to execute the word */ 1089 char *name; /* First nFICLNAME chars of word name */ 1090 void (*vfunc) (); /* void function to use [ms] */ 1091 FTH (*func) (); /* function to use [ms] */ 1092 FTH properties; /* property-hash [ms] */ 1093 FTH current_file; /* file where ficlWord is used [ms] */ 1094 FTH file; /* origin file of word [ms] */ 1095 int primitive_p; /* C-primitive or not [ms] */ 1096 int req; /* required args [ms] */ 1097 int opt; /* optional args [ms] */ 1098 int rest; /* 1 if rest args, 0 otherwise [ms] */ 1099 int argc; /* number of all args [ms] */ 1100 int kind; /* word, proc, symbol, keyword, exception 1101 * [ms] */ 1102 ficlInteger current_line; /* line where ficlWord is used [ms] */ 1103 ficlInteger line; /* line in source [ms] */ 1104 ficlUnsigned flags; /* Immediate, Smudge, Compile-only, IsOjbect, 1105 * Instruction */ 1106 ficlUnsigned length; /* Number of chars in word name */ 1107 ficlUnsigned hash; 1108 ficlCell param[1]; /* First data cell of the word */ 1109 }; 1110 1111 /* 1112 ** ficlWord.flag bitfield values: 1113 */ 1114 1115 /* 1116 ** FICL_WORD_IMMEDIATE: 1117 ** This word is always executed immediately when 1118 ** encountered, even when compiling. 1119 */ 1120 #define FICL_WORD_IMMEDIATE (1UL) 1121 1122 /* 1123 ** FICL_WORD_COMPILE_ONLY: 1124 ** This word is only valid during compilation. 1125 ** Ficl will throw a runtime error if this word executed 1126 ** while not compiling. 1127 */ 1128 #define FICL_WORD_COMPILE_ONLY (2UL) 1129 1130 /* 1131 ** FICL_WORD_SMUDGED 1132 ** This word's definition is in progress. 1133 ** The word is hidden from dictionary lookups 1134 ** until it is "un-smudged". 1135 */ 1136 #define FICL_WORD_SMUDGED (4UL) 1137 1138 /* 1139 ** FICL_WORD_OBJECT 1140 ** This word is an object or object member variable. 1141 ** (Currently only used by "my=[".) 1142 */ 1143 #define FICL_WORD_OBJECT (8UL) 1144 1145 /* 1146 ** FICL_WORD_INSTRUCTION 1147 ** This word represents a ficlInstruction, not a normal word. 1148 ** param[0] is the instruction. 1149 ** When compiled, Ficl will simply copy over the instruction, 1150 ** rather than executing the word as normal. 1151 ** 1152 ** (Do *not* use this flag for words that need their PFA pushed 1153 ** before executing!) 1154 */ 1155 #define FICL_WORD_INSTRUCTION (16UL) 1156 1157 /* 1158 ** FICL_WORD_COMPILE_ONLY_IMMEDIATE 1159 ** Most words that are "immediate" are also 1160 ** "compile-only". 1161 */ 1162 #define FICL_WORD_COMPILE_ONLY_IMMEDIATE \ 1163 (FICL_WORD_IMMEDIATE | FICL_WORD_COMPILE_ONLY) 1164 #define FICL_WORD_DEFAULT (0UL) 1165 1166 /* 1167 ** Worst-case size of a word header: FICL_NAME_LENGTH chars in name 1168 */ 1169 #define FICL_CELLS_PER_WORD \ 1170 ((sizeof(ficlWord) + FICL_NAME_LENGTH + sizeof(ficlCell)) / \ 1171 (sizeof(ficlCell))) 1172 1173 int ficlWordIsImmediate(ficlWord *); 1174 int ficlWordIsCompileOnly(ficlWord *); 1175 1176 void ficlCallbackAssert(int expression, char *expr, char *file, int line); 1177 /* 1178 * XXX: FICL_ASSERT() 1179 */ 1180 #if 0 1181 #define FICL_ASSERT(Expr) \ ficlCallbackAssert(((int)(Expr)), #Expr, __FILE__, __LINE__) 1182 #else 1183 #define FICL_ASSERT(Expr) /* empty */ 1184 #endif 1185 1186 /* 1187 ** Generally useful string manipulators omitted by ANSI C... 1188 ** ltoa complements strtol 1189 */ 1190 1191 int ficlIsPowerOfTwo(ficlUnsigned); 1192 char *ficlLtoa(ficlInteger, char *, int); 1193 char *ficlUltoa(ficlUnsigned, char *, int); 1194 char ficlDigitToCharacter(int); 1195 char *ficlStringReverse(char *); 1196 char *ficlStringSkipSpace(char *, char *); 1197 char *ficlStringCaseFold(char *); 1198 void *ficlAlignPointer(void *); 1199 int intern_ficlStrincmp(char *, char *, ficlUnsigned); 1200 1201 #if defined(HAVE_STRNCASECMP) 1202 #if defined(HAVE_STRINGS_H) 1203 #include <strings.h> 1204 #endif 1205 #define ficlStrincmp(s1, s2, len) strncasecmp(s1, s2, len) 1206 #else 1207 #define ficlStrincmp(s1, s2, len) intern_ficlStrincmp(s1, s2, len) 1208 #endif 1209 1210 /* 1211 ** Ficl hash table - variable size. 1212 ** assert(size > 0) 1213 ** If size is 1, the table degenerates into a linked list. 1214 ** A WORDLIST (see the search order word set in DPANS) is 1215 ** just a pointer to a FICL_HASH in this implementation. 1216 */ 1217 typedef struct ficlHash { 1218 struct ficlHash *link; /* link to parent class wordlist for OO */ 1219 char *name; /* optional pointer to \0 terminated wordlist 1220 * name */ 1221 unsigned size; /* number of buckets in the hash */ 1222 ficlWord *table[1]; 1223 } ficlHash; 1224 1225 void ficlHashForget(ficlHash *, void *); 1226 ficlUnsigned ficlHashCode(ficlString); 1227 void ficlHashInsertWord(ficlHash *, ficlWord *); 1228 ficlWord *ficlHashLookup(ficlHash *, ficlString, ficlUnsigned); 1229 void ficlHashReset(ficlHash *); 1230 1231 /* 1232 ** A Dictionary is a linked list of FICL_WORDs. It is also Ficl's 1233 ** memory model. Description of fields: 1234 ** 1235 ** here -- points to the next free byte in the dictionary. This 1236 ** pointer is forced to be CELL-aligned before a definition is added. 1237 ** Do not assume any specific alignment otherwise - Use dictAlign(). 1238 ** 1239 ** smudge -- pointer to word currently being defined (or last defined word) 1240 ** If the definition completes successfully, the word will be 1241 ** linked into the hash table. If unsuccessful, dictUnsmudge 1242 ** uses this pointer to restore the previous state of the dictionary. 1243 ** Smudge prevents unintentional recursion as a side-effect: the 1244 ** dictionary search algo examines only completed definitions, so a 1245 ** word cannot invoke itself by name. See the Ficl word "recurse". 1246 ** NOTE: smudge always points to the last word defined. IMMEDIATE 1247 ** makes use of this fact. Smudge is initially NULL. 1248 ** 1249 ** forthWordlist -- pointer to the default wordlist (FICL_HASH). 1250 ** This is the initial compilation list, and contains all 1251 ** Ficl's precompiled words. 1252 ** 1253 ** compilationWordlist -- compilation wordlist - 1254 ** initially equal to forthWordlist 1255 ** wordlists -- array of pointers to wordlists. Managed as a stack. 1256 ** Highest index is the first list in the search order. 1257 ** wordlistCount -- number of lists in wordlists. 1258 ** wordlistCount-1 is the highest 1259 ** filled slot in wordlists, and points to the first wordlist 1260 ** in the search order 1261 ** size -- number of cells in the dictionary (total) 1262 ** base -- start of data area. Must be at the end of the struct. 1263 */ 1264 struct ficlDictionary { 1265 ficlCell *here; 1266 void *context;/* for your use, particularly with 1267 * ficlDictionaryLock() */ 1268 ficlWord *smudge; 1269 ficlHash *forthWordlist; 1270 ficlHash *compilationWordlist; 1271 ficlHash *wordlists[FICL_MAX_WORDLISTS]; 1272 ficlInteger wordlistCount; 1273 ficlUnsigned size; /* Number of cells in dictionary (total) */ 1274 ficlSystem *system; /* used for debugging */ 1275 ficlCell base[1]; /* Base of dictionary memory */ 1276 }; 1277 1278 void ficlDictionaryAbortDefinition(ficlDictionary *); 1279 void ficlDictionaryAlign(ficlDictionary *); 1280 void ficlDictionaryAllot(ficlDictionary *, int); 1281 void ficlDictionaryAllotCells(ficlDictionary *, int); 1282 void ficlDictionaryAppendCell(ficlDictionary *, ficlCell); 1283 void ficlDictionaryAppendPointer(ficlDictionary *, void *); 1284 void ficlDictionaryAppendInteger(ficlDictionary *, ficlInteger); 1285 void ficlDictionaryAppendFTH(ficlDictionary *, FTH); 1286 void ficlDictionaryAppendCharacter(ficlDictionary *, char); 1287 void ficlDictionaryAppendUnsigned(ficlDictionary *, ficlUnsigned); 1288 void *ficlDictionaryAppendData(ficlDictionary *, void *, ficlInteger); 1289 char *ficlDictionaryAppendString(ficlDictionary *, ficlString); 1290 ficlWord *ficlDictionaryAppendWord(ficlDictionary *, 1291 ficlString, ficlPrimitive, ficlUnsigned); 1292 ficlWord *ficlDictionaryAppendPrimitive(ficlDictionary *, char *, 1293 ficlPrimitive, ficlUnsigned); 1294 ficlWord *ficlDictionaryAppendInstruction(ficlDictionary *, char *, 1295 ficlInstruction, ficlUnsigned); 1296 ficlWord *ficlDictionaryAppendConstantInstruction(ficlDictionary *, 1297 ficlString, ficlInstruction, ficlInteger); 1298 ficlWord *ficlDictionaryAppendConstant(ficlDictionary *, char *, 1299 ficlInteger); 1300 ficlWord *ficlDictionaryAppendPointerConstant(ficlDictionary *, 1301 char *, void *); 1302 ficlWord *ficlDictionaryAppendFTHConstant(ficlDictionary *, char *, FTH); 1303 ficlWord *ficlDictionarySetConstantInstruction(ficlDictionary *, 1304 ficlString, ficlInstruction, ficlInteger); 1305 ficlWord *ficlDictionarySetConstant(ficlDictionary *, 1306 char *, ficlInteger); 1307 ficlWord *ficlDictionaryAppendFTHConstantInstruction(ficlDictionary *, 1308 ficlString, ficlInstruction, FTH); 1309 ficlWord *ficlDictionarySetFTHConstantInstruction(ficlDictionary *, 1310 ficlString, ficlInstruction, FTH); 1311 ficlWord *ficlDictionarySetFTHConstant(ficlDictionary *, char *, FTH); 1312 ficlWord *ficlDictionarySetPrimitive(ficlDictionary *, char *, 1313 ficlPrimitive, ficlUnsigned); 1314 ficlWord *ficlDictionarySetInstruction(ficlDictionary *, char *, 1315 ficlInstruction, ficlUnsigned); 1316 int ficlDictionaryCellsAvailable(ficlDictionary *); 1317 int ficlDictionaryCellsUsed(ficlDictionary *); 1318 ficlDictionary *ficlDictionaryCreate(ficlSystem *, unsigned); 1319 ficlDictionary *ficlDictionaryCreateHashed(ficlSystem *, unsigned, unsigned); 1320 ficlHash *ficlDictionaryCreateWordlist(ficlDictionary *, int); 1321 void ficlDictionaryDestroy(ficlDictionary *); 1322 void ficlDictionaryEmpty(ficlDictionary *, unsigned); 1323 int ficlDictionaryIncludes(ficlDictionary *, void *); 1324 ficlWord *ficlDictionaryLookup(ficlDictionary *, ficlString); 1325 void ficlDictionaryResetSearchOrder(ficlDictionary *); 1326 void ficlDictionarySetFlags(ficlDictionary *, ficlUnsigned); 1327 void ficlDictionaryClearFlags(ficlDictionary *, ficlUnsigned); 1328 void ficlDictionarySetImmediate(ficlDictionary *); 1329 void ficlDictionaryUnsmudge(ficlDictionary *); 1330 ficlCell *ficlDictionaryWhere(ficlDictionary *); 1331 1332 int ficlDictionaryIsAWord(ficlDictionary *, ficlWord *); 1333 void ficlDictionarySee(ficlDictionary *, ficlWord *); 1334 ficlWord *ficlDictionaryFindEnclosingWord(ficlDictionary *, ficlCell *); 1335 1336 /* 1337 ** P A R S E S T E P 1338 ** (New for 2.05) 1339 ** See words.c: interpWord 1340 ** By default, Ficl goes through two attempts to parse each token from its input 1341 ** stream: it first attempts to match it with a word in the dictionary, and 1342 ** if that fails, it attempts to convert it into a number. This mechanism is now 1343 ** extensible by additional steps. This allows extensions like floating point 1344 ** and double number support to be factored cleanly. 1345 ** 1346 ** Each parse step is a function that receives the next input token as a 1347 ** STRINGINFO. If the parse step matches the token, it must apply semantics 1348 ** to the token appropriate to the present value of VM.state 1349 ** (compiling or interpreting), and return FICL_TRUE. 1350 ** Otherwise it returns FICL_FALSE. See words.c: isNumber for an example 1351 ** 1352 ** Note: for the sake of efficiency, it's a good idea both to limit the number 1353 ** of parse steps and to code each parse step so that it rejects tokens that 1354 ** do not match as quickly as possible. 1355 */ 1356 typedef int (*ficlParseStep)(ficlVm *vm, ficlString s); 1357 1358 /* 1359 ** FICL_BREAKPOINT record. 1360 ** oldXT - if NULL, this breakpoint is unused. Otherwise it stores the xt 1361 ** that the breakpoint overwrote. This is restored to the dictionary when the 1362 ** BP executes or gets cleared 1363 ** address - the location of the breakpoint (address of the instruction that 1364 ** has been replaced with the breakpoint trap 1365 ** oldXT - The original contents of the location with the breakpoint 1366 ** Note: address is NULL when this breakpoint is empty 1367 */ 1368 typedef struct { 1369 void *address; 1370 ficlWord *oldXT; 1371 } ficlBreakpoint; 1372 1373 /* 1374 ** F I C L _ S Y S T E M 1375 ** The top level data structure of the system - ficl_system ties a list of 1376 ** virtual machines with their corresponding dictionaries. Ficl 3.0 added 1377 ** support for multiple Ficl systems, allowing multiple concurrent sessions 1378 ** to separate dictionaries with some constraints. 1379 ** Note: the context pointer is there to provide context for applications. 1380 ** It is copied to each VM's context field as that VM is created. 1381 */ 1382 struct ficlSystemInformation { 1383 int size; /* structure size tag for versioning */ 1384 void *context;/* Initializes VM's context pointer - for 1385 * application use */ 1386 unsigned int dictionarySize; /* Size of system's Dictionary, in 1387 * cells */ 1388 unsigned int environmentSize; /* Size of Environment 1389 * dictionary, in cells */ 1390 unsigned int stackSize; /* Size of all stacks created, in 1391 * cells */ 1392 unsigned int returnSize; /* [ms] */ 1393 unsigned int localsSize; /* [ms] */ 1394 ficlInputFunction textIn; /* default textIn function [ms] */ 1395 ficlOutputFunction textOut; /* default textOut function */ 1396 ficlOutputFunction errorOut; /* textOut function used for errors */ 1397 FTH port_in; /* rest added by [ms] */ 1398 FTH port_out; 1399 FTH port_err; 1400 int stdin_fileno; 1401 int stdout_fileno; 1402 int stderr_fileno; 1403 FILE *stdin_ptr; 1404 FILE *stdout_ptr; 1405 FILE *stderr_ptr; 1406 }; 1407 1408 #define ficlSystemInformationInitialize(x) \ 1409 { \ 1410 memset((x), 0, sizeof(ficlSystemInformation)); \ 1411 (x)->size = (int)sizeof(ficlSystemInformation); \ 1412 } 1413 1414 struct ficlSystem { 1415 void *context; 1416 ficlCallback callback; 1417 ficlSystem *link; 1418 ficlVm *vmList; 1419 ficlDictionary *dictionary; 1420 ficlDictionary *environment; 1421 ficlDictionary *symbols;/* [ms] */ 1422 ficlWord *interpreterLoop[3]; 1423 ficlWord *parseList[FICL_MAX_PARSE_STEPS]; 1424 ficlWord *exitInnerWord; 1425 ficlWord *interpretWord; 1426 ficlDictionary *locals; 1427 ficlInteger localsCount; 1428 ficlCell *localsFixup; 1429 unsigned stackSize; 1430 unsigned returnSize; /* [ms] */ 1431 ficlBreakpoint breakpoint; 1432 }; 1433 1434 #define ficlSystemGetContext(system) ((system)->context) 1435 1436 /* 1437 ** External interface to Ficl... 1438 */ 1439 /* 1440 ** f i c l S y s t e m C r e a t e 1441 ** Binds a global dictionary to the interpreter system and initializes 1442 ** the dictionary to contain the ANSI CORE wordset. 1443 ** You can specify the address and size of the allocated area. 1444 ** You can also specify the text output function at creation time. 1445 ** After that, Ficl manages it. 1446 ** First step is to set up the static pointers to the area. 1447 ** Then write the "precompiled" portion of the dictionary in. 1448 ** The dictionary needs to be at least large enough to hold the 1449 ** precompiled part. Try 1K cells minimum. Use "words" to find 1450 ** out how much of the dictionary is used at any time. 1451 */ 1452 ficlSystem *ficlSystemCreate(ficlSystemInformation *); 1453 1454 /* 1455 ** f i c l S y s t e m D e s t r o y 1456 ** Deletes the system dictionary and all virtual machines that 1457 ** were created with ficlNewVM (see below). Call this function to 1458 ** reclaim all memory used by the dictionary and VMs. 1459 */ 1460 void ficlSystemDestroy(ficlSystem *); 1461 1462 /* 1463 ** Create a new VM from the heap, and link it into the system VM list. 1464 ** Initializes the VM and binds default sized stacks to it. Returns the 1465 ** address of the VM, or NULL if an error occurs. 1466 ** Precondition: successful execution of ficlInitSystem 1467 */ 1468 ficlVm *ficlSystemCreateVm(ficlSystem *); 1469 1470 /* 1471 ** Force deletion of a VM. You do not need to do this 1472 ** unless you're creating and discarding a lot of VMs. 1473 ** For systems that use a constant pool of VMs for the life 1474 ** of the system, ficltermSystem takes care of VM cleanup 1475 ** automatically. 1476 */ 1477 void ficlSystemDestroyVm(ficlVm *); 1478 1479 /* 1480 ** Returns the address of the most recently defined word in the system 1481 ** dictionary with the given name, or NULL if no match. 1482 ** Precondition: successful execution of ficlInitSystem 1483 */ 1484 ficlWord *ficlSystemLookup(ficlSystem *, char *); 1485 1486 /* 1487 ** f i c l G e t D i c t 1488 ** Utility function - returns the address of the system dictionary. 1489 ** Precondition: successful execution of ficlInitSystem 1490 */ 1491 ficlDictionary *ficlSystemGetDictionary(ficlSystem *); 1492 ficlDictionary *ficlSystemGetEnvironment(ficlSystem *); 1493 ficlDictionary *ficlSystemGetLocals(ficlSystem *); 1494 ficlDictionary *ficlSystemGetSymbols(ficlSystem *); /* [ms] */ 1495 1496 /* 1497 ** f i c l C o m p i l e C o r e 1498 ** Builds the ANS CORE wordset into the dictionary - called by 1499 ** ficlInitSystem - no need to waste dictionary space by doing it again. 1500 */ 1501 void ficlSystemCompileCore(ficlSystem *); 1502 void ficlSystemCompilePrefix(ficlSystem *); 1503 void ficlSystemCompileSearch(ficlSystem *); 1504 void ficlSystemCompileSoftCore(ficlSystem *); 1505 void ficlSystemCompileTools(ficlSystem *); 1506 void ficlSystemCompileFile(ficlSystem *); 1507 int ficlVmParseFloatNumber(ficlVm *, ficlString); 1508 void ficlSystemCompilePlatform(ficlSystem *); 1509 void ficlSystemCompileExtras(ficlSystem *); 1510 1511 int ficlVmParsePrefix(ficlVm *, ficlString); 1512 ficlWord *ficlSystemLookupLocal(ficlSystem *, ficlString); 1513 1514 /* 1515 ** from words.c... 1516 */ 1517 int ficlVmParseNumber(ficlVm *, ficlString); 1518 void ficlPrimitiveTick(ficlVm *); 1519 void ficlPrimitiveParseStepParen(ficlVm *); 1520 1521 /* 1522 ** Appends a parse step function to the end of the parse list (see 1523 ** FICL_PARSE_STEP notes in ficl.h for details). Returns 0 if successful, 1524 ** nonzero if there's no more room in the list. Each parse step is a word in 1525 ** the dictionary. Precompiled parse steps can use (PARSE-STEP) as their 1526 ** CFA - see parenParseStep in words.c. 1527 */ 1528 int ficlSystemAddParseStep(ficlSystem *, ficlWord *); /* ficl.c */ 1529 void ficlSystemAddPrimitiveParseStep(ficlSystem *, 1530 char *, ficlParseStep); 1531 1532 /* 1533 ** From tools.c 1534 */ 1535 1536 /* 1537 ** The following supports SEE and the debugger. 1538 */ 1539 typedef enum { 1540 FICL_WORDKIND_BRANCH, 1541 FICL_WORDKIND_BRANCH0, 1542 FICL_WORDKIND_COLON, 1543 FICL_WORDKIND_CONSTANT, 1544 FICL_WORDKIND_2CONSTANT, 1545 FICL_WORDKIND_CREATE, 1546 FICL_WORDKIND_DO, 1547 FICL_WORDKIND_DOES, 1548 FICL_WORDKIND_LITERAL, 1549 FICL_WORDKIND_2LITERAL, 1550 FICL_WORDKIND_LOOP, 1551 FICL_WORDKIND_OF, 1552 FICL_WORDKIND_PLOOP, 1553 FICL_WORDKIND_PRIMITIVE, 1554 FICL_WORDKIND_QDO, 1555 FICL_WORDKIND_STRING_LITERAL, 1556 FICL_WORDKIND_CSTRING_LITERAL, 1557 FICL_WORDKIND_USER, 1558 FICL_WORDKIND_VARIABLE, 1559 FICL_WORDKIND_INSTRUCTION, 1560 FICL_WORDKIND_INSTRUCTION_WORD, 1561 FICL_WORDKIND_INSTRUCTION_WITH_ARGUMENT 1562 } ficlWordKind; 1563 1564 ficlWordKind ficlWordClassify(ficlWord *); 1565 1566 /* 1567 ** Used with File-Access wordset. 1568 */ 1569 #define FICL_FAM_READ 1 1570 #define FICL_FAM_WRITE 2 1571 #define FICL_FAM_APPEND 4 1572 #define FICL_FAM_BINARY 8 1573 1574 #define FICL_FAM_OPEN_MODE(fam) \ 1575 ((fam) & (FICL_FAM_READ | FICL_FAM_WRITE | FICL_FAM_APPEND)) 1576 1577 #define FICL_MAXPATHLEN 1024 1578 1579 typedef struct { 1580 FILE *f; 1581 char filename[FICL_MAXPATHLEN]; 1582 } ficlFile; 1583 1584 int ficlFileTruncate(ficlFile *, ficlUnsigned); 1585 int ficlFileStatus(char *, int *); 1586 ficl2Integer ficlFileSize(ficlFile *); 1587 1588 #define FICL_MIN(a, b) (((a) < (b)) ? (a) : (b)) 1589 #define FICL_MAX(a, b) (((a) > (b)) ? (a) : (b)) 1590 1591 __END_DECLS 1592 1593 #endif /* __FICL_H__ */ 1594