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