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 ** 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$ */
  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
 217 extern "C" {
 218 #endif
 219
 220 #include "sysdep.h"
 221 #include <limits.h> /* UCHAR_MAX */
 222
 223 /*
 224 ** Forward declarations... read on.
 225 */
 226 struct ficl_word;
 227 typedef struct ficl_word FICL_WORD;
 228 struct vm;
 229 typedef struct vm FICL_VM;
 230 struct ficl_dict;
 231 typedef struct ficl_dict FICL_DICT;
 232 struct ficl_system;
 233 typedef struct ficl_system FICL_SYSTEM;
 234 struct ficl_system_info;
 235 typedef 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 */
 263 typedef 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
 299 typedef unsigned char FICL_COUNT;
 300 #define FICL_STRING_MAX UCHAR_MAX
 301 typedef struct _ficl_string
 302 {
 303     FICL_COUNT count;
 304     char text[1];
 305 } FICL_STRING;
 306
 307 typedef 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 */
 342 typedef 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 */
 359 typedef 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 */
 370 FICL_STACK *stackCreate   (unsigned nCells);
 371 void        stackDelete   (FICL_STACK *pStack);
 372 int         stackDepth    (FICL_STACK *pStack);
 373 void        stackDrop     (FICL_STACK *pStack, int n);
 374 CELL        stackFetch    (FICL_STACK *pStack, int n);
 375 CELL        stackGetTop   (FICL_STACK *pStack);
 376 void        stackLink     (FICL_STACK *pStack, int nCells);
 377 void        stackPick     (FICL_STACK *pStack, int n);
 378 CELL        stackPop      (FICL_STACK *pStack);
 379 void       *stackPopPtr   (FICL_STACK *pStack);
 380 FICL_UNS    stackPopUNS   (FICL_STACK *pStack);
 381 FICL_INT    stackPopINT   (FICL_STACK *pStack);
 382 void        stackPush     (FICL_STACK *pStack, CELL c);
 383 void        stackPushPtr  (FICL_STACK *pStack, void *ptr);
 384 void        stackPushUNS  (FICL_STACK *pStack, FICL_UNS u);
 385 void        stackPushINT  (FICL_STACK *pStack, FICL_INT i);
 386 void        stackReset    (FICL_STACK *pStack);
 387 void        stackRoll     (FICL_STACK *pStack, int n);
 388 void        stackSetTop   (FICL_STACK *pStack, CELL c);
 389 void        stackStore    (FICL_STACK *pStack, int n, CELL c);
 390 void        stackUnlink   (FICL_STACK *pStack);
 391
 392 #if (FICL_WANT_FLOAT)
 393 float       stackPopFloat (FICL_STACK *pStack);
 394 void        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
 436 typedef 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 */
 444 typedef 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 */
 475 struct 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 */
 511 typedef 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 */
 527 struct 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
 545 int wordIsImmediate(FICL_WORD *pFW);
 546 int 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
 572 void        vmBranchRelative(FICL_VM *pVM, int offset);
 573 FICL_VM *   vmCreate       (FICL_VM *pVM, unsigned nPStack, unsigned nRStack);
 574 void        vmDelete       (FICL_VM *pVM);
 575 void        vmExecute      (FICL_VM *pVM, FICL_WORD *pWord);
 576 FICL_DICT  *vmGetDict      (FICL_VM *pVM);
 577 char *      vmGetString    (FICL_VM *pVM, FICL_STRING *spDest, char delimiter);
 578 STRINGINFO  vmGetWord      (FICL_VM *pVM);
 579 STRINGINFO  vmGetWord0     (FICL_VM *pVM);
 580 int         vmGetWordToPad (FICL_VM *pVM);
 581 STRINGINFO  vmParseString  (FICL_VM *pVM, char delimiter);
 582 STRINGINFO  vmParseStringEx(FICL_VM *pVM, char delimiter, char fSkipLeading);
 583 CELL        vmPop          (FICL_VM *pVM);
 584 void        vmPush         (FICL_VM *pVM, CELL c);
 585 void        vmPopIP        (FICL_VM *pVM);
 586 void        vmPushIP       (FICL_VM *pVM, IPTYPE newIP);
 587 void        vmQuit         (FICL_VM *pVM);
 588 void        vmReset        (FICL_VM *pVM);
 589 void        vmSetTextOut   (FICL_VM *pVM, OUTFUNC textOut);
 590 void        vmTextOut      (FICL_VM *pVM, char *text, int fNewline);
 591 void        vmTextOut      (FICL_VM *pVM, char *text, int fNewline);
 592 void        vmThrow        (FICL_VM *pVM, int except);
 593 void        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
 614 void        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 */
 623 void        vmCheckStack(FICL_VM *pVM, int popCells, int pushCells);
 624 #if FICL_WANT_FLOAT
 625 void        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 */
 638 void        vmPushTib  (FICL_VM *pVM, char *text, FICL_INT nChars, TIB *pSaveTib);
 639 void        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
 659 int        isPowerOfTwo(FICL_UNS u);
 660
 661 char       *ltoa( FICL_INT value, char *string, int radix );
 662 char       *ultoa(FICL_UNS value, char *string, int radix );
 663 char        digit_to_char(int value);
 664 char       *strrev( char *string );
 665 char       *skipSpace(char *cp, char *end);
 666 char       *caseFold(char *cp);
 667 int         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
 684 typedef 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
 692 void        hashForget    (FICL_HASH *pHash, void *where);
 693 UNS16       hashHashCode  (STRINGINFO si);
 694 void        hashInsertWord(FICL_HASH *pHash, FICL_WORD *pFW);
 695 FICL_WORD  *hashLookup    (FICL_HASH *pHash, STRINGINFO si, UNS16 hashCode);
 696 void        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 */
 729 struct 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
 741 void       *alignPtr(void *ptr);
 742 void        dictAbortDefinition(FICL_DICT *pDict);
 743 void        dictAlign      (FICL_DICT *pDict);
 744 int         dictAllot      (FICL_DICT *pDict, int n);
 745 int         dictAllotCells (FICL_DICT *pDict, int nCells);
 746 void        dictAppendCell (FICL_DICT *pDict, CELL c);
 747 void        dictAppendChar (FICL_DICT *pDict, char c);
 748 FICL_WORD  *dictAppendWord (FICL_DICT *pDict,
 749                            char *name,
 750                            FICL_CODE pCode,
 751                            UNS8 flags);
 752 FICL_WORD  *dictAppendWord2(FICL_DICT *pDict,
 753                            STRINGINFO si,
 754                            FICL_CODE pCode,
 755                            UNS8 flags);
 756 void        dictAppendUNS  (FICL_DICT *pDict, FICL_UNS u);
 757 int         dictCellsAvail (FICL_DICT *pDict);
 758 int         dictCellsUsed  (FICL_DICT *pDict);
 759 void        dictCheck      (FICL_DICT *pDict, FICL_VM *pVM, int n);
 760 FICL_DICT  *dictCreate(unsigned nCELLS);
 761 FICL_DICT  *dictCreateHashed(unsigned nCells, unsigned nHash);
 762 FICL_HASH  *dictCreateWordlist(FICL_DICT *dp, int nBuckets);
 763 void        dictDelete     (FICL_DICT *pDict);
 764 void        dictEmpty      (FICL_DICT *pDict, unsigned nHash);
 765 #if FICL_WANT_FLOAT
 766 void        dictHashSummary(FICL_VM *pVM);
 767 #endif
 768 int         dictIncludes   (FICL_DICT *pDict, void *p);
 769 FICL_WORD  *dictLookup     (FICL_DICT *pDict, STRINGINFO si);
 770 #if FICL_WANT_LOCALS
 771 FICL_WORD  *ficlLookupLoc  (FICL_SYSTEM *pSys, STRINGINFO si);
 772 #endif
 773 void        dictResetSearchOrder(FICL_DICT *pDict);
 774 void        dictSetFlags   (FICL_DICT *pDict, UNS8 set, UNS8 clr);
 775 void        dictSetImmediate(FICL_DICT *pDict);
 776 void        dictUnsmudge   (FICL_DICT *pDict);
 777 CELL       *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
 800 typedef 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 */
 809 int  ficlAddParseStep(FICL_SYSTEM *pSys, FICL_WORD *pFW); /* ficl.c */
 810 void ficlAddPrecompiledParseStep(FICL_SYSTEM *pSys, char *name, FICL_PARSE_STEP pStep);
 811 void 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 */
 823 typedef 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 */
 841 struct 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
 890 struct 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 */
 919 FICL_SYSTEM *ficlInitSystemEx(FICL_SYSTEM_INFO *fsi);
 920
 921 /* Deprecated call */
 922 FICL_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 */
 930 void       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 */
 940 int        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 */
 968 int        ficlExec (FICL_VM *pVM, char *pText);
 969 int        ficlExecC(FICL_VM *pVM, char *pText, FICL_INT nChars);
 970 int        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  */
 978 int        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 */
 986 FICL_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 */
 995 void 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 */
1002 int 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 */
1009 FICL_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 */
1016 FICL_DICT *ficlGetDict(FICL_SYSTEM *pSys);
1017 FICL_DICT *ficlGetEnv (FICL_SYSTEM *pSys);
1018 void       ficlSetEnv (FICL_SYSTEM *pSys, char *name, FICL_UNS value);
1019 void       ficlSetEnvD(FICL_SYSTEM *pSys, char *name, FICL_UNS hi, FICL_UNS lo);
1020 #if FICL_WANT_LOCALS
1021 FICL_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 */
1039 int        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 */
1046 void       ficlCompileCore(FICL_SYSTEM *pSys);
1047 void       ficlCompilePrefix(FICL_SYSTEM *pSys);
1048 void       ficlCompileSearch(FICL_SYSTEM *pSys);
1049 void       ficlCompileSoftCore(FICL_SYSTEM *pSys);
1050 void       ficlCompileTools(FICL_SYSTEM *pSys);
1051 void       ficlCompileFile(FICL_SYSTEM *pSys);
1052 #if FICL_WANT_FLOAT
1053 void       ficlCompileFloat(FICL_SYSTEM *pSys);
1054 int        ficlParseFloatNumber( FICL_VM *pVM, STRINGINFO si ); /* float.c */
1055 #endif
1056 #if FICL_PLATFORM_EXTEND
1057 void       ficlCompilePlatform(FICL_SYSTEM *pSys);
1058 #endif
1059 int        ficlParsePrefix(FICL_VM *pVM, STRINGINFO si);
1060
1061 /*
1062 ** from words.c...
1063 */
1064 void       constantParen(FICL_VM *pVM);
1065 void       twoConstParen(FICL_VM *pVM);
1066 int        ficlParseNumber(FICL_VM *pVM, STRINGINFO si);
1067 void       ficlTick(FICL_VM *pVM);
1068 void       parseStepParen(FICL_VM *pVM);
1069
1070 /*
1071 ** From tools.c
1072 */
1073 int        isAFiclWord(FICL_DICT *pd, FICL_WORD *pFW);
1074
1075 /*
1076 ** The following supports SEE and the debugger.
1077 */
1078 typedef 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
1100 WORDKIND   ficlWordClassify(FICL_WORD *pFW);
1101
1102 /*
1103 ** Dictionary on-demand resizing
1104 */
1105 extern CELL dictThreshold;
1106 extern CELL dictIncrease;
1107
1108 /*
1109 ** Various FreeBSD goodies
1110 */
1111
1112 #if defined(__i386__) && !defined(TESTMAIN)
1113 extern void ficlOutb(FICL_VM *pVM);
1114 extern void ficlInb(FICL_VM *pVM);
1115 #endif
1116
1117 extern void ficlSetenv(FICL_VM *pVM);
1118 extern void ficlSetenvq(FICL_VM *pVM);
1119 extern void ficlGetenv(FICL_VM *pVM);
1120 extern void ficlUnsetenv(FICL_VM *pVM);
1121 extern void ficlCopyin(FICL_VM *pVM);
1122 extern void ficlCopyout(FICL_VM *pVM);
1123 extern void ficlFindfile(FICL_VM *pVM);
1124 extern void ficlCcall(FICL_VM *pVM);
1125 #if !defined(TESTMAIN)
1126 extern void ficlPnpdevices(FICL_VM *pVM);
1127 extern void ficlPnphandlers(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)
1142 typedef 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__ */