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.18 2001/12/05 07:21:34 jsadler 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#if !defined (__FICL_H__) 46#define __FICL_H__ 47/* 48** Ficl (Forth-inspired command language) is an ANS Forth 49** interpreter written in C. Unlike traditional Forths, this 50** interpreter is designed to be embedded into other systems 51** as a command/macro/development prototype language. 52** 53** Where Forths usually view themselves as the center of the system 54** and expect the rest of the system to be coded in Forth, Ficl 55** acts as a component of the system. It is easy to export 56** code written in C or ASM to Ficl in the style of TCL, or to invoke 57** Ficl code from a compiled module. This allows you to do incremental 58** development in a way that combines the best features of threaded 59** languages (rapid development, quick code/test/debug cycle, 60** reasonably fast) with the best features of C (everyone knows it, 61** easier to support large blocks of code, efficient, type checking). 62** 63** Ficl provides facilities for interoperating 64** with programs written in C: C functions can be exported to Ficl, 65** and Ficl commands can be executed via a C calling interface. The 66** interpreter is re-entrant, so it can be used in multiple instances 67** in a multitasking system. Unlike Forth, Ficl's outer interpreter 68** expects a text block as input, and returns to the caller after each 69** text block, so the "data pump" is somewhere in external code. This 70** is more like TCL than Forth, which usually expcets to be at the center 71** of the system, requesting input at its convenience. Each Ficl virtual 72** machine can be bound to a different I/O channel, and is independent 73** of all others in in the same address space except that all virtual 74** machines share a common dictionary (a sort or open symbol table that 75** defines all of the elements of the language). 76** 77** Code is written in ANSI C for portability. 78** 79** Summary of Ficl features and constraints: 80** - Standard: Implements the ANSI Forth CORE word set and part 81** of the CORE EXT word-set, SEARCH and SEARCH EXT, TOOLS and 82** TOOLS EXT, LOCAL and LOCAL ext and various extras. 83** - Extensible: you can export code written in Forth, C, 84** or asm in a straightforward way. Ficl provides open 85** facilities for extending the language in an application 86** specific way. You can even add new control structures! 87** - Ficl and C can interact in two ways: Ficl can encapsulate 88** C code, or C code can invoke Ficl code. 89** - Thread-safe, re-entrant: The shared system dictionary 90** uses a locking mechanism that you can either supply 91** or stub out to provide exclusive access. Each Ficl 92** virtual machine has an otherwise complete state, and 93** each can be bound to a separate I/O channel (or none at all). 94** - Simple encapsulation into existing systems: a basic implementation 95** requires three function calls (see the example program in testmain.c). 96** - ROMable: Ficl is designed to work in RAM-based and ROM code / RAM data 97** environments. It does require somewhat more memory than a pure 98** ROM implementation because it builds its system dictionary in 99** RAM at startup time. 100** - Written an ANSI C to be as simple as I can make it to understand, 101** support, debug, and port. Compiles without complaint at /Az /W4 102** (require ANSI C, max warnings) under Microsoft VC++ 5. 103** - Does full 32 bit math (but you need to implement 104** two mixed precision math primitives (see sysdep.c)) 105** - Indirect threaded interpreter is not the fastest kind of 106** Forth there is (see pForth 68K for a really fast subroutine 107** threaded interpreter), but it's the cleanest match to a 108** pure C implementation. 109** 110** P O R T I N G F i c l 111** 112** To install Ficl on your target system, you need an ANSI C compiler 113** and its runtime library. Inspect the system dependent macros and 114** functions in sysdep.h and sysdep.c and edit them to suit your 115** system. For example, INT16 is a short on some compilers and an 116** int on others. Check the default CELL alignment controlled by 117** FICL_ALIGN. If necessary, add new definitions of ficlMalloc, ficlFree, 118** ficlLockDictionary, and ficlTextOut to work with your operating system. 119** Finally, use testmain.c as a guide to installing the Ficl system and 120** one or more virtual machines into your code. You do not need to include 121** testmain.c in your build. 122** 123** T o D o L i s t 124** 125** 1. Unimplemented system dependent CORE word: key 126** 2. Ficl uses the PAD in some CORE words - this violates the standard, 127** but it's cleaner for a multithreaded system. I'll have to make a 128** second pad for reference by the word PAD to fix this. 129** 130** F o r M o r e I n f o r m a t i o n 131** 132** Web home of ficl 133** http://ficl.sourceforge.net 134** Check this website for Forth literature (including the ANSI standard) 135** http://www.taygeta.com/forthlit.html 136** and here for software and more links 137** http://www.taygeta.com/forth.html 138** 139** Obvious Performance enhancement opportunities 140** Compile speed 141** - work on interpret speed 142** - turn off locals (FICL_WANT_LOCALS) 143** Interpret speed 144** - Change inner interpreter (and everything else) 145** so that a definition is a list of pointers to functions 146** and inline data rather than pointers to words. This gets 147** rid of vm->runningWord and a level of indirection in the 148** inner loop. I'll look at it for ficl 3.0 149** - Make the main hash table a bigger prime (HASHSIZE) 150** - FORGET about twiddling the hash function - my experience is 151** that that is a waste of time. 152** - Eliminate the need to pass the pVM parameter on the stack 153** by dedicating a register to it. Most words need access to the 154** vm, but the parameter passing overhead can be reduced. One way 155** requires that the host OS have a task switch callout. Create 156** a global variable for the running VM and refer to it in words 157** that need VM access. Alternative: use thread local storage. 158** For single threaded implementations, you can just use a global. 159** The first two solutions create portability problems, so I 160** haven't considered doing them. Another possibility is to 161** declare the pVm parameter to be "register", and hope the compiler 162** pays attention. 163** 164*/ 165 166/* 167** Revision History: 168** 169** 15 Apr 1999 (sadler) Merged FreeBSD changes for exception wordset and 170** counted strings in ficlExec. 171** 12 Jan 1999 (sobral) Corrected EVALUATE behavior. Now TIB has an 172** "end" field, and all words respect this. ficlExec is passed a "size" 173** of TIB, as well as vmPushTib. This size is used to calculate the "end" 174** of the string, ie, base+size. If the size is not known, pass -1. 175** 176** 10 Jan 1999 (sobral) EXCEPTION word set has been added, and existing 177** words has been modified to conform to EXCEPTION EXT word set. 178** 179** 27 Aug 1998 (sadler) testing and corrections for LOCALS, LOCALS EXT, 180** SEARCH / SEARCH EXT, TOOLS / TOOLS EXT. 181** Added .X to display in hex, PARSE and PARSE-WORD to supplement WORD, 182** EMPTY to clear stack. 183** 184** 29 jun 1998 (sadler) added variable sized hash table support 185** and ANS Forth optional SEARCH & SEARCH EXT word set. 186** 26 May 1998 (sadler) 187** FICL_PROMPT macro 188** 14 April 1998 (sadler) V1.04 189** Ficlwin: Windows version, Skip Carter's Linux port 190** 5 March 1998 (sadler) V1.03 191** Bug fixes -- passes John Ryan's ANS test suite "core.fr" 192** 193** 24 February 1998 (sadler) V1.02 194** -Fixed bugs in <# # #> 195** -Changed FICL_WORD so that storage for the name characters 196** can be allocated from the dictionary as needed rather than 197** reserving 32 bytes in each word whether needed or not - 198** this saved 50% of the dictionary storage requirement. 199** -Added words in testmain for Win32 functions system,chdir,cwd, 200** also added a word that loads and evaluates a file. 201** 202** December 1997 (sadler) 203** -Added VM_RESTART exception handling in ficlExec -- this lets words 204** that require additional text to succeed (like :, create, variable...) 205** recover gracefully from an empty input buffer rather than emitting 206** an error message. Definitions can span multiple input blocks with 207** no restrictions. 208** -Changed #include order so that <assert.h> is included in sysdep.h, 209** and sysdep is included in all other files. This lets you define 210** NDEBUG in sysdep.h to disable assertions if you want to. 211** -Make PC specific system dependent code conditional on _M_IX86 212** defined so that ports can coexist in sysdep.h/sysdep.c 213*/ 214 215#ifdef __cplusplus 216extern "C" { 217#endif 218 219#include "sysdep.h" 220#include <limits.h> /* UCHAR_MAX */ 221 222/* 223** Forward declarations... read on. 224*/ 225struct ficl_word; 226typedef struct ficl_word FICL_WORD; 227struct vm; 228typedef struct vm FICL_VM; 229struct ficl_dict; 230typedef struct ficl_dict FICL_DICT; 231struct ficl_system; 232typedef struct ficl_system FICL_SYSTEM; 233struct ficl_system_info; 234typedef struct ficl_system_info FICL_SYSTEM_INFO; 235 236/* 237** the Good Stuff starts here... 238*/ 239#define FICL_VER "3.03" 240#define FICL_VER_MAJOR 3 241#define FICL_VER_MINOR 3 242#if !defined (FICL_PROMPT) 243#define FICL_PROMPT "ok> " 244#endif 245 246/* 247** ANS Forth requires false to be zero, and true to be the ones 248** complement of false... that unifies logical and bitwise operations 249** nicely. 250*/ 251#define FICL_TRUE (~(FICL_UNS)0) 252#define FICL_FALSE (0) 253#define FICL_BOOL(x) ((x) ? FICL_TRUE : FICL_FALSE) 254 255 256/* 257** A CELL is the main storage type. It must be large enough 258** to contain a pointer or a scalar. In order to accommodate 259** 32 bit and 64 bit processors, use abstract types for int, 260** unsigned, and float. 261*/ 262typedef union _cell 263{ 264 FICL_INT i; 265 FICL_UNS u; 266#if (FICL_WANT_FLOAT) 267 FICL_FLOAT f; 268#endif 269 void *p; 270 void (*fn)(void); 271} CELL; 272 273/* 274** LVALUEtoCELL does a little pointer trickery to cast any CELL sized 275** lvalue (informal definition: an expression whose result has an 276** address) to CELL. Remember that constants and casts are NOT 277** themselves lvalues! 278*/ 279#define LVALUEtoCELL(v) (*(CELL *)&v) 280 281/* 282** PTRtoCELL is a cast through void * intended to satisfy the 283** most outrageously pedantic compiler... (I won't mention 284** its name) 285*/ 286#define PTRtoCELL (CELL *)(void *) 287#define PTRtoSTRING (FICL_STRING *)(void *) 288 289/* 290** Strings in FICL are stored in Pascal style - with a count 291** preceding the text. We'll also NULL-terminate them so that 292** they work with the usual C lib string functions. (Belt & 293** suspenders? You decide.) 294** STRINGINFO hides the implementation with a couple of 295** macros for use in internal routines. 296*/ 297 298typedef unsigned char FICL_COUNT; 299#define FICL_STRING_MAX UCHAR_MAX 300typedef struct _ficl_string 301{ 302 FICL_COUNT count; 303 char text[1]; 304} FICL_STRING; 305 306typedef struct 307{ 308 FICL_UNS count; 309 char *cp; 310} STRINGINFO; 311 312#define SI_COUNT(si) (si.count) 313#define SI_PTR(si) (si.cp) 314#define SI_SETLEN(si, len) (si.count = (FICL_UNS)(len)) 315#define SI_SETPTR(si, ptr) (si.cp = (char *)(ptr)) 316/* 317** Init a STRINGINFO from a pointer to NULL-terminated string 318*/ 319#define SI_PSZ(si, psz) \ 320 {si.cp = psz; si.count = (FICL_COUNT)strlen(psz);} 321/* 322** Init a STRINGINFO from a pointer to FICL_STRING 323*/ 324#define SI_PFS(si, pfs) \ 325 {si.cp = pfs->text; si.count = pfs->count;} 326 327/* 328** Ficl uses this little structure to hold the address of 329** the block of text it's working on and an index to the next 330** unconsumed character in the string. Traditionally, this is 331** done by a Text Input Buffer, so I've called this struct TIB. 332** 333** Since this structure also holds the size of the input buffer, 334** and since evaluate requires that, let's put the size here. 335** The size is stored as an end-pointer because that is what the 336** null-terminated string aware functions find most easy to deal 337** with. 338** Notice, though, that nobody really uses this except evaluate, 339** so it might just be moved to FICL_VM instead. (sobral) 340*/ 341typedef struct 342{ 343 FICL_INT index; 344 char *end; 345 char *cp; 346} TIB; 347 348 349/* 350** Stacks get heavy use in Ficl and Forth... 351** Each virtual machine implements two of them: 352** one holds parameters (data), and the other holds return 353** addresses and control flow information for the virtual 354** machine. (Note: C's automatic stack is implicitly used, 355** but not modeled because it doesn't need to be...) 356** Here's an abstract type for a stack 357*/ 358typedef struct _ficlStack 359{ 360 FICL_UNS nCells; /* size of the stack */ 361 CELL *pFrame; /* link reg for stack frame */ 362 CELL *sp; /* stack pointer */ 363 CELL base[1]; /* Top of stack */ 364} FICL_STACK; 365 366/* 367** Stack methods... many map closely to required Forth words. 368*/ 369FICL_STACK *stackCreate (unsigned nCells); 370void stackDelete (FICL_STACK *pStack); 371int stackDepth (FICL_STACK *pStack); 372void stackDrop (FICL_STACK *pStack, int n); 373CELL stackFetch (FICL_STACK *pStack, int n); 374CELL stackGetTop (FICL_STACK *pStack); 375void stackLink (FICL_STACK *pStack, int nCells); 376void stackPick (FICL_STACK *pStack, int n); 377CELL stackPop (FICL_STACK *pStack); 378void *stackPopPtr (FICL_STACK *pStack); 379FICL_UNS stackPopUNS (FICL_STACK *pStack); 380FICL_INT stackPopINT (FICL_STACK *pStack); 381void stackPush (FICL_STACK *pStack, CELL c); 382void stackPushPtr (FICL_STACK *pStack, void *ptr); 383void stackPushUNS (FICL_STACK *pStack, FICL_UNS u); 384void stackPushINT (FICL_STACK *pStack, FICL_INT i); 385void stackReset (FICL_STACK *pStack); 386void stackRoll (FICL_STACK *pStack, int n); 387void stackSetTop (FICL_STACK *pStack, CELL c); 388void stackStore (FICL_STACK *pStack, int n, CELL c); 389void stackUnlink (FICL_STACK *pStack); 390 391#if (FICL_WANT_FLOAT) 392float stackPopFloat (FICL_STACK *pStack); 393void stackPushFloat(FICL_STACK *pStack, FICL_FLOAT f); 394#endif 395 396/* 397** Shortcuts (Guy Carver) 398*/ 399#define PUSHPTR(p) stackPushPtr(pVM->pStack,p) 400#define PUSHUNS(u) stackPushUNS(pVM->pStack,u) 401#define PUSHINT(i) stackPushINT(pVM->pStack,i) 402#define PUSHFLOAT(f) stackPushFloat(pVM->fStack,f) 403#define PUSH(c) stackPush(pVM->pStack,c) 404#define POPPTR() stackPopPtr(pVM->pStack) 405#define POPUNS() stackPopUNS(pVM->pStack) 406#define POPINT() stackPopINT(pVM->pStack) 407#define POPFLOAT() stackPopFloat(pVM->fStack) 408#define POP() stackPop(pVM->pStack) 409#define GETTOP() stackGetTop(pVM->pStack) 410#define SETTOP(c) stackSetTop(pVM->pStack,LVALUEtoCELL(c)) 411#define GETTOPF() stackGetTop(pVM->fStack) 412#define SETTOPF(c) stackSetTop(pVM->fStack,LVALUEtoCELL(c)) 413#define STORE(n,c) stackStore(pVM->pStack,n,LVALUEtoCELL(c)) 414#define DEPTH() stackDepth(pVM->pStack) 415#define DROP(n) stackDrop(pVM->pStack,n) 416#define DROPF(n) stackDrop(pVM->fStack,n) 417#define FETCH(n) stackFetch(pVM->pStack,n) 418#define PICK(n) stackPick(pVM->pStack,n) 419#define PICKF(n) stackPick(pVM->fStack,n) 420#define ROLL(n) stackRoll(pVM->pStack,n) 421#define ROLLF(n) stackRoll(pVM->fStack,n) 422 423/* 424** The virtual machine (VM) contains the state for one interpreter. 425** Defined operations include: 426** Create & initialize 427** Delete 428** Execute a block of text 429** Parse a word out of the input stream 430** Call return, and branch 431** Text output 432** Throw an exception 433*/ 434 435typedef FICL_WORD ** IPTYPE; /* the VM's instruction pointer */ 436 437/* 438** Each VM has a placeholder for an output function - 439** this makes it possible to have each VM do I/O 440** through a different device. If you specify no 441** OUTFUNC, it defaults to ficlTextOut. 442*/ 443typedef void (*OUTFUNC)(FICL_VM *pVM, char *text, int fNewline); 444 445/* 446** Each VM operates in one of two non-error states: interpreting 447** or compiling. When interpreting, words are simply executed. 448** When compiling, most words in the input stream have their 449** addresses inserted into the word under construction. Some words 450** (known as IMMEDIATE) are executed in the compile state, too. 451*/ 452/* values of STATE */ 453#define INTERPRET 0 454#define COMPILE 1 455 456/* 457** The pad is a small scratch area for text manipulation. ANS Forth 458** requires it to hold at least 84 characters. 459*/ 460#if !defined nPAD 461#define nPAD 256 462#endif 463 464/* 465** ANS Forth requires that a word's name contain {1..31} characters. 466*/ 467#if !defined nFICLNAME 468#define nFICLNAME 31 469#endif 470 471/* 472** OK - now we can really define the VM... 473*/ 474struct vm 475{ 476 FICL_SYSTEM *pSys; /* Which system this VM belongs to */ 477 FICL_VM *link; /* Ficl keeps a VM list for simple teardown */ 478 jmp_buf *pState; /* crude exception mechanism... */ 479 OUTFUNC textOut; /* Output callback - see sysdep.c */ 480 void * pExtend; /* vm extension pointer for app use - initialized from FICL_SYSTEM */ 481 short fRestart; /* Set TRUE to restart runningWord */ 482 IPTYPE ip; /* instruction pointer */ 483 FICL_WORD *runningWord;/* address of currently running word (often just *(ip-1) ) */ 484 FICL_UNS state; /* compiling or interpreting */ 485 FICL_UNS base; /* number conversion base */ 486 FICL_STACK *pStack; /* param stack */ 487 FICL_STACK *rStack; /* return stack */ 488#if FICL_WANT_FLOAT 489 FICL_STACK *fStack; /* float stack (optional) */ 490#endif 491 CELL sourceID; /* -1 if EVALUATE, 0 if normal input */ 492 TIB tib; /* address of incoming text string */ 493#if FICL_WANT_USER 494 CELL user[FICL_USER_CELLS]; 495#endif 496 char pad[nPAD]; /* the scratch area (see above) */ 497}; 498 499/* 500** A FICL_CODE points to a function that gets called to help execute 501** a word in the dictionary. It always gets passed a pointer to the 502** running virtual machine, and from there it can get the address 503** of the parameter area of the word it's supposed to operate on. 504** For precompiled words, the code is all there is. For user defined 505** words, the code assumes that the word's parameter area is a list 506** of pointers to the code fields of other words to execute, and 507** may also contain inline data. The first parameter is always 508** a pointer to a code field. 509*/ 510typedef void (*FICL_CODE)(FICL_VM *pVm); 511 512#if 0 513#define VM_ASSERT(pVM) assert((*(pVM->ip - 1)) == pVM->runningWord) 514#else 515#define VM_ASSERT(pVM) 516#endif 517 518/* 519** Ficl models memory as a contiguous space divided into 520** words in a linked list called the dictionary. 521** A FICL_WORD starts each entry in the list. 522** Version 1.02: space for the name characters is allotted from 523** the dictionary ahead of the word struct, rather than using 524** a fixed size array for each name. 525*/ 526struct ficl_word 527{ 528 struct ficl_word *link; /* Previous word in the dictionary */ 529 UNS16 hash; 530 UNS8 flags; /* Immediate, Smudge, Compile-only */ 531 FICL_COUNT nName; /* Number of chars in word name */ 532 char *name; /* First nFICLNAME chars of word name */ 533 FICL_CODE code; /* Native code to execute the word */ 534 CELL param[1]; /* First data cell of the word */ 535}; 536 537/* 538** Worst-case size of a word header: nFICLNAME chars in name 539*/ 540#define CELLS_PER_WORD \ 541 ( (sizeof (FICL_WORD) + nFICLNAME + sizeof (CELL)) \ 542 / (sizeof (CELL)) ) 543 544int wordIsImmediate(FICL_WORD *pFW); 545int wordIsCompileOnly(FICL_WORD *pFW); 546 547/* flag values for word header */ 548#define FW_IMMEDIATE 1 /* execute me even if compiling */ 549#define FW_COMPILE 2 /* error if executed when not compiling */ 550#define FW_SMUDGE 4 /* definition in progress - hide me */ 551#define FW_ISOBJECT 8 /* word is an object or object member variable */ 552 553#define FW_COMPIMMED (FW_IMMEDIATE | FW_COMPILE) 554#define FW_DEFAULT 0 555 556 557/* 558** Exit codes for vmThrow 559*/ 560#define VM_INNEREXIT -256 /* tell ficlExecXT to exit inner loop */ 561#define VM_OUTOFTEXT -257 /* hungry - normal exit */ 562#define VM_RESTART -258 /* word needs more text to succeed - re-run it */ 563#define VM_USEREXIT -259 /* user wants to quit */ 564#define VM_ERREXIT -260 /* interp found an error */ 565#define VM_BREAK -261 /* debugger breakpoint */ 566#define VM_ABORT -1 /* like errexit -- abort */ 567#define VM_ABORTQ -2 /* like errexit -- abort" */ 568#define VM_QUIT -56 /* like errexit, but leave pStack & base alone */ 569 570 571void vmBranchRelative(FICL_VM *pVM, int offset); 572FICL_VM * vmCreate (FICL_VM *pVM, unsigned nPStack, unsigned nRStack); 573void vmDelete (FICL_VM *pVM); 574void vmExecute (FICL_VM *pVM, FICL_WORD *pWord); 575FICL_DICT *vmGetDict (FICL_VM *pVM); 576char * vmGetString (FICL_VM *pVM, FICL_STRING *spDest, char delimiter); 577STRINGINFO vmGetWord (FICL_VM *pVM); 578STRINGINFO vmGetWord0 (FICL_VM *pVM); 579int vmGetWordToPad (FICL_VM *pVM); 580STRINGINFO vmParseString (FICL_VM *pVM, char delimiter); 581STRINGINFO vmParseStringEx(FICL_VM *pVM, char delimiter, char fSkipLeading); 582CELL vmPop (FICL_VM *pVM); 583void vmPush (FICL_VM *pVM, CELL c); 584void vmPopIP (FICL_VM *pVM); 585void vmPushIP (FICL_VM *pVM, IPTYPE newIP); 586void vmQuit (FICL_VM *pVM); 587void vmReset (FICL_VM *pVM); 588void vmSetTextOut (FICL_VM *pVM, OUTFUNC textOut); 589void vmTextOut (FICL_VM *pVM, char *text, int fNewline); 590void vmTextOut (FICL_VM *pVM, char *text, int fNewline); 591void vmThrow (FICL_VM *pVM, int except); 592void vmThrowErr (FICL_VM *pVM, char *fmt, ...); 593 594#define vmGetRunningWord(pVM) ((pVM)->runningWord) 595 596 597/* 598** The inner interpreter - coded as a macro (see note for 599** INLINE_INNER_LOOP in sysdep.h for complaints about VC++ 5 600*/ 601#define M_VM_STEP(pVM) \ 602 FICL_WORD *tempFW = *(pVM)->ip++; \ 603 (pVM)->runningWord = tempFW; \ 604 tempFW->code(pVM); 605 606#define M_INNER_LOOP(pVM) \ 607 for (;;) { M_VM_STEP(pVM) } 608 609 610#if INLINE_INNER_LOOP != 0 611#define vmInnerLoop(pVM) M_INNER_LOOP(pVM) 612#else 613void vmInnerLoop(FICL_VM *pVM); 614#endif 615 616/* 617** vmCheckStack needs a vm pointer because it might have to say 618** something if it finds a problem. Parms popCells and pushCells 619** correspond to the number of parameters on the left and right of 620** a word's stack effect comment. 621*/ 622void vmCheckStack(FICL_VM *pVM, int popCells, int pushCells); 623#if FICL_WANT_FLOAT 624void vmCheckFStack(FICL_VM *pVM, int popCells, int pushCells); 625#endif 626 627/* 628** TIB access routines... 629** ANS forth seems to require the input buffer to be represented 630** as a pointer to the start of the buffer, and an index to the 631** next character to read. 632** PushTib points the VM to a new input string and optionally 633** returns a copy of the current state 634** PopTib restores the TIB state given a saved TIB from PushTib 635** GetInBuf returns a pointer to the next unused char of the TIB 636*/ 637void vmPushTib (FICL_VM *pVM, char *text, FICL_INT nChars, TIB *pSaveTib); 638void vmPopTib (FICL_VM *pVM, TIB *pTib); 639#define vmGetInBuf(pVM) ((pVM)->tib.cp + (pVM)->tib.index) 640#define vmGetInBufLen(pVM) ((pVM)->tib.end - (pVM)->tib.cp) 641#define vmGetInBufEnd(pVM) ((pVM)->tib.end) 642#define vmGetTibIndex(pVM) (pVM)->tib.index 643#define vmSetTibIndex(pVM, i) (pVM)->tib.index = i 644#define vmUpdateTib(pVM, str) (pVM)->tib.index = (str) - (pVM)->tib.cp 645 646/* 647** Generally useful string manipulators omitted by ANSI C... 648** ltoa complements strtol 649*/ 650#if defined(_WIN32) && !FICL_MAIN 651/* #SHEESH 652** Why do Microsoft Meatballs insist on contaminating 653** my namespace with their string functions??? 654*/ 655#pragma warning(disable: 4273) 656#endif 657 658int isPowerOfTwo(FICL_UNS u); 659 660char *ltoa( FICL_INT value, char *string, int radix ); 661char *ultoa(FICL_UNS value, char *string, int radix ); 662char digit_to_char(int value); 663char *strrev( char *string ); 664char *skipSpace(char *cp, char *end); 665char *caseFold(char *cp); 666int strincmp(char *cp1, char *cp2, FICL_UNS count); 667 668#if defined(_WIN32) && !FICL_MAIN 669#pragma warning(default: 4273) 670#endif 671 672/* 673** Ficl hash table - variable size. 674** assert(size > 0) 675** If size is 1, the table degenerates into a linked list. 676** A WORDLIST (see the search order word set in DPANS) is 677** just a pointer to a FICL_HASH in this implementation. 678*/ 679#if !defined HASHSIZE /* Default size of hash table. For most uniform */ 680#define HASHSIZE 241 /* performance, use a prime number! */ 681#endif 682 683typedef struct ficl_hash 684{ 685 struct ficl_hash *link; /* link to parent class wordlist for OO */ 686 char *name; /* optional pointer to \0 terminated wordlist name */ 687 unsigned size; /* number of buckets in the hash */ 688 FICL_WORD *table[1]; 689} FICL_HASH; 690 691void hashForget (FICL_HASH *pHash, void *where); 692UNS16 hashHashCode (STRINGINFO si); 693void hashInsertWord(FICL_HASH *pHash, FICL_WORD *pFW); 694FICL_WORD *hashLookup (FICL_HASH *pHash, STRINGINFO si, UNS16 hashCode); 695void hashReset (FICL_HASH *pHash); 696 697/* 698** A Dictionary is a linked list of FICL_WORDs. It is also Ficl's 699** memory model. Description of fields: 700** 701** here -- points to the next free byte in the dictionary. This 702** pointer is forced to be CELL-aligned before a definition is added. 703** Do not assume any specific alignment otherwise - Use dictAlign(). 704** 705** smudge -- pointer to word currently being defined (or last defined word) 706** If the definition completes successfully, the word will be 707** linked into the hash table. If unsuccessful, dictUnsmudge 708** uses this pointer to restore the previous state of the dictionary. 709** Smudge prevents unintentional recursion as a side-effect: the 710** dictionary search algo examines only completed definitions, so a 711** word cannot invoke itself by name. See the ficl word "recurse". 712** NOTE: smudge always points to the last word defined. IMMEDIATE 713** makes use of this fact. Smudge is initially NULL. 714** 715** pForthWords -- pointer to the default wordlist (FICL_HASH). 716** This is the initial compilation list, and contains all 717** ficl's precompiled words. 718** 719** pCompile -- compilation wordlist - initially equal to pForthWords 720** pSearch -- array of pointers to wordlists. Managed as a stack. 721** Highest index is the first list in the search order. 722** nLists -- number of lists in pSearch. nLists-1 is the highest 723** filled slot in pSearch, and points to the first wordlist 724** in the search order 725** size -- number of cells in the dictionary (total) 726** dict -- start of data area. Must be at the end of the struct. 727*/ 728struct ficl_dict 729{ 730 CELL *here; 731 FICL_WORD *smudge; 732 FICL_HASH *pForthWords; 733 FICL_HASH *pCompile; 734 FICL_HASH *pSearch[FICL_DEFAULT_VOCS]; 735 int nLists; 736 unsigned size; /* Number of cells in dict (total)*/ 737 CELL *dict; /* Base of dictionary memory */ 738}; 739 740void *alignPtr(void *ptr); 741void dictAbortDefinition(FICL_DICT *pDict); 742void dictAlign (FICL_DICT *pDict); 743int dictAllot (FICL_DICT *pDict, int n); 744int dictAllotCells (FICL_DICT *pDict, int nCells); 745void dictAppendCell (FICL_DICT *pDict, CELL c); 746void dictAppendChar (FICL_DICT *pDict, char c); 747FICL_WORD *dictAppendWord (FICL_DICT *pDict, 748 char *name, 749 FICL_CODE pCode, 750 UNS8 flags); 751FICL_WORD *dictAppendWord2(FICL_DICT *pDict, 752 STRINGINFO si, 753 FICL_CODE pCode, 754 UNS8 flags); 755void dictAppendUNS (FICL_DICT *pDict, FICL_UNS u); 756int dictCellsAvail (FICL_DICT *pDict); 757int dictCellsUsed (FICL_DICT *pDict); 758void dictCheck (FICL_DICT *pDict, FICL_VM *pVM, int n); 759void dictCheckThreshold(FICL_DICT* dp); 760FICL_DICT *dictCreate(unsigned nCELLS); 761FICL_DICT *dictCreateHashed(unsigned nCells, unsigned nHash); 762FICL_HASH *dictCreateWordlist(FICL_DICT *dp, int nBuckets); 763void dictDelete (FICL_DICT *pDict); 764void dictEmpty (FICL_DICT *pDict, unsigned nHash); 765#if FICL_WANT_FLOAT 766void dictHashSummary(FICL_VM *pVM); 767#endif 768int dictIncludes (FICL_DICT *pDict, void *p); 769FICL_WORD *dictLookup (FICL_DICT *pDict, STRINGINFO si); 770#if FICL_WANT_LOCALS 771FICL_WORD *ficlLookupLoc (FICL_SYSTEM *pSys, STRINGINFO si); 772#endif 773void dictResetSearchOrder(FICL_DICT *pDict); 774void dictSetFlags (FICL_DICT *pDict, UNS8 set, UNS8 clr); 775void dictSetImmediate(FICL_DICT *pDict); 776void dictUnsmudge (FICL_DICT *pDict); 777CELL *dictWhere (FICL_DICT *pDict); 778 779 780/* 781** P A R S E S T E P 782** (New for 2.05) 783** See words.c: interpWord 784** By default, ficl goes through two attempts to parse each token from its input 785** stream: it first attempts to match it with a word in the dictionary, and 786** if that fails, it attempts to convert it into a number. This mechanism is now 787** extensible by additional steps. This allows extensions like floating point and 788** double number support to be factored cleanly. 789** 790** Each parse step is a function that receives the next input token as a STRINGINFO. 791** If the parse step matches the token, it must apply semantics to the token appropriate 792** to the present value of VM.state (compiling or interpreting), and return FICL_TRUE. 793** Otherwise it returns FICL_FALSE. See words.c: isNumber for an example 794** 795** Note: for the sake of efficiency, it's a good idea both to limit the number 796** of parse steps and to code each parse step so that it rejects tokens that 797** do not match as quickly as possible. 798*/ 799 800typedef int (*FICL_PARSE_STEP)(FICL_VM *pVM, STRINGINFO si); 801 802/* 803** Appends a parse step function to the end of the parse list (see 804** FICL_PARSE_STEP notes in ficl.h for details). Returns 0 if successful, 805** nonzero if there's no more room in the list. Each parse step is a word in 806** the dictionary. Precompiled parse steps can use (PARSE-STEP) as their 807** CFA - see parenParseStep in words.c. 808*/ 809int ficlAddParseStep(FICL_SYSTEM *pSys, FICL_WORD *pFW); /* ficl.c */ 810void ficlAddPrecompiledParseStep(FICL_SYSTEM *pSys, char *name, FICL_PARSE_STEP pStep); 811void ficlListParseSteps(FICL_VM *pVM); 812 813/* 814** FICL_BREAKPOINT record. 815** origXT - if NULL, this breakpoint is unused. Otherwise it stores the xt 816** that the breakpoint overwrote. This is restored to the dictionary when the 817** BP executes or gets cleared 818** address - the location of the breakpoint (address of the instruction that 819** has been replaced with the breakpoint trap 820** origXT - The original contents of the location with the breakpoint 821** Note: address is NULL when this breakpoint is empty 822*/ 823typedef struct FICL_BREAKPOINT 824{ 825 void *address; 826 FICL_WORD *origXT; 827} FICL_BREAKPOINT; 828 829 830/* 831** F I C L _ S Y S T E M 832** The top level data structure of the system - ficl_system ties a list of 833** virtual machines with their corresponding dictionaries. Ficl 3.0 will 834** support multiple Ficl systems, allowing multiple concurrent sessions 835** to separate dictionaries with some constraints. 836** The present model allows multiple sessions to one dictionary provided 837** you implement ficlLockDictionary() as specified in sysdep.h 838** Note: the pExtend pointer is there to provide context for applications. It is copied 839** to each VM's pExtend field as that VM is created. 840*/ 841struct ficl_system 842{ 843 FICL_SYSTEM *link; 844 void *pExtend; /* Initializes VM's pExtend pointer (for application use) */ 845 FICL_VM *vmList; 846 FICL_DICT *dp; 847 FICL_DICT *envp; 848#ifdef FICL_WANT_LOCALS 849 FICL_DICT *localp; 850#endif 851 FICL_WORD *pInterp[3]; 852 FICL_WORD *parseList[FICL_MAX_PARSE_STEPS]; 853 OUTFUNC textOut; 854 855 FICL_WORD *pBranchParen; 856 FICL_WORD *pDoParen; 857 FICL_WORD *pDoesParen; 858 FICL_WORD *pExitInner; 859 FICL_WORD *pExitParen; 860 FICL_WORD *pBranch0; 861 FICL_WORD *pInterpret; 862 FICL_WORD *pLitParen; 863 FICL_WORD *pTwoLitParen; 864 FICL_WORD *pLoopParen; 865 FICL_WORD *pPLoopParen; 866 FICL_WORD *pQDoParen; 867 FICL_WORD *pSemiParen; 868 FICL_WORD *pOfParen; 869 FICL_WORD *pStore; 870 FICL_WORD *pDrop; 871 FICL_WORD *pCStringLit; 872 FICL_WORD *pStringLit; 873 874#if FICL_WANT_LOCALS 875 FICL_WORD *pGetLocalParen; 876 FICL_WORD *pGet2LocalParen; 877 FICL_WORD *pGetLocal0; 878 FICL_WORD *pGetLocal1; 879 FICL_WORD *pToLocalParen; 880 FICL_WORD *pTo2LocalParen; 881 FICL_WORD *pToLocal0; 882 FICL_WORD *pToLocal1; 883 FICL_WORD *pLinkParen; 884 FICL_WORD *pUnLinkParen; 885 FICL_INT nLocals; 886 CELL *pMarkLocals; 887#endif 888 889 FICL_BREAKPOINT bpStep; 890}; 891 892struct ficl_system_info 893{ 894 int size; /* structure size tag for versioning */ 895 int nDictCells; /* Size of system's Dictionary */ 896 OUTFUNC textOut; /* default textOut function */ 897 void *pExtend; /* Initializes VM's pExtend pointer - for application use */ 898 int nEnvCells; /* Size of Environment dictionary */ 899}; 900 901 902#define ficlInitInfo(x) { memset((x), 0, sizeof(FICL_SYSTEM_INFO)); \ 903 (x)->size = sizeof(FICL_SYSTEM_INFO); } 904 905/* 906** External interface to FICL... 907*/ 908/* 909** f i c l I n i t S y s t e m 910** Binds a global dictionary to the interpreter system and initializes 911** the dict to contain the ANSI CORE wordset. 912** You can specify the address and size of the allocated area. 913** Using ficlInitSystemEx you can also specify the text output function. 914** After that, ficl manages it. 915** First step is to set up the static pointers to the area. 916** Then write the "precompiled" portion of the dictionary in. 917** The dictionary needs to be at least large enough to hold the 918** precompiled part. Try 1K cells minimum. Use "words" to find 919** out how much of the dictionary is used at any time. 920*/ 921FICL_SYSTEM *ficlInitSystemEx(FICL_SYSTEM_INFO *fsi); 922 923/* Deprecated call */ 924FICL_SYSTEM *ficlInitSystem(int nDictCells); 925 926/* 927** f i c l T e r m S y s t e m 928** Deletes the system dictionary and all virtual machines that 929** were created with ficlNewVM (see below). Call this function to 930** reclaim all memory used by the dictionary and VMs. 931*/ 932void ficlTermSystem(FICL_SYSTEM *pSys); 933 934/* 935** f i c l E v a l u a t e 936** Evaluates a block of input text in the context of the 937** specified interpreter. Also sets SOURCE-ID properly. 938** 939** PLEASE USE THIS FUNCTION when throwing a hard-coded 940** string to the FICL interpreter. 941*/ 942int ficlEvaluate(FICL_VM *pVM, char *pText); 943 944/* 945** f i c l E x e c 946** Evaluates a block of input text in the context of the 947** specified interpreter. Emits any requested output to the 948** interpreter's output function. If the input string is NULL 949** terminated, you can pass -1 as nChars rather than count it. 950** Execution returns when the text block has been executed, 951** or an error occurs. 952** Returns one of the VM_XXXX codes defined in ficl.h: 953** VM_OUTOFTEXT is the normal exit condition 954** VM_ERREXIT means that the interp encountered a syntax error 955** and the vm has been reset to recover (some or all 956** of the text block got ignored 957** VM_USEREXIT means that the user executed the "bye" command 958** to shut down the interpreter. This would be a good 959** time to delete the vm, etc -- or you can ignore this 960** signal. 961** VM_ABORT and VM_ABORTQ are generated by 'abort' and 'abort"' 962** commands. 963** Preconditions: successful execution of ficlInitSystem, 964** Successful creation and init of the VM by ficlNewVM (or equiv) 965** 966** If you call ficlExec() or one of its brothers, you MUST 967** ensure pVM->sourceID was set to a sensible value. 968** ficlExec() explicitly DOES NOT manage SOURCE-ID for you. 969*/ 970int ficlExec (FICL_VM *pVM, char *pText); 971int ficlExecC(FICL_VM *pVM, char *pText, FICL_INT nChars); 972int ficlExecXT(FICL_VM *pVM, FICL_WORD *pWord); 973 974/* 975** ficlExecFD(FICL_VM *pVM, int fd); 976 * Evaluates text from file passed in via fd. 977 * Execution returns when all of file has been executed or an 978 * error occurs. 979 */ 980int ficlExecFD(FICL_VM *pVM, int fd); 981 982/* 983** Create a new VM from the heap, and link it into the system VM list. 984** Initializes the VM and binds default sized stacks to it. Returns the 985** address of the VM, or NULL if an error occurs. 986** Precondition: successful execution of ficlInitSystem 987*/ 988FICL_VM *ficlNewVM(FICL_SYSTEM *pSys); 989 990/* 991** Force deletion of a VM. You do not need to do this 992** unless you're creating and discarding a lot of VMs. 993** For systems that use a constant pool of VMs for the life 994** of the system, ficltermSystem takes care of VM cleanup 995** automatically. 996*/ 997void ficlFreeVM(FICL_VM *pVM); 998 999 1000/* 1001** Set the stack sizes (return and parameter) to be used for all 1002** subsequently created VMs. Returns actual stack size to be used. 1003*/ 1004int ficlSetStackSize(int nStackCells); 1005 1006/* 1007** Returns the address of the most recently defined word in the system 1008** dictionary with the given name, or NULL if no match. 1009** Precondition: successful execution of ficlInitSystem 1010*/ 1011FICL_WORD *ficlLookup(FICL_SYSTEM *pSys, char *name); 1012 1013/* 1014** f i c l G e t D i c t 1015** Utility function - returns the address of the system dictionary. 1016** Precondition: successful execution of ficlInitSystem 1017*/ 1018FICL_DICT *ficlGetDict(FICL_SYSTEM *pSys); 1019FICL_DICT *ficlGetEnv (FICL_SYSTEM *pSys); 1020void ficlSetEnv (FICL_SYSTEM *pSys, char *name, FICL_UNS value); 1021void ficlSetEnvD(FICL_SYSTEM *pSys, char *name, FICL_UNS hi, FICL_UNS lo); 1022#if FICL_WANT_LOCALS 1023FICL_DICT *ficlGetLoc (FICL_SYSTEM *pSys); 1024#endif 1025/* 1026** f i c l B u i l d 1027** Builds a word into the system default dictionary in a thread-safe way. 1028** Preconditions: system must be initialized, and there must 1029** be enough space for the new word's header! Operation is 1030** controlled by ficlLockDictionary, so any initialization 1031** required by your version of the function (if you "overrode" 1032** it) must be complete at this point. 1033** Parameters: 1034** name -- the name of the word to be built 1035** code -- code to execute when the word is invoked - must take a single param 1036** pointer to a FICL_VM 1037** flags -- 0 or more of FW_IMMEDIATE, FW_COMPILE, use bitwise OR! 1038** Most words can use FW_DEFAULT. 1039** nAllot - number of extra cells to allocate in the parameter area (usually zero) 1040*/ 1041int ficlBuild(FICL_SYSTEM *pSys, char *name, FICL_CODE code, char flags); 1042 1043/* 1044** f i c l C o m p i l e C o r e 1045** Builds the ANS CORE wordset into the dictionary - called by 1046** ficlInitSystem - no need to waste dict space by doing it again. 1047*/ 1048void ficlCompileCore(FICL_SYSTEM *pSys); 1049void ficlCompilePrefix(FICL_SYSTEM *pSys); 1050void ficlCompileSearch(FICL_SYSTEM *pSys); 1051void ficlCompileSoftCore(FICL_SYSTEM *pSys); 1052void ficlCompileTools(FICL_SYSTEM *pSys); 1053void ficlCompileFile(FICL_SYSTEM *pSys); 1054#if FICL_WANT_FLOAT 1055void ficlCompileFloat(FICL_SYSTEM *pSys); 1056int ficlParseFloatNumber( FICL_VM *pVM, STRINGINFO si ); /* float.c */ 1057#endif 1058#if FICL_PLATFORM_EXTEND 1059void ficlCompilePlatform(FICL_SYSTEM *pSys); 1060#endif 1061int ficlParsePrefix(FICL_VM *pVM, STRINGINFO si); 1062 1063/* 1064** from words.c... 1065*/ 1066void constantParen(FICL_VM *pVM); 1067void twoConstParen(FICL_VM *pVM); 1068int ficlParseNumber(FICL_VM *pVM, STRINGINFO si); 1069void ficlTick(FICL_VM *pVM); 1070void parseStepParen(FICL_VM *pVM); 1071 1072/* 1073** From tools.c 1074*/ 1075int isAFiclWord(FICL_DICT *pd, FICL_WORD *pFW); 1076 1077/* 1078** The following supports SEE and the debugger. 1079*/ 1080typedef enum 1081{ 1082 BRANCH, 1083 COLON, 1084 CONSTANT, 1085 CREATE, 1086 DO, 1087 DOES, 1088 IF, 1089 LITERAL, 1090 LOOP, 1091 OF, 1092 PLOOP, 1093 PRIMITIVE, 1094 QDO, 1095 STRINGLIT, 1096 CSTRINGLIT, 1097#if FICL_WANT_USER 1098 USER, 1099#endif 1100 VARIABLE, 1101} WORDKIND; 1102 1103WORDKIND ficlWordClassify(FICL_WORD *pFW); 1104 1105/* 1106** Dictionary on-demand resizing 1107*/ 1108extern CELL dictThreshold; 1109extern CELL dictIncrease; 1110 1111/* 1112** Various FreeBSD goodies 1113*/ 1114 1115#if defined(__i386__) && !defined(TESTMAIN) 1116extern void ficlOutb(FICL_VM *pVM); 1117extern void ficlInb(FICL_VM *pVM); 1118#endif 1119 1120extern void ficlSetenv(FICL_VM *pVM); 1121extern void ficlSetenvq(FICL_VM *pVM); 1122extern void ficlGetenv(FICL_VM *pVM); 1123extern void ficlUnsetenv(FICL_VM *pVM); 1124extern void ficlCopyin(FICL_VM *pVM); 1125extern void ficlCopyout(FICL_VM *pVM); 1126extern void ficlFindfile(FICL_VM *pVM); 1127extern void ficlCcall(FICL_VM *pVM); 1128#if !defined(TESTMAIN) 1129extern void ficlPnpdevices(FICL_VM *pVM); 1130extern void ficlPnphandlers(FICL_VM *pVM); 1131#endif 1132 1133/* 1134** Used with File-Access wordset. 1135*/ 1136#define FICL_FAM_READ 1 1137#define FICL_FAM_WRITE 2 1138#define FICL_FAM_APPEND 4 1139#define FICL_FAM_BINARY 8 1140 1141#define FICL_FAM_OPEN_MODE(fam) ((fam) & (FICL_FAM_READ | FICL_FAM_WRITE | FICL_FAM_APPEND)) 1142 1143 1144#if (FICL_WANT_FILE) 1145typedef struct ficlFILE 1146{ 1147 FILE *f; 1148 char filename[256]; 1149} ficlFILE; 1150#endif 1151 1152#include <sys/linker_set.h> 1153 1154typedef void ficlCompileFcn(FICL_SYSTEM *); 1155#define FICL_COMPILE_SET(func) \ 1156 DATA_SET(X4th_compile_set, func) 1157SET_DECLARE(X4th_compile_set, ficlCompileFcn); 1158 1159#ifdef LOADER_VERIEXEC 1160#include <verify_file.h> 1161#endif 1162 1163#ifdef __cplusplus 1164} 1165#endif 1166 1167#endif /* __FICL_H__ */ 1168