src/liburforth/urforth.c

   1 // and now for something completely different...
   2 // UrAsm built-in Forth Engine!
   3 // GPLv3 ONLY
   4 #ifdef WIN32
   5 #include <windows.h>
   6 #endif
   7 #include <stdarg.h>
   8 #include <setjmp.h>
   9 #include <stdio.h>
  10 #include <stdlib.h>
  11 #include <string.h>
  12 #include <time.h>
  13 #include <unistd.h>
  14
  15 #include <sys/stat.h>
  16 #include <sys/types.h>
  17
  18 #include "urforth.h"
  19
  20 #ifdef WIN32
  21 # define realpath(shit,fuck)  _fullpath(fuck, shit, 32768)
  22 #endif
  23
  24
  25 #define UFO_DEBUG_STARTUP_TIMES
  26 //#define UFO_DEBUG_FATAL_ABORT
  27 #define UFO_DEBUG_DEBUG  /* ;-) */
  28 //#define UFO_TRACE_VM_DOER
  29 //#define UFO_TRACE_VM_RUN
  30 //#define UFO_DEBUG_INCLUDE
  31 //#define UFO_DEBUG_DUMP_NEW_HEADERS
  32 //#define UFO_DEBUG_FIND_WORD
  33 //#define UFO_DEBUG_FIND_WORD_IN_VOC
  34 //#define UFO_DEBUG_FIND_WORD_COLON
  35
  36 // 2/8 msecs w/o inlining
  37 // 1/5 msecs with inlining
  38 #if 1
  39 # define UFO_FORCE_INLINE static inline __attribute__((always_inline))
  40 #else
  41 # define UFO_FORCE_INLINE static __attribute__((noinline)) __attribute__((unused))
  42 #endif
  43 #define UFO_DISABLE_INLINE static __attribute__((noinline)) __attribute__((unused))
  44
  45 // detect arch, and use faster memory access code on x86
  46 #if defined(__x86_64__) || defined(_M_X64) || \
  47     defined(i386) || defined(__i386__) || defined(__i386) || defined(_M_IX86)
  48 # define UFO_FAST_MEM_ACCESS
  49 #endif
  50
  51 // should not be bigger than this!
  52 #define UFO_MAX_WORD_LENGTH  (250)
  53
  54 #define UFO_ALIGN4(v_)  (((v_) + 3u) / 4u * 4u)
  55
  56
  57 // ////////////////////////////////////////////////////////////////////////// //
  58 static const char *ufo_assert_failure (const char *cond, const char *fname, int fline, const char *func) {
  59   for (const char *t = fname; *t; ++t) {
  60     #ifdef WIN32
  61     if (*t == '/' || *t == '\\') fname = t+1;
  62     #else
  63     if (*t == '/') fname = t+1;
  64     #endif
  65   }
  66   fflush(NULL);
  67   fprintf(stderr, "\n%s:%d: Assertion in `%s` failed: %s\n", fname, fline, func, cond);
  68   fflush(NULL);
  69   abort();
  70 }
  71
  72 #define ufo_assert(cond_)  do { if (__builtin_expect((!(cond_)), 0)) { ufo_assert_failure(#cond_, __FILE__, __LINE__, __PRETTY_FUNCTION__); } } while (0)
  73
  74
  75 static char ufoRealPathBuf[32769];
  76 static char ufoRealPathHashBuf[32769];
  77
  78
  79 //==========================================================================
  80 //
  81 //  ufoRealPath
  82 //
  83 //==========================================================================
  84 static char *ufoRealPath (const char *fname) {
  85   char *res;
  86   if (fname != NULL && fname[0] != 0) {
  87     res = realpath(fname, NULL);
  88     if (res != NULL) {
  89       const size_t slen = strlen(res);
  90       if (slen < 32768) {
  91         strcpy(ufoRealPathBuf, res);
  92         free(res);
  93         res = ufoRealPathBuf;
  94       } else {
  95         free(res);
  96         res = NULL;
  97       }
  98     }
  99   } else {
 100     res = NULL;
 101   }
 102   return res;
 103 }
 104
 105
 106 #ifndef WIN32
 107 static time_t secstart = 0;
 108 #endif
 109
 110
 111
 112 //==========================================================================
 113 //
 114 //  ufo_get_msecs
 115 //
 116 //==========================================================================
 117 static uint64_t ufo_get_msecs (void) {
 118   #ifdef WIN32
 119   return GetTickCount();
 120   #else
 121   struct timespec ts;
 122   #ifdef CLOCK_MONOTONIC
 123   ufo_assert(clock_gettime(CLOCK_MONOTONIC, &ts) == 0);
 124   #else
 125   // this should be available everywhere
 126   ufo_assert(clock_gettime(CLOCK_REALTIME, &ts) == 0);
 127   #endif
 128   // first run?
 129   if (secstart == 0) {
 130     secstart = ts.tv_sec+1;
 131     ufo_assert(secstart); // it should not be zero
 132   }
 133   return (uint64_t)(ts.tv_sec-secstart+2)*1000U+(uint32_t)ts.tv_nsec/1000000U;
 134   // nanoseconds
 135   //return (uint64_t)(ts.tv_sec-secstart+2)*1000000000U+(uint32_t)ts.tv_nsec;
 136   #endif
 137 }
 138
 139
 140 //==========================================================================
 141 //
 142 //  joaatHashBuf
 143 //
 144 //==========================================================================
 145 UFO_FORCE_INLINE uint32_t joaatHashBuf (const void *buf, size_t len, uint8_t orbyte) {
 146   uint32_t hash = 0x29a;
 147   const uint8_t *s = (const uint8_t *)buf;
 148   while (len--) {
 149     hash += (*s++)|orbyte;
 150     hash += hash<<10;
 151     hash ^= hash>>6;
 152   }
 153   // finalize
 154   hash += hash<<3;
 155   hash ^= hash>>11;
 156   hash += hash<<15;
 157   return hash;
 158 }
 159
 160
 161 // this converts ASCII capitals to locase (and destroys other, but who cares)
 162 #define joaatHashBufCI(buf_,len_)  joaatHashBuf((buf_), (len_), 0x20)
 163
 164
 165 //==========================================================================
 166 //
 167 //  toUpper
 168 //
 169 //==========================================================================
 170 UFO_FORCE_INLINE char toUpper (char ch) {
 171   return (ch >= 'a' && ch <= 'z' ? ch-'a'+'A' : ch);
 172 }
 173
 174
 175 //==========================================================================
 176 //
 177 //  toUpperU8
 178 //
 179 //==========================================================================
 180 UFO_FORCE_INLINE uint8_t toUpperU8 (uint8_t ch) {
 181   return (ch >= 'a' && ch <= 'z' ? ch-'a'+'A' : ch);
 182 }
 183
 184
 185 //==========================================================================
 186 //
 187 //  digitInBase
 188 //
 189 //==========================================================================
 190 UFO_FORCE_INLINE int digitInBase (char ch, int base) {
 191   switch (ch) {
 192     case '0' ... '9': ch = ch - '0'; break;
 193     case 'A' ... 'Z': ch = ch - 'A' + 10; break;
 194     case 'a' ... 'z': ch = ch - 'a' + 10; break;
 195     default: base = -1; break;
 196   }
 197   return (ch >= 0 && ch < base ? ch : -1);
 198 }
 199
 200
 201 /*
 202 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 203 ;; word header format:
 204 ;; note than name hash is ALWAYS calculated with ASCII-uppercased name
 205 ;; (actually, bit 5 is always reset for all bytes, because we don't need the
 206 ;; exact uppercase, only something that resembles it)
 207 ;; bfa points to next bfa or to 0 (this is "hash bucket pointer")
 208 ;; before nfa, we have such "hidden" fields:
 209 ;;   dd dfa       ; pointer to the debug data; can be 0 if debug info is missing
 210 ;;   dd xfa       ; points to the previous word header SFA, regardless of vocabularies (or 0)
 211 ;;   dd yfa       ; points to the previous word header SFA, regardless of vocabularies (or 0)
 212 ;;   dd bfa       ; next word in hashtable bucket; it is always here, even if hashtable is turned off
 213 ;;                ; if there is no hashtable, this field is not used
 214 ;; lfa:
 215 ;;   dd lfa       ; previous vocabulary word LFA or 0 (lfa links points here)
 216 ;;   dd namehash  ; it is always here, and always calculated, even if hashtable is turned off
 217 ;; nfa:
 218 ;;   dd flags-and-name-len   ; see below
 219 ;;   db name      ; no terminating zero or other "termination flag" here
 220 ;;  here could be some 0 bytes to align everything to 4 bytes
 221 ;;   db namelen   ; yes, name length again, so CFA->NFA can avoid guessing
 222 ;;                ; full length, including padding, but not including this byte
 223 ;; cfa:
 224 ;;   dd cfaidx    ; our internal CFA index, or image address for DOES>
 225 ;; pfa:
 226 ;;   word data follows
 227 ;;
 228 ;; first word cell contains combined name length (low byte), argtype and flags (other bytes)
 229 ;; layout:
 230 ;;   db namelen
 231 ;;   db argtype
 232 ;;   dw flags
 233 ;; i.e. we have 16 bits for flags, and 256 possible argument types. why not.
 234 ;;
 235 ;; flags:
 236 ;;  bit 0: immediate
 237 ;;  bit 1: smudge
 238 ;;  bit 2: noreturn
 239 ;;  bit 3: hidden
 240 ;;  bit 4: codeblock
 241 ;;  bit 5: vocabulary
 242 ;;  bit 6: *UNUSED* main scattered colon word (with "...")
 243 ;;  bit 7: protected
 244 ;;
 245 ;;  argtype is the type of the argument that this word reads from the threaded code.
 246 ;;  possible argument types:
 247 ;;    0: none
 248 ;;    1: branch address
 249 ;;    2: cell-size numeric literal
 250 ;;    3: cell-counted string with terminating zero (not counted)
 251 ;;    4: cfa of another word
 252 ;;    5: cblock
 253 ;;    6: vocid
 254 ;;    7: byte-counted string with terminating zero (not counted)
 255 ;;    8: *UNUSED* unsigned byte
 256 ;;    9: *UNUSED* signed byte
 257 ;;   10: *UNUSED* unsigned word
 258 ;;   11: *UNUSED* signed word
 259
 260
 261 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 262 ;; wordlist structure (at PFA)
 263 ;; -4: wordlist type id (used by structs, for example)
 264 ;;   dd latest
 265 ;;   dd voclink (voclink always points here)
 266 ;;   dd parent (if not zero, all parent words are visible)
 267 ;;   dd header-nfa (can be 0 for anonymous wordlists)
 268 ;;   hashtable (if enabled), or ~0U if no hash table
 269 */
 270
 271
 272 // ////////////////////////////////////////////////////////////////////////// //
 273 #define UFO_BFA_TO_LFA(bfa_)    ((bfa_) + 1u * 4u)
 274 #define UFO_LFA_TO_DFA(lfa_)    ((lfa_) - 4u * 4u)
 275 #define UFO_LFA_TO_XFA(lfa_)    ((lfa_) - 3u * 4u)
 276 #define UFO_LFA_TO_YFA(lfa_)    ((lfa_) - 2u * 4u)
 277 #define UFO_LFA_TO_BFA(lfa_)    ((lfa_) - 1u * 4u)
 278 #define UFO_LFA_TO_NFA(lfa_)    ((lfa_) + 2u * 4u)
 279 #define UFO_LFA_TO_CFA(lfa_)    UFO_ALIGN4((lfa_) + 3u * 4u + 1u + ufoImgGetU8((lfa_) + 2u * 4u))
 280 #define UFO_LFA_TO_NHASH(lfa_)  ((lfa_) + 1u * 4u)
 281 #define UFO_CFA_TO_NFA(cfa_)    ((cfa_) - 1u - 4u - ufoImgGetU8((cfa_) - 1u))
 282 #define UFO_CFA_TO_LFA(cfa_)    ((cfa_) - 1u - 4u * 3u - ufoImgGetU8((cfa_) - 1u))
 283 #define UFO_CFA_TO_PFA(cfa_)    ((cfa_) + 1u * 4u)
 284 #define UFO_PFA_TO_CFA(pfa_)    ((pfa_) - 1u * 4u)
 285 #define UFO_NFA_TO_CFA(nfa_)    UFO_ALIGN4((nfa_) + 4u + 1u + ufoImgGetU8((nfa_)))
 286 #define UFO_NFA_TO_LFA(nfa_)    ((nfa_) - 2u * 4u)
 287 #define UFO_XFA_TO_YFA(xfa_)    ((xfa_) + 4u)
 288 #define UFO_YFA_TO_XFA(yfa_)    ((xfa_) - 4u)
 289 #define UFO_XFA_TO_WST(xfa_)    ((xfa_) - 4u)
 290 #define UFO_YFA_TO_WST(yfa_)    ((yfa_) - 2u * 4u)
 291 #define UFO_YFA_TO_NFA(yfa_)    ((yfa_) + 4u * 4u)
 292
 293
 294 // ////////////////////////////////////////////////////////////////////////// //
 295 //#define UFW_WARG_U8      (8u<<8)
 296 //#define UFW_WARG_S8      (9u<<8)
 297 //#define UFW_WARG_U16     (10u<<8)
 298 //#define UFW_WARG_S16     (11u<<8)
 299
 300 #define UFW_VOCAB_OFS_LATEST   (0u * 4u)
 301 #define UFW_VOCAB_OFS_VOCLINK  (1u * 4u)
 302 #define UFW_VOCAB_OFS_PARENT   (2u * 4u)
 303 #define UFW_VOCAB_OFS_HEADER   (3u * 4u)
 304 #define UFW_VOCAB_OFS_HTABLE   (4u * 4u)
 305
 306 #define UFO_HASHTABLE_SIZE  (256)
 307
 308 #define UFO_NO_HTABLE_FLAG  (~(uint32_t)0)
 309
 310 #define UFO_MAX_NATIVE_CFAS  (1024u)
 311 static ufoNativeCFA *ufoForthCFAs = NULL;
 312 static uint32_t ufoCFAsUsed = 0;
 313
 314 static uint32_t ufoDoForthCFA;
 315 static uint32_t ufoDoVariableCFA;
 316 static uint32_t ufoDoValueCFA;
 317 static uint32_t ufoDoConstCFA;
 318 static uint32_t ufoDoDeferCFA;
 319 static uint32_t ufoDoVocCFA;
 320 static uint32_t ufoDoCreateCFA;
 321 static uint32_t ufoDoUserVariableCFA;
 322
 323 static uint32_t ufoStrLit8CFA;
 324
 325 // special address types:
 326 #define UFO_ADDR_CFA_BIT   ((uint32_t)1<<31)
 327 #define UFO_ADDR_CFA_MASK  (UFO_ADDR_CFA_BIT-1u)
 328
 329 // handles are somewhat special: first 12 bits can be used as offset for "@", and are ignored
 330 #define UFO_ADDR_HANDLE_BIT       ((uint32_t)1<<30)
 331 #define UFO_ADDR_HANDLE_MASK      ((UFO_ADDR_HANDLE_BIT-1u)&~((uint32_t)0xfff))
 332 #define UFO_ADDR_HANDLE_SHIFT     (12)
 333 #define UFO_ADDR_HANDLE_OFS_MASK  ((uint32_t)((1 << UFO_ADDR_HANDLE_SHIFT) - 1))
 334
 335 // temporary area is 1MB buffer out of the main image
 336 #define UFO_ADDR_TEMP_BIT   ((uint32_t)1<<29)
 337 #define UFO_ADDR_TEMP_MASK  (UFO_ADDR_TEMP_BIT-1u)
 338
 339 #define UFO_ADDR_SPECIAL_BITS_MASK  (UFO_ADDR_CFA_BIT|UFO_ADDR_HANDLE_BIT|UFO_ADDR_TEMP_BIT)
 340
 341 /*
 342   debug image stores mapping from dictionary addresses to source files and lines.
 343   it is used for backtraces and debuggers, so it doesn't need to be optimised for
 344   speed; therefore i choose to optimise it for size.
 345
 346   debug map format is this:
 347     dv filename-len
 348       ...filename...
 349       align, so next data starts at 4-byte boundary
 350     dxl line   ; 0: no more lines
 351     dxi ip-length
 352     ...next filename record
 353
 354   "dv" is variable-length number. each byte uses bit 7 as "continuation" bit.
 355
 356   "dx?" is delta-coded number.
 357   "dxi" is global, starts with 0, and incrementing.
 358   "dxl" resets to 0 on each new file.
 359   delta format is the same as "dv".
 360 */
 361
 362 static uint32_t *ufoImage = NULL;
 363 static uint32_t ufoImageSize = 0;
 364
 365 static uint8_t *ufoDebugImage = NULL;
 366 static uint32_t ufoDebugImageUsed = 0;
 367 static uint32_t ufoDebugImageSize = 0;
 368 static uint32_t ufoDebugFileId = 0;
 369 static uint32_t ufoDebugLastFRecAddr = 0;
 370 static uint32_t ufoDebugCurrDP = 0;
 371
 372 static uint32_t ufoInRunWord = 0;
 373
 374 static volatile int ufoVMAbort = 0;
 375 static volatile int ufoVMStop = 0;
 376
 377 #define ufoTrueValue  (~(uint32_t)0)
 378
 379 enum {
 380   UFO_MODE_NONE = -1,
 381   UFO_MODE_NATIVE = 0, // executing forth code
 382   UFO_MODE_MACRO = 1, // executing forth asm macro
 383 };
 384 static uint32_t ufoMode = UFO_MODE_NONE;
 385
 386 #define UFO_DSTACK_SIZE    (8192)
 387 #define UFO_RSTACK_SIZE    (4096)
 388 #define UFO_LSTACK_SIZE    (4096)
 389 #define UFO_MAX_TASK_NAME  (127)
 390
 391 // to support multitasking (required for the debugger),
 392 // our virtual machine state is encapsulated in a struct.
 393 typedef struct UfoState_t {
 394   uint32_t id;
 395   uint32_t dStack[UFO_DSTACK_SIZE];
 396   uint32_t rStack[UFO_RSTACK_SIZE];
 397   uint32_t lStack[UFO_LSTACK_SIZE];
 398   uint32_t IP; // in image
 399   uint32_t SP; // points AFTER the last value pushed
 400   uint32_t RP; // points AFTER the last value pushed
 401   uint32_t RPTop; // stop when RP is this
 402   // address register
 403   uint32_t regA;
 404   // for locals
 405   uint32_t LP;
 406   uint32_t LBP;
 407   uint32_t vmRPopCFA;
 408   // temp image
 409   uint32_t *imageTemp;
 410   uint32_t imageTempSize;
 411   // linked list of all allocated states (tasks)
 412   char name[UFO_MAX_TASK_NAME + 1];
 413 } UfoState;
 414
 415 // 'cmon!
 416 #define UFO_MAX_STATES  (8192)
 417
 418 // this is indexed by id
 419 static UfoState *ufoStateMap[UFO_MAX_STATES] = {NULL};
 420 static uint32_t ufoStateUsedBitmap[UFO_MAX_STATES/32] = {0};
 421
 422 // currently active execution state
 423 static UfoState *ufoCurrState = NULL;
 424 // state we're yielded from
 425 static UfoState *ufoYieldedState = NULL;
 426 // if debug state is not NULL, VM will switch to it
 427 // after executing one instruction from the current state.
 428 // it will store current state in `ufoDebugeeState`.
 429 static UfoState *ufoDebuggerState = NULL;
 430 static uint32_t ufoSingleStep = 0;
 431
 432 #define ufoDStack  (ufoCurrState->dStack)
 433 #define ufoRStack  (ufoCurrState->rStack)
 434 #define ufoLStack  (ufoCurrState->lStack)
 435 #define ufoIP      (ufoCurrState->IP)
 436 #define ufoSP      (ufoCurrState->SP)
 437 #define ufoRP      (ufoCurrState->RP)
 438 #define ufoRPTop   (ufoCurrState->RPTop)
 439 #define ufoLP      (ufoCurrState->LP)
 440 #define ufoLBP     (ufoCurrState->LBP)
 441 #define ufoRegA    (ufoCurrState->regA)
 442 #define ufoImageTemp      (ufoCurrState->imageTemp)
 443 #define ufoImageTempSize  (ufoCurrState->imageTempSize)
 444 #define ufoVMRPopCFA      (ufoCurrState->vmRPopCFA)
 445
 446 // 256 bytes for user variables
 447 #define UFO_USER_AREA_ADDR  UFO_ADDR_TEMP_BIT
 448 #define UFO_USER_AREA_SIZE  (256u)
 449 #define UFO_NBUF_ADDR       UFO_USER_AREA_ADDR + UFO_USER_AREA_SIZE
 450 #define UFO_NBUF_SIZE       (256u)
 451 #define UFO_PAD_ADDR        (UFO_NBUF_ADDR + UFO_NBUF_SIZE)
 452 #define UFO_DEF_TIB_ADDR    (UFO_PAD_ADDR + 2048u)
 453
 454 // dynamically allocated text input buffer
 455 // always ends with zero (this is word name too)
 456 static const uint32_t ufoAddrTIBx = UFO_ADDR_TEMP_BIT + 0u * 4u; // TIB
 457 static const uint32_t ufoAddrINx = UFO_ADDR_TEMP_BIT + 1u * 4u; // >IN
 458 static const uint32_t ufoAddrDefTIB = UFO_ADDR_TEMP_BIT + 2u * 4u; // default TIB (handle); user cannot change it
 459 static const uint32_t ufoAddrBASE = UFO_ADDR_TEMP_BIT + 3u * 4u;
 460 static const uint32_t ufoAddrUserVarUsed = UFO_ADDR_TEMP_BIT + 4u * 4u;
 461
 462 static uint32_t ufoAddrContext; // CONTEXT
 463 static uint32_t ufoAddrCurrent; // CURRENT (definitions will go there)
 464 static uint32_t ufoAddrSTATE;
 465 static uint32_t ufoAddrVocLink;
 466 static uint32_t ufoAddrDP;
 467 static uint32_t ufoAddrDPTemp;
 468 static uint32_t ufoAddrNewWordFlags;
 469 static uint32_t ufoAddrRedefineWarning;
 470 static uint32_t ufoAddrLastXFA;
 471
 472 // allows to redefine even protected words
 473 #define UFO_REDEF_WARN_DONT_CARE  (~(uint32_t)0)
 474 // do not warn about ordinary words, allow others
 475 #define UFO_REDEF_WARN_NONE    (0)
 476 // do warn
 477 #define UFO_REDEF_WARN_NORMAL  (1)
 478
 479 #define UFO_GET_DP()      (ufoImgGetU32(ufoAddrDPTemp) ?: ufoImgGetU32(ufoAddrDP))
 480 //#define UFO_SET_DP(val_)  ufoImgPutU32(ufoAddrDP, (val_))
 481
 482 #define UFO_MAX_NESTED_INCLUDES  (32)
 483 typedef struct {
 484   FILE *fl;
 485   char *fname;
 486   char *incpath;
 487   char *sysincpath;
 488   int fline;
 489   uint32_t id; // non-zero unique id
 490 } UFOFileStackEntry;
 491
 492 static UFOFileStackEntry ufoFileStack[UFO_MAX_NESTED_INCLUDES];
 493 static uint32_t ufoFileStackPos; // after the last used item
 494
 495 static FILE *ufoInFile = NULL;
 496 static char *ufoInFileName = NULL;
 497 static char *ufoLastIncPath = NULL;
 498 static char *ufoLastSysIncPath = NULL;
 499 static int ufoInFileLine = 0;
 500 static uint32_t ufoFileId = 0;
 501 static uint32_t ufoLastUsedFileId = 0;
 502
 503 static int ufoLastEmitWasCR = 1;
 504
 505 #define UFO_VOCSTACK_SIZE  (16u)
 506 static uint32_t ufoVocStack[UFO_VOCSTACK_SIZE]; // cfas
 507 static uint32_t ufoVSP;
 508 static uint32_t ufoForthVocId;
 509 static uint32_t ufoCompilerVocId;
 510
 511 // dynamic handles
 512 typedef struct UHandleInfo_t {
 513   uint32_t ufoHandle;
 514   uint32_t typeid;
 515   uint8_t *data;
 516   uint32_t size;
 517   uint32_t used;
 518   // in free list
 519   struct UHandleInfo_t *next;
 520 } UfoHandle;
 521
 522 static UfoHandle *ufoHandleFreeList = NULL;
 523 static UfoHandle **ufoHandles = NULL;
 524 static uint32_t ufoHandlesUsed = 0;
 525 static uint32_t ufoHandlesAlloted = 0;
 526
 527 #define UFO_HANDLE_FREE  (~(uint32_t)0)
 528
 529 static char ufoCurrFileLine[520];
 530
 531 // for `ufoFatal()`
 532 static uint32_t ufoInBacktrace = 0;
 533
 534
 535 // ////////////////////////////////////////////////////////////////////////// //
 536 static void ufoClearCondDefines (void);
 537
 538 static void ufoRunVMCFA (uint32_t cfa);
 539
 540 static void ufoBacktrace (uint32_t ip);
 541
 542 static void ufoClearCondDefines (void);
 543
 544 static UfoState *ufoNewState (uint32_t cfa);
 545 static void ufoInitStateUserVars (UfoState *st, int initial);
 546 static void ufoFreeState (UfoState *st);
 547 static UfoState *ufoFindState (uint32_t stid);
 548 static void ufoSwitchToState (UfoState *newst);
 549
 550 __attribute__((unused)) static void ufoDumpWordHeader (const uint32_t lfa);
 551
 552 #ifndef WIN32
 553 static void ufoDisableRaw (void);
 554 #endif
 555
 556 #ifdef UFO_DEBUG_DEBUG
 557 static void ufoDumpDebugImage (void);
 558 #endif
 559
 560
 561 // ////////////////////////////////////////////////////////////////////////// //
 562 #define UFWORD(name_) \
 563 static void ufoWord_##name_ (uint32_t mypfa)
 564
 565 #define UFCALL(name_)  ufoWord_##name_(0)
 566 #define UFCFA(name_)   (&ufoWord_##name_)
 567
 568 // for TIB words
 569 UFWORD(CPEEK_REGA_IDX);
 570 UFWORD(CPOKE_REGA_IDX);
 571
 572 // for peek and poke
 573 UFWORD(PAR_HANDLE_LOAD_BYTE);
 574 UFWORD(PAR_HANDLE_LOAD_WORD);
 575 UFWORD(PAR_HANDLE_LOAD_CELL);
 576 UFWORD(PAR_HANDLE_STORE_BYTE);
 577 UFWORD(PAR_HANDLE_STORE_WORD);
 578 UFWORD(PAR_HANDLE_STORE_CELL);
 579
 580
 581 //==========================================================================
 582 //
 583 //  ufoSetUserAbort
 584 //
 585 //==========================================================================
 586 void ufoSetUserAbort (void) {
 587   ufoVMAbort = 1;
 588 }
 589
 590
 591 //==========================================================================
 592 //
 593 //  ufoAllocHandle
 594 //
 595 //==========================================================================
 596 static UfoHandle *ufoAllocHandle (uint32_t typeid) {
 597   ufo_assert(typeid != UFO_HANDLE_FREE);
 598   UfoHandle *newh = ufoHandleFreeList;
 599   if (newh == NULL) {
 600     if (ufoHandlesUsed == ufoHandlesAlloted) {
 601       uint32_t newsz = ufoHandlesAlloted + 16384;
 602       // due to offsets, this is the maximum number of handles we can have
 603       if (newsz > 0x1ffffU) {
 604         if (ufoHandlesAlloted > 0x1ffffU) ufoFatal("too many dynamic handles");
 605         newsz = 0x1ffffU + 1U;
 606         ufo_assert(newsz > ufoHandlesAlloted);
 607       }
 608       UfoHandle **nh = realloc(ufoHandles, sizeof(ufoHandles[0]) * newsz);
 609       if (nh == NULL) ufoFatal("out of memory for handle table");
 610       ufoHandles = nh;
 611       ufoHandlesAlloted = newsz;
 612     }
 613     newh = calloc(1, sizeof(UfoHandle));
 614     if (newh == NULL) ufoFatal("out of memory for handle info");
 615     ufoHandles[ufoHandlesUsed] = newh;
 616     // setup new handle info
 617     newh->ufoHandle = (ufoHandlesUsed << UFO_ADDR_HANDLE_SHIFT) | UFO_ADDR_HANDLE_BIT;
 618     ufoHandlesUsed += 1;
 619   } else {
 620     ufo_assert(newh->typeid == UFO_HANDLE_FREE);
 621     ufoHandleFreeList = newh->next;
 622   }
 623   // setup new handle info
 624   newh->typeid = typeid;
 625   newh->data = NULL;
 626   newh->size = 0;
 627   newh->used = 0;
 628   newh->next = NULL;
 629   return newh;
 630 }
 631
 632
 633 //==========================================================================
 634 //
 635 //  ufoFreeHandle
 636 //
 637 //==========================================================================
 638 static void ufoFreeHandle (UfoHandle *hh) {
 639   if (hh != NULL) {
 640     ufo_assert(hh->typeid != UFO_HANDLE_FREE);
 641     if (hh->data) free(hh->data);
 642     hh->typeid = UFO_HANDLE_FREE;
 643     hh->data = NULL;
 644     hh->size = 0;
 645     hh->used = 0;
 646     hh->next = ufoHandleFreeList;
 647     ufoHandleFreeList = hh;
 648   }
 649 }
 650
 651
 652 //==========================================================================
 653 //
 654 //  ufoGetHandle
 655 //
 656 //==========================================================================
 657 static UfoHandle *ufoGetHandle (uint32_t hh) {
 658   UfoHandle *res;
 659   if (hh != 0 && (hh & UFO_ADDR_HANDLE_BIT) != 0) {
 660     hh = (hh & UFO_ADDR_HANDLE_MASK) >> UFO_ADDR_HANDLE_SHIFT;
 661     if (hh < ufoHandlesUsed) {
 662       res = ufoHandles[hh];
 663       if (res->typeid == UFO_HANDLE_FREE) res = NULL;
 664     } else {
 665       res = NULL;
 666     }
 667   } else {
 668     res = NULL;
 669   }
 670   return res;
 671 }
 672
 673
 674 //==========================================================================
 675 //
 676 //  setLastIncPath
 677 //
 678 //==========================================================================
 679 static void setLastIncPath (const char *fname, int system) {
 680   if (fname == NULL || fname[0] == 0) {
 681     if (system) {
 682       if (ufoLastSysIncPath) free(ufoLastIncPath);
 683       ufoLastSysIncPath = NULL;
 684     } else {
 685       if (ufoLastIncPath) free(ufoLastIncPath);
 686       ufoLastIncPath = strdup(".");
 687     }
 688   } else {
 689     char *lslash;
 690     char *cpos;
 691     if (system) {
 692       if (ufoLastSysIncPath) free(ufoLastSysIncPath);
 693       ufoLastSysIncPath = strdup(fname);
 694       lslash = ufoLastSysIncPath;
 695       cpos = ufoLastSysIncPath;
 696     } else {
 697       if (ufoLastIncPath) free(ufoLastIncPath);
 698       ufoLastIncPath = strdup(fname);
 699       lslash = ufoLastIncPath;
 700       cpos = ufoLastIncPath;
 701     }
 702     while (*cpos) {
 703       #ifdef WIN32
 704       if (*cpos == '/' || *cpos == '\\') lslash = cpos;
 705       #else
 706       if (*cpos == '/') lslash = cpos;
 707       #endif
 708       cpos += 1;
 709     }
 710     *lslash = 0;
 711   }
 712 }
 713
 714
 715 //==========================================================================
 716 //
 717 //  ufoClearIncludePath
 718 //
 719 //  required for UrAsm
 720 //
 721 //==========================================================================
 722 void ufoClearIncludePath (void) {
 723   if (ufoLastIncPath != NULL) {
 724     free(ufoLastIncPath);
 725     ufoLastIncPath = NULL;
 726   }
 727   if (ufoLastSysIncPath != NULL) {
 728     free(ufoLastSysIncPath);
 729     ufoLastSysIncPath = NULL;
 730   }
 731 }
 732
 733
 734 //==========================================================================
 735 //
 736 //  ufoErrorPrintFile
 737 //
 738 //==========================================================================
 739 static void ufoErrorPrintFile (FILE *fo) {
 740   if (ufoInFileName) {
 741     fprintf(fo, "UFO ERROR at file %s, line %d: ", ufoInFileName, ufoInFileLine);
 742   } else {
 743     fprintf(fo, "UFO ERROR somewhere in time: ");
 744   }
 745 }
 746
 747
 748 //==========================================================================
 749 //
 750 //  ufoErrorMsgV
 751 //
 752 //==========================================================================
 753 static void ufoErrorMsgV (const char *fmt, va_list ap) {
 754   if (!ufoLastEmitWasCR) { printf("\n"); ufoLastEmitWasCR = 1; }
 755   fflush(stdout);
 756   ufoErrorPrintFile(stderr);
 757   vfprintf(stderr, fmt, ap);
 758   va_end(ap);
 759   fputc('\n', stderr);
 760   fflush(NULL);
 761 }
 762
 763
 764 //==========================================================================
 765 //
 766 //  ufoWarning
 767 //
 768 //==========================================================================
 769 __attribute__((format(printf, 1, 2)))
 770 void ufoWarning (const char *fmt, ...) {
 771   va_list ap;
 772   va_start(ap, fmt);
 773   ufoErrorMsgV(fmt, ap);
 774 }
 775
 776
 777 //==========================================================================
 778 //
 779 //  ufoFatal
 780 //
 781 //==========================================================================
 782 __attribute__((noreturn)) __attribute__((format(printf, 1, 2)))
 783 void ufoFatal (const char *fmt, ...) {
 784   va_list ap;
 785   #ifndef WIN32
 786   ufoDisableRaw();
 787   #endif
 788   va_start(ap, fmt);
 789   ufoErrorMsgV(fmt, ap);
 790   if (!ufoInBacktrace) {
 791     ufoInBacktrace = 1;
 792     ufoBacktrace(ufoIP);
 793     ufoInBacktrace = 0;
 794   } else {
 795     fprintf(stderr, "DOUBLE FATAL: error in backtrace!\n");
 796     abort();
 797   }
 798   #ifdef UFO_DEBUG_FATAL_ABORT
 799   abort();
 800   #endif
 801   ufoFatalError();
 802 }
 803
 804
 805 // ////////////////////////////////////////////////////////////////////////// //
 806 // working with the stacks
 807 UFO_FORCE_INLINE void ufoPush (uint32_t v) { if (ufoSP >= UFO_DSTACK_SIZE) ufoFatal("data stack overflow"); ufoDStack[ufoSP++] = v; }
 808 UFO_FORCE_INLINE void ufoDrop (void) { if (ufoSP == 0) ufoFatal("data stack underflow"); --ufoSP; }
 809 UFO_FORCE_INLINE uint32_t ufoPop (void) { if (ufoSP == 0) { ufoFatal("data stack underflow"); } return ufoDStack[--ufoSP]; }
 810 UFO_FORCE_INLINE uint32_t ufoPeek (void) { if (ufoSP == 0) ufoFatal("data stack underflow"); return ufoDStack[ufoSP-1u]; }
 811 UFO_FORCE_INLINE void ufoDup (void) { if (ufoSP == 0) ufoFatal("data stack underflow"); ufoPush(ufoDStack[ufoSP-1u]); }
 812 UFO_FORCE_INLINE void ufoOver (void) { if (ufoSP < 2u) ufoFatal("data stack underflow"); ufoPush(ufoDStack[ufoSP-2u]); }
 813 UFO_FORCE_INLINE void ufoSwap (void) { if (ufoSP < 2u) ufoFatal("data stack underflow"); const uint32_t t = ufoDStack[ufoSP-1u]; ufoDStack[ufoSP-1u] = ufoDStack[ufoSP-2u]; ufoDStack[ufoSP-2u] = t; }
 814 UFO_FORCE_INLINE void ufoRot (void) { if (ufoSP < 3u) ufoFatal("data stack underflow"); const uint32_t t = ufoDStack[ufoSP-3u]; ufoDStack[ufoSP-3u] = ufoDStack[ufoSP-2u]; ufoDStack[ufoSP-2u] = ufoDStack[ufoSP-1u]; ufoDStack[ufoSP-1u] = t; }
 815 UFO_FORCE_INLINE void ufoNRot (void) { if (ufoSP < 3u) ufoFatal("data stack underflow"); const uint32_t t = ufoDStack[ufoSP-1u]; ufoDStack[ufoSP-1u] = ufoDStack[ufoSP-2u]; ufoDStack[ufoSP-2u] = ufoDStack[ufoSP-3u]; ufoDStack[ufoSP-3u] = t; }
 816
 817 UFO_FORCE_INLINE void ufo2Dup (void) { ufoOver(); ufoOver(); }
 818 UFO_FORCE_INLINE void ufo2Drop (void) { ufoDrop(); ufoDrop(); }
 819 UFO_FORCE_INLINE void ufo2Over (void) { if (ufoSP < 4u) ufoFatal("data stack underflow"); const uint32_t n0 = ufoDStack[ufoSP-4u]; const uint32_t n1 = ufoDStack[ufoSP-3u]; ufoPush(n0); ufoPush(n1); }
 820 UFO_FORCE_INLINE void ufo2Swap (void) { if (ufoSP < 4u) ufoFatal("data stack underflow"); const uint32_t n0 = ufoDStack[ufoSP-4u]; const uint32_t n1 = ufoDStack[ufoSP-3u]; ufoDStack[ufoSP-4u] = ufoDStack[ufoSP-2u]; ufoDStack[ufoSP-3u] = ufoDStack[ufoSP-1u]; ufoDStack[ufoSP-2u] = n0; ufoDStack[ufoSP-1u] = n1; }
 821
 822 UFO_FORCE_INLINE void ufoRPush (uint32_t v) { if (ufoRP >= UFO_RSTACK_SIZE) ufoFatal("return stack overflow"); ufoRStack[ufoRP++] = v; }
 823 UFO_FORCE_INLINE void ufoRDrop (void) { if (ufoRP == 0 || ufoRP == ufoRPTop) ufoFatal("return stack underflow"); --ufoRP; }
 824 UFO_FORCE_INLINE uint32_t ufoRPop (void) { if (ufoRP == 0 || ufoRP == ufoRPTop) ufoFatal("return stack underflow"); return ufoRStack[--ufoRP]; }
 825 UFO_FORCE_INLINE uint32_t ufoRPeek (void) { if (ufoRP == 0 || ufoRP == ufoRPTop) ufoFatal("return stack underflow"); return ufoRStack[ufoRP-1u]; }
 826 UFO_FORCE_INLINE void ufoRDup (void) { if (ufoRP == 0 || ufoRP == ufoRPTop) ufoFatal("return stack underflow"); ufoPush(ufoRStack[ufoRP-1u]); }
 827
 828 UFO_FORCE_INLINE void ufoPushBool (int v) { ufoPush(v ? ufoTrueValue : 0u); }
 829
 830
 831 //==========================================================================
 832 //
 833 //  ufoImgEnsureSize
 834 //
 835 //==========================================================================
 836 static void ufoImgEnsureSize (uint32_t addr) {
 837   if ((addr & UFO_ADDR_SPECIAL_BITS_MASK) != 0) ufoFatal("ufoImgEnsureSize: internal error");
 838   if (addr >= ufoImageSize) {
 839     // 64MB should be enough for everyone!
 840     if (addr >= 0x04000000U) {
 841       ufoFatal("image grown too big (addr=0%08XH)", addr);
 842     }
 843     const const uint32_t osz = ufoImageSize;
 844     // grow by 1MB steps
 845     const uint32_t nsz = (addr|0x000fffffU) + 1U;
 846     ufo_assert(nsz > addr);
 847     uint32_t *nimg = realloc(ufoImage, nsz);
 848     if (nimg == NULL) {
 849       ufoFatal("out of memory for UFO image (%u -> %u MBs)",
 850                ufoImageSize / 1024u / 1024u,
 851                nsz / 1024u / 1024u);
 852     }
 853     ufoImage = nimg;
 854     ufoImageSize = nsz;
 855     memset((char *)ufoImage + osz, 0, (nsz - osz));
 856   }
 857 }
 858
 859
 860 //==========================================================================
 861 //
 862 //  ufoImgEnsureTemp
 863 //
 864 //==========================================================================
 865 static void ufoImgEnsureTemp (uint32_t addr) {
 866   if ((addr & UFO_ADDR_SPECIAL_BITS_MASK) != 0) ufoFatal("ufoImgEnsureTemp: internal error");
 867   if (addr >= ufoImageTempSize) {
 868     if (addr >= 1024u * 1024u) {
 869       ufoFatal("Forth segmentation fault at address 0x%08X", addr | UFO_ADDR_TEMP_BIT);
 870     }
 871     const uint32_t osz = ufoImageTempSize;
 872     // grow by 8KB steps
 873     const uint32_t nsz = (addr|0x00001fffU) + 1U;
 874     uint32_t *nimg = realloc(ufoImageTemp, nsz);
 875     if (nimg == NULL) {
 876       ufoFatal("out of memory for temp UFO image (%u -> %u KBs)",
 877                ufoImageTempSize / 1024u,
 878                nsz / 1024u);
 879     }
 880     ufoImageTemp = nimg;
 881     ufoImageTempSize = nsz;
 882     memset((char *)ufoImageTemp + osz, 0, (nsz - osz));
 883   }
 884 }
 885
 886
 887 #ifdef UFO_FAST_MEM_ACCESS
 888 //==========================================================================
 889 //
 890 //  ufoImgPutU8
 891 //
 892 //  fast
 893 //
 894 //==========================================================================
 895 UFO_FORCE_INLINE void ufoImgPutU8 (uint32_t addr, const uint32_t value) {
 896   if ((addr & UFO_ADDR_SPECIAL_BITS_MASK) == 0) {
 897     if (addr >= ufoImageSize) ufoImgEnsureSize(addr);
 898     *((uint8_t *)ufoImage + addr) = (uint8_t)value;
 899   } else if (addr & UFO_ADDR_TEMP_BIT) {
 900     addr &= UFO_ADDR_TEMP_MASK;
 901     if (addr >= ufoImageTempSize) ufoImgEnsureTemp(addr);
 902     *((uint8_t *)ufoImageTemp + addr) = (uint8_t)value;
 903   } else {
 904     ufoFatal("Forth segmentation fault at address 0x%08X", addr);
 905   }
 906 }
 907
 908
 909 //==========================================================================
 910 //
 911 //  ufoImgPutU16
 912 //
 913 //  fast
 914 //
 915 //==========================================================================
 916 UFO_FORCE_INLINE void ufoImgPutU16 (uint32_t addr, const uint32_t value) {
 917   if ((addr & UFO_ADDR_SPECIAL_BITS_MASK) == 0) {
 918     if (addr + 1u >= ufoImageSize) ufoImgEnsureSize(addr + 1u);
 919     *(uint16_t *)((uint8_t *)ufoImage + addr) = (uint16_t)value;
 920   } else if (addr & UFO_ADDR_TEMP_BIT) {
 921     addr &= UFO_ADDR_TEMP_MASK;
 922     if (addr + 1u >= ufoImageTempSize) ufoImgEnsureTemp(addr + 1u);
 923     *(uint16_t *)((uint8_t *)ufoImageTemp + addr) = (uint16_t)value;
 924   } else {
 925     ufoFatal("Forth segmentation fault at address 0x%08X", addr);
 926   }
 927 }
 928
 929
 930 //==========================================================================
 931 //
 932 //  ufoImgPutU32
 933 //
 934 //  fast
 935 //
 936 //==========================================================================
 937 UFO_FORCE_INLINE void ufoImgPutU32 (uint32_t addr, const uint32_t value) {
 938   if ((addr & UFO_ADDR_SPECIAL_BITS_MASK) == 0) {
 939     if (addr + 3u >= ufoImageSize) ufoImgEnsureSize(addr + 3u);
 940     *(uint32_t *)((uint8_t *)ufoImage + addr) = value;
 941   } else if (addr & UFO_ADDR_TEMP_BIT) {
 942     addr &= UFO_ADDR_TEMP_MASK;
 943     if (addr + 3u >= ufoImageTempSize) ufoImgEnsureTemp(addr + 3u);
 944     *(uint32_t *)((uint8_t *)ufoImageTemp + addr) = value;
 945   } else {
 946     ufoFatal("Forth segmentation fault at address 0x%08X", addr);
 947   }
 948 }
 949
 950
 951 //==========================================================================
 952 //
 953 //  ufoImgGetU8
 954 //
 955 //  false
 956 //
 957 //==========================================================================
 958 UFO_FORCE_INLINE uint32_t ufoImgGetU8 (uint32_t addr) {
 959   if ((addr & UFO_ADDR_SPECIAL_BITS_MASK) == 0) {
 960     if (addr >= ufoImageSize) {
 961       // accessing unallocated image area is segmentation fault
 962       ufoFatal("Forth segmentation fault (unallocated access) at address 0x%08X", addr);
 963     }
 964     return *((const uint8_t *)ufoImage + addr);
 965   } else if (addr & UFO_ADDR_TEMP_BIT) {
 966     addr &= UFO_ADDR_TEMP_MASK;
 967     if (addr >= ufoImageTempSize) {
 968       // accessing unallocated image area is segmentation fault
 969       ufoFatal("Forth segmentation fault (unallocated access) at address 0x%08X", addr | UFO_ADDR_TEMP_BIT);
 970     }
 971     return *((const uint8_t *)ufoImageTemp + addr);
 972   } else {
 973     ufoFatal("Forth segmentation fault at address 0x%08X", addr);
 974   }
 975 }
 976
 977
 978 //==========================================================================
 979 //
 980 //  ufoImgGetU16
 981 //
 982 //  fast
 983 //
 984 //==========================================================================
 985 UFO_FORCE_INLINE uint32_t ufoImgGetU16 (uint32_t addr) {
 986   if ((addr & UFO_ADDR_SPECIAL_BITS_MASK) == 0) {
 987     if (addr + 1u >= ufoImageSize) {
 988       // accessing unallocated image area is segmentation fault
 989       ufoFatal("Forth segmentation fault (unallocated access) at address 0x%08X", addr);
 990     }
 991     return *(const uint16_t *)((const uint8_t *)ufoImage + addr);
 992   } else if (addr & UFO_ADDR_TEMP_BIT) {
 993     addr &= UFO_ADDR_TEMP_MASK;
 994     if (addr + 1u >= ufoImageTempSize) {
 995       // accessing unallocated image area is segmentation fault
 996       ufoFatal("Forth segmentation fault (unallocated access) at address 0x%08X", addr | UFO_ADDR_TEMP_BIT);
 997     }
 998     return *(const uint16_t *)((const uint8_t *)ufoImageTemp + addr);
 999   } else {
1000     ufoFatal("Forth segmentation fault at address 0x%08X", addr);
1001   }
1002 }
1003
1004
1005 //==========================================================================
1006 //
1007 //  ufoImgGetU32
1008 //
1009 //  fast
1010 //
1011 //==========================================================================
1012 UFO_FORCE_INLINE uint32_t ufoImgGetU32 (uint32_t addr) {
1013   if ((addr & UFO_ADDR_SPECIAL_BITS_MASK) == 0) {
1014     if (addr + 3u >= ufoImageSize) {
1015       // accessing unallocated image area is segmentation fault
1016       ufoFatal("Forth segmentation fault (unallocated access) at address 0x%08X", addr);
1017     }
1018     return *(const uint32_t *)((const uint8_t *)ufoImage + addr);
1019   } else if (addr & UFO_ADDR_TEMP_BIT) {
1020     addr &= UFO_ADDR_TEMP_MASK;
1021     if (addr + 3u >= ufoImageTempSize) {
1022       // accessing unallocated image area is segmentation fault
1023       ufoFatal("Forth segmentation fault (unallocated access) at address 0x%08X", addr | UFO_ADDR_TEMP_BIT);
1024     }
1025     return *(const uint32_t *)((const uint8_t *)ufoImageTemp + addr);
1026   } else {
1027     ufoFatal("Forth segmentation fault at address 0x%08X", addr);
1028   }
1029 }
1030
1031 #else
1032
1033 //==========================================================================
1034 //
1035 //  ufoImgPutU8
1036 //
1037 //  general
1038 //
1039 //==========================================================================
1040 UFO_FORCE_INLINE void ufoImgPutU8 (uint32_t addr, const uint32_t value) {
1041   uint32_t *imgptr;
1042   if ((addr & UFO_ADDR_SPECIAL_BITS_MASK) == 0) {
1043     if (addr >= ufoImageSize) ufoImgEnsureSize(addr);
1044     imgptr = &ufoImage[addr/4u];
1045   } else if (addr & UFO_ADDR_TEMP_BIT) {
1046     addr &= UFO_ADDR_TEMP_MASK;
1047     if (addr >= ufoImageTempSize) ufoImgEnsureTemp(addr);
1048     imgptr = &ufoImageTemp[addr/4u];
1049   } else {
1050     ufoFatal("Forth segmentation fault at address 0x%08X", addr);
1051   }
1052   const uint8_t val = (uint8_t)value;
1053   memcpy((uint8_t *)imgptr + (addr&3), &val, 1);
1054 }
1055
1056
1057 //==========================================================================
1058 //
1059 //  ufoImgPutU16
1060 //
1061 //  general
1062 //
1063 //==========================================================================
1064 UFO_FORCE_INLINE void ufoImgPutU16 (uint32_t addr, const uint32_t value) {
1065   ufoImgPutU8(addr, value&0xffU);
1066   ufoImgPutU8(addr + 1u, (value>>8)&0xffU);
1067 }
1068
1069
1070 //==========================================================================
1071 //
1072 //  ufoImgPutU32
1073 //
1074 //  general
1075 //
1076 //==========================================================================
1077 UFO_FORCE_INLINE void ufoImgPutU32 (uint32_t addr, const uint32_t value) {
1078   ufoImgPutU16(addr, value&0xffffU);
1079   ufoImgPutU16(addr + 2u, (value>>16)&0xffffU);
1080 }
1081
1082
1083 //==========================================================================
1084 //
1085 //  ufoImgGetU8
1086 //
1087 //  general
1088 //
1089 //==========================================================================
1090 UFO_FORCE_INLINE uint32_t ufoImgGetU8 (uint32_t addr) {
1091   uint32_t *imgptr;
1092   if ((addr & UFO_ADDR_SPECIAL_BITS_MASK) == 0) {
1093     if (addr >= ufoImageSize) return 0;
1094     imgptr = &ufoImage[addr/4u];
1095   } else if (addr & UFO_ADDR_TEMP_BIT) {
1096     addr &= UFO_ADDR_TEMP_MASK;
1097     if (addr >= ufoImageTempSize) return 0;
1098     imgptr = &ufoImageTemp[addr/4u];
1099   } else {
1100     ufoFatal("Forth segmentation fault at address 0x%08X", addr);
1101   }
1102   uint8_t val;
1103   memcpy(&val, (uint8_t *)imgptr + (addr&3), 1);
1104   return (uint32_t)val;
1105 }
1106
1107
1108 //==========================================================================
1109 //
1110 //  ufoImgGetU16
1111 //
1112 //  general
1113 //
1114 //==========================================================================
1115 UFO_FORCE_INLINE uint32_t ufoImgGetU16 (uint32_t addr) {
1116   return ufoImgGetU8(addr) | (ufoImgGetU8(addr + 1u) << 8);
1117 }
1118
1119
1120 //==========================================================================
1121 //
1122 //  ufoImgGetU32
1123 //
1124 //  general
1125 //
1126 //==========================================================================
1127 UFO_FORCE_INLINE uint32_t ufoImgGetU32 (uint32_t addr) {
1128   return ufoImgGetU16(addr) | (ufoImgGetU16(addr + 2u) << 16);
1129 }
1130 #endif
1131
1132
1133 //==========================================================================
1134 //
1135 //  ufoEnsureDebug
1136 //
1137 //==========================================================================
1138 UFO_DISABLE_INLINE void ufoEnsureDebug (uint32_t sdelta) {
1139   ufo_assert(sdelta != 0);
1140   if (ufoDebugImageUsed != 0) {
1141     if (ufoDebugImageUsed + sdelta >= 0x40000000U) ufoFatal("debug info too big");
1142     if (ufoDebugImageUsed + sdelta > ufoDebugImageSize) {
1143       // grow by 32KB, this should be more than enough
1144       const uint32_t newsz = ((ufoDebugImageUsed + sdelta) | 0x7fffU) + 1u;
1145       uint8_t *ndb = realloc(ufoDebugImage, newsz);
1146       if (ndb == NULL) ufoFatal("out of memory for debug info");
1147       ufoDebugImage = ndb;
1148       ufoDebugImageSize = newsz;
1149     }
1150   } else {
1151     // initial allocation: 32KB, quite a lot
1152     ufoDebugImageSize = 1024 * 32;
1153     ufoDebugImage = malloc(ufoDebugImageSize);
1154     if (ufoDebugImage == NULL) ufoFatal("out of memory for debug info");
1155   }
1156 }
1157
1158
1159 #ifdef UFO_DEBUG_DEBUG
1160 //==========================================================================
1161 //
1162 //  ufoDumpDebugInfo
1163 //
1164 //==========================================================================
1165 static void ufoDumpDebugImage (void) {
1166   #if 0
1167   uint32_t dbgpos = 0u; // first item is always "next file record"
1168   while (dbgpos < ufoDebugImageUsed) {
1169     const uint32_t ln = *(const uint32_t *)(ufoDebugImage + dbgpos); dbgpos += 4u;
1170     if (ln == ~(uint32_t)0) {
1171       // next file record
1172       const uint32_t nlen = *(const uint32_t *)(ufoDebugImage + dbgpos); dbgpos += 4u;
1173       fprintf(stderr, "*** NEW FILE: %s\n", (const char *)(ufoDebugImage + dbgpos));
1174       dbgpos += nlen + 1u;
1175       if ((dbgpos & 0x03) != 0) dbgpos = (dbgpos | 0x03u) + 1u;
1176     } else {
1177       const uint32_t edp = *(const uint32_t *)(ufoDebugImage + dbgpos); dbgpos += 4u;
1178       fprintf(stderr, "  line %6u: edp=%u\n", ln, edp);
1179     }
1180   }
1181   #endif
1182 }
1183 #endif
1184
1185
1186 #define UFO_DBG_PUT_U4(val_)  do { \
1187   const uint32_t vv_ = (val_); \
1188   *((uint32_t *)(ufoDebugImage + ufoDebugImageUsed)) = vv_; \
1189   ufoDebugImageUsed += 4u; \
1190 } while (0)
1191
1192 //==========================================================================
1193 //
1194 //  ufoRecordDebug
1195 //
1196 //==========================================================================
1197 UFO_DISABLE_INLINE void ufoRecordDebug (uint32_t newhere) {
1198   if (newhere > ufoDebugCurrDP) {
1199     if (ufoInFileName != NULL) {
1200       // check if we're doing the same file
1201       const uint32_t slen = (uint32_t)strlen(ufoInFileName);
1202       const int newfrec = (ufoDebugLastFRecAddr == 0) ||
1203                           (*((const uint32_t *)(ufoDebugImage + ufoDebugLastFRecAddr)) != slen) ||
1204                           (memcmp((const char *)ufoDebugImage + ufoDebugLastFRecAddr + 4u, ufoInFileName, slen) != 0);
1205       uint32_t fline = (uint32_t)ufoInFileLine;
1206       if (fline == ~(uint32_t)0) fline -= 1u;
1207       if (newfrec) {
1208         ufoEnsureDebug(slen + 4u + 4u + 4u + 32u); // way too much ;-)
1209         // finish previous record
1210         UFO_DBG_PUT_U4(~(uint32_t)0);
1211         // create new file record
1212         ufoDebugLastFRecAddr = ufoDebugImageUsed;
1213         UFO_DBG_PUT_U4(slen);
1214         memcpy(ufoDebugImage + ufoDebugImageUsed, ufoInFileName, slen + 1u);
1215         ufoDebugImageUsed += slen + 1u;
1216         while ((ufoDebugImageUsed & 0x03u) != 0) {
1217           ufoDebugImage[ufoDebugImageUsed] = 0;
1218           ufoDebugImageUsed += 1;
1219         }
1220         UFO_DBG_PUT_U4(fline);
1221         UFO_DBG_PUT_U4(newhere);
1222       } else {
1223         // check if the line is the same
1224         if (*((const uint32_t *)(ufoDebugImage + ufoDebugImageUsed - 8u)) == fline) {
1225           *((uint32_t *)(ufoDebugImage + ufoDebugImageUsed - 4u)) = newhere;
1226         } else {
1227           // new line
1228           ufoEnsureDebug(8u);
1229           UFO_DBG_PUT_U4(fline);
1230           UFO_DBG_PUT_U4(newhere);
1231         }
1232       }
1233     } else {
1234       // we don't have a file, don't record debug info
1235       ufoDebugFileId = 0;
1236       ufoDebugLastFRecAddr = 0;
1237     }
1238     ufoDebugCurrDP = newhere;
1239   }
1240 }
1241
1242
1243 //==========================================================================
1244 //
1245 //  ufoGetWordEndAddrYFA
1246 //
1247 //==========================================================================
1248 static uint32_t ufoGetWordEndAddrYFA (uint32_t yfa) {
1249   if (yfa > 8u) {
1250     const uint32_t oyfa = yfa;
1251     yfa = ufoImgGetU32(yfa);
1252     if (yfa == 0) {
1253       if ((oyfa & UFO_ADDR_TEMP_BIT) == 0) {
1254         yfa = UFO_GET_DP();
1255         if ((yfa & UFO_ADDR_TEMP_BIT) != 0) {
1256           yfa = UFO_CFA_TO_PFA(UFO_NFA_TO_CFA(UFO_YFA_TO_NFA(oyfa)));
1257         }
1258       } else {
1259         yfa = UFO_CFA_TO_PFA(UFO_NFA_TO_CFA(UFO_YFA_TO_NFA(oyfa)));
1260       }
1261     } else {
1262       yfa = UFO_YFA_TO_WST(yfa);
1263     }
1264   } else {
1265     yfa = 0;
1266   }
1267   return yfa;
1268 }
1269
1270
1271 //==========================================================================
1272 //
1273 //  ufoGetWordEndAddr
1274 //
1275 //==========================================================================
1276 static uint32_t ufoGetWordEndAddr (const uint32_t cfa) {
1277   if (cfa != 0) {
1278     return ufoGetWordEndAddrYFA(UFO_LFA_TO_YFA(UFO_CFA_TO_LFA(cfa)));
1279   } else {
1280     return 0;
1281   }
1282 }
1283
1284
1285 //==========================================================================
1286 //
1287 //  ufoFindWordForIP
1288 //
1289 //  return NFA or 0
1290 //
1291 //  WARNING: this is SLOW!
1292 //
1293 //==========================================================================
1294 static uint32_t ufoFindWordForIP (const uint32_t ip) {
1295   uint32_t res = 0;
1296   if (ip != 0) {
1297     // iterate over all words
1298     uint32_t xfa = ufoImgGetU32(ufoAddrLastXFA);
1299     if (xfa != 0) {
1300       while (res == 0 && xfa != 0) {
1301         const uint32_t yfa = UFO_XFA_TO_YFA(xfa);
1302         const uint32_t wst = UFO_YFA_TO_WST(yfa);
1303         const uint32_t wend = ufoGetWordEndAddrYFA(yfa);
1304         if (ip >= wst && ip < wend) {
1305           res = UFO_YFA_TO_NFA(yfa);
1306         } else {
1307           xfa = ufoImgGetU32(xfa);
1308         }
1309       }
1310     }
1311   }
1312   return res;
1313 }
1314
1315
1316 //==========================================================================
1317 //
1318 //  ufoFindFileForIP
1319 //
1320 //  return file name or `NULL`
1321 //
1322 //  WARNING: this is SLOW!
1323 //
1324 //==========================================================================
1325 static const char *ufoFindFileForIP (uint32_t ip, uint32_t *line) {
1326   const char *res = NULL;
1327   if (ip != 0 && ufoDebugImageUsed != 0) {
1328     uint32_t lastfinfo = 0u;
1329     uint32_t lastip = 0u;
1330     uint32_t dbgpos = 0u; // first item is always "next file record"
1331     while (res == NULL && dbgpos < ufoDebugImageUsed) {
1332       const uint32_t ln = *(const uint32_t *)(ufoDebugImage + dbgpos); dbgpos += 4u;
1333       if (ln == ~(uint32_t)0) {
1334         // next file record
1335         lastfinfo = dbgpos;
1336         const uint32_t nlen = *(const uint32_t *)(ufoDebugImage + dbgpos); dbgpos += 4u;
1337         dbgpos += nlen + 1u;
1338         if ((dbgpos & 0x03) != 0) dbgpos = (dbgpos | 0x03u) + 1u;
1339       } else {
1340         const uint32_t edp = *(const uint32_t *)(ufoDebugImage + dbgpos); dbgpos += 4u;
1341         if (ip >= lastip && ip < edp) {
1342           if (line) *line = ln;
1343           res = (const char *)(ufoDebugImage + lastfinfo + 4u);
1344         }
1345         lastip = edp;
1346       }
1347     }
1348   }
1349   return res;
1350 }
1351
1352
1353 //==========================================================================
1354 //
1355 //  ufoBumpDP
1356 //
1357 //==========================================================================
1358 UFO_FORCE_INLINE void ufoBumpDP (uint32_t delta) {
1359   uint32_t dp = ufoImgGetU32(ufoAddrDPTemp);
1360   if (dp == 0) {
1361     dp = ufoImgGetU32(ufoAddrDP);
1362     if ((dp & UFO_ADDR_SPECIAL_BITS_MASK) == 0) ufoRecordDebug(dp + delta);
1363     dp += delta;
1364     ufoImgPutU32(ufoAddrDP, dp);
1365   } else {
1366     dp = ufoImgGetU32(ufoAddrDPTemp);
1367     if ((dp & UFO_ADDR_SPECIAL_BITS_MASK) == 0) ufoRecordDebug(dp + delta);
1368     dp += delta;
1369     ufoImgPutU32(ufoAddrDPTemp, dp);
1370   }
1371 }
1372
1373
1374 //==========================================================================
1375 //
1376 //  ufoImgEmitU8
1377 //
1378 //==========================================================================
1379 UFO_FORCE_INLINE void ufoImgEmitU8 (uint32_t value) {
1380   ufoImgPutU8(UFO_GET_DP(), value);
1381   ufoBumpDP(1);
1382 }
1383
1384
1385 //==========================================================================
1386 //
1387 //  ufoImgEmitU32
1388 //
1389 //==========================================================================
1390 UFO_FORCE_INLINE void ufoImgEmitU32 (uint32_t value) {
1391   ufoImgPutU32(UFO_GET_DP(), value);
1392   ufoBumpDP(4);
1393 }
1394
1395
1396 #ifdef UFO_FAST_MEM_ACCESS
1397
1398 //==========================================================================
1399 //
1400 //  ufoImgEmitU32_NoInline
1401 //
1402 //  false
1403 //
1404 //==========================================================================
1405 UFO_FORCE_INLINE void ufoImgEmitU32_NoInline (uint32_t value) {
1406   ufoImgPutU32(UFO_GET_DP(), value);
1407   ufoBumpDP(4);
1408 }
1409
1410 #else
1411
1412 //==========================================================================
1413 //
1414 //  ufoImgEmitU32_NoInline
1415 //
1416 //  general
1417 //
1418 //==========================================================================
1419 UFO_DISABLE_INLINE void ufoImgEmitU32_NoInline (uint32_t value) {
1420   ufoImgPutU32(UFO_GET_DP(), value);
1421   ufoBumpDP(4);
1422 }
1423
1424 #endif
1425
1426
1427 //==========================================================================
1428 //
1429 //  ufoImgGetU8Ext
1430 //
1431 //  this understands handle addresses
1432 //
1433 //==========================================================================
1434 UFO_FORCE_INLINE uint32_t ufoImgGetU8Ext (uint32_t addr) {
1435   if ((addr & UFO_ADDR_HANDLE_BIT) == 0) {
1436     return ufoImgGetU8(addr);
1437   } else {
1438     ufoPush(0);
1439     ufoPush(addr);
1440     UFCALL(PAR_HANDLE_LOAD_BYTE);
1441     return ufoPop();
1442   }
1443 }
1444
1445
1446 //==========================================================================
1447 //
1448 //  ufoImgPutU8Ext
1449 //
1450 //  this understands handle addresses
1451 //
1452 //==========================================================================
1453 UFO_FORCE_INLINE void ufoImgPutU8Ext (uint32_t addr, uint32_t value) {
1454   if ((addr & UFO_ADDR_HANDLE_BIT) == 0) {
1455     ufoImgPutU8(addr, value);
1456   } else {
1457     ufoPush(value);
1458     ufoPush(0);
1459     ufoPush(addr);
1460     UFCALL(PAR_HANDLE_STORE_BYTE);
1461   }
1462 }
1463
1464
1465 //==========================================================================
1466 //
1467 //  ufoImgEmitAlign
1468 //
1469 //==========================================================================
1470 UFO_FORCE_INLINE void ufoImgEmitAlign (void) {
1471   while ((UFO_GET_DP() & 3) != 0) ufoImgEmitU8(0);
1472 }
1473
1474
1475 //==========================================================================
1476 //
1477 //  ufoResetTib
1478 //
1479 //==========================================================================
1480 UFO_FORCE_INLINE void ufoResetTib (void) {
1481   uint32_t defTIB = ufoImgGetU32(ufoAddrDefTIB);
1482   //fprintf(stderr, "ufoResetTib(%p): defTIB=0x%08x\n", ufoCurrState, defTIB);
1483   if (defTIB == 0) {
1484     // create new TIB handle
1485     UfoHandle *tibh = ufoAllocHandle(0x69a029a6); // arbitrary number
1486     defTIB = tibh->ufoHandle;
1487     ufoImgPutU32(ufoAddrDefTIB, defTIB);
1488   }
1489   if ((defTIB & UFO_ADDR_HANDLE_BIT) != 0) {
1490     UfoHandle *hh = ufoGetHandle(defTIB);
1491     if (hh == NULL) ufoFatal("default TIB is not allocated");
1492     if (hh->size == 0) {
1493       ufo_assert(hh->data == NULL);
1494       hh->data = calloc(1, UFO_ADDR_HANDLE_OFS_MASK + 1);
1495       if (hh->data == NULL) ufoFatal("out of memory for default TIB");
1496       hh->size = UFO_ADDR_HANDLE_OFS_MASK + 1;
1497     }
1498   }
1499   const uint32_t oldA = ufoRegA;
1500   ufoImgPutU32(ufoAddrTIBx, defTIB);
1501   ufoImgPutU32(ufoAddrINx, 0);
1502   ufoRegA = defTIB;
1503   ufoPush(0); // value
1504   ufoPush(0); // offset
1505   UFCALL(CPOKE_REGA_IDX);
1506   ufoRegA = oldA;
1507 }
1508
1509
1510 //==========================================================================
1511 //
1512 //  ufoTibEnsureSize
1513 //
1514 //==========================================================================
1515 UFO_DISABLE_INLINE void ufoTibEnsureSize (uint32_t size) {
1516   if (size > 1024u * 1024u * 256u) ufoFatal("TIB size too big");
1517   const uint32_t tib = ufoImgGetU32(ufoAddrTIBx);
1518   //fprintf(stderr, "ufoTibEnsureSize: TIB=0x%08x; size=%u\n", tib, size);
1519   if ((tib & UFO_ADDR_HANDLE_BIT) != 0) {
1520     UfoHandle *hh = ufoGetHandle(tib);
1521     if (hh == NULL) {
1522       ufoFatal("cannot resize TIB, TIB is not a handle");
1523     }
1524     if (hh->size < size) {
1525       const uint32_t newsz = (size | 0xfffU) + 1u;
1526       uint8_t *nx = realloc(hh->data, newsz);
1527       if (nx == NULL) ufoFatal("out of memory for restored TIB");
1528       hh->data = nx;
1529       hh->size = newsz;
1530     }
1531   }
1532   #if 0
1533   else {
1534     ufoFatal("cannot resize TIB, TIB is not a handle (0x%08x)", tib);
1535   }
1536   #endif
1537 }
1538
1539
1540 //==========================================================================
1541 //
1542 //  ufoTibGetSize
1543 //
1544 //==========================================================================
1545 /*
1546 UFO_DISABLE_INLINE uint32_t ufoTibGetSize (void) {
1547   const uint32_t tib = ufoImgGetU32(ufoAddrTIBx);
1548   if ((tib & UFO_ADDR_HANDLE_BIT) == 0) {
1549     ufoFatal("cannot query TIB, TIB is not a handle");
1550   }
1551   UfoHandle *hh = ufoGetHandle(tib);
1552   if (hh == NULL) {
1553     ufoFatal("cannot query TIB, TIB is not a handle");
1554   }
1555   return hh->size;
1556 }
1557 */
1558
1559
1560 //==========================================================================
1561 //
1562 //  ufoTibPeekCh
1563 //
1564 //==========================================================================
1565 UFO_FORCE_INLINE uint8_t ufoTibPeekCh (void) {
1566   return (uint8_t)ufoImgGetU8Ext(ufoImgGetU32(ufoAddrTIBx) + ufoImgGetU32(ufoAddrINx));
1567 }
1568
1569
1570 //==========================================================================
1571 //
1572 //  ufoTibPeekChOfs
1573 //
1574 //==========================================================================
1575 UFO_FORCE_INLINE uint8_t ufoTibPeekChOfs (uint32_t ofs) {
1576   const uint32_t tib = ufoImgGetU32(ufoAddrTIBx);
1577   if (ofs <= UFO_ADDR_HANDLE_OFS_MASK || (tib & UFO_ADDR_HANDLE_BIT) == 0) {
1578     return (uint8_t)ufoImgGetU8Ext(tib + ufoImgGetU32(ufoAddrINx) + ofs);
1579   } else {
1580     return 0;
1581   }
1582 }
1583
1584
1585 //==========================================================================
1586 //
1587 //  ufoTibPokeChOfs
1588 //
1589 //==========================================================================
1590 UFO_DISABLE_INLINE void ufoTibPokeChOfs (uint8_t ch, uint32_t ofs) {
1591   const uint32_t oldA = ufoRegA;
1592   ufoRegA = ufoImgGetU32(ufoAddrTIBx);
1593   ufoPush(ch);
1594   ufoPush(ufoImgGetU32(ufoAddrINx) + ofs);
1595   UFCALL(CPOKE_REGA_IDX);
1596   ufoRegA = oldA;
1597 }
1598
1599
1600 //==========================================================================
1601 //
1602 //  ufoTibGetCh
1603 //
1604 //==========================================================================
1605 UFO_FORCE_INLINE uint8_t ufoTibGetCh (void) {
1606   const uint8_t ch = ufoTibPeekCh();
1607   if (ch) ufoImgPutU32(ufoAddrINx, ufoImgGetU32(ufoAddrINx) + 1u);
1608   return ch;
1609 }
1610
1611
1612 //==========================================================================
1613 //
1614 //  ufoTibSkipCh
1615 //
1616 //==========================================================================
1617 UFO_FORCE_INLINE void ufoTibSkipCh (void) {
1618   (void)ufoTibGetCh();
1619 }
1620
1621
1622 // ////////////////////////////////////////////////////////////////////////// //
1623 // native CFA implementations
1624 //
1625
1626 //==========================================================================
1627 //
1628 //  ufoDoForth
1629 //
1630 //==========================================================================
1631 static void ufoDoForth (uint32_t pfa) {
1632   ufoRPush(ufoIP);
1633   ufoIP = pfa;
1634 }
1635
1636
1637 //==========================================================================
1638 //
1639 //  ufoDoVariable
1640 //
1641 //==========================================================================
1642 static void ufoDoVariable (uint32_t pfa) {
1643   ufoPush(pfa);
1644 }
1645
1646
1647 //==========================================================================
1648 //
1649 //  ufoDoUserVariable
1650 //
1651 //==========================================================================
1652 static void ufoDoUserVariable (uint32_t pfa) {
1653   ufoPush(ufoImgGetU32(pfa));
1654 }
1655
1656
1657 //==========================================================================
1658 //
1659 //  ufoDoValue
1660 //
1661 //==========================================================================
1662 static void ufoDoValue (uint32_t pfa) {
1663   ufoPush(ufoImgGetU32(pfa));
1664 }
1665
1666
1667 //==========================================================================
1668 //
1669 //  ufoDoConst
1670 //
1671 //==========================================================================
1672 static void ufoDoConst (uint32_t pfa) {
1673   ufoPush(ufoImgGetU32(pfa));
1674 }
1675
1676
1677 //==========================================================================
1678 //
1679 //  ufoDoDefer
1680 //
1681 //==========================================================================
1682 static void ufoDoDefer (uint32_t pfa) {
1683   const uint32_t cfa = ufoImgGetU32(pfa);
1684   if (cfa != 0) {
1685     ufoRPush(cfa);
1686     ufoVMRPopCFA = 1;
1687   }
1688 }
1689
1690
1691 //==========================================================================
1692 //
1693 //  ufoDoVoc
1694 //
1695 //==========================================================================
1696 static void ufoDoVoc (uint32_t pfa) {
1697   ufoImgPutU32(ufoAddrContext, ufoImgGetU32(pfa));
1698 }
1699
1700
1701 //==========================================================================
1702 //
1703 //  ufoDoCreate
1704 //
1705 //==========================================================================
1706 static void ufoDoCreate (uint32_t pfa) {
1707   ufoPush(pfa);
1708 }
1709
1710
1711 //==========================================================================
1712 //
1713 //  ufoPushInFile
1714 //
1715 //  this also increments last used file id
1716 //
1717 //==========================================================================
1718 static void ufoPushInFile (void) {
1719   if (ufoFileStackPos >= UFO_MAX_NESTED_INCLUDES) ufoFatal("too many includes");
1720   UFOFileStackEntry *stk = &ufoFileStack[ufoFileStackPos];
1721   stk->fl = ufoInFile;
1722   stk->fname = ufoInFileName;
1723   stk->fline = ufoInFileLine;
1724   stk->id = ufoFileId;
1725   stk->incpath = (ufoLastIncPath ? strdup(ufoLastIncPath) : NULL);
1726   stk->sysincpath = (ufoLastSysIncPath ? strdup(ufoLastSysIncPath) : NULL);
1727   ufoFileStackPos += 1;
1728   ufoInFile = NULL;
1729   ufoInFileName = NULL;
1730   ufoInFileLine = 0;
1731   ufoLastUsedFileId += 1;
1732   ufo_assert(ufoLastUsedFileId != 0); // just in case ;-)
1733   //ufoLastIncPath = NULL;
1734 }
1735
1736
1737 //==========================================================================
1738 //
1739 //  ufoWipeIncludeStack
1740 //
1741 //==========================================================================
1742 static void ufoWipeIncludeStack (void) {
1743   if (ufoInFileName) { free(ufoInFileName); ufoInFileName = NULL; }
1744   if (ufoInFile) { fclose(ufoInFile); ufoInFile = NULL; }
1745   if (ufoLastIncPath) { free(ufoLastIncPath); ufoLastIncPath = NULL; }
1746   if (ufoLastSysIncPath) { free(ufoLastSysIncPath); ufoLastSysIncPath = NULL; }
1747   while (ufoFileStackPos != 0) {
1748     ufoFileStackPos -= 1;
1749     UFOFileStackEntry *stk = &ufoFileStack[ufoFileStackPos];
1750     if (stk->fl) fclose(stk->fl);
1751     if (stk->fname) free(stk->fname);
1752     if (stk->incpath) free(stk->incpath);
1753   }
1754 }
1755
1756
1757 //==========================================================================
1758 //
1759 //  ufoPopInFile
1760 //
1761 //==========================================================================
1762 static void ufoPopInFile (void) {
1763   if (ufoFileStackPos == 0) ufoFatal("trying to pop include from empty stack");
1764   if (ufoInFileName) { free(ufoInFileName); ufoInFileName = NULL; }
1765   if (ufoInFile) { fclose(ufoInFile); ufoInFile = NULL; }
1766   if (ufoLastIncPath) { free(ufoLastIncPath); ufoLastIncPath = NULL; }
1767   if (ufoLastSysIncPath) { free(ufoLastSysIncPath); ufoLastSysIncPath = NULL; }
1768   ufoFileStackPos -= 1;
1769   UFOFileStackEntry *stk = &ufoFileStack[ufoFileStackPos];
1770   ufoInFile = stk->fl;
1771   ufoInFileName = stk->fname;
1772   ufoInFileLine = stk->fline;
1773   ufoLastIncPath = stk->incpath;
1774   ufoLastSysIncPath = stk->sysincpath;
1775   ufoFileId = stk->id;
1776   ufoResetTib();
1777   #ifdef UFO_DEBUG_INCLUDE
1778   if (ufoInFileName == NULL) {
1779     fprintf(stderr, "INC-POP: no more files.\n");
1780   } else {
1781     fprintf(stderr, "INC-POP: fname: %s\n", ufoInFileName);
1782   }
1783   #endif
1784 }
1785
1786
1787 //==========================================================================
1788 //
1789 //  ufoDeinit
1790 //
1791 //==========================================================================
1792 void ufoDeinit (void) {
1793   #ifdef UFO_DEBUG_DEBUG
1794   fprintf(stderr, "UFO: debug image used: %u; size: %u\n",
1795           ufoDebugImageUsed, ufoDebugImageSize);
1796   ufoDumpDebugImage();
1797   #endif
1798
1799   // free all states
1800   ufoCurrState = NULL;
1801   ufoYieldedState = NULL;
1802   ufoDebuggerState = NULL;
1803   for (uint32_t fidx = 0; fidx < (uint32_t)(UFO_MAX_STATES/32); fidx += 1u) {
1804     uint32_t bmp = ufoStateUsedBitmap[fidx];
1805     if (bmp != 0) {
1806       uint32_t stid = fidx * 32u;
1807       while (bmp != 0) {
1808         if ((bmp & 0x01) != 0) ufoFreeState(ufoStateMap[stid]);
1809         stid += 1u; bmp >>= 1;
1810       }
1811     }
1812   }
1813
1814   free(ufoDebugImage);
1815   ufoDebugImage = NULL;
1816   ufoDebugImageUsed = 0;
1817   ufoDebugImageSize = 0;
1818   ufoDebugFileId = 0;
1819   ufoDebugLastFRecAddr = 0;
1820   ufoDebugCurrDP = 0;
1821
1822   ufoInBacktrace = 0;
1823   ufoClearCondDefines();
1824   ufoWipeIncludeStack();
1825
1826   // release all includes
1827   ufoInFile = NULL;
1828   if (ufoInFileName) free(ufoInFileName);
1829   if (ufoLastIncPath) free(ufoLastIncPath);
1830   if (ufoLastSysIncPath) free(ufoLastSysIncPath);
1831   ufoInFileName = NULL; ufoLastIncPath = NULL; ufoLastSysIncPath = NULL;
1832   ufoInFileLine = 0;
1833
1834   free(ufoForthCFAs);
1835   ufoForthCFAs = NULL;
1836   ufoCFAsUsed = 0;
1837
1838   free(ufoImage);
1839   ufoImage = NULL;
1840   ufoImageSize = 0;
1841
1842   ufoMode = UFO_MODE_NATIVE;
1843   ufoVSP = 0;
1844   ufoForthVocId = 0; ufoCompilerVocId = 0;
1845   ufoSingleStep = 0;
1846
1847   // free all handles
1848   for (uint32_t f = 0; f < ufoHandlesUsed; f += 1) {
1849     UfoHandle *hh = ufoHandles[f];
1850     if (hh != NULL) {
1851       if (hh->data != NULL) free(hh->data);
1852       free(hh);
1853     }
1854   }
1855   if (ufoHandles != NULL) free(ufoHandles);
1856   ufoHandles = NULL; ufoHandlesUsed = 0; ufoHandlesAlloted = 0;
1857   ufoHandleFreeList = NULL;
1858
1859   ufoLastEmitWasCR = 1;
1860
1861   ufoClearCondDefines();
1862 }
1863
1864
1865 //==========================================================================
1866 //
1867 //  ufoDumpWordHeader
1868 //
1869 //==========================================================================
1870 __attribute__((unused)) static void ufoDumpWordHeader (const uint32_t lfa) {
1871   fprintf(stderr, "=== WORD: LFA: 0x%08x ===\n", lfa);
1872   if (lfa != 0) {
1873     fprintf(stderr, "  (DFA): 0x%08x\n", ufoImgGetU32(UFO_LFA_TO_DFA(lfa)));
1874     fprintf(stderr, "  (XFA): 0x%08x\n", ufoImgGetU32(UFO_LFA_TO_XFA(lfa)));
1875     fprintf(stderr, "  (YFA): 0x%08x\n", ufoImgGetU32(UFO_LFA_TO_YFA(lfa)));
1876     fprintf(stderr, "  (BFA): 0x%08x\n", ufoImgGetU32(UFO_LFA_TO_BFA(lfa)));
1877     fprintf(stderr, "  (LFA): 0x%08x\n", ufoImgGetU32(lfa));
1878     fprintf(stderr, "  (NHH): 0x%08x\n", ufoImgGetU32(UFO_LFA_TO_NHASH(lfa)));
1879     const uint32_t cfa = UFO_LFA_TO_CFA(lfa);
1880     fprintf(stderr, "    CFA: 0x%08x\n", cfa);
1881     fprintf(stderr, "    PFA: 0x%08x\n", UFO_CFA_TO_PFA(cfa));
1882     fprintf(stderr, "  (CFA): 0x%08x\n", ufoImgGetU32(cfa));
1883     const uint32_t nfa = UFO_LFA_TO_NFA(lfa);
1884     const uint32_t nlen = ufoImgGetU8(nfa);
1885     fprintf(stderr, "    NFA: 0x%08x  (nlen: %u)\n", nfa, nlen);
1886     const uint32_t flags = ufoImgGetU32(nfa);
1887     fprintf(stderr, "  FLAGS: 0x%08x\n", flags);
1888     if ((flags & 0xffff0000U) != 0) {
1889       fprintf(stderr, "  FLAGS:");
1890       if (flags & UFW_FLAG_IMMEDIATE) fprintf(stderr, " IMM");
1891       if (flags & UFW_FLAG_SMUDGE) fprintf(stderr, " SMUDGE");
1892       if (flags & UFW_FLAG_NORETURN) fprintf(stderr, " NORET");
1893       if (flags & UFW_FLAG_HIDDEN) fprintf(stderr, " HIDDEN");
1894       if (flags & UFW_FLAG_CBLOCK) fprintf(stderr, " CBLOCK");
1895       if (flags & UFW_FLAG_VOCAB) fprintf(stderr, " VOCAB");
1896       if (flags & UFW_FLAG_SCOLON) fprintf(stderr, " SCOLON");
1897       if (flags & UFW_FLAG_PROTECTED) fprintf(stderr, " PROTECTED");
1898       fputc('\n', stderr);
1899     }
1900     if ((flags & 0xff00U) != 0) {
1901       fprintf(stderr, "   ARGS: ");
1902       switch (flags & UFW_WARG_MASK) {
1903         case UFW_WARG_NONE: fprintf(stderr, "NONE"); break;
1904         case UFW_WARG_BRANCH: fprintf(stderr, "BRANCH"); break;
1905         case UFW_WARG_LIT: fprintf(stderr, "LIT"); break;
1906         case UFW_WARG_C4STRZ: fprintf(stderr, "C4STRZ"); break;
1907         case UFW_WARG_CFA: fprintf(stderr, "CFA"); break;
1908         case UFW_WARG_CBLOCK: fprintf(stderr, "CBLOCK"); break;
1909         case UFW_WARG_VOCID: fprintf(stderr, "VOCID"); break;
1910         case UFW_WARG_C1STRZ: fprintf(stderr, "C1STRZ"); break;
1911         default: fprintf(stderr, "wtf?!"); break;
1912       }
1913       fputc('\n', stderr);
1914     }
1915     fprintf(stderr, "  BACKLEN: %u (nfa at 0x%08x)\n", ufoImgGetU8(cfa - 1u), UFO_CFA_TO_NFA(cfa));
1916     fprintf(stderr, "  NAME(%u): ", nlen);
1917     for (uint32_t f = 0; f < nlen; f += 1) {
1918       const uint8_t ch = ufoImgGetU8(nfa + 4u + f);
1919       if (ch <= 32 || ch >= 127) {
1920         fprintf(stderr, "\\x%02x", ch);
1921       } else {
1922         fprintf(stderr, "%c", (char)ch);
1923       }
1924     }
1925     fprintf(stderr, "\n");
1926     ufo_assert(UFO_CFA_TO_LFA(cfa) == lfa);
1927   }
1928 }
1929
1930
1931 //==========================================================================
1932 //
1933 //  ufoVocCheckName
1934 //
1935 //  return 0 or CFA
1936 //
1937 //==========================================================================
1938 static uint32_t ufoVocCheckName (uint32_t lfa, const void *wname, uint32_t wnlen, uint32_t hash,
1939                                  int allowvochid)
1940 {
1941   uint32_t res = 0;
1942   #ifdef UFO_DEBUG_FIND_WORD
1943   fprintf(stderr, "CHECK-NAME: %.*s; LFA: 0x%08x; hash: 0x%08x (wname: 0x%08x)\n",
1944           (unsigned) wnlen, (const char *)wname,
1945           lfa, (lfa != 0 ? ufoImgGetU32(UFO_LFA_TO_NHASH(lfa)) : 0), hash);
1946   ufoDumpWordHeader(lfa);
1947   #endif
1948   if (lfa != 0 && ufoImgGetU32(UFO_LFA_TO_NHASH(lfa)) == hash) {
1949     const uint32_t lenflags = ufoImgGetU32(UFO_LFA_TO_NFA(lfa));
1950     if ((lenflags & UFW_FLAG_SMUDGE) == 0 &&
1951         (allowvochid || (lenflags & UFW_FLAG_HIDDEN) == 0))
1952     {
1953       const uint32_t nlen = lenflags&0xffU;
1954       if (nlen == wnlen) {
1955         uint32_t naddr = UFO_LFA_TO_NFA(lfa) + 4u;
1956         uint32_t pos = 0;
1957         while (pos < nlen) {
1958           uint8_t c0 = ((const unsigned char *)wname)[pos];
1959           if (c0 >= 'a' && c0 <= 'z') c0 = c0 - 'a' + 'A';
1960           uint8_t c1 = ufoImgGetU8(naddr + pos);
1961           if (c1 >= 'a' && c1 <= 'z') c1 = c1 - 'a' + 'A';
1962           if (c0 != c1) break;
1963           pos += 1u;
1964         }
1965         if (pos == nlen) {
1966           // i found her!
1967           naddr += pos + 1u;
1968           res = UFO_ALIGN4(naddr);
1969         }
1970       }
1971     }
1972   }
1973   return res;
1974 }
1975
1976
1977 //==========================================================================
1978 //
1979 //  ufoFindWordInVoc
1980 //
1981 //  return 0 or CFA
1982 //
1983 //==========================================================================
1984 static uint32_t ufoFindWordInVoc (const void *wname, uint32_t wnlen, uint32_t hash,
1985                                   uint32_t vocid, int allowvochid)
1986 {
1987   uint32_t res = 0;
1988   if (wname == NULL) ufo_assert(wnlen == 0);
1989   if (wnlen != 0 && vocid != 0) {
1990     if (hash == 0) hash = joaatHashBufCI(wname, wnlen);
1991     #if defined(UFO_DEBUG_FIND_WORD) || defined(UFO_DEBUG_FIND_WORD_IN_VOC)
1992     fprintf(stderr, "IN-VOC: %.*s; VOCID: 0x%08x; whash: 0x%08x; htbl[0]: 0x%08x\n",
1993             (unsigned) wnlen, (const char *)wname,
1994             vocid, hash, ufoImgGetU32(vocid + UFW_VOCAB_OFS_HTABLE));
1995     #endif
1996     const uint32_t htbl = vocid + UFW_VOCAB_OFS_HTABLE;
1997     if (ufoImgGetU32(htbl) != UFO_NO_HTABLE_FLAG) {
1998       // hash table present, use it
1999       uint32_t bfa = htbl + (hash % (uint32_t)UFO_HASHTABLE_SIZE) * 4u;
2000       bfa = ufoImgGetU32(bfa);
2001       while (res == 0 && bfa != 0) {
2002         #if defined(UFO_DEBUG_FIND_WORD) || defined(UFO_DEBUG_FIND_WORD_IN_VOC)
2003         fprintf(stderr, "IN-VOC:   bfa: 0x%08x\n", bfa);
2004         #endif
2005         res = ufoVocCheckName(UFO_BFA_TO_LFA(bfa), wname, wnlen, hash, allowvochid);
2006         bfa = ufoImgGetU32(bfa);
2007       }
2008     } else {
2009       // no hash table, use linear search
2010       uint32_t lfa = vocid + UFW_VOCAB_OFS_LATEST;
2011       lfa = ufoImgGetU32(lfa);
2012       while (res == 0 && lfa != 0) {
2013         res = ufoVocCheckName(lfa, wname, wnlen, hash, allowvochid);
2014         lfa = ufoImgGetU32(lfa);
2015       }
2016     }
2017   }
2018   return res;
2019 }
2020
2021
2022 //==========================================================================
2023 //
2024 //  ufoFindColon
2025 //
2026 //  return part after the colon, or `NULL`
2027 //
2028 //==========================================================================
2029 static const void *ufoFindColon (const void *wname, uint32_t wnlen) {
2030   const void *res = NULL;
2031   if (wnlen != 0) {
2032     ufo_assert(wname != NULL);
2033     const char *str = (const char *)wname;
2034     while (wnlen != 0 && str[0] != ':') {
2035       str += 1; wnlen -= 1;
2036     }
2037     if (wnlen != 0) {
2038       res = (const void *)(str + 1); // skip colon
2039     }
2040   }
2041   return res;
2042 }
2043
2044
2045 //==========================================================================
2046 //
2047 //  ufoFindWordInVocAndParents
2048 //
2049 //==========================================================================
2050 static uint32_t ufoFindWordInVocAndParents (const void *wname, uint32_t wnlen, uint32_t hash,
2051                                             uint32_t vocid, int allowvochid)
2052 {
2053   uint32_t res = 0;
2054   if (hash == 0) hash = joaatHashBufCI(wname, wnlen);
2055   while (res == 0 && vocid != 0) {
2056     res = ufoFindWordInVoc(wname, wnlen, hash, vocid, allowvochid);
2057     vocid = ufoImgGetU32(vocid + UFW_VOCAB_OFS_PARENT);
2058   }
2059   return res;
2060 }
2061
2062
2063 //==========================================================================
2064 //
2065 //  ufoFindWordNameRes
2066 //
2067 //  find with name resolution
2068 //
2069 //  return 0 or CFA
2070 //
2071 //==========================================================================
2072 static uint32_t ufoFindWordNameRes (const void *wname, uint32_t wnlen) {
2073   uint32_t res = 0;
2074   if (wnlen != 0 && *(const char *)wname != ':') {
2075     ufo_assert(wname != NULL);
2076
2077     const void *stx = wname;
2078     wname = ufoFindColon(wname, wnlen);
2079     if (wname != NULL) {
2080       // look in all vocabs (excluding hidden ones)
2081       uint32_t xlen = (uint32_t)(ptrdiff_t)(wname - stx) - 1u;
2082       ufo_assert(xlen > 0 && xlen < 255);
2083       uint32_t xhash = joaatHashBufCI(stx, xlen);
2084       uint32_t voclink = ufoImgGetU32(ufoAddrVocLink);
2085       #ifdef UFO_DEBUG_FIND_WORD_COLON
2086       fprintf(stderr, "COLON-FIND: first voc: {%.*s}; xhash=0x%08x; voc-link: 0x%08x\n",
2087               (unsigned)xlen, (const char *)stx, xhash, voclink);
2088       #endif
2089       while (res == 0 && voclink != 0) {
2090         const uint32_t vhdraddr = voclink - UFW_VOCAB_OFS_VOCLINK + UFW_VOCAB_OFS_HEADER;
2091         const uint32_t vhdr = ufoImgGetU32(vhdraddr);
2092         if (vhdr != 0) {
2093           res = ufoVocCheckName(UFO_NFA_TO_LFA(vhdr), stx, xlen, xhash, 0);
2094         }
2095         if (res == 0) voclink = ufoImgGetU32(voclink);
2096       }
2097       if (res != 0) {
2098         uint32_t vocid = voclink - UFW_VOCAB_OFS_VOCLINK;
2099         ufo_assert(voclink != 0);
2100         wnlen -= xlen + 1;
2101         #ifdef UFO_DEBUG_FIND_WORD_COLON
2102         fprintf(stderr, "searching {%.*s}(%u) in {%.*s}\n",
2103                 (unsigned)wnlen, wname, wnlen, (unsigned)xlen, stx);
2104         #endif
2105         while (res != 0 && wname != NULL) {
2106           stx = wname;
2107           wname = ufoFindColon(wname, wnlen);
2108           if (wname == NULL) xlen = wnlen; else xlen = (uint32_t)(ptrdiff_t)(wname - stx) - 1u;
2109           ufo_assert(xlen > 0 && xlen < 255);
2110           res = ufoFindWordInVocAndParents(stx, xlen, 0, vocid, 1);
2111           if (res != 0) {
2112             wnlen -= xlen + 1;
2113             if (wname != NULL) {
2114               // it should be a vocabulary
2115               const uint32_t nfa = UFO_CFA_TO_NFA(res);
2116               if ((ufoImgGetU32(nfa) & UFW_FLAG_VOCAB) != 0) {
2117                 vocid = ufoImgGetU32(UFO_CFA_TO_PFA(res)); // pfa points to vocabulary
2118               } else {
2119                 res = 0;
2120               }
2121             }
2122           }
2123         }
2124       }
2125     }
2126   }
2127
2128   return res;
2129 }
2130
2131
2132 //==========================================================================
2133 //
2134 //  ufoFindWord
2135 //
2136 //  doesn't look in CURRENT, does name resolution ("a:b" is word "b" in "a")
2137 //
2138 //  return 0 or CFA
2139 //
2140 //==========================================================================
2141 static uint32_t ufoFindWord (const char *wname) {
2142   uint32_t res = 0;
2143   if (wname && wname[0] != 0) {
2144     const size_t wnlen = strlen(wname);
2145     ufo_assert(wnlen < 8192);
2146     uint32_t ctx = ufoImgGetU32(ufoAddrContext);
2147     const uint32_t hash = joaatHashBufCI(wname, (uint32_t)wnlen);
2148
2149     //fprintf(stderr, "FIND-WORD: whash: 0x%08x; name:{%s}\n", hash, wname);
2150
2151     // first search in context
2152     res = ufoFindWordInVocAndParents(wname, (uint32_t)wnlen, hash, ctx, (ctx == ufoImgGetU32(ufoAddrCurrent)));
2153
2154     // now try vocabulary stack
2155     uint32_t vstp = ufoVSP;
2156     while (res == 0 && vstp != 0) {
2157       vstp -= 1;
2158       ctx = ufoVocStack[vstp];
2159       res = ufoFindWordInVocAndParents(wname, (uint32_t)wnlen, hash, ctx, (ctx == ufoImgGetU32(ufoAddrCurrent)));
2160     }
2161
2162     // if not found, try name resolution
2163     if (res == 0) res = ufoFindWordNameRes(wname, (uint32_t)wnlen);
2164   }
2165
2166   return res;
2167 }
2168
2169
2170 //==========================================================================
2171 //
2172 //  ufoCreateWordHeader
2173 //
2174 //  create word header up to CFA, link to the current dictionary
2175 //
2176 //==========================================================================
2177 static void ufoCreateWordHeader (const char *wname, uint32_t flags) {
2178   if (wname == NULL) wname = "";
2179   const size_t wnlen = strlen(wname);
2180   ufo_assert(wnlen < UFO_MAX_WORD_LENGTH);
2181   const uint32_t hash = joaatHashBufCI(wname, (uint32_t)wnlen);
2182   const uint32_t curr = ufoImgGetU32(ufoAddrCurrent);
2183   ufo_assert(curr != 0);
2184   // redefine check
2185   if (wnlen != 0 && ufoImgGetU32(ufoAddrRedefineWarning) != UFO_REDEF_WARN_DONT_CARE) {
2186     const uint32_t cfa = ufoFindWordInVoc(wname, wnlen, hash, curr, 1);
2187     if (cfa) {
2188       const uint32_t nfa = UFO_CFA_TO_NFA(cfa);
2189       const uint32_t flags = ufoImgGetU32(nfa);
2190       if ((flags & UFW_FLAG_PROTECTED) != 0) {
2191         ufoFatal("trying to redefine protected word '%s'", wname);
2192       } else if (ufoImgGetU32(ufoAddrRedefineWarning) != UFO_REDEF_WARN_NONE) {
2193         ufoWarning("redefining word '%s'", wname);
2194       }
2195     }
2196   }
2197   //fprintf(stderr, "000: HERE: 0x%08x\n", UFO_GET_DP());
2198   const uint32_t bkt = (hash % (uint32_t)UFO_HASHTABLE_SIZE) * 4u;
2199   const uint32_t htbl = curr + UFW_VOCAB_OFS_HTABLE;
2200   ufoImgEmitAlign();
2201   ufoImgEmitU32(0); // dfa
2202   const uint32_t xfaAddr = UFO_GET_DP();
2203   if ((xfaAddr & UFO_ADDR_TEMP_BIT) == 0) {
2204     // link previous yfa here
2205     const uint32_t lastxfa = ufoImgGetU32(ufoAddrLastXFA);
2206     // fix YFA of the previous word
2207     if (lastxfa != 0) {
2208       ufoImgPutU32(UFO_XFA_TO_YFA(lastxfa), UFO_XFA_TO_YFA(xfaAddr));
2209     }
2210     // our XFA points to the previous XFA
2211     ufoImgEmitU32(lastxfa); // xfa
2212     // update last XFA
2213     ufoImgPutU32(ufoAddrLastXFA, xfaAddr);
2214   } else {
2215     ufoImgEmitU32(0); // xfa
2216   }
2217   ufoImgEmitU32(0); // yfa
2218   // bucket link (bfa)
2219   if (wnlen == 0 || ufoImgGetU32(htbl) == UFO_NO_HTABLE_FLAG) {
2220     ufoImgEmitU32(0);
2221   } else {
2222     #ifdef UFO_DEBUG_DUMP_NEW_HEADERS
2223     fprintf(stderr, "NEW HEADER: %s; curr: 0x%08x; htbl: 0x%08x; bkt: 0x%08x\n",
2224             wname, curr, htbl, bkt);
2225     fprintf(stderr, "  [bkt]: 0x%08x; nbk: 0x%08x\n", ufoImgGetU32(htbl + bkt), UFO_GET_DP());
2226     #endif
2227     // bfa points to bfa
2228     const uint32_t bfa = UFO_GET_DP();
2229     ufoImgEmitU32(ufoImgGetU32(htbl + bkt));
2230     ufoImgPutU32(htbl + bkt, bfa);
2231   }
2232   // lfa
2233   const uint32_t lfa = UFO_GET_DP();
2234   ufoImgEmitU32(ufoImgGetU32(curr + UFW_VOCAB_OFS_LATEST));
2235   // fix voc latest
2236   ufoImgPutU32(curr + UFW_VOCAB_OFS_LATEST, lfa);
2237   // name hash
2238   ufoImgEmitU32(hash);
2239   // name length
2240   const uint32_t nfa = UFO_GET_DP();
2241   ufoImgEmitU32(((uint32_t)wnlen&0xffU) | (flags & 0xffffff00U));
2242   const uint32_t nstart = UFO_GET_DP();
2243   // put name
2244   for (size_t f = 0; f < wnlen; f += 1) {
2245     ufoImgEmitU8(((const unsigned char *)wname)[f]);
2246   }
2247   while ((UFO_GET_DP() & 3) != 3) ufoImgEmitU8(0);
2248   const uint32_t nend = UFO_GET_DP(); // length byte itself is not included
2249   // name length, again
2250   ufo_assert(nend - nstart <= 255);
2251   ufoImgEmitU8((uint8_t)(nend - nstart));
2252   ufo_assert((UFO_GET_DP() & 3) == 0);
2253   ufo_assert(UFO_CFA_TO_NFA(UFO_GET_DP()) == nfa);
2254   if ((nend & UFO_ADDR_SPECIAL_BITS_MASK) == 0) ufoRecordDebug(nend);
2255   #ifdef UFO_DEBUG_DUMP_NEW_HEADERS
2256   fprintf(stderr, "*** NEW HEADER ***\n");
2257   fprintf(stderr, "CFA: 0x%08x\n", UFO_GET_DP());
2258   fprintf(stderr, "NSTART: 0x%08x\n", nstart);
2259   fprintf(stderr, "NEND: 0x%08x\n", nend);
2260   fprintf(stderr, "NLEN: %u (%u)\n", nend - nstart, ufoImgGetU8(UFO_GET_DP() - 1u));
2261   ufoDumpWordHeader(lfa);
2262   #endif
2263   #if 0
2264   fprintf(stderr, "NEW WORD CFA 0x%08x: %s\n", UFO_GET_DP(), wname);
2265   #endif
2266 }
2267
2268
2269 //==========================================================================
2270 //
2271 //  ufoDecompilePart
2272 //
2273 //==========================================================================
2274 static void ufoDecompilePart (uint32_t addr, uint32_t eaddr, int indent) {
2275   uint32_t count;
2276   FILE *fo = stdout;
2277   while (addr < eaddr) {
2278     uint32_t cfa = ufoImgGetU32(addr);
2279     for (int n = 0; n < indent; n += 1) fputc(' ', fo);
2280     fprintf(fo, "%6u: 0x%08x: ", addr, cfa);
2281     uint32_t nfa = UFO_CFA_TO_NFA(cfa);
2282     uint32_t flags = ufoImgGetU32(nfa);
2283     //fprintf(fo, "[0x%08x] ", flags & UFW_WARG_MASK);
2284     uint32_t nlen = flags & 0xffU;
2285     for (uint32_t f = 0; f < nlen; f += 1) {
2286       const uint8_t ch = ufoImgGetU8(nfa + 4u + f);
2287       if (ch <= 32 || ch >= 127) {
2288         fprintf(fo, "\\x%02x", ch);
2289       } else {
2290         fprintf(fo, "%c", (char)ch);
2291       }
2292     }
2293     addr += 4u;
2294     switch (flags & UFW_WARG_MASK) {
2295       case UFW_WARG_NONE:
2296         break;
2297       case UFW_WARG_BRANCH:
2298         fprintf(fo, "  @%u", ufoImgGetU32(addr)); addr += 4u;
2299         break;
2300       case UFW_WARG_LIT:
2301         fprintf(fo, "  %u : %d : 0x%08x", ufoImgGetU32(addr),
2302                 (int32_t)ufoImgGetU32(addr), ufoImgGetU32(addr)); addr += 4u;
2303         break;
2304       case UFW_WARG_C4STRZ:
2305         count = ufoImgGetU32(addr); addr += 4;
2306        print_str:
2307         fprintf(fo, "  str:");
2308         for (int f = 0; f < count; f += 1) {
2309           const uint8_t ch = ufoImgGetU8(addr); addr += 1u;
2310           if (ch <= 32 || ch >= 127) {
2311             fprintf(fo, "\\x%02x", ch);
2312           } else {
2313             fprintf(fo, "%c", (char)ch);
2314           }
2315         }
2316         addr += 1u; // skip zero byte
2317         addr = UFO_ALIGN4(addr);
2318         break;
2319       case UFW_WARG_CFA:
2320         cfa = ufoImgGetU32(addr); addr += 4u;
2321         fprintf(fo, "  CFA:%u: ", cfa);
2322         nfa = UFO_CFA_TO_NFA(cfa);
2323         nlen = ufoImgGetU8(nfa);
2324         for (uint32_t f = 0; f < nlen; f += 1) {
2325           const uint8_t ch = ufoImgGetU8(nfa + 4u + f);
2326           if (ch <= 32 || ch >= 127) {
2327             fprintf(fo, "\\x%02x", ch);
2328           } else {
2329             fprintf(fo, "%c", (char)ch);
2330           }
2331         }
2332         break;
2333       case UFW_WARG_CBLOCK:
2334         fprintf(fo, "  CBLOCK:%u", ufoImgGetU32(addr)); addr += 4u;
2335         break;
2336       case UFW_WARG_VOCID:
2337         fprintf(fo, "  VOCID:%u", ufoImgGetU32(addr)); addr += 4u;
2338         break;
2339       case UFW_WARG_C1STRZ:
2340         count = ufoImgGetU8(addr); addr += 1;
2341         goto print_str;
2342       /*
2343       case UFW_WARG_U8:
2344         fprintf(fo, "  ubyte:%u", ufoImgGetU8(addr)); addr += 1u;
2345         break;
2346       case UFW_WARG_S8:
2347         fprintf(fo, "  sbyte:%u", ufoImgGetU8(addr)); addr += 1u;
2348         break;
2349       case UFW_WARG_U16:
2350         fprintf(fo, "  uword:%u", ufoImgGetU16(addr)); addr += 2u;
2351         break;
2352       case UFW_WARG_S16:
2353         fprintf(fo, "  sword:%u", ufoImgGetU16(addr)); addr += 2u;
2354         break;
2355       */
2356       default:
2357         fprintf(fo, " -- WTF?!\n");
2358         abort();
2359     }
2360     fputc('\n', fo);
2361   }
2362 }
2363
2364
2365 //==========================================================================
2366 //
2367 //  ufoDecompileWord
2368 //
2369 //==========================================================================
2370 static void ufoDecompileWord (const uint32_t cfa) {
2371   if (cfa != 0) {
2372     const uint32_t lfa = UFO_CFA_TO_LFA(cfa);
2373     fprintf(stdout, "#### DECOMPILING CFA %u ###\n", cfa);
2374     ufoDumpWordHeader(lfa);
2375     const uint32_t yfa = ufoGetWordEndAddr(cfa);
2376     if (ufoImgGetU32(cfa) == ufoDoForthCFA) {
2377       fprintf(stdout, "--- DECOMPILED CODE ---\n");
2378       ufoDecompilePart(UFO_CFA_TO_PFA(cfa), yfa, 0);
2379       fprintf(stdout, "=======================\n");
2380     }
2381   }
2382 }
2383
2384
2385 //==========================================================================
2386 //
2387 //  ufoBTShowWordName
2388 //
2389 //==========================================================================
2390 static void ufoBTShowWordName (uint32_t nfa) {
2391   if (nfa != 0) {
2392     uint32_t len = ufoImgGetU8(nfa); nfa += 4u;
2393     //fprintf(stderr, "(0x%08x)", ufoImgGetU32(nfa - 4u));
2394     while (len != 0) {
2395       uint8_t ch = ufoImgGetU8(nfa); nfa += 1u; len -= 1u;
2396       if (ch <= 32 || ch >= 127) {
2397         fprintf(stderr, "\\x%02x", ch);
2398       } else {
2399         fprintf(stderr, "%c", (char)ch);
2400       }
2401     }
2402   }
2403 }
2404
2405
2406 //==========================================================================
2407 //
2408 //  ufoBacktrace
2409 //
2410 //==========================================================================
2411 static void ufoBacktrace (uint32_t ip) {
2412   // dump data stack (top 16)
2413   if (!ufoLastEmitWasCR) { printf("\n"); ufoLastEmitWasCR = 1; }
2414   fflush(NULL);
2415
2416   fprintf(stderr, "***UFO STACK DEPTH: %u\n", ufoSP);
2417   uint32_t xsp = ufoSP;
2418   if (xsp > 16) xsp = 16;
2419   for (uint32_t sp = 0; sp < xsp; ++sp) {
2420     fprintf(stderr, "  %2u: 0x%08x  %d\n", sp,
2421             ufoDStack[xsp - sp - 1], (int32_t)ufoDStack[xsp - sp - 1]);
2422   }
2423   if (ufoSP > 16) fprintf(stderr, "    ...more...\n");
2424
2425   // dump return stack (top 32)
2426   uint32_t nfa;
2427   uint32_t fline;
2428   const char *fname;
2429
2430   fprintf(stderr, "***UFO RETURN STACK DEPTH: %u\n", ufoRP);
2431   if (ip != 0) {
2432     nfa = ufoFindWordForIP(ip);
2433     if (nfa != 0) {
2434       fprintf(stderr, "  **: %8u -- ", ip);
2435       ufoBTShowWordName(nfa);
2436       fname = ufoFindFileForIP(ip, &fline);
2437       if (fname != NULL) { fprintf(stderr, " (at %s:%u)", fname, fline); }
2438       fputc('\n', stderr);
2439     }
2440   }
2441   uint32_t rp = ufoRP;
2442   uint32_t rscount = 0;
2443   if (rp > UFO_RSTACK_SIZE) rp = UFO_RSTACK_SIZE;
2444   while (rscount != 32 && rp != 0) {
2445     rp -= 1;
2446     const uint32_t val = ufoRStack[rp];
2447     nfa = ufoFindWordForIP(val);
2448     if (nfa != 0) {
2449       fprintf(stderr, "  %2u: %8u -- ", ufoRP - rp - 1u, val);
2450       ufoBTShowWordName(nfa);
2451       fname = ufoFindFileForIP(val - 4u, &fline);
2452       if (fname != NULL) { fprintf(stderr, " (at %s:%u)", fname, fline); }
2453       fputc('\n', stderr);
2454     } else {
2455       fprintf(stderr, "  %2u: 0x%08x  %d\n", ufoRP - rp - 1u, val, (int32_t)val);
2456     }
2457     rscount += 1;
2458   }
2459   if (ufoRP > 32) fprintf(stderr, "    ...more...\n");
2460
2461   fflush(NULL);
2462 }
2463
2464
2465 //==========================================================================
2466 //
2467 //  ufoDumpVocab
2468 //
2469 //==========================================================================
2470 /*
2471 static void ufoDumpVocab (uint32_t vocid) {
2472   if (vocid != 0) {
2473     fprintf(stderr, "*** VOCID: 0x%08x ***\n", vocid);
2474     uint32_t vochdr = vocid + UFW_VOCAB_OFS_HEADER;
2475     vochdr = ufoImgGetU32(vochdr);
2476     if (vochdr != 0) {
2477       fprintf(stderr, "--- HEADER ---\n");
2478       ufoDumpWordHeader(UFO_NFA_TO_LFA(vochdr));
2479       fprintf(stderr, "========\n");
2480       uint32_t htbl = vocid + UFW_VOCAB_OFS_HTABLE;
2481       if (ufoImgGetU32(htbl) != UFO_NO_HTABLE_FLAG) {
2482         fprintf(stderr, "--- HASH TABLE ---\n");
2483         for (int f = 0; f < UFO_HASHTABLE_SIZE; f += 1) {
2484           uint32_t bfa = ufoImgGetU32(htbl);
2485           if (bfa != 0) {
2486             fprintf(stderr, "**** %2d: 0x%08x\n", f, bfa);
2487             do {
2488               ufoDumpWordHeader(UFO_BFA_TO_LFA(bfa));
2489               bfa = ufoImgGetU32(bfa);
2490             } while (bfa != 0);
2491           }
2492           htbl += 4u;
2493         }
2494       }
2495     }
2496   }
2497 }
2498 */
2499
2500
2501 // if set, this will be used when we are out of include files. intended for UrAsm.
2502 // return 0 if there is no more lines, otherwise the string should be copied
2503 // to buffer, `*fname` and `*fline` should be properly set.
2504 int (*ufoFileReadLine) (void *buf, size_t bufsize, const char **fname, int *fline) = NULL;
2505
2506
2507 //==========================================================================
2508 //
2509 //  ufoLoadNextUserLine
2510 //
2511 //==========================================================================
2512 static int ufoLoadNextUserLine (void) {
2513   uint32_t tibPos = 0;
2514   const char *fname = NULL;
2515   int fline = 0;
2516   ufoResetTib();
2517   if (ufoFileReadLine != NULL && ufoFileReadLine(ufoCurrFileLine, 510, &fname, &fline) != 0) {
2518     ufoCurrFileLine[510] = 0;
2519     uint32_t slen = (uint32_t)strlen(ufoCurrFileLine);
2520     while (slen != 0 && (ufoCurrFileLine[slen - 1u] == 10 || ufoCurrFileLine[slen - 1u] == 13)) {
2521       slen -= 1u;
2522     }
2523     if (tibPos + slen + 1u > UFO_ADDR_HANDLE_OFS_MASK) {
2524       ufoFatal("input text line too long (at least %u bytes)", tibPos + slen);
2525     }
2526     ufoTibEnsureSize(tibPos + slen + 1u);
2527     for (uint32_t f = 0; f < slen; f += 1) {
2528       ufoTibPokeChOfs(((const unsigned char *)ufoCurrFileLine)[f], tibPos + f);
2529     }
2530     ufoTibPokeChOfs(0, tibPos + slen);
2531     tibPos += slen;
2532     if (fname == NULL) fname = "<user>";
2533     if (ufoInFileName == NULL || strcmp(ufoInFileName, fname) != 0) {
2534       free(ufoInFileName);
2535       ufoInFileName = strdup(fname);
2536       if (ufoInFileName == NULL) ufoFatal("out of memory");
2537     }
2538     ufoInFileLine = fline;
2539     return 1;
2540   } else {
2541     return 0;
2542   }
2543 }
2544
2545
2546 //==========================================================================
2547 //
2548 //  ufoLoadNextLine_NativeMode
2549 //
2550 //  load next file line into TIB
2551 //  always strips final '\n'
2552 //
2553 //  return 0 on EOF, 1 on success
2554 //
2555 //==========================================================================
2556 static int ufoLoadNextLine (int crossInclude) {
2557   int done = 0;
2558   uint32_t tibPos = 0;
2559   ufoResetTib();
2560
2561   if (ufoMode == UFO_MODE_MACRO) {
2562     //fprintf(stderr, "***MAC!\n");
2563     return 0;
2564   }
2565
2566   while (ufoInFile != NULL && !done) {
2567     if (fgets(ufoCurrFileLine, 510, ufoInFile) != NULL) {
2568       // check for a newline
2569       // if there is no newline char at the end, the string was truncated
2570       ufoCurrFileLine[510] = 0;
2571       const uint32_t slen = (uint32_t)strlen(ufoCurrFileLine);
2572       if (tibPos + slen + 1u > UFO_ADDR_HANDLE_OFS_MASK) {
2573         ufoFatal("input text line too long (at least %u bytes)", tibPos + slen);
2574       }
2575       ufoTibEnsureSize(tibPos + slen + 1u);
2576       for (uint32_t f = 0; f < slen; f += 1) {
2577         ufoTibPokeChOfs(((const unsigned char *)ufoCurrFileLine)[f], tibPos + f);
2578       }
2579       ufoTibPokeChOfs(0, tibPos + slen);
2580       tibPos += slen;
2581       if (slen != 0 && (ufoCurrFileLine[slen - 1u] == 13 || ufoCurrFileLine[slen - 1u] == 10)) {
2582         ++ufoInFileLine;
2583         done = 1;
2584       } else {
2585         // continuation, nothing to do
2586       }
2587     } else {
2588       // if we read nothing, this is EOF
2589       if (tibPos == 0 && crossInclude) {
2590         // we read nothing, and allowed to cross include boundaries
2591         ufoPopInFile();
2592       } else {
2593         done = 1;
2594       }
2595     }
2596   }
2597
2598   if (tibPos == 0) {
2599     // eof, try user-supplied input
2600     if (ufoFileStackPos == 0) {
2601       return ufoLoadNextUserLine();
2602     } else {
2603       return 0;
2604     }
2605   } else {
2606     // if we read at least something, this is not EOF
2607     return 1;
2608   }
2609 }
2610
2611
2612 // ////////////////////////////////////////////////////////////////////////// //
2613 // debug
2614
2615 // DUMP-STACK
2616 // ( -- )
2617 UFWORD(DUMP_STACK) {
2618   if (!ufoLastEmitWasCR) { printf("\n"); ufoLastEmitWasCR = 1; }
2619   printf("***UFO STACK DEPTH: %u\n", ufoSP);
2620   uint32_t left = 32;
2621   uint32_t sp = ufoSP;
2622   while (sp != 0 && left != 0) {
2623     sp -= 1; left -= 1;
2624     printf("  %4u: 0x%08x  %d\n", sp, ufoDStack[sp], (int32_t)ufoDStack[sp]);
2625   }
2626   if (sp != 0) printf("...more...\n");
2627   ufoLastEmitWasCR = 1;
2628 }
2629
2630 // BACKTRACE
2631 UFWORD(UFO_BACKTRACE) {
2632   if (!ufoLastEmitWasCR) { printf("\n"); ufoLastEmitWasCR = 1; }
2633   fflush(NULL);
2634   if (ufoInFile != NULL) {
2635     fprintf(stderr, "*** at file %s, line %d ***\n", ufoInFileName, ufoInFileLine);
2636   } else {
2637     fprintf(stderr, "*** somewhere in time ***\n");
2638   }
2639   ufoBacktrace(ufoIP);
2640 }
2641
2642
2643 // ////////////////////////////////////////////////////////////////////////// //
2644 // SP0!
2645 // ( -- )
2646 UFWORD(SP0_STORE) { ufoSP = 0; }
2647
2648 // RP0!
2649 // ( -- )
2650 UFWORD(RP0_STORE) {
2651   if (ufoRP != ufoRPTop) {
2652     ufoRP = ufoRPTop;
2653     // we need to push a dummy value
2654     ufoRPush(0xdeadf00d);
2655   }
2656 }
2657
2658 // PAD
2659 // ( -- pad )
2660 // PAD is at the beginning of temp area
2661 UFWORD(PAD) {
2662   ufoPush(UFO_PAD_ADDR);
2663 }
2664
2665
2666 // ////////////////////////////////////////////////////////////////////////// //
2667 // peeks and pokes with address register
2668 //
2669
2670 // A>
2671 // ( -- regA )
2672 UFWORD(REGA_LOAD) {
2673   ufoPush(ufoRegA);
2674 }
2675
2676 // >A
2677 // ( regA -- )
2678 UFWORD(REGA_STORE) {
2679   ufoRegA = ufoPop();
2680 }
2681
2682 // A-SWAP
2683 // ( regA -- oldA )
2684 // swap TOS and A
2685 UFWORD(REGA_SWAP) {
2686   const uint32_t newa = ufoPop();
2687   ufoPush(ufoRegA);
2688   ufoRegA = newa;
2689 }
2690
2691
2692 // ////////////////////////////////////////////////////////////////////////// //
2693 // useful to work with handles and normal addreses uniformly
2694 //
2695
2696 // C@A+
2697 // ( idx -- byte )
2698 UFWORD(CPEEK_REGA_IDX) {
2699   if ((ufoRegA & UFO_ADDR_HANDLE_BIT) == 0) {
2700     const uint32_t idx = ufoPop();
2701     const uint32_t newaddr = ufoRegA + idx;
2702     if ((ufoRegA & UFO_ADDR_SPECIAL_BITS_MASK) == (newaddr & UFO_ADDR_SPECIAL_BITS_MASK)) {
2703       ufoPush(ufoImgGetU8Ext(newaddr));
2704     } else {
2705       ufoFatal("address offset out of range; addr=0x%08x; offset=%u; res=0x%08x",
2706                ufoRegA, idx, newaddr);
2707     }
2708   } else {
2709     ufoPush(ufoRegA);
2710     UFCALL(PAR_HANDLE_LOAD_BYTE);
2711   }
2712 }
2713
2714 // W@A+
2715 // ( idx -- word )
2716 UFWORD(WPEEK_REGA_IDX) {
2717   if ((ufoRegA & UFO_ADDR_HANDLE_BIT) == 0) {
2718     const uint32_t idx = ufoPop();
2719     const uint32_t newaddr = ufoRegA + idx;
2720     if ((ufoRegA & UFO_ADDR_SPECIAL_BITS_MASK) == (newaddr & UFO_ADDR_SPECIAL_BITS_MASK) &&
2721         (ufoRegA & UFO_ADDR_SPECIAL_BITS_MASK) == ((newaddr + 1u) & UFO_ADDR_SPECIAL_BITS_MASK))
2722     {
2723       ufoPush(ufoImgGetU16(newaddr));
2724     } else {
2725       ufoFatal("address offset out of range; addr=0x%08x; offset=%u; res=0x%08x",
2726                ufoRegA, idx, newaddr);
2727     }
2728   } else {
2729     ufoPush(ufoRegA);
2730     UFCALL(PAR_HANDLE_LOAD_WORD);
2731   }
2732 }
2733
2734 // @A+
2735 // ( idx -- value )
2736 UFWORD(PEEK_REGA_IDX) {
2737   if ((ufoRegA & UFO_ADDR_HANDLE_BIT) == 0) {
2738     const uint32_t idx = ufoPop();
2739     const uint32_t newaddr = ufoRegA + idx;
2740     if ((ufoRegA & UFO_ADDR_SPECIAL_BITS_MASK) == (newaddr & UFO_ADDR_SPECIAL_BITS_MASK) &&
2741         (ufoRegA & UFO_ADDR_SPECIAL_BITS_MASK) == ((newaddr + 3u) & UFO_ADDR_SPECIAL_BITS_MASK))
2742     {
2743       ufoPush(ufoImgGetU32(newaddr));
2744     } else {
2745       ufoFatal("address offset out of range; addr=0x%08x; offset=%u; res=0x%08x",
2746                ufoRegA, idx, newaddr);
2747     }
2748   } else {
2749     ufoPush(ufoRegA);
2750     UFCALL(PAR_HANDLE_LOAD_CELL);
2751   }
2752 }
2753
2754 // C!A+
2755 // ( byte idx -- )
2756 UFWORD(CPOKE_REGA_IDX) {
2757   if ((ufoRegA & UFO_ADDR_HANDLE_BIT) == 0) {
2758     const uint32_t idx = ufoPop();
2759     const uint32_t newaddr = ufoRegA + idx;
2760     if ((ufoRegA & UFO_ADDR_SPECIAL_BITS_MASK) == (newaddr & UFO_ADDR_SPECIAL_BITS_MASK)) {
2761       const uint32_t value = ufoPop();
2762       ufoImgPutU8(newaddr, value);
2763     } else {
2764       ufoFatal("address offset out of range; addr=0x%08x; offset=%u; res=0x%08x",
2765                ufoRegA, idx, newaddr);
2766     }
2767   } else {
2768     ufoPush(ufoRegA);
2769     UFCALL(PAR_HANDLE_STORE_BYTE);
2770   }
2771 }
2772
2773 // W!A+
2774 // ( word idx -- )
2775 UFWORD(WPOKE_REGA_IDX) {
2776   if ((ufoRegA & UFO_ADDR_HANDLE_BIT) == 0) {
2777     const uint32_t idx = ufoPop();
2778     const uint32_t newaddr = ufoRegA + idx;
2779     if ((ufoRegA & UFO_ADDR_SPECIAL_BITS_MASK) == (newaddr & UFO_ADDR_SPECIAL_BITS_MASK) &&
2780         (ufoRegA & UFO_ADDR_SPECIAL_BITS_MASK) == ((newaddr + 1u) & UFO_ADDR_SPECIAL_BITS_MASK))
2781     {
2782       const uint32_t value = ufoPop();
2783       ufoImgPutU16(newaddr, value);
2784     } else {
2785       ufoFatal("address offset out of range; addr=0x%08x; offset=%u; res=0x%08x",
2786                ufoRegA, idx, newaddr);
2787     }
2788   } else {
2789     ufoPush(ufoRegA);
2790     UFCALL(PAR_HANDLE_STORE_WORD);
2791   }
2792 }
2793
2794 // !A+
2795 // ( value idx -- )
2796 UFWORD(POKE_REGA_IDX) {
2797   if ((ufoRegA & UFO_ADDR_HANDLE_BIT) == 0) {
2798     const uint32_t idx = ufoPop();
2799     const uint32_t newaddr = ufoRegA + idx;
2800     if ((ufoRegA & UFO_ADDR_SPECIAL_BITS_MASK) == (newaddr & UFO_ADDR_SPECIAL_BITS_MASK) &&
2801         (ufoRegA & UFO_ADDR_SPECIAL_BITS_MASK) == ((newaddr + 3u) & UFO_ADDR_SPECIAL_BITS_MASK))
2802     {
2803       const uint32_t value = ufoPop();
2804       ufoImgPutU32(newaddr, value);
2805     } else {
2806       ufoFatal("address offset out of range; addr=0x%08x; offset=%u; res=0x%08x",
2807                ufoRegA, idx, newaddr);
2808     }
2809   } else {
2810     ufoPush(ufoRegA);
2811     UFCALL(PAR_HANDLE_STORE_CELL);
2812   }
2813 }
2814
2815
2816 // ////////////////////////////////////////////////////////////////////////// //
2817 // peeks and pokes
2818 //
2819
2820 // C@
2821 // ( addr -- value8 )
2822 UFWORD(CPEEK) {
2823   ufoPush(ufoImgGetU8Ext(ufoPop()));
2824 }
2825
2826 // W@
2827 // ( addr -- value16 )
2828 UFWORD(WPEEK) {
2829   const uint32_t addr = ufoPop();
2830   if ((addr & UFO_ADDR_HANDLE_BIT) == 0) {
2831     ufoPush(ufoImgGetU16(addr));
2832   } else {
2833     ufoPush(0);
2834     ufoPush(addr);
2835     UFCALL(PAR_HANDLE_LOAD_WORD);
2836   }
2837 }
2838
2839 // @
2840 // ( addr -- value32 )
2841 UFWORD(PEEK) {
2842   const uint32_t addr = ufoPop();
2843   if ((addr & UFO_ADDR_HANDLE_BIT) == 0) {
2844     ufoPush(ufoImgGetU32(addr));
2845   } else {
2846     ufoPush(0);
2847     ufoPush(addr);
2848     UFCALL(PAR_HANDLE_LOAD_CELL);
2849   }
2850 }
2851
2852 // C!
2853 // ( val8 addr -- )
2854 UFWORD(CPOKE) {
2855   const uint32_t addr = ufoPop();
2856   const uint32_t val = ufoPop();
2857   ufoImgPutU8Ext(addr, val);
2858 }
2859
2860 // W!
2861 // ( val16 addr -- )
2862 UFWORD(WPOKE) {
2863   const uint32_t addr = ufoPop();
2864   const uint32_t val = ufoPop();
2865   if ((addr & UFO_ADDR_HANDLE_BIT) == 0) {
2866     ufoImgPutU16(addr, val);
2867   } else {
2868     ufoPush(val);
2869     ufoPush(0);
2870     ufoPush(addr);
2871     UFCALL(PAR_HANDLE_STORE_WORD);
2872   }
2873 }
2874
2875 // !
2876 // ( val32 addr -- )
2877 UFWORD(POKE) {
2878   const uint32_t addr = ufoPop();
2879   const uint32_t val = ufoPop();
2880   if ((addr & UFO_ADDR_HANDLE_BIT) == 0) {
2881     ufoImgPutU32(addr, val);
2882   } else {
2883     ufoPush(val);
2884     ufoPush(0);
2885     ufoPush(addr);
2886     UFCALL(PAR_HANDLE_STORE_CELL);
2887   }
2888 }
2889
2890
2891 // ////////////////////////////////////////////////////////////////////////// //
2892 // dictionary emitters
2893 //
2894
2895 // C,
2896 // ( val8 -- )
2897 UFWORD(CCOMMA) { const uint32_t val = ufoPop(); ufoImgEmitU8(val); }
2898
2899 // W,
2900 // ( val16 -- )
2901 UFWORD(WCOMMA) { const uint32_t val = ufoPop(); ufoImgEmitU8(val&0xffU); ufoImgEmitU8((val >> 8)&0xffU); }
2902
2903 // ,
2904 // ( val -- )
2905 UFWORD(COMMA) { const uint32_t val = ufoPop(); ufoImgEmitU32(val); }
2906
2907
2908 // ////////////////////////////////////////////////////////////////////////// //
2909 // literal pushers
2910 //
2911
2912
2913 // (LIT) ( -- n )
2914 UFWORD(PAR_LIT) {
2915   const uint32_t v = ufoImgGetU32(ufoIP); ufoIP += 4;
2916   ufoPush(v);
2917 }
2918
2919 // (LITCFA) ( -- n )
2920 UFWORD(PAR_LITCFA) {
2921   const uint32_t v = ufoImgGetU32(ufoIP); ufoIP += 4;
2922   ufoPush(v);
2923 }
2924
2925 // (LITVOCID) ( -- n )
2926 UFWORD(PAR_LITVOCID) {
2927   const uint32_t v = ufoImgGetU32(ufoIP); ufoIP += 4;
2928   ufoPush(v);
2929 }
2930
2931 // (STRLIT8)
2932 UFWORD(PAR_STRLIT8) {
2933   const uint32_t count = ufoImgGetU8(ufoIP); ufoIP += 1;
2934   ufoPush(ufoIP);
2935   ufoPush(count);
2936   ufoIP += count + 1; // 1 for terminating 0
2937   // align
2938   ufoIP = UFO_ALIGN4(ufoIP);
2939 }
2940
2941
2942 // ////////////////////////////////////////////////////////////////////////// //
2943 // jumps, etc.
2944 //
2945
2946
2947 // (BRANCH) ( -- )
2948 UFWORD(PAR_BRANCH) {
2949   ufoIP = ufoImgGetU32(ufoIP);
2950 }
2951
2952 // (TBRANCH) ( flag )
2953 UFWORD(PAR_TBRANCH) {
2954   if (ufoPop()) {
2955     ufoIP = ufoImgGetU32(ufoIP);
2956   } else {
2957     ufoIP += 4;
2958   }
2959 }
2960
2961 // (0BRANCH) ( flag )
2962 UFWORD(PAR_0BRANCH) {
2963   if (!ufoPop()) {
2964     ufoIP = ufoImgGetU32(ufoIP);
2965   } else {
2966     ufoIP += 4;
2967   }
2968 }
2969
2970
2971 // ////////////////////////////////////////////////////////////////////////// //
2972 // execute words by CFA
2973 //
2974
2975
2976 // EXECUTE ( cfa )
2977 UFWORD(EXECUTE) {
2978   ufoRPush(ufoPop());
2979   ufoVMRPopCFA = 1;
2980 }
2981
2982 // EXECUTE-TAIL ( cfa )
2983 UFWORD(EXECUTE_TAIL) {
2984   ufoIP = ufoRPop();
2985   ufoRPush(ufoPop());
2986   ufoVMRPopCFA = 1;
2987 }
2988
2989
2990 // ////////////////////////////////////////////////////////////////////////// //
2991 // word termination, locals support
2992 //
2993
2994
2995 // (EXIT)
2996 UFWORD(PAR_EXIT) {
2997   ufoIP = ufoRPop();
2998 }
2999
3000 // (L-ENTER)
3001 // ( loccount -- )
3002 UFWORD(PAR_LENTER) {
3003   // low byte of loccount is total number of locals
3004   // high byte is the number of args
3005   uint32_t lcount = ufoImgGetU32(ufoIP); ufoIP += 4u;
3006   uint32_t acount = (lcount >> 8) & 0xff;
3007   lcount &= 0xff;
3008   if (lcount == 0 || lcount < acount) ufoFatal("invalid call to (L-ENTER)");
3009   if ((ufoLBP != 0 && ufoLBP >= ufoLP) || UFO_LSTACK_SIZE - ufoLP <= lcount + 2) {
3010     ufoFatal("out of locals stack");
3011   }
3012   uint32_t newbp;
3013   if (ufoLP == 0) { ufoLP = 1; newbp = 1; } else newbp = ufoLP;
3014   //fprintf(stderr, "LP: %u; LBP: %u; locs: %u; word: %s\n", ufoLP, ufoLBP, fw->locs, fw->name);
3015   ufoLStack[ufoLP] = ufoLBP; ufoLP += 1;
3016   ufoLBP = newbp; ufoLP += lcount;
3017   // and copy args
3018   newbp += acount;
3019   while (newbp != ufoLBP) {
3020     ufoLStack[newbp] = ufoPop();
3021     newbp -= 1;
3022   }
3023 }
3024
3025 // (L-LEAVE)
3026 UFWORD(PAR_LLEAVE) {
3027   if (ufoLBP == 0) ufoFatal("(L-LEAVE) with empty locals stack");
3028   if (ufoLBP >= ufoLP) ufoFatal("(L-LEAVE) broken locals stack");
3029   ufoLP = ufoLBP;
3030   ufoLBP = ufoLStack[ufoLBP];
3031 }
3032
3033
3034 //==========================================================================
3035 //
3036 //  ufoLoadLocal
3037 //
3038 //==========================================================================
3039 UFO_FORCE_INLINE void ufoLoadLocal (const uint32_t lidx) {
3040   if (lidx == 0 || lidx >= UFO_LSTACK_SIZE) ufoFatal("invalid local index");
3041   if (ufoLBP == 0 || ufoLBP >= ufoLP || ufoLP - ufoLBP <= lidx) ufoFatal("invalid local index");
3042   ufoPush(ufoLStack[ufoLBP + lidx]);
3043 }
3044
3045
3046 //==========================================================================
3047 //
3048 //  ufoStoreLocal
3049 //
3050 //==========================================================================
3051 UFO_FORCE_INLINE void ufoStoreLocal (const uint32_t lidx) {
3052   const uint32_t value = ufoPop();
3053   if (lidx == 0 || lidx >= UFO_LSTACK_SIZE) ufoFatal("invalid local index");
3054   if (ufoLBP == 0 || ufoLBP >= ufoLP || ufoLP - ufoLBP <= lidx) ufoFatal("invalid local index");
3055   ufoLStack[ufoLBP + lidx] = value;
3056 }
3057
3058
3059 // (LOCAL@)
3060 // ( idx -- value )
3061 UFWORD(PAR_LOCAL_LOAD) { ufoLoadLocal(ufoPop()); }
3062
3063 // (LOCAL!)
3064 // ( value idx -- )
3065 UFWORD(PAR_LOCAL_STORE) { ufoStoreLocal(ufoPop()); }
3066
3067
3068 // ////////////////////////////////////////////////////////////////////////// //
3069 // stack manipulation
3070 //
3071
3072
3073 // DUP
3074 // ( n -- n n )
3075 UFWORD(DUP) { ufoDup(); }
3076 // ?DUP
3077 // ( n -- n n ) | ( 0 -- 0 )
3078 UFWORD(QDUP) { if (ufoPeek()) ufoDup(); }
3079 // 2DUP
3080 // ( n0 n1 -- n0 n1 n0 n1 )
3081 UFWORD(DDUP) { ufo2Dup(); }
3082 // DROP
3083 // ( n -- )
3084 UFWORD(DROP) { ufoDrop(); }
3085 // 2DROP
3086 // ( n0 n1 -- )
3087 UFWORD(DDROP) { ufo2Drop(); }
3088 // SWAP
3089 // ( n0 n1 -- n1 n0 )
3090 UFWORD(SWAP) { ufoSwap(); }
3091 // 2SWAP
3092 // ( n0 n1 -- n1 n0 )
3093 UFWORD(DSWAP) { ufo2Swap(); }
3094 // OVER
3095 // ( n0 n1 -- n0 n1 n0 )
3096 UFWORD(OVER) { ufoOver(); }
3097 // 2OVER
3098 // ( n0 n1 -- n0 n1 n0 )
3099 UFWORD(DOVER) { ufo2Over(); }
3100 // ROT
3101 // ( n0 n1 n2 -- n1 n2 n0 )
3102 UFWORD(ROT) { ufoRot(); }
3103 // NROT
3104 // ( n0 n1 n2 -- n2 n0 n1 )
3105 UFWORD(NROT) { ufoNRot(); }
3106
3107 // RDUP
3108 // ( n -- n n )
3109 UFWORD(RDUP) { ufoRDup(); }
3110 // RDROP
3111 // ( n -- )
3112 UFWORD(RDROP) { ufoRDrop(); }
3113
3114 // >R
3115 // ( n -- | n )
3116 UFWORD(DTOR) { ufoRPush(ufoPop()); }
3117 // R>
3118 // ( | n -- n )
3119 UFWORD(RTOD) { ufoPush(ufoRPop()); }
3120 // R@
3121 // ( | n -- n | n)
3122 UFWORD(RPEEK) { ufoPush(ufoRPeek()); }
3123
3124
3125 // PICK
3126 // ( idx -- n )
3127 UFWORD(PICK) {
3128   const uint32_t n = ufoPop();
3129   if (n >= ufoSP) ufoFatal("invalid PICK index %u", n);
3130   ufoPush(ufoDStack[ufoSP - n - 1u]);
3131 }
3132
3133 // RPICK
3134 // ( idx -- n )
3135 UFWORD(RPICK) {
3136   const uint32_t n = ufoPop();
3137   if (n >= ufoRP - ufoRPTop) ufoFatal("invalid RPICK index %u", n);
3138   const uint32_t rp = ufoRP - n - 1u;
3139   ufoPush(ufoRStack[rp]);
3140 }
3141
3142 // ROLL
3143 // ( idx -- n )
3144 UFWORD(ROLL) {
3145   const uint32_t n = ufoPop();
3146   if (n >= ufoSP) ufoFatal("invalid ROLL index %u", n);
3147   switch (n) {
3148     case 0: break; // do nothing
3149     case 1: ufoSwap(); break;
3150     case 2: ufoRot(); break;
3151     default:
3152       {
3153         const uint32_t val = ufoDStack[ufoSP - n - 1u];
3154         for (uint32_t f = ufoSP - n; f < ufoSP; f += 1) ufoDStack[f - 1] = ufoDStack[f];
3155         ufoDStack[ufoSP - 1u] = val;
3156       }
3157       break;
3158   }
3159 }
3160
3161 // RROLL
3162 // ( idx -- n )
3163 UFWORD(RROLL) {
3164   const uint32_t n = ufoPop();
3165   if (n >= ufoRP - ufoRPTop) ufoFatal("invalid RROLL index %u", n);
3166   if (n != 0) {
3167     const uint32_t rp = ufoRP - n - 1u;
3168     const uint32_t val = ufoRStack[rp];
3169     for (uint32_t f = rp + 1u; f < ufoRP; f += 1u) ufoRStack[f - 1u] = ufoRStack[f];
3170     ufoRStack[ufoRP - 1u] = val;
3171   }
3172 }
3173
3174 // RSWAP
3175 // ( | a b -- | b a )
3176 UFWORD(RSWAP) {
3177   const uint32_t b = ufoRPop();
3178   const uint32_t a = ufoRPop();
3179   ufoRPush(b); ufoRPush(a);
3180 }
3181
3182 // ROVER
3183 // ( | a b -- | a b a )
3184 UFWORD(ROVER) {
3185   const uint32_t b = ufoRPop();
3186   const uint32_t a = ufoRPop();
3187   ufoRPush(a); ufoRPush(b); ufoRPush(a);
3188 }
3189
3190 // RROT
3191 // ( | a b c -- | b c a )
3192 UFWORD(RROT) {
3193   const uint32_t c = ufoRPop();
3194   const uint32_t b = ufoRPop();
3195   const uint32_t a = ufoRPop();
3196   ufoRPush(b); ufoRPush(c); ufoRPush(a);
3197 }
3198
3199 // RNROT
3200 // ( | a b c -- | c a b )
3201 UFWORD(RNROT) {
3202   const uint32_t c = ufoRPop();
3203   const uint32_t b = ufoRPop();
3204   const uint32_t a = ufoRPop();
3205   ufoRPush(c); ufoRPush(a); ufoRPush(b);
3206 }
3207
3208
3209 // ////////////////////////////////////////////////////////////////////////// //
3210 // TIB API
3211 //
3212
3213 // REFILL
3214 // ( -- eofflag )
3215 UFWORD(REFILL) {
3216   ufoPushBool(ufoLoadNextLine(1));
3217 }
3218
3219 // REFILL-NOCROSS
3220 // ( -- eofflag )
3221 UFWORD(REFILL_NOCROSS) {
3222   ufoPushBool(ufoLoadNextLine(0));
3223 }
3224
3225 // (TIB-IN)
3226 // ( -- addr )
3227 UFWORD(TIB_IN) {
3228   ufoPush(ufoImgGetU32(ufoAddrTIBx) + ufoImgGetU32(ufoAddrINx));
3229 }
3230
3231 // TIB-PEEKCH
3232 // ( -- char )
3233 UFWORD(TIB_PEEKCH) {
3234   ufoPush(ufoTibPeekCh());
3235 }
3236
3237 // TIB-PEEKCH-OFS
3238 // ( ofs -- char )
3239 UFWORD(TIB_PEEKCH_OFS) {
3240   const uint32_t ofs = ufoPop();
3241   ufoPush(ufoTibPeekChOfs(ofs));
3242 }
3243
3244 // TIB-GETCH
3245 // ( -- char )
3246 UFWORD(TIB_GETCH) {
3247   ufoPush(ufoTibGetCh());
3248 }
3249
3250 // TIB-SKIPCH
3251 // ( -- )
3252 UFWORD(TIB_SKIPCH) {
3253   ufoTibSkipCh();
3254 }
3255
3256
3257 // ////////////////////////////////////////////////////////////////////////// //
3258 // TIB parsing
3259 //
3260
3261 //==========================================================================
3262 //
3263 //  ufoIsDelim
3264 //
3265 //==========================================================================
3266 UFO_FORCE_INLINE int ufoIsDelim (uint8_t ch, uint8_t delim) {
3267   return (delim == 32 ? (ch <= 32) : (ch == delim));
3268 }
3269
3270
3271 // (PARSE)
3272 // ( delim skip-leading-delim? -- addr count TRUE / FALSE )
3273 // does base TIB parsing; never copies anything.
3274 // as our reader is line-based, returns FALSE on EOL.
3275 // EOL is detected after skipping leading delimiters.
3276 // passing -1 as delimiter skips the whole line, and always returns FALSE.
3277 // trailing delimiter is always skipped.
3278 UFWORD(PAR_PARSE) {
3279   const uint32_t skipDelim = ufoPop();
3280   const uint32_t delim = ufoPop();
3281   uint8_t ch;
3282
3283   if (delim == 0 || delim > 0xffU) {
3284     // skip everything
3285     while (ufoTibGetCh() != 0) {}
3286     ufoPushBool(0);
3287   } else {
3288     ch = ufoTibPeekCh();
3289     // skip initial delimiters
3290     if (skipDelim) {
3291       while (ch != 0 && ufoIsDelim(ch, delim)) {
3292         ufoTibSkipCh();
3293         ch = ufoTibPeekCh();
3294       }
3295     }
3296     if (ch == 0) {
3297       ufoPushBool(0);
3298     } else {
3299       // parse
3300       const uint32_t staddr = ufoImgGetU32(ufoAddrTIBx) + ufoImgGetU32(ufoAddrINx);
3301       uint32_t count = 0;
3302       while (ch != 0 && !ufoIsDelim(ch, delim)) {
3303         count += 1u;
3304         ufoTibSkipCh();
3305         ch = ufoTibPeekCh();
3306       }
3307       // skip delimiter
3308       if (ch != 0) ufoTibSkipCh();
3309       ufoPush(staddr);
3310       ufoPush(count);
3311       ufoPushBool(1);
3312     }
3313   }
3314 }
3315
3316 // PARSE-SKIP-BLANKS
3317 // ( -- )
3318 UFWORD(PARSE_SKIP_BLANKS) {
3319   uint8_t ch = ufoTibPeekCh();
3320   while (ch != 0 && ch <= 32) {
3321     ufoTibSkipCh();
3322     ch = ufoTibPeekCh();
3323   }
3324 }
3325
3326
3327 //==========================================================================
3328 //
3329 //  ufoParseMLComment
3330 //
3331 //  initial two chars are skipped
3332 //
3333 //==========================================================================
3334 static void ufoParseMLComment (uint32_t allowMulti, int nested) {
3335   uint32_t level = 1;
3336   uint8_t ch, ch1;
3337   while (level != 0) {
3338     ch = ufoTibGetCh();
3339     if (ch == 0) {
3340       if (allowMulti) {
3341         UFCALL(REFILL_NOCROSS);
3342         if (ufoPop() == 0) ufoFatal("unexpected end of file in comment");
3343       } else {
3344         ufoFatal("unexpected end of line in comment");
3345       }
3346     } else {
3347       ch1 = ufoTibPeekCh();
3348       if (nested && ch == '(' && ch1 == '(') { ufoTibSkipCh(); level += 1; }
3349       else if (nested && ch == ')' && ch1 == ')') { ufoTibSkipCh(); level -= 1; }
3350       else if (!nested && ch == '*' && ch1 == ')') { ufo_assert(level == 1); ufoTibSkipCh(); level = 0; }
3351     }
3352   }
3353 }
3354
3355
3356 // (PARSE-SKIP-COMMENTS)
3357 // ( allow-multiline? -- )
3358 // skip all blanks and comments
3359 UFWORD(PAR_PARSE_SKIP_COMMENTS) {
3360   const uint32_t allowMulti = ufoPop();
3361   uint8_t ch, ch1;
3362   ch = ufoTibPeekCh();
3363   #if 0
3364   fprintf(stderr, "(PARSE-SKIP-COMMENTS): first-ch:'%c'\n", (char)ch);
3365   #endif
3366   while (ch != 0) {
3367     if (ch <= 32) {
3368       ufoTibSkipCh();
3369       ch = ufoTibPeekCh();
3370       #if 0
3371       fprintf(stderr, "(PARSE-SKIP-COMMENTS): blank-ch:'%c'\n", (char)ch);
3372       #endif
3373     } else if (ch == '(') {
3374       #if 0
3375       fprintf(stderr, "(PARSE-SKIP-COMMENTS): ch:'%c'; ch1:'%c' ('%c')\n", (char)ch, (char)ch1,
3376               ufoTibPeekChOfs(0));
3377       #endif
3378       ch1 = ufoTibPeekChOfs(1);
3379       if (ch1 <= 32) {
3380         // single-line comment
3381         do { ch = ufoTibGetCh(); } while (ch != 0 && ch != ')');
3382         ch = ufoTibPeekCh();
3383       } else if (ch1 == '*' || ch1 == '(') {
3384         // possibly multiline
3385         ufoTibSkipCh(); ufoTibSkipCh(); // skip opening
3386         ufoParseMLComment(allowMulti, (ch1 == '('));
3387         ch = ufoTibPeekCh();
3388       } else {
3389         ch = 0;
3390       }
3391     } else if (ch == '\\' && ufoTibPeekChOfs(1) <= 32) {
3392       // single-line comment
3393       while (ch != 0) ch = ufoTibGetCh();
3394     } else if ((ch == ';' || ch == '-' || ch == '/') && (ufoTibPeekChOfs(1) == ch)) {
3395       // skip to EOL
3396       while (ch != 0) ch = ufoTibGetCh();
3397     } else {
3398       ch = 0;
3399     }
3400   }
3401   #if 0
3402   fprintf(stderr, "(PARSE-SKIP-COMMENTS): end-ch:'%c'\n", ufoTibPeekCh());
3403   #endif
3404 }
3405
3406 // PARSE-SKIP-LINE
3407 // ( -- )
3408 UFWORD(PARSE_SKIP_LINE) {
3409   ufoPush(0); ufoPushBool(0); UFCALL(PAR_PARSE);
3410   if (ufoPop() != 0) {
3411     ufo2Drop();
3412   }
3413 }
3414
3415 // PARSE-NAME
3416 // ( -- addr count )
3417 // parse with leading blanks skipping. doesn't copy anything.
3418 // return empty string on EOL.
3419 UFWORD(PARSE_NAME) {
3420   ufoPush(32); ufoPushBool(1); UFCALL(PAR_PARSE);
3421   if (ufoPop() == 0) {
3422     ufoPush(0);
3423     ufoPush(0);
3424   }
3425 }
3426
3427 // PARSE
3428 // ( delim -- addr count TRUE / FALSE )
3429 // parse without skipping delimiters; never copies anything.
3430 // as our reader is line-based, returns FALSE on EOL.
3431 // passing 0 as delimiter skips the whole line, and always returns FALSE.
3432 // trailing delimiter is always skipped.
3433 UFWORD(PARSE) {
3434   ufoPushBool(0); UFCALL(PAR_PARSE);
3435 }
3436
3437 // (WORD-OR-PARSE)
3438 // ( delim skip-leading-delim? -- here TRUE / FALSE )
3439 // parse word, copy it to HERE as counted string.
3440 // adds trailing zero after the string, but doesn't include it in count.
3441 // doesn't advance line.
3442
3443 // WORD
3444 // ( delim -- here )
3445 // parse word, copy it to HERE as counted string.
3446 // adds trailing zero after the string, but doesn't include it in count.
3447 // doesn't advance line.
3448 // return empty string on EOL.
3449
3450 // PARSE-TO-HERE
3451 // ( delim -- addr count TRUE / FALSE )
3452 // parse word w/o skipping delimiters, copy it to HERE as counted string.
3453 // adds trailing zero after the string, but doesn't include it in count.
3454 // doesn't advance line.
3455
3456
3457 // ////////////////////////////////////////////////////////////////////////// //
3458 // char output
3459 //
3460
3461 // (EMIT)
3462 // ( n -- )
3463 UFWORD(PAR_EMIT) {
3464   uint32_t ch = ufoPop()&0xffU;
3465   ufoLastEmitWasCR = (ch == 10);
3466   putchar((char)ch);
3467 }
3468
3469 // EMIT
3470 // ( n -- )
3471 UFWORD(EMIT) {
3472   uint32_t ch = ufoPop()&0xffU;
3473   if (ch < 32 || ch == 127) {
3474     if (ch != 9 && ch != 10 && ch != 13) ch = '?';
3475   }
3476   ufoLastEmitWasCR = (ch == 10);
3477   putchar((char)ch);
3478 }
3479
3480 // XEMIT
3481 // ( n -- )
3482 UFWORD(XEMIT) {
3483   uint32_t ch = ufoPop()&0xffU;
3484   putchar(ch < 32 || ch == 127 ? '?' : (char)ch);
3485   ufoLastEmitWasCR = 0;
3486 }
3487
3488 // LASTCR?
3489 // ( -- bool )
3490 UFWORD(LASTCRQ) {
3491   ufoPushBool(ufoLastEmitWasCR);
3492 }
3493
3494 // LASTCR!
3495 // ( bool -- )
3496 UFWORD(LASTCRSET) {
3497   ufoLastEmitWasCR = !!ufoPop();
3498 }
3499
3500 // CR
3501 // ( -- )
3502 UFWORD(CR) {
3503   putchar('\n');
3504   ufoLastEmitWasCR = 1;
3505 }
3506
3507 // SPACE
3508 // ( -- )
3509 UFWORD(SPACE) {
3510   putchar(' ');
3511   ufoLastEmitWasCR = 0;
3512 }
3513
3514 // SPACES
3515 // ( n -- )
3516 UFWORD(SPACES) {
3517   char tmpbuf[64];
3518   int32_t n = (int32_t)ufoPop();
3519   if (n > 0) {
3520     memset(tmpbuf, 32, sizeof(tmpbuf));
3521     while (n > 0) {
3522       int32_t xwr = n;
3523       if (xwr > (int32_t)sizeof(tmpbuf) - 1) xwr = (int32_t)sizeof(tmpbuf) - 1;
3524       tmpbuf[xwr] = 0;
3525       printf("%s", tmpbuf);
3526       n -= xwr;
3527     }
3528     ufoLastEmitWasCR = 0;
3529   }
3530 }
3531
3532 // ENDCR
3533 // ( -- )
3534 UFWORD(ENDCR) {
3535   if (ufoLastEmitWasCR == 0) {
3536     putchar('\n');
3537     ufoLastEmitWasCR = 1;
3538   }
3539 }
3540
3541 // TYPE
3542 // ( addr count -- )
3543 UFWORD(TYPE) {
3544   int32_t count = (int32_t)ufoPop();
3545   uint32_t addr = ufoPop();
3546   while (count > 0) {
3547     const uint8_t ch = ufoImgGetU8Ext(addr);
3548     ufoPush(ch);
3549     UFCALL(EMIT);
3550     addr += 1; count -= 1;
3551   }
3552 }
3553
3554 // XTYPE
3555 // ( addr count -- )
3556 UFWORD(XTYPE) {
3557   int32_t count = (int32_t)ufoPop();
3558   uint32_t addr = ufoPop();
3559   while (count > 0) {
3560     const uint8_t ch = ufoImgGetU8Ext(addr);
3561     ufoPush(ch);
3562     UFCALL(XEMIT);
3563     addr += 1; count -= 1;
3564   }
3565 }
3566
3567 // FLUSH-EMIT
3568 // ( -- )
3569 UFWORD(FLUSH_EMIT) {
3570   fflush(NULL);
3571 }
3572
3573
3574 // ////////////////////////////////////////////////////////////////////////// //
3575 // simple math
3576 //
3577
3578 #define UF_UMATH(name_,op_)  \
3579 UFWORD(name_) { \
3580   const uint32_t a = ufoPop(); \
3581   ufoPush(op_); \
3582 }
3583
3584 #define UF_BMATH(name_,op_)  \
3585 UFWORD(name_) { \
3586   const uint32_t b = ufoPop(); \
3587   const uint32_t a = ufoPop(); \
3588   ufoPush(op_); \
3589 }
3590
3591 #define UF_BDIV(name_,op_)  \
3592 UFWORD(name_) { \
3593   const uint32_t b = ufoPop(); \
3594   const uint32_t a = ufoPop(); \
3595   if (b == 0) ufoFatal("division by zero"); \
3596   ufoPush(op_); \
3597 }
3598
3599 #define UFO_POP_U64()  ({ \
3600   const uint32_t hi_ = ufoPop(); \
3601   const uint32_t lo_ = ufoPop(); \
3602   (((uint64_t)hi_ << 32) | lo_); \
3603 })
3604
3605 // this is UB by the idiotic C standard. i don't care.
3606 #define UFO_POP_I64()  ((int64_t)UFO_POP_U64())
3607
3608 #define UFO_PUSH_U64(vn_)  do { \
3609   ufoPush((uint32_t)(vn_)); \
3610   ufoPush((uint32_t)((vn_) >> 32)); \
3611 } while (0)
3612
3613 // this is UB by the idiotic C standard. i don't care.
3614 #define UFO_PUSH_I64(vn_)  UFO_PUSH_U64((uint64_t)(vn_))
3615
3616
3617 // +
3618 // ( a b -- a+b )
3619 UF_BMATH(PLUS, a + b);
3620
3621 // -
3622 // ( a b -- a-b )
3623 UF_BMATH(MINUS, a - b);
3624
3625 // *
3626 // ( a b -- a*b )
3627 UF_BMATH(MUL, (uint32_t)((int32_t)a * (int32_t)b));
3628
3629 // U*
3630 // ( a b -- a*b )
3631 UF_BMATH(UMUL, a * b);
3632
3633 // /
3634 // ( a b -- a/b )
3635 UF_BDIV(DIV, (uint32_t)((int32_t)a / (int32_t)b));
3636
3637 // U/
3638 // ( a b -- a/b )
3639 UF_BDIV(UDIV, a / b);
3640
3641 // MOD
3642 // ( a b -- a%b )
3643 UF_BDIV(MOD, (uint32_t)((int32_t)a % (int32_t)b));
3644
3645 // UMOD
3646 // ( a b -- a%b )
3647 UF_BDIV(UMOD, a % b);
3648
3649 // /MOD
3650 // ( a b -- a/b, a%b )
3651 UFWORD(DIVMOD) {
3652   const int32_t b = (int32_t)ufoPop();
3653   const int32_t a = (int32_t)ufoPop();
3654   if (b == 0) ufoFatal("division by zero");
3655   ufoPush((uint32_t)(a/b));
3656   ufoPush((uint32_t)(a%b));
3657 }
3658
3659 // U/MOD
3660 // ( a b -- a/b, a%b )
3661 UFWORD(UDIVMOD) {
3662   const uint32_t b = ufoPop();
3663   const uint32_t a = ufoPop();
3664   if (b == 0) ufoFatal("division by zero");
3665   ufoPush((uint32_t)(a/b));
3666   ufoPush((uint32_t)(a%b));
3667 }
3668
3669 // */
3670 // ( a b c -- a*b/c )
3671 // this uses 64-bit intermediate value
3672 UFWORD(MULDIV) {
3673   const int32_t c = (int32_t)ufoPop();
3674   const int32_t b = (int32_t)ufoPop();
3675   const int32_t a = (int32_t)ufoPop();
3676   if (c == 0) ufoFatal("division by zero");
3677   int64_t xval = a; xval *= b; xval /= c;
3678   ufoPush((uint32_t)(int32_t)xval);
3679 }
3680
3681 // U*/
3682 // ( a b c -- a*b/c )
3683 // this uses 64-bit intermediate value
3684 UFWORD(UMULDIV) {
3685   const uint32_t c = ufoPop();
3686   const uint32_t b = ufoPop();
3687   const uint32_t a = ufoPop();
3688   if (c == 0) ufoFatal("division by zero");
3689   uint64_t xval = a; xval *= b; xval /= c;
3690   ufoPush((uint32_t)xval);
3691 }
3692
3693 // */MOD
3694 // ( a b c -- a*b/c a*b%c )
3695 // this uses 64-bit intermediate value
3696 UFWORD(MULDIVMOD) {
3697   const int32_t c = (int32_t)ufoPop();
3698   const int32_t b = (int32_t)ufoPop();
3699   const int32_t a = (int32_t)ufoPop();
3700   if (c == 0) ufoFatal("division by zero");
3701   int64_t xval = a; xval *= b;
3702   ufoPush((uint32_t)(int32_t)(xval / c));
3703   ufoPush((uint32_t)(int32_t)(xval % c));
3704 }
3705
3706 // U*/
3707 // ( a b c -- a*b/c )
3708 // this uses 64-bit intermediate value
3709 UFWORD(UMULDIVMOD) {
3710   const uint32_t c = ufoPop();
3711   const uint32_t b = ufoPop();
3712   const uint32_t a = ufoPop();
3713   if (c == 0) ufoFatal("division by zero");
3714   uint64_t xval = a; xval *= b;
3715   ufoPush((uint32_t)(xval / c));
3716   ufoPush((uint32_t)(xval % c));
3717 }
3718
3719 // M*
3720 // ( a b -- lo(a*b) hi(a*b) )
3721 // this leaves 64-bit result
3722 UFWORD(MMUL) {
3723   const int32_t b = (int32_t)ufoPop();
3724   const int32_t a = (int32_t)ufoPop();
3725   int64_t xval = a; xval *= b;
3726   UFO_PUSH_I64(xval);
3727 }
3728
3729 // UM*
3730 // ( a b -- lo(a*b) hi(a*b) )
3731 // this leaves 64-bit result
3732 UFWORD(UMMUL) {
3733   const uint32_t b = ufoPop();
3734   const uint32_t a = ufoPop();
3735   uint64_t xval = a; xval *= b;
3736   UFO_PUSH_U64(xval);
3737 }
3738
3739 // M/MOD
3740 // ( alo ahi b -- a/b a%b )
3741 UFWORD(MDIVMOD) {
3742   const int32_t b = (int32_t)ufoPop();
3743   if (b == 0) ufoFatal("division by zero");
3744   int64_t a = UFO_POP_I64();
3745   int32_t adiv = (int32_t)(a / b);
3746   int32_t amod = (int32_t)(a % b);
3747   ufoPush((uint32_t)adiv);
3748   ufoPush((uint32_t)amod);
3749 }
3750
3751 // UM/MOD
3752 // ( alo ahi b -- a/b a%b )
3753 UFWORD(UMDIVMOD) {
3754   const uint32_t b = ufoPop();
3755   if (b == 0) ufoFatal("division by zero");
3756   uint64_t a = UFO_POP_U64();
3757   uint32_t adiv = (uint32_t)(a / b);
3758   uint32_t amod = (uint32_t)(a % b);
3759   ufoPush(adiv);
3760   ufoPush(amod);
3761 }
3762
3763 // UDS*
3764 // ( alo ahi u -- lo hi )
3765 UFWORD(UDSMUL) {
3766   const uint32_t b = ufoPop();
3767   uint64_t a = UFO_POP_U64();
3768   a *= b;
3769   UFO_PUSH_U64(a);
3770 }
3771
3772 // D-
3773 // ( lo0 hi0 lo1 hi1 -- lo hi )
3774 UFWORD(DMINUS) {
3775   uint64_t n1 = UFO_POP_U64();
3776   uint64_t n0 = UFO_POP_U64();
3777   n0 -= n1;
3778   UFO_PUSH_U64(n0);
3779 }
3780
3781 // D+
3782 // ( lo0 hi0 lo1 hi1 -- lo hi )
3783 UFWORD(DPLUS) {
3784   uint64_t n1 = UFO_POP_U64();
3785   uint64_t n0 = UFO_POP_U64();
3786   n0 += n1;
3787   UFO_PUSH_U64(n0);
3788 }
3789
3790 // D=
3791 // ( lo0 hi0 lo1 hi1 -- bool )
3792 UFWORD(DEQU) {
3793   uint64_t n1 = UFO_POP_U64();
3794   uint64_t n0 = UFO_POP_U64();
3795   ufoPushBool(n0 == n1);
3796 }
3797
3798 // D<
3799 // ( lo0 hi0 lo1 hi1 -- bool )
3800 UFWORD(DLESS) {
3801   int64_t n1 = UFO_POP_I64();
3802   int64_t n0 = UFO_POP_I64();
3803   ufoPushBool(n0 < n1);
3804 }
3805
3806 // D<=
3807 // ( lo0 hi0 lo1 hi1 -- bool )
3808 UFWORD(DLESSEQU) {
3809   int64_t n1 = UFO_POP_I64();
3810   int64_t n0 = UFO_POP_I64();
3811   ufoPushBool(n0 <= n1);
3812 }
3813
3814 // DU<
3815 // ( lo0 hi0 lo1 hi1 -- bool )
3816 UFWORD(DULESS) {
3817   uint64_t n1 = UFO_POP_U64();
3818   uint64_t n0 = UFO_POP_U64();
3819   ufoPushBool(n0 < n1);
3820 }
3821
3822 // DU<=
3823 // ( lo0 hi0 lo1 hi1 -- bool )
3824 UFWORD(DULESSEQU) {
3825   uint64_t n1 = UFO_POP_U64();
3826   uint64_t n0 = UFO_POP_U64();
3827   ufoPushBool(n0 <= n1);
3828 }
3829
3830 // SM/REM
3831 // ( dlo dhi n -- nmod ndiv )
3832 // rounds toward zero
3833 UFWORD(SMREM) {
3834   const int32_t n = (int32_t)ufoPop();
3835   if (n == 0) ufoFatal("division by zero");
3836   int64_t d = UFO_POP_I64();
3837   int32_t ndiv = (int32_t)(d / n);
3838   int32_t nmod = (int32_t)(d % n);
3839   ufoPush(nmod);
3840   ufoPush(ndiv);
3841 }
3842
3843 // FM/MOD
3844 // ( dlo dhi n -- nmod ndiv )
3845 // rounds toward negative infinity
3846 UFWORD(FMMOD) {
3847   const int32_t n = (int32_t)ufoPop();
3848   if (n == 0) ufoFatal("division by zero");
3849   int64_t d = UFO_POP_I64();
3850   int32_t ndiv = (int32_t)(d / n);
3851   int32_t nmod = (int32_t)(d % n);
3852   if (nmod != 0 && ((uint32_t)n ^ (uint32_t)(d >> 32)) >= 0x80000000u) {
3853     ndiv -= 1;
3854     nmod += n;
3855   }
3856   ufoPush(nmod);
3857   ufoPush(ndiv);
3858 }
3859
3860
3861 // ////////////////////////////////////////////////////////////////////////// //
3862 // simple logic and bit manipulation
3863 //
3864
3865 #define UF_CMP(name_,op_)  \
3866 UFWORD(name_) { \
3867   const uint32_t b = ufoPop(); \
3868   const uint32_t a = ufoPop(); \
3869   ufoPushBool(op_); \
3870 }
3871
3872 // <
3873 // ( a b -- a<b )
3874 UF_CMP(LESS, (int32_t)a < (int32_t)b);
3875
3876 // U<
3877 // ( a b -- a<b )
3878 UF_CMP(ULESS, a < b);
3879
3880 // >
3881 // ( a b -- a>b )
3882 UF_CMP(GREAT, (int32_t)a > (int32_t)b);
3883
3884 // U>
3885 // ( a b -- a>b )
3886 UF_CMP(UGREAT, a > b);
3887
3888 // <=
3889 // ( a b -- a<=b )
3890 UF_CMP(LESSEQU, (int32_t)a <= (int32_t)b);
3891
3892 // U<=
3893 // ( a b -- a<=b )
3894 UF_CMP(ULESSEQU, a <= b);
3895
3896 // >=
3897 // ( a b -- a>=b )
3898 UF_CMP(GREATEQU, (int32_t)a >= (int32_t)b);
3899
3900 // U>=
3901 // ( a b -- a>=b )
3902 UF_CMP(UGREATEQU, a >= b);
3903
3904 // =
3905 // ( a b -- a=b )
3906 UF_CMP(EQU, a == b);
3907
3908 // <>
3909 // ( a b -- a<>b )
3910 UF_CMP(NOTEQU, a != b);
3911
3912 // NOT
3913 // ( a -- !a )
3914 UFWORD(NOT) {
3915   const uint32_t a = ufoPop();
3916   ufoPushBool(!a);
3917 }
3918
3919 // LAND
3920 // ( a b -- a&&b )
3921 UF_CMP(LOGAND, a && b);
3922
3923 // LOR
3924 // ( a b -- a||b )
3925 UF_CMP(LOGOR, a || b);
3926
3927 // AND
3928 // ( a b -- a&b )
3929 UFWORD(AND) {
3930   const uint32_t b = ufoPop();
3931   const uint32_t a = ufoPop();
3932   ufoPush(a&b);
3933 }
3934
3935 // OR
3936 // ( a b -- a|b )
3937 UFWORD(OR) {
3938   const uint32_t b = ufoPop();
3939   const uint32_t a = ufoPop();
3940   ufoPush(a|b);
3941 }
3942
3943 // XOR
3944 // ( a b -- a^b )
3945 UFWORD(XOR) {
3946   const uint32_t b = ufoPop();
3947   const uint32_t a = ufoPop();
3948   ufoPush(a^b);
3949 }
3950
3951 // BITNOT
3952 // ( a -- ~a )
3953 UFWORD(BITNOT) {
3954   const uint32_t a = ufoPop();
3955   ufoPush(~a);
3956 }
3957
3958 UFWORD(ONESHL) { uint32_t n = ufoPop(); ufoPush(n << 1); }
3959 UFWORD(ONESHR) { uint32_t n = ufoPop(); ufoPush(n >> 1); }
3960 UFWORD(TWOSHL) { uint32_t n = ufoPop(); ufoPush(n << 2); }
3961 UFWORD(TWOSHR) { uint32_t n = ufoPop(); ufoPush(n >> 2); }
3962
3963 // ASH
3964 // ( n count -- )
3965 // arithmetic shift; positive `n` shifts to the left
3966 UFWORD(ASH) {
3967   int32_t c = (int32_t)ufoPop();
3968   if (c < 0) {
3969     // right
3970     int32_t n = (int32_t)ufoPop();
3971     if (c < -30) {
3972       if (n < 0) n = -1; else n = 0;
3973     } else {
3974       n >>= (uint8_t)(-c);
3975     }
3976     ufoPush((uint32_t)n);
3977   } else if (c > 0) {
3978     // left
3979     uint32_t u = ufoPop();
3980     if (c > 31) {
3981       u = 0;
3982     } else {
3983       u <<= (uint8_t)c;
3984     }
3985     ufoPush(u);
3986   }
3987 }
3988
3989 // LSH
3990 // ( n count -- )
3991 // logical shift; positive `n` shifts to the left
3992 UFWORD(LSH) {
3993   int32_t c = (int32_t) ufoPop();
3994   uint32_t u = ufoPop();
3995   if (c < 0) {
3996     // right
3997     if (c < -31) {
3998       u = 0;
3999     } else {
4000       u >>= (uint8_t)(-c);
4001     }
4002   } else if (c > 0) {
4003     // left
4004     if (c > 31) {
4005       u = 0;
4006     } else {
4007       u <<= (uint8_t)c;
4008     }
4009   }
4010   ufoPush(u);
4011 }
4012
4013
4014 // ////////////////////////////////////////////////////////////////////////// //
4015 // string unescaping
4016 //
4017
4018 // (UNESCAPE)
4019 // ( addr count -- addr count )
4020 UFWORD(PAR_UNESCAPE) {
4021   const uint32_t count = ufoPop();
4022   const uint32_t addr = ufoPeek();
4023   if ((count & ((uint32_t)1<<31)) == 0) {
4024     const uint32_t eaddr = addr + count;
4025     uint32_t caddr = addr;
4026     uint32_t daddr = addr;
4027     while (caddr != eaddr) {
4028       uint8_t ch = ufoImgGetU8Ext(caddr); caddr += 1u;
4029       if (ch == '\\' && caddr != eaddr) {
4030         ch = ufoImgGetU8Ext(caddr); caddr += 1u;
4031         switch (ch) {
4032           case 'r': ch = '\r'; break;
4033           case 'n': ch = '\n'; break;
4034           case 't': ch = '\t'; break;
4035           case 'e': ch = '\x1b'; break;
4036           case '`': ch = '"'; break; // special escape to insert double-quote
4037           case '"': ch = '"'; break;
4038           case '\\': ch = '\\'; break;
4039           case 'x': case 'X':
4040             if (eaddr - daddr >= 1) {
4041               const int dg0 = digitInBase((char)(ufoImgGetU8Ext(caddr)), 16);
4042               if (dg0 < 0) ufoFatal("invalid hex string escape");
4043               if (eaddr - daddr >= 2) {
4044                 const int dg1 = digitInBase((char)(ufoImgGetU8Ext(caddr + 1u)), 16);
4045                 if (dg1 < 0) ufoFatal("invalid hex string escape");
4046                 ch = (uint8_t)(dg0 * 16 + dg1);
4047                 caddr += 2u;
4048               } else {
4049                 ch = (uint8_t)dg0;
4050                 caddr += 1u;
4051               }
4052             } else {
4053               ufoFatal("invalid hex string escape");
4054             }
4055             break;
4056           default: ufoFatal("invalid string escape");
4057         }
4058       }
4059       ufoImgPutU8Ext(daddr, ch); daddr += 1u;
4060     }
4061     ufoPush(daddr - addr);
4062   } else {
4063     ufoPush(count);
4064   }
4065 }
4066
4067
4068 // ////////////////////////////////////////////////////////////////////////// //
4069 // numeric conversions
4070 //
4071
4072 // (BASED-NUMBER) ( addr count allowsign? base -- num TRUE / FALSE )
4073 UFWORD(PAR_BASED_NUMBER) {
4074   const uint32_t xbase = ufoPop();
4075   const uint32_t allowSign = ufoPop();
4076   int32_t count = (int32_t)ufoPop();
4077   uint32_t addr = ufoPop();
4078   uint32_t n = 0;
4079   int base = 0;
4080   int neg = 0;
4081   uint8_t ch;
4082
4083   if (allowSign && count > 1) {
4084     ch = ufoImgGetU8Ext(addr);
4085     if (ch == '-') { neg = 1; addr += 1u; count -= 1; }
4086     else if (ch == '+') { neg = 0; addr += 1u; count -= 1; }
4087   }
4088
4089   // special-based numbers
4090   if (count >= 3 && ufoImgGetU8Ext(addr) == '0') {
4091     switch (ufoImgGetU8Ext(addr + 1u)) {
4092       case 'x': case 'X': base = 16; break;
4093       case 'o': case 'O': base = 8; break;
4094       case 'b': case 'B': base = 2; break;
4095       case 'd': case 'D': base = 10; break;
4096       default: break;
4097     }
4098     if (base) { addr += 2; count -= 2; }
4099   } else if (count >= 2 && ufoImgGetU8Ext(addr) == '$') {
4100     base = 16;
4101     addr += 1; count -= 1;
4102   } else if (count >= 2 && ufoImgGetU8Ext(addr) == '#') {
4103     base = 16;
4104     addr += 1; count -= 1;
4105   } else if (count >= 2 && ufoImgGetU8Ext(addr) == '%') {
4106     base = 2;
4107     addr += 1; count -= 1;
4108   } else if (count >= 3 && ufoImgGetU8Ext(addr) == '&') {
4109     switch (ufoImgGetU8Ext(addr + 1u)) {
4110       case 'h': case 'H': base = 16; break;
4111       case 'o': case 'O': base = 8; break;
4112       case 'b': case 'B': base = 2; break;
4113       case 'd': case 'D': base = 10; break;
4114       default: break;
4115     }
4116     if (base) { addr += 2; count -= 2; }
4117   } else if (xbase < 12 && count > 2 && toUpperU8(ufoImgGetU8Ext(addr + (uint32_t)count - 1u)) == 'B') {
4118     base = 2;
4119     count -= 1;
4120   } else if (xbase < 18 && count > 2 && toUpperU8(ufoImgGetU8Ext(addr + (uint32_t)count - 1u)) == 'H') {
4121     base = 16;
4122     count -= 1;
4123   } else if (xbase < 25 && count > 2 && toUpperU8(ufoImgGetU8Ext(addr + (uint32_t)count - 1u)) == 'O') {
4124     base = 8;
4125     count -= 1;
4126   }
4127
4128   // in current base?
4129   if (!base && xbase < 255) base = xbase;
4130
4131   if (count <= 0 || base < 1 || base > 36) {
4132     ufoPushBool(0);
4133   } else {
4134     uint32_t nc;
4135     int wasDig = 0, wasUnder = 1, error = 0, dig;
4136     while (!error && count != 0) {
4137       ch = ufoImgGetU8Ext(addr); addr += 1u; count -= 1;
4138       if (ch != '_') {
4139         error = 1; wasUnder = 0; wasDig = 1;
4140         dig = digitInBase((char)ch, (int)base);
4141         if (dig >= 0) {
4142           nc = n * (uint32_t)base;
4143           if (nc >= n) {
4144             nc += (uint32_t)dig;
4145             if (nc >= n) {
4146               n = nc;
4147               error = 0;
4148             }
4149           }
4150         }
4151       } else {
4152         error = wasUnder;
4153         wasUnder = 1;
4154       }
4155     }
4156
4157     if (!error && wasDig && !wasUnder) {
4158       if (allowSign && neg) n = ~n + 1u;
4159       ufoPush(n);
4160       ufoPushBool(1);
4161     } else {
4162       ufoPushBool(0);
4163     }
4164   }
4165 }
4166
4167
4168 // ////////////////////////////////////////////////////////////////////////// //
4169 // compiler-related, dictionary-related
4170 //
4171
4172 static char ufoWNameBuf[256];
4173
4174
4175 // [
4176 UFWORD(LBRACKET_IMM) {
4177   if (ufoImgGetU32(ufoAddrSTATE) == 0) ufoFatal("expects compiling mode");
4178   ufoImgPutU32(ufoAddrSTATE, 0);
4179 }
4180
4181 // ]
4182 UFWORD(RBRACKET) {
4183   if (ufoImgGetU32(ufoAddrSTATE) != 0) ufoFatal("expects interpreting mode");
4184   ufoImgPutU32(ufoAddrSTATE, 1);
4185 }
4186
4187 // (CREATE-WORD-HEADER)
4188 // ( addr count word-flags -- )
4189 UFWORD(PAR_CREATE_WORD_HEADER) {
4190   const uint32_t flags = ufoPop();
4191   const uint32_t wlen = ufoPop();
4192   const uint32_t waddr = ufoPop();
4193   if (wlen == 0) ufoFatal("word name expected");
4194   if (wlen >= UFO_MAX_WORD_LENGTH) ufoFatal("word name too long");
4195   // copy to separate buffer
4196   for (uint32_t f = 0; f < wlen; f += 1) {
4197     ufoWNameBuf[f] = (char)ufoImgGetU8Ext(waddr + f);
4198   }
4199   ufoWNameBuf[wlen] = 0;
4200   ufoCreateWordHeader(ufoWNameBuf, flags);
4201 }
4202
4203 // (CREATE-NAMELESS-WORD-HEADER)
4204 // ( word-flags -- )
4205 UFWORD(PAR_CREATE_NAMELESS_WORD_HEADER) {
4206   const uint32_t flags = ufoPop();
4207   ufoCreateWordHeader("", flags);
4208 }
4209
4210 // FIND-WORD
4211 // ( addr count -- cfa TRUE / FALSE)
4212 UFWORD(FIND_WORD) {
4213   const uint32_t wlen = ufoPop();
4214   const uint32_t waddr = ufoPop();
4215   if (wlen > 0 && wlen < UFO_MAX_WORD_LENGTH) {
4216     // copy to separate buffer
4217     for (uint32_t f = 0; f < wlen; f += 1) {
4218       ufoWNameBuf[f] = (char)ufoImgGetU8Ext(waddr + f);
4219     }
4220     ufoWNameBuf[wlen] = 0;
4221     const uint32_t cfa = ufoFindWord(ufoWNameBuf);
4222     if (cfa != 0) {
4223       ufoPush(cfa);
4224       ufoPushBool(1);
4225     } else {
4226       ufoPushBool(0);
4227     }
4228   } else {
4229     ufoPushBool(0);
4230   }
4231 }
4232
4233 // FIND-WORD-IN-VOC
4234 // ( addr count vocid allowhidden -- cfa TRUE / FALSE)
4235 // find only in the given voc; no name resolution
4236 UFWORD(FIND_WORD_IN_VOC) {
4237   const uint32_t allowHidden = ufoPop();
4238   const uint32_t vocid = ufoPop();
4239   const uint32_t wlen = ufoPop();
4240   const uint32_t waddr = ufoPop();
4241   if (wlen > 0 && wlen < UFO_MAX_WORD_LENGTH) {
4242     // copy to separate buffer
4243     for (uint32_t f = 0; f < wlen; f += 1) {
4244       ufoWNameBuf[f] = (char)ufoImgGetU8Ext(waddr + f);
4245     }
4246     ufoWNameBuf[wlen] = 0;
4247     const uint32_t cfa = ufoFindWordInVoc(ufoWNameBuf, wlen, 0, vocid, (allowHidden ? 1 : 0));
4248     if (cfa != 0) {
4249       ufoPush(cfa);
4250       ufoPushBool(1);
4251     } else {
4252       ufoPushBool(0);
4253     }
4254   } else {
4255     ufoPushBool(0);
4256   }
4257 }
4258
4259 // FIND-WORD-IN-VOC-AND-PARENTS
4260 // ( addr count vocid allowhidden -- cfa TRUE / FALSE)
4261 // find only in the given voc; no name resolution
4262 UFWORD(FIND_WORD_IN_VOC_AND_PARENTS) {
4263   const uint32_t allowHidden = ufoPop();
4264   const uint32_t vocid = ufoPop();
4265   const uint32_t wlen = ufoPop();
4266   const uint32_t waddr = ufoPop();
4267   if (wlen > 0 && wlen < UFO_MAX_WORD_LENGTH) {
4268     // copy to separate buffer
4269     for (uint32_t f = 0; f < wlen; f += 1) {
4270       ufoWNameBuf[f] = (char)ufoImgGetU8Ext(waddr + f);
4271     }
4272     ufoWNameBuf[wlen] = 0;
4273     const uint32_t cfa = ufoFindWordInVocAndParents(ufoWNameBuf, wlen, 0, vocid, (allowHidden ? 1 : 0));
4274     if (cfa != 0) {
4275       ufoPush(cfa);
4276       ufoPushBool(1);
4277     } else {
4278       ufoPushBool(0);
4279     }
4280   } else {
4281     ufoPushBool(0);
4282   }
4283 }
4284
4285
4286 // ////////////////////////////////////////////////////////////////////////// //
4287 // more compiler words
4288 //
4289
4290 // ?EXEC
4291 UFWORD(QEXEC) {
4292   if (ufoImgGetU32(ufoAddrSTATE) != 0) ufoFatal("expecting execution mode");
4293 }
4294
4295 // ?COMP
4296 UFWORD(QCOMP) {
4297   if (ufoImgGetU32(ufoAddrSTATE) == 0) ufoFatal("expecting compilation mode");
4298 }
4299
4300 // "
4301 // string literal
4302 UFWORD(QUOTE_IMM) {
4303   ufoPush(34); UFCALL(PARSE);
4304   if (ufoPop() == 0) ufoFatal("string literal expected");
4305   UFCALL(PAR_UNESCAPE);
4306   if (ufoImgGetU32(ufoAddrSTATE) != 0) {
4307     // compiling
4308     const uint32_t wlen = ufoPop();
4309     const uint32_t waddr = ufoPop();
4310     if (wlen > 255) ufoFatal("string literal too long");
4311     ufoImgEmitU32(ufoStrLit8CFA);
4312     ufoImgEmitU8(wlen);
4313     for (uint32_t f = 0; f < wlen; f += 1) {
4314       ufoImgEmitU8(ufoImgGetU8Ext(waddr + f));
4315     }
4316     ufoImgEmitU8(0);
4317     ufoImgEmitAlign();
4318   }
4319 }
4320
4321
4322 // ////////////////////////////////////////////////////////////////////////// //
4323 // vocabulary and wordlist utilities
4324 //
4325
4326 // (VSP@)
4327 // ( -- vsp )
4328 UFWORD(PAR_GET_VSP) {
4329   ufoPush(ufoVSP);
4330 }
4331
4332 // (VSP!)
4333 // ( vsp -- )
4334 UFWORD(PAR_SET_VSP) {
4335   const uint32_t vsp = ufoPop();
4336   if (vsp >= UFO_VOCSTACK_SIZE) ufoFatal("VSP %u out of range (%u)", vsp, UFO_VOCSTACK_SIZE);
4337   ufoVSP = vsp;
4338 }
4339
4340 // (VSP-AT@)
4341 // ( idx -- value )
4342 UFWORD(PAR_VSP_LOAD) {
4343   const uint32_t vsp = ufoPop();
4344   if (vsp >= UFO_VOCSTACK_SIZE) ufoFatal("VSP %u out of range (%u)", vsp, UFO_VOCSTACK_SIZE);
4345   ufoPush(ufoVocStack[vsp]);
4346 }
4347
4348 // (VSP-AT!)
4349 // ( value idx -- )
4350 UFWORD(PAR_VSP_STORE) {
4351   const uint32_t vsp = ufoPop();
4352   const uint32_t value = ufoPop();
4353   if (vsp > UFO_VOCSTACK_SIZE) ufoFatal("VSP %u out of range (%u)", vsp, UFO_VOCSTACK_SIZE);
4354   ufoVocStack[vsp] = value;
4355 }
4356
4357
4358 // ////////////////////////////////////////////////////////////////////////// //
4359 // word field address conversion
4360 //
4361
4362 // CFA->PFA
4363 // ( cfa -- pfa )
4364 UFWORD(CFA2PFA) {
4365   const uint32_t cfa = ufoPop();
4366   ufoPush(UFO_CFA_TO_PFA(cfa));
4367 }
4368
4369 // PFA->CFA
4370 // ( pfa -- cfa )
4371 UFWORD(PFA2CFA) {
4372   const uint32_t pfa = ufoPop();
4373   ufoPush(UFO_PFA_TO_CFA(pfa));
4374 }
4375
4376 // CFA->NFA
4377 // ( cfa -- nfa )
4378 UFWORD(CFA2NFA) {
4379   const uint32_t cfa = ufoPop();
4380   ufoPush(UFO_CFA_TO_NFA(cfa));
4381 }
4382
4383 // NFA->CFA
4384 // ( nfa -- cfa )
4385 UFWORD(NFA2CFA) {
4386   const uint32_t nfa = ufoPop();
4387   ufoPush(UFO_NFA_TO_CFA(nfa));
4388 }
4389
4390 // CFA->LFA
4391 // ( cfa -- lfa )
4392 UFWORD(CFA2LFA) {
4393   const uint32_t cfa = ufoPop();
4394   ufoPush(UFO_CFA_TO_LFA(cfa));
4395 }
4396
4397 // LFA->CFA
4398 // ( lfa -- cfa )
4399 UFWORD(LFA2CFA) {
4400   const uint32_t lfa = ufoPop();
4401   ufoPush(UFO_LFA_TO_CFA(lfa));
4402 }
4403
4404 // LFA->PFA
4405 // ( lfa -- pfa )
4406 UFWORD(LFA2PFA) {
4407   const uint32_t lfa = ufoPop();
4408   const uint32_t cfa = UFO_LFA_TO_CFA(lfa);
4409   ufoPush(UFO_CFA_TO_PFA(cfa));
4410 }
4411
4412 // LFA->BFA
4413 // ( lfa -- bfa )
4414 UFWORD(LFA2BFA) {
4415   const uint32_t lfa = ufoPop();
4416   ufoPush(UFO_LFA_TO_BFA(lfa));
4417 }
4418
4419 // LFA->XFA
4420 // ( lfa -- xfa )
4421 UFWORD(LFA2XFA) {
4422   const uint32_t lfa = ufoPop();
4423   ufoPush(UFO_LFA_TO_XFA(lfa));
4424 }
4425
4426 // LFA->YFA
4427 // ( lfa -- yfa )
4428 UFWORD(LFA2YFA) {
4429   const uint32_t lfa = ufoPop();
4430   ufoPush(UFO_LFA_TO_YFA(lfa));
4431 }
4432
4433 // LFA->NFA
4434 // ( lfa -- nfa )
4435 UFWORD(LFA2NFA) {
4436   const uint32_t lfa = ufoPop();
4437   ufoPush(UFO_LFA_TO_NFA(lfa));
4438 }
4439
4440 // NFA->LFA
4441 // ( nfa -- lfa )
4442 UFWORD(NFA2LFA) {
4443   const uint32_t nfa = ufoPop();
4444   ufoPush(UFO_NFA_TO_LFA(nfa));
4445 }
4446
4447 // CFA->WEND
4448 // ( cfa -- wend-addr )
4449 UFWORD(CFA2WEND) {
4450   const uint32_t cfa = ufoPop();
4451   ufoPush(ufoGetWordEndAddr(cfa));
4452 }
4453
4454 // IP->NFA
4455 // ( ip -- nfa / 0 )
4456 UFWORD(IP2NFA) {
4457   const uint32_t ip = ufoPop();
4458   ufoPush(ufoFindWordForIP(ip));
4459 }
4460
4461 // IP->FILE/LINE
4462 // ( ip -- addr count line TRUE / FALSE )
4463 // name is at PAD; it is safe to use PAD, because each task has its own temp image
4464 UFWORD(IP2FILELINE) {
4465   const uint32_t ip = ufoPop();
4466   uint32_t fline;
4467   const char *fname = ufoFindFileForIP(ip, &fline);
4468   if (fname != NULL) {
4469     UFCALL(PAD);
4470     const uint32_t addr = ufoPeek();
4471     uint32_t count = 0;
4472     while (*fname != 0) {
4473       ufoImgPutU8(addr + count, *(const unsigned char *)fname);
4474       fname += 1u; count += 1u;
4475     }
4476     ufoImgPutU8(addr + count, 0); // just in case
4477     ufoPush(addr);
4478     ufoPush(count);
4479     ufoPushBool(1);
4480   } else {
4481     ufoPushBool(0);
4482   }
4483 }
4484
4485
4486 // ////////////////////////////////////////////////////////////////////////// //
4487 // string operations
4488 //
4489
4490 UFO_FORCE_INLINE uint32_t ufoHashBuf (uint32_t addr, uint32_t size, uint8_t orbyte) {
4491   uint32_t hash = 0x29a;
4492   if ((size & ((uint32_t)1<<31)) == 0) {
4493     while (size != 0) {
4494       hash += ufoImgGetU8Ext(addr) | orbyte;
4495       hash += hash<<10;
4496       hash ^= hash>>6;
4497       addr += 1u; size -= 1u;
4498     }
4499   }
4500   // finalize
4501   hash += hash<<3;
4502   hash ^= hash>>11;
4503   hash += hash<<15;
4504   return hash;
4505 }
4506
4507 //==========================================================================
4508 //
4509 //  ufoBufEqu
4510 //
4511 //==========================================================================
4512 UFO_FORCE_INLINE int ufoBufEqu (uint32_t addr0, uint32_t addr1, uint32_t count) {
4513   int res;
4514   if ((count & ((uint32_t)1<<31)) == 0) {
4515     res = 1;
4516     while (res != 0 && count != 0) {
4517       res = (toUpperU8(ufoImgGetU8Ext(addr0)) == toUpperU8(ufoImgGetU8Ext(addr1)));
4518       addr0 += 1u; addr1 += 1u; count -= 1u;
4519     }
4520   } else {
4521     res = 0;
4522   }
4523   return res;
4524 }
4525
4526 // STRING:=
4527 // ( a0 c0 a1 c1 -- bool )
4528 UFWORD(STREQU) {
4529   int32_t c1 = (int32_t)ufoPop();
4530   uint32_t a1 = ufoPop();
4531   int32_t c0 = (int32_t)ufoPop();
4532   uint32_t a0 = ufoPop();
4533   if (c0 < 0) c0 = 0;
4534   if (c1 < 0) c1 = 0;
4535   if (c0 == c1) {
4536     int res = 1;
4537     while (res != 0 && c0 != 0) {
4538       res = (ufoImgGetU8Ext(a0) == ufoImgGetU8Ext(a1));
4539       a0 += 1; a1 += 1; c0 -= 1;
4540     }
4541     ufoPushBool(res);
4542   } else {
4543     ufoPushBool(0);
4544   }
4545 }
4546
4547 // STRING:=CI
4548 // ( a0 c0 a1 c1 -- bool )
4549 UFWORD(STREQUCI) {
4550   int32_t c1 = (int32_t)ufoPop();
4551   uint32_t a1 = ufoPop();
4552   int32_t c0 = (int32_t)ufoPop();
4553   uint32_t a0 = ufoPop();
4554   if (c0 < 0) c0 = 0;
4555   if (c1 < 0) c1 = 0;
4556   if (c0 == c1) {
4557     int res = 1;
4558     while (res != 0 && c0 != 0) {
4559       res = (toUpperU8(ufoImgGetU8Ext(a0)) == toUpperU8(ufoImgGetU8Ext(a1)));
4560       a0 += 1; a1 += 1; c0 -= 1;
4561     }
4562     ufoPushBool(res);
4563   } else {
4564     ufoPushBool(0);
4565   }
4566 }
4567
4568 // search the string specified by c-addr1 u1 for the string specified by c-addr2 u2.
4569 // if flag is true, a match was found at c-addr3 with u3 characters remaining.
4570 // if flag is false there was no match and c-addr3 is c-addr1 and u3 is u1.
4571 // ( c-addr1 u1 c-addr2 u2 -- c-addr3 u3 flag )
4572 UFWORD(SEARCH) {
4573   const uint32_t pcount = ufoPop();
4574   const uint32_t paddr = ufoPop();
4575   const uint32_t tcount = ufoPop();
4576   const uint32_t taddr = ufoPop();
4577   if ((pcount & ((uint32_t)1 << 31)) == 0 && (tcount & ((uint32_t)1 << 31)) == 0) {
4578     for (uint32_t f = 0; tcount - f >= pcount; f += 1) {
4579       if (ufoBufEqu(taddr + f, paddr, pcount)) {
4580         ufoPush(taddr + f);
4581         ufoPush(tcount - f);
4582         ufoPushBool(1);
4583         return;
4584       }
4585     }
4586   }
4587   ufoPush(taddr);
4588   ufoPush(tcount);
4589   ufoPushBool(0);
4590 }
4591
4592 // STRING:HASH
4593 // ( addr count -- hash )
4594 UFWORD(STRHASH) {
4595   uint32_t count = ufoPop();
4596   uint32_t addr = ufoPop();
4597   ufoPush(ufoHashBuf(addr, count, 0));
4598 }
4599
4600 // STRING:HASH-CI
4601 // ( addr count -- hash )
4602 UFWORD(STRHASHCI) {
4603   uint32_t count = ufoPop();
4604   uint32_t addr = ufoPop();
4605   ufoPush(ufoHashBuf(addr, count, 0x20));
4606 }
4607
4608
4609 // ////////////////////////////////////////////////////////////////////////// //
4610 // conditional defines
4611 //
4612
4613 typedef struct UForthCondDefine_t UForthCondDefine;
4614 struct UForthCondDefine_t {
4615   char *name;
4616   uint32_t namelen;
4617   uint32_t hash;
4618   UForthCondDefine *next;
4619 };
4620
4621 static UForthCondDefine *ufoCondDefines = NULL;
4622 static char ufoErrMsgBuf[4096];
4623
4624
4625 //==========================================================================
4626 //
4627 //  ufoStrEquCI
4628 //
4629 //==========================================================================
4630 UFO_DISABLE_INLINE int ufoStrEquCI (const void *str0, const void *str1) {
4631   const unsigned char *s0 = (const unsigned char *)str0;
4632   const unsigned char *s1 = (const unsigned char *)str1;
4633   while (*s0 && *s1) {
4634     if (toUpperU8(*s0) != toUpperU8(*s1)) return 0;
4635     s0 += 1; s1 += 1;
4636   }
4637   return (*s0 == 0 && *s1 == 0);
4638 }
4639
4640
4641 //==========================================================================
4642 //
4643 //  ufoBufEquCI
4644 //
4645 //==========================================================================
4646 UFO_FORCE_INLINE int ufoBufEquCI (uint32_t addr, uint32_t count, const void *buf) {
4647   int res;
4648   if ((count & ((uint32_t)1<<31)) == 0) {
4649     const unsigned char *src = (const unsigned char *)buf;
4650     res = 1;
4651     while (res != 0 && count != 0) {
4652       res = (toUpperU8(*src) == toUpperU8(ufoImgGetU8Ext(addr)));
4653       src += 1; addr += 1u; count -= 1u;
4654     }
4655   } else {
4656     res = 0;
4657   }
4658   return res;
4659 }
4660
4661
4662 //==========================================================================
4663 //
4664 //  ufoClearCondDefines
4665 //
4666 //==========================================================================
4667 static void ufoClearCondDefines (void) {
4668   while (ufoCondDefines) {
4669     UForthCondDefine *df = ufoCondDefines;
4670     ufoCondDefines = df->next;
4671     if (df->name) free(df->name);
4672     free(df);
4673   }
4674 }
4675
4676
4677 //==========================================================================
4678 //
4679 //  ufoHasCondDefine
4680 //
4681 //==========================================================================
4682 int ufoHasCondDefine (const char *name) {
4683   int res = 0;
4684   if (name != NULL && name[0] != 0) {
4685     const size_t nlen = strlen(name);
4686     if (nlen <= 255) {
4687       const uint32_t hash = joaatHashBufCI(name, nlen);
4688       UForthCondDefine *dd = ufoCondDefines;
4689       while (res == 0 && dd != NULL) {
4690         if (dd->hash == hash && dd->namelen == (uint32_t)nlen) {
4691           res = ufoStrEquCI(name, dd->name);
4692         }
4693         dd = dd->next;
4694       }
4695     }
4696   }
4697   return res;
4698 }
4699
4700
4701 //==========================================================================
4702 //
4703 //  ufoCondDefine
4704 //
4705 //==========================================================================
4706 void ufoCondDefine (const char *name) {
4707   if (name != NULL && name[0] != 0) {
4708     const size_t nlen = strlen(name);
4709     if (nlen > 255) ufoFatal("conditional define name too long");
4710     const uint32_t hash = joaatHashBufCI(name, nlen);
4711     UForthCondDefine *dd = ufoCondDefines;
4712     int res = 0;
4713     while (res == 0 && dd != NULL) {
4714       if (dd->hash == hash && dd->namelen == (uint32_t)nlen) {
4715         res = ufoStrEquCI(name, dd->name);
4716       }
4717       dd = dd->next;
4718     }
4719     if (res == 0) {
4720       // new define
4721       dd = calloc(1, sizeof(UForthCondDefine));
4722       if (dd == NULL) ufoFatal("out of memory for defines");
4723       dd->name = strdup(name);
4724       if (dd->name == NULL) { free(dd); ufoFatal("out of memory for defines"); }
4725       dd->namelen = (uint32_t)nlen;
4726       dd->hash = hash;
4727       dd->next = ufoCondDefines;
4728       ufoCondDefines = dd;
4729     }
4730   }
4731 }
4732
4733
4734 //==========================================================================
4735 //
4736 //  ufoCondUndef
4737 //
4738 //==========================================================================
4739 void ufoCondUndef (const char *name) {
4740   if (name != NULL && name[0] != 0) {
4741     const size_t nlen = strlen(name);
4742     if (nlen <= 255) {
4743       const uint32_t hash = joaatHashBufCI(name, nlen);
4744       UForthCondDefine *dd = ufoCondDefines;
4745       UForthCondDefine *prev = NULL;
4746       while (dd != NULL) {
4747         if (dd->hash == hash && dd->namelen == (uint32_t)nlen) {
4748           if (ufoStrEquCI(name, dd->name)) {
4749             if (prev != NULL) prev->next = dd->next; else ufoCondDefines = dd->next;
4750             free(dd->name);
4751             free(dd);
4752             dd = NULL;
4753           }
4754         }
4755         if (dd != NULL) { prev = dd; dd = dd->next; }
4756       }
4757     }
4758   }
4759 }
4760
4761
4762 // ($DEFINE)
4763 // ( addr count -- )
4764 UFWORD(PAR_DLR_DEFINE) {
4765   uint32_t count = ufoPop();
4766   uint32_t addr = ufoPop();
4767   if (count == 0) ufoFatal("empty define");
4768   if (count >= UFO_MAX_WORD_LENGTH) ufoFatal("define too long");
4769   const uint32_t hash = ufoHashBuf(addr, count, 0x20);
4770   UForthCondDefine *dd;
4771   for (dd = ufoCondDefines; dd != NULL; dd = dd->next) {
4772     if (dd->hash == hash && dd->namelen == count) {
4773       if (ufoBufEquCI(addr, count, dd->name)) return;
4774     }
4775   }
4776   // new define
4777   dd = calloc(1, sizeof(UForthCondDefine));
4778   if (dd == NULL) ufoFatal("out of memory for defines");
4779   dd->name = calloc(1, count + 1u);
4780   if (dd->name == NULL) { free(dd); ufoFatal("out of memory for defines"); }
4781   for (uint32_t f = 0; f < count; f += 1) {
4782     ((unsigned char *)dd->name)[f] = ufoImgGetU8Ext(addr + f);
4783   }
4784   dd->namelen = count;
4785   dd->hash = hash;
4786   dd->next = ufoCondDefines;
4787   ufoCondDefines = dd;
4788 }
4789
4790 // ($UNDEF)
4791 // ( addr count -- )
4792 UFWORD(PAR_DLR_UNDEF) {
4793   uint32_t count = ufoPop();
4794   uint32_t addr = ufoPop();
4795   if (count == 0) ufoFatal("empty define");
4796   if (count >= UFO_MAX_WORD_LENGTH) ufoFatal("define too long");
4797   const uint32_t hash = ufoHashBuf(addr, count, 0x20);
4798   UForthCondDefine *prev = NULL;
4799   UForthCondDefine *dd;
4800   for (dd = ufoCondDefines; dd != NULL; prev = dd, dd = dd->next) {
4801     if (dd->hash == hash && dd->namelen == count) {
4802       if (ufoBufEquCI(addr, count, dd->name)) {
4803         if (prev == NULL) ufoCondDefines = dd->next; else prev->next = dd->next;
4804         free(dd->name);
4805         free(dd);
4806         return;
4807       }
4808     }
4809   }
4810 }
4811
4812 // ($DEFINED?)
4813 // ( addr count -- bool )
4814 UFWORD(PAR_DLR_DEFINEDQ) {
4815   uint32_t count = ufoPop();
4816   uint32_t addr = ufoPop();
4817   if (count == 0) ufoFatal("empty define");
4818   if (count >= UFO_MAX_WORD_LENGTH) ufoFatal("define too long");
4819   const uint32_t hash = ufoHashBuf(addr, count, 0x20);
4820   int found = 0;
4821   UForthCondDefine *dd = ufoCondDefines;
4822   while (!found && dd != NULL) {
4823     if (dd->hash == hash && dd->namelen == count) {
4824       found = ufoBufEquCI(addr, count, dd->name);
4825     }
4826     dd = dd->next;
4827   }
4828   ufoPushBool(found);
4829 }
4830
4831
4832 // ////////////////////////////////////////////////////////////////////////// //
4833 // error reporting
4834 //
4835
4836 // ERROR
4837 // ( addr count -- )
4838 UFWORD(ERROR) {
4839   uint32_t count = ufoPop();
4840   uint32_t addr = ufoPop();
4841   if (count & (1u<<31)) ufoFatal("invalid error message");
4842   if (count == 0) ufoFatal("some error");
4843   if (count > (uint32_t)sizeof(ufoErrMsgBuf) - 1u) count = (uint32_t)sizeof(ufoErrMsgBuf) - 1u;
4844   for (uint32_t f = 0; f < count; f += 1) {
4845     ufoErrMsgBuf[f] = (char)ufoImgGetU8Ext(addr + f);
4846   }
4847   ufoErrMsgBuf[count] = 0;
4848   ufoFatal("%s", ufoErrMsgBuf);
4849 }
4850
4851 // ?ERROR
4852 // ( errflag addr count -- )
4853 UFWORD(QERROR) {
4854   const uint32_t count = ufoPop();
4855   const uint32_t addr = ufoPop();
4856   if (ufoPop()) {
4857     ufoPush(addr);
4858     ufoPush(count);
4859     UFCALL(ERROR);
4860   }
4861 }
4862
4863
4864 // ////////////////////////////////////////////////////////////////////////// //
4865 // includes
4866 //
4867
4868 static char ufoFNameBuf[4096];
4869
4870
4871 //==========================================================================
4872 //
4873 //  ufoScanIncludeFileName
4874 //
4875 //  `*psys` and `*psoft` must be initialised!
4876 //
4877 //==========================================================================
4878 static void ufoScanIncludeFileName (uint32_t addr, uint32_t count, char *dest, size_t destsz,
4879                                     uint32_t *psys, uint32_t *psoft)
4880 {
4881   uint8_t ch;
4882   uint32_t dpos;
4883   ufo_assert(dest != NULL);
4884   ufo_assert(destsz > 0);
4885
4886   while (count != 0) {
4887     ch = ufoImgGetU8Ext(addr);
4888     if (ch == '!') {
4889       //if (system) ufoFatal("invalid file name (duplicate system mark)");
4890       *psys = 1;
4891     } else if (ch == '?') {
4892       //if (softinclude) ufoFatal("invalid file name (duplicate soft mark)");
4893       *psoft = 1;
4894     } else {
4895       break;
4896     }
4897     do {
4898       addr += 1; count -= 1;
4899       ch = ufoImgGetU8Ext(addr);
4900     } while (ch <= 32 && count != 0);
4901   }
4902
4903   if (count == 0) ufoFatal("empty include file name");
4904   if (count >= destsz) ufoFatal("include file name too long");
4905
4906   dpos = 0;
4907   while (count != 0) {
4908     dest[dpos] = (char)ufoImgGetU8Ext(addr); dpos += 1;
4909     addr += 1; count -= 1;
4910   }
4911   dest[dpos] = 0;
4912 }
4913
4914
4915 // (INCLUDE-DEPTH)
4916 // ( -- depth )
4917 // return number of items in include stack
4918 UFWORD(PAR_INCLUDE_DEPTH) {
4919   ufoPush(ufoFileStackPos);
4920 }
4921
4922 // (INCLUDE-FILE-ID)
4923 // ( isp -- id ) -- isp 0 is current, then 1, etc.
4924 // each include file has unique non-zero id.
4925 UFWORD(PAR_INCLUDE_FILE_ID) {
4926   const uint32_t isp = ufoPop();
4927   if (isp == 0) {
4928     ufoPush(ufoFileId);
4929   } else if (isp <= ufoFileStackPos) {
4930     UFOFileStackEntry *stk = &ufoFileStack[ufoFileStackPos - isp];
4931     ufoPush(stk->id);
4932   } else {
4933     ufoFatal("invalid include stack index");
4934   }
4935 }
4936
4937 // (INCLUDE-FILE-LINE)
4938 // ( isp -- line )
4939 UFWORD(PAR_INCLUDE_FILE_LINE) {
4940   const uint32_t isp = ufoPop();
4941   if (isp == 0) {
4942     ufoPush(ufoInFileLine);
4943   } else if (isp <= ufoFileStackPos) {
4944     UFOFileStackEntry *stk = &ufoFileStack[ufoFileStackPos - isp];
4945     ufoPush(stk->fline);
4946   } else {
4947     ufoFatal("invalid include stack index");
4948   }
4949   ufoPush(ufoInFileLine);
4950 }
4951
4952 // (INCLUDE-FILE-NAME)
4953 // ( isp -- addr count )
4954 // current file name; at PAD
4955 UFWORD(PAR_INCLUDE_FILE_NAME) {
4956   const uint32_t isp = ufoPop();
4957   const char *fname = NULL;
4958   if (isp == 0) {
4959     fname = ufoInFileName;
4960   } else if (isp <= ufoFileStackPos) {
4961     UFOFileStackEntry *stk = &ufoFileStack[ufoFileStackPos - isp];
4962     fname = stk->fname;
4963   } else {
4964     ufoFatal("invalid include stack index");
4965   }
4966   UFCALL(PAD);
4967   uint32_t addr = ufoPop();
4968   uint32_t count = 0;
4969   while (fname[count] != 0) {
4970     ufoImgPutU8Ext(addr + count, ((const unsigned char *)fname)[count]);
4971     count += 1;
4972   }
4973   ufoImgPutU8Ext(addr + count, 0);
4974   ufoPush(addr);
4975   ufoPush(count);
4976 }
4977
4978 // (INCLUDE)
4979 // ( addr count soft? system? -- )
4980 UFWORD(PAR_INCLUDE) {
4981   uint32_t system = ufoPop();
4982   uint32_t softinclude = ufoPop();
4983   uint32_t count = ufoPop();
4984   uint32_t addr = ufoPop();
4985
4986   if (ufoMode == UFO_MODE_MACRO) ufoFatal("macros cannot include files");
4987
4988   if ((count & ((uint32_t)1<<31)) != 0) ufoFatal("invalid include name");
4989
4990   ufoScanIncludeFileName(addr, count, ufoFNameBuf, sizeof(ufoFNameBuf),
4991                          &system, &softinclude);
4992
4993   char *ffn = ufoCreateIncludeName(ufoFNameBuf, system, (system ? ufoLastSysIncPath : ufoLastIncPath));
4994   #ifdef WIN32
4995   FILE *fl = fopen(ffn, "rb");
4996   #else
4997   FILE *fl = fopen(ffn, "r");
4998   #endif
4999   if (!fl) {
5000     if (softinclude) { free(ffn); return; }
5001     ufoFatal("include file '%s' not found", ffn);
5002   }
5003   ufoPushInFile();
5004   ufoInFile = fl;
5005   ufoInFileLine = 0;
5006   ufoInFileName = ffn;
5007   ufoFileId = ufoLastUsedFileId;
5008   setLastIncPath(ufoInFileName, system);
5009   #ifdef UFO_DEBUG_INCLUDE
5010   fprintf(stderr, "INC-PUSH: new fname: %s\n", ffn);
5011   #endif
5012
5013   // trigger next line loading
5014   UFCALL(REFILL);
5015   if (!ufoPop()) ufoFatal("(INCLUDE) internal error");
5016 }
5017
5018 // $INCLUDE "str"
5019 UFWORD(DLR_INCLUDE_IMM) {
5020   int soft = 0, system = 0;
5021   // parse include filename
5022   //UFCALL(PARSE_SKIP_BLANKS);
5023   ufoPushBool(0); UFCALL(PAR_PARSE_SKIP_COMMENTS);
5024   uint8_t ch = ufoTibPeekCh();
5025   if (ch == '"') {
5026     ufoTibSkipCh(); // skip quote
5027     ufoPush(34);
5028   } else if (ch == '<') {
5029     ufoTibSkipCh(); // skip quote
5030     ufoPush(62);
5031     system = 1;
5032   } else {
5033     ufoFatal("expected quoted string");
5034   }
5035   UFCALL(PARSE);
5036   if (!ufoPop()) ufoFatal("file name expected");
5037   ufoPushBool(0); UFCALL(PAR_PARSE_SKIP_COMMENTS);
5038   if (ufoTibPeekCh() != 0) {
5039     ufoFatal("$INCLUDE doesn't accept extra args yet");
5040   }
5041   // ( addr count soft? system? -- )
5042   ufoPushBool(soft); ufoPushBool(system); UFCALL(PAR_INCLUDE);
5043 }
5044
5045
5046 //==========================================================================
5047 //
5048 //  ufoCreateFileGuard
5049 //
5050 //==========================================================================
5051 static const char *ufoCreateFileGuard (const char *fname) {
5052   if (fname == NULL || fname[0] == 0) return NULL;
5053   char *rp = ufoRealPath(fname);
5054   if (rp == NULL) return NULL;
5055   #ifdef WIN32
5056   for (char *s = rp; *s; s += 1) if (*s == '\\') *s = '/';
5057   #endif
5058   // hash the buffer; extract file name; create string with path len, file name, and hash
5059   const size_t orgplen = strlen(rp);
5060   const uint32_t phash = joaatHashBuf(rp, orgplen, 0);
5061   size_t plen = orgplen;
5062   while (plen != 0 && rp[plen - 1u] != '/') plen -= 1;
5063   snprintf(ufoRealPathHashBuf, sizeof(ufoRealPathHashBuf),
5064            "__INCLUDE_GUARD_%08X_%08X_%s__", phash, (uint32_t)orgplen, rp + plen);
5065   return ufoRealPathHashBuf;
5066 }
5067
5068
5069 // $INCLUDE-ONCE "str"
5070 // includes file only once; unreliable on shitdoze, i believe
5071 UFWORD(DLR_INCLUDE_ONCE_IMM) {
5072   uint32_t softinclude = 0, system = 0;
5073   // parse include filename
5074   //UFCALL(PARSE_SKIP_BLANKS);
5075   ufoPushBool(0); UFCALL(PAR_PARSE_SKIP_COMMENTS);
5076   uint8_t ch = ufoTibPeekCh();
5077   if (ch == '"') {
5078     ufoTibSkipCh(); // skip quote
5079     ufoPush(34);
5080   } else if (ch == '<') {
5081     ufoTibSkipCh(); // skip quote
5082     ufoPush(62);
5083     system = 1;
5084   } else {
5085     ufoFatal("expected quoted string");
5086   }
5087   UFCALL(PARSE);
5088   if (!ufoPop()) ufoFatal("file name expected");
5089   const uint32_t count = ufoPop();
5090   const uint32_t addr = ufoPop();
5091   ufoPushBool(0); UFCALL(PAR_PARSE_SKIP_COMMENTS);
5092   if (ufoTibPeekCh() != 0) {
5093     ufoFatal("$REQUIRE doesn't accept extra args yet");
5094   }
5095   ufoScanIncludeFileName(addr, count, ufoRealPathHashBuf, sizeof(ufoRealPathHashBuf),
5096                          &system, &softinclude);
5097   char *incfname = ufoCreateIncludeName(ufoRealPathHashBuf, system, (system ? ufoLastSysIncPath : ufoLastIncPath));
5098   if (incfname == NULL) ufoFatal("cannot resolve include file '%s'", ufoRealPathHashBuf);
5099   //fprintf(stderr, "?:%d;!:%d;%s|%s\n", softinclude, system, ufoRealPathHashBuf, incfname);
5100   // this will overwrite `ufoRealPathHashBuf`
5101   const char *guard = ufoCreateFileGuard(incfname);
5102   free(incfname);
5103   if (guard == NULL) {
5104     if (!softinclude) ufoFatal("cannot include file '%s'", ufoRealPathHashBuf);
5105     return;
5106   }
5107   #if 0
5108   fprintf(stderr, "GUARD: <%s>\n", guard);
5109   #endif
5110   // now check for the guard
5111   const uint32_t glen = (uint32_t)strlen(guard);
5112   const uint32_t ghash = joaatHashBuf(guard, glen, 0);
5113   UForthCondDefine *dd;
5114   for (dd = ufoCondDefines; dd != NULL; dd = dd->next) {
5115     if (dd->hash == ghash && dd->namelen == glen && strcmp(guard, dd->name) == 0) {
5116       // nothing to do: already included
5117       return;
5118     }
5119   }
5120   // add guard
5121   dd = calloc(1, sizeof(UForthCondDefine));
5122   if (dd == NULL) ufoFatal("out of memory for defines");
5123   dd->name = calloc(1, glen + 1u);
5124   if (dd->name == NULL) { free(dd); ufoFatal("out of memory for defines"); }
5125   strcpy(dd->name, guard);
5126   dd->namelen = glen;
5127   dd->hash = ghash;
5128   dd->next = ufoCondDefines;
5129   ufoCondDefines = dd;
5130   // ( addr count soft? system? -- )
5131   ufoPush(addr); ufoPush(count); ufoPushBool(softinclude); ufoPushBool(system);
5132   UFCALL(PAR_INCLUDE);
5133 }
5134
5135
5136 // ////////////////////////////////////////////////////////////////////////// //
5137 // handles
5138 //
5139
5140 // HANDLE:NEW
5141 // ( typeid -- hx )
5142 UFWORD(PAR_NEW_HANDLE) {
5143   const uint32_t typeid = ufoPop();
5144   if (typeid == UFO_HANDLE_FREE) ufoFatal("invalid handle typeid");
5145   UfoHandle *hh = ufoAllocHandle(typeid);
5146   ufoPush(hh->ufoHandle);
5147 }
5148
5149 // HANDLE:FREE
5150 // ( hx -- )
5151 UFWORD(PAR_FREE_HANDLE) {
5152   const uint32_t hx = ufoPop();
5153   if ((hx & UFO_ADDR_HANDLE_BIT) == 0) ufoFatal("trying to free something that is not a handle");
5154   UfoHandle *hh = ufoGetHandle(hx);
5155   if (hh == NULL) ufoFatal("trying to free invalid handle");
5156   ufoFreeHandle(hh);
5157 }
5158
5159 // HANDLE:TYPEID@
5160 // ( hx -- typeid )
5161 UFWORD(PAR_HANDLE_GET_TYPEID) {
5162   const uint32_t hx = ufoPop();
5163   if ((hx & UFO_ADDR_HANDLE_BIT) == 0) ufoFatal("not a handle");
5164   UfoHandle *hh = ufoGetHandle(hx);
5165   if (hh == NULL) ufoFatal("invalid handle");
5166   ufoPush(hh->typeid);
5167 }
5168
5169 // HANDLE:TYPEID!
5170 // ( typeid hx -- )
5171 UFWORD(PAR_HANDLE_SET_TYPEID) {
5172   const uint32_t hx = ufoPop();
5173   const uint32_t typeid = ufoPop();
5174   if ((hx & UFO_ADDR_HANDLE_BIT) == 0) ufoFatal("not a handle");
5175   if (typeid == UFO_HANDLE_FREE) ufoFatal("invalid handle typeid");
5176   UfoHandle *hh = ufoGetHandle(hx);
5177   if (hh == NULL) ufoFatal("invalid handle");
5178   hh->typeid = typeid;
5179 }
5180
5181 // HANDLE:SIZE@
5182 // ( hx -- size )
5183 UFWORD(PAR_HANDLE_GET_SIZE) {
5184   const uint32_t hx = ufoPop();
5185   if ((hx & UFO_ADDR_HANDLE_BIT) == 0) ufoFatal("not a handle");
5186   UfoHandle *hh = ufoGetHandle(hx);
5187   if (hh == NULL) ufoFatal("invalid handle");
5188   ufoPush(hh->size);
5189 }
5190
5191 // HANDLE:SIZE!
5192 // ( size hx -- )
5193 UFWORD(PAR_HANDLE_SET_SIZE) {
5194   const uint32_t hx = ufoPop();
5195   const uint32_t size = ufoPop();
5196   if (size > 0x04000000) ufoFatal("invalid handle size");
5197   if ((hx & UFO_ADDR_HANDLE_BIT) == 0) ufoFatal("not a handle");
5198   UfoHandle *hh = ufoGetHandle(hx);
5199   if (hh == NULL) ufoFatal("invalid handle");
5200   if (hh->size != size) {
5201     if (size == 0) {
5202       free(hh->data);
5203       hh->data = NULL;
5204     } else {
5205       uint8_t *nx = realloc(hh->data, size * sizeof(hh->data[0]));
5206       if (nx == NULL) ufoFatal("out of memory for handle of size %u", size);
5207       hh->data = nx;
5208       if (size > hh->size) memset(hh->data, 0, size - hh->size);
5209     }
5210     hh->size = size;
5211     if (hh->used > size) hh->used = size;
5212   }
5213 }
5214
5215 // HANDLE:USED@
5216 // ( hx -- used )
5217 UFWORD(PAR_HANDLE_GET_USED) {
5218   const uint32_t hx = ufoPop();
5219   if ((hx & UFO_ADDR_HANDLE_BIT) == 0) ufoFatal("not a handle");
5220   UfoHandle *hh = ufoGetHandle(hx);
5221   if (hh == NULL) ufoFatal("invalid handle");
5222   ufoPush(hh->used);
5223 }
5224
5225 // HANDLE:USED!
5226 // ( size hx -- )
5227 UFWORD(PAR_HANDLE_SET_USED) {
5228   const uint32_t hx = ufoPop();
5229   const uint32_t used = ufoPop();
5230   if (used > 0x04000000) ufoFatal("invalid handle used");
5231   if ((hx & UFO_ADDR_HANDLE_BIT) == 0) ufoFatal("not a handle");
5232   UfoHandle *hh = ufoGetHandle(hx);
5233   if (hh == NULL) ufoFatal("invalid handle");
5234   if (used > hh->size) ufoFatal("handle used %u out of range (%u)", used, hh->size);
5235   hh->used = used;
5236 }
5237
5238 #define POP_PREPARE_HANDLE() \
5239   const uint32_t hx = ufoPop(); \
5240   uint32_t idx = ufoPop(); \
5241   if ((hx & UFO_ADDR_HANDLE_BIT) == 0) ufoFatal("not a handle"); \
5242   if (idx > 0x1fffffffU - UFO_ADDR_HANDLE_OFS_MASK) ufoFatal("handle index %u out of range", idx); \
5243   idx += (hx & UFO_ADDR_HANDLE_OFS_MASK); \
5244   UfoHandle *hh = ufoGetHandle(hx); \
5245   if (hh == NULL) ufoFatal("invalid handle")
5246
5247 // HANDLE:C@
5248 // ( idx hx -- value )
5249 UFWORD(PAR_HANDLE_LOAD_BYTE) {
5250   POP_PREPARE_HANDLE();
5251   if (idx >= hh->size) ufoFatal("handle index %u out of range (%u)", idx, hh->size);
5252   ufoPush(hh->data[idx]);
5253 }
5254
5255 // HANDLE:W@
5256 // ( idx hx -- value )
5257 UFWORD(PAR_HANDLE_LOAD_WORD) {
5258   POP_PREPARE_HANDLE();
5259   if (idx >= hh->size || hh->size - idx < 2u) {
5260     ufoFatal("handle index %u out of range (%u)", idx, hh->size);
5261   }
5262   #ifdef UFO_FAST_MEM_ACCESS
5263   ufoPush(*(const uint16_t *)(hh->data + idx));
5264   #else
5265   uint32_t res = hh->data[idx];
5266   res |= hh->data[idx + 1u] << 8;
5267   ufoPush(res);
5268   #endif
5269 }
5270
5271 // HANDLE:@
5272 // ( idx hx -- value )
5273 UFWORD(PAR_HANDLE_LOAD_CELL) {
5274   POP_PREPARE_HANDLE();
5275   if (idx >= hh->size || hh->size - idx < 4u) {
5276     ufoFatal("handle index %u out of range (%u)", idx, hh->size);
5277   }
5278   #ifdef UFO_FAST_MEM_ACCESS
5279   ufoPush(*(const uint32_t *)(hh->data + idx));
5280   #else
5281   uint32_t res = hh->data[idx];
5282   res |= hh->data[idx + 1u] << 8;
5283   res |= hh->data[idx + 2u] << 16;
5284   res |= hh->data[idx + 3u] << 24;
5285   ufoPush(res);
5286   #endif
5287 }
5288
5289 // HANDLE:C!
5290 // ( value idx hx -- value )
5291 UFWORD(PAR_HANDLE_STORE_BYTE) {
5292   POP_PREPARE_HANDLE();
5293   const uint32_t value = ufoPop();
5294   if (idx >= hh->size) ufoFatal("handle index %u out of range (%u)", idx, hh->size);
5295   hh->data[idx] = value;
5296 }
5297
5298 // HANDLE:W!
5299 // ( value idx hx -- )
5300 UFWORD(PAR_HANDLE_STORE_WORD) {
5301   POP_PREPARE_HANDLE();
5302   const uint32_t value = ufoPop();
5303   if (idx >= hh->size || hh->size - idx < 2u) {
5304     ufoFatal("handle index %u out of range (%u)", idx, hh->size);
5305   }
5306   #ifdef UFO_FAST_MEM_ACCESS
5307   *(uint16_t *)(hh->data + idx) = (uint16_t)value;
5308   #else
5309   hh->data[idx] = (uint8_t)value;
5310   hh->data[idx + 1u] = (uint8_t)(value >> 8);
5311   #endif
5312 }
5313
5314 // HANDLE:!
5315 // ( value idx hx -- )
5316 UFWORD(PAR_HANDLE_STORE_CELL) {
5317   POP_PREPARE_HANDLE();
5318   const uint32_t value = ufoPop();
5319   if (idx >= hh->size || hh->size - idx < 4u) {
5320     ufoFatal("handle index %u out of range (%u)", idx, hh->size);
5321   }
5322   #ifdef UFO_FAST_MEM_ACCESS
5323   *(uint32_t *)(hh->data + idx) = value;
5324   #else
5325   hh->data[idx] = (uint8_t)value;
5326   hh->data[idx + 1u] = (uint8_t)(value >> 8);
5327   hh->data[idx + 2u] = (uint8_t)(value >> 16);
5328   hh->data[idx + 3u] = (uint8_t)(value >> 24);
5329   #endif
5330 }
5331
5332
5333 // HANDLE:LOAD-FILE
5334 // ( addr count -- stx )
5335 UFWORD(PAR_HANDLE_LOAD_FILE) {
5336   uint32_t count = ufoPop();
5337   uint32_t addr = ufoPop();
5338
5339   if ((count & ((uint32_t)1<<31)) != 0) ufoFatal("invalid file name");
5340
5341   uint8_t *dest = (uint8_t *)ufoFNameBuf;
5342   while (count != 0 && dest < (uint8_t *)ufoFNameBuf + sizeof(ufoFNameBuf)) {
5343     uint8_t ch = ufoImgGetU8Ext(addr);
5344     *dest = ch;
5345     dest += 1u; addr += 1u; count -= 1u;
5346   }
5347   if (dest == (uint8_t *)ufoFNameBuf + sizeof(ufoFNameBuf)) ufoFatal("file name too long");
5348   *dest = 0;
5349
5350   if (*ufoFNameBuf == 0) ufoFatal("empty file name");
5351
5352   char *ffn = ufoCreateIncludeName(ufoFNameBuf, 0/*system*/, ufoLastIncPath);
5353   #ifdef WIN32
5354   FILE *fl = fopen(ffn, "rb");
5355   #else
5356   FILE *fl = fopen(ffn, "r");
5357   #endif
5358   if (!fl) {
5359     ufoFatal("file '%s' not found", ffn);
5360   }
5361
5362   if (fseek(fl, 0, SEEK_END) != 0) {
5363     fclose(fl);
5364     ufoFatal("seek error in file '%s'", ffn);
5365   }
5366
5367   long sz = ftell(fl);
5368   if (sz < 0 || sz >= 1024 * 1024 * 64) {
5369     fclose(fl);
5370     ufoFatal("tell error in file '%s' (or too big)", ffn);
5371   }
5372
5373   if (fseek(fl, 0, SEEK_SET) != 0) {
5374     fclose(fl);
5375     ufoFatal("seek error in file '%s'", ffn);
5376   }
5377
5378   UfoHandle *hh = ufoAllocHandle(0);
5379   if (sz != 0) {
5380     hh->data = malloc((uint32_t)sz);
5381     if (hh->data == NULL) {
5382       fclose(fl);
5383       ufoFatal("out of memory for file '%s'", ffn);
5384     }
5385     hh->size = (uint32_t)sz;
5386     if (fread(hh->data, (uint32_t)sz, 1, fl) != 1) {
5387       fclose(fl);
5388       ufoFatal("error reading file '%s'", ffn);
5389     }
5390     fclose(fl);
5391   }
5392
5393   free(ffn);
5394   ufoPush(hh->ufoHandle);
5395 }
5396
5397
5398 // ////////////////////////////////////////////////////////////////////////// //
5399 // utils
5400 //
5401
5402 // DEBUG:(DECOMPILE-CFA)
5403 // ( cfa -- )
5404 UFWORD(DEBUG_DECOMPILE_CFA) {
5405   const uint32_t cfa = ufoPop();
5406   ufoDecompileWord(cfa);
5407 }
5408
5409 // GET-MSECS
5410 // ( -- u32 )
5411 UFWORD(GET_MSECS) {
5412   ufoPush((uint32_t)ufo_get_msecs());
5413 }
5414
5415 // this is called by INTERPRET when it is out of input stream
5416 UFWORD(UFO_INTERPRET_FINISHED_ACTION) {
5417   ufoVMStop = 1;
5418 }
5419
5420 // MTASK:NEW-STATE
5421 // ( cfa -- stid )
5422 UFWORD(MT_NEW_STATE) {
5423   UfoState *st = ufoNewState(ufoPop());
5424   ufoInitStateUserVars(st, 1);
5425   ufoPush(st->id);
5426 }
5427
5428 // MTASK:FREE-STATE
5429 // ( stid -- )
5430 UFWORD(MT_FREE_STATE) {
5431   UfoState *st = ufoFindState(ufoPop());
5432   if (st == NULL) ufoFatal("cannot free unknown state");
5433   if (st == ufoCurrState) ufoFatal("cannot free current state");
5434   ufoFreeState(st);
5435 }
5436
5437 // MTASK:STATE-NAME@
5438 // ( stid -- addr count )
5439 // to PAD
5440 UFWORD(MT_GET_STATE_NAME) {
5441   UfoState *st = ufoFindState(ufoPop());
5442   if (st == NULL) ufoFatal("unknown state");
5443   UFCALL(PAD);
5444   uint32_t addr = ufoPop();
5445   uint32_t count = 0;
5446   while (st->name[count] != 0) {
5447     ufoImgPutU8Ext(addr + count, ((const unsigned char *)st->name)[count]);
5448     count += 1u;
5449   }
5450   ufoImgPutU8Ext(addr + count, 0);
5451   ufoPush(addr);
5452   ufoPush(count);
5453 }
5454
5455 // MTASK:STATE-NAME!
5456 // ( addr count stid -- )
5457 UFWORD(MT_SET_STATE_NAME) {
5458   UfoState *st = ufoFindState(ufoPop());
5459   if (st == NULL) ufoFatal("unknown state");
5460   uint32_t count = ufoPop();
5461   uint32_t addr = ufoPop();
5462   if ((count & ((uint32_t)1 << 31)) == 0) {
5463     if (count > UFO_MAX_TASK_NAME) ufoFatal("task name too long");
5464     for (uint32_t f = 0; f < count; f += 1u) {
5465       ((unsigned char *)st->name)[f] = ufoImgGetU8Ext(addr + f);
5466     }
5467     st->name[count] = 0;
5468   }
5469 }
5470
5471 // MTASK:STATE-FIRST
5472 // ( -- stid )
5473 UFWORD(MT_STATE_FIRST) {
5474   uint32_t fidx = 0;
5475   while (fidx != (uint32_t)(UFO_MAX_STATES/32) && ufoStateUsedBitmap[fidx] == 0) fidx += 1u;
5476   // there should be at least one allocated state
5477   ufo_assert(fidx != (uint32_t)(UFO_MAX_STATES/32));
5478   uint32_t bmp = ufoStateUsedBitmap[fidx];
5479   fidx *= 32u;
5480   while ((bmp & 0x01) == 0) { fidx += 1u; bmp >>= 1; }
5481   ufoPush(fidx + 1u);
5482 }
5483
5484 // MTASK:STATE-NEXT
5485 // ( stid -- stid / 0 )
5486 UFWORD(MT_STATE_NEXT) {
5487   uint32_t stid = ufoPop();
5488   if (stid != 0 && stid < (uint32_t)(UFO_MAX_STATES/32)) {
5489     // it is already incremented for us, yay!
5490     uint32_t fidx = stid / 32u;
5491     uint8_t fofs = stid & 0x1f;
5492     while (fidx < (uint32_t)(UFO_MAX_STATES/32)) {
5493       const uint32_t bmp = ufoStateUsedBitmap[fidx];
5494       if (bmp != 0) {
5495         while (fofs != 32u) {
5496           if ((bmp & ((uint32_t)1 << (fofs & 0x1f))) == 0) fofs += 1u;
5497         }
5498         if (fofs != 32u) {
5499           ufoPush(fidx * 32u + fofs + 1u);
5500           return; // sorry!
5501         }
5502       }
5503       fidx += 1u; fofs = 0;
5504     }
5505   }
5506   ufoPush(0);
5507 }
5508
5509
5510 // MTASK:YIELD-TO
5511 // ( ... argc stid -- )
5512 UFWORD(MT_YIELD_TO) {
5513   UfoState *st = ufoFindState(ufoPop());
5514   if (st == NULL) ufoFatal("cannot yield to unknown state");
5515   //if (st == ufoDebuggerState) ufoFatal("cannot yield to debugger"); // why not?
5516   const uint32_t argc = ufoPop();
5517   if (argc > 256) ufoFatal("too many YIELD-TO arguments");
5518   UfoState *curst = ufoCurrState;
5519   if (st != ufoCurrState) {
5520     for (uint32_t f = 0; f < argc; f += 1) {
5521       ufoCurrState = curst;
5522       const uint32_t n = ufoPop();
5523       ufoCurrState = st;
5524       ufoPush(n);
5525     }
5526     ufoCurrState = curst; // we need to use API call to switch states
5527   }
5528   ufoSwitchToState(st); // always use API call for this!
5529   ufoPush(argc);
5530   ufoPush(curst->id);
5531 }
5532
5533 // MTASK:SET-SELF-AS-DEBUGGER
5534 // ( -- )
5535 UFWORD(MT_SET_SELF_AS_DEBUGGER) {
5536   ufoDebuggerState = ufoCurrState;
5537 }
5538
5539 // DEBUG:(BP)
5540 // ( -- )
5541 // debugger task receives debugge stid on the data stack, and -1 as argc.
5542 // i.e. debugger stask is: ( -1 old-stid )
5543 UFWORD(MT_DEBUGGER_BP) {
5544   if (ufoDebuggerState != NULL && ufoCurrState != ufoDebuggerState) {
5545     UfoState *st = ufoCurrState;
5546     ufoSwitchToState(ufoDebuggerState); // always use API call for this!
5547     ufoPush(-1);
5548     ufoPush(st->id);
5549     ufoSingleStep = 0;
5550   }
5551 }
5552
5553 // MTASK:DEBUGGER-RESUME
5554 // ( stid -- )
5555 UFWORD(MT_RESUME_DEBUGEE) {
5556   if (ufoCurrState != ufoDebuggerState) ufoFatal("cannot resume from non-debugger");
5557   UfoState *st = ufoFindState(ufoPop());
5558   if (st == NULL) ufoFatal("cannot yield to unknown state");
5559   if (st == ufoCurrState) ufoFatal("cannot resume into debugger itself");
5560   ufoSwitchToState(st); // always use API call for this!
5561   ufoSingleStep = 0;
5562 }
5563
5564 // MTASK:DEBUGGER-SINGLE-STEP
5565 // ( stid -- )
5566 UFWORD(MT_SINGLE_STEP_DEBUGEE) {
5567   if (ufoCurrState != ufoDebuggerState) ufoFatal("cannot resume from non-debugger");
5568   UfoState *st = ufoFindState(ufoPop());
5569   if (st == NULL) ufoFatal("cannot yield to unknown state");
5570   if (st == ufoCurrState) ufoFatal("cannot resume into debugger itself");
5571   ufoSwitchToState(st); // always use API call for this!
5572   ufoSingleStep = 2; // it will be decremented after returning from this word
5573 }
5574
5575 // MTASK:STATE-IP@
5576 // ( stid -- ip )
5577 UFWORD(MT_STATE_IP_GET) {
5578   UfoState *st = ufoFindState(ufoPop());
5579   if (st == NULL) ufoFatal("unknown state");
5580   ufoPush(st->IP);
5581 }
5582
5583 // MTASK:STATE-IP!
5584 // ( ip stid -- )
5585 UFWORD(MT_STATE_IP_SET) {
5586   UfoState *st = ufoFindState(ufoPop());
5587   if (st == NULL) ufoFatal("unknown state");
5588   st->IP = ufoPop();
5589 }
5590
5591 // MTASK:STATE-A>
5592 // ( stid -- ip )
5593 UFWORD(MT_STATE_REGA_GET) {
5594   UfoState *st = ufoFindState(ufoPop());
5595   if (st == NULL) ufoFatal("unknown state");
5596   ufoPush(st->regA);
5597 }
5598
5599 // MTASK:STATE->A
5600 // ( ip stid -- )
5601 UFWORD(MT_STATE_REGA_SET) {
5602   UfoState *st = ufoFindState(ufoPop());
5603   if (st == NULL) ufoFatal("unknown state");
5604   st->regA = ufoPop();
5605 }
5606
5607 // MTASK:STATE-USER@
5608 // ( addr stid -- value )
5609 UFWORD(MT_STATE_USER_GET) {
5610   UfoState *st = ufoFindState(ufoPop());
5611   if (st == NULL) ufoFatal("unknown state");
5612   uint32_t addr = ufoPop();
5613   if ((addr & UFO_ADDR_TEMP_BIT) != 0 && (addr & UFO_ADDR_TEMP_MASK) + 3u < st->imageTempSize) {
5614     uint32_t v = *(const uint32_t *)((const uint8_t *)st->imageTemp + (addr & UFO_ADDR_TEMP_MASK));
5615     ufoPush(v);
5616   } else {
5617     ufoFatal("invalid user area address");
5618   }
5619 }
5620
5621 // MTASK:STATE-USER!
5622 // ( value addr stid -- )
5623 UFWORD(MT_STATE_USER_SET) {
5624   UfoState *st = ufoFindState(ufoPop());
5625   if (st == NULL) ufoFatal("unknown state");
5626   uint32_t addr = ufoPop();
5627   uint32_t value = ufoPop();
5628   if ((addr & UFO_ADDR_TEMP_BIT) != 0 && (addr & UFO_ADDR_TEMP_MASK) + 3u < st->imageTempSize) {
5629     *(uint32_t *)((const uint8_t *)st->imageTemp + (addr & UFO_ADDR_TEMP_MASK)) = value;
5630   } else {
5631     ufoFatal("invalid user area address");
5632   }
5633 }
5634
5635 // MTASK:STATE-RPOPCFA@
5636 // ( -- flag )
5637 UFWORD(MT_STATE_RPOPCFA_GET) {
5638   UfoState *st = ufoFindState(ufoPop());
5639   if (st == NULL) ufoFatal("unknown state");
5640   ufoPush(st->vmRPopCFA);
5641 }
5642
5643 // MTASK:STATE-RPOPCFA!
5644 // ( flag -- )
5645 UFWORD(MT_STATE_RPOPCFA_SET) {
5646   UfoState *st = ufoFindState(ufoPop());
5647   if (st == NULL) ufoFatal("unknown state");
5648   st->vmRPopCFA = ufoPop();
5649 }
5650
5651 // MTASK:ACTIVE-STATE
5652 // ( -- stid )
5653 UFWORD(MT_ACTIVE_STATE) {
5654   ufoPush(ufoCurrState->id);
5655 }
5656
5657 // MTASK:YIELDED-FROM
5658 // ( -- stid / 0 )
5659 UFWORD(MT_YIELDED_FROM) {
5660   if (ufoYieldedState != NULL) {
5661     ufoPush(ufoYieldedState->id);
5662   } else {
5663     ufoPush(0);
5664   }
5665 }
5666
5667 // MTASK:STATE-SP@
5668 // ( stid -- depth )
5669 UFWORD(MT_DSTACK_DEPTH_GET) {
5670   UfoState *st = ufoFindState(ufoPop());
5671   if (st == NULL) ufoFatal("unknown state");
5672   ufoPush(st->SP);
5673 }
5674
5675 // MTASK:STATE-RP@
5676 // ( stid -- depth )
5677 UFWORD(MT_RSTACK_DEPTH_GET) {
5678   UfoState *st = ufoFindState(ufoPop());
5679   if (st == NULL) ufoFatal("unknown state");
5680   ufoPush(st->RP - st->RPTop);
5681 }
5682
5683 // MTASK:STATE-LP@
5684 // ( stid -- lp )
5685 UFWORD(MT_LP_GET) {
5686   UfoState *st = ufoFindState(ufoPop());
5687   if (st == NULL) ufoFatal("unknown state");
5688   ufoPush(st->LP);
5689 }
5690
5691 // MTASK:STATE-LBP@
5692 // ( stid -- lbp )
5693 UFWORD(MT_LBP_GET) {
5694   UfoState *st = ufoFindState(ufoPop());
5695   if (st == NULL) ufoFatal("unknown state");
5696   ufoPush(st->LBP);
5697 }
5698
5699 // MTASK:STATE-SP!
5700 // ( depth stid -- )
5701 UFWORD(MT_DSTACK_DEPTH_SET) {
5702   UfoState *st = ufoFindState(ufoPop());
5703   if (st == NULL) ufoFatal("unknown state");
5704   uint32_t idx = ufoPop();
5705   if (idx >= UFO_DSTACK_SIZE) ufoFatal("invalid stack index %u (%u)", idx, UFO_DSTACK_SIZE);
5706   st->SP = idx;
5707 }
5708
5709 // MTASK:STATE-RP!
5710 // ( stid -- depth )
5711 UFWORD(MT_RSTACK_DEPTH_SET) {
5712   UfoState *st = ufoFindState(ufoPop());
5713   if (st == NULL) ufoFatal("unknown state");
5714   uint32_t idx = ufoPop();
5715   const uint32_t left = UFO_RSTACK_SIZE - st->RPTop;
5716   if (idx >= left) ufoFatal("invalid stack index %u (%u)", idx, left);
5717   st->RP = st->RPTop + idx;
5718 }
5719
5720 // MTASK:STATE-LP!
5721 // ( lp stid -- )
5722 UFWORD(MT_LP_SET) {
5723   UfoState *st = ufoFindState(ufoPop());
5724   if (st == NULL) ufoFatal("unknown state");
5725   st->LP = ufoPop();
5726 }
5727
5728 // MTASK:STATE-LBP!
5729 // ( lbp stid -- )
5730 UFWORD(MT_LBP_SET) {
5731   UfoState *st = ufoFindState(ufoPop());
5732   if (st == NULL) ufoFatal("unknown state");
5733   st->LBP = ufoPop();
5734 }
5735
5736 // MTASK:STATE-DS@
5737 // ( idx stid -- value )
5738 UFWORD(MT_DSTACK_LOAD) {
5739   UfoState *st = ufoFindState(ufoPop());
5740   if (st == NULL) ufoFatal("unknown state");
5741   uint32_t idx = ufoPop();
5742   if (idx >= st->SP) ufoFatal("invalid stack index %u (%u)", idx, st->SP);
5743   ufoPush(st->dStack[st->SP - idx - 1u]);
5744 }
5745
5746 // MTASK:STATE-RS@
5747 // ( idx stid -- value )
5748 UFWORD(MT_RSTACK_LOAD) {
5749   UfoState *st = ufoFindState(ufoPop());
5750   if (st == NULL) ufoFatal("unknown state");
5751   uint32_t idx = ufoPop();
5752   if (idx >= st->RP - st->RPTop) ufoFatal("invalid stack index %u (%u)", idx, st->RP - st->RPTop);
5753   ufoPush(st->dStack[st->RP - idx - 1u]);
5754 }
5755
5756 // MTASK:STATE-LS@
5757 // ( idx stid -- value )
5758 UFWORD(MT_LSTACK_LOAD) {
5759   UfoState *st = ufoFindState(ufoPop());
5760   if (st == NULL) ufoFatal("unknown state");
5761   uint32_t idx = ufoPop();
5762   if (idx >= st->LP) ufoFatal("invalid lstack index %u (%u)", idx, st->LP);
5763   ufoPush(st->lStack[st->LP - idx - 1u]);
5764 }
5765
5766 // MTASK:STATE-DS!
5767 // ( value idx stid -- )
5768 UFWORD(MT_DSTACK_STORE) {
5769   UfoState *st = ufoFindState(ufoPop());
5770   if (st == NULL) ufoFatal("unknown state");
5771   uint32_t idx = ufoPop();
5772   uint32_t value = ufoPop();
5773   if (idx >= st->SP) ufoFatal("invalid stack index %u (%u)", idx, st->SP);
5774   st->dStack[st->SP - idx - 1u] = value;
5775 }
5776
5777 // MTASK:STATE-RS!
5778 // ( value idx stid -- )
5779 UFWORD(MT_RSTACK_STORE) {
5780   UfoState *st = ufoFindState(ufoPop());
5781   if (st == NULL) ufoFatal("unknown state");
5782   uint32_t idx = ufoPop();
5783   uint32_t value = ufoPop();
5784   if (idx >= st->RP - st->RPTop) ufoFatal("invalid stack index %u (%u)", idx, st->RP - st->RPTop);
5785   st->dStack[st->RP - idx - 1u] = value;
5786 }
5787
5788 // MTASK:STATE-LS!
5789 // ( value idx stid -- )
5790 UFWORD(MT_LSTACK_STORE) {
5791   UfoState *st = ufoFindState(ufoPop());
5792   if (st == NULL) ufoFatal("unknown state");
5793   uint32_t idx = ufoPop();
5794   uint32_t value = ufoPop();
5795   if (idx >= st->LP) ufoFatal("invalid stack index %u (%u)", idx, st->LP);
5796   st->dStack[st->LP - idx - 1u] = value;
5797 }
5798
5799
5800 #include "urforth_tty.c"
5801
5802
5803 // ////////////////////////////////////////////////////////////////////////// //
5804 // initial dictionary definitions
5805 //
5806
5807 #undef UFWORD
5808
5809 #define UFWORD(name_)  do { \
5810   const uint32_t xcfa_ = ufoCFAsUsed; \
5811   ufo_assert(xcfa_ < UFO_MAX_NATIVE_CFAS); \
5812   ufoForthCFAs[xcfa_] = &ufoWord_##name_; \
5813   ufoCFAsUsed += 1; \
5814   ufoDefineNative(""#name_, xcfa_, 0); \
5815 } while (0)
5816
5817 #define UFWORDX(strname_,name_)  do { \
5818   const uint32_t xcfa_ = ufoCFAsUsed; \
5819   ufo_assert(xcfa_ < UFO_MAX_NATIVE_CFAS); \
5820   ufoForthCFAs[xcfa_] = &ufoWord_##name_; \
5821   ufoCFAsUsed += 1; \
5822   ufoDefineNative(strname_, xcfa_, 0); \
5823 } while (0)
5824
5825 #define UFWORD_IMM(name_)  do { \
5826   const uint32_t xcfa_ = ufoCFAsUsed; \
5827   ufo_assert(xcfa_ < UFO_MAX_NATIVE_CFAS); \
5828   ufoForthCFAs[xcfa_] = &ufoWord_##name_; \
5829   ufoCFAsUsed += 1; \
5830   ufoDefineNative(""#name_, xcfa_, 1); \
5831 } while (0)
5832
5833 #define UFWORDX_IMM(strname_,name_)  do { \
5834   const uint32_t xcfa_ = ufoCFAsUsed; \
5835   ufo_assert(xcfa_ < UFO_MAX_NATIVE_CFAS); \
5836   ufoForthCFAs[xcfa_] = &ufoWord_##name_; \
5837   ufoCFAsUsed += 1; \
5838   ufoDefineNative(strname_, xcfa_, 1); \
5839 } while (0)
5840
5841 #define UFC(name_)  ufoImgEmitU32_NoInline(ufoFindWordChecked(name_))
5842
5843
5844 //==========================================================================
5845 //
5846 //  ufoFindWordChecked
5847 //
5848 //==========================================================================
5849 UFO_DISABLE_INLINE uint32_t ufoFindWordChecked (const char *wname) {
5850   const uint32_t cfa = ufoFindWord(wname);
5851   if (cfa == 0) ufoFatal("word '%s' not found", wname);
5852   return cfa;
5853 }
5854
5855
5856 //==========================================================================
5857 //
5858 //  ufoGetForthVocId
5859 //
5860 //  get "FORTH" vocid
5861 //
5862 //==========================================================================
5863 uint32_t ufoGetForthVocId (void) {
5864   return ufoForthVocId;
5865 }
5866
5867
5868 //==========================================================================
5869 //
5870 //  ufoVocSetOnlyDefs
5871 //
5872 //==========================================================================
5873 void ufoVocSetOnlyDefs (uint32_t vocid) {
5874   ufoImgPutU32(ufoAddrCurrent, vocid);
5875   ufoImgPutU32(ufoAddrContext, vocid);
5876 }
5877
5878
5879 //==========================================================================
5880 //
5881 //  ufoCreateVoc
5882 //
5883 //  return voc PFA (vocid)
5884 //
5885 //==========================================================================
5886 uint32_t ufoCreateVoc (const char *wname, uint32_t parentvocid, uint32_t flags) {
5887   // create wordlist struct
5888   // typeid, used by Forth code (structs and such)
5889   ufoImgEmitU32(0); // typeid
5890   // vocid points here, to "LATEST-LFA"
5891   const uint32_t vocid = UFO_GET_DP();
5892   //fprintf(stderr, "NEW VOCID (%s): 0x%08x\n", wname, vocid);
5893   ufoImgEmitU32(0); // latest
5894   const uint32_t vlink = UFO_GET_DP();
5895   if ((vocid & UFO_ADDR_TEMP_BIT) == 0) {
5896     ufoImgEmitU32(ufoImgGetU32(ufoAddrVocLink)); // voclink
5897     ufoImgPutU32(ufoAddrVocLink, vlink); // update voclink
5898   } else {
5899     abort();
5900     ufoImgEmitU32(0);
5901   }
5902   ufoImgEmitU32(parentvocid); // parent
5903   const uint32_t hdraddr = UFO_GET_DP();
5904   ufoImgEmitU32(0); // word header
5905   // create empty hash table
5906   for (int f = 0; f < UFO_HASHTABLE_SIZE; f += 1) ufoImgEmitU32(0);
5907   // update CONTEXT and CURRENT if this is the first wordlist ever
5908   if (ufoImgGetU32(ufoAddrContext) == 0) {
5909     ufoImgPutU32(ufoAddrContext, vocid);
5910   }
5911   if (ufoImgGetU32(ufoAddrCurrent) == 0) {
5912     ufoImgPutU32(ufoAddrCurrent, vocid);
5913   }
5914   // create word header
5915   if (wname != NULL && wname[0] != 0) {
5916     /*
5917     uint32_t flags = ufoImgGetU32(ufoAddrNewWordFlags);
5918     flags &=
5919       //UFW_FLAG_IMMEDIATE|
5920       //UFW_FLAG_SMUDGE|
5921       //UFW_FLAG_NORETURN|
5922       UFW_FLAG_HIDDEN|
5923       //UFW_FLAG_CBLOCK|
5924       //UFW_FLAG_VOCAB|
5925       //UFW_FLAG_SCOLON|
5926       UFW_FLAG_PROTECTED;
5927     flags |= UFW_FLAG_VOCAB;
5928     */
5929     flags &= 0xffffff00u;
5930     flags |= UFW_FLAG_VOCAB;
5931     ufoCreateWordHeader(wname, flags);
5932     const uint32_t cfa = UFO_GET_DP();
5933     ufoImgEmitU32(ufoDoVocCFA); // cfa
5934     ufoImgEmitU32(vocid); // pfa
5935     // update vocab header pointer
5936     const uint32_t lfa = UFO_CFA_TO_LFA(cfa);
5937     ufoImgPutU32(hdraddr, UFO_LFA_TO_NFA(lfa));
5938     #ifdef UFO_DEBUG_DUMP_NEW_HEADERS
5939     ufoDumpWordHeader(lfa);
5940     #endif
5941   }
5942   return vocid;
5943 }
5944
5945
5946 //==========================================================================
5947 //
5948 //  ufoSetLatestArgs
5949 //
5950 //==========================================================================
5951 static void ufoSetLatestArgs (uint32_t warg) {
5952   const uint32_t curr = ufoImgGetU32(ufoAddrCurrent);
5953   const uint32_t lfa = ufoImgGetU32(curr);
5954   const uint32_t nfa = UFO_LFA_TO_NFA(lfa);
5955   uint32_t flags = ufoImgGetU32(nfa);
5956   //fprintf(stderr, "OLD FLAGS: 0x%08x\n", flags);
5957   flags &= ~UFW_WARG_MASK;
5958   flags |= warg & UFW_WARG_MASK;
5959   //fprintf(stderr, "NEW FLAGS: 0x%08x\n", flags);
5960   ufoImgPutU32(nfa, flags);
5961   #ifdef UFO_DEBUG_DUMP_NEW_HEADERS
5962   ufoDumpWordHeader(lfa);
5963   #endif
5964 }
5965
5966
5967 //==========================================================================
5968 //
5969 //  ufoDefine
5970 //
5971 //==========================================================================
5972 static void ufoDefineNative (const char *wname, uint32_t cfaidx, int immed) {
5973   cfaidx |= UFO_ADDR_CFA_BIT;
5974   uint32_t flags = ufoImgGetU32(ufoAddrNewWordFlags);
5975   flags &=
5976       //UFW_FLAG_IMMEDIATE|
5977       //UFW_FLAG_SMUDGE|
5978       //UFW_FLAG_NORETURN|
5979       UFW_FLAG_HIDDEN|
5980       //UFW_FLAG_CBLOCK|
5981       //UFW_FLAG_VOCAB|
5982       //UFW_FLAG_SCOLON|
5983       UFW_FLAG_PROTECTED;
5984   if (immed) flags |= UFW_FLAG_IMMEDIATE;
5985   ufoCreateWordHeader(wname, flags);
5986   ufoImgEmitU32(cfaidx);
5987 }
5988
5989
5990 //==========================================================================
5991 //
5992 //  ufoDefineConstant
5993 //
5994 //==========================================================================
5995 static void ufoDefineConstant (const char *name, uint32_t value) {
5996   ufoDefineNative(name, ufoDoConstCFA, 0);
5997   ufoImgEmitU32(value);
5998 }
5999
6000
6001 //==========================================================================
6002 //
6003 //  ufoDefineUserVar
6004 //
6005 //==========================================================================
6006 static void ufoDefineUserVar (const char *name, uint32_t addr) {
6007   ufoDefineNative(name, ufoDoUserVariableCFA, 0);
6008   ufoImgEmitU32(addr);
6009 }
6010
6011
6012 //==========================================================================
6013 //
6014 //  ufoDefineVar
6015 //
6016 //==========================================================================
6017 /*
6018 static void ufoDefineVar (const char *name, uint32_t value) {
6019   ufoDefineNative(name, ufoDoVarCFA, 0);
6020   ufoImgEmitU32(value);
6021 }
6022 */
6023
6024
6025 //==========================================================================
6026 //
6027 //  ufoDefineDefer
6028 //
6029 //==========================================================================
6030 static void ufoDefineDefer (const char *name, uint32_t value) {
6031   ufoDefineNative(name, ufoDoDeferCFA, 0);
6032   ufoImgEmitU32(value);
6033 }
6034
6035
6036 //==========================================================================
6037 //
6038 //  ufoHiddenWords
6039 //
6040 //==========================================================================
6041 static void ufoHiddenWords (void) {
6042   const uint32_t flags = ufoImgGetU32(ufoAddrNewWordFlags);
6043   ufoImgPutU32(ufoAddrNewWordFlags, flags | UFW_FLAG_HIDDEN);
6044 }
6045
6046
6047 //==========================================================================
6048 //
6049 //  ufoPublicWords
6050 //
6051 //==========================================================================
6052 static void ufoPublicWords (void) {
6053   const uint32_t flags = ufoImgGetU32(ufoAddrNewWordFlags);
6054   ufoImgPutU32(ufoAddrNewWordFlags, flags & ~UFW_FLAG_HIDDEN);
6055 }
6056
6057
6058 //==========================================================================
6059 //
6060 //  ufoDefineForth
6061 //
6062 //==========================================================================
6063 static void ufoDefineForth (const char *name) {
6064   ufoDefineNative(name, ufoDoForthCFA, 0);
6065 }
6066
6067
6068 //==========================================================================
6069 //
6070 //  ufoDefineForthImm
6071 //
6072 //==========================================================================
6073 static void ufoDefineForthImm (const char *name) {
6074   ufoDefineNative(name, ufoDoForthCFA, 1);
6075 }
6076
6077
6078 //==========================================================================
6079 //
6080 //  ufoDefineForthHidden
6081 //
6082 //==========================================================================
6083 static void ufoDefineForthHidden (const char *name) {
6084   const uint32_t flags = ufoImgGetU32(ufoAddrNewWordFlags);
6085   ufoImgPutU32(ufoAddrNewWordFlags, flags | UFW_FLAG_HIDDEN);
6086   ufoDefineNative(name, ufoDoForthCFA, 0);
6087   ufoImgPutU32(ufoAddrNewWordFlags, flags);
6088 }
6089
6090
6091 //==========================================================================
6092 //
6093 //  ufoDefineSColonForth
6094 //
6095 //  create word suitable for scattered colon extension
6096 //
6097 //==========================================================================
6098 static void ufoDefineSColonForth (const char *name) {
6099   ufoDefineNative(name, ufoDoForthCFA, 0);
6100   // placeholder for scattered colon
6101   // it will compile two branches:
6102   // the first branch will jump to the first "..:" word (or over the two branches)
6103   // the second branch is never taken, and works as a pointer to the latest branch addr in the list
6104   // this way, each extension word will simply fix the last branch address, and update list tail
6105   // at the creation time, second branch points to the first branch
6106   UFC("FORTH:(BRANCH)");
6107   const uint32_t xjmp = UFO_GET_DP();
6108   ufoImgEmitU32(0);
6109   UFC("FORTH:(BRANCH)"); ufoImgEmitU32(xjmp);
6110   ufoImgPutU32(xjmp, UFO_GET_DP());
6111 }
6112
6113
6114 //==========================================================================
6115 //
6116 //  ufoDoneForth
6117 //
6118 //==========================================================================
6119 UFO_FORCE_INLINE void ufoDoneForth (void) {
6120 }
6121
6122
6123 //==========================================================================
6124 //
6125 //  ufoNewState
6126 //
6127 //  create a new state, its execution will start from the given CFA.
6128 //  state is not automatically activated.
6129 //
6130 //==========================================================================
6131 static UfoState *ufoNewState (uint32_t cfa) {
6132   // find free state id
6133   uint32_t fidx = 0;
6134   uint32_t bmp = ufoStateUsedBitmap[0];
6135   while (fidx != (uint32_t)(UFO_MAX_STATES/32) && bmp == ~(uint32_t)0) {
6136     fidx += 1u;
6137     bmp = ufoStateUsedBitmap[fidx];
6138   }
6139   if (fidx == (uint32_t)(UFO_MAX_STATES/32)) ufoFatal("too many execution states");
6140   //fprintf(stderr, "NST:000: fidx=%u; bmp=0x%08x\n", fidx, bmp);
6141   fidx *= 32u;
6142   while ((bmp & 0x01) != 0) { fidx += 1u; bmp >>= 1; }
6143   ufo_assert(fidx < UFO_MAX_STATES);
6144   ufo_assert((ufoStateUsedBitmap[fidx / 32u] & ((uint32_t)1 << (fidx & 0x1f))) == 0);
6145   ufo_assert(ufoStateMap[fidx] == NULL);
6146   UfoState *st = calloc(1, sizeof(UfoState));
6147   if (st == NULL) ufoFatal("out of memory for states");
6148   st->id = fidx + 1u;
6149   st->vmRPopCFA = 1;
6150   st->rStack[0] = 0xdeadf00d; // dummy value
6151   st->rStack[1] = cfa;
6152   st->RP = 2;
6153   ufoStateMap[fidx] = st;
6154   ufoStateUsedBitmap[fidx / 32u] |= ((uint32_t)1 << (fidx & 0x1f));
6155   //fprintf(stderr, "NST: fidx=%u; 0x%08x\n", fidx, ufoStateUsedBitmap[fidx / 32u]);
6156   return st;
6157 }
6158
6159
6160 //==========================================================================
6161 //
6162 //  ufoFreeState
6163 //
6164 //  free all memory used for the state, remove it from state list.
6165 //  WARNING! never free current state!
6166 //
6167 //==========================================================================
6168 static void ufoFreeState (UfoState *st) {
6169   if (st != NULL) {
6170     if (st == ufoCurrState) ufoFatal("cannot free active state");
6171     if (ufoYieldedState == st) ufoYieldedState = NULL;
6172     if (ufoDebuggerState == st) ufoDebuggerState = NULL;
6173     const uint32_t fidx = st->id - 1u;
6174     //fprintf(stderr, "FST: fidx=%u; 0x%08x\n", fidx, ufoStateUsedBitmap[fidx / 32u]);
6175     ufo_assert(fidx < UFO_MAX_STATES);
6176     ufo_assert((ufoStateUsedBitmap[fidx / 32u] & (1u << (fidx & 0x1f))) != 0);
6177     ufo_assert(ufoStateMap[fidx] == st);
6178     // free default TIB handle
6179     UfoState *oldst = ufoCurrState;
6180     ufoCurrState = st;
6181     const uint32_t tib = ufoImgGetU32(ufoAddrDefTIB);
6182     if ((tib & UFO_ADDR_TEMP_BIT) != 0) {
6183       UfoHandle *tibh = ufoGetHandle(tib);
6184       if (tibh != NULL) ufoFreeHandle(tibh);
6185     }
6186     ufoCurrState = oldst;
6187     // free temp buffer
6188     if (st->imageTemp != NULL) free(st->imageTemp);
6189     free(st);
6190     ufoStateMap[fidx] = NULL;
6191     ufoStateUsedBitmap[fidx / 32u] &= ~((uint32_t)1 << (fidx & 0x1f));
6192   }
6193 }
6194
6195
6196 //==========================================================================
6197 //
6198 //  ufoFindState
6199 //
6200 //==========================================================================
6201 static UfoState *ufoFindState (uint32_t stid) {
6202   UfoState *res = NULL;
6203   if (stid != 0 && stid <= UFO_MAX_STATES) {
6204     stid -= 1u;
6205     res = ufoStateMap[stid];
6206     if (res != NULL) {
6207       ufo_assert((ufoStateUsedBitmap[stid / 32u] & (1u << (stid & 0x1f))) != 0);
6208       ufo_assert(res->id == stid + 1u);
6209     } else {
6210       ufo_assert((ufoStateUsedBitmap[stid / 32u] & (1u << (stid & 0x1f))) == 0);
6211     }
6212   }
6213   return res;
6214 }
6215
6216
6217 //==========================================================================
6218 //
6219 //  ufoSwitchToState
6220 //
6221 //==========================================================================
6222 static void ufoSwitchToState (UfoState *newst) {
6223   ufo_assert(newst != NULL);
6224   if (newst != ufoCurrState) {
6225     ufoCurrState = newst;
6226   }
6227 }
6228
6229
6230
6231 //==========================================================================
6232 //
6233 //  ufoReset
6234 //
6235 //==========================================================================
6236 UFO_DISABLE_INLINE void ufoReset (void) {
6237   if (ufoCurrState == NULL) ufoFatal("no active execution state");
6238
6239   ufoSP = 0; ufoRP = 0;
6240   ufoLP = 0; ufoLBP = 0;
6241
6242   ufoInRunWord = 0;
6243   ufoVMStop = 0; ufoVMAbort = 0;
6244
6245   ufoInBacktrace = 0;
6246
6247   ufoInitStateUserVars(ufoCurrState, 0);
6248   ufoImgPutU32(ufoAddrSTATE, 0);
6249   ufoImgPutU32(ufoAddrRedefineWarning, UFO_REDEF_WARN_NORMAL);
6250   ufoResetTib();
6251
6252   ufoImgPutU32(ufoAddrDPTemp, 0);
6253
6254   ufoImgPutU32(ufoAddrNewWordFlags, 0);
6255   ufoVocSetOnlyDefs(ufoForthVocId);
6256 }
6257
6258
6259 //==========================================================================
6260 //
6261 //  ufoCompileStrLit
6262 //
6263 //  compile string literal, the same as QUOTE_IMM
6264 //
6265 //==========================================================================
6266 static void ufoCompileStrLit (const char *str) {
6267   if (str == NULL) str = "";
6268   const size_t slen = strlen(str);
6269   if (slen > 255) ufoFatal("string literal too long");
6270   UFC("FORTH:(STRLIT8)");
6271   ufoImgEmitU8((uint8_t)slen);
6272   for (size_t f = 0; f < slen; f += 1) {
6273     ufoImgEmitU8(((const unsigned char *)str)[f]);
6274   }
6275   ufoImgEmitU8(0);
6276   ufoImgEmitAlign();
6277 }
6278
6279
6280 //==========================================================================
6281 //
6282 //  ufoCompileLit
6283 //
6284 //==========================================================================
6285 static __attribute__((unused)) void ufoCompileLit (uint32_t value) {
6286   UFC("FORTH:(LIT)");
6287   ufoImgEmitU32(value);
6288 }
6289
6290
6291 //==========================================================================
6292 //
6293 //  ufoMarkFwd
6294 //
6295 //==========================================================================
6296 UFO_FORCE_INLINE uint32_t ufoMarkFwd (void) {
6297   const uint32_t res = UFO_GET_DP();
6298   ufoImgEmitU32(0);
6299   return res;
6300 }
6301
6302
6303 //==========================================================================
6304 //
6305 //  ufoResolveFwd
6306 //
6307 //==========================================================================
6308 UFO_FORCE_INLINE void ufoResolveFwd (uint32_t jaddr) {
6309   ufoImgPutU32(jaddr, UFO_GET_DP());
6310 }
6311
6312
6313 //==========================================================================
6314 //
6315 //  ufoMarkBwd
6316 //
6317 //==========================================================================
6318 UFO_FORCE_INLINE uint32_t ufoMarkBwd (void) {
6319   return UFO_GET_DP();
6320 }
6321
6322
6323 //==========================================================================
6324 //
6325 //  ufoResolveBwd
6326 //
6327 //==========================================================================
6328 UFO_FORCE_INLINE void ufoResolveBwd (uint32_t jaddr) {
6329   ufoImgEmitU32(jaddr);
6330 }
6331
6332
6333 //==========================================================================
6334 //
6335 //  ufoDefineInterpret
6336 //
6337 //  define "INTERPRET" in Forth
6338 //
6339 //==========================================================================
6340 UFO_DISABLE_INLINE void ufoDefineInterpret (void) {
6341   // skip comments, parse name, refilling lines if necessary
6342   ufoDefineForthHidden("(INTERPRET-PARSE-NAME)");
6343     const uint32_t label_ipn_again = ufoMarkBwd();
6344     UFC("TRUE"); UFC("(PARSE-SKIP-COMMENTS)");
6345     UFC("PARSE-NAME");
6346     UFC("DUP");
6347     UFC("FORTH:(TBRANCH)"); const uint32_t label_ipn_exit_fwd = ufoMarkFwd();
6348     UFC("2DROP");
6349     UFC("REFILL");
6350     UFC("FORTH:(TBRANCH)"); ufoResolveBwd(label_ipn_again);
6351     // refill failed
6352     UFC("FORTH:STATE"); UFC("@");
6353     ufoCompileStrLit("unexpected end of file"); UFC("?ERROR");
6354     UFC("FORTH:(UFO-INTERPRET-FINISHED)");
6355     // patch the jump above
6356     ufoResolveFwd(label_ipn_exit_fwd);
6357     UFC("FORTH:(EXIT)");
6358   ufoDoneForth();
6359   //ufoDecompileWord(ufoFindWordChecked("(INTERPRET-PARSE-NAME)"));
6360
6361   ufoDefineForth("INTERPRET");
6362     const uint32_t label_it_again = ufoMarkBwd();
6363     UFC("FORTH:(INTERPRET-PARSE-NAME)");
6364     // try defered checker
6365     // ( addr count FALSE -- addr count FALSE / TRUE )
6366     UFC("FALSE"); UFC("(INTERPRET-CHECK-WORD)");
6367     UFC("FORTH:(TBRANCH)"); ufoResolveBwd(label_it_again);
6368     UFC("2DUP"); UFC("FIND-WORD");  // ( addr count cfa TRUE / addr count FALSE )
6369     UFC("FORTH:(0BRANCH)"); const uint32_t label_it_try_num = ufoMarkFwd();
6370       UFC("NROT"); UFC("2DROP"); // drop word string
6371       UFC("STATE"); UFC("@");
6372       UFC("FORTH:(0BRANCH)"); const uint32_t label_it_exec_fwd = ufoMarkFwd();
6373         // compiling; check immediate bit
6374         UFC("DUP"); UFC("CFA->NFA"); UFC("@");
6375         UFC("COMPILER:(WFLAG-IMMEDIATE)"); UFC("AND");
6376         UFC("FORTH:(TBRANCH)"); const uint32_t label_it_exec_imm = ufoMarkFwd();
6377           // compile it
6378           UFC("FORTH:COMPILE,");
6379           UFC("FORTH:(BRANCH)"); ufoResolveBwd(label_it_again);
6380         // execute it
6381         ufoResolveFwd(label_it_exec_imm);
6382         ufoResolveFwd(label_it_exec_fwd);
6383           UFC("EXECUTE");
6384           UFC("FORTH:(BRANCH)"); ufoResolveBwd(label_it_again);
6385     // not a word, try a number
6386     ufoResolveFwd(label_it_try_num);
6387     UFC("2DUP"); UFC("TRUE"); UFC("BASE"); UFC("@"); UFC("(BASED-NUMBER)");
6388     // (BASED-NUMBER) ( addr count allowsign? base -- num TRUE / FALSE )
6389     UFC("FORTH:(0BRANCH)"); const uint32_t label_it_num_error = ufoMarkFwd();
6390       // number
6391       UFC("NROT"); UFC("2DROP"); // drop word string
6392       // do we need to compile it?
6393       UFC("STATE"); UFC("@");
6394       UFC("FORTH:(0BRANCH)"); ufoResolveBwd(label_it_again);
6395       // compile "(LITERAL)" (do it properly, with "LITCFA")
6396       UFC("FORTH:(LITCFA)"); UFC("FORTH:(LIT)");
6397       UFC("FORTH:COMPILE,"); // compile "(LIT)" CFA
6398       UFC("FORTH:,"); // compile number
6399       UFC("FORTH:(BRANCH)"); ufoResolveBwd(label_it_again);
6400     // error
6401     ufoResolveFwd(label_it_num_error);
6402       // ( addr count FALSE -- addr count FALSE / TRUE )
6403       UFC("FALSE"); UFC("(INTERPRET-WORD-NOT-FOUND)");
6404       UFC("FORTH:(TBRANCH)"); ufoResolveBwd(label_it_again);
6405       UFC("ENDCR"); UFC("SPACE"); UFC("XTYPE");
6406       ufoCompileStrLit(" -- wut?\n"); UFC("TYPE");
6407       ufoCompileStrLit("unknown word");
6408       UFC("ERROR");
6409   ufoDoneForth();
6410   //ufoDecompileWord(ufoFindWordChecked("INTERPRET"));
6411 }
6412
6413
6414 //==========================================================================
6415 //
6416 //  ufoInitBaseDict
6417 //
6418 //==========================================================================
6419 UFO_DISABLE_INLINE void ufoInitBaseDict (void) {
6420   uint32_t imgAddr = 0;
6421
6422   // reserve 64 bytes for nothing
6423   for (uint32_t f = 0; f < 64; f += 1) {
6424     ufoImgPutU8(imgAddr, 0);
6425     imgAddr += 1;
6426   }
6427   // align
6428   while ((imgAddr & 3) != 0) {
6429     ufoImgPutU8(imgAddr, 0);
6430     imgAddr += 1;
6431   }
6432
6433   // STATE
6434   ufoAddrSTATE = imgAddr;
6435   ufoImgPutU32(imgAddr, 0); imgAddr += 4u;
6436
6437   // DP
6438   ufoAddrDP = imgAddr;
6439   ufoImgPutU32(imgAddr, 0); imgAddr += 4u;
6440
6441   // DP-TEMP
6442   ufoAddrDPTemp = imgAddr;
6443   ufoImgPutU32(imgAddr, 0); imgAddr += 4u;
6444
6445   // CONTEXT
6446   ufoAddrContext = imgAddr;
6447   ufoImgPutU32(imgAddr, 0); imgAddr += 4u;
6448
6449   // CURRENT
6450   ufoAddrCurrent = imgAddr;
6451   ufoImgPutU32(imgAddr, 0); imgAddr += 4u;
6452
6453   // (LATEST-XFA)
6454   ufoAddrLastXFA = imgAddr;
6455   ufoImgPutU32(imgAddr, 0); imgAddr += 4u;
6456
6457   // (VOC-LINK)
6458   ufoAddrVocLink = imgAddr;
6459   ufoImgPutU32(imgAddr, 0); imgAddr += 4u;
6460
6461   // (NEW-WORD-FLAGS)
6462   ufoAddrNewWordFlags = imgAddr;
6463   ufoImgPutU32(imgAddr, UFW_FLAG_PROTECTED); imgAddr += 4u;
6464
6465   // WORD-REDEFINE-WARN-MODE
6466   ufoAddrRedefineWarning = imgAddr;
6467   ufoImgPutU32(imgAddr, UFO_REDEF_WARN_NORMAL); imgAddr += 4u;
6468
6469   ufoImgPutU32(ufoAddrDP, imgAddr);
6470   ufoImgPutU32(ufoAddrDPTemp, 0);
6471
6472   #if 0
6473   fprintf(stderr, "INITIAL HERE: 0x%08x (0x%08x)\n", imgAddr, UFO_GET_DP());
6474   #endif
6475 }
6476
6477
6478 //==========================================================================
6479 //
6480 //  ufoInitStateUserVars
6481 //
6482 //==========================================================================
6483 static void ufoInitStateUserVars (UfoState *st, int initial) {
6484   ufo_assert(st != NULL);
6485   if (st->imageTempSize < 8192u) {
6486     uint32_t *itmp = realloc(st->imageTemp, 8192);
6487     if (itmp == NULL) ufoFatal("out of memory for state user area");
6488     st->imageTemp = itmp;
6489     memset((uint8_t *)st->imageTemp + st->imageTempSize, 0, 8192u - st->imageTempSize);
6490     st->imageTempSize = 8192;
6491   }
6492   st->imageTemp[(ufoAddrBASE & UFO_ADDR_TEMP_MASK) / 4u] = 10;
6493   if (initial) {
6494     st->imageTemp[(ufoAddrUserVarUsed & UFO_ADDR_TEMP_MASK) / 4u] = ufoAddrUserVarUsed;
6495     st->imageTemp[(ufoAddrDefTIB & UFO_ADDR_TEMP_MASK) / 4u] = UFO_DEF_TIB_ADDR;
6496     st->imageTemp[(ufoAddrTIBx & UFO_ADDR_TEMP_MASK) / 4u] = UFO_DEF_TIB_ADDR;
6497   } else {
6498     st->imageTemp[(ufoAddrTIBx & UFO_ADDR_TEMP_MASK) / 4u] =
6499       st->imageTemp[(ufoAddrDefTIB & UFO_ADDR_TEMP_MASK) / 4u];
6500   }
6501   st->imageTemp[(ufoAddrINx & UFO_ADDR_TEMP_MASK) / 4u] = 0;
6502 }
6503
6504
6505 //==========================================================================
6506 //
6507 //  ufoInitBasicWords
6508 //
6509 //==========================================================================
6510 UFO_DISABLE_INLINE void ufoInitBasicWords (void) {
6511   ufoDefineConstant("FALSE", 0);
6512   ufoDefineConstant("TRUE", ufoTrueValue);
6513
6514   ufoDefineConstant("BL", 32);
6515   ufoDefineConstant("NL", 10);
6516
6517   // user variables
6518   ufoDefineUserVar("BASE", ufoAddrBASE);
6519   ufoDefineUserVar("TIB", ufoAddrTIBx);
6520   ufoDefineUserVar(">IN", ufoAddrINx);
6521   ufoDefineUserVar("(STD-TIB-ADDR)", ufoAddrDefTIB);
6522   ufoDefineUserVar("(USER-VAR-USED)", ufoAddrUserVarUsed);
6523   ufoDefineConstant("(USER-VAR-ADDR)", UFO_ADDR_TEMP_BIT);
6524   ufoDefineConstant("(USER-VAR-SIZE)", UFO_USER_AREA_SIZE);
6525   ufoDefineConstant("(USER-TIB)", UFO_DEF_TIB_ADDR);
6526   ufoDefineConstant("(USER-TIB-SIZE)", UFO_ADDR_HANDLE_OFS_MASK);
6527
6528   ufoDefineUserVar("STATE", ufoAddrSTATE);
6529   ufoDefineConstant("CONTEXT", ufoAddrContext);
6530   ufoDefineConstant("CURRENT", ufoAddrCurrent);
6531
6532   ufoHiddenWords();
6533   ufoDefineConstant("(LATEST-XFA)", ufoAddrLastXFA);
6534   ufoDefineConstant("(VOC-LINK)", ufoAddrVocLink);
6535   ufoDefineConstant("(NEW-WORD-FLAGS)", ufoAddrNewWordFlags);
6536   ufoDefineConstant("(ADDR-TEMP-BIT)", UFO_ADDR_TEMP_BIT);
6537   ufoDefineConstant("(ADDR-CFA-BIT)", UFO_ADDR_CFA_BIT);
6538   ufoDefineConstant("(ADDR-HANDLE-BIT)", UFO_ADDR_HANDLE_BIT);
6539   ufoDefineConstant("(MAX-HANDLE-OFS)", UFO_ADDR_HANDLE_OFS_MASK);
6540
6541   ufoDefineConstant("(PAD-ADDR)", UFO_PAD_ADDR);
6542   ufoDefineConstant("(#BUF)", UFO_NBUF_ADDR + 4u); // reserve room for counter
6543   ufoDefineConstant("(#BUF-SIZE)", UFO_NBUF_SIZE - 8u);
6544
6545   ufoDefineConstant("(DP)", ufoAddrDP);
6546   ufoDefineConstant("(DP-TEMP)", ufoAddrDPTemp);
6547   ufoPublicWords();
6548
6549   //UFWORDX("(UFO-BUCKET-STATS)", PAR_UFO_BUCKET_STATS);
6550   UFWORDX("SP0!", SP0_STORE);
6551   UFWORDX("RP0!", RP0_STORE);
6552
6553   UFWORDX("PAD", PAD);
6554
6555   UFWORDX("@", PEEK);
6556   UFWORDX("C@", CPEEK);
6557   UFWORDX("W@", WPEEK);
6558
6559   UFWORDX("!", POKE);
6560   UFWORDX("C!", CPOKE);
6561   UFWORDX("W!", WPOKE);
6562
6563   UFWORDX(",", COMMA);
6564   UFWORDX("C,", CCOMMA);
6565   UFWORDX("W,", WCOMMA);
6566
6567   UFWORDX("A>", REGA_LOAD);
6568   UFWORDX(">A", REGA_STORE);
6569   UFWORDX("A-SWAP", REGA_SWAP);
6570
6571   UFWORDX("@A+", PEEK_REGA_IDX);
6572   UFWORDX("C@A+", CPEEK_REGA_IDX);
6573   UFWORDX("W@A+", WPEEK_REGA_IDX);
6574
6575   UFWORDX("!A+", POKE_REGA_IDX);
6576   UFWORDX("C!A+", CPOKE_REGA_IDX);
6577   UFWORDX("W!A+", WPOKE_REGA_IDX);
6578
6579   ufoHiddenWords();
6580   UFWORDX("(LIT)", PAR_LIT); ufoSetLatestArgs(UFW_WARG_LIT);
6581   UFWORDX("(LITCFA)", PAR_LITCFA); ufoSetLatestArgs(UFW_WARG_CFA);
6582   UFWORDX("(LITVOCID)", PAR_LITVOCID); ufoSetLatestArgs(UFW_WARG_VOCID);
6583   UFWORDX("(STRLIT8)", PAR_STRLIT8); ufoSetLatestArgs(UFW_WARG_C1STRZ);
6584   UFWORDX("(EXIT)", PAR_EXIT);
6585
6586   UFWORDX("(UFO-INTERPRET-FINISHED-ACTION)", UFO_INTERPRET_FINISHED_ACTION);
6587   ufoDefineDefer("(UFO-INTERPRET-FINISHED)", ufoFindWordChecked("FORTH:(UFO-INTERPRET-FINISHED-ACTION)"));
6588
6589   ufoStrLit8CFA = ufoFindWordChecked("FORTH:(STRLIT8)");
6590
6591   UFWORDX("(L-ENTER)", PAR_LENTER); ufoSetLatestArgs(UFW_WARG_LIT);
6592   UFWORDX("(L-LEAVE)", PAR_LLEAVE);
6593   UFWORDX("(LOCAL@)", PAR_LOCAL_LOAD);
6594   UFWORDX("(LOCAL!)", PAR_LOCAL_STORE);
6595
6596   UFWORDX("(BRANCH)", PAR_BRANCH); ufoSetLatestArgs(UFW_WARG_BRANCH);
6597   UFWORDX("(TBRANCH)", PAR_TBRANCH); ufoSetLatestArgs(UFW_WARG_BRANCH);
6598   UFWORDX("(0BRANCH)", PAR_0BRANCH); ufoSetLatestArgs(UFW_WARG_BRANCH);
6599   ufoPublicWords();
6600
6601   UFWORDX("GET-MSECS", GET_MSECS);
6602 }
6603
6604
6605 //==========================================================================
6606 //
6607 //  ufoInitBasicCompilerWords
6608 //
6609 //==========================================================================
6610 UFO_DISABLE_INLINE void ufoInitBasicCompilerWords (void) {
6611   // create "COMPILER" vocabulary
6612   ufoCompilerVocId = ufoCreateVoc("COMPILER", 0, UFW_FLAG_PROTECTED);
6613   ufoVocSetOnlyDefs(ufoCompilerVocId);
6614
6615   ufoDefineConstant("(CFAIDX-DO-FORTH)", ufoDoForthCFA);
6616   ufoDefineConstant("(CFAIDX-DO-VAR)", ufoDoVariableCFA);
6617   ufoDefineConstant("(CFAIDX-DO-VALUE)", ufoDoValueCFA);
6618   ufoDefineConstant("(CFAIDX-DO-CONST)", ufoDoConstCFA);
6619   ufoDefineConstant("(CFAIDX-DO-DEFER)", ufoDoDeferCFA);
6620   ufoDefineConstant("(CFAIDX-DO-VOC)", ufoDoVocCFA);
6621   ufoDefineConstant("(CFAIDX-DO-CREATE)", ufoDoCreateCFA);
6622   ufoDefineConstant("(CFAIDX-DO-USER-VAR)", ufoDoUserVariableCFA);
6623
6624   ufoDefineConstant("(WFLAG-IMMEDIATE)", UFW_FLAG_IMMEDIATE);
6625   ufoDefineConstant("(WFLAG-SMUDGE)", UFW_FLAG_SMUDGE);
6626   ufoDefineConstant("(WFLAG-NORETURN)", UFW_FLAG_NORETURN);
6627   ufoDefineConstant("(WFLAG-HIDDEN)", UFW_FLAG_HIDDEN);
6628   ufoDefineConstant("(WFLAG-CBLOCK)", UFW_FLAG_CBLOCK);
6629   ufoDefineConstant("(WFLAG-VOCAB)", UFW_FLAG_VOCAB);
6630   ufoDefineConstant("(WFLAG-SCOLON)", UFW_FLAG_SCOLON);
6631   ufoDefineConstant("(WFLAG-PROTECTED)", UFW_FLAG_PROTECTED);
6632
6633   ufoDefineConstant("(WARG-MASK)", UFW_WARG_MASK);
6634   ufoDefineConstant("(WARG-NONE)", UFW_WARG_NONE);
6635   ufoDefineConstant("(WARG-BRANCH)", UFW_WARG_BRANCH);
6636   ufoDefineConstant("(WARG-LIT)", UFW_WARG_LIT);
6637   ufoDefineConstant("(WARG-C4STRZ)", UFW_WARG_C4STRZ);
6638   ufoDefineConstant("(WARG-CFA)", UFW_WARG_CFA);
6639   ufoDefineConstant("(WARG-CBLOCK)", UFW_WARG_CBLOCK);
6640   ufoDefineConstant("(WARG-VOCID)", UFW_WARG_VOCID);
6641   ufoDefineConstant("(WARG-C1STRZ)", UFW_WARG_C1STRZ);
6642
6643   ufoDefineConstant("(VOCOFS-LATEST)", UFW_VOCAB_OFS_LATEST);
6644   ufoDefineConstant("(VOCOFS-VOCLINK)", UFW_VOCAB_OFS_VOCLINK);
6645   ufoDefineConstant("(VOCOFS-PARENT)", UFW_VOCAB_OFS_PARENT);
6646   ufoDefineConstant("(VOCOFS-HEADER)", UFW_VOCAB_OFS_HEADER);
6647   ufoDefineConstant("(VOCOFS-HTABLE)", UFW_VOCAB_OFS_HTABLE);
6648   ufoDefineConstant("(VOC-HTABLE-SIZE)", UFO_HASHTABLE_SIZE);
6649   ufoDefineConstant("(VOC-HTABLE-NOFLAG)", UFO_NO_HTABLE_FLAG);
6650
6651   ufoDefineConstant("(REDEFINE-WARN-DON'T-CARE)", UFO_REDEF_WARN_DONT_CARE);
6652   ufoDefineConstant("(REDEFINE-WARN-NONE)", UFO_REDEF_WARN_NONE);
6653   ufoDefineConstant("(REDEFINE-WARN-NORMAL)", UFO_REDEF_WARN_NORMAL);
6654
6655   ufoDefineConstant("WORD-REDEFINE-WARN-MODE", ufoAddrRedefineWarning);
6656
6657   UFWORDX("(UNESCAPE)", PAR_UNESCAPE);
6658
6659   UFWORDX("?EXEC", QEXEC);
6660   UFWORDX("?COMP", QCOMP);
6661
6662   // interpreter
6663   /*
6664   UFWORDX("(INTERPRET-DUMB)", PAR_INTERPRET_DUMB); UFCALL(PAR_HIDDEN);
6665   const uint32_t idumbCFA = UFO_LFA_TO_CFA(ufoImgGetU32(ufoImgGetU32(ufoAddrCurrent)));
6666   ufo_assert(idumbCFA == UFO_PFA_TO_CFA(UFO_GET_DP()));
6667   */
6668
6669   UFWORDX("(CREATE-WORD-HEADER)", PAR_CREATE_WORD_HEADER);
6670   UFWORDX("(CREATE-NAMELESS-WORD-HEADER)", PAR_CREATE_NAMELESS_WORD_HEADER);
6671
6672   ufoVocSetOnlyDefs(ufoForthVocId);
6673 }
6674
6675
6676 //==========================================================================
6677 //
6678 //  ufoInitMoreWords
6679 //
6680 //==========================================================================
6681 UFO_DISABLE_INLINE void ufoInitMoreWords (void) {
6682   UFWORDX("COMPILE,", COMMA); // just an alias, for clarity
6683
6684   UFWORDX("CFA->PFA", CFA2PFA);
6685   UFWORDX("PFA->CFA", PFA2CFA);
6686   UFWORDX("CFA->NFA", CFA2NFA);
6687   UFWORDX("NFA->CFA", NFA2CFA);
6688   UFWORDX("CFA->LFA", CFA2LFA);
6689   UFWORDX("LFA->CFA", LFA2CFA);
6690   UFWORDX("LFA->PFA", LFA2PFA);
6691   UFWORDX("LFA->BFA", LFA2BFA);
6692   UFWORDX("LFA->XFA", LFA2XFA);
6693   UFWORDX("LFA->YFA", LFA2YFA);
6694   UFWORDX("LFA->NFA", LFA2NFA);
6695   UFWORDX("NFA->LFA", NFA2LFA);
6696   UFWORDX("CFA->WEND", CFA2WEND);
6697
6698   UFWORDX("ERROR", ERROR);
6699   UFWORDX("?ERROR", QERROR);
6700
6701   UFWORDX("(BASED-NUMBER)", PAR_BASED_NUMBER);
6702   UFWORDX("FIND-WORD", FIND_WORD);
6703   UFWORDX("FIND-WORD-IN-VOC", FIND_WORD_IN_VOC);
6704   UFWORDX("FIND-WORD-IN-VOC-AND-PARENTS", FIND_WORD_IN_VOC_AND_PARENTS);
6705
6706   UFWORDX_IMM("\"", QUOTE_IMM);
6707
6708   UFWORD(EXECUTE);
6709   UFWORDX("EXECUTE-TAIL", EXECUTE_TAIL);
6710
6711   UFWORD(DUP);
6712   UFWORDX("?DUP", QDUP);
6713   UFWORDX("2DUP", DDUP);
6714   UFWORD(DROP);
6715   UFWORDX("2DROP", DDROP);
6716   UFWORD(SWAP);
6717   UFWORDX("2SWAP", DSWAP);
6718   UFWORD(OVER);
6719   UFWORDX("2OVER", DOVER);
6720   UFWORD(ROT);
6721   UFWORD(NROT);
6722   UFWORDX("PICK", PICK);
6723   UFWORDX("ROLL", ROLL);
6724
6725   UFWORD(RDUP);
6726   UFWORD(RDROP);
6727   UFWORDX(">R", DTOR);
6728   UFWORDX("R>", RTOD);
6729   UFWORDX("R@", RPEEK);
6730   UFWORDX("RPICK", RPICK);
6731   UFWORDX("RROLL", RROLL);
6732   UFWORDX("RSWAP", RSWAP);
6733   UFWORDX("ROVER", ROVER);
6734   UFWORDX("RROT", RROT);
6735   UFWORDX("RNROT", RNROT);
6736
6737   UFWORDX("FLUSH-EMIT", FLUSH_EMIT);
6738   UFWORDX("(EMIT)", PAR_EMIT);
6739   UFWORD(EMIT);
6740   UFWORD(XEMIT);
6741   UFWORD(TYPE);
6742   UFWORD(XTYPE);
6743   UFWORD(SPACE);
6744   UFWORD(SPACES);
6745   UFWORD(CR);
6746   UFWORD(ENDCR);
6747   UFWORDX("LASTCR?", LASTCRQ);
6748   UFWORDX("LASTCR!", LASTCRSET);
6749
6750   // simple math
6751   UFWORDX("+", PLUS);
6752   UFWORDX("-", MINUS);
6753   UFWORDX("*", MUL);
6754   UFWORDX("U*", UMUL);
6755   UFWORDX("/", DIV);
6756   UFWORDX("U/", UDIV);
6757   UFWORDX("MOD", MOD);
6758   UFWORDX("UMOD", UMOD);
6759   UFWORDX("/MOD", DIVMOD);
6760   UFWORDX("U/MOD", UDIVMOD);
6761   UFWORDX("*/", MULDIV);
6762   UFWORDX("U*/", UMULDIV);
6763   UFWORDX("*/MOD", MULDIVMOD);
6764   UFWORDX("U*/MOD", UMULDIVMOD);
6765   UFWORDX("M*", MMUL);
6766   UFWORDX("UM*", UMMUL);
6767   UFWORDX("M/MOD", MDIVMOD);
6768   UFWORDX("UM/MOD", UMDIVMOD);
6769   UFWORDX("UDS*", UDSMUL);
6770
6771   UFWORDX("SM/REM", SMREM);
6772   UFWORDX("FM/MOD", FMMOD);
6773
6774   UFWORDX("D-", DMINUS);
6775   UFWORDX("D+", DPLUS);
6776   UFWORDX("D=", DEQU);
6777   UFWORDX("D<", DLESS);
6778   UFWORDX("D<=", DLESSEQU);
6779   UFWORDX("DU<", DULESS);
6780   UFWORDX("DU<=", DULESSEQU);
6781
6782   UFWORDX("2U*", ONESHL);
6783   UFWORDX("2U/", ONESHR);
6784   UFWORDX("4U*", TWOSHL);
6785   UFWORDX("4U/", TWOSHR);
6786
6787   UFWORD(ASH);
6788   UFWORD(LSH);
6789
6790   // logic
6791   UFWORDX("<", LESS);
6792   UFWORDX(">", GREAT);
6793   UFWORDX("<=", LESSEQU);
6794   UFWORDX(">=", GREATEQU);
6795   UFWORDX("U<", ULESS);
6796   UFWORDX("U>", UGREAT);
6797   UFWORDX("U<=", ULESSEQU);
6798   UFWORDX("U>=", UGREATEQU);
6799   UFWORDX("=", EQU);
6800   UFWORDX("<>", NOTEQU);
6801
6802   UFWORD(NOT);
6803   UFWORD(BITNOT);
6804   UFWORD(AND);
6805   UFWORD(OR);
6806   UFWORD(XOR);
6807   UFWORDX("LOGAND", LOGAND);
6808   UFWORDX("LOGOR", LOGOR);
6809
6810   // TIB and parser
6811   UFWORDX("(TIB-IN)", TIB_IN);
6812   UFWORDX("TIB-PEEKCH", TIB_PEEKCH);
6813   UFWORDX("TIB-PEEKCH-OFS", TIB_PEEKCH_OFS);
6814   UFWORDX("TIB-GETCH", TIB_GETCH);
6815   UFWORDX("TIB-SKIPCH", TIB_SKIPCH);
6816
6817   UFWORDX("REFILL", REFILL);
6818   UFWORDX("REFILL-NOCROSS", REFILL_NOCROSS);
6819
6820   ufoHiddenWords();
6821   UFWORDX("(PARSE)", PAR_PARSE);
6822   UFWORDX("(PARSE-SKIP-COMMENTS)", PAR_PARSE_SKIP_COMMENTS);
6823   ufoPublicWords();
6824   UFWORDX("PARSE-SKIP-BLANKS", PARSE_SKIP_BLANKS);
6825   UFWORDX("PARSE-NAME", PARSE_NAME);
6826   UFWORDX("PARSE-SKIP-LINE", PARSE_SKIP_LINE);
6827   UFWORDX("PARSE", PARSE);
6828
6829   UFWORDX_IMM("[", LBRACKET_IMM);
6830   UFWORDX("]", RBRACKET);
6831
6832   ufoHiddenWords();
6833   UFWORDX("(VSP@)", PAR_GET_VSP);
6834   UFWORDX("(VSP!)", PAR_SET_VSP);
6835   UFWORDX("(VSP-AT@)", PAR_VSP_LOAD);
6836   UFWORDX("(VSP-AT!)", PAR_VSP_STORE);
6837   ufoDefineConstant("(VSP-SIZE)", UFO_VOCSTACK_SIZE);
6838
6839   ufoDefineConstant("(SP-SIZE)", UFO_DSTACK_SIZE);
6840   ufoDefineConstant("(RP-SIZE)", UFO_RSTACK_SIZE);
6841   ufoDefineConstant("(LP-SIZE)", UFO_LSTACK_SIZE);
6842   ufoPublicWords();
6843 }
6844
6845
6846 //==========================================================================
6847 //
6848 //  ufoInitHandleWords
6849 //
6850 //==========================================================================
6851 UFO_DISABLE_INLINE void ufoInitHandleWords (void) {
6852   // create "HANDLE" vocabulary
6853   const uint32_t handleVocId = ufoCreateVoc("HANDLE", 0, UFW_FLAG_PROTECTED);
6854   ufoVocSetOnlyDefs(handleVocId);
6855   UFWORDX("NEW", PAR_NEW_HANDLE);
6856   UFWORDX("FREE", PAR_FREE_HANDLE);
6857   UFWORDX("TYPEID@", PAR_HANDLE_GET_TYPEID);
6858   UFWORDX("TYPEID!", PAR_HANDLE_SET_TYPEID);
6859   UFWORDX("SIZE@", PAR_HANDLE_GET_SIZE);
6860   UFWORDX("SIZE!", PAR_HANDLE_SET_SIZE);
6861   UFWORDX("USED@", PAR_HANDLE_GET_USED);
6862   UFWORDX("USED!", PAR_HANDLE_SET_USED);
6863   UFWORDX("C@", PAR_HANDLE_LOAD_BYTE);
6864   UFWORDX("W@", PAR_HANDLE_LOAD_WORD);
6865   UFWORDX("@", PAR_HANDLE_LOAD_CELL);
6866   UFWORDX("C!", PAR_HANDLE_STORE_BYTE);
6867   UFWORDX("W!", PAR_HANDLE_STORE_WORD);
6868   UFWORDX("!", PAR_HANDLE_STORE_CELL);
6869   UFWORDX("LOAD-FILE", PAR_HANDLE_LOAD_FILE);
6870   ufoVocSetOnlyDefs(ufoForthVocId);
6871 }
6872
6873
6874 //==========================================================================
6875 //
6876 //  ufoInitHigherWords
6877 //
6878 //==========================================================================
6879 UFO_DISABLE_INLINE void ufoInitHigherWords (void) {
6880   UFWORDX("(INCLUDE)", PAR_INCLUDE);
6881
6882   UFWORDX("(INCLUDE-DEPTH)", PAR_INCLUDE_DEPTH);
6883   UFWORDX("(INCLUDE-FILE-ID)", PAR_INCLUDE_FILE_ID);
6884   UFWORDX("(INCLUDE-FILE-LINE)", PAR_INCLUDE_FILE_LINE);
6885   UFWORDX("(INCLUDE-FILE-NAME)", PAR_INCLUDE_FILE_NAME);
6886
6887   UFWORDX("($DEFINED?)", PAR_DLR_DEFINEDQ);
6888   UFWORDX("($DEFINE)", PAR_DLR_DEFINE);
6889   UFWORDX("($UNDEF)", PAR_DLR_UNDEF);
6890
6891   UFWORDX_IMM("$INCLUDE", DLR_INCLUDE_IMM);
6892   UFWORDX_IMM("$INCLUDE-ONCE", DLR_INCLUDE_ONCE_IMM);
6893 }
6894
6895
6896 //==========================================================================
6897 //
6898 //  ufoInitStringWords
6899 //
6900 //==========================================================================
6901 UFO_DISABLE_INLINE void ufoInitStringWords (void) {
6902   // create "STRING" vocabulary
6903   const uint32_t stringVocId = ufoCreateVoc("STRING", 0, UFW_FLAG_PROTECTED);
6904   ufoVocSetOnlyDefs(stringVocId);
6905   UFWORDX("=", STREQU);
6906   UFWORDX("=CI", STREQUCI);
6907   UFWORDX("SEARCH", SEARCH);
6908   UFWORDX("HASH", STRHASH);
6909   UFWORDX("HASH-CI", STRHASHCI);
6910   ufoVocSetOnlyDefs(ufoForthVocId);
6911 }
6912
6913
6914 //==========================================================================
6915 //
6916 //  ufoInitDebugWords
6917 //
6918 //==========================================================================
6919 UFO_DISABLE_INLINE void ufoInitDebugWords (void) {
6920   // create "DEBUG" vocabulary
6921   const uint32_t debugVocId = ufoCreateVoc("DEBUG", 0, UFW_FLAG_PROTECTED);
6922   ufoVocSetOnlyDefs(debugVocId);
6923   UFWORDX("(DECOMPILE-CFA)", DEBUG_DECOMPILE_CFA);
6924   UFWORDX("BACKTRACE", UFO_BACKTRACE);
6925   UFWORDX("DUMP-STACK", DUMP_STACK);
6926   UFWORDX("(BP)", MT_DEBUGGER_BP);
6927   UFWORDX("IP->NFA", IP2NFA);
6928   UFWORDX("IP->FILE/LINE", IP2FILELINE);
6929   ufoVocSetOnlyDefs(ufoForthVocId);
6930 }
6931
6932
6933 //==========================================================================
6934 //
6935 //  ufoInitMTWords
6936 //
6937 //==========================================================================
6938 UFO_DISABLE_INLINE void ufoInitMTWords (void) {
6939   // create "MTASK" vocabulary
6940   const uint32_t mtVocId = ufoCreateVoc("MTASK", 0, UFW_FLAG_PROTECTED);
6941   ufoVocSetOnlyDefs(mtVocId);
6942   UFWORDX("NEW-STATE", MT_NEW_STATE);
6943   UFWORDX("FREE-STATE", MT_FREE_STATE);
6944   UFWORDX("STATE-NAME@", MT_GET_STATE_NAME);
6945   UFWORDX("STATE-NAME!", MT_SET_STATE_NAME);
6946   UFWORDX("STATE-FIRST", MT_STATE_FIRST);
6947   UFWORDX("STATE-NEXT", MT_STATE_NEXT);
6948   UFWORDX("YIELD-TO", MT_YIELD_TO);
6949   UFWORDX("SET-SELF-AS-DEBUGGER", MT_SET_SELF_AS_DEBUGGER);
6950   UFWORDX("DEBUGGER-RESUME", MT_RESUME_DEBUGEE);
6951   UFWORDX("DEBUGGER-SINGLE-STEP", MT_SINGLE_STEP_DEBUGEE);
6952   UFWORDX("ACTIVE-STATE", MT_ACTIVE_STATE);
6953   UFWORDX("STATE-IP@", MT_STATE_IP_GET);
6954   UFWORDX("STATE-IP!", MT_STATE_IP_SET);
6955   UFWORDX("STATE-A>", MT_STATE_REGA_GET);
6956   UFWORDX("STATE->A", MT_STATE_REGA_SET);
6957   UFWORDX("STATE-USER@", MT_STATE_USER_GET);
6958   UFWORDX("STATE-USER!", MT_STATE_USER_SET);
6959   UFWORDX("STATE-RPOPCFA@", MT_STATE_RPOPCFA_GET);
6960   UFWORDX("STATE-RPOPCFA!", MT_STATE_RPOPCFA_SET);
6961   UFWORDX("YIELDED-FROM", MT_YIELDED_FROM);
6962   UFWORDX("STATE-SP@", MT_DSTACK_DEPTH_GET);
6963   UFWORDX("STATE-RP@", MT_RSTACK_DEPTH_GET);
6964   UFWORDX("STATE-LP@", MT_LP_GET);
6965   UFWORDX("STATE-LBP@", MT_LBP_GET);
6966   UFWORDX("STATE-SP!", MT_DSTACK_DEPTH_SET);
6967   UFWORDX("STATE-RP!", MT_RSTACK_DEPTH_SET);
6968   UFWORDX("STATE-LP!", MT_LP_SET);
6969   UFWORDX("STATE-LBP!", MT_LBP_SET);
6970   UFWORDX("STATE-DS@", MT_DSTACK_LOAD);
6971   UFWORDX("STATE-RS@", MT_RSTACK_LOAD);
6972   UFWORDX("STATE-LS@", MT_LSTACK_LOAD);
6973   UFWORDX("STATE-DS!", MT_DSTACK_STORE);
6974   UFWORDX("STATE-RS!", MT_RSTACK_STORE);
6975   UFWORDX("STATE-LS!", MT_LSTACK_STORE);
6976   ufoVocSetOnlyDefs(ufoForthVocId);
6977 }
6978
6979
6980 //==========================================================================
6981 //
6982 //  ufoInitTTYWords
6983 //
6984 //==========================================================================
6985 UFO_DISABLE_INLINE void ufoInitTTYWords (void) {
6986   // create "TTY" vocabulary
6987   const uint32_t ttyVocId = ufoCreateVoc("TTY", 0, UFW_FLAG_PROTECTED);
6988   ufoVocSetOnlyDefs(ttyVocId);
6989   UFWORDX("TTY?", TTY_TTYQ);
6990   UFWORDX("RAW?", TTY_RAWQ);
6991   UFWORDX("SIZE", TTY_SIZE);
6992   UFWORDX("SET-RAW", TTY_SET_RAW);
6993   UFWORDX("SET-COOKED", TTY_SET_COOKED);
6994   UFWORDX("RAW-EMIT", TTY_RAW_EMIT);
6995   UFWORDX("RAW-TYPE", TTY_RAW_TYPE);
6996   UFWORDX("RAW-FLUSH", TTY_RAW_FLUSH);
6997   UFWORDX("RAW-READCH", TTY_RAW_READCH);
6998   UFWORDX("RAW-READY?", TTY_RAW_READYQ);
6999   ufoVocSetOnlyDefs(ufoForthVocId);
7000 }
7001
7002
7003 //==========================================================================
7004 //
7005 //  ufoInitVeryVeryHighWords
7006 //
7007 //==========================================================================
7008 UFO_DISABLE_INLINE void ufoInitVeryVeryHighWords (void) {
7009   // interpret defer
7010   //ufoDefineDefer("INTERPRET", idumbCFA);
7011
7012   // ( addr count FALSE -- addr count FALSE / TRUE )
7013   ufoDefineSColonForth("(INTERPRET-CHECK-WORD)");
7014     UFC("FORTH:(EXIT)");
7015   ufoDoneForth();
7016   // ( addr count FALSE -- addr count FALSE / TRUE )
7017   ufoDefineSColonForth("(INTERPRET-WORD-NOT-FOUND)");
7018     UFC("FORTH:(EXIT)");
7019   ufoDoneForth();
7020   // ( FALSE -- FALSE / TRUE ) -- called in "EXIT", before compiling "FORTH:(EXIT)"
7021   // return TRUE to stop calling other chained words, and omit default exit
7022   ufoDefineSColonForth("(EXIT-EXTENDER)");
7023     UFC("FORTH:(EXIT)");
7024   ufoDoneForth();
7025
7026   // create "FORTH:EXIT"
7027   // : EXIT  ?COMP COMPILE FORTH:(EXIT) ;
7028   ufoDefineForthImm("EXIT");
7029     UFC("COMPILER:?COMP");
7030     UFC("FALSE"); UFC("(EXIT-EXTENDER)");
7031     UFC("FORTH:(TBRANCH)"); const uint32_t exit_branch_end = ufoMarkFwd();
7032     UFC("FORTH:(LITCFA)"); UFC("FORTH:(EXIT)");
7033     UFC("FORTH:COMPILE,");
7034     ufoResolveFwd(exit_branch_end);
7035     UFC("FORTH:(EXIT)");
7036   ufoDoneForth();
7037
7038   ufoDefineInterpret();
7039
7040   //ufoDumpVocab(ufoCompilerVocId);
7041
7042   ufoDefineForth("RUN-INTERPRET-LOOP");
7043     const uint32_t addrAgain = UFO_GET_DP();
7044     UFC("RP0!");
7045     UFC("INTERPRET");
7046     UFC("FORTH:(BRANCH)");
7047     ufoImgEmitU32(addrAgain);
7048   ufoDoneForth();
7049 }
7050
7051 #define UFO_ADD_DO_CFA(cfx_)  do { \
7052   ufoDo##cfx_##CFA = ufoCFAsUsed | UFO_ADDR_CFA_BIT; \
7053   ufoForthCFAs[ufoCFAsUsed] = &ufoDo##cfx_; \
7054   ufoCFAsUsed += 1; \
7055 } while (0)
7056
7057
7058 //==========================================================================
7059 //
7060 //  ufoInitCommon
7061 //
7062 //==========================================================================
7063 UFO_DISABLE_INLINE void ufoInitCommon (void) {
7064   ufoVSP = 0;
7065   ufoForthVocId = 0; ufoCompilerVocId = 0;
7066
7067   ufoForthCFAs = calloc(UFO_MAX_NATIVE_CFAS, sizeof(ufoForthCFAs[0]));
7068
7069   // allocate default TIB handle
7070   //UfoHandle *tibh = ufoAllocHandle(0x69a029a6); // arbitrary number
7071   //ufoDefTIB = tibh->ufoHandle;
7072
7073   ufoForthCFAs[0] = NULL; ufoCFAsUsed = 1u;
7074   UFO_ADD_DO_CFA(Forth);
7075   UFO_ADD_DO_CFA(Variable);
7076   UFO_ADD_DO_CFA(Value);
7077   UFO_ADD_DO_CFA(Const);
7078   UFO_ADD_DO_CFA(Defer);
7079   UFO_ADD_DO_CFA(Voc);
7080   UFO_ADD_DO_CFA(Create);
7081   UFO_ADD_DO_CFA(UserVariable);
7082
7083   //fprintf(stderr, "DO-FORTH-CFA: 0x%08x\n", ufoDoForthCFA);
7084
7085   ufoInitBaseDict();
7086
7087   // create "FORTH" vocabulary
7088   ufoForthVocId = ufoCreateVoc("FORTH", 0, UFW_FLAG_PROTECTED);
7089   ufoVocSetOnlyDefs(ufoForthVocId);
7090
7091   // base low-level interpreter words
7092   ufoInitBasicWords();
7093
7094   // some COMPILER words
7095   ufoInitBasicCompilerWords();
7096
7097   // STRING vocabulary
7098   ufoInitStringWords();
7099
7100   // DEBUG vocabulary
7101   ufoInitDebugWords();
7102
7103   // MTASK vocabulary
7104   ufoInitMTWords();
7105
7106   // HANDLE vocabulary
7107   ufoInitHandleWords();
7108
7109   // TTY vocabulary
7110   ufoInitTTYWords();
7111
7112   // more FORTH words
7113   ufoInitMoreWords();
7114
7115   // some higher-level FORTH words (includes, etc.)
7116   ufoInitHigherWords();
7117
7118   // very-very high-level FORTH words
7119   ufoInitVeryVeryHighWords();
7120
7121   #if 0
7122   ufoDecompileWord(ufoFindWordChecked("RUN-INTERPRET-LOOP"));
7123   #endif
7124
7125   ufoReset();
7126 }
7127
7128 #undef UFC
7129
7130
7131 // ////////////////////////////////////////////////////////////////////////// //
7132 // virtual machine executor
7133 //
7134
7135
7136 //==========================================================================
7137 //
7138 //  ufoRunVM
7139 //
7140 //  address interpreter
7141 //
7142 //==========================================================================
7143 static void ufoRunVMCFA (uint32_t cfa) {
7144   const uint32_t oldRPTop = ufoRPTop;
7145   ufoRPTop = ufoRP;
7146   #ifdef UFO_TRACE_VM_RUN
7147   fprintf(stderr, "**VM-INITIAL**: cfa=%u\n", cfa);
7148   UFCALL(DUMP_STACK);
7149   #endif
7150   ufoRPush(cfa);
7151   ufoVMRPopCFA = 1;
7152   ufoVMStop = 0;
7153   // VM execution loop
7154   do {
7155     if (ufoVMAbort) ufoFatal("user abort");
7156     if (ufoVMStop) { ufoRP = oldRPTop; break; }
7157     if (ufoCurrState == NULL) ufoFatal("execution state is lost");
7158     if (ufoVMRPopCFA == 0) {
7159       // check IP
7160       if (ufoIP == 0) ufoFatal("IP is NULL");
7161       if (ufoIP & UFO_ADDR_HANDLE_BIT) ufoFatal("IP is a handle");
7162       cfa = ufoImgGetU32(ufoIP); ufoIP += 4u;
7163     } else {
7164       cfa = ufoRPop(); ufoVMRPopCFA = 0;
7165     }
7166     // check CFA sanity
7167     if (cfa == 0) ufoFatal("EXECUTE: NULL CFA");
7168     if (cfa & UFO_ADDR_HANDLE_BIT) ufoFatal("cannot execute handle");
7169     // get next word CFAIDX, and check it
7170     uint32_t cfaidx = ufoImgGetU32(cfa);
7171     if (cfaidx & UFO_ADDR_HANDLE_BIT) ufoFatal("cannot execute CFAIDX-handle");
7172     #ifdef UFO_TRACE_VM_RUN
7173     fprintf(stderr, "**VM**: IP=%u; cfa=%u; cfaidx=0x%08x\n", ufoIP - 4u, cfa, cfaidx);
7174     UFCALL(DUMP_STACK);
7175     ufoDumpWordHeader(UFO_CFA_TO_LFA(cfa));
7176     fprintf(stderr, "######################################\n");
7177     #endif
7178     if (cfaidx & UFO_ADDR_CFA_BIT) {
7179       cfaidx &= UFO_ADDR_CFA_MASK;
7180       if (cfaidx >= ufoCFAsUsed || ufoForthCFAs[cfaidx] == NULL) {
7181         ufoFatal("tried to execute an unknown word: %u (max is %u); IP=%u",
7182                  cfaidx, ufoCFAsUsed, ufoIP - 4u);
7183       }
7184       #ifdef UFO_TRACE_VM_RUN
7185       fprintf(stderr, "**VM-NATIVE**: cfaidx=%u (doForth=%u)\n", cfaidx,
7186               (ufoDoForthCFA & UFO_ADDR_CFA_MASK));
7187       #endif
7188       ufoForthCFAs[cfaidx](UFO_CFA_TO_PFA(cfa));
7189     } else {
7190       // if CFA points somewhere inside a dict, this is "DOES>" word
7191       // IP points to PFA we need to push
7192       // CFA points to Forth word we need to jump to
7193       #ifdef UFO_TRACE_VM_DOER
7194       fprintf(stderr, "*** DOER! IP=%u; cfa=%u; cfaidx=%u ***\n", ufoIP, cfa, cfaidx);
7195       UFCALL(UFO_BACKTRACE);
7196       #endif
7197       ufoPush(UFO_CFA_TO_PFA(cfa)); // push PFA
7198       ufoRPush(ufoIP); // push IP
7199       ufoIP = cfaidx; // fix IP
7200     }
7201     // that's all we need to activate the debugger
7202     if (ufoSingleStep) {
7203       ufoSingleStep -= 1;
7204       if (ufoSingleStep == 0 && ufoDebuggerState != NULL) {
7205         if (ufoCurrState == ufoDebuggerState) ufoFatal("debugger cannot debug itself");
7206         UfoState *ost = ufoCurrState;
7207         ufoSwitchToState(ufoDebuggerState); // always use API call for this!
7208         ufoPush(-2);
7209         ufoPush(ost->id);
7210       }
7211     }
7212   } while (ufoRP != oldRPTop);
7213   //ufoVMStop = 0;
7214 }
7215
7216
7217 // ////////////////////////////////////////////////////////////////////////// //
7218 // high-level API
7219 //
7220
7221 //==========================================================================
7222 //
7223 //  ufoRegisterWord
7224 //
7225 //  register new word
7226 //
7227 //==========================================================================
7228 uint32_t ufoRegisterWord (const char *wname, ufoNativeCFA cfa, uint32_t flags) {
7229   ufo_assert(cfa != NULL);
7230   ufo_assert(wname != NULL && wname[0] != 0);
7231   uint32_t cfaidx = ufoCFAsUsed;
7232   if (cfaidx >= UFO_MAX_NATIVE_CFAS) ufoFatal("too many native words");
7233   ufoForthCFAs[cfaidx] = cfa;
7234   ufoCFAsUsed += 1;
7235   //ufoDefineNative(wname, xcfa, 0);
7236   cfaidx |= UFO_ADDR_CFA_BIT;
7237   flags &= 0xffffff00u;
7238   ufoCreateWordHeader(wname, flags);
7239   const uint32_t res = UFO_GET_DP();
7240   ufoImgEmitU32(cfaidx);
7241   return res;
7242 }
7243
7244
7245 //==========================================================================
7246 //
7247 //  ufoRegisterDataWord
7248 //
7249 //==========================================================================
7250 static uint32_t ufoRegisterDataWord (const char *wname, uint32_t cfaidx, uint32_t value,
7251                                      uint32_t flags)
7252 {
7253   ufo_assert(wname != NULL && wname[0] != 0);
7254   flags &= 0xffffff00u;
7255   ufoCreateWordHeader(wname, flags);
7256   ufoImgEmitU32(cfaidx);
7257   const uint32_t res = UFO_GET_DP();
7258   ufoImgEmitU32(value);
7259   return res;
7260 }
7261
7262
7263 //==========================================================================
7264 //
7265 //  ufoRegisterConstant
7266 //
7267 //==========================================================================
7268 void ufoRegisterConstant (const char *wname, uint32_t value, uint32_t flags) {
7269   (void)ufoRegisterDataWord(wname, ufoDoConstCFA, value, flags);
7270 }
7271
7272
7273 //==========================================================================
7274 //
7275 //  ufoRegisterVariable
7276 //
7277 //==========================================================================
7278 uint32_t ufoRegisterVariable (const char *wname, uint32_t value, uint32_t flags) {
7279   return ufoRegisterDataWord(wname, ufoDoVariableCFA, value, flags);
7280 }
7281
7282
7283 //==========================================================================
7284 //
7285 //  ufoRegisterValue
7286 //
7287 //==========================================================================
7288 uint32_t ufoRegisterValue (const char *wname, uint32_t value, uint32_t flags) {
7289   return ufoRegisterDataWord(wname, ufoDoValueCFA, value, flags);
7290 }
7291
7292
7293 //==========================================================================
7294 //
7295 //  ufoRegisterDefer
7296 //
7297 //==========================================================================
7298 uint32_t ufoRegisterDefer (const char *wname, uint32_t value, uint32_t flags) {
7299   return ufoRegisterDataWord(wname, ufoDoDeferCFA, value, flags);
7300 }
7301
7302
7303 //==========================================================================
7304 //
7305 //  ufoFindWordInVocabulary
7306 //
7307 //  check if we have the corresponding word.
7308 //  return CFA suitable for executing, or 0.
7309 //
7310 //==========================================================================
7311 uint32_t ufoFindWordInVocabulary (const char *wname, uint32_t vocid) {
7312   if (wname == NULL || wname[0] == 0) return 0;
7313   size_t wlen = strlen(wname);
7314   if (wlen >= UFO_MAX_WORD_LENGTH) return 0;
7315   return ufoFindWordInVocAndParents(wname, (uint32_t)wlen, 0, vocid, 0);
7316 }
7317
7318
7319 //==========================================================================
7320 //
7321 //  ufoGetIP
7322 //
7323 //==========================================================================
7324 uint32_t ufoGetIP (void) {
7325   return ufoIP;
7326 }
7327
7328
7329 //==========================================================================
7330 //
7331 //  ufoSetIP
7332 //
7333 //==========================================================================
7334 void ufoSetIP (uint32_t newip) {
7335   ufoIP = newip;
7336 }
7337
7338
7339 //==========================================================================
7340 //
7341 //  ufoIsExecuting
7342 //
7343 //==========================================================================
7344 int ufoIsExecuting (void) {
7345   return (ufoImgGetU32(ufoAddrSTATE) == 0);
7346 }
7347
7348
7349 //==========================================================================
7350 //
7351 //  ufoIsCompiling
7352 //
7353 //==========================================================================
7354 int ufoIsCompiling (void) {
7355   return (ufoImgGetU32(ufoAddrSTATE) != 0);
7356 }
7357
7358
7359 //==========================================================================
7360 //
7361 //  ufoSetExecuting
7362 //
7363 //==========================================================================
7364 void ufoSetExecuting (void) {
7365   ufoImgPutU32(ufoAddrSTATE, 0);
7366 }
7367
7368
7369 //==========================================================================
7370 //
7371 //  ufoSetCompiling
7372 //
7373 //==========================================================================
7374 void ufoSetCompiling (void) {
7375   ufoImgPutU32(ufoAddrSTATE, 1);
7376 }
7377
7378
7379 //==========================================================================
7380 //
7381 //  ufoGetHere
7382 //
7383 //==========================================================================
7384 uint32_t ufoGetHere () {
7385   return UFO_GET_DP();
7386 }
7387
7388
7389 //==========================================================================
7390 //
7391 //  ufoGetPad
7392 //
7393 //==========================================================================
7394 uint32_t ufoGetPad () {
7395   UFCALL(PAD);
7396   return ufoPop();
7397 }
7398
7399
7400 //==========================================================================
7401 //
7402 //  ufoTIBPeekCh
7403 //
7404 //==========================================================================
7405 uint8_t ufoTIBPeekCh (uint32_t ofs) {
7406   return ufoTibPeekChOfs(ofs);
7407 }
7408
7409
7410 //==========================================================================
7411 //
7412 //  ufoTIBGetCh
7413 //
7414 //==========================================================================
7415 uint8_t ufoTIBGetCh (void) {
7416   return ufoTibGetCh();
7417 }
7418
7419
7420 //==========================================================================
7421 //
7422 //  ufoTIBSkipCh
7423 //
7424 //==========================================================================
7425 void ufoTIBSkipCh (void) {
7426   ufoTibSkipCh();
7427 }
7428
7429
7430 //==========================================================================
7431 //
7432 //  ufoTIBSRefill
7433 //
7434 //  returns 0 on EOF
7435 //
7436 //==========================================================================
7437 int ufoTIBSRefill (int allowCrossIncludes) {
7438   return ufoLoadNextLine(allowCrossIncludes);
7439 }
7440
7441
7442 //==========================================================================
7443 //
7444 //  ufoPeekData
7445 //
7446 //==========================================================================
7447 uint32_t ufoPeekData (void) {
7448   return ufoPeek();
7449 }
7450
7451
7452 //==========================================================================
7453 //
7454 //  ufoPopData
7455 //
7456 //==========================================================================
7457 uint32_t ufoPopData (void) {
7458   return ufoPop();
7459 }
7460
7461
7462 //==========================================================================
7463 //
7464 //  ufoPushData
7465 //
7466 //==========================================================================
7467 void ufoPushData (uint32_t value) {
7468   return ufoPush(value);
7469 }
7470
7471
7472 //==========================================================================
7473 //
7474 //  ufoPushBoolData
7475 //
7476 //==========================================================================
7477 void ufoPushBoolData (int val) {
7478   ufoPushBool(val);
7479 }
7480
7481
7482 //==========================================================================
7483 //
7484 //  ufoPeekRet
7485 //
7486 //==========================================================================
7487 uint32_t ufoPeekRet (void) {
7488   return ufoRPeek();
7489 }
7490
7491
7492 //==========================================================================
7493 //
7494 //  ufoPopRet
7495 //
7496 //==========================================================================
7497 uint32_t ufoPopRet (void) {
7498   return ufoRPop();
7499 }
7500
7501
7502 //==========================================================================
7503 //
7504 //  ufoPushRet
7505 //
7506 //==========================================================================
7507 void ufoPushRet (uint32_t value) {
7508   return ufoRPush(value);
7509 }
7510
7511
7512 //==========================================================================
7513 //
7514 //  ufoPushBoolRet
7515 //
7516 //==========================================================================
7517 void ufoPushBoolRet (int val) {
7518   ufoRPush(val ? ufoTrueValue : 0);
7519 }
7520
7521
7522 //==========================================================================
7523 //
7524 //  ufoPeekByte
7525 //
7526 //==========================================================================
7527 uint8_t ufoPeekByte (uint32_t addr) {
7528   return ufoImgGetU8Ext(addr);
7529 }
7530
7531
7532 //==========================================================================
7533 //
7534 //  ufoPeekWord
7535 //
7536 //==========================================================================
7537 uint16_t ufoPeekWord (uint32_t addr) {
7538   ufoPush(addr);
7539   UFCALL(WPEEK);
7540   return ufoPop();
7541 }
7542
7543
7544 //==========================================================================
7545 //
7546 //  ufoPeekCell
7547 //
7548 //==========================================================================
7549 uint32_t ufoPeekCell (uint32_t addr) {
7550   ufoPush(addr);
7551   UFCALL(PEEK);
7552   return ufoPop();
7553 }
7554
7555
7556 //==========================================================================
7557 //
7558 //  ufoPokeByte
7559 //
7560 //==========================================================================
7561 void ufoPokeByte (uint32_t addr, uint32_t value) {
7562   ufoImgPutU8(addr, value);
7563 }
7564
7565
7566 //==========================================================================
7567 //
7568 //  ufoPokeWord
7569 //
7570 //==========================================================================
7571 void ufoPokeWord (uint32_t addr, uint32_t value) {
7572   ufoPush(value);
7573   ufoPush(addr);
7574   UFCALL(WPOKE);
7575 }
7576
7577
7578 //==========================================================================
7579 //
7580 //  ufoPokeCell
7581 //
7582 //==========================================================================
7583 void ufoPokeCell (uint32_t addr, uint32_t value) {
7584   ufoPush(value);
7585   ufoPush(addr);
7586   UFCALL(POKE);
7587 }
7588
7589
7590 //==========================================================================
7591 //
7592 //  ufoEmitByte
7593 //
7594 //==========================================================================
7595 void ufoEmitByte (uint32_t value) {
7596   ufoImgEmitU8(value);
7597 }
7598
7599
7600 //==========================================================================
7601 //
7602 //  ufoEmitWord
7603 //
7604 //==========================================================================
7605 void ufoEmitWord (uint32_t value) {
7606   ufoImgEmitU8(value & 0xff);
7607   ufoImgEmitU8((value >> 8) & 0xff);
7608 }
7609
7610
7611 //==========================================================================
7612 //
7613 //  ufoEmitCell
7614 //
7615 //==========================================================================
7616 void ufoEmitCell (uint32_t value) {
7617   ufoImgEmitU32(value);
7618 }
7619
7620
7621 //==========================================================================
7622 //
7623 //  ufoIsInited
7624 //
7625 //==========================================================================
7626 int ufoIsInited (void) {
7627   return (ufoMode != UFO_MODE_NONE);
7628 }
7629
7630
7631 static void (*ufoUserPostInitCB) (void);
7632
7633
7634 //==========================================================================
7635 //
7636 //  ufoSetUserPostInit
7637 //
7638 //  called after main initialisation
7639 //
7640 //==========================================================================
7641 void ufoSetUserPostInit (void (*cb) (void)) {
7642   ufoUserPostInitCB = cb;
7643 }
7644
7645
7646 //==========================================================================
7647 //
7648 //  ufoInit
7649 //
7650 //==========================================================================
7651 void ufoInit (void) {
7652   if (ufoMode != UFO_MODE_NONE) return;
7653   ufoMode = UFO_MODE_NATIVE;
7654
7655   ufoInFileLine = 0;
7656   ufoInFileName = NULL;
7657   ufoInFile = NULL;
7658   ufoLastIncPath = NULL; ufoLastSysIncPath = NULL;
7659
7660   for (uint32_t f = 0; f < UFO_MAX_STATES; f += 1u) ufoStateMap[f] = NULL;
7661   memset(ufoStateUsedBitmap, 0, sizeof(ufoStateUsedBitmap));
7662
7663   ufoCurrState = ufoNewState(0); // CFA doesn't matter here
7664   strcpy(ufoCurrState->name, "MAIN");
7665   ufoInitStateUserVars(ufoCurrState, 1);
7666   ufoImgPutU32(ufoAddrDefTIB, 0); // create TIB handle
7667   ufoImgPutU32(ufoAddrTIBx, 0); // create TIB handle
7668
7669   ufoYieldedState = NULL;
7670   ufoDebuggerState = NULL;
7671   ufoSingleStep = 0;
7672
7673   #ifdef UFO_DEBUG_STARTUP_TIMES
7674   uint32_t stt = ufo_get_msecs();
7675   ufoCondDefine("UFO-DEBUG-STARTUP-TIMES");
7676   #endif
7677   ufoInitCommon();
7678   #ifdef UFO_DEBUG_STARTUP_TIMES
7679   uint32_t ett = ufo_get_msecs();
7680   fprintf(stderr, "UrForth init time: %u msecs\n", (unsigned)(ett - stt));
7681   #endif
7682
7683   ufoReset();
7684
7685   if (ufoUserPostInitCB) {
7686     ufoUserPostInitCB();
7687     ufoReset();
7688   }
7689
7690   // load ufo modules
7691   char *ufmname = ufoCreateIncludeName("init", 1, NULL);
7692   #ifdef WIN32
7693   FILE *ufl = fopen(ufmname, "rb");
7694   #else
7695   FILE *ufl = fopen(ufmname, "r");
7696   #endif
7697   if (ufl) {
7698     ufoPushInFile();
7699     ufoInFileName = ufmname;
7700     ufoInFile = ufl;
7701     ufoFileId = ufoLastUsedFileId;
7702     setLastIncPath(ufoInFileName, 1);
7703   } else {
7704     free(ufmname);
7705     ufoFatal("cannot load init code");
7706   }
7707
7708   if (ufoInFile != NULL) {
7709     ufoRunInterpretLoop();
7710   }
7711 }
7712
7713
7714 //==========================================================================
7715 //
7716 //  ufoFinishVM
7717 //
7718 //==========================================================================
7719 void ufoFinishVM (void) {
7720   ufoVMStop = 1;
7721 }
7722
7723
7724 //==========================================================================
7725 //
7726 //  ufoWasVMFinished
7727 //
7728 //  check if VM was exited due to `ufoFinishVM()`
7729 //
7730 //==========================================================================
7731 int ufoWasVMFinished (void) {
7732   return (ufoVMStop != 0);
7733 }
7734
7735
7736 //==========================================================================
7737 //
7738 //  ufoCallParseIntr
7739 //
7740 //  ( -- addr count TRUE / FALSE )
7741 //  does base TIB parsing; never copies anything.
7742 //  as our reader is line-based, returns FALSE on EOL.
7743 //  EOL is detected after skipping leading delimiters.
7744 //  passing -1 as delimiter skips the whole line, and always returns FALSE.
7745 //  trailing delimiter is always skipped.
7746 //  result is on the data stack.
7747 //
7748 //==========================================================================
7749 void ufoCallParseIntr (uint32_t delim, int skipLeading) {
7750   ufoPush(delim); ufoPushBool(skipLeading);
7751   UFCALL(PAR_PARSE);
7752 }
7753
7754 //==========================================================================
7755 //
7756 //  ufoCallParseName
7757 //
7758 //  ( -- addr count )
7759 //  parse with leading blanks skipping. doesn't copy anything.
7760 //  return empty string on EOL.
7761 //
7762 //==========================================================================
7763 void ufoCallParseName (void) {
7764   UFCALL(PARSE_NAME);
7765 }
7766
7767
7768 //==========================================================================
7769 //
7770 //  ufoCallParse
7771 //
7772 //  ( -- addr count TRUE / FALSE )
7773 //  parse without skipping delimiters; never copies anything.
7774 //  as our reader is line-based, returns FALSE on EOL.
7775 //  passing 0 as delimiter skips the whole line, and always returns FALSE.
7776 //  trailing delimiter is always skipped.
7777 //
7778 //==========================================================================
7779 void ufoCallParse (uint32_t delim) {
7780   ufoPush(delim);
7781   UFCALL(PARSE);
7782 }
7783
7784
7785 //==========================================================================
7786 //
7787 //  ufoCallParseSkipBlanks
7788 //
7789 //==========================================================================
7790 void ufoCallParseSkipBlanks (void) {
7791   UFCALL(PARSE_SKIP_BLANKS);
7792 }
7793
7794
7795 //==========================================================================
7796 //
7797 //  ufoCallParseSkipComments
7798 //
7799 //==========================================================================
7800 void ufoCallParseSkipComments (void) {
7801   ufoPushBool(1); UFCALL(PAR_PARSE_SKIP_COMMENTS);
7802 }
7803
7804
7805 //==========================================================================
7806 //
7807 //  ufoCallParseSkipLineComments
7808 //
7809 //==========================================================================
7810 void ufoCallParseSkipLineComments (void) {
7811   ufoPushBool(0); UFCALL(PAR_PARSE_SKIP_COMMENTS);
7812 }
7813
7814
7815 //==========================================================================
7816 //
7817 //  ufoCallParseSkipLine
7818 //
7819 //  to the end of line; doesn't refill
7820 //
7821 //==========================================================================
7822 void ufoCallParseSkipLine (void) {
7823   UFCALL(PARSE_SKIP_LINE);
7824 }
7825
7826
7827 //==========================================================================
7828 //
7829 //  ufoCallBasedNumber
7830 //
7831 //  convert number from addrl+1
7832 //  returns address of the first inconvertible char
7833 //  (BASED-NUMBER) ( addr count allowsign? base -- num TRUE / FALSE )
7834 //
7835 //==========================================================================
7836 void ufoCallBasedNumber (uint32_t addr, uint32_t count, int allowSign, int base) {
7837   ufoPush(addr); ufoPush(count); ufoPushBool(allowSign);
7838   if (base < 0) ufoPush(0); else ufoPush((uint32_t)base);
7839   UFCALL(PAR_BASED_NUMBER);
7840 }
7841
7842
7843 //==========================================================================
7844 //
7845 //  ufoRunWord
7846 //
7847 //==========================================================================
7848 void ufoRunWord (uint32_t cfa) {
7849   if (cfa != 0) {
7850     if (ufoMode == UFO_MODE_NONE) ufoFatal("UrForth is not properly inited");
7851     if (ufoInRunWord) ufoFatal("`ufoRunWord` cannot be called recursively");
7852     ufoMode = UFO_MODE_NATIVE;
7853     ufoInRunWord = 1;
7854     ufoRunVMCFA(cfa);
7855     ufoInRunWord = 0;
7856   }
7857 }
7858
7859
7860 //==========================================================================
7861 //
7862 //  ufoRunMacroWord
7863 //
7864 //==========================================================================
7865 void ufoRunMacroWord (uint32_t cfa) {
7866   if (cfa != 0) {
7867     if (ufoMode == UFO_MODE_NONE) ufoFatal("UrForth is not properly inited");
7868     if (ufoInRunWord) ufoFatal("`ufoRunWord` cannot be called recursively");
7869     ufoMode = UFO_MODE_MACRO;
7870     const uint32_t oisp = ufoFileStackPos;
7871     ufoPushInFile();
7872     ufoFileId = 0;
7873     (void)ufoLoadNextUserLine();
7874     ufoInRunWord = 1;
7875     ufoRunVMCFA(cfa);
7876     ufoInRunWord = 0;
7877     ufoPopInFile();
7878     ufo_assert(ufoFileStackPos == oisp); // sanity check
7879   }
7880 }
7881
7882
7883 //==========================================================================
7884 //
7885 //  ufoIsInMacroMode
7886 //
7887 //  check if we are currently in "MACRO" mode.
7888 //  should be called from registered words.
7889 //
7890 //==========================================================================
7891 int ufoIsInMacroMode (void) {
7892   return (ufoMode == UFO_MODE_MACRO);
7893 }
7894
7895
7896 //==========================================================================
7897 //
7898 //  ufoRunInterpretLoop
7899 //
7900 //  run default interpret loop.
7901 //
7902 //==========================================================================
7903 void ufoRunInterpretLoop (void) {
7904   if (ufoMode == UFO_MODE_NONE) {
7905     ufoInit();
7906   }
7907   const uint32_t cfa = ufoFindWord("RUN-INTERPRET-LOOP");
7908   if (cfa == 0) ufoFatal("'RUN-INTERPRET-LOOP' word not found");
7909   ufoReset();
7910   ufoMode = UFO_MODE_NATIVE;
7911   ufoInRunWord = 1;
7912   ufoRunVMCFA(cfa);
7913   ufoInRunWord = 0;
7914   while (ufoFileStackPos != 0) ufoPopInFile();
7915 }
7916
7917
7918 //==========================================================================
7919 //
7920 //  ufoRunFile
7921 //
7922 //==========================================================================
7923 void ufoRunFile (const char *fname) {
7924   if (ufoMode == UFO_MODE_NONE) {
7925     ufoInit();
7926   }
7927   if (ufoInRunWord) ufoFatal("`ufoRunFile` cannot be called recursively");
7928   ufoMode = UFO_MODE_NATIVE;
7929
7930   ufoReset();
7931   char *ufmname = ufoCreateIncludeName(fname, 0, ".");
7932   #ifdef WIN32
7933   FILE *ufl = fopen(ufmname, "rb");
7934   #else
7935   FILE *ufl = fopen(ufmname, "r");
7936   #endif
7937   if (ufl) {
7938     ufoPushInFile();
7939     ufoInFileName = ufmname;
7940     ufoInFile = ufl;
7941     ufoFileId = ufoLastUsedFileId;
7942     setLastIncPath(ufoInFileName, 0);
7943   } else {
7944     free(ufmname);
7945     ufoFatal("cannot load source file '%s'", fname);
7946   }
7947   ufoRunInterpretLoop();
7948 }