sys/boot/ficl/ficl.h

   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 **
   7 *******************************************************************/
   8 /*
   9 ** N O T I C E -- DISCLAIMER OF WARRANTY
  10 **
  11 ** Ficl is freeware. Use it in any way that you like, with
  12 ** the understanding that the code is supported on a "best effort"
  13 ** basis only.
  14 **
  15 ** Any third party may reproduce, distribute, or modify the ficl
  16 ** software code or any derivative  works thereof without any
  17 ** compensation or license, provided that the author information
  18 ** and this disclaimer text are retained in the source code files.
  19 ** The ficl software code is provided on an "as is"  basis without
  20 ** warranty of any kind, including, without limitation, the implied
  21 ** warranties of merchantability and fitness for a particular purpose
  22 ** and their equivalents under the laws of any jurisdiction.
  23 **
  24 ** I am interested in hearing from anyone who uses ficl. If you have
  25 ** a problem, a success story, a defect, an enhancement request, or
  26 ** if you would like to contribute to the ficl release (yay!), please
  27 ** send me email at the address above.
  28 */
  29
  30 /* $FreeBSD: src/sys/boot/ficl/ficl.h,v 1.11.2.1 2000/07/06 23:44:58 obrien Exp $ */
  31 /* $DragonFly: src/sys/boot/ficl/ficl.h,v 1.2 2003/06/17 04:28:17 dillon Exp $ */
  32
  33 #if !defined (__FICL_H__)
  34 #define __FICL_H__
  35 /*
  36 ** Ficl (Forth-inspired command language) is an ANS Forth
  37 ** interpreter written in C. Unlike traditional Forths, this
  38 ** interpreter is designed to be embedded into other systems
  39 ** as a command/macro/development prototype language.
  40 **
  41 ** Where Forths usually view themselves as the center of the system
  42 ** and expect the rest of the system to be coded in Forth, Ficl
  43 ** acts as a component of the system. It is easy to export
  44 ** code written in C or ASM to Ficl in the style of TCL, or to invoke
  45 ** Ficl code from a compiled module. This allows you to do incremental
  46 ** development in a way that combines the best features of threaded
  47 ** languages (rapid development, quick code/test/debug cycle,
  48 ** reasonably fast) with the best features of C (everyone knows it,
  49 ** easier to support large blocks of code, efficient, type checking).
  50 **
  51 ** Ficl provides facilities for interoperating
  52 ** with programs written in C: C functions can be exported to Ficl,
  53 ** and Ficl commands can be executed via a C calling interface. The
  54 ** interpreter is re-entrant, so it can be used in multiple instances
  55 ** in a multitasking system. Unlike Forth, Ficl's outer interpreter
  56 ** expects a text block as input, and returns to the caller after each
  57 ** text block, so the "data pump" is somewhere in external code. This
  58 ** is more like TCL than Forth, which usually expcets to be at the center
  59 ** of the system, requesting input at its convenience. Each Ficl virtual
  60 ** machine can be bound to a different I/O channel, and is independent
  61 ** of all others in in the same address space except that all virtual
  62 ** machines share a common dictionary (a sort or open symbol table that
  63 ** defines all of the elements of the language).
  64 **
  65 ** Code is written in ANSI C for portability.
  66 **
  67 ** Summary of Ficl features and constraints:
  68 ** - Standard: Implements the ANSI Forth CORE word set and part
  69 **   of the CORE EXT word-set, SEARCH and SEARCH EXT, TOOLS and
  70 **   TOOLS EXT, LOCAL and LOCAL ext and various extras.
  71 ** - Extensible: you can export code written in Forth, C,
  72 **   or asm in a straightforward way. Ficl provides open
  73 **   facilities for extending the language in an application
  74 **   specific way. You can even add new control structures!
  75 ** - Ficl and C can interact in two ways: Ficl can encapsulate
  76 **   C code, or C code can invoke Ficl code.
  77 ** - Thread-safe, re-entrant: The shared system dictionary
  78 **   uses a locking mechanism that you can either supply
  79 **   or stub out to provide exclusive access. Each Ficl
  80 **   virtual machine has an otherwise complete state, and
  81 **   each can be bound to a separate I/O channel (or none at all).
  82 ** - Simple encapsulation into existing systems: a basic implementation
  83 **   requires three function calls (see the example program in testmain.c).
  84 ** - ROMable: Ficl is designed to work in RAM-based and ROM code / RAM data
  85 **   environments. It does require somewhat more memory than a pure
  86 **   ROM implementation because it builds its system dictionary in
  87 **   RAM at startup time.
  88 ** - Written an ANSI C to be as simple as I can make it to understand,
  89 **   support, debug, and port. Compiles without complaint at /Az /W4
  90 **   (require ANSI C, max warnings) under Microsoft VC++ 5.
  91 ** - Does full 32 bit math (but you need to implement
  92 **   two mixed precision math primitives (see sysdep.c))
  93 ** - Indirect threaded interpreter is not the fastest kind of
  94 **   Forth there is (see pForth 68K for a really fast subroutine
  95 **   threaded interpreter), but it's the cleanest match to a
  96 **   pure C implementation.
  97 **
  98 ** P O R T I N G   F i c l
  99 **
 100 ** To install Ficl on your target system, you need an ANSI C compiler
 101 ** and its runtime library. Inspect the system dependent macros and
 102 ** functions in sysdep.h and sysdep.c and edit them to suit your
 103 ** system. For example, INT16 is a short on some compilers and an
 104 ** int on others. Check the default CELL alignment controlled by
 105 ** FICL_ALIGN. If necessary, add new definitions of ficlMalloc, ficlFree,
 106 ** ficlLockDictionary, and ficlTextOut to work with your operating system.
 107 ** Finally, use testmain.c as a guide to installing the Ficl system and
 108 ** one or more virtual machines into your code. You do not need to include
 109 ** testmain.c in your build.
 110 **
 111 ** T o   D o   L i s t
 112 **
 113 ** 1. Unimplemented system dependent CORE word: key
 114 ** 2. Kludged CORE word: ACCEPT
 115 ** 3. Dictionary locking is full of holes - only one vm at a time
 116 **    can alter the dict.
 117 ** 4. Ficl uses the pad in CORE words - this violates the standard,
 118 **    but it's cleaner for a multithreaded system. I'll have to make a
 119 **    second pad for reference by the word PAD to fix this.
 120 **
 121 ** F o r   M o r e   I n f o r m a t i o n
 122 **
 123 ** Web home of ficl
 124 **   http://www.taygeta.com/forth/compilers
 125 ** Check this website for Forth literature (including the ANSI standard)
 126 **   http://www.taygeta.com/forthlit.html
 127 ** and here for software and more links
 128 **   http://www.taygeta.com/forth.html
 129 **
 130 ** Obvious Performance enhancement opportunities
 131 ** Compile speed
 132 ** - work on interpret speed
 133 ** - turn off locals (FICL_WANT_LOCALS)
 134 ** Interpret speed
 135 ** - Change inner interpreter (and everything else)
 136 **   so that a definition is a list of pointers to functions
 137 **   and inline data rather than pointers to words. This gets
 138 **   rid of vm->runningWord and a level of indirection in the
 139 **   inner loop. I'll look at it for ficl 3.0
 140 ** - Make the main hash table a bigger prime (HASHSIZE)
 141 ** - FORGET about twiddling the hash function - my experience is
 142 **   that that is a waste of time.
 143 ** - eliminate the need to pass the pVM parameter on the stack
 144 **   by dedicating a register to it. Most words need access to the
 145 **   vm, but the parameter passing overhead can be reduced. One way
 146 **   requires that the host OS have a task switch callout. Create
 147 **   a global variable for the running VM and refer to it in words
 148 **   that need VM access. Alternative: use thread local storage.
 149 **   For single threaded implementations, you can just use a global.
 150 **   The first two solutions create portability problems, so I
 151 **   haven't considered doing them. Another possibility is to
 152 **   declare the pVm parameter to be "register", and hope the compiler
 153 **   pays attention.
 154 **
 155 */
 156
 157 /*
 158 ** Revision History:
 159 **
 160 ** 15 Apr 1999 (sadler) Merged FreeBSD changes for exception wordset and
 161 ** counted strings in ficlExec.
 162 ** 12 Jan 1999 (sobral) Corrected EVALUATE behavior. Now TIB has an
 163 ** "end" field, and all words respect this. ficlExec is passed a "size"
 164 ** of TIB, as well as vmPushTib. This size is used to calculate the "end"
 165 ** of the string, ie, base+size. If the size is not known, pass -1.
 166 **
 167 ** 10 Jan 1999 (sobral) EXCEPTION word set has been added, and existing
 168 ** words has been modified to conform to EXCEPTION EXT word set.
 169 **
 170 ** 27 Aug 1998 (sadler) testing and corrections for LOCALS, LOCALS EXT,
 171 **  SEARCH / SEARCH EXT, TOOLS / TOOLS EXT.
 172 **  Added .X to display in hex, PARSE and PARSE-WORD to supplement WORD,
 173 **  EMPTY to clear stack.
 174 **
 175 ** 29 jun 1998 (sadler) added variable sized hash table support
 176 **  and ANS Forth optional SEARCH & SEARCH EXT word set.
 177 ** 26 May 1998 (sadler)
 178 **  FICL_PROMPT macro
 179 ** 14 April 1998 (sadler) V1.04
 180 **  Ficlwin: Windows version, Skip Carter's Linux port
 181 ** 5 March 1998 (sadler) V1.03
 182 **  Bug fixes -- passes John Ryan's ANS test suite "core.fr"
 183 **
 184 ** 24 February 1998 (sadler) V1.02
 185 ** -Fixed bugs in <# # #>
 186 ** -Changed FICL_WORD so that storage for the name characters
 187 **  can be allocated from the dictionary as needed rather than
 188 **  reserving 32 bytes in each word whether needed or not -
 189 **  this saved 50% of the dictionary storage requirement.
 190 ** -Added words in testmain for Win32 functions system,chdir,cwd,
 191 **  also added a word that loads and evaluates a file.
 192 **
 193 ** December 1997 (sadler)
 194 ** -Added VM_RESTART exception handling in ficlExec -- this lets words
 195 **  that require additional text to succeed (like :, create, variable...)
 196 **  recover gracefully from an empty input buffer rather than emitting
 197 **  an error message. Definitions can span multiple input blocks with
 198 **  no restrictions.
 199 ** -Changed #include order so that <assert.h> is included in sysdep.h,
 200 **  and sysdep is included in all other files. This lets you define
 201 **  NDEBUG in sysdep.h to disable assertions if you want to.
 202 ** -Make PC specific system dependent code conditional on _M_IX86
 203 **  defined so that ports can coexist in sysdep.h/sysdep.c
 204 */
 205
 206 #ifdef __cplusplus
 207 extern "C" {
 208 #endif
 209
 210 #include "sysdep.h"
 211 #include <limits.h> /* UCHAR_MAX */
 212
 213 /*
 214 ** Forward declarations... read on.
 215 */
 216 struct ficl_word;
 217 struct vm;
 218 struct ficl_dict;
 219
 220 /*
 221 ** the Good Stuff starts here...
 222 */
 223 #define FICL_VER    "2.03"
 224 #if !defined (FICL_PROMPT)
 225 #define FICL_PROMPT "ok> "
 226 #endif
 227
 228 /*
 229 ** ANS Forth requires false to be zero, and true to be the ones
 230 ** complement of false... that unifies logical and bitwise operations
 231 ** nicely.
 232 */
 233 #define FICL_TRUE  (~(0L))
 234 #define FICL_FALSE (0)
 235 #define FICL_BOOL(x) ((x) ? FICL_TRUE : FICL_FALSE)
 236
 237
 238 /*
 239 ** A CELL is the main storage type. It must be large enough
 240 ** to contain a pointer or a scalar. In order to accommodate
 241 ** 32 bit and 64 bit processors, use abstract types for i and u.
 242 */
 243 typedef union _cell
 244 {
 245         FICL_INT i;
 246     FICL_UNS u;
 247         void *p;
 248 } CELL;
 249
 250 /*
 251 ** LVALUEtoCELL does a little pointer trickery to cast any 32 bit
 252 ** lvalue (informal definition: an expression whose result has an
 253 ** address) to CELL. Remember that constants and casts are NOT
 254 ** themselves lvalues!
 255 */
 256 #define LVALUEtoCELL(v) (*(CELL *)&v)
 257
 258 /*
 259 ** PTRtoCELL is a cast through void * intended to satisfy the
 260 ** most outrageously pedantic compiler... (I won't mention
 261 ** its name)
 262 */
 263 #define PTRtoCELL (CELL *)(void *)
 264 #define PTRtoSTRING (FICL_STRING *)(void *)
 265
 266 /*
 267 ** Strings in FICL are stored in Pascal style - with a count
 268 ** preceding the text. We'll also NULL-terminate them so that
 269 ** they work with the usual C lib string functions. (Belt &
 270 ** suspenders? You decide.)
 271 ** STRINGINFO hides the implementation with a couple of
 272 ** macros for use in internal routines.
 273 */
 274
 275 typedef unsigned char FICL_COUNT;
 276 #define FICL_STRING_MAX UCHAR_MAX
 277 typedef struct _ficl_string
 278 {
 279     FICL_COUNT count;
 280     char text[1];
 281 } FICL_STRING;
 282
 283 typedef struct
 284 {
 285     FICL_UNS count;
 286     char *cp;
 287 } STRINGINFO;
 288
 289 #define SI_COUNT(si) (si.count)
 290 #define SI_PTR(si)   (si.cp)
 291 #define SI_SETLEN(si, len) (si.count = (FICL_UNS)(len))
 292 #define SI_SETPTR(si, ptr) (si.cp = (char *)(ptr))
 293 /*
 294 ** Init a STRINGINFO from a pointer to NULL-terminated string
 295 */
 296 #define SI_PSZ(si, psz) \
 297             {si.cp = psz; si.count = (FICL_COUNT)strlen(psz);}
 298 /*
 299 ** Init a STRINGINFO from a pointer to FICL_STRING
 300 */
 301 #define SI_PFS(si, pfs) \
 302             {si.cp = pfs->text; si.count = pfs->count;}
 303
 304 /*
 305 ** Ficl uses a this little structure to hold the address of
 306 ** the block of text it's working on and an index to the next
 307 ** unconsumed character in the string. Traditionally, this is
 308 ** done by a Text Input Buffer, so I've called this struct TIB.
 309 **
 310 ** Since this structure also holds the size of the input buffer,
 311 ** and since evaluate requires that, let's put the size here.
 312 ** The size is stored as an end-pointer because that is what the
 313 ** null-terminated string aware functions find most easy to deal
 314 ** with.
 315 ** Notice, though, that nobody really uses this except evaluate,
 316 ** so it might just be moved to FICL_VM instead. (sobral)
 317 */
 318 typedef struct
 319 {
 320     FICL_INT index;
 321     char *end;
 322     char *cp;
 323 } TIB;
 324
 325
 326 /*
 327 ** Stacks get heavy use in Ficl and Forth...
 328 ** Each virtual machine implements two of them:
 329 ** one holds parameters (data), and the other holds return
 330 ** addresses and control flow information for the virtual
 331 ** machine. (Note: C's automatic stack is implicitly used,
 332 ** but not modeled because it doesn't need to be...)
 333 ** Here's an abstract type for a stack
 334 */
 335 typedef struct _ficlStack
 336 {
 337     FICL_UNS nCells;    /* size of the stack */
 338     CELL *pFrame;       /* link reg for stack frame */
 339     CELL *sp;           /* stack pointer */
 340     CELL base[1];       /* Bottom of the stack */
 341 } FICL_STACK;
 342
 343 /*
 344 ** Stack methods... many map closely to required Forth words.
 345 */
 346 FICL_STACK *stackCreate(unsigned nCells);
 347 void        stackDelete(FICL_STACK *pStack);
 348 int         stackDepth (FICL_STACK *pStack);
 349 void        stackDrop  (FICL_STACK *pStack, int n);
 350 CELL        stackFetch (FICL_STACK *pStack, int n);
 351 CELL        stackGetTop(FICL_STACK *pStack);
 352 void        stackLink  (FICL_STACK *pStack, int nCells);
 353 void        stackPick  (FICL_STACK *pStack, int n);
 354 CELL        stackPop   (FICL_STACK *pStack);
 355 void       *stackPopPtr   (FICL_STACK *pStack);
 356 FICL_UNS    stackPopUNS(FICL_STACK *pStack);
 357 FICL_INT    stackPopINT(FICL_STACK *pStack);
 358 void        stackPush  (FICL_STACK *pStack, CELL c);
 359 void        stackPushPtr  (FICL_STACK *pStack, void *ptr);
 360 void        stackPushUNS(FICL_STACK *pStack, FICL_UNS u);
 361 void        stackPushINT(FICL_STACK *pStack, FICL_INT i);
 362 void        stackReset (FICL_STACK *pStack);
 363 void        stackRoll  (FICL_STACK *pStack, int n);
 364 void        stackSetTop(FICL_STACK *pStack, CELL c);
 365 void        stackStore (FICL_STACK *pStack, int n, CELL c);
 366 void        stackUnlink(FICL_STACK *pStack);
 367
 368 /*
 369 ** The virtual machine (VM) contains the state for one interpreter.
 370 ** Defined operations include:
 371 ** Create & initialize
 372 ** Delete
 373 ** Execute a block of text
 374 ** Parse a word out of the input stream
 375 ** Call return, and branch
 376 ** Text output
 377 ** Throw an exception
 378 */
 379
 380 typedef struct ficl_word ** IPTYPE; /* the VM's instruction pointer */
 381
 382 /*
 383 ** Each VM has a placeholder for an output function -
 384 ** this makes it possible to have each VM do I/O
 385 ** through a different device. If you specify no
 386 ** OUTFUNC, it defaults to ficlTextOut.
 387 */
 388 typedef void (*OUTFUNC)(struct vm *pVM, char *text, int fNewline);
 389
 390 /*
 391 ** Each VM operates in one of two non-error states: interpreting
 392 ** or compiling. When interpreting, words are simply executed.
 393 ** When compiling, most words in the input stream have their
 394 ** addresses inserted into the word under construction. Some words
 395 ** (known as IMMEDIATE) are executed in the compile state, too.
 396 */
 397 /* values of STATE */
 398 #define INTERPRET 0
 399 #define COMPILE   1
 400
 401 /*
 402 ** The pad is a small scratch area for text manipulation. ANS Forth
 403 ** requires it to hold at least 84 characters.
 404 */
 405 #if !defined nPAD
 406 #define nPAD 256
 407 #endif
 408
 409 /*
 410 ** ANS Forth requires that a word's name contain {1..31} characters.
 411 */
 412 #if !defined nFICLNAME
 413 #define nFICLNAME               31
 414 #endif
 415
 416 /*
 417 ** OK - now we can really define the VM...
 418 */
 419 typedef struct vm
 420 {
 421     struct vm      *link;       /* Ficl keeps a VM list for simple teardown */
 422     jmp_buf        *pState;     /* crude exception mechanism...     */
 423     OUTFUNC         textOut;    /* Output callback - see sysdep.c   */
 424     void *          pExtend;    /* vm extension pointer             */
 425     short           fRestart;   /* Set TRUE to restart runningWord  */
 426     IPTYPE          ip;         /* instruction pointer              */
 427     struct ficl_word
 428                    *runningWord;/* address of currently running word (often just *(ip-1) ) */
 429     FICL_UNS        state;      /* compiling or interpreting        */
 430     FICL_UNS        base;       /* number conversion base           */
 431     FICL_STACK     *pStack;     /* param stack                      */
 432     FICL_STACK     *rStack;     /* return stack                     */
 433     CELL            sourceID;   /* -1 if string, 0 if normal input  */
 434     TIB             tib;        /* address of incoming text string  */
 435 #if FICL_WANT_USER
 436     CELL            user[FICL_USER_CELLS];
 437 #endif
 438     char            pad[nPAD];  /* the scratch area (see above)     */
 439 } FICL_VM;
 440
 441 /*
 442 ** A FICL_CODE points to a function that gets called to help execute
 443 ** a word in the dictionary. It always gets passed a pointer to the
 444 ** running virtual machine, and from there it can get the address
 445 ** of the parameter area of the word it's supposed to operate on.
 446 ** For precompiled words, the code is all there is. For user defined
 447 ** words, the code assumes that the word's parameter area is a list
 448 ** of pointers to the code fields of other words to execute, and
 449 ** may also contain inline data. The first parameter is always
 450 ** a pointer to a code field.
 451 */
 452 typedef void (*FICL_CODE)(FICL_VM *pVm);
 453
 454 #if 0
 455 #define VM_ASSERT(pVM) assert((*(pVM->ip - 1)) == pVM->runningWord)
 456 #else
 457 #define VM_ASSERT(pVM)
 458 #endif
 459
 460 /*
 461 ** Ficl models memory as a contiguous space divided into
 462 ** words in a linked list called the dictionary.
 463 ** A FICL_WORD starts each entry in the list.
 464 ** Version 1.02: space for the name characters is allotted from
 465 ** the dictionary ahead of the word struct - this saves about half
 466 ** the storage on average with very little runtime cost.
 467 */
 468 typedef struct ficl_word
 469 {
 470     struct ficl_word *link;     /* Previous word in the dictionary      */
 471     UNS16 hash;
 472     UNS8 flags;                 /* Immediate, Smudge, Compile-only      */
 473     FICL_COUNT nName;           /* Number of chars in word name         */
 474     char *name;                 /* First nFICLNAME chars of word name   */
 475     FICL_CODE code;             /* Native code to execute the word      */
 476     CELL param[1];              /* First data cell of the word          */
 477 } FICL_WORD;
 478
 479 /*
 480 ** Worst-case size of a word header: nFICLNAME chars in name
 481 */
 482 #define CELLS_PER_WORD  \
 483     ( (sizeof (FICL_WORD) + nFICLNAME + sizeof (CELL)) \
 484                           / (sizeof (CELL)) )
 485
 486 int wordIsImmediate(FICL_WORD *pFW);
 487 int wordIsCompileOnly(FICL_WORD *pFW);
 488
 489 /* flag values for word header */
 490 #define FW_IMMEDIATE    1   /* execute me even if compiling */
 491 #define FW_COMPILE      2   /* error if executed when not compiling */
 492 #define FW_SMUDGE       4   /* definition in progress - hide me */
 493 #define FW_CLASS        8   /* Word defines a class */
 494
 495 #define FW_COMPIMMED    (FW_IMMEDIATE | FW_COMPILE)
 496 #define FW_DEFAULT      0
 497
 498
 499 /*
 500 ** Exit codes for vmThrow
 501 */
 502 #define VM_INNEREXIT -256   /* tell ficlExecXT to exit inner loop */
 503 #define VM_OUTOFTEXT -257   /* hungry - normal exit */
 504 #define VM_RESTART   -258   /* word needs more text to succeed - re-run it */
 505 #define VM_USEREXIT  -259   /* user wants to quit */
 506 #define VM_ERREXIT   -260   /* interp found an error */
 507 #define VM_ABORT       -1   /* like errexit -- abort */
 508 #define VM_ABORTQ      -2   /* like errexit -- abort" */
 509 #define VM_QUIT       -56   /* like errexit, but leave pStack & base alone */
 510
 511
 512 void        vmBranchRelative(FICL_VM *pVM, int offset);
 513 FICL_VM *   vmCreate (FICL_VM *pVM, unsigned nPStack, unsigned nRStack);
 514 void        vmDelete (FICL_VM *pVM);
 515 void        vmExecute(FICL_VM *pVM, FICL_WORD *pWord);
 516 char *      vmGetString(FICL_VM *pVM, FICL_STRING *spDest, char delimiter);
 517 STRINGINFO  vmGetWord(FICL_VM *pVM);
 518 STRINGINFO  vmGetWord0(FICL_VM *pVM);
 519 int         vmGetWordToPad(FICL_VM *pVM);
 520 STRINGINFO  vmParseString(FICL_VM *pVM, char delimiter);
 521 STRINGINFO  vmParseStringEx(FICL_VM *pVM, char delimiter, char fSkipLeading);
 522 CELL        vmPop(FICL_VM *pVM);
 523 void        vmPush(FICL_VM *pVM, CELL c);
 524 void        vmPopIP  (FICL_VM *pVM);
 525 void        vmPushIP (FICL_VM *pVM, IPTYPE newIP);
 526 void        vmQuit   (FICL_VM *pVM);
 527 void        vmReset  (FICL_VM *pVM);
 528 void        vmSetTextOut(FICL_VM *pVM, OUTFUNC textOut);
 529 #if FICL_WANT_DEBUGGER
 530 void        vmStep(FICL_VM *pVM);
 531 #endif
 532 void        vmTextOut(FICL_VM *pVM, char *text, int fNewline);
 533 void        vmThrow  (FICL_VM *pVM, int except);
 534 void        vmThrowErr(FICL_VM *pVM, char *fmt, ...);
 535
 536 #define vmGetRunningWord(pVM) ((pVM)->runningWord)
 537
 538
 539 /*
 540 ** The inner interpreter - coded as a macro (see note for
 541 ** INLINE_INNER_LOOP in sysdep.h for complaints about VC++ 5
 542 */
 543 #define M_VM_STEP(pVM) \
 544         FICL_WORD *tempFW = *(pVM)->ip++; \
 545         (pVM)->runningWord = tempFW; \
 546         tempFW->code(pVM); \
 547
 548 #define M_INNER_LOOP(pVM) \
 549     for (;;)  { M_VM_STEP(pVM) }
 550
 551
 552 #if INLINE_INNER_LOOP != 0
 553 #define     vmInnerLoop(pVM) M_INNER_LOOP(pVM)
 554 #else
 555 void        vmInnerLoop(FICL_VM *pVM);
 556 #endif
 557
 558 /*
 559 ** vmCheckStack needs a vm pointer because it might have to say
 560 ** something if it finds a problem. Parms popCells and pushCells
 561 ** correspond to the number of parameters on the left and right of
 562 ** a word's stack effect comment.
 563 */
 564 void        vmCheckStack(FICL_VM *pVM, int popCells, int pushCells);
 565
 566 /*
 567 ** TIB access routines...
 568 ** ANS forth seems to require the input buffer to be represented
 569 ** as a pointer to the start of the buffer, and an index to the
 570 ** next character to read.
 571 ** PushTib points the VM to a new input string and optionally
 572 **  returns a copy of the current state
 573 ** PopTib restores the TIB state given a saved TIB from PushTib
 574 ** GetInBuf returns a pointer to the next unused char of the TIB
 575 */
 576 void        vmPushTib(FICL_VM *pVM, char *text, FICL_INT nChars, TIB *pSaveTib);
 577 void        vmPopTib(FICL_VM *pVM, TIB *pTib);
 578 #define     vmGetInBuf(pVM) ((pVM)->tib.cp + (pVM)->tib.index)
 579 #define     vmGetInBufLen(pVM) ((pVM)->tib.end - (pVM)->tib.cp)
 580 #define     vmGetInBufEnd(pVM) ((pVM)->tib.end)
 581 #define     vmSetTibIndex(pVM, i) (pVM)->tib.index = i
 582 #define     vmUpdateTib(pVM, str) (pVM)->tib.index = (str) - (pVM)->tib.cp
 583
 584 /*
 585 ** Generally useful string manipulators omitted by ANSI C...
 586 ** ltoa complements strtol
 587 */
 588 #if defined(_WIN32) && !FICL_MAIN
 589 /* #SHEESH
 590 ** Why do Microsoft Meatballs insist on contaminating
 591 ** my namespace with their string functions???
 592 */
 593 #pragma warning(disable: 4273)
 594 #endif
 595
 596 int        isPowerOfTwo(FICL_UNS u);
 597
 598 char       *ltoa( FICL_INT value, char *string, int radix );
 599 char       *ultoa(FICL_UNS value, char *string, int radix );
 600 char        digit_to_char(int value);
 601 char       *strrev( char *string );
 602 char       *skipSpace(char *cp, char *end);
 603 char       *caseFold(char *cp);
 604 int         strincmp(char *cp1, char *cp2, FICL_COUNT count);
 605
 606 #if defined(_WIN32) && !FICL_MAIN
 607 #pragma warning(default: 4273)
 608 #endif
 609
 610 /*
 611 ** Ficl hash table - variable size.
 612 ** assert(size > 0)
 613 ** If size is 1, the table degenerates into a linked list.
 614 ** A WORDLIST (see the search order word set in DPANS) is
 615 ** just a pointer to a FICL_HASH in this implementation.
 616 */
 617 #if !defined HASHSIZE /* Default size of hash table. For most uniform */
 618 #define HASHSIZE 127  /*   performance, use a prime number!   */
 619 #endif
 620
 621 typedef struct ficl_hash
 622 {
 623     struct ficl_hash *link;  /* eventual inheritance support */
 624     unsigned   size;
 625     FICL_WORD *table[1];
 626 } FICL_HASH;
 627
 628 void        hashForget(FICL_HASH *pHash, void *where);
 629 UNS16       hashHashCode(STRINGINFO si);
 630 void        hashInsertWord(FICL_HASH *pHash, FICL_WORD *pFW);
 631 FICL_WORD  *hashLookup(struct ficl_hash *pHash,
 632                        STRINGINFO si,
 633                        UNS16 hashCode);
 634 void        hashReset(FICL_HASH *pHash);
 635
 636 /*
 637 ** A Dictionary is a linked list of FICL_WORDs. It is also Ficl's
 638 ** memory model. Description of fields:
 639 **
 640 ** here -- points to the next free byte in the dictionary. This
 641 **      pointer is forced to be CELL-aligned before a definition is added.
 642 **      Do not assume any specific alignment otherwise - Use dictAlign().
 643 **
 644 ** smudge -- pointer to word currently being defined (or last defined word)
 645 **      If the definition completes successfully, the word will be
 646 **      linked into the hash table. If unsuccessful, dictUnsmudge
 647 **      uses this pointer to restore the previous state of the dictionary.
 648 **      Smudge prevents unintentional recursion as a side-effect: the
 649 **      dictionary search algo examines only completed definitions, so a
 650 **      word cannot invoke itself by name. See the ficl word "recurse".
 651 **      NOTE: smudge always points to the last word defined. IMMEDIATE
 652 **      makes use of this fact. Smudge is initially NULL.
 653 **
 654 ** pForthWords -- pointer to the default wordlist (FICL_HASH).
 655 **      This is the initial compilation list, and contains all
 656 **      ficl's precompiled words.
 657 **
 658 ** pCompile -- compilation wordlist - initially equal to pForthWords
 659 ** pSearch  -- array of pointers to wordlists. Managed as a stack.
 660 **      Highest index is the first list in the search order.
 661 ** nLists   -- number of lists in pSearch. nLists-1 is the highest
 662 **      filled slot in pSearch, and points to the first wordlist
 663 **      in the search order
 664 ** size -- number of cells in the dictionary (total)
 665 ** dict -- start of data area. Must be at the end of the struct.
 666 */
 667 typedef struct ficl_dict
 668 {
 669     CELL *here;
 670     FICL_WORD *smudge;
 671     FICL_HASH *pForthWords;
 672     FICL_HASH *pCompile;
 673     FICL_HASH *pSearch[FICL_DEFAULT_VOCS];
 674     int        nLists;
 675     unsigned   size;    /* Number of cells in dict (total)*/
 676     CELL       *dict;   /* Base of dictionary memory      */
 677 } FICL_DICT;
 678
 679 void       *alignPtr(void *ptr);
 680 void        dictAbortDefinition(FICL_DICT *pDict);
 681 void        dictAlign(FICL_DICT *pDict);
 682 int         dictAllot(FICL_DICT *pDict, int n);
 683 int         dictAllotCells(FICL_DICT *pDict, int nCells);
 684 void        dictAppendCell(FICL_DICT *pDict, CELL c);
 685 void        dictAppendChar(FICL_DICT *pDict, char c);
 686 FICL_WORD  *dictAppendWord(FICL_DICT *pDict,
 687                            char *name,
 688                            FICL_CODE pCode,
 689                            UNS8 flags);
 690 FICL_WORD  *dictAppendWord2(FICL_DICT *pDict,
 691                            STRINGINFO si,
 692                            FICL_CODE pCode,
 693                            UNS8 flags);
 694 void        dictAppendUNS(FICL_DICT *pDict, FICL_UNS u);
 695 int         dictCellsAvail(FICL_DICT *pDict);
 696 int         dictCellsUsed (FICL_DICT *pDict);
 697 void        dictCheck(FICL_DICT *pDict, FICL_VM *pVM, int nCells);
 698 FICL_DICT  *dictCreate(unsigned nCELLS);
 699 FICL_DICT  *dictCreateHashed(unsigned nCells, unsigned nHash);
 700 void        dictDelete(FICL_DICT *pDict);
 701 void        dictEmpty(FICL_DICT *pDict, unsigned nHash);
 702 int         dictIncludes(FICL_DICT *pDict, void *p);
 703 FICL_WORD  *dictLookup(FICL_DICT *pDict, STRINGINFO si);
 704 #if FICL_WANT_LOCALS
 705 FICL_WORD  *dictLookupLoc(FICL_DICT *pDict, STRINGINFO si);
 706 #endif
 707 void        dictResetSearchOrder(FICL_DICT *pDict);
 708 void        dictSetFlags(FICL_DICT *pDict, UNS8 set, UNS8 clr);
 709 void        dictSetImmediate(FICL_DICT *pDict);
 710 void        dictUnsmudge(FICL_DICT *pDict);
 711 CELL       *dictWhere(FICL_DICT *pDict);
 712
 713
 714 /*
 715 ** External interface to FICL...
 716 */
 717 /*
 718 ** f i c l I n i t S y s t e m
 719 ** Binds a global dictionary to the interpreter system and initializes
 720 ** the dict to contain the ANSI CORE wordset.
 721 ** You specify the address and size of the allocated area.
 722 ** After that, ficl manages it.
 723 ** First step is to set up the static pointers to the area.
 724 ** Then write the "precompiled" portion of the dictionary in.
 725 ** The dictionary needs to be at least large enough to hold the
 726 ** precompiled part. Try 1K cells minimum. Use "words" to find
 727 ** out how much of the dictionary is used at any time.
 728 */
 729 void       ficlInitSystem(int nDictCells);
 730
 731 /*
 732 ** f i c l T e r m S y s t e m
 733 ** Deletes the system dictionary and all virtual machines that
 734 ** were created with ficlNewVM (see below). Call this function to
 735 ** reclaim all memory used by the dictionary and VMs.
 736 */
 737 void       ficlTermSystem(void);
 738
 739 /*
 740 ** f i c l E x e c
 741 ** Evaluates a block of input text in the context of the
 742 ** specified interpreter. Emits any requested output to the
 743 ** interpreter's output function. If the input string is NULL
 744 ** terminated, you can pass -1 as nChars rather than count it.
 745 ** Execution returns when the text block has been executed,
 746 ** or an error occurs.
 747 ** Returns one of the VM_XXXX codes defined in ficl.h:
 748 ** VM_OUTOFTEXT is the normal exit condition
 749 ** VM_ERREXIT means that the interp encountered a syntax error
 750 **      and the vm has been reset to recover (some or all
 751 **      of the text block got ignored
 752 ** VM_USEREXIT means that the user executed the "bye" command
 753 **      to shut down the interpreter. This would be a good
 754 **      time to delete the vm, etc -- or you can ignore this
 755 **      signal.
 756 ** VM_ABORT and VM_ABORTQ are generated by 'abort' and 'abort"'
 757 **      commands.
 758 ** Preconditions: successful execution of ficlInitSystem,
 759 **      Successful creation and init of the VM by ficlNewVM (or equiv)
 760 */
 761 int        ficlExec (FICL_VM *pVM, char *pText);
 762 int        ficlExecC(FICL_VM *pVM, char *pText, FICL_INT nChars);
 763 int        ficlExecXT(FICL_VM *pVM, FICL_WORD *pWord);
 764
 765 /*
 766 ** ficlExecFD(FICL_VM *pVM, int fd);
 767  * Evaluates text from file passed in via fd.
 768  * Execution returns when all of file has been executed or an
 769  * error occurs.
 770  */
 771 int        ficlExecFD(FICL_VM *pVM, int fd);
 772
 773 /*
 774 ** Create a new VM from the heap, and link it into the system VM list.
 775 ** Initializes the VM and binds default sized stacks to it. Returns the
 776 ** address of the VM, or NULL if an error occurs.
 777 ** Precondition: successful execution of ficlInitSystem
 778 */
 779 FICL_VM   *ficlNewVM(void);
 780
 781 /*
 782 ** Force deletion of a VM. You do not need to do this
 783 ** unless you're creating and discarding a lot of VMs.
 784 ** For systems that use a constant pool of VMs for the life
 785 ** of the system, ficltermSystem takes care of VM cleanup
 786 ** automatically.
 787 */
 788 void ficlFreeVM(FICL_VM *pVM);
 789
 790
 791 /*
 792 ** Set the stack sizes (return and parameter) to be used for all
 793 ** subsequently created VMs. Returns actual stack size to be used.
 794 */
 795 int ficlSetStackSize(int nStackCells);
 796
 797 /*
 798 ** Returns the address of the most recently defined word in the system
 799 ** dictionary with the given name, or NULL if no match.
 800 ** Precondition: successful execution of ficlInitSystem
 801 */
 802 FICL_WORD *ficlLookup(char *name);
 803
 804 /*
 805 ** f i c l G e t D i c t
 806 ** Utility function - returns the address of the system dictionary.
 807 ** Precondition: successful execution of ficlInitSystem
 808 */
 809 FICL_DICT *ficlGetDict(void);
 810 FICL_DICT *ficlGetEnv(void);
 811 void       ficlSetEnv(char *name, FICL_UNS value);
 812 void       ficlSetEnvD(char *name, FICL_UNS hi, FICL_UNS lo);
 813 #if FICL_WANT_LOCALS
 814 FICL_DICT *ficlGetLoc(void);
 815 #endif
 816 /*
 817 ** f i c l B u i l d
 818 ** Builds a word into the system default dictionary in a thread-safe way.
 819 ** Preconditions: system must be initialized, and there must
 820 ** be enough space for the new word's header! Operation is
 821 ** controlled by ficlLockDictionary, so any initialization
 822 ** required by your version of the function (if you "overrode"
 823 ** it) must be complete at this point.
 824 ** Parameters:
 825 ** name  -- the name of the word to be built
 826 ** code  -- code to execute when the word is invoked - must take a single param
 827 **          pointer to a FICL_VM
 828 ** flags -- 0 or more of FW_IMMEDIATE, FW_COMPILE, use bitwise OR!
 829 **          Most words can use FW_DEFAULT.
 830 ** nAllot - number of extra cells to allocate in the parameter area (usually zero)
 831 */
 832 int        ficlBuild(char *name, FICL_CODE code, char flags);
 833
 834 /*
 835 ** f i c l C o m p i l e C o r e
 836 ** Builds the ANS CORE wordset into the dictionary - called by
 837 ** ficlInitSystem - no need to waste dict space by doing it again.
 838 */
 839 void       ficlCompileCore(FICL_DICT *dp);
 840 void       ficlCompileSoftCore(FICL_VM *pVM);
 841
 842 /*
 843 ** from words.c...
 844 */
 845 void       constantParen(FICL_VM *pVM);
 846 void       twoConstParen(FICL_VM *pVM);
 847
 848 /*
 849 ** Dictionary on-demand resizing
 850 */
 851 extern unsigned int dictThreshold;
 852 extern unsigned int dictIncrease;
 853
 854 /*
 855 ** So we can more easily debug...
 856 */
 857 #ifdef FICL_TRACE
 858 extern int ficl_trace;
 859 #endif
 860
 861 /*
 862 ** Various FreeBSD goodies
 863 */
 864
 865 #if defined(__i386__) && !defined(TESTMAIN)
 866 extern void ficlOutb(FICL_VM *pVM);
 867 extern void ficlInb(FICL_VM *pVM);
 868 #endif
 869
 870 #if !defined(TESTMAIN)
 871 extern void ficlSetenv(FICL_VM *pVM);
 872 extern void ficlSetenvq(FICL_VM *pVM);
 873 extern void ficlGetenv(FICL_VM *pVM);
 874 extern void ficlUnsetenv(FICL_VM *pVM);
 875 extern void ficlCopyin(FICL_VM *pVM);
 876 extern void ficlCopyout(FICL_VM *pVM);
 877 #endif
 878
 879 #ifdef __cplusplus
 880 }
 881 #endif
 882
 883 #endif /* __FICL_H__ */