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