src/urforth.c

   1 // and now for something completely different...
   2 // UrAsm built-in Forth Engine!
   3 // GPLv3 ONLY
   4 #include <stdarg.h>
   5 #include <setjmp.h>
   6 #include <stdio.h>
   7 #include <stdlib.h>
   8 #include <string.h>
   9 #include <unistd.h>
  10
  11 #include <sys/stat.h>
  12 #include <sys/types.h>
  13
  14 #include "urforth.h"
  15
  16 //#define UFO_UPPERCASE_DICT_WORDS
  17
  18
  19 //#define UFO_DEBUG_FATAL_ABORT
  20 //#define UFO_DEBUG_PARSE
  21 //#define UFO_DEBUG_INLCUDE
  22
  23
  24 #define UFO_FORCE_INLINE static inline __attribute__((always_inline))
  25 #define UFO_INLINE static inline
  26
  27
  28 #define UFO_QPAIRS_BEGIN  (1)
  29 #define UFO_QPAIRS_IF     (2)
  30 #define UFO_QPAIRS_DO     (3)
  31 #define UFO_QPAIRS_CASE   (4)
  32 #define UFO_QPAIRS_OF     (5)
  33 #define UFO_QPAIRS_OTHER  (6)
  34 #define UFO_QPAIRS_WHILE  (7)
  35 #define UFO_QPAIRS_CBLOCK (666)
  36
  37 // should not be bigger than this!
  38 #define UFO_MAX_WORD_LENGTH  (127)
  39
  40
  41 static const char *ufo_assert_failure (const char *cond, const char *fname, int fline,
  42                                        const char *func)
  43 {
  44   for (const char *t = fname; *t; ++t) {
  45     #ifdef WIN32
  46     if (*t == '/' || *t == '\\') fname = t+1;
  47     #else
  48     if (*t == '/') fname = t+1;
  49     #endif
  50   }
  51   fflush(stdout);
  52   fprintf(stderr, "\n%s:%d: Assertion in `%s` failed: %s\n", fname, fline, func, cond);
  53   fflush(stderr);
  54   abort();
  55 }
  56
  57 #define ufo_assert(cond_)  do { if (__builtin_expect((!(cond_)), 0)) { ufo_assert_failure(#cond_, __FILE__, __LINE__, __PRETTY_FUNCTION__); } } while (0)
  58
  59
  60 //==========================================================================
  61 //
  62 //  joaatHashBufCI
  63 //
  64 //==========================================================================
  65 UFO_FORCE_INLINE uint32_t joaatHashBufCI (const void *buf, size_t len) {
  66   uint32_t hash = 0x29a;
  67   const uint8_t *s = (const uint8_t *)buf;
  68   while (len--) {
  69     //hash += (uint8_t)locase1251(*s++);
  70     hash += (*s++)|0x20; // this converts ASCII capitals to locase (and destroys other, but who cares)
  71     hash += hash<<10;
  72     hash ^= hash>>6;
  73   }
  74   // finalize
  75   hash += hash<<3;
  76   hash ^= hash>>11;
  77   hash += hash<<15;
  78   return hash;
  79 }
  80
  81
  82 //==========================================================================
  83 //
  84 //  strEquCI
  85 //
  86 //==========================================================================
  87 static int strEquCI (const char *s0, const char *s1) {
  88   int res = 1;
  89   while (res && *s0 && *s1) {
  90     char c0 = *s0++; if (c0 >= 'A' && c0 <= 'Z') c0 = c0 - 'A' + 'a';
  91     char c1 = *s1++; if (c1 >= 'A' && c1 <= 'Z') c1 = c1 - 'A' + 'a';
  92     res = (c0 == c1);
  93   }
  94   return (res && s0[0] == 0 && s1[0] == 0);
  95 }
  96
  97
  98 //==========================================================================
  99 //
 100 //  toUpper
 101 //
 102 //==========================================================================
 103 UFO_FORCE_INLINE char toUpper (char ch) {
 104   return (ch >= 'a' && ch <= 'z' ? ch-'a'+'A' : ch);
 105 }
 106
 107
 108 //==========================================================================
 109 //
 110 //  digitInBase
 111 //
 112 //==========================================================================
 113 static int digitInBase (char ch, int base) {
 114   if (ch < '0') return -1;
 115   if (base <= 10) {
 116     if (ch >= '0'+base) return -1;
 117     return ch-'0';
 118   }
 119   ch = toUpper(ch);
 120   if (ch <= '9') return ch-'0';
 121   if (ch < 'A' || ch > 'A'+base-10) return -1;
 122   ch -= 'A'-10;
 123   return (ch < base ? ch : -1);
 124 }
 125
 126
 127 // ////////////////////////////////////////////////////////////////////////// //
 128 #define UFW_FLAG_IMMEDIATE  (1u<<0)
 129 #define UFW_FLAG_PROTECTED  (1u<<1)
 130 #define UFW_FLAG_HIDDEN     (1u<<2)
 131 #define UFW_FLAG_VOC_HIDDEN (1u<<3)
 132
 133 #define UFW_IS_IMM(fw_)      (((fw_)->flags&UFW_FLAG_IMMEDIATE) != 0)
 134 #define UFW_IS_PROT(fw_)     (((fw_)->flags&UFW_FLAG_PROTECTED) != 0)
 135 #define UFW_IS_HID(fw_)      (((fw_)->flags&UFW_FLAG_HIDDEN) != 0)
 136 #define UFW_IS_VOC_HID(fw_)  (((fw_)->flags&UFW_FLAG_VOC_HIDDEN) != 0)
 137
 138
 139 typedef struct UForthWord_t UForthWord;
 140 struct UForthWord_t {
 141   char *name;
 142   UForthWord *prevAll; // in global list
 143   UForthWord *prevVoc; // in vocabulary
 144   void (*cfa) (UForthWord *self); // `self` may be NULL if called from the internal code
 145   uint32_t cfaidx; // in `ufoForthCFAs`
 146   uint32_t pfastart; // pointer to image
 147   uint32_t pfaend; // set in `;`
 148   uint32_t pfa; // pointer to image
 149   uint32_t flags; // see `UFW_FLAG_xxx`
 150   // parent vocabulary link (for vocabularies only)
 151   UForthWord *latest;
 152   UForthWord **buckets; // vocabulary hash table
 153   // hash and bucket link
 154   UForthWord *hlink;
 155   uint32_t hash;
 156 };
 157
 158 #define UFO_DICT_HASH_BUCKETS  (1024u)
 159 static UForthWord *ufoForthDict = NULL;
 160 static UForthWord *ufoColonWord = NULL;
 161
 162 static jmp_buf ufoInlineQuitJP;
 163
 164 #define UFO_MAX_WORDS  (65536u)
 165 static UForthWord **ufoForthCFAs = NULL;
 166 static unsigned ufoCFAsUsed = 0;
 167
 168 #define UFO_ZX_ADDR_BIT   (1u<<30)
 169 #define UFO_ZX_ADDR_MASK  (0xffffU)
 170
 171 #define UFO_RS_CFA_BIT   (1u<<31)
 172 #define UFO_RS_CFA_MASK  ((1u<<31)-1u)
 173
 174 #define UFO_ENSURE_NATIVE_ADDR(adr_)  do { \
 175   const uint32_t aa = (uint32_t)(adr_); \
 176   if (aa & UFO_ZX_ADDR_BIT) ufoFatal("unexpected ZX address"); \
 177   if (aa & UFO_RS_CFA_BIT) ufoFatal("unexpected CFA address"); \
 178 } while (0)
 179
 180 #define UFO_ENSURE_NATIVE_CFA(adr_)  ({ \
 181   const uint32_t aa = (uint32_t)(adr_); \
 182   if ((aa & UFO_RS_CFA_BIT) == 0) ufoFatal("expected CFA address"); \
 183   if ((aa&UFO_RS_CFA_MASK) >= ufoCFAsUsed || ufoForthCFAs[(aa&UFO_RS_CFA_MASK)] == NULL) ufoFatal("invalid CFA address"); \
 184   aa; \
 185 })
 186
 187 #define UFO_GET_NATIVE_CFA(adr_)  ({ \
 188   uint32_t aa = (uint32_t)(adr_); \
 189   if ((aa & UFO_RS_CFA_BIT) == 0) ufoFatal("expected CFA address"); \
 190   aa &= UFO_RS_CFA_MASK; \
 191   if (aa >= ufoCFAsUsed || ufoForthCFAs[aa] == NULL) ufoFatal("invalid CFA address"); \
 192   ufoForthCFAs[aa]; \
 193 })
 194
 195 #define FW_GET_CFAIDX(fw_)      ((fw_)->cfaidx & UFO_RS_CFA_MASK)
 196 #define FW_SET_CFAIDX(fw_,ci_)  ((fw_)->cfaidx = (((ci_) & UFO_RS_CFA_MASK) | UFO_RS_CFA_BIT))
 197
 198 static uint32_t *ufoImage = NULL;
 199 static uint32_t ufoImageSize = 0;
 200 static uint32_t ufoImageUsed = 0;
 201
 202 static uint32_t ufoIP = 0; // in image
 203 static uint32_t ufoSP = 0; // points AFTER the last value pushed
 204 static uint32_t ufoRP = 0; // points AFTER the last value pushed
 205 static uint32_t ufoRPTop = 0; // stop when RP is this, and we're doing EXIT
 206
 207 static uint32_t ufoTrueValue = ~0u;
 208
 209 // the compiler works in two modes
 210 // first mode is "native"
 211 //   only forth variables are allowed, and they're leaving ZX addresses
 212 // second mode is "zx"
 213 //   in this mode, various creation words will create things in ZX memory.
 214 //   note that in interpret mode it is still possible to perform various
 215 //   native calculations, and call native words.
 216 //   but calling native word while compiling ZX code is possible only if it
 217 //   is an immediate one.
 218 enum {
 219   UFO_MODE_NONE = -1,
 220   UFO_MODE_NATIVE = 0, // executing forth code
 221   UFO_MODE_MACRO = 1, // executing forth asm macro
 222 };
 223 static uint32_t ufoMode = UFO_MODE_NONE;
 224
 225 // hack for `IMMEDIATE`
 226 // set by `;`
 227 // only one of those can be set! (invariant)
 228 static UForthWord *ufoLastDefinedNativeWord = NULL;
 229
 230 #define UFO_DSTACK_SIZE  (8192)
 231 #define UFO_RSTACK_SIZE  (8192)
 232 static uint32_t *ufoDStack = NULL;
 233 static uint32_t *ufoRStack = NULL;
 234
 235 // locals stack
 236 typedef struct UForthLocRecord_t {
 237   char name[128]; // local name
 238   uint32_t lidx;  // offset from the current local ptr
 239   struct UForthLocRecord_t *next;
 240 } UForthLocRecord;
 241
 242 #define UFO_LSTACK_SIZE  (8192)
 243 static uint32_t *ufoLStack = NULL;
 244 static uint32_t ufoLP, ufoLBP; // bottom, base; nice names, yeah
 245 // used in the compiler
 246 static UForthLocRecord *ufoLocals = NULL;
 247
 248 // dynamically allocated text input buffer
 249 // always ends with zero (this is word name too)
 250 // first 512 cells of image is TIB
 251 static uint32_t ufoTIBAreaSize = 512;
 252
 253 static uint32_t ufoAddrTIB = 0; // TIB; 0 means "in TIB area", otherwise in the dictionary
 254 static uint32_t ufoAddrIN = 0; // >IN
 255
 256 static uint32_t ufoAddrContext = 0; // CONTEXT
 257 static uint32_t ufoAddrCurrent = 0; // CURRENT
 258 static uint32_t ufoDefaultVocFlags = 0;
 259 static uint32_t ufoLastVoc = 0;
 260
 261 static uint32_t ufoBASEaddr; // address of "BASE" variable
 262 static uint32_t ufoSTATEaddr; // address of "STATE" variable
 263 static uint32_t ufoStopVM;
 264 static int ufoInColon; // should be signed
 265
 266 #define UFO_PAD_OFFSET   (2048u)
 267 #define UFO_PAD1_OFFSET  (4096u)
 268
 269 #define UFO_MAX_NESTED_INCLUDES  (32)
 270 typedef struct {
 271   FILE *fl;
 272   char *fname;
 273   char *incpath;
 274   int fline;
 275   uint8_t *savedTIB;
 276   uint32_t savedTIBSize;
 277 } UFOFileStackEntry;
 278
 279 static UFOFileStackEntry ufoFileStack[UFO_MAX_NESTED_INCLUDES];
 280 static uint32_t ufoFileStackPos; // after the last used item
 281
 282 static FILE *ufoInFile = NULL;
 283 static char *ufoInFileName = NULL;
 284 static char *ufoLastIncPath = NULL;
 285 static int ufoInFileLine = 0;
 286 static int ufoCondStLine = -1;
 287
 288 static int ufoLastEmitWasCR = 1;
 289 static uint32_t ufoCSP = 0;
 290 static int ufoInCondIf = 0;
 291
 292 #define UFO_VOCSTACK_SIZE  (16u)
 293 static uint32_t ufoVocStack[UFO_VOCSTACK_SIZE]; // cfas
 294 static uint32_t ufoVSP;
 295 static uint32_t ufoForthVocCFA;
 296 static uint32_t ufoCompSuppVocCFA;
 297 static uint32_t ufoMacroVocCFA;
 298
 299 static char ufoCurrFileLine[520];
 300 // used to extract strings from the image
 301 static char ufoTempCharBuf[1024];
 302
 303
 304 // ////////////////////////////////////////////////////////////////////////// //
 305 #ifndef WIN32
 306 static void ufoDbgDeinit (void);
 307 #endif
 308 static void ufoClearCondDefines (void);
 309 static void ufoRunVM (void);
 310
 311 static int ufoParseConditionExpr (int doskip);
 312
 313
 314 //==========================================================================
 315 //
 316 //  setLastIncPath
 317 //
 318 //==========================================================================
 319 static void setLastIncPath (const char *fname) {
 320   if (fname == NULL || fname[0] == 0) {
 321     if (ufoLastIncPath) free(ufoLastIncPath);
 322     ufoLastIncPath = strdup(".");
 323   } else {
 324     if (ufoLastIncPath) free(ufoLastIncPath);
 325     ufoLastIncPath = strdup(fname);
 326     char *lslash = ufoLastIncPath;
 327     char *cpos = ufoLastIncPath;
 328     while (*cpos) {
 329       #ifdef WIN32
 330       if (*cpos == '/' || *cpos == '\\') lslash = cpos;
 331       #else
 332       if (*cpos == '/') lslash = cpos;
 333       #endif
 334       cpos += 1;
 335     }
 336     *lslash = 0;
 337   }
 338 }
 339
 340
 341 // ////////////////////////////////////////////////////////////////////////// //
 342 UFO_FORCE_INLINE uint32_t ufoPadAddr (void) {
 343   return (ufoImageUsed + UFO_PAD_OFFSET + 1023u) / 1024u * 1024u;
 344 }
 345
 346
 347 static void ufoDoForth (UForthWord *self);
 348 static void ufoDoVariable (UForthWord *self);
 349 static void ufoDoValue (UForthWord *self);
 350 static void ufoDoConst (UForthWord *self);
 351 static void ufoDoDefer (UForthWord *self);
 352 static void ufoDoVoc (UForthWord *self);
 353
 354
 355 //==========================================================================
 356 //
 357 //  ufoErrorWriteFile
 358 //
 359 //==========================================================================
 360 static void ufoErrorWriteFile (FILE *fo) {
 361   if (ufoInFileName) {
 362     fprintf(fo, "UFO ERROR at file %s, line %d: ", ufoInFileName, ufoInFileLine);
 363   } else {
 364     fprintf(fo, "UFO ERROR somewhere in time: ");
 365   }
 366 }
 367
 368
 369 //==========================================================================
 370 //
 371 //  ufoErrorMsgV
 372 //
 373 //==========================================================================
 374 static void ufoErrorMsgV (const char *fmt, va_list ap) {
 375   if (!ufoLastEmitWasCR) { printf("\n"); ufoLastEmitWasCR = 1; }
 376   fflush(stdout);
 377   ufoErrorWriteFile(stderr);
 378   vfprintf(stderr, fmt, ap);
 379   va_end(ap);
 380   fputc('\n', stderr);
 381   fflush(stderr);
 382 }
 383
 384
 385 //==========================================================================
 386 //
 387 //  ufoStackTrace
 388 //
 389 //==========================================================================
 390 static void ufoStackTrace (void) {
 391   // dump data stack (top 16)
 392   fprintf(stderr, "***UFO STACK DEPTH: %u\n", ufoSP);
 393   uint32_t xsp = ufoSP;
 394   if (xsp > 16) xsp = 16;
 395   for (uint32_t sp = 0; sp < xsp; ++sp) {
 396     fprintf(stderr, "  %2u: 0x%08x  %d\n", sp,
 397            ufoDStack[xsp - sp - 1], (int32_t)ufoDStack[xsp - sp - 1]);
 398   }
 399   //if (ufoSP != 0) fputc('\n', stderr);
 400
 401   // dump return stack (top 32)
 402   fprintf(stderr, "***UFO RETURN STACK DEPTH: %u\n", ufoRP);
 403   uint32_t rp = ufoRP;
 404   uint32_t rscount = 0;
 405   if (rp > UFO_RSTACK_SIZE) rp = UFO_RSTACK_SIZE;
 406   while (rscount != 32 && rp != 0) {
 407     rp -= 1;
 408     uint32_t cfa = ufoRStack[rp];
 409     if (cfa & UFO_RS_CFA_BIT) {
 410       cfa &= UFO_RS_CFA_MASK;
 411       if (cfa < ufoCFAsUsed && ufoForthCFAs[cfa] != NULL) {
 412         UForthWord *fw = ufoForthCFAs[cfa];
 413         fprintf(stderr, "  %2u: %s\n", rscount, fw->name);
 414       } else {
 415         fprintf(stderr, "  %2u: wutafuck?\n", rscount);
 416       }
 417       rscount += 1;
 418     }
 419   }
 420
 421   fflush(stderr);
 422 }
 423
 424
 425 //==========================================================================
 426 //
 427 //  ufoFatal
 428 //
 429 //==========================================================================
 430 __attribute__((noreturn)) __attribute__((format(printf, 1, 2)))
 431 void ufoFatal (const char *fmt, ...) {
 432   va_list ap;
 433   va_start(ap, fmt);
 434   ufoErrorMsgV(fmt, ap);
 435   ufoStackTrace();
 436   #ifdef UFO_DEBUG_FATAL_ABORT
 437   abort();
 438   #endif
 439   ufoFatalError();
 440 }
 441
 442
 443 //==========================================================================
 444 //
 445 //  ufoWipeLocRecords
 446 //
 447 //==========================================================================
 448 static void ufoWipeLocRecords (void) {
 449   while (ufoLocals != NULL) {
 450     UForthLocRecord *r = ufoLocals;
 451     ufoLocals = ufoLocals->next;
 452     free(r);
 453   }
 454 }
 455
 456
 457 //==========================================================================
 458 //
 459 //  ufoNewLocal
 460 //
 461 //  return !0 for duplicate
 462 //
 463 //==========================================================================
 464 static void ufoNewLocal (const char *name) {
 465   char buf[128];
 466
 467   if (name == NULL || name[0] == 0) ufoFatal("empty local name");
 468   const size_t nlen = strlen(name);
 469   if (nlen > 127) ufoFatal("local name too long");
 470   for (size_t f = 0; f < nlen; f += 1) {
 471     char ch = name[f];
 472     if (ch >= 'a' && ch <= 'z') ch = ch-'a'+'A';
 473     //if (ch == ':' || ch == '!') ufoFatal("invalid local name '%s'", name);
 474     buf[f] = ch;
 475   }
 476   buf[nlen] = 0;
 477
 478   UForthLocRecord *r = ufoLocals;
 479   while (r != NULL && strcmp(r->name, buf) != 0) r = r->next;
 480
 481   if (r != NULL) ufoFatal("duplocate local '%s'", name);
 482
 483   r = calloc(1, sizeof(*r));
 484   strcpy(r->name, buf);
 485   if (ufoLocals == 0) r->lidx = 1; else r->lidx = ufoLocals->lidx + 1;
 486   r->next = ufoLocals; ufoLocals = r;
 487 }
 488
 489
 490 //==========================================================================
 491 //
 492 //  ufoFindLocal
 493 //
 494 //==========================================================================
 495 static UForthLocRecord *ufoFindLocal (const char *name, int *wantStore) {
 496   char buf[128];
 497
 498   if (wantStore) *wantStore = 0;
 499   if (name == NULL || name[0] != ':' || name[1] == 0) return NULL;
 500   name += 1; // skip colon
 501   size_t nlen = strlen(name);
 502   if (nlen != 0 && name[nlen - 1] == '!') {
 503     if (wantStore) *wantStore = 1;
 504     nlen -= 1;
 505     if (nlen == 0) return NULL;
 506   }
 507   if (nlen > 127) return NULL;
 508   for (size_t f = 0; f < nlen; f += 1) {
 509     char ch = name[f];
 510     if (ch >= 'a' && ch <= 'z') ch = ch-'a'+'A';
 511     buf[f] = ch;
 512   }
 513   buf[nlen] = 0;
 514
 515   UForthLocRecord *r = ufoLocals;
 516   while (r != NULL && strcmp(r->name, buf) != 0) r = r->next;
 517
 518   return r;
 519 }
 520
 521
 522 // ////////////////////////////////////////////////////////////////////////// //
 523 // working with the image
 524
 525 //==========================================================================
 526 //
 527 //  ufoImgEnsureSize
 528 //
 529 //==========================================================================
 530 static void ufoImgEnsureSize (uint32_t addr) {
 531   UFO_ENSURE_NATIVE_ADDR(addr);
 532   if (addr >= ufoImageSize) {
 533     // 256MB should be enough for everyone!
 534     // one cell is 4 bytes, so max address is 64MB
 535     if (addr >= 0x04000000U) {
 536       ufoFatal("UFO image grown too big (addr=0%08XH)", addr);
 537     }
 538     const uint32_t osz = ufoImageSize;
 539     // grow by 4MB steps (16 real MBs)
 540     uint32_t nsz = (addr|0x003fffffU) + 1U;
 541     uint32_t *nimg = realloc(ufoImage, nsz * sizeof(ufoImage[0]));
 542     if (nimg == NULL) {
 543       ufoFatal("out of memory for UFO image (%u -> %u MBs)",
 544                ufoImageSize / 1024u / 1024u,
 545                nsz / 1024u / 1024u);
 546     }
 547     ufoImage = nimg;
 548     ufoImageSize = nsz;
 549     memset(ufoImage + osz, 0, (nsz - osz) * sizeof(ufoImage[0]));
 550   }
 551 }
 552
 553
 554 //==========================================================================
 555 //
 556 //  ufoImgPutU8
 557 //
 558 //==========================================================================
 559 UFO_FORCE_INLINE void ufoImgPutU8 (uint32_t addr, uint32_t value) {
 560   UFO_ENSURE_NATIVE_ADDR(addr);
 561   if (addr >= ufoImageSize) ufoImgEnsureSize(addr);
 562   ufoImage[addr] = value&0xffU;
 563 }
 564
 565
 566 //==========================================================================
 567 //
 568 //  ufoImgPutU32
 569 //
 570 //==========================================================================
 571 UFO_FORCE_INLINE void ufoImgPutU32 (uint32_t addr, uint32_t value) {
 572   UFO_ENSURE_NATIVE_ADDR(addr);
 573   if (addr >= ufoImageSize) ufoImgEnsureSize(addr);
 574   ufoImage[addr] = value;
 575 }
 576
 577
 578 //==========================================================================
 579 //
 580 //  ufoImgEmitU8
 581 //
 582 //==========================================================================
 583 UFO_FORCE_INLINE void ufoImgEmitU8 (uint32_t value) {
 584   ufoImgPutU8(ufoImageUsed, value);
 585   ufoImageUsed += 1;
 586 }
 587
 588
 589 //==========================================================================
 590 //
 591 //  ufoImgEmitU32
 592 //
 593 //==========================================================================
 594 UFO_FORCE_INLINE void ufoImgEmitU32 (uint32_t value) {
 595   ufoImgPutU32(ufoImageUsed, value);
 596   ufoImageUsed += 1;
 597 }
 598
 599
 600 //==========================================================================
 601 //
 602 //  ufoImgGetU8
 603 //
 604 //==========================================================================
 605 UFO_FORCE_INLINE uint32_t ufoImgGetU8 (uint32_t addr) {
 606   UFO_ENSURE_NATIVE_ADDR(addr);
 607   if (addr >= ufoImageSize) ufoFatal("UFO read violation (%u)", addr);
 608   return ufoImage[addr]&0xffU;
 609 }
 610
 611
 612 //==========================================================================
 613 //
 614 //  ufoImgGetU32
 615 //
 616 //==========================================================================
 617 UFO_FORCE_INLINE uint32_t ufoImgGetU32 (uint32_t addr) {
 618   UFO_ENSURE_NATIVE_ADDR(addr);
 619   if (addr >= ufoImageSize) ufoFatal("UFO read violation (%u)", addr);
 620   return ufoImage[addr];
 621 }
 622
 623
 624 //==========================================================================
 625 //
 626 //  ufoImgGetCounter
 627 //
 628 //  32 for native address
 629 //
 630 //==========================================================================
 631 UFO_FORCE_INLINE uint32_t ufoImgGetCounter (uint32_t addr) {
 632   UFO_ENSURE_NATIVE_ADDR(addr);
 633   return ufoImgGetU32(addr);
 634 }
 635
 636
 637 //==========================================================================
 638 //
 639 //  ufoOpenFileOrDir
 640 //
 641 //==========================================================================
 642 static FILE *ufoOpenFileOrDir (char **fnameptr) {
 643   struct stat st;
 644   char *tmp;
 645   char *fname;
 646
 647   if (fnameptr == NULL) return NULL;
 648   fname = *fnameptr;
 649   #if 0
 650   fprintf(stderr, "***:fname=<%s>\n", fname);
 651   #endif
 652
 653   if (fname == NULL || fname[0] == 0 || stat(fname, &st) != 0) return NULL;
 654
 655   if (S_ISDIR(st.st_mode)) {
 656     tmp = calloc(1, strlen(fname) + 128);
 657     ufo_assert(tmp != NULL);
 658     sprintf(tmp, "%s/%s", fname, "zzmain.f");
 659     free(fname); fname = tmp; *fnameptr = tmp;
 660     #if 0
 661     fprintf(stderr, "***:  <%s>\n", fname);
 662     #endif
 663   }
 664
 665   return fopen(fname, "rb");
 666 }
 667
 668
 669 //==========================================================================
 670 //
 671 //  ufoPushInFile
 672 //
 673 //==========================================================================
 674 static void ufoPushInFile (void) {
 675   if (ufoFileStackPos >= UFO_MAX_NESTED_INCLUDES) ufoFatal("too many includes");
 676   UFOFileStackEntry *stk = &ufoFileStack[ufoFileStackPos];
 677   stk->fl = ufoInFile;
 678   stk->fname = ufoInFileName;
 679   stk->fline = ufoInFileLine;
 680   stk->incpath = ufoLastIncPath;
 681   // save TIB (if it is the default)
 682   uint32_t tib = ufoImgGetU32(ufoAddrTIB);
 683   uint32_t in = ufoImgGetU32(ufoAddrIN);
 684   stk->savedTIBSize = 0;
 685   stk->savedTIB = NULL;
 686   if (tib == 0 && in < ufoTIBAreaSize) {
 687     while (ufoImgGetU8(tib + in + stk->savedTIBSize) != 0) stk->savedTIBSize += 1;
 688     if (stk->savedTIBSize != 0) {
 689       stk->savedTIB = malloc(stk->savedTIBSize);
 690       if (stk->savedTIB == NULL) ufoFatal("out of memory for include stack");
 691       for (uint32_t f = 0; f < stk->savedTIBSize; f += 1) {
 692         stk->savedTIB[f] = ufoImgGetU8(tib + in + f);
 693       }
 694     }
 695   }
 696   ufoFileStackPos += 1;
 697   ufoInFile = NULL;
 698   ufoInFileName = NULL;
 699   ufoInFileLine = 0;
 700   ufoLastIncPath = NULL;
 701 }
 702
 703
 704 //==========================================================================
 705 //
 706 //  ufoPopInFile
 707 //
 708 //==========================================================================
 709 static void ufoPopInFile (void) {
 710   if (ufoFileStackPos == 0) ufoFatal("trying to pop include from empty stack");
 711   if (ufoInFileName) free(ufoInFileName);
 712   if (ufoInFile) fclose(ufoInFile);
 713   if (ufoLastIncPath) free(ufoLastIncPath);
 714   ufoFileStackPos -= 1;
 715   UFOFileStackEntry *stk = &ufoFileStack[ufoFileStackPos];
 716   ufoInFile = stk->fl;
 717   ufoInFileName = stk->fname;
 718   ufoInFileLine = stk->fline;
 719   ufoLastIncPath = stk->incpath;
 720   // restore TIB
 721   // also, restore current line, because some code may need it
 722   if (stk->savedTIBSize >= ufoTIBAreaSize) ufoFatal("restored TIB too big");
 723   if (stk->savedTIBSize >= sizeof(ufoCurrFileLine)) {
 724     ufoFatal("post-include restored source line is too long");
 725   }
 726   ufoImgPutU32(ufoAddrTIB, 0);
 727   ufoImgPutU32(ufoAddrIN, 0);
 728   if (stk->savedTIBSize != 0) {
 729     for (uint32_t f = 0; f < stk->savedTIBSize; f += 1) {
 730       ufoImgPutU8(f, stk->savedTIB[f]);
 731       ufoCurrFileLine[f] = (char)(stk->savedTIB[f]&0xff);
 732     }
 733     free(stk->savedTIB);
 734   }
 735   ufoImgPutU8(stk->savedTIBSize, 0);
 736   ufoCurrFileLine[stk->savedTIBSize] = 0;
 737   #ifdef UFO_DEBUG_INLCUDE
 738   fprintf(stderr, "INC-POP: <%s>\n", ufoCurrFileLine);
 739   #endif
 740 }
 741
 742
 743 //==========================================================================
 744 //
 745 //  ufoDeinit
 746 //
 747 //==========================================================================
 748 void ufoDeinit (void) {
 749   ufoWipeLocRecords();
 750
 751   ufoInFile = NULL;
 752   if (ufoInFileName) free(ufoInFileName);
 753   if (ufoLastIncPath) free(ufoLastIncPath);
 754   ufoInFileName = NULL; ufoLastIncPath = NULL;
 755   ufoInFileLine = 0;
 756
 757   while (ufoForthDict != NULL) {
 758     UForthWord *fw = ufoForthDict;
 759     if (fw->buckets != NULL) free(fw->buckets);
 760     ufoForthDict = fw->prevAll;
 761     free(fw->name);
 762     free(fw);
 763   }
 764   ufoColonWord = NULL;
 765
 766   free(ufoForthCFAs);
 767   ufoForthCFAs = NULL;
 768   ufoCFAsUsed = 0;
 769
 770   free(ufoImage);
 771   ufoImage = NULL;
 772   ufoImageSize = 0;
 773   ufoImageUsed = 0;
 774
 775   ufoIP = 0;
 776   ufoSP = 0; ufoRP = 0; ufoRPTop = 0;
 777   ufoLP = 0; ufoLBP = 0;
 778   ufoMode = UFO_MODE_NATIVE;
 779   ufoVSP = 0; ufoForthVocCFA = 0; ufoCompSuppVocCFA = 0; ufoMacroVocCFA = 0;
 780
 781   free(ufoDStack);
 782   ufoDStack = NULL;
 783   free(ufoRStack);
 784   ufoRStack = NULL;
 785   free(ufoLStack);
 786   ufoLStack = NULL;
 787
 788   ufoAddrTIB = 0; ufoAddrIN = 0;
 789
 790   ufoLastDefinedNativeWord = NULL;
 791
 792   ufoLastEmitWasCR = 1;
 793   ufoCSP = 0;
 794   ufoInCondIf = 0;
 795   ufoInColon = 0;
 796
 797   ufoClearCondDefines();
 798
 799   #ifndef WIN32
 800   ufoDbgDeinit();
 801   #endif
 802 }
 803
 804
 805 // ////////////////////////////////////////////////////////////////////////// //
 806 // TIB, >IN
 807
 808 UFO_FORCE_INLINE uint32_t ufoGetTIB (void) {
 809   if (ufoAddrTIB >= ufoImageSize) ufoFatal("UFO read violation (%u)", ufoAddrTIB);
 810   return ufoImage[ufoAddrTIB];
 811 }
 812
 813 UFO_FORCE_INLINE void ufoSetTIB (uint32_t value) {
 814   if (ufoAddrTIB >= ufoImageSize) ufoFatal("UFO read violation (%u)", ufoAddrTIB);
 815   ufoImage[ufoAddrTIB] = value;
 816 }
 817
 818 UFO_FORCE_INLINE uint32_t ufoGetIN (void) {
 819   if (ufoAddrTIB >= ufoImageSize) ufoFatal("UFO read violation (%u)", ufoAddrIN);
 820   return ufoImage[ufoAddrIN];
 821 }
 822
 823 UFO_FORCE_INLINE void ufoSetIN (uint32_t value) {
 824   if (ufoAddrTIB >= ufoImageSize) ufoFatal("UFO read violation (%u)", ufoAddrIN);
 825   ufoImage[ufoAddrIN] = value;
 826 }
 827
 828
 829
 830 // ////////////////////////////////////////////////////////////////////////// //
 831 // 1: compiling; 0: interpreting
 832 UFO_FORCE_INLINE int ufoGetState (void) { return (int)ufoImgGetU32(ufoSTATEaddr); }
 833 // 1: compiling; 0: interpreting
 834 UFO_FORCE_INLINE void ufoSetState (int v) { ufoImgPutU32(ufoSTATEaddr, (uint32_t)v); }
 835
 836 UFO_FORCE_INLINE void ufoSetStateCompile (void) { ufoSetState(1); }
 837 UFO_FORCE_INLINE void ufoSetStateInterpret (void) { ufoSetState(0); }
 838
 839 UFO_FORCE_INLINE int ufoIsCompiling () { return (ufoGetState() != 0); }
 840 UFO_FORCE_INLINE int ufoIsInterpreting () { return (ufoGetState() == 0); }
 841
 842
 843 #define UFO_GET_CFAPROC(cfa_)  ({ \
 844   uint32_t xcfa = (cfa_); \
 845   ((xcfa & UFO_RS_CFA_BIT) && (xcfa & UFO_RS_CFA_MASK) < ufoCFAsUsed ? \
 846     ufoForthCFAs[(xcfa & UFO_RS_CFA_MASK)] : NULL); \
 847 })
 848
 849 #define UFO_VALID_VOC_FW(fw_)  ({ \
 850   const UForthWord *xvfw = (fw_); \
 851   (xvfw != NULL && xvfw->cfa == &ufoDoVoc); \
 852 })
 853
 854
 855 //==========================================================================
 856 //
 857 //  ufoLinkWordToDict
 858 //
 859 //  will not link hidden words
 860 //
 861 //==========================================================================
 862 static void ufoLinkWordToDict (UForthWord *fw) {
 863   ufo_assert(fw != NULL && fw->prevAll == NULL && fw->hash == 0 && fw->hlink == NULL);
 864   if (fw->name == NULL) fw->name = strdup("");
 865   if (UFW_IS_HID(fw)) {
 866     fw->hash = 0;
 867     fw->prevVoc = NULL;
 868   } else {
 869     // insert into hash bucket
 870     fw->hash = joaatHashBufCI(fw->name, strlen(fw->name));
 871     const uint32_t bucket = fw->hash%UFO_DICT_HASH_BUCKETS;
 872     // link to CURRENT
 873     uint32_t cur = ufoImgGetU32(ufoAddrCurrent);
 874     // we may have no vocabulary active
 875     UForthWord *voc = UFO_GET_CFAPROC(cur);
 876     if (UFO_VALID_VOC_FW(voc)) {
 877       #if 0
 878       fprintf(stderr, "REG: <%s> : hash=0%08XH; bucked=%u\n", fw->name, fw->hash, bucket);
 879       #endif
 880       fw->hlink = voc->buckets[bucket];
 881       voc->buckets[bucket] = fw;
 882       fw->prevVoc = voc->latest;
 883       voc->latest = fw;
 884     } else {
 885       fw->prevVoc = NULL;
 886     }
 887   }
 888   // append to linear list
 889   fw->prevAll = ufoForthDict;
 890   ufoForthDict = fw;
 891 }
 892
 893
 894 //==========================================================================
 895 //
 896 //  ufoLinkVocab
 897 //
 898 //==========================================================================
 899 static void ufoLinkVocab (UForthWord *fw, UForthWord *parent) {
 900   if (UFO_VALID_VOC_FW(fw)) {
 901     ufo_assert(fw->pfa != 0xffffffffU && FW_GET_CFAIDX(fw) < ufoCFAsUsed);
 902     if (parent != fw && UFO_VALID_VOC_FW(parent)) {
 903       ufoImgPutU32(fw->pfa + 1, parent->cfaidx);
 904     } else {
 905       ufoImgPutU32(fw->pfa + 1, 0);
 906     }
 907   }
 908 }
 909
 910
 911 //==========================================================================
 912 //
 913 //  ufoCreateVocabData
 914 //
 915 //==========================================================================
 916 static void ufoCreateVocabData (UForthWord *fw) {
 917   if (fw != NULL && fw->cfa == NULL) {
 918     ufo_assert(fw->pfa == 0xffffffffU && FW_GET_CFAIDX(fw) < ufoCFAsUsed && fw->buckets == NULL);
 919     fw->cfa = &ufoDoVoc;
 920     fw->buckets = calloc(1, sizeof(fw->buckets[0]) * UFO_DICT_HASH_BUCKETS);
 921     // pfa: cfa, parentvoc, prevvoc
 922     fw->pfa = ufoImageUsed;
 923     fw->pfastart = ufoImageUsed;
 924     ufoImgEmitU32(fw->cfaidx); // our cfa
 925     ufoImgEmitU32(0); // parent voc cfa
 926     ufoImgEmitU32(ufoLastVoc); // voc link
 927     ufoLastVoc = fw->pfa;
 928     fw->pfaend = ufoImageUsed;
 929     ufoLastVoc = fw->cfaidx;
 930   }
 931 }
 932
 933
 934 //==========================================================================
 935 //
 936 //  ufoFindWordInVoc
 937 //
 938 //==========================================================================
 939 static UForthWord *ufoFindWordInVoc (const char *wname, uint32_t hash, UForthWord *voc,
 940                                      int allowvochid)
 941 {
 942   UForthWord *fw = NULL;
 943   if (wname && wname[0] != 0 && UFO_VALID_VOC_FW(voc)) {
 944     fw = voc->buckets[hash%UFO_DICT_HASH_BUCKETS];
 945     while (fw != NULL) {
 946       if (fw->cfa != NULL && fw->hash == hash &&
 947           !UFW_IS_HID(fw) && (allowvochid || !UFW_IS_VOC_HID(fw)) &&
 948           strEquCI(fw->name, wname))
 949       {
 950         break;
 951       }
 952       fw = fw->hlink;
 953     }
 954   }
 955   return fw;
 956 }
 957
 958
 959 //==========================================================================
 960 //
 961 //  ufoFindWordNameRes
 962 //
 963 //==========================================================================
 964 static UForthWord *ufoFindWordNameRes (const char *wname) {
 965   char tempwbuf[256];
 966
 967   //FIXME: make this faster!
 968   UForthWord *fw;
 969   uint32_t lvcfa = ufoLastVoc;
 970   UForthWord *voc = UFO_GET_CFAPROC(lvcfa);
 971   if (!UFO_VALID_VOC_FW(voc) || wname[0] == ':') return NULL;
 972
 973   const char *colon = strchr(wname + 1, ':');
 974   if (colon == NULL || colon[1] == 0 || colon[1] == ':') return NULL;
 975   size_t vnlen = (size_t)(colon - wname);
 976   if (vnlen > 255) return NULL;
 977
 978   // get initial vocabulary name
 979   memcpy(tempwbuf, wname, vnlen);
 980   tempwbuf[vnlen] = 0;
 981   wname = colon + 1; // skip colon
 982
 983   #if 0
 984   fprintf(stderr, "NRES: INIT-VOC=<%s>; REST=<%s>\n", tempwbuf, wname);
 985   #endif
 986
 987   uint32_t vhash = joaatHashBufCI(tempwbuf, vnlen);
 988   while (UFO_VALID_VOC_FW(voc)) {
 989     if (voc->hash == vhash || strEquCI(voc->name, tempwbuf)) {
 990       break;
 991     } else {
 992       lvcfa = ufoImgGetU32(voc->pfa + 2);
 993       voc = UFO_GET_CFAPROC(lvcfa);
 994     }
 995   }
 996   #if 0
 997   fprintf(stderr, "  IVC: %p %d\n", voc, UFO_VALID_VOC_FW(voc));
 998   #endif
 999
1000   while (wname != NULL && UFO_VALID_VOC_FW(voc)) {
1001     vhash = joaatHashBufCI(wname, strlen(wname));
1002     fw = ufoFindWordInVoc(wname, vhash, voc, 1);
1003     if (fw != NULL) return fw;
1004     colon = strchr(wname, ':');
1005     if (colon == NULL) return NULL;
1006     // get vocab name
1007     size_t vnlen = (size_t)(colon - wname);
1008     if (vnlen > 255) return NULL;
1009     memcpy(tempwbuf, wname, vnlen);
1010     tempwbuf[vnlen] = 0;
1011     wname = colon + 1; // skip colon
1012     #if 0
1013     fprintf(stderr, "    XVOC=<%s>; XREST=<%s>\n", tempwbuf, wname);
1014     #endif
1015     vhash = joaatHashBufCI(tempwbuf, vnlen);
1016     voc = ufoFindWordInVoc(tempwbuf, vhash, voc, 1);
1017   }
1018
1019   return NULL;
1020 }
1021
1022
1023 //==========================================================================
1024 //
1025 //  ufoFindWord
1026 //
1027 //  ignore words with no CFA: those are not finished yet
1028 //
1029 //  doesn't look in CURRENT, does name resolution ("a:b" is word "b" in "a")
1030 //
1031 //==========================================================================
1032 static UForthWord *ufoFindWord (const char *wname) {
1033   if (!wname || wname[0] == 0) return NULL;
1034   uint32_t cur = ufoImgGetU32(ufoAddrContext);
1035   const uint32_t hash = joaatHashBufCI(wname, strlen(wname));
1036   UForthWord *fw;
1037   UForthWord *voc;
1038
1039   // first search in current
1040   voc = UFO_GET_CFAPROC(cur);
1041   fw = ufoFindWordInVoc(wname, hash, voc, (cur == ufoImgGetU32(ufoAddrContext)));
1042
1043   // try linked vocs
1044   if (fw == NULL && UFO_VALID_VOC_FW(voc)) {
1045     uint32_t vocPPrev = cur;
1046     int doMove = 0;
1047     while (fw == NULL && UFO_VALID_VOC_FW(voc)) {
1048       uint32_t vocParent = ufoImgGetU32(voc->pfa + 1);
1049       if (vocParent == vocPPrev) break;
1050       // move prev pointer
1051       if (doMove) {
1052         voc = UFO_GET_CFAPROC(vocPPrev);
1053         ufo_assert(UFO_VALID_VOC_FW(voc));
1054         vocPPrev = ufoImgGetU32(voc->pfa + 1);
1055       }
1056       doMove ^= 1;
1057       // search
1058       voc = UFO_GET_CFAPROC(vocParent);
1059       fw = ufoFindWordInVoc(wname, hash, voc, (cur == ufoImgGetU32(ufoAddrContext)));
1060     }
1061   }
1062
1063   // if not found, try name resolution
1064   if (fw == NULL) fw = ufoFindWordNameRes(wname);
1065
1066   // now try vocabulary stack
1067   uint32_t vstp = ufoVSP;
1068   while (fw == NULL && vstp != 0) {
1069     vstp -= 1;
1070     voc = UFO_GET_CFAPROC(ufoVocStack[vstp]);
1071     fw = ufoFindWordInVoc(wname, hash, voc,
1072                           (ufoVocStack[vstp] == ufoImgGetU32(ufoAddrContext)));
1073   }
1074
1075   return fw;
1076 }
1077
1078
1079 //==========================================================================
1080 //
1081 //  ufoFindWordMacro
1082 //
1083 //==========================================================================
1084 static UForthWord *ufoFindWordMacro (const char *wname) {
1085   if (!wname || wname[0] == 0) return NULL;
1086   const uint32_t hash = joaatHashBufCI(wname, strlen(wname));
1087   return ufoFindWordInVoc(wname, hash, UFO_GET_CFAPROC(ufoMacroVocCFA), 0);
1088 }
1089
1090
1091 //==========================================================================
1092 //
1093 //  ufoFindWordForth
1094 //
1095 //  only in FORTH dictionary, including hidden words
1096 //
1097 //==========================================================================
1098 static UForthWord *ufoFindWordForth (const char *wname) {
1099   if (!wname || wname[0] == 0) return NULL;
1100   const uint32_t hash = joaatHashBufCI(wname, strlen(wname));
1101   UForthWord *fw = ufoFindWordInVoc(wname, hash, UFO_GET_CFAPROC(ufoForthVocCFA), 1);
1102   if (fw == NULL) fw = ufoFindWord(wname);
1103   return fw;
1104 }
1105
1106
1107 //==========================================================================
1108 //
1109 //  ufoFindWordCompiler
1110 //
1111 //==========================================================================
1112 static UForthWord *ufoFindWordCompiler (const char *wname) {
1113   if (!wname || wname[0] == 0) return NULL;
1114   const uint32_t hash = joaatHashBufCI(wname, strlen(wname));
1115   UForthWord *fw = ufoFindWordInVoc(wname, hash, UFO_GET_CFAPROC(ufoCompSuppVocCFA), 1);
1116   if (fw == NULL) fw = ufoFindWord(wname);
1117   return fw;
1118 }
1119
1120
1121 //==========================================================================
1122 //
1123 //  ufoAlwaysWordForth
1124 //
1125 //==========================================================================
1126 UFO_FORCE_INLINE UForthWord *ufoAlwaysWordForth (const char *wname) {
1127   UForthWord *fw = ufoFindWordForth(wname);
1128   if (!fw) ufoFatal("FORTH word `%s` not found", (wname[0] ? wname : "~"));
1129   return fw;
1130 }
1131
1132
1133 //==========================================================================
1134 //
1135 //  ufoAlwaysWordCompiler
1136 //
1137 //==========================================================================
1138 UFO_FORCE_INLINE UForthWord *ufoAlwaysWordCompiler (const char *wname) {
1139   UForthWord *fw = ufoFindWordCompiler(wname);
1140   if (!fw) ufoFatal("COMPILER word `%s` not found", (wname[0] ? wname : "~"));
1141   return fw;
1142 }
1143
1144
1145 //==========================================================================
1146 //
1147 //  ufoAlwaysWord
1148 //
1149 //==========================================================================
1150 UFO_FORCE_INLINE UForthWord *ufoAlwaysWord (const char *wname) {
1151   UForthWord *fw = ufoFindWord(wname);
1152   if (!fw) ufoFatal("word `%s` not found", (wname[0] ? wname : "~"));
1153   return fw;
1154 }
1155
1156
1157 //==========================================================================
1158 //
1159 //  ufoNFind
1160 //
1161 //==========================================================================
1162 static UForthWord *ufoNFind (uint32_t addr, uint32_t count) {
1163   char wbuf[128];
1164   if (count > 0) {
1165     if (count > 127) return NULL; // too long
1166     // copy
1167     for (uint32_t n = 0; n < count; ++n) {
1168       const uint8_t ch = ufoImgGetU8(addr+n)&0xffU;
1169       if (!ch) return NULL; // word name cannot contain 0 byte
1170       wbuf[n] = (char)ch; //toUpper((char)(ch));
1171     }
1172   }
1173   wbuf[count] = 0;
1174   return ufoFindWord(wbuf);
1175 }
1176
1177
1178 //==========================================================================
1179 //
1180 //  ufoLoadNextLine_NativeMode
1181 //
1182 //  load next file line into TIB
1183 //  always adds final '\n'
1184 //
1185 //==========================================================================
1186 static void ufoLoadNextLine_NativeMode (int crossInclude) {
1187   const uint8_t *text = NULL;
1188
1189   ufoSetTIB(0); ufoSetIN(0);
1190   int done = 0;
1191
1192   while (ufoInFile && done == 0) {
1193     if (fgets(ufoCurrFileLine, 510, ufoInFile) != NULL) {
1194       // check for a newline
1195       // if there is no newline char at the end, the string was truncated
1196       ufoCurrFileLine[510] = 0;
1197       uint32_t slen = (uint32_t)strlen(ufoCurrFileLine);
1198       if (slen == 0 || (ufoCurrFileLine[slen - 1u] != 13 && ufoCurrFileLine[slen - 1u] != 10)) {
1199         ufoFatal("input line too long");
1200       }
1201       ++ufoInFileLine;
1202       text = (const uint8_t *)ufoCurrFileLine;
1203       done = 1;
1204     } else {
1205       if (!crossInclude) {
1206         if (ufoCondStLine >= 0) {
1207           ufoFatal("unfinished conditional from line %d", ufoCondStLine);
1208         }
1209         ufoFatal("unexpected end of text");
1210       }
1211       ufoPopInFile();
1212     }
1213   }
1214
1215   if (done == 0) {
1216     int lnum;
1217     const char *fname;
1218     text = (const uint8_t *)ufoGetSrcLine(&fname, &lnum);
1219     if (text == NULL) {
1220       if (ufoCondStLine >= 0) {
1221         ufoFatal("unfinished conditional from line %d", ufoCondStLine);
1222       }
1223       ufoFatal("unexpected end of text");
1224     }
1225     ufoInFileLine = lnum;
1226     if (ufoInFileName == NULL || strcmp(ufoInFileName, fname) != 0) {
1227       if (ufoInFileName != NULL) free(ufoInFileName);
1228       ufoInFileName = strdup(fname);
1229       setLastIncPath(ufoInFileName);
1230     }
1231   }
1232
1233   size_t sslen = strlen((const char *)text);
1234   while (sslen != 0 && (text[sslen - 1u] == 13 || text[sslen - 1u] == 10)) sslen -= 1;
1235   if (sslen > 510) ufoFatal("input line too long");
1236   if (text != (const void *)ufoCurrFileLine) {
1237     if (sslen != 0) memcpy(ufoCurrFileLine, text, sslen);
1238   }
1239   ufoCurrFileLine[sslen + 0] = 10;
1240   ufoCurrFileLine[sslen + 1] = 0;
1241
1242   #ifdef UFO_DEBUG_INLCUDE
1243   fprintf(stderr, "NEXT-LINE: <%s>\n", ufoCurrFileLine);
1244   #endif
1245
1246   for (uint32_t dpos = 0; dpos != (uint32_t)sslen; dpos += 1) {
1247     uint8_t ch = text[dpos];
1248     // replace bad chars, because why not
1249     if (ch == 0 || ch == 13 || ch == 10) ch = 32;
1250     ufoImgPutU32(dpos, ch);
1251   }
1252   ufoImgPutU32((uint32_t)sslen, 10);
1253   ufoImgPutU32((uint32_t)sslen + 1u, 0);
1254 }
1255
1256
1257 //==========================================================================
1258 //
1259 //  ufoLoadMacroLine
1260 //
1261 //==========================================================================
1262 static void ufoLoadMacroLine (const char *line, const char *fname, int lnum) {
1263   const uint8_t *text = (const uint8_t *)line;
1264   if (text == NULL) text = (const uint8_t *)"";
1265   if (fname == NULL) fname = "";
1266
1267   ufoSetTIB(0); ufoSetIN(0);
1268
1269   ufoInFileLine = lnum;
1270   if (ufoInFileName == NULL || strcmp(ufoInFileName, fname) != 0) {
1271     if (ufoInFileName != NULL) free(ufoInFileName);
1272     ufoInFileName = strdup(fname);
1273     setLastIncPath(ufoInFileName);
1274   }
1275
1276   size_t sslen = strlen((const char *)text);
1277   while (sslen != 0 && (text[sslen - 1u] == 13 || text[sslen - 1u] == 10)) sslen -= 1;
1278   if (sslen > 510) ufoFatal("input line too long");
1279   if (sslen != 0) memcpy(ufoCurrFileLine, text, sslen);
1280   ufoCurrFileLine[sslen + 0] = 10;
1281   ufoCurrFileLine[sslen + 1] = 0;
1282
1283   for (uint32_t dpos = 0; dpos != (uint32_t)sslen; dpos += 1) {
1284     uint8_t ch = text[dpos];
1285     // replace bad chars, because why not
1286     if (ch == 0 || ch == 13 || ch == 10) ch = 32;
1287     ufoImgPutU32(dpos, ch);
1288   }
1289   ufoImgPutU32((uint32_t)sslen, 10);
1290   ufoImgPutU32((uint32_t)sslen + 1u, 0);
1291 }
1292
1293
1294 //==========================================================================
1295 //
1296 //  ufoLoadNextLine
1297 //
1298 //  load next file line into TIB
1299 //  return zero on success, -1 on EOF, -2 on error
1300 //
1301 //==========================================================================
1302 static void ufoLoadNextLine (int crossInclude) {
1303   switch (ufoMode) {
1304     case UFO_MODE_NATIVE:
1305       ufoLoadNextLine_NativeMode(crossInclude);
1306       break;
1307     case UFO_MODE_MACRO:
1308       if (ufoCondStLine >= 0) {
1309         ufoFatal("unfinished conditional from line %d", ufoCondStLine);
1310       }
1311       ufoFatal("unexpected end of input for FORTH asm macro");
1312       break;
1313     default: ufoFatal("wtf?! not properly inited!");
1314   }
1315 }
1316
1317
1318 // ////////////////////////////////////////////////////////////////////////// //
1319 // working with the stacks
1320 UFO_FORCE_INLINE void ufoPush (uint32_t v) { if (ufoSP >= UFO_DSTACK_SIZE) ufoFatal("UFO data stack overflow"); ufoDStack[ufoSP++] = v; }
1321 UFO_FORCE_INLINE void ufoDrop (void) { if (ufoSP == 0) ufoFatal("UFO data stack underflow"); --ufoSP; }
1322 UFO_FORCE_INLINE uint32_t ufoPop (void) { if (ufoSP == 0) { ufoFatal("UFO data stack underflow"); } return ufoDStack[--ufoSP]; }
1323 UFO_FORCE_INLINE uint32_t ufoPeek (void) { if (ufoSP == 0) ufoFatal("UFO data stack underflow"); return ufoDStack[ufoSP-1u]; }
1324 UFO_FORCE_INLINE void ufoDup (void) { if (ufoSP == 0) ufoFatal("UFO data stack underflow"); ufoPush(ufoDStack[ufoSP-1u]); }
1325 UFO_FORCE_INLINE void ufoOver (void) { if (ufoSP < 2u) ufoFatal("UFO data stack underflow"); ufoPush(ufoDStack[ufoSP-2u]); }
1326 UFO_FORCE_INLINE void ufoSwap (void) { if (ufoSP < 2u) ufoFatal("UFO data stack underflow"); const uint32_t t = ufoDStack[ufoSP-1u]; ufoDStack[ufoSP-1u] = ufoDStack[ufoSP-2u]; ufoDStack[ufoSP-2u] = t; }
1327 UFO_FORCE_INLINE void ufoRot (void) { if (ufoSP < 3u) ufoFatal("UFO 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; }
1328 UFO_FORCE_INLINE void ufoNRot (void) { if (ufoSP < 3u) ufoFatal("UFO 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; }
1329
1330 UFO_FORCE_INLINE void ufo2Dup (void) { ufoOver(); ufoOver(); }
1331 UFO_FORCE_INLINE void ufo2Drop (void) { ufoDrop(); ufoDrop(); }
1332 UFO_FORCE_INLINE void ufo2Over (void) { if (ufoSP < 4u) ufoFatal("UFO data stack underflow"); const uint32_t n0 = ufoDStack[ufoSP-4u]; const uint32_t n1 = ufoDStack[ufoSP-3u]; ufoPush(n0); ufoPush(n1); }
1333 UFO_FORCE_INLINE void ufo2Swap (void) { if (ufoSP < 4u) ufoFatal("UFO 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; }
1334
1335 UFO_FORCE_INLINE void ufoRPush (uint32_t v) { if (ufoRP >= UFO_RSTACK_SIZE) ufoFatal("UFO return stack overflow"); ufoRStack[ufoRP++] = v; }
1336 UFO_FORCE_INLINE void ufoRDrop (void) { if (ufoRP == 0) ufoFatal("UFO return stack underflow"); --ufoRP; }
1337 UFO_FORCE_INLINE uint32_t ufoRPop (void) { if (ufoRP == 0) ufoFatal("UFO return stack underflow"); return ufoRStack[--ufoRP]; }
1338 UFO_FORCE_INLINE uint32_t ufoRPeek (void) { if (ufoRP == 0) ufoFatal("UFO return stack underflow"); return ufoRStack[ufoRP-1u]; }
1339 UFO_FORCE_INLINE void ufoRDup (void) { if (ufoRP == 0) ufoFatal("UFO return stack underflow"); ufoPush(ufoRStack[ufoRP-1u]); }
1340 UFO_FORCE_INLINE void ufoROver (void) { if (ufoRP < 2u) ufoFatal("UFO return stack underflow"); ufoPush(ufoRStack[ufoRP-2u]); }
1341 UFO_FORCE_INLINE void ufoRSwap (void) { if (ufoRP < 2u) ufoFatal("UFO return stack underflow"); const uint32_t t = ufoRStack[ufoRP-1u]; ufoRStack[ufoRP-1u] = ufoRStack[ufoRP-2u]; ufoRStack[ufoRP-2u] = t; }
1342 UFO_FORCE_INLINE void ufoRRot (void) { if (ufoRP < 3u) ufoFatal("UFO return stack underflow"); const uint32_t t = ufoRStack[ufoRP-3u]; ufoRStack[ufoRP-3u] = ufoRStack[ufoRP-2u]; ufoRStack[ufoRP-2u] = ufoRStack[ufoRP-1u]; ufoRStack[ufoRP-1u] = t; }
1343 UFO_FORCE_INLINE void ufoRNRot (void) { if (ufoRP < 3u) ufoFatal("UFO return stack underflow"); const uint32_t t = ufoRStack[ufoRP-1u]; ufoRStack[ufoRP-1u] = ufoRStack[ufoRP-2u]; ufoRStack[ufoRP-2u] = ufoRStack[ufoRP-3u]; ufoRStack[ufoRP-3u] = t; }
1344
1345 UFO_FORCE_INLINE void ufoPushBool (int v) { ufoPush(v ? ufoTrueValue : 0u); }
1346
1347
1348 // ////////////////////////////////////////////////////////////////////////// //
1349 #define UFWORD(name_) \
1350 static void ufoWord_##name_ (UForthWord *self)
1351
1352 #define UFCALL(name_)  ufoWord_##name_(NULL)
1353 #define UFCFA(name_)   (&ufoWord_##name_)
1354
1355
1356
1357 // ////////////////////////////////////////////////////////////////////////// //
1358 static void ufoDoForth (UForthWord *self) {
1359   #if 0
1360     fprintf(stderr, "ufoDoForth: <%s>; ip=%u; pfa=%u; pfastart=%u; pfaend=%u; HERE=%u\n",
1361             self->name, ufoIP, self->pfa, self->pfastart, self->pfaend, ufoImageUsed);
1362   #endif
1363   ufoRPush(ufoIP);
1364   if (self->pfastart != self->pfa) {
1365     #if 0
1366       fprintf(stderr, "ufoDoForth: <%s>; ip=%u; pfa=%u; pfastart=%u; pfaend=%u; HERE=%u\n",
1367               self->name, ufoIP, self->pfa, self->pfastart, self->pfaend, ufoImageUsed);
1368     #endif
1369     ufoPush(self->pfastart);
1370   }
1371   ufoIP = self->pfa;
1372 }
1373
1374
1375 //==========================================================================
1376 //
1377 //  ufoDoVoc
1378 //
1379 //==========================================================================
1380 static void ufoDoVoc (UForthWord *self) {
1381   ufoImgPutU32(ufoAddrContext, self->cfaidx);
1382 }
1383
1384
1385 //==========================================================================
1386 //
1387 //  ufoCompileWordCFA
1388 //
1389 //==========================================================================
1390 UFO_FORCE_INLINE void ufoCompileWordCFA (UForthWord *fw) {
1391   if (fw == NULL) ufoFatal("internal error in `ufoCompileWordCFA`");
1392   if (fw->cfa == NULL || FW_GET_CFAIDX(fw) >= ufoCFAsUsed) {
1393     ufoFatal("internal error in `ufoCompileWordCFA` (word: '%s')", fw->name);
1394   }
1395   ufoImgEmitU32(fw->cfaidx);
1396 }
1397
1398
1399 //==========================================================================
1400 //
1401 //  ufoCompileForthWord
1402 //
1403 //==========================================================================
1404 UFO_FORCE_INLINE void ufoCompileForthWord (const char *wname) {
1405   ufoCompileWordCFA(ufoAlwaysWordForth(wname));
1406 }
1407
1408
1409 //==========================================================================
1410 //
1411 //  ufoCompileCompilerWord
1412 //
1413 //==========================================================================
1414 UFO_FORCE_INLINE void ufoCompileCompilerWord (const char *wname) {
1415   ufoCompileWordCFA(ufoAlwaysWordCompiler(wname));
1416 }
1417
1418
1419 //==========================================================================
1420 //
1421 //  ufoCompileLiteral
1422 //
1423 //==========================================================================
1424 static void ufoCompileLiteral (uint32_t value) {
1425   ufoCompileCompilerWord("LIT");
1426   ufoImgEmitU32(value);
1427 }
1428
1429
1430 // ////////////////////////////////////////////////////////////////////////// //
1431 // SP0!
1432 // ( -- )
1433 UFWORD(SP0_PUT) { ufoSP = 0; }
1434
1435 // RP0!
1436 // ( -- )
1437 UFWORD(RP0_PUT) { ufoRP = ufoRPTop; }
1438
1439 // BASE
1440 // ( -- baseptr )
1441 UFWORD(BASE) { ufoPush(ufoBASEaddr); }
1442
1443 // STATE
1444 // ( -- stateptr )
1445 UFWORD(STATE) { ufoPush(ufoSTATEaddr); }
1446
1447 // @
1448 // ( addr -- value32 )
1449 UFWORD(PEEK) { const uint32_t addr = ufoPop(); ufoPush(ufoImgGetU32(addr)); }
1450
1451 // C@
1452 // ( addr -- value8 )
1453 UFWORD(CPEEK) { const uint32_t addr = ufoPop(); ufoPush(ufoImgGetU8(addr)&0xffU); }
1454
1455 // W@
1456 // ( addr -- value32 )
1457 UFWORD(WPEEK) { const uint32_t addr = ufoPop(); ufoPush(ufoImgGetU32(addr)&0xffffU); }
1458
1459 // !
1460 // ( val32 addr -- )
1461 UFWORD(POKE) { const uint32_t addr = ufoPop(); const uint32_t val = ufoPop(); ufoImgPutU32(addr, val); }
1462
1463 // C!
1464 // ( val8 addr -- )
1465 UFWORD(CPOKE) { const uint32_t addr = ufoPop(); const uint32_t val = ufoPop(); ufoImgPutU8(addr, val&0xffU); }
1466
1467 // W!
1468 // ( val32 addr -- )
1469 UFWORD(WPOKE) {
1470   const uint32_t addr = ufoPop();
1471   const uint32_t val = ufoPop();
1472   ufoImgPutU32(addr, val&0xffffU);
1473 }
1474
1475 // C,
1476 // ( val8 -- )
1477 // puts byte to native/zx dictionary, according to the current mode
1478 UFWORD(CCOMMA) {
1479   const uint32_t val = ufoPop()&0xffU;
1480   ufoImgEmitU8(val);
1481 }
1482
1483 // ZX-C,
1484 // ( val8 -- )
1485 // puts byte to zx dictionary
1486 UFWORD(ZX_CCOMMA) {
1487   const uint32_t val = ufoPop()&0xffU;
1488   ufoZXEmitU8(val);
1489 }
1490
1491 // ,
1492 // ( val -- )
1493 // puts uint/word to native/zx dictionary, according to the current mode
1494 UFWORD(COMMA) {
1495   const uint32_t val = ufoPop();
1496   ufoImgEmitU32(val);
1497 }
1498
1499 // ZX-W,
1500 // ( val -- )
1501 // puts word to zx dictionary
1502 UFWORD(ZX_WCOMMA) {
1503   const uint32_t val = ufoPop();
1504   ufoZXEmitU16(val&0xffffU);
1505 }
1506
1507 // ZX-C@
1508 // ( addr -- value8 )
1509 UFWORD(ZX_CPEEK) { const uint32_t addr = ufoPop(); ufoPush(ufoZXGetU8(addr)); }
1510
1511 // ZX-C!
1512 // ( val8 addr -- )
1513 UFWORD(ZX_CPOKE) { const uint32_t addr = ufoPop(); const uint32_t val = ufoPop(); ufoZXPutU8(addr, val); }
1514
1515 // ZX-W@
1516 // ( addr -- value16 )
1517 UFWORD(ZX_WPEEK) { const uint32_t addr = ufoPop(); ufoPush(ufoZXGetU16(addr)); }
1518
1519 // ZX-W!
1520 // ( val16 addr -- )
1521 UFWORD(ZX_WPOKE) { const uint32_t addr = ufoPop(); const uint32_t val = ufoPop(); ufoZXPutU16(addr, val); }
1522
1523 // ZX-RESERVED?
1524 // ( addr -- bool )
1525 UFWORD(ZX_RESERVEDQ) {
1526   const uint32_t addr = ufoPop();
1527   ufoPushBool(ufoZXGetReserved(addr));
1528 }
1529
1530 // ZX-RESERVED!
1531 // ( bool addr -- )
1532 UFWORD(ZX_RESERVEDS) {
1533   const uint32_t addr = ufoPop();
1534   const uint32_t flag = ufoPop();
1535   ufoZXSetReserved(addr, (flag ? 1 : 0));
1536 }
1537
1538
1539 // ZXADDR?
1540 // ( addr -- flag )
1541 // is address a ZX Spectrum mmaped address?
1542 UFWORD(ZXADDRQ) {
1543   const uint32_t addr = ufoPop();
1544   ufoPushBool(addr&UFO_ZX_ADDR_BIT);
1545 }
1546
1547 // (TOZX)
1548 // ( addr -- addr )
1549 // convert address to ZX Spectrum mmaped address
1550 UFWORD(TOZX) {
1551   const uint32_t addr = ufoPop();
1552   ufoPush((addr&UFO_ZX_ADDR_MASK)|UFO_ZX_ADDR_BIT);
1553 }
1554
1555 // TOZX
1556 // ( addr -- addr )
1557 // convert address to ZX Spectrum mmaped address
1558 UFWORD(TOZX_IMM) {
1559   if (ufoMode == UFO_MODE_NATIVE) {
1560     if (ufoIsCompiling()) {
1561       ufoCompileForthWord("(TOZX)");
1562     } else {
1563       UFCALL(TOZX);
1564     }
1565   }
1566 }
1567
1568 // (FROMZX)
1569 // ( addr -- addr )
1570 // convert address from ZX Spectrum mmaped address
1571 UFWORD(FROMZX) {
1572   const uint32_t addr = ufoPop();
1573   ufoPush(addr&UFO_ZX_ADDR_MASK);
1574 }
1575
1576 // FROMZX
1577 // ( addr -- addr )
1578 // convert address from ZX Spectrum mmaped address
1579 UFWORD(FROMZX_IMM) {
1580   if (ufoMode == UFO_MODE_NATIVE) {
1581     if (ufoIsCompiling()) {
1582       ufoCompileForthWord("(FROMZX)");
1583     } else {
1584       UFCALL(FROMZX);
1585     }
1586   }
1587 }
1588
1589 // (LIT) ( -- n )
1590 UFWORD(LIT) {
1591   const uint32_t v = ufoImgGetU32(ufoIP++);
1592   ufoPush(v);
1593 }
1594
1595 // (BRANCH) ( -- )
1596 UFWORD(BRANCH) {
1597   ufoIP = ufoImgGetU32(ufoIP);
1598 }
1599
1600 // (TBRANCH) ( flag )
1601 UFWORD(TBRANCH) {
1602   if (ufoPop()) {
1603     ufoIP = ufoImgGetU32(ufoIP);
1604   } else {
1605     ++ufoIP;
1606   }
1607 }
1608
1609 // (0BRANCH) ( flag )
1610 UFWORD(0BRANCH) {
1611   if (!ufoPop()) {
1612     ufoIP = ufoImgGetU32(ufoIP);
1613   } else {
1614     ++ufoIP;
1615   }
1616 }
1617
1618 // (DO)
1619 // ( limit start -- | limit counter )
1620 // loops from start to limit-1
1621 UFWORD(DO_PAREN) {
1622   ufoSwap();
1623   ufoRPush(ufoPop());
1624   ufoRPush(ufoPop());
1625 }
1626
1627 // ( -- | limit counter )
1628 static void ufoPLoopCommon (int32_t add) {
1629   const int32_t n = (int32_t)ufoRPop();
1630   const int32_t lim = (int32_t)ufoRPeek();
1631   const int32_t newn = n+add;
1632   // this is how dsForth does it
1633   if ((newn < 0 ? lim-newn : newn-lim) < 0) {
1634     ufoRPush(newn);
1635     ufoIP = ufoImgGetU32(ufoIP);
1636   } else {
1637     ufoRDrop();
1638     ++ufoIP;
1639   }
1640 }
1641
1642 // (LOOP)
1643 // ( -- | limit counter )
1644 // loops from start to limit-1
1645 UFWORD(LOOP_PAREN) {
1646   ufoPLoopCommon(1);
1647 }
1648
1649 // (+LOOP)
1650 // ( n -- | limit counter )
1651 // loops from start to limit-1
1652 UFWORD(PLOOP_PAREN) {
1653   const int32_t add = (int32_t)ufoPop();
1654   ufoPLoopCommon(add);
1655 }
1656
1657 /*
1658 UFWORD(LEAVE) {
1659   ufoRDrop();
1660   ufoRDrop();
1661   const int32_t add = (int32_t)ufoPop();
1662   int32_t n = (int32_t)ufoRPop();
1663   const int32_t lim = (int32_t)ufoRPeek();
1664   if ((n < lim && n+add >= lim) || (n > lim && n+add <= lim)) {
1665     ufoRDrop();
1666     ++ufoIP;
1667   } else {
1668     ufoRPush(n+add);
1669     ufoIP = ufoImgGetU32(ufoIP);
1670   }
1671 }
1672 */
1673
1674 // I
1675 // ( counter -- | limit counter )
1676 UFWORD(I) {
1677   ufoPush(ufoRPeek());
1678 }
1679
1680 // I'
1681 // ( limit -- | limit counter )
1682 UFWORD(ITICK) {
1683   const uint32_t c = ufoRPop();
1684   ufoPush(ufoRPeek());
1685   ufoRPush(c);
1686 }
1687
1688 // J
1689 UFWORD(J) {
1690   const uint32_t c0 = ufoRPop();
1691   const uint32_t c1 = ufoRPop();
1692   ufoPush(ufoRPeek());
1693   ufoRPush(c1);
1694   ufoRPush(c0);
1695 }
1696
1697 // J'
1698 UFWORD(JTICK) {
1699   const uint32_t c0 = ufoRPop();
1700   const uint32_t c1 = ufoRPop();
1701   const uint32_t c2 = ufoRPop();
1702   ufoPush(ufoRPeek());
1703   ufoRPush(c2);
1704   ufoRPush(c1);
1705   ufoRPush(c0);
1706 }
1707
1708
1709 //==========================================================================
1710 //
1711 //  ufoExecuteNativeWordInVM
1712 //
1713 //==========================================================================
1714 UFO_FORCE_INLINE void ufoExecuteNativeWordInVM (UForthWord *fw) {
1715   ufo_assert(fw != NULL);
1716   if (fw->cfa == &ufoDoForth) {
1717     const uint32_t oldRPTop = ufoRPTop;
1718     ufoRPTop = ufoRP;
1719     fw->cfa(fw); // this pushes IP, and may do other work
1720     ufoRunVM();
1721     ufoRPTop = oldRPTop;
1722   } else {
1723     fw->cfa(fw);
1724   }
1725 }
1726
1727
1728 //==========================================================================
1729 //
1730 //  ufoExecCFAIdx
1731 //
1732 //==========================================================================
1733 UFO_FORCE_INLINE void ufoExecCFAIdxInVM (uint32_t cfa) {
1734   if (cfa & UFO_RS_CFA_BIT) {
1735     cfa &= UFO_RS_CFA_MASK;
1736     if (cfa >= ufoCFAsUsed) ufoFatal("calling invalid UFO word with EXECUTE (%u)", cfa);
1737     UForthWord *fw = ufoForthCFAs[cfa];
1738     if (fw == NULL) ufoFatal("internal error: empty CFA index for word '%s'", fw->name);
1739     ufoExecuteNativeWordInVM(fw);
1740   } else {
1741     ufoFatal("calling invalid address with EXECUTE (%u)", cfa);
1742   }
1743 }
1744
1745
1746 //==========================================================================
1747 //
1748 //  ufoExecCFAIdx
1749 //
1750 //==========================================================================
1751 UFO_FORCE_INLINE void ufoExecCFAIdx (uint32_t cfa) {
1752   if (cfa & UFO_RS_CFA_BIT) {
1753     cfa &= UFO_RS_CFA_MASK;
1754     if (cfa >= ufoCFAsUsed) ufoFatal("calling invalid UFO word with EXECUTE (%u)", cfa);
1755     UForthWord *fw = ufoForthCFAs[cfa];
1756     if (fw == NULL) ufoFatal("internal error: empty CFA index for word '%s'", fw->name);
1757     fw->cfa(fw);
1758   } else {
1759     ufoFatal("calling invalid address with EXECUTE (%u)", cfa);
1760   }
1761 }
1762
1763
1764 // EXECUTE ( cfa )
1765 UFWORD(EXECUTE) { ufoExecCFAIdx(ufoPop()); }
1766
1767 // DUP ( n -- n n )
1768 UFWORD(DUP) { ufoDup(); }
1769 // ?DUP ( n -- n n ) | ( 0 -- 0 )
1770 UFWORD(QDUP) { if (ufoPeek()) ufoDup(); }
1771 // 2DUP ( n0 n1 -- n0 n1 n0 n1 ) | ( 0 -- 0 )
1772 UFWORD(DDUP) { ufo2Dup(); }
1773 // DROP ( n -- )
1774 UFWORD(DROP) { ufoDrop(); }
1775 // 2DROP ( n -- )
1776 UFWORD(DDROP) { ufo2Drop(); }
1777 // SWAP ( n0 n1 -- n1 n0 )
1778 UFWORD(SWAP) { ufoSwap(); }
1779 // 2SWAP ( n0 n1 -- n1 n0 )
1780 UFWORD(DSWAP) { ufo2Swap(); }
1781 // OVER ( n0 n1 -- n0 n1 n0 )
1782 UFWORD(OVER) { ufoOver(); }
1783 // 2OVER ( n0 n1 -- n0 n1 n0 )
1784 UFWORD(DOVER) { ufo2Over(); }
1785 // ROT ( n0 n1 n2 -- n1 n2 n0 )
1786 UFWORD(ROT) { ufoRot(); }
1787 // NROT ( n0 n1 n2 -- n2 n0 n1 )
1788 UFWORD(NROT) { ufoNRot(); }
1789
1790 // RDUP ( n -- n n )
1791 UFWORD(RDUP) { ufoRDup(); }
1792 // RDROP ( n -- )
1793 UFWORD(RDROP) { ufoRDrop(); }
1794 // RSWAP ( n0 n1 -- n1 n0 )
1795 UFWORD(RSWAP) { ufoRSwap(); }
1796 // ROVER ( n0 n1 -- n0 n1 n0 )
1797 UFWORD(ROVER) { ufoROver(); }
1798 // RROT ( n0 n1 n2 -- n1 n2 n0 )
1799 UFWORD(RROT) { ufoRRot(); }
1800 // RNROT ( n0 n1 n2 -- n2 n0 n1 )
1801 UFWORD(RNROT) { ufoRNRot(); }
1802
1803 // >R ( n -- | n)
1804 UFWORD(DTOR) { ufoRPush(ufoPop()); }
1805 // R> ( -- n | n-removed )
1806 UFWORD(RTOD) { ufoPush(ufoRPop()); }
1807 // R@ ( -- n | n-removed )
1808 UFWORD(RPEEK) { ufoPush(ufoRPeek()); }
1809
1810
1811 // CMOVE>
1812 // ( src dest count -- )
1813 UFWORD(CMOVE_FWD) {
1814   uint32_t count = ufoPop();
1815   uint32_t dest = ufoPop();
1816   uint32_t src = ufoPop();
1817   if (count == 0 || count > 0x1fffffffU || dest == src) return;
1818   dest += count;
1819   src += count;
1820   while (count--) {
1821     --dest;
1822     --src;
1823     const uint32_t v = (src&UFO_ZX_ADDR_BIT ? ufoZXGetU8(src&UFO_ZX_ADDR_MASK) : ufoImgGetU32(src));
1824     if (dest&UFO_ZX_ADDR_BIT) ufoZXPutU8(dest&UFO_ZX_ADDR_MASK, (uint8_t)v&0xffU); else ufoImgPutU32(dest, v);
1825   }
1826 }
1827
1828 // CMOVE
1829 // ( src dest count -- )
1830 UFWORD(CMOVE_BACK) {
1831   uint32_t count = ufoPop();
1832   uint32_t dest = ufoPop();
1833   uint32_t src = ufoPop();
1834   if (count == 0 || count > 0x1fffffffU || dest == src) return;
1835   while (count--) {
1836     const uint32_t v = (src&UFO_ZX_ADDR_BIT ? ufoZXGetU8(src&UFO_ZX_ADDR_MASK) : ufoImgGetU32(src));
1837     if (dest&UFO_ZX_ADDR_BIT) ufoZXPutU8(dest&UFO_ZX_ADDR_MASK, (uint8_t)v&0xffU); else ufoImgPutU32(dest, v);
1838     ++dest;
1839     ++src;
1840   }
1841 }
1842
1843 // MOVE
1844 // ( src dest count -- )
1845 UFWORD(MOVE) {
1846   uint32_t count = ufoPop();
1847   uint32_t dest = ufoPop();
1848   uint32_t src = ufoPop();
1849   ufoPush(src);
1850   ufoPush(dest);
1851   ufoPush(count);
1852   if (dest < src) UFCALL(CMOVE_BACK); else UFCALL(CMOVE_FWD);
1853 }
1854
1855
1856 // STR=
1857 // ( addr1 count1 addr2 count2 -- flag )
1858 UFWORD(STREQU) {
1859   uint32_t count2 = ufoPop();
1860   uint32_t addr2 = ufoPop();
1861   uint32_t count1 = ufoPop();
1862   uint32_t addr1 = ufoPop();
1863   if (count2 != count1) { ufoPushBool(0); return; }
1864   while (count1--) {
1865     uint8_t c0 = ufoImgGetU8(addr1++);
1866     uint8_t c1 = ufoImgGetU8(addr2++);
1867     if (c0 != c1) { ufoPushBool(0); return; }
1868   }
1869   ufoPushBool(1);
1870 }
1871
1872 // STR=CI
1873 // ( addr1 count1 addr2 count2 -- flag )
1874 UFWORD(STRCMPCI) {
1875   uint32_t count2 = ufoPop();
1876   uint32_t addr2 = ufoPop();
1877   uint32_t count1 = ufoPop();
1878   uint32_t addr1 = ufoPop();
1879   if (count2 != count1) { ufoPushBool(0); return; }
1880   while (count1--) {
1881     uint8_t c0 = (uint8_t)(toUpper((char)ufoImgGetU8(addr1++)));
1882     uint8_t c1 = (uint8_t)(toUpper((char)ufoImgGetU8(addr2++)));
1883     if (c0 != c1) { ufoPushBool(0); return; }
1884   }
1885   ufoPushBool(1);
1886 }
1887
1888 // STRCMP
1889 // ( addr1 count1 addr2 count2 -- signed-flag )
1890 UFWORD(STRCMP) {
1891   uint32_t count2 = ufoPop();
1892   uint32_t addr2 = ufoPop();
1893   uint32_t count1 = ufoPop();
1894   uint32_t addr1 = ufoPop();
1895   while (count1 != 0 && count2 != 0) {
1896     uint8_t c0 = ufoImgGetU8(addr1++);
1897     uint8_t c1 = ufoImgGetU8(addr2++);
1898     if (c0 != c1) {
1899       if (c0 < c1) ufoPush(~0u); else ufoPush(1u);
1900       return;
1901     }
1902   }
1903   if (count1 == 0) ufoPush(count2 == 0 ? 0u : ~0u);
1904   else if (count2 == 0) ufoPush(1u);
1905   else __builtin_trap();
1906 }
1907
1908 // STR=CI
1909 // ( addr1 count1 addr2 count2 -- flag )
1910 UFWORD(STREQUCI) {
1911   uint32_t count2 = ufoPop();
1912   uint32_t addr2 = ufoPop();
1913   uint32_t count1 = ufoPop();
1914   uint32_t addr1 = ufoPop();
1915   while (count1 != 0 && count2 != 0) {
1916     uint8_t c0 = (uint8_t)(toUpper((char)ufoImgGetU8(addr1++)));
1917     uint8_t c1 = (uint8_t)(toUpper((char)ufoImgGetU8(addr2++)));
1918     if (c0 != c1) {
1919       if (c0 < c1) ufoPush(~0u); else ufoPush(1u);
1920       return;
1921     }
1922   }
1923   if (count1 == 0) ufoPush(count2 == 0 ? 0u : ~0u);
1924   else if (count2 == 0) ufoPush(1u);
1925   else __builtin_trap();
1926 }
1927
1928
1929 // ////////////////////////////////////////////////////////////////////////// //
1930 // text input buffer parsing
1931
1932 //==========================================================================
1933 //
1934 //  ufoTibCharAddr
1935 //
1936 //==========================================================================
1937 UFO_FORCE_INLINE uint32_t ufoTibCharAddr (void) {
1938   return ufoGetTIB() + ufoGetIN();
1939 }
1940
1941
1942 //==========================================================================
1943 //
1944 //  ufoPeekInChar
1945 //
1946 //==========================================================================
1947 UFO_FORCE_INLINE uint8_t ufoPeekInChar (void) {
1948   return ufoImgGetU8(ufoTibCharAddr());
1949 }
1950
1951
1952 //==========================================================================
1953 //
1954 //  ufoGetInChar
1955 //
1956 //==========================================================================
1957 UFO_FORCE_INLINE uint8_t ufoGetInChar (void) {
1958   const uint32_t tib = ufoGetTIB();
1959   const uint32_t in = ufoGetIN();
1960   const uint8_t ch = ufoImgGetU8(tib + in);
1961   if (ch != 0) ufoSetIN(in + 1);
1962   return ch;
1963 }
1964
1965
1966 //==========================================================================
1967 //
1968 //  ufoGetInCharAndAddr
1969 //
1970 //==========================================================================
1971 UFO_FORCE_INLINE uint8_t ufoGetInCharAndAddr (uint32_t *addr) {
1972   const uint32_t tib = ufoGetTIB();
1973   const uint32_t in = ufoGetIN();
1974   *addr = tib + in;
1975   const uint8_t ch = ufoImgGetU8(tib + in);
1976   if (ch != 0) ufoSetIN(in + 1);
1977   return ch;
1978 }
1979
1980
1981 // TIB-ADVANCE-LINE
1982 // ( -- )
1983 UFWORD(TIB_ADVANCE_LINE) {
1984   ufoLoadNextLine(0);
1985 }
1986
1987 // TIB-PEEKCH
1988 // ( -- char )
1989 UFWORD(TIB_PEEKCH) {
1990   ufoPush(ufoPeekInChar());
1991 }
1992
1993 // TIB-SKIPCH
1994 // ( -- )
1995 UFWORD(TIB_SKIPCH) {
1996   (void)ufoGetInChar();
1997 }
1998
1999 // TIB-GETCH
2000 // ( -- char )
2001 UFWORD(TIB_GETCH) {
2002   ufoPush(ufoGetInChar());
2003 }
2004
2005 // >IN
2006 // ( -- addr )
2007 UFWORD(GET_IN_ADDR) { ufoPush(ufoAddrIN); }
2008
2009 // TIB
2010 // ( -- addr )
2011 UFWORD(GET_TIB_ADDR) { ufoPush(ufoAddrTIB); }
2012
2013 // TIB-SIZE
2014 // ( -- size-in-cells )
2015 UFWORD(GET_TIB_SIZE) { ufoPush(ufoTIBAreaSize); }
2016
2017
2018 // HERE
2019 // ( -- n )
2020 UFWORD(HERE) {
2021   ufoPush(ufoImageUsed);
2022 }
2023
2024 // PAD
2025 // ( -- n+UFO_PAD_OFFSET,aligned to 1kb )
2026 UFWORD(PAD) {
2027   ufoPush(ufoPadAddr());
2028 }
2029
2030 // COUNT
2031 // ( n -- n+1 [n] )
2032 UFWORD(COUNT) {
2033   uint32_t addr = ufoPop();
2034   uint32_t len = ufoImgGetCounter(addr);
2035   ufoPush(addr+1);
2036   ufoPush(len);
2037 }
2038
2039
2040 //==========================================================================
2041 //
2042 //  ufoWordIsGoodDelim
2043 //
2044 //==========================================================================
2045 UFO_FORCE_INLINE int ufoWordIsGoodDelim (uint32_t ch, uint32_t delim) {
2046   return (ch == delim || (delim == 32 && ch <= 32));
2047 }
2048
2049
2050 // (PARSE)
2051 // ( delim skip-leading-delim? -- addr count TRUE / FALSE )
2052 // does base TIB parsing; never copies anything.
2053 // as our reader is line-based, returns FALSE on EOL.
2054 // EOL is detected after skipping leading delimiters.
2055 // passing 0 as delimiter skips the whole line, and always returns FALSE.
2056 // trailing delimiter is always skipped.
2057 UFWORD(PAR_PARSE) {
2058   const uint32_t skipLeading = ufoPop();
2059   uint32_t delim = ufoPop();
2060   uint32_t addr = 0, count;
2061   uint32_t ch;
2062
2063   if (delim > 255) ufoFatal("invalid delimiter char");
2064
2065   if (delim != 0) {
2066     #ifdef UFO_DEBUG_PARSE
2067     fprintf(stderr, "*** (PARSE): delim=%u(%c); skip=%u\n", delim, (char)delim, skipLeading);
2068     #endif
2069     ch = ufoGetInCharAndAddr(&addr);
2070     #ifdef UFO_DEBUG_PARSE
2071     fprintf(stderr, " FCH: %u(%c)\n", ch, (ch > 32 && ch < 127 ? (char)ch : '?'));
2072     #endif
2073     // skip leading delimiters
2074     while (ch != 0 && skipLeading && ufoWordIsGoodDelim(ch, delim)) ch = ufoGetInCharAndAddr(&addr);
2075     // collect
2076     if (ch != 0) {
2077       #ifdef UFO_DEBUG_PARSE
2078       fprintf(stderr, " COLLECT: %u\n", ch);
2079       #endif
2080       count = 0;
2081       while (ch != 0 && !ufoWordIsGoodDelim(ch, delim)) { count += 1; ch = ufoGetInChar(); }
2082       #ifdef UFO_DEBUG_PARSE
2083       fprintf(stderr, " COLLECTED: ch=%u; count=%u; addr=%u\n", ch, count, addr);
2084       #endif
2085       ufoPush(addr);
2086       ufoPush(count);
2087       ufoPushBool(1);
2088     } else {
2089       #ifdef UFO_DEBUG_PARSE
2090       fprintf(stderr, " EOL!\n");
2091       #endif
2092       ufoPushBool(0);
2093     }
2094   } else {
2095     // skip the whole line
2096     while (ufoGetInChar() != 0) {}
2097     ufoPushBool(0);
2098   }
2099 }
2100
2101 // (WORD-OR-PARSE)
2102 // ( delim skip-leading-delim? -- here TRUE / FALSE )
2103 // parse word, copy it to HERE as counted string.
2104 // adds trailing zero after the string, but doesn't include it in count.
2105 // doesn't advance line.
2106 UFWORD(PAR_WORD_OR_PARSE) {
2107   UFCALL(PAR_PARSE);
2108   if (ufoPop()) {
2109     uint32_t count = ufoPop();
2110     uint32_t src = ufoPop();
2111     UFCALL(HERE);
2112     uint32_t dest = ufoPop();
2113     ufoImgPutU32(dest, count);
2114     for (uint32_t f = 0; f < count; f += 1) {
2115       ufoImgPutU8(dest + f + 1, ufoImgGetU8(src + f));
2116     }
2117     ufoImgPutU32(dest + count + 1, 0); // put trailing zero, just in case
2118     ufoPush(dest);
2119     ufoPushBool(1);
2120   } else {
2121     ufoPushBool(0);
2122   }
2123 }
2124
2125 // WORD
2126 // ( delim -- here )
2127 // parse word, copy it to HERE as counted string.
2128 // adds trailing zero after the string, but doesn't include it in count.
2129 // doesn't advance line.
2130 // return empty string on EOL.
2131 UFWORD(WORD) {
2132   ufoPushBool(1);
2133   UFCALL(PAR_WORD_OR_PARSE);
2134   if (!ufoPop()) {
2135     UFCALL(HERE);
2136     uint32_t dest = ufoPop();
2137     ufoImgPutU32(dest, 0); // counter
2138     ufoImgPutU32(dest + 1, 0); // trailing zero
2139     ufoPush(dest);
2140   }
2141 }
2142
2143 // PARSE-TO-HERE
2144 // ( delim -- addr count TRUE / FALSE )
2145 // parse word w/o skipping delimiters, copy it to HERE as counted string.
2146 // adds trailing zero after the string, but doesn't include it in count.
2147 // doesn't advance line.
2148 UFWORD(PARSE_TO_HERE) {
2149   ufoPushBool(0);
2150   UFCALL(PAR_WORD_OR_PARSE);
2151   if (ufoPop()) {
2152     UFCALL(COUNT);
2153     ufoPushBool(1);
2154   } else {
2155     ufoPushBool(0);
2156   }
2157 }
2158
2159 // PARSE-NAME
2160 // ( -- addr count )
2161 // parse with skipping leading blanks. doesn't copy anything.
2162 // return empty string on EOL.
2163 UFWORD(PARSE_NAME) {
2164   ufoPush(32); ufoPushBool(1);
2165   UFCALL(PAR_PARSE);
2166   if (!ufoPop()) {
2167     ufoPush(ufoTibCharAddr());
2168     ufoPush(0);
2169   }
2170 }
2171
2172 // PARSE
2173 // ( delim -- addr count TRUE / FALSE )
2174 // parse without skipping delimiters; never copies anything.
2175 // as our reader is line-based, returns FALSE on EOL.
2176 // passing 0 as delimiter skips the whole line, and always returns FALSE.
2177 // trailing delimiter is always skipped.
2178 UFWORD(PARSE) {
2179   ufoPushBool(0);
2180   UFCALL(PAR_PARSE);
2181 }
2182
2183
2184 //==========================================================================
2185 //
2186 //  ufoPopStrLitToTempBuf
2187 //
2188 //==========================================================================
2189 static void ufoPopStrLitToTempBuf (void) {
2190   uint32_t count = ufoPop();
2191   uint32_t addr = ufoPop();
2192   if (count == 0) ufoFatal("unexpected end of line");
2193   ufo_assert(count < (uint32_t)sizeof(ufoTempCharBuf));
2194   uint32_t dpos = 0;
2195   while (dpos != count) {
2196     ufoTempCharBuf[dpos] = ufoImgGetU8(addr + dpos);
2197     dpos += 1;
2198   }
2199   ufoTempCharBuf[dpos] = 0;
2200 }
2201
2202
2203 //==========================================================================
2204 //
2205 //  ufoParseNameToTempBuf
2206 //
2207 //  parse forth word name from TIB, put it to `ufoTempCharBuf`.
2208 //  on EOL, `ufoTempCharBuf` will be an empty string.
2209 //
2210 //==========================================================================
2211 static void ufoParseNameToTempBuf (void) {
2212   UFCALL(PARSE_NAME);
2213   if (ufoPeek() == 0) ufoFatal("word name expected");
2214   if (ufoPeek() > UFO_MAX_WORD_LENGTH) ufoFatal("word name too long");
2215   ufoPopStrLitToTempBuf();
2216 }
2217
2218
2219 //==========================================================================
2220 //
2221 //  ufoParseNameToTempBufEmptyOk
2222 //
2223 //==========================================================================
2224 static void ufoParseNameToTempBufEmptyOk (void) {
2225   UFCALL(PARSE_NAME);
2226   if (ufoPeek() == 0) {
2227     ufoTempCharBuf[0] = 0;
2228   } else {
2229     if (ufoPeek() > UFO_MAX_WORD_LENGTH) ufoFatal("word name too long");
2230     ufoPopStrLitToTempBuf();
2231   }
2232 }
2233
2234
2235 //==========================================================================
2236 //
2237 //  ufoPutTempStrLiteral
2238 //
2239 //  puts counted string literal to PAD
2240 //  returns VM address of counted string
2241 //
2242 //==========================================================================
2243 static uint32_t ufoPutTempStrLiteral (const char *s) {
2244   if (!s) s = "";
2245   const size_t slen = strlen(s);
2246   if (slen > 1024*1024) ufoFatal("temp string too long");
2247   uint32_t dest = ufoPadAddr();
2248   ufoImgPutU32(dest, (uint32_t)slen);
2249   for (size_t f = 0; f <= slen; ++f) {
2250     ufoImgPutU32(dest + f + 1, (uint8_t)(s[f]&0xffU));
2251   }
2252   return dest;
2253 }
2254
2255
2256 // ////////////////////////////////////////////////////////////////////////// //
2257 // strings
2258
2259 // EMIT
2260 // ( n -- )
2261 UFWORD(EMIT) {
2262   uint32_t ch = ufoPop()&0xffU;
2263   if (ch < 32 || ch == 127) {
2264     if (ch != 10 && ch != 13 && ch != 9) { printf("?"); return; }
2265   }
2266   ufoLastEmitWasCR = (ch == 10);
2267   if (ch == 10) printf("\n"); else printf("%c", (char)ch);
2268 }
2269
2270 // XEMIT
2271 // ( n -- )
2272 UFWORD(XEMIT) {
2273   uint32_t ch = ufoPop()&0xffU;
2274   printf("%c", (ch < 32 || ch == 127 ? '?' : (char)ch));
2275   ufoLastEmitWasCR = 0;
2276 }
2277
2278 // CR
2279 // ( -- )
2280 UFWORD(CR) {
2281   printf("\n");
2282   ufoLastEmitWasCR = 1;
2283 }
2284
2285 // SPACE
2286 // ( -- )
2287 UFWORD(SPACE) {
2288   printf(" ");
2289   ufoLastEmitWasCR = 0;
2290 }
2291
2292 // SPACES
2293 // ( n -- )
2294 UFWORD(SPACES) {
2295   int32_t n = (int32_t)ufoPop();
2296   while (n-- > 0) printf(" ");
2297   ufoLastEmitWasCR = 0;
2298 }
2299
2300 // ENDCR
2301 // ( -- )
2302 UFWORD(ENDCR) {
2303   if (!ufoLastEmitWasCR) {
2304     printf("\n");
2305     ufoLastEmitWasCR = 1;
2306   }
2307 }
2308
2309 // LASTCR?
2310 // ( -- bool )
2311 UFWORD(LASTCRQ) {
2312   ufoPushBool(ufoLastEmitWasCR);
2313 }
2314
2315 // LASTCR!
2316 // ( bool -- )
2317 UFWORD(LASTCRSET) {
2318   ufoLastEmitWasCR = !!ufoPop();
2319 }
2320
2321 // TYPE
2322 // ( addr count -- )
2323 UFWORD(TYPE) {
2324   int32_t count = (int32_t)ufoPop();
2325   uint32_t addr = ufoPop();
2326   while (count-- > 0) {
2327     const uint8_t ch = ufoImgGetU8(addr++)&0xffU;
2328     ufoPush(ch);
2329     UFCALL(EMIT);
2330   }
2331 }
2332
2333 // XTYPE
2334 // ( addr count -- )
2335 UFWORD(XTYPE) {
2336   int32_t count = (int32_t)ufoPop();
2337   uint32_t addr = ufoPop();
2338   while (count-- > 0) {
2339     const uint8_t ch = ufoImgGetU8(addr++)&0xffU;
2340     ufoPush(ch);
2341     UFCALL(XEMIT);
2342   }
2343 }
2344
2345 // (")
2346 UFWORD(STRQ_PAREN) {
2347   const uint32_t count = ufoImgGetU32(ufoIP++);
2348   ufoPush(ufoIP);
2349   if (count > 0x7fffffffU) ufoPush(0); else ufoPush(count);
2350   ufoIP += count;
2351 }
2352
2353 // (.")
2354 UFWORD(STRDOTQ_PAREN) {
2355   const uint32_t count = ufoImgGetU32(ufoIP++);
2356   ufoPush(ufoIP);
2357   ufoPush(count);
2358   ufoIP += count;
2359   UFCALL(TYPE);
2360 }
2361
2362
2363 //==========================================================================
2364 //
2365 //  ufoNTWordAddrCount
2366 //
2367 //==========================================================================
2368 static UForthWord *ufoNTWordAddrCount (void) {
2369   uint32_t count = ufoPop();
2370   uint32_t addr = ufoPop();
2371   UForthWord *fw = ufoNFind(addr, count);
2372   if (!fw) {
2373     UFCALL(SPACE); ufoPush(addr); ufoPush(count); UFCALL(XTYPE);
2374     printf(" -- wut?\n"); ufoLastEmitWasCR = 1;
2375     ufoFatal("unknown UFO word");
2376   }
2377   return fw;
2378 }
2379
2380
2381 // ////////////////////////////////////////////////////////////////////////// //
2382 // number printing
2383
2384 //==========================================================================
2385 //
2386 //  ufoPrintNumber
2387 //
2388 //==========================================================================
2389 static char *ufoPrintNumber (uint32_t v, int sign) {
2390   static char buf[64];
2391   size_t bufpos = sizeof(buf);
2392   buf[--bufpos] = 0;
2393   int64_t n = (sign ? (int64_t)(int32_t)v : (int64_t)(uint32_t)v);
2394   const char sch = (n < 0 ? '-' : 0);
2395   if (n < 0) n = -n;
2396   int base = ufoImgGetU32(ufoBASEaddr);
2397   if (base < 2 || base > 36) { snprintf(buf, sizeof(buf), "%s", "invalid-base"); return buf; }
2398   do {
2399     if (bufpos == 0) ufoFatal("number too long");
2400     char ch = '0'+(char)(n%base);
2401     if (ch > '9') ch += 7;
2402     buf[--bufpos] = ch;
2403   } while ((n /= base) != 0);
2404   if (bufpos != 0 && sch) buf[--bufpos] = sch;
2405   return buf+bufpos;
2406 }
2407
2408
2409 // .
2410 // ( n -- )
2411 UFWORD(DOT) {
2412   int32_t v = (int32_t)ufoPop();
2413   printf("%s ", ufoPrintNumber(v, 1));
2414 }
2415
2416 // U.
2417 // ( n -- )
2418 UFWORD(UDOT) {
2419   uint32_t v = ufoPop();
2420   printf("%s ", ufoPrintNumber(v, 0));
2421 }
2422
2423 // .R
2424 // ( n width -- )
2425 UFWORD(DOTR) {
2426   int32_t wdt = (int32_t)ufoPop();
2427   int32_t v = (int32_t)ufoPop();
2428   char *s = ufoPrintNumber(v, 1);
2429   int32_t slen = (int32_t)strlen(s);
2430   while (slen < wdt) { printf(" "); ++slen; }
2431   printf("%s", s);
2432 }
2433
2434 // U.R
2435 // ( n width -- )
2436 UFWORD(UDOTR) {
2437   int32_t wdt = (int32_t)ufoPop();
2438   int32_t v = (int32_t)ufoPop();
2439   char *s = ufoPrintNumber(v, 0);
2440   int32_t slen = (int32_t)strlen(s);
2441   while (slen < wdt) { printf(" "); ++slen; }
2442   printf("%s", s);
2443 }
2444
2445
2446 // ////////////////////////////////////////////////////////////////////////// //
2447 // simple math
2448
2449 // NEGATE
2450 // ( a -- -a )
2451 UFWORD(NEGATE) {
2452   const uint32_t a = ufoPop();
2453   ufoPush((~a)+1u);
2454 }
2455
2456 // +
2457 // ( a b -- a+b )
2458 UFWORD(PLUS) {
2459   const uint32_t b = ufoPop();
2460   const uint32_t a = ufoPop();
2461   ufoPush(a+b);
2462 }
2463
2464 // -
2465 // ( a b -- a-b )
2466 UFWORD(MINUS) {
2467   const uint32_t b = ufoPop();
2468   const uint32_t a = ufoPop();
2469   ufoPush(a-b);
2470 }
2471
2472 // *
2473 // ( a b -- a*b )
2474 UFWORD(MUL) {
2475   const int32_t b = (int32_t)ufoPop();
2476   const int32_t a = (int32_t)ufoPop();
2477   ufoPush((uint32_t)(a*b));
2478 }
2479
2480 // U*
2481 // ( a b -- a*b )
2482 UFWORD(UMUL) {
2483   const uint32_t b = ufoPop();
2484   const uint32_t a = ufoPop();
2485   ufoPush((uint32_t)(a*b));
2486 }
2487
2488 // /
2489 // ( a b -- a/b )
2490 UFWORD(DIV) {
2491   const int32_t b = (int32_t)ufoPop();
2492   const int32_t a = (int32_t)ufoPop();
2493   if (b == 0) ufoFatal("UFO division by zero");
2494   ufoPush((uint32_t)(a/b));
2495 }
2496
2497 // U*
2498 // ( a b -- a/b )
2499 UFWORD(UDIV) {
2500   const uint32_t b = ufoPop();
2501   const uint32_t a = ufoPop();
2502   if (b == 0) ufoFatal("UFO division by zero");
2503   ufoPush((uint32_t)(a/b));
2504 }
2505
2506 // MOD
2507 // ( a b -- a%b )
2508 UFWORD(MOD) {
2509   const int32_t b = (int32_t)ufoPop();
2510   const int32_t a = (int32_t)ufoPop();
2511   if (b == 0) ufoFatal("UFO division by zero");
2512   ufoPush((uint32_t)(a%b));
2513 }
2514
2515 // UMOD
2516 // ( a b -- a%b )
2517 UFWORD(UMOD) {
2518   const uint32_t b = ufoPop();
2519   const uint32_t a = ufoPop();
2520   if (b == 0) ufoFatal("UFO division by zero");
2521   ufoPush((uint32_t)(a%b));
2522 }
2523
2524 // /MOD
2525 // ( a b -- a/b, a%b )
2526 UFWORD(DIVMOD) {
2527   const int32_t b = (int32_t)ufoPop();
2528   const int32_t a = (int32_t)ufoPop();
2529   if (b == 0) ufoFatal("UFO division by zero");
2530   ufoPush((uint32_t)(a/b));
2531   ufoPush((uint32_t)(a%b));
2532 }
2533
2534 // U/MOD
2535 // ( a b -- a/b, a%b )
2536 UFWORD(UDIVMOD) {
2537   const uint32_t b = ufoPop();
2538   const uint32_t a = ufoPop();
2539   if (b == 0) ufoFatal("UFO division by zero");
2540   ufoPush((uint32_t)(a/b));
2541   ufoPush((uint32_t)(a%b));
2542 }
2543
2544
2545 // ////////////////////////////////////////////////////////////////////////// //
2546 // simple logic
2547
2548 // <
2549 // ( a b -- a<b )
2550 UFWORD(LESS) {
2551   const int32_t b = (int32_t)ufoPop();
2552   const int32_t a = (int32_t)ufoPop();
2553   ufoPushBool(a < b);
2554 }
2555
2556 // >
2557 // ( a b -- a>b )
2558 UFWORD(GREAT) {
2559   const int32_t b = (int32_t)ufoPop();
2560   const int32_t a = (int32_t)ufoPop();
2561   ufoPushBool(a > b);
2562 }
2563
2564 // <=
2565 // ( a b -- a<=b )
2566 UFWORD(LESSEQU) {
2567   const int32_t b = (int32_t)ufoPop();
2568   const int32_t a = (int32_t)ufoPop();
2569   ufoPushBool(a <= b);
2570 }
2571
2572 // >=
2573 // ( a b -- a>=b )
2574 UFWORD(GREATEQU) {
2575   const int32_t b = (int32_t)ufoPop();
2576   const int32_t a = (int32_t)ufoPop();
2577   ufoPushBool(a >= b);
2578 }
2579
2580 // U<
2581 // ( a b -- a<b )
2582 UFWORD(ULESS) {
2583   const uint32_t b = ufoPop();
2584   const uint32_t a = ufoPop();
2585   ufoPushBool(a < b);
2586 }
2587
2588 // U>
2589 // ( a b -- a>b )
2590 UFWORD(UGREAT) {
2591   const uint32_t b = ufoPop();
2592   const uint32_t a = ufoPop();
2593   ufoPushBool(a > b);
2594 }
2595
2596 // U<=
2597 // ( a b -- a<=b )
2598 UFWORD(ULESSEQU) {
2599   const uint32_t b = ufoPop();
2600   const uint32_t a = ufoPop();
2601   ufoPushBool(a <= b);
2602 }
2603
2604 // U>=
2605 // ( a b -- a>=b )
2606 UFWORD(UGREATEQU) {
2607   const uint32_t b = ufoPop();
2608   const uint32_t a = ufoPop();
2609   ufoPushBool(a >= b);
2610 }
2611
2612 // =
2613 // ( a b -- a=b )
2614 UFWORD(EQU) {
2615   const uint32_t b = ufoPop();
2616   const uint32_t a = ufoPop();
2617   ufoPushBool(a == b);
2618 }
2619
2620 // <>
2621 // ( a b -- a<>b )
2622 UFWORD(NOTEQU) {
2623   const uint32_t b = ufoPop();
2624   const uint32_t a = ufoPop();
2625   ufoPushBool(a != b);
2626 }
2627
2628 // WITHIN
2629 // ( value a b -- value>=a&&value<b )
2630 UFWORD(WITHIN) {
2631   const int32_t value = (int32_t)ufoPop();
2632   const int32_t b = (int32_t)ufoPop();
2633   const int32_t a = (int32_t)ufoPop();
2634   ufoPushBool(value >= a && value < b);
2635 }
2636
2637 // UWITHIN
2638 // ( value a b -- value>=a&&value<b )
2639 UFWORD(UWITHIN) {
2640   const uint32_t value = ufoPop();
2641   const uint32_t b = ufoPop();
2642   const uint32_t a = ufoPop();
2643   ufoPushBool(value >= a && value < b);
2644 }
2645
2646 // BOUNDS?
2647 // ( value a b -- value>=a&&value<=b )
2648 // unsigned compare
2649 UFWORD(BOUNDSQ) {
2650   const uint32_t value = ufoPop();
2651   const uint32_t b = ufoPop();
2652   const uint32_t a = ufoPop();
2653   ufoPushBool(value >= a && value <= b);
2654 }
2655
2656 // NOT
2657 // ( a -- !a )
2658 UFWORD(NOT) {
2659   const uint32_t a = ufoPop();
2660   ufoPushBool(!a);
2661 }
2662
2663 // NOTNOT
2664 // ( a -- !!a )
2665 UFWORD(NOTNOT) {
2666   const uint32_t a = ufoPop();
2667   ufoPushBool(a);
2668 }
2669
2670 // LAND
2671 // ( a b -- a&&b )
2672 UFWORD(LOGAND) {
2673   const uint32_t b = ufoPop();
2674   const uint32_t a = ufoPop();
2675   ufoPushBool(a && b);
2676 }
2677
2678 // LOR
2679 // ( a b -- a||b )
2680 UFWORD(LOGOR) {
2681   const uint32_t b = ufoPop();
2682   const uint32_t a = ufoPop();
2683   ufoPushBool(a || b);
2684 }
2685
2686 // AND
2687 // ( a b -- a&b )
2688 UFWORD(AND) {
2689   const uint32_t b = ufoPop();
2690   const uint32_t a = ufoPop();
2691   ufoPush(a&b);
2692 }
2693
2694 // OR
2695 // ( a b -- a|b )
2696 UFWORD(OR) {
2697   const uint32_t b = ufoPop();
2698   const uint32_t a = ufoPop();
2699   ufoPush(a|b);
2700 }
2701
2702 // XOR
2703 // ( a b -- a^b )
2704 UFWORD(XOR) {
2705   const uint32_t b = ufoPop();
2706   const uint32_t a = ufoPop();
2707   ufoPush(a^b);
2708 }
2709
2710 // BITNOT
2711 // ( a -- ~a )
2712 UFWORD(BITNOT) {
2713   const uint32_t a = ufoPop();
2714   ufoPush(~a);
2715 }
2716
2717 UFWORD(ONEPLUS) { uint32_t n = ufoPop(); ufoPush(n+1u); }
2718 UFWORD(ONEMINUS) { uint32_t n = ufoPop(); ufoPush(n-1u); }
2719 UFWORD(TWOPLUS) { uint32_t n = ufoPop(); ufoPush(n+2u); }
2720 UFWORD(TWOMINUS) { uint32_t n = ufoPop(); ufoPush(n-2u); }
2721 UFWORD(THREEPLUS) { uint32_t n = ufoPop(); ufoPush(n+3u); }
2722 UFWORD(THREEMINUS) { uint32_t n = ufoPop(); ufoPush(n-3u); }
2723 UFWORD(FOURPLUS) { uint32_t n = ufoPop(); ufoPush(n+4u); }
2724 UFWORD(FOURMINUS) { uint32_t n = ufoPop(); ufoPush(n-4u); }
2725 UFWORD(ONESHL) { uint32_t n = ufoPop(); ufoPush(n*2u); }
2726 UFWORD(ONESHR) { uint32_t n = ufoPop(); ufoPush(n/2u); }
2727
2728 UFWORD(LSHIFT) { uint32_t c = ufoPop(); uint32_t n = ufoPop(); n = (c > 31u ? 0u : n<<c); ufoPush(n); }
2729 UFWORD(RSHIFT) { uint32_t c = ufoPop(); uint32_t n = ufoPop(); n = (c > 31u ? 0u : n>>c); ufoPush(n); }
2730
2731
2732
2733 // ////////////////////////////////////////////////////////////////////////// //
2734 // compiler
2735
2736 // LITERAL
2737 // ( n -- n )
2738 UFWORD(LITERAL) {
2739   if (ufoIsCompiling()) {
2740     ufoCompileLiteral(ufoPop());
2741   }
2742 }
2743
2744 // STR-UNESCAPE
2745 // ( addr count -- addr count )
2746 UFWORD(STR_UNESCAPE) {
2747   uint32_t count = (int32_t)ufoPop();
2748   const uint32_t addr = ufoPeek();
2749   const uint32_t eaddr = addr + count;
2750   uint32_t caddr = addr;
2751   uint32_t daddr = addr;
2752   while (caddr != eaddr) {
2753     uint8_t ch = ufoImgGetU8(caddr); caddr += 1;
2754     if (ch == '\\' && caddr != eaddr) {
2755       ch = ufoImgGetU8(caddr); caddr += 1;
2756       switch (ch) {
2757         case 'r': ch = '\r'; break;
2758         case 'n': ch = '\n'; break;
2759         case 't': ch = '\t'; break;
2760         case 'e': ch = '\x1b'; break;
2761         case '`': ch = '"'; break; // special escape to insert double-quoted
2762         case '"': ch = '"'; break;
2763         case '\'': ch = '\''; break;
2764         case '\\': ch = '\\'; break;
2765         case 'x': case 'X':
2766           if (eaddr - daddr >= 1) {
2767             const int dg0 = digitInBase((char)(ufoImgGetU8(caddr + 1)), 16);
2768             if (dg0 < 0) ufoFatal("invalid hex string escape");
2769             if (eaddr - daddr >= 2) {
2770               const int dg1 = digitInBase((char)(ufoImgGetU8(caddr + 2)), 16);
2771               if (dg1 < 0) ufoFatal("invalid hex string escape");
2772               ch = (uint8_t)(dg0 * 16 + dg1);
2773               caddr += 2;
2774             } else {
2775               ch = (uint8_t)dg0;
2776               caddr += 1;
2777             }
2778           } else {
2779             ufoFatal("invalid hex string escape");
2780           }
2781           break;
2782         default: ufoFatal("invalid string escape");
2783       }
2784     }
2785     if (caddr != daddr) ufoImgPutU32(daddr, ch);
2786     daddr += 1;
2787   }
2788   if (daddr < eaddr) ufoImgPutU32(daddr, 0);
2789   ufoPush(daddr - addr);
2790 }
2791
2792 // STRLITERAL
2793 // I:( addr count -- addr count )
2794 // R:( -- addr count )
2795 // C:( addr count -- )
2796 // addr *MUST* be HERE+1
2797 UFWORD(STRLITERAL) {
2798   UFCALL(STR_UNESCAPE);
2799   if (ufoIsCompiling()) {
2800     uint32_t count = ufoPop();
2801     uint32_t addr = ufoPop();
2802     // compile
2803     if (count > 0xffffU) ufoFatal("UFO string too long");
2804     if (addr - 1u != ufoImageUsed) {
2805       ufoFatal("invalid call to UFO word 'STRLITERAL'");
2806     } else {
2807       ufoImgPutU32(addr - 1u, count);
2808       ufoImageUsed += count + 1u;
2809     }
2810   }
2811 }
2812
2813 // "
2814 // ( -- addr count )
2815 UFWORD(STRQ) {
2816   if (ufoIsCompiling()) ufoCompileCompilerWord("(\")");
2817   ufoPush(34); UFCALL(PARSE_TO_HERE);
2818   if (ufoPop()) {
2819     UFCALL(STRLITERAL);
2820     if (ufoIsInterpreting()) {
2821       // copy to PAD
2822       uint32_t dest = ufoPadAddr();
2823       uint32_t count = ufoPop();
2824       uint32_t src = ufoPop();
2825       if (dest >= src && dest <= src + count) ufoFatal("something's wrong!");
2826       if (count > 1022) ufoFatal("UFO string too long");
2827       ufoImgPutU32(dest, count);
2828       for (uint32_t n = 0; n < count; ++n) ufoImgPutU32(dest + n + 1, ufoImgGetU32(src + n));
2829       ufoImgPutU32(dest + count + 1, 0);
2830       ufoPush(dest + 1);
2831       ufoPush(count);
2832     }
2833   } else {
2834     ufoFatal("string literal expected");
2835   }
2836 }
2837
2838 // ."
2839 // ( -- )
2840 UFWORD(STRDOTQ) {
2841   if (ufoIsCompiling()) ufoCompileCompilerWord("(.\")");
2842   ufoPush(34); UFCALL(PARSE_TO_HERE);
2843   if (ufoPop()) {
2844     UFCALL(STRLITERAL);
2845     if (ufoIsInterpreting()) {
2846       UFCALL(TYPE);
2847     }
2848   } else {
2849     ufoFatal("string literal expected");
2850   }
2851 }
2852
2853
2854 // ////////////////////////////////////////////////////////////////////////// //
2855 // interpreter
2856
2857
2858 //==========================================================================
2859 //
2860 //  ufoGetInCharAutoLineAdvance
2861 //
2862 //==========================================================================
2863 static uint8_t ufoGetInCharAutoLineAdvance (void) {
2864   uint8_t ch;
2865   do {
2866     ch = ufoGetInChar();
2867     if (ch == 0) ufoLoadNextLine(0);
2868   } while (ch == 0);
2869   return ch;
2870 }
2871
2872
2873 // "\" comment
2874 UFWORD(COMMENTEOL) {
2875   // just skip the whole line
2876   while (ufoGetInChar() != 0) {}
2877 }
2878
2879 // "( ...)" comment
2880 UFWORD(COMMENTPAREN) {
2881   uint32_t ch = 0;
2882   do { ch = ufoGetInCharAutoLineAdvance(); } while (ch != ')');
2883 }
2884
2885 // "(*" multiline comment
2886 UFWORD(COMMENTML) {
2887   uint32_t prevch = 0, ch = 0;
2888   do {
2889     prevch = ch;
2890     ch = ufoGetInCharAutoLineAdvance();
2891   } while (prevch != '*' || ch != ')');
2892 }
2893
2894 // "((" multiline comment
2895 UFWORD(COMMENTML_NESTED) {
2896   int level = 1;
2897   uint32_t prevch = 0, ch = 0;
2898   do {
2899     prevch = ch;
2900     ch = ufoGetInCharAutoLineAdvance();
2901     if (prevch == '(' && ch == '(') { ch = 0; level += 1; }
2902     else if (prevch == ')' && ch == ')') { ch = 0; level -= 1; }
2903   } while (level != 0);
2904 }
2905
2906
2907 // NFIND ( addr count -- cfa TRUE | 0 )
2908 // find native/zx word
2909 //   onlynativeimmflag:
2910 //     0: look for ZX word only if native word not found
2911 //    !0: look for ZX word only if native word not found, or if it is not immediate
2912 //   666: prefer ZX words (used in `COMPILE`)
2913 // returned ZX CFA has `UFO_ZX_ADDR_BIT` set
2914 //
2915 // native mode:
2916 //   look for native word
2917 //   if there is none, look for zx word
2918 // zx mode:
2919 //   look for native word
2920 //   STATE == 0: (interpreting)
2921 //     if there is none, look for zx word
2922 //   STATE != 0: (compiling)
2923 //     if no native word, or native word is not immediate, look for zx word
2924 UFWORD(NFIND) {
2925   const uint32_t count = ufoPop();
2926   const uint32_t addr = ufoPop();
2927   UForthWord *fw = ufoNFind(addr, count);
2928   if (fw != NULL) {
2929     ufoPush(fw->cfaidx);
2930     ufoPushBool(1);
2931   } else {
2932     // nothing
2933     ufoPushBool(0);
2934   }
2935 }
2936
2937 // convert number from addrl+1
2938 // returns address of the first inconvertible char
2939 // (XNUMBER) ( addr count -- num TRUE / FALSE )
2940 UFWORD(XNUMBER) {
2941   uint32_t count = ufoPop();
2942   uint32_t addr = ufoPop();
2943   uint32_t n = 0;
2944   int base = 0;
2945   int xbase = (int)ufoImgGetU8(ufoBASEaddr);
2946
2947   // special-based numbers
2948   if (count >= 3 && ufoImgGetU8(addr) == '0') {
2949     switch (ufoImgGetU8(addr + 1)) {
2950       case 'x': case 'X': base = 16; break;
2951       case 'o': case 'O': base = 8; break;
2952       case 'b': case 'B': base = 2; break;
2953       case 'd': case 'D': base = 10; break;
2954       default: break;
2955     }
2956     if (base) { addr += 2; count -= 2; }
2957   } else if (count >= 2 && ufoImgGetU8(addr) == '$') {
2958     base = 16;
2959     addr += 1; count -= 1;
2960   } else if (count >= 2 && ufoImgGetU8(addr) == '#') {
2961     base = 16;
2962     addr += 1; count -= 1;
2963   } else if (count >= 2 && ufoImgGetU8(addr) == '%') {
2964     base = 2;
2965     addr += 1; count -= 1;
2966   } else if (count >= 3 && ufoImgGetU8(addr) == '&') {
2967     switch (ufoImgGetU8(addr + 1)) {
2968       case 'h': case 'H': base = 16; break;
2969       case 'o': case 'O': base = 8; break;
2970       case 'b': case 'B': base = 2; break;
2971       case 'd': case 'D': base = 10; break;
2972       default: break;
2973     }
2974     if (base) { addr += 2; count -= 2; }
2975   } else if (xbase < 12 && count > 2 && toUpper(ufoImgGetU8(addr + count - 1)) == 'B') {
2976     base = 2;
2977     count -= 1;
2978   } else if (xbase < 18 && count > 2 && toUpper(ufoImgGetU8(addr + count - 1)) == 'H') {
2979     base = 16;
2980     count -= 1;
2981   } else if (xbase < 25 && count > 2 && toUpper(ufoImgGetU8(addr + count - 1)) == 'O') {
2982     base = 8;
2983     count -= 1;
2984   }
2985
2986
2987   // in current base?
2988   if (!base) base = xbase;
2989
2990   if (count == 0 || base < 1 || base > 36) {
2991     ufoPushBool(0);
2992     return;
2993   }
2994
2995   while (count != 0) {
2996     const uint32_t ch = ufoImgGetU8(addr);
2997     if (ch != '_') {
2998       const int dig = digitInBase((char)ch, (int)base);
2999       if (dig < 0) break;
3000       uint32_t nc = n * (uint32_t)base + (uint32_t)dig;
3001       if (nc < n) break;
3002       n = nc;
3003     }
3004     addr += 1; count -= 1;
3005   }
3006
3007   if (count == 0) {
3008     ufoPush(n);
3009     ufoPushBool(1);
3010   } else {
3011     ufoPushBool(0);
3012   }
3013 }
3014
3015
3016 // INTERPRET
3017 UFWORD(INTERPRET) {
3018   for (;;) {
3019     uint32_t len, addr;
3020     do {
3021       UFCALL(PARSE_NAME);  // ( addr count )
3022       len = ufoPop();
3023       addr = ufoPop();
3024       if (len == 0) {
3025         // end of input buffer; read next line
3026         #ifdef UFO_DEBUG_INLCUDE
3027         printf("*** NEW LINE ***\n");
3028         #endif
3029         ufoLoadNextLine(1); // cross includes
3030       } else {
3031         #ifdef UFO_DEBUG_INLCUDE
3032         printf("WORD: %u %u [", addr, len);
3033         ufoPush(addr); ufoPush(len); UFCALL(XTYPE); printf("]"); UFCALL(CR);
3034         #endif
3035       }
3036     } while (len == 0);
3037     // stack: empty
3038
3039     // check for local
3040     // HACK: allow access to locals from code blocks
3041     // HACK: this will break badly if we'll pass such code blocks outside of the word
3042     if (len > 1 && len < 128 &&
3043         ufoInColon > 0 && ufoIsCompiling() && ufoLocals != NULL &&
3044         ufoImgGetU8(addr) == ':')
3045     {
3046       static char name[257];
3047       int wantStore;
3048       for (uint32_t f = 0; f < len; f += 1) name[f] = ufoImgGetU8(addr + f);
3049       name[len] = 0;
3050       UForthLocRecord *loc = ufoFindLocal(name, &wantStore);
3051       if (loc != NULL) {
3052         char lwordn[64];
3053         snprintf(lwordn, sizeof(lwordn), "(LOCAL%c-%u)",
3054                  (wantStore ? '!' : '@'), loc->lidx);
3055         UForthWord *lfw = ufoFindWordCompiler(lwordn);
3056         if (lfw != NULL) {
3057           ufoCompileWordCFA(lfw);
3058         } else {
3059           ufoPush(loc->lidx);
3060           UFCALL(LITERAL);
3061           if (wantStore) {
3062             ufoCompileCompilerWord("(LOCAL!)");
3063           } else {
3064             ufoCompileCompilerWord("(LOCAL@)");
3065           }
3066         }
3067         continue;
3068       }
3069     }
3070
3071     // find in dictionary
3072     ufoPush(addr); ufoPush(len);
3073     UFCALL(NFIND); // ( cfa TRUE / FALSE )
3074     if (ufoPop()) {
3075       // word found, compile/execute
3076       UForthWord *fw = UFO_GET_NATIVE_CFA(ufoPop());
3077       if (!UFW_IS_IMM(fw) && ufoIsCompiling()) {
3078         // compile
3079         ufoCompileWordCFA(fw);
3080       } else {
3081         // execute
3082         ufoExecuteNativeWordInVM(fw);
3083       }
3084     } else {
3085       // word not found, try to parse a number
3086       int neg = 0;
3087       if (ufoImgGetU8(addr) == '-') { neg = -1; ++addr; --len; }
3088       else if (ufoImgGetU8(addr) == '+') { neg = 1; ++addr; --len; }
3089       ufoPush(addr); // address
3090       ufoPush(len); // address
3091       UFCALL(XNUMBER);
3092       // check if parsed successfully
3093       if (ufoPop()) {
3094         // valid number
3095         uint32_t n = ufoPop();
3096         if (neg < 0) n = (~n)+1u;
3097         ufoPush(n);
3098         UFCALL(LITERAL);
3099       } else {
3100         // something wicked this way comes
3101         if (neg) { --addr; ++len; }
3102         UFCALL(SPACE); ufoPush(addr); ufoPush(len); UFCALL(XTYPE);
3103         printf(" -- wut?\n"); ufoLastEmitWasCR = 1;
3104         ufoFatal("unknown word");
3105       }
3106     }
3107   }
3108 }
3109
3110
3111 // ////////////////////////////////////////////////////////////////////////// //
3112 // more compiler words
3113
3114 // ?EXEC
3115 UFWORD(QEXEC) {
3116   if (ufoIsCompiling()) ufoFatal("expecting execution mode");
3117 }
3118
3119 // ?COMP
3120 UFWORD(QCOMP) {
3121   if (ufoIsInterpreting()) ufoFatal("expecting compilation mode");
3122 }
3123
3124 // ?PAIRS
3125 // ( ocond cond -- )
3126 UFWORD(QPAIRS) {
3127   if (ufoIsInterpreting()) ufoFatal("expecting compilation mode");
3128   const uint32_t cond = ufoPop();
3129   const uint32_t ocond = ufoPop();
3130   if (cond != ocond) ufoFatal("unbalanced structured code");
3131 }
3132
3133 // COMPILE
3134 UFWORD(COMPILE_IMM) {
3135   if (ufoIsInterpreting()) ufoFatal("cannot call `COMPILE` from interpreter");
3136   UFCALL(PARSE_NAME);
3137   if (ufoPeek()) {
3138     UFCALL(NFIND); // ( cfa TRUE / FALSE )
3139     if (ufoPop()) {
3140       uint32_t cfa = UFO_ENSURE_NATIVE_CFA(ufoPop());
3141       ufoCompileLiteral(cfa);
3142       ufoCompileForthWord(",");
3143     } else {
3144       UFCALL(HERE); UFCALL(COUNT); UFCALL(SPACE); UFCALL(XTYPE);
3145       printf(" -- wut?"); UFCALL(CR);
3146       ufoFatal("unknown word");
3147     }
3148   } else {
3149     ufoFatal("word name expected");
3150   }
3151 }
3152
3153 // [COMPILE]
3154 UFWORD(XCOMPILE_IMM) {
3155   if (ufoIsInterpreting()) ufoFatal("cannot call `[COMPILE]` from interpreter");
3156   UFCALL(PARSE_NAME);
3157   if (ufoPeek()) {
3158     UFCALL(NFIND); // ( cfa TRUE / FALSE )
3159     if (ufoPop()) {
3160       UForthWord *fw = UFO_GET_NATIVE_CFA(ufoPop());
3161       ufoCompileWordCFA(fw);
3162     } else {
3163       UFCALL(HERE); UFCALL(COUNT); UFCALL(SPACE); UFCALL(XTYPE);
3164       printf(" -- wut?"); UFCALL(CR);
3165       ufoFatal("unknown word");
3166     }
3167   } else {
3168     ufoFatal("word name expected");
3169   }
3170 }
3171
3172 // [']
3173 UFWORD(XTICK_IMM) {
3174   UFCALL(PARSE_NAME);
3175   if (ufoPeek()) {
3176     UFCALL(NFIND); // ( cfa TRUE / FALSE )
3177     if (ufoPop()) {
3178       uint32_t cfa = UFO_ENSURE_NATIVE_CFA(ufoPop());
3179       if (ufoIsCompiling()) {
3180         ufoCompileLiteral(cfa);
3181       } else {
3182         ufoPush(cfa);
3183       }
3184     } else {
3185       UFCALL(HERE); UFCALL(COUNT); UFCALL(SPACE); UFCALL(XTYPE);
3186       printf(" -- wut?"); UFCALL(CR);
3187       ufoFatal("unknown word");
3188     }
3189   } else {
3190     ufoFatal("word name expected");
3191   }
3192 }
3193
3194 // ['PFA]
3195 UFWORD(XTICKPFA_IMM) {
3196   UFCALL(PARSE_NAME);
3197   if (ufoPeek()) {
3198     UFCALL(NFIND); // ( cfa TRUE / FALSE )
3199     if (ufoPop()) {
3200       uint32_t cfa = ufoPop();
3201       UForthWord *fw = UFO_GET_NATIVE_CFA(cfa);
3202       if (ufoIsCompiling()) {
3203         ufoCompileLiteral(fw->pfa);
3204       } else {
3205         ufoPush(fw->pfa);
3206       }
3207     } else {
3208       UFCALL(HERE); UFCALL(COUNT); UFCALL(SPACE); UFCALL(XTYPE);
3209       printf(" -- wut?"); UFCALL(CR);
3210       ufoFatal("unknown word");
3211     }
3212   } else {
3213     ufoFatal("word name expected");
3214   }
3215 }
3216
3217
3218 // '
3219 UFWORD(TICK_IMM) {
3220   UFCALL(QEXEC);
3221   UFCALL(PARSE_NAME);
3222   if (ufoPeek()) {
3223     UFCALL(NFIND); // ( cfa TRUE / FALSE )
3224     if (ufoPop()) {
3225       uint32_t cfa = UFO_ENSURE_NATIVE_CFA(ufoPop());
3226       ufoPush(cfa);
3227     } else {
3228       UFCALL(HERE); UFCALL(COUNT); UFCALL(SPACE); UFCALL(XTYPE);
3229       printf(" -- wut?"); UFCALL(CR);
3230       ufoFatal("unknown word");
3231     }
3232   } else {
3233     ufoFatal("word name expected");
3234   }
3235 }
3236
3237 // 'PFA
3238 UFWORD(TICKPFA_IMM) {
3239   UFCALL(QEXEC);
3240   UFCALL(PARSE_NAME);
3241   if (ufoPeek()) {
3242     UFCALL(NFIND); // ( cfa TRUE / FALSE )
3243     if (ufoPop()) {
3244       uint32_t cfa = ufoPop();
3245       UForthWord *fw = UFO_GET_NATIVE_CFA(cfa);
3246       ufoPush(fw->pfa);
3247     } else {
3248       UFCALL(HERE); UFCALL(COUNT); UFCALL(SPACE); UFCALL(XTYPE);
3249       printf(" -- wut?"); UFCALL(CR);
3250       ufoFatal("unknown word");
3251     }
3252   } else {
3253     ufoFatal("word name expected");
3254   }
3255 }
3256
3257
3258 // COMP-BACK
3259 // ( addr -- )
3260 UFWORD(COMP_BACK) {
3261   ufoImgEmitU32(ufoPop());
3262 }
3263
3264 // COMP-FWD
3265 // ( addr -- )
3266 // calculate the forward branch offset from addr to HERE and put it into the addr
3267 UFWORD(COMP_FWD) {
3268   UFCALL(HERE);
3269   const uint32_t here = ufoPop();
3270   const uint32_t addr = ufoPop();
3271   ufoImgPutU32(addr, here);
3272 }
3273
3274
3275 // ////////////////////////////////////////////////////////////////////////// //
3276 // locals
3277
3278 static int ufoIsLocalsEnter (UForthWord *ww) {
3279   int res = 0;
3280   if (ww != NULL && ww->pfa + 1 < ufoImageUsed) {
3281     UForthWord *fw = ufoAlwaysWordCompiler("(L-ENTER)");
3282     uint32_t w = ufoImgGetU32(ww->pfa);
3283     res = (w == fw->cfaidx);
3284   }
3285   return res;
3286 }
3287
3288
3289 //==========================================================================
3290 //
3291 //  ufoPrepareEnter
3292 //
3293 //==========================================================================
3294 static uint32_t ufoPrepareEnter (UForthWord *ww) {
3295   uint32_t res = 0;
3296   if (!ufoIsCompiling()) ufoFatal("compile mode expected");
3297   if (ufoInColon != 1) ufoFatal("must be in a word definition");
3298   if (ww->cfa != NULL) ufoFatal("wutafuck?");
3299   if (ww->pfa == ufoImageUsed) {
3300     ufoCompileCompilerWord("(L-ENTER)");
3301     ufoImgEmitU32(0);
3302   } else {
3303     UForthWord *fw = ufoAlwaysWordCompiler("(L-ENTER)");
3304     uint32_t w = ufoImgGetU32(ww->pfa);
3305     if (w != fw->cfaidx) ufoFatal("arg/local definition must be the first word");
3306     res = ufoImgGetU32(ww->pfa + 1);
3307   }
3308   return res;
3309 }
3310
3311
3312 //==========================================================================
3313 //
3314 //  ufoUpdateEnter
3315 //
3316 //==========================================================================
3317 UFO_FORCE_INLINE void ufoUpdateEnter (UForthWord *ww, uint32_t val) {
3318   ufoImgPutU32(ww->pfa + 1, val);
3319 }
3320
3321
3322 // (EXIT)
3323 UFWORD(PAR_EXIT) {
3324   ufoIP = ufoRPop();
3325   if (ufoRP < ufoRPTop) ufoFatal("return stack undeflow in (EXIT)");
3326   ufoStopVM = (ufoRP == ufoRPTop);
3327 }
3328
3329 // (L-ENTER)
3330 // ( loccount -- )
3331 UFWORD(PAR_LENTER) {
3332   // low byte of loccount is total number of locals
3333   // higt byte is the number of args
3334   uint32_t lcount = ufoImgGetU32(ufoIP); ufoIP += 1;
3335   uint32_t acount = (lcount >> 8)&0xff;
3336   lcount &= 0xff;
3337   if (lcount == 0 || lcount < acount) ufoFatal("invalid call to (L-ENTER)");
3338   if ((ufoLBP != 0 && ufoLBP >= ufoLP) || UFO_LSTACK_SIZE - ufoLP <= lcount + 2) {
3339     ufoFatal("out of locals stack");
3340   }
3341   uint32_t newbp;
3342   if (ufoLP == 0) { ufoLP = 1; newbp = 1; } else newbp = ufoLP;
3343   //fprintf(stderr, "LP: %u; LBP: %u; locs: %u; word: %s\n", ufoLP, ufoLBP, fw->locs, fw->name);
3344   ufoLStack[ufoLP] = ufoLBP; ufoLP += 1;
3345   ufoLBP = newbp; ufoLP += lcount;
3346   // and copy args
3347   newbp += acount;
3348   while (newbp != ufoLBP) {
3349     ufoLStack[newbp] = ufoPop();
3350     newbp -= 1;
3351   }
3352 }
3353
3354 // (L-LEAVE)
3355 UFWORD(PAR_LLEAVE) {
3356   if (ufoLBP == 0) ufoFatal("(L-LEAVE) with empty locals stack");
3357   if (ufoLBP >= ufoLP) ufoFatal("(L-LEAVE) broken locals stack");
3358   ufoLP = ufoLBP;
3359   ufoLBP = ufoLStack[ufoLBP];
3360 }
3361
3362 // EXIT
3363 UFWORD(EXIT_IMM) {
3364   if (ufoIsInterpreting()) ufoFatal("EXIT in interpreter?");
3365   if (ufoInColon == 1) {
3366     if (ufoColonWord->cfa != NULL) ufoFatal("invalid EXIT");
3367     if (ufoIsLocalsEnter(ufoColonWord)) ufoCompileCompilerWord("(L-LEAVE)");
3368   }
3369   ufoCompileCompilerWord("(EXIT)");
3370 }
3371
3372
3373 // IF
3374 UFWORD(IF) {
3375   UFCALL(QCOMP);
3376   ufoCompileCompilerWord("(0BRANCH)");
3377   UFCALL(HERE);
3378   ufoImgEmitU32(0);
3379   ufoPush(UFO_QPAIRS_IF);
3380 }
3381
3382 // IFNOT
3383 UFWORD(IFNOT) {
3384   UFCALL(QCOMP);
3385   ufoCompileCompilerWord("(TBRANCH)");
3386   UFCALL(HERE);
3387   ufoImgEmitU32(0);
3388   ufoPush(UFO_QPAIRS_IF);
3389 }
3390
3391 // ENDIF
3392 UFWORD(ENDIF) {
3393   UFCALL(QCOMP);
3394   ufoPush(UFO_QPAIRS_IF);
3395   UFCALL(QPAIRS);
3396   UFCALL(COMP_FWD);
3397 }
3398
3399 // ELSE
3400 UFWORD(ELSE) {
3401   UFCALL(QCOMP);
3402   ufoPush(UFO_QPAIRS_IF);
3403   UFCALL(QPAIRS);
3404   ufoCompileCompilerWord("(BRANCH)");
3405   UFCALL(HERE);
3406   ufoImgEmitU32(0);
3407   ufoSwap();
3408   ufoPush(UFO_QPAIRS_IF);
3409   UFCALL(ENDIF);
3410   ufoPush(UFO_QPAIRS_IF);
3411 }
3412
3413
3414 // DO
3415 UFWORD(DO) {
3416   UFCALL(QCOMP);
3417   ufoCompileCompilerWord("(DO)");
3418   UFCALL(HERE);
3419   ufoPush(UFO_QPAIRS_DO);
3420 }
3421
3422 // LOOP
3423 UFWORD(LOOP) {
3424   UFCALL(QCOMP);
3425   ufoPush(UFO_QPAIRS_DO);
3426   UFCALL(QPAIRS);
3427   ufoCompileCompilerWord("(LOOP)");
3428   UFCALL(COMP_BACK);
3429 }
3430
3431 // +LOOP
3432 UFWORD(PLOOP) {
3433   UFCALL(QCOMP);
3434   ufoPush(UFO_QPAIRS_DO);
3435   UFCALL(QPAIRS);
3436   ufoCompileCompilerWord("(+LOOP)");
3437   UFCALL(COMP_BACK);
3438 }
3439
3440
3441 // BEGIN
3442 UFWORD(BEGIN) {
3443   UFCALL(QCOMP);
3444   UFCALL(HERE);
3445   ufoPush(UFO_QPAIRS_BEGIN);
3446 }
3447
3448 static void ufoCommonUntil (const char *bword) {
3449   UFCALL(QCOMP);
3450   int wasWhile = 0;
3451   if (ufoPeek() == UFO_QPAIRS_WHILE) {
3452     ufoDrop();
3453     wasWhile = 1;
3454   } else {
3455     ufoPush(UFO_QPAIRS_BEGIN);
3456     UFCALL(QPAIRS);
3457     wasWhile = 0;
3458   }
3459   // first is begin addr
3460   ufoCompileCompilerWord(bword);
3461   UFCALL(COMP_BACK);
3462   if (wasWhile) {
3463     // then jumps to the end
3464     while (ufoPeek() != ~0U) { UFCALL(COMP_FWD); }
3465     ufoDrop();
3466   }
3467 }
3468
3469 // UNTIL
3470 UFWORD(UNTIL) { ufoCommonUntil("(0BRANCH)"); }
3471
3472 // NOT-UNTIL
3473 UFWORD(NOT_UNTIL) { ufoCommonUntil("(TBRANCH)"); }
3474
3475 // AGAIN
3476 UFWORD(AGAIN) { ufoCommonUntil("(BRANCH)"); }
3477
3478 static void ufoCommonWhile (int normal) {
3479   uint32_t ra;
3480   UFCALL(QCOMP);
3481   if (ufoPeek() == UFO_QPAIRS_WHILE) {
3482     ufoDrop();
3483     ra = ufoPop();
3484   } else {
3485     ufoPush(UFO_QPAIRS_BEGIN);
3486     UFCALL(QPAIRS);
3487     ra = ufoPop();
3488     ufoPush(~0U);
3489   }
3490   ufoCompileCompilerWord(normal ? "(0BRANCH)" : "(TBRANCH)");
3491   UFCALL(HERE);
3492   ufoImgEmitU32(0);
3493   ufoPush(ra);
3494   ufoPush(UFO_QPAIRS_WHILE);
3495 }
3496
3497 // WHILE
3498 UFWORD(WHILE) { ufoCommonWhile(1); }
3499
3500 // NOT-WHILE
3501 UFWORD(NOT_WHILE) { ufoCommonWhile(0); }
3502
3503
3504 //==========================================================================
3505 //
3506 //  ufoXOF
3507 //
3508 //==========================================================================
3509 static void ufoXOF (const char *cmpwname, int doswap) {
3510   UFCALL(QCOMP);
3511   ufoPush(UFO_QPAIRS_CASE);
3512   UFCALL(QPAIRS);
3513   ufoCompileForthWord("OVER");
3514   if (doswap) ufoCompileForthWord("SWAP");
3515   ufoCompileForthWord(cmpwname);
3516   ufoCompileCompilerWord("(0BRANCH)");
3517   // HERE 0 ,
3518   UFCALL(HERE);
3519   ufoImgEmitU32(0);
3520   ufoCompileForthWord("DROP");
3521   ufoPush(UFO_QPAIRS_OF);
3522 }
3523
3524
3525 // CASE
3526 UFWORD(CASE) {
3527   UFCALL(QCOMP);
3528   ufoPush(ufoCSP); ufoCSP = ufoSP; //CSP @ !CSP
3529   ufoPush(UFO_QPAIRS_CASE);
3530 }
3531
3532 // OF
3533 UFWORD(OF) {
3534   ufoXOF("=", 0);
3535 }
3536
3537 // &OF
3538 UFWORD(AND_OF) {
3539   ufoXOF("AND", 1);
3540 }
3541
3542 // ENDOF
3543 UFWORD(ENDOF) {
3544   UFCALL(QCOMP);
3545   ufoPush(UFO_QPAIRS_OF);
3546   UFCALL(QPAIRS);
3547   ufoCompileCompilerWord("(BRANCH)");
3548   // HERE 0 ,
3549   UFCALL(HERE);
3550   ufoImgEmitU32(0);
3551   ufoSwap();
3552   ufoPush(UFO_QPAIRS_IF);
3553   UFCALL(ENDIF);
3554   ufoPush(UFO_QPAIRS_CASE);
3555 }
3556
3557 // OTHERWISE
3558 UFWORD(OTHERWISE) {
3559   UFCALL(QCOMP);
3560   ufoPush(UFO_QPAIRS_CASE);
3561   UFCALL(QPAIRS);
3562   ufoPush(UFO_QPAIRS_OTHER);
3563 }
3564
3565 // ENDCASE
3566 UFWORD(ENDCASE) {
3567   UFCALL(QCOMP);
3568   if (ufoPeek() != UFO_QPAIRS_OTHER) {
3569     ufoPush(UFO_QPAIRS_CASE);
3570     UFCALL(QPAIRS);
3571     ufoCompileForthWord("DROP");
3572   } else {
3573     ufoDrop();
3574   }
3575   //fprintf(stderr, "SP=%u; csp=%u\n", ufoSP, ufoCSP);
3576   if (ufoSP < ufoCSP) ufoFatal("ENDCASE compiler error");
3577   while (ufoSP > ufoCSP) {
3578     ufoPush(UFO_QPAIRS_IF);
3579     UFCALL(ENDIF);
3580   }
3581   ufoCSP = ufoPop(); //CSP !
3582 }
3583
3584
3585 // ////////////////////////////////////////////////////////////////////////// //
3586 // define Forth words
3587
3588
3589 //==========================================================================
3590 //
3591 //  ufoRegisterWord
3592 //
3593 //==========================================================================
3594 static UForthWord *ufoRegisterWord (const char *wname, void (*cfa) (UForthWord *self),
3595                                     uint32_t flags)
3596 {
3597   if (!wname) wname = "";
3598   if (strlen(wname) > 127) ufoFatal("too long word name '%s'", wname);
3599   UForthWord *fw = ufoFindWord(wname);
3600   if (fw != NULL) {
3601     if (UFW_IS_PROT(fw)) {
3602       ufoFatal("cannot redefine protected word '%s'", wname);
3603     }
3604     printf("redefined word '%s'.\n", wname); ufoLastEmitWasCR = 1;
3605   }
3606   fw = calloc(1, sizeof(UForthWord));
3607   fw->name = strdup(wname);
3608   #ifdef UFO_UPPERCASE_DICT_WORDS
3609   for (char *s = fw->name; *s; ++s) *s = toUpper(*s);
3610   #endif
3611   fw->cfa = cfa;
3612   FW_SET_CFAIDX(fw, ufoCFAsUsed);
3613   fw->flags = flags;
3614   fw->pfa = 0xffffffffu; //ufoImageUsed;
3615   fw->pfastart = ufoImageUsed;
3616   fw->pfaend = 0;
3617   ufoLinkWordToDict(fw);
3618   if (ufoCFAsUsed >= UFO_MAX_WORDS) ufoFatal("too many UFO words");
3619   ufoForthCFAs[ufoCFAsUsed++] = fw;
3620   //fprintf(stderr, "***NEW WORD #%u: <%s> at 0x%08x\n", ufoCFAsUsed-1u, ufoForthCFAs[ufoCFAsUsed-1u]->name, fw->pfa);
3621   return fw;
3622 };
3623
3624
3625 //==========================================================================
3626 //
3627 //  ufoCreateNamelessForthWord
3628 //
3629 //==========================================================================
3630 static UForthWord *ufoCreateNamelessForthWord (void) {
3631   UForthWord *fw = calloc(1, sizeof(UForthWord));
3632   fw->name = strdup("(nameless-word)");
3633   fw->cfa = &ufoDoForth;
3634   FW_SET_CFAIDX(fw, ufoCFAsUsed);
3635   fw->flags = UFW_FLAG_PROTECTED | UFW_FLAG_HIDDEN;
3636   fw->pfa = 0xffffffffu; //ufoImageUsed;
3637   fw->pfastart = ufoImageUsed;
3638   fw->pfaend = 0;
3639   ufoLinkWordToDict(fw);
3640   if (ufoCFAsUsed >= UFO_MAX_WORDS) ufoFatal("too many UFO words");
3641   ufoForthCFAs[ufoCFAsUsed++] = fw;
3642   return fw;
3643 };
3644
3645
3646 //==========================================================================
3647 //
3648 //  doNativeCreate
3649 //
3650 //==========================================================================
3651 static UForthWord *doNativeCreate (void) {
3652   ufoParseNameToTempBuf();
3653   UForthWord *fw = ufoRegisterWord(ufoTempCharBuf, NULL, ufoDefaultVocFlags);
3654   fw->pfa = ufoImageUsed;
3655   fw->pfastart = ufoImageUsed;
3656   fw->pfaend = 0;
3657   return fw;
3658 }
3659
3660
3661 // :
3662 // either native, or ZX, depending of the current mode
3663 UFWORD(COLON) {
3664   if (ufoIsCompiling()) ufoFatal("already compiling");
3665   if (ufoInColon != 0) ufoFatal("invalid ':' usage");
3666   ufoWipeLocRecords();
3667   ufoInColon = 1;
3668   UForthWord *fw = doNativeCreate();
3669   fw->cfa = NULL; // for now
3670   ufoColonWord = fw;
3671   ufoSetStateCompile();
3672   //fprintf(stderr, "compiling native <%s>\n", wname);
3673   // always remember old mode
3674   ufoPush(0xdeadbeefU); // just a flag
3675 }
3676
3677
3678 // VOCABULARY name
3679 UFWORD(VOCABULARY) {
3680   ufoParseNameToTempBuf();
3681   UForthWord *fw = ufoRegisterWord(ufoTempCharBuf, NULL, ufoDefaultVocFlags);
3682   fw->pfa = 0xffffffffU;
3683   ufoCreateVocabData(fw);
3684 }
3685
3686 // NESTED-VOCABULARY name
3687 UFWORD(NESTED_VOCABULARY) {
3688   uint32_t prev = ufoLastVoc;
3689   UForthWord *voc = UFO_GET_CFAPROC(prev);
3690   if (!UFO_VALID_VOC_FW(voc)) ufoFatal("'NESTED_VOCABULARY' internal error");
3691   ufoParseNameToTempBuf();
3692   UForthWord *fw = ufoRegisterWord(ufoTempCharBuf, NULL, ufoDefaultVocFlags);
3693   fw->pfa = 0xffffffffU;
3694   ufoCreateVocabData(fw);
3695   ufoLinkVocab(fw, voc);
3696 }
3697
3698 // ONLY
3699 UFWORD(ONLY) {
3700   ufoVSP = 0;
3701 }
3702
3703 // ALSO
3704 UFWORD(ALSO) {
3705   if (ufoVSP == UFO_VOCSTACK_SIZE) ufoFatal("vocabulary stack overflow");
3706   ufoVocStack[ufoVSP] = ufoImgGetU32(ufoAddrContext);
3707   ufoVSP += 1;
3708 }
3709
3710 // PREVIOUS
3711 UFWORD(PREVIOUS) {
3712   if (ufoVSP == 0) ufoFatal("vocabulary stack underflow");
3713   ufoVSP -= 1;
3714   ufoImgPutU32(ufoAddrContext, ufoVocStack[ufoVSP]);
3715 }
3716
3717 // DEFINITIONS
3718 UFWORD(DEFINITIONS) {
3719   ufoImgPutU32(ufoAddrCurrent, ufoImgGetU32(ufoAddrContext));
3720   ufoDefaultVocFlags &= ~UFW_FLAG_VOC_HIDDEN;
3721 }
3722
3723 // VOCID: name
3724 // ( -- vocid )
3725 UFWORD(VOCID_IMM) {
3726   ufoParseNameToTempBuf();
3727   UForthWord *fw = ufoAlwaysWord(ufoTempCharBuf);
3728   if (!UFO_VALID_VOC_FW(fw)) ufoFatal("word '%s' is not a vocabulary", ufoTempCharBuf);
3729   ufoPush(fw->cfaidx);
3730   UFCALL(LITERAL);
3731 }
3732
3733 // <PUBLIC-WORDS>
3734 UFWORD(VOC_PUBLIC_MODE) {
3735   ufoDefaultVocFlags &= ~UFW_FLAG_VOC_HIDDEN;
3736 }
3737
3738 // <HIDDEN-WORDS>
3739 UFWORD(VOC_HIDDEN_MODE) {
3740   ufoDefaultVocFlags |= UFW_FLAG_VOC_HIDDEN;
3741 }
3742
3743 // <PROTECTED-WORDS>
3744 UFWORD(VOC_PROTECTED_MODE) {
3745   ufoDefaultVocFlags |= UFW_FLAG_PROTECTED;
3746 }
3747
3748 // <UNPROTECTED-WORDS>
3749 UFWORD(VOC_UNPROTECTED_MODE) {
3750   ufoDefaultVocFlags &= ~UFW_FLAG_PROTECTED;
3751 }
3752
3753
3754 // CREATE name
3755 UFWORD(CREATE) {
3756   if (ufoIsCompiling()) ufoFatal("already compiling");
3757   if (ufoInColon != 0) ufoFatal("invalid 'CREATE' usage");
3758   ufoWipeLocRecords();
3759   ufoInColon = 0x00010000;
3760   UForthWord *fw = doNativeCreate();
3761   fw->cfa = &ufoDoVariable; // for now
3762   //fw->flags |= UFW_FLAG_HIDDEN;
3763   ufoColonWord = fw;
3764 }
3765
3766 // CREATE;
3767 UFWORD(CREATE_SEMI) {
3768   if (ufoIsCompiling()) ufoFatal("already compiling");
3769   if (ufoInColon != 0x00010000) ufoFatal("invalid 'CREATE;' usage");
3770   if (ufoColonWord->cfa != &ufoDoVariable) ufoFatal("invalid 'CREATE;' usage");
3771   ufoLastDefinedNativeWord = ufoColonWord;
3772   ufoWipeLocRecords();
3773   ufoInColon = 0;
3774   ufoColonWord->pfaend = ufoImageUsed;
3775   //ufoColonWord->flags &= ~UFW_FLAG_HIDDEN;
3776 }
3777
3778 // DOES>
3779 UFWORD(DOES) {
3780   if (ufoIsCompiling()) ufoFatal("already compiling");
3781   if (ufoInColon != 0x00010000) ufoFatal("invalid 'DOES>' usage");
3782   if (ufoColonWord->cfa != &ufoDoVariable) ufoFatal("invalid 'DOES>' usage");
3783   ufoColonWord->cfa = NULL; // for semicolon
3784   ufoColonWord->pfa = ufoImageUsed;
3785   ufoWipeLocRecords();
3786   ufoInColon = 1;
3787   // this is for semicolon
3788   ufoPush(ufoMode);
3789   ufoPush(0xdead0badU); // just a flag
3790   ufoSetStateCompile();
3791 }
3792
3793
3794 // ;
3795 UFWORD(SEMI) {
3796   if (ufoIsInterpreting()) ufoFatal("not compiling");
3797   if (ufoInColon != 1) ufoFatal("where's my colon?");
3798   ufoLastDefinedNativeWord = NULL;
3799   UFCALL(QCOMP);
3800   // check guard
3801   const uint32_t guard = ufoPop();
3802   if (guard != 0xdeadbeefU && guard != 0xdead0badU) {
3803     ufoFatal("UFO finishing word primary magic imbalance!");
3804   }
3805   // compile finishing word
3806   if (ufoColonWord == NULL || ufoColonWord->cfa != NULL) ufoFatal("UFO ';' without ':'");
3807   ufo_assert(ufoColonWord->pfa != 0xffffffffU);
3808   ufoColonWord->cfa = &ufoDoForth;
3809   if (ufoIsLocalsEnter(ufoColonWord)) {
3810     ufoCompileCompilerWord("(L-LEAVE)");
3811   }
3812   ufoCompileCompilerWord("(EXIT)");
3813   //ufoDecompileForth(ufoForthDict);
3814   ufoLastDefinedNativeWord = ufoColonWord;
3815   ufoColonWord->pfaend = ufoImageUsed;
3816   ufoSetStateInterpret();
3817   // stack must be empty
3818   //if (ufoSP) ufoFatal("UFO finishing word primary imbalance!");
3819
3820   ufoWipeLocRecords();
3821   ufoInColon = 0;
3822   ufoColonWord = NULL;
3823
3824   // call optimiser if there is any
3825   UForthWord *ofw = ufoFindWordCompiler("OPTIMISE-WORD");
3826   if (ofw && ofw != ufoLastDefinedNativeWord) {
3827     //if (ufoMode == UFO_MODE_ZX) fprintf(stderr, "**********000: #%04X\n", disp);
3828     ufoPush(ufoLastDefinedNativeWord->cfaidx);
3829     ufoExecuteNativeWordInVM(ofw);
3830   }
3831 }
3832
3833 // IMMEDIATE
3834 UFWORD(IMMEDIATE) {
3835   if (ufoLastDefinedNativeWord) {
3836     ufoLastDefinedNativeWord->flags ^= UFW_FLAG_IMMEDIATE;
3837   } else {
3838     ufoFatal("wtf in `IMMEDIATE`");
3839   }
3840 }
3841
3842 // (PROTECTED)
3843 UFWORD(PAR_PROTECTED) {
3844   if (ufoLastDefinedNativeWord) {
3845     // we cannot unprotect the word
3846     ufoLastDefinedNativeWord->flags |= UFW_FLAG_PROTECTED;
3847   } else {
3848     ufoFatal("wtf in `(PROTECTED)`");
3849   }
3850 }
3851
3852 // (HIDDEN)
3853 UFWORD(PAR_HIDDEN) {
3854   if (ufoLastDefinedNativeWord) {
3855     ufoLastDefinedNativeWord->flags ^= UFW_FLAG_VOC_HIDDEN;
3856   } else {
3857     ufoFatal("wtf in `(HIDDEN)`");
3858   }
3859 }
3860
3861 UFWORD(RECURSE_IMM) {
3862   UFCALL(QCOMP);
3863   //if (!ufoGetState()) ufoFatal("not compiling");
3864   if (ufoLastDefinedNativeWord) {
3865     ufoImgEmitU32(ufoLastDefinedNativeWord->cfaidx);
3866   } else {
3867     ufoFatal("wtf in `RECURSE`");
3868   }
3869 }
3870
3871
3872 //==========================================================================
3873 //
3874 //  ufoArgsLocalsCommon
3875 //
3876 //==========================================================================
3877 static void ufoArgsLocalsCommon (uint32_t increment) {
3878   uint32_t eidx = ufoPrepareEnter(ufoColonWord);
3879   uint32_t ch = ufoGetInChar();
3880   while (ch != 0) {
3881     if (ch > 32) {
3882       uint32_t dpos = 0;
3883       while (ch > 32) {
3884         if (dpos >= UFO_MAX_WORD_LENGTH - 1 || dpos >= (uint32_t)sizeof(ufoTempCharBuf)) {
3885           ufoFatal("name too long");
3886         }
3887         ufoTempCharBuf[dpos] = (char)ch; dpos += 1;
3888         ch = ufoGetInChar();
3889       }
3890       ufoTempCharBuf[dpos] = 0;
3891       if ((eidx&0xffU) > 127) ufoFatal("too many locals at '%s'", ufoTempCharBuf);
3892       eidx += increment;
3893       ufoNewLocal(ufoTempCharBuf);
3894     } else {
3895       ch = ufoGetInChar();
3896     }
3897   }
3898   ufoUpdateEnter(ufoColonWord, eidx);
3899 }
3900
3901 // args: name name...
3902 UFWORD(ARGS_IMM) { ufoArgsLocalsCommon(0x0101); } // increment high byte too
3903 // locals: name name...
3904 UFWORD(LOCALS_IMM) { ufoArgsLocalsCommon(1); }
3905
3906
3907 //==========================================================================
3908 //
3909 //  ufoLoadLocal
3910 //
3911 //==========================================================================
3912 UFO_FORCE_INLINE void ufoLoadLocal (uint32_t lidx) {
3913   if (lidx == 0 || lidx >= UFO_LSTACK_SIZE) ufoFatal("invalid local index1");
3914   if (ufoLBP == 0 || ufoLBP >= ufoLP || ufoLP - ufoLBP <= lidx) ufoFatal("invalid local index");
3915   ufoPush(ufoLStack[ufoLBP + lidx]);
3916 }
3917
3918
3919 //==========================================================================
3920 //
3921 //  ufoStoreLocal
3922 //
3923 //==========================================================================
3924 UFO_FORCE_INLINE void ufoStoreLocal (uint32_t lidx) {
3925   uint32_t value = ufoPop();
3926   if (lidx == 0 || lidx >= UFO_LSTACK_SIZE) ufoFatal("invalid local index1");
3927   if (ufoLBP == 0 || ufoLBP >= ufoLP || ufoLP - ufoLBP <= lidx) ufoFatal("invalid local index");
3928   ufoLStack[ufoLBP + lidx] = value;
3929 }
3930
3931
3932 // (LOCAL@)
3933 // ( idx -- value )
3934 UFWORD(LOCAL_LOAD) { ufoLoadLocal(ufoPop()); }
3935
3936 // (LOCAL@-1) .. (LOCAL@-7)
3937 UFWORD(LOCAL_LOAD_1) { ufoLoadLocal(1); }
3938 UFWORD(LOCAL_LOAD_2) { ufoLoadLocal(2); }
3939 UFWORD(LOCAL_LOAD_3) { ufoLoadLocal(3); }
3940 UFWORD(LOCAL_LOAD_4) { ufoLoadLocal(4); }
3941 UFWORD(LOCAL_LOAD_5) { ufoLoadLocal(5); }
3942 UFWORD(LOCAL_LOAD_6) { ufoLoadLocal(6); }
3943 UFWORD(LOCAL_LOAD_7) { ufoLoadLocal(7); }
3944 UFWORD(LOCAL_LOAD_8) { ufoLoadLocal(8); }
3945 UFWORD(LOCAL_LOAD_9) { ufoLoadLocal(9); }
3946 UFWORD(LOCAL_LOAD_10) { ufoLoadLocal(10); }
3947 UFWORD(LOCAL_LOAD_11) { ufoLoadLocal(11); }
3948 UFWORD(LOCAL_LOAD_12) { ufoLoadLocal(12); }
3949 UFWORD(LOCAL_LOAD_13) { ufoLoadLocal(13); }
3950 UFWORD(LOCAL_LOAD_14) { ufoLoadLocal(14); }
3951 UFWORD(LOCAL_LOAD_15) { ufoLoadLocal(15); }
3952 UFWORD(LOCAL_LOAD_16) { ufoLoadLocal(16); }
3953
3954 // (LOCAL!)
3955 // ( value idx -- )
3956 UFWORD(LOCAL_STORE) { ufoStoreLocal(ufoPop()); }
3957
3958 // (LOCAL!-1) .. (LOCAL!-7)
3959 UFWORD(LOCAL_STORE_1) { ufoStoreLocal(1); }
3960 UFWORD(LOCAL_STORE_2) { ufoStoreLocal(2); }
3961 UFWORD(LOCAL_STORE_3) { ufoStoreLocal(3); }
3962 UFWORD(LOCAL_STORE_4) { ufoStoreLocal(4); }
3963 UFWORD(LOCAL_STORE_5) { ufoStoreLocal(5); }
3964 UFWORD(LOCAL_STORE_6) { ufoStoreLocal(6); }
3965 UFWORD(LOCAL_STORE_7) { ufoStoreLocal(7); }
3966 UFWORD(LOCAL_STORE_8) { ufoStoreLocal(8); }
3967 UFWORD(LOCAL_STORE_9) { ufoStoreLocal(9); }
3968 UFWORD(LOCAL_STORE_10) { ufoStoreLocal(10); }
3969 UFWORD(LOCAL_STORE_11) { ufoStoreLocal(11); }
3970 UFWORD(LOCAL_STORE_12) { ufoStoreLocal(12); }
3971 UFWORD(LOCAL_STORE_13) { ufoStoreLocal(13); }
3972 UFWORD(LOCAL_STORE_14) { ufoStoreLocal(14); }
3973 UFWORD(LOCAL_STORE_15) { ufoStoreLocal(15); }
3974 UFWORD(LOCAL_STORE_16) { ufoStoreLocal(16); }
3975
3976
3977 // ////////////////////////////////////////////////////////////////////////// //
3978 // code blocks
3979
3980 // (CODEBLOCK) ( -- )
3981 UFWORD(CODEBLOCK_PAR) {
3982   // current IP is "jump over" destination
3983   // next IP is cfaidx
3984   ufoPush(ufoImgGetU32(ufoIP+1u)); // push cfa
3985   ufoIP = ufoImgGetU32(ufoIP); // branch over the code block
3986 }
3987
3988 // [: -- start code block
3989 UFWORD(CODEBLOCK_START_IMM) {
3990   if (ufoInColon <= 0) ufoInColon -= 1; else ufoInColon += 1;
3991   UFCALL(QCOMP);
3992   ufoCompileCompilerWord("(CODEBLOCK)");
3993   UFCALL(HERE);
3994   ufoImgEmitU32(0); // jump over
3995   // create nameless word
3996   UForthWord *fw = ufoCreateNamelessForthWord();
3997   ufoImgEmitU32(fw->cfaidx); // cfaidx
3998   fw->pfa = ufoImageUsed;
3999   fw->pfastart = ufoImageUsed;
4000   fw->pfaend = 0;
4001   ufoPush(UFO_QPAIRS_CBLOCK);
4002 }
4003
4004 // ;] -- end code block
4005 UFWORD(CODEBLOCK_END_IMM) {
4006   if (ufoInColon == 0 || ufoInColon == 1) ufoFatal("end of code block without start");
4007   if (ufoInColon < 0) ufoInColon += 1; else ufoInColon -= 1;
4008   if (!UFW_IS_HID(ufoForthDict) || ufoForthDict->cfa != &ufoDoForth) {
4009     ufoFatal("invalid code block!");
4010   }
4011   UFCALL(QCOMP);
4012   ufoPush(UFO_QPAIRS_CBLOCK);
4013   UFCALL(QPAIRS);
4014   ufoCompileCompilerWord("(EXIT)"); // finish code block
4015   UFCALL(COMP_FWD);
4016   ufoForthDict->pfaend = ufoImageUsed;
4017 }
4018
4019
4020 // ////////////////////////////////////////////////////////////////////////// //
4021 // some ZX words
4022
4023 // <UFO-MODE@>
4024 UFWORD(UFO_MODER) {
4025   ufoPush(ufoMode);
4026 }
4027
4028
4029 // ////////////////////////////////////////////////////////////////////////// //
4030 static void ufoDoVariable (UForthWord *self) { ufoPush(self->pfa); }
4031 static void ufoDoValue (UForthWord *self) { ufoPush(ufoImgGetU32(self->pfa)); }
4032 static void ufoDoConst (UForthWord *self) { ufoPush(ufoImgGetU32(self->pfa)); }
4033
4034 static void ufoDoDefer (UForthWord *self) {
4035   const uint32_t cfaidx = ufoImgGetU32(self->pfastart);
4036   ufoExecCFAIdx(cfaidx);
4037 }
4038
4039 // VALUE
4040 UFWORD(VALUE) {
4041   UForthWord *fvar = doNativeCreate();
4042   fvar->cfa = &ufoDoValue;
4043   fvar->pfa = ufoImageUsed;
4044   // variable value
4045   ufoImgEmitU32(ufoPop());
4046   fvar->pfaend = ufoImageUsed;
4047 }
4048
4049 // VAR-NOALLOT
4050 UFWORD(VAR_NOALLOT) {
4051   UForthWord *fvar = doNativeCreate();
4052   fvar->cfa = &ufoDoVariable;
4053   fvar->pfa = ufoImageUsed;
4054   // no variable value yet
4055 }
4056
4057 // VARIABLE
4058 UFWORD(VARIABLE) {
4059   UForthWord *fvar = doNativeCreate();
4060   fvar->cfa = &ufoDoVariable;
4061   fvar->pfa = ufoImageUsed;
4062   // variable value
4063   ufoImgEmitU32(ufoPop());
4064   fvar->pfaend = ufoImageUsed;
4065 }
4066
4067 // CONSTANT
4068 UFWORD(CONSTANT) {
4069   UForthWord *fvar = doNativeCreate();
4070   fvar->cfa = &ufoDoConst;
4071   fvar->pfa = ufoImageUsed;
4072   // variable value
4073   ufoImgEmitU32(ufoPop());
4074   fvar->pfaend = ufoImageUsed;
4075 }
4076
4077 // DEFER
4078 UFWORD(DEFER) {
4079   UForthWord *fvar = doNativeCreate();
4080   fvar->cfa = &ufoDoDefer;
4081   fvar->pfa = ufoImageUsed;
4082   // variable value
4083   ufoImgEmitU32(ufoPop());
4084   fvar->pfaend = ufoImageUsed;
4085 }
4086
4087 // N-ALLOT
4088 // ( size -- startaddr )
4089 // this cannot "deallot" memory
4090 UFWORD(N_ALLOT) {
4091   uint32_t sz = (int32_t)ufoPop();
4092   if (sz >= 1024*1024*64) ufoFatal("cannot allot %u bytes", sz);
4093   ufoImgEnsureSize(ufoImageUsed + sz);
4094   ufoPush(ufoImageUsed);
4095   ufoImageUsed += sz;
4096 }
4097
4098 // ALLOT
4099 // ( size -- )
4100 UFWORD(ALLOT) {
4101   UFCALL(N_ALLOT);
4102   ufoDrop();
4103 }
4104
4105 // LOAD-DATA-FILE
4106 // ( addr count -- here size )
4107 // load data file from disk, put it to HERE
4108 // file is unpacked to cells (i.e. each byte will occupy one cell)
4109 // the usual "!" and "*" modifiers are ok
4110 UFWORD(LOAD_DATA_FILE) {
4111   ufoPopStrLitToTempBuf();
4112   const char *orgname = ufoTempCharBuf;
4113   int system = 0, softinclude = 0;
4114   while (*orgname != 0) {
4115     if (*orgname == '!') {
4116       if (system) ufoFatal("invalid file name (duplicate system mark)");
4117       system = 1;
4118     } else if (*orgname == '?') {
4119       if (softinclude) ufoFatal("invalid file name (duplicate soft mark)");
4120       softinclude = 1;
4121     } else {
4122       break;
4123     }
4124     do {
4125       ++orgname;
4126     } while (*orgname > 0 && *orgname <= 32);
4127   }
4128   if (*orgname == 0) ufoFatal("empty file name");
4129   UFCALL(HERE);
4130   const uint32_t addr = ufoPop();
4131   uint32_t count = 0;
4132   char *fname = ufoCreateIncludeName(orgname, system, ufoLastIncPath);
4133   FILE *fl = fopen(fname, "rb");
4134   if (!fl) {
4135     if (!softinclude) ufoFatal("file not found: '%s'", fname);
4136   } else {
4137     for (;;) {
4138       uint8_t bt;
4139       ssize_t res = fread(&bt, 1, 1, fl);
4140       if (!res) break;
4141       if (res != 1) { fclose(fl); ufoFatal("error reading file: '%s'", fname); }
4142       //ufoZXEmitU8(bt);
4143       ufoImgPutU8(addr + count, bt); count += 1;
4144     }
4145     fclose(fl);
4146   }
4147   free(fname);
4148   ufoPush(addr);
4149   ufoPush(count);
4150 }
4151
4152 // ZX-LOAD-DATA-FILE
4153 // ( addr count -- )
4154 // load data file from disk, put it to org, advance org
4155 // the usual "!" and "*" modifiers are ok
4156 UFWORD(ZX_LOAD_DATA_FILE) {
4157   ufoPopStrLitToTempBuf();
4158   const char *orgname = ufoTempCharBuf;
4159   int system = 0, softinclude = 0;
4160   while (*orgname != 0) {
4161     if (*orgname == '!') {
4162       if (system) ufoFatal("invalid file name (duplicate system mark)");
4163       system = 1;
4164     } else if (*orgname == '?') {
4165       if (softinclude) ufoFatal("invalid file name (duplicate soft mark)");
4166       softinclude = 1;
4167     } else {
4168       break;
4169     }
4170     do {
4171       ++orgname;
4172     } while (*orgname > 0 && *orgname <= 32);
4173   }
4174   if (*orgname == 0) ufoFatal("empty file name");
4175   char *fname = ufoCreateIncludeName(orgname, system, ufoLastIncPath);
4176   FILE *fl = fopen(fname, "rb");
4177   if (!fl) {
4178     if (!softinclude) ufoFatal("file not found: '%s'", fname);
4179   } else {
4180     for (;;) {
4181       uint8_t bt;
4182       ssize_t res = fread(&bt, 1, 1, fl);
4183       if (!res) break;
4184       if (res != 1) { fclose(fl); ufoFatal("error reading file: '%s'", fname); }
4185       ufoZXEmitU8(bt);
4186     }
4187     fclose(fl);
4188   }
4189   free(fname);
4190 }
4191
4192
4193 // TO
4194 UFWORD(TO_IMM) {
4195   UFCALL(PARSE_NAME);
4196   UForthWord *fw = ufoNTWordAddrCount();
4197   if (fw->cfa != &ufoDoValue && fw->cfa != &ufoDoDefer) {
4198     ufoFatal("UFO word `%s` is not VALUE/DEFER", fw->name);
4199   }
4200   if (ufoIsCompiling()) {
4201     // compiling
4202     // literal
4203     ufoCompileLiteral(fw->pfa);
4204     ufoCompileForthWord("!");
4205   } else {
4206     // interpreting
4207     ufoImgPutU32(fw->pfa, ufoPop());
4208   }
4209 }
4210
4211 // NAMED-TO
4212 // ( value addr count -- )
4213 UFWORD(NAMED_TO) {
4214   UForthWord *fw = ufoNTWordAddrCount();
4215   if (fw->cfa != &ufoDoValue && fw->cfa != &ufoDoDefer) {
4216     ufoFatal("UFO word `%s` is not VALUE/DEFER", fw->name);
4217   }
4218   if (ufoIsCompiling()) {
4219     // compiling
4220     // literal
4221     ufoCompileLiteral(fw->pfa);
4222     ufoCompileForthWord("!");
4223   } else {
4224     // interpreting
4225     ufoImgPutU32(fw->pfa, ufoPop());
4226   }
4227 }
4228
4229 // CFA->PFA
4230 // ( cfa -- pfa )
4231 UFWORD(CFA2PFA) {
4232   uint32_t cfa = ufoPop();
4233   UForthWord *fw = UFO_GET_NATIVE_CFA(cfa);
4234   ufoPush(fw->pfa);
4235 }
4236
4237
4238 // ////////////////////////////////////////////////////////////////////////// //
4239
4240 // [
4241 UFWORD(LSQBRACKET_IMM) {
4242   ufoSetStateInterpret();
4243 }
4244
4245 // ]
4246 UFWORD(RSQBRACKET) {
4247   ufoSetStateCompile();
4248 }
4249
4250
4251 // ////////////////////////////////////////////////////////////////////////// //
4252 // UrAsm API
4253
4254 // UR-HAS-LABEL?
4255 // ( addr count -- flag )
4256 UFWORD(UR_HAS_LABELQ) {
4257   ufoPopStrLitToTempBuf();
4258   ufoPushBool(ufoZXGetLabelType(ufoTempCharBuf) > UFO_ZX_LABEL_UNKNOWN);
4259 }
4260
4261 // UR-LABEL-TYPE?
4262 // ( addr count -- type )
4263 // 0: unknown
4264 UFWORD(UR_GET_LABELQ_TYPE) {
4265   ufoPopStrLitToTempBuf();
4266   ufoPush(ufoZXGetLabelType(ufoTempCharBuf));
4267 }
4268
4269 // UR-GET-LABEL
4270 // ( addr count -- value )
4271 // fatals when the label is not found
4272 UFWORD(UR_GET_LABELQ) {
4273   ufoPopStrLitToTempBuf();
4274   ufoPush((uint32_t)ufoZXGetLabelValue(ufoTempCharBuf));
4275 }
4276
4277 typedef struct {
4278   uint32_t cfaidx;
4279 } LIterInfo;
4280
4281
4282 //==========================================================================
4283 //
4284 //  zxLabelIter
4285 //
4286 //==========================================================================
4287 static uint32_t zxLabelIter (const char *name, int type, int value, void *udata) {
4288   LIterInfo *nfo = (LIterInfo *)udata;
4289   uint32_t addr = ufoPutTempStrLiteral(name);
4290   uint32_t count = ufoImgGetU32(addr++);
4291   ufoPush(addr);
4292   ufoPush(count);
4293   ufoExecCFAIdxInVM(nfo->cfaidx);
4294   return ufoPop();
4295 }
4296
4297 // UR-FOREACH-LABEL
4298 // ( cfa -- res )
4299 // EXECUTEs cfa, returns final res
4300 // cfa: ( addr count -- stopflag )
4301 // i.e. return non-zero from cfa to stop
4302 // res is the result of the last called cfa
4303 UFWORD(UR_FOREACH_LABEL) {
4304   LIterInfo nfo;
4305   nfo.cfaidx = ufoPop();
4306   uint32_t res = ufoZXForeachLabel(&zxLabelIter, &nfo);
4307   ufoPush((uint32_t)res);
4308 }
4309
4310
4311 //==========================================================================
4312 //
4313 //  urw_set_typed_label
4314 //
4315 // ( value addr count -- )
4316 //
4317 //==========================================================================
4318 static void urw_set_typed_label (UForthWord *self, int type) {
4319   ufoPopStrLitToTempBuf();
4320   const char *name = ufoTempCharBuf;
4321   int32_t val = (int32_t)ufoPop();
4322   ufoZXSetLabelValue(name, type, val);
4323 }
4324
4325
4326 // UR-SET-LABEL-VAR
4327 // ( value addr count -- )
4328 // create/overwrite an "assign" label
4329 UFWORD(UR_SET_LABEL_VAR) { urw_set_typed_label(self, UFO_ZX_LABEL_VAR); }
4330
4331 // UR-SET-LABEL-EQU
4332 // ( value addr count -- )
4333 UFWORD(UR_SET_LABEL_EQU) { urw_set_typed_label(self, UFO_ZX_LABEL_EQU); }
4334
4335 // UR-SET-LABEL-CODE
4336 // ( value addr count -- )
4337 UFWORD(UR_SET_LABEL_CODE) { urw_set_typed_label(self, UFO_ZX_LABEL_CODE); }
4338
4339 // UR-SET-LABEL-STOFS
4340 // ( value addr count -- )
4341 UFWORD(UR_SET_LABEL_STOFS) { urw_set_typed_label(self, UFO_ZX_LABEL_STOFS); }
4342
4343 // UR-SET-LABEL-DATA
4344 // ( value addr count -- )
4345 UFWORD(UR_SET_LABEL_DATA) { urw_set_typed_label(self, UFO_ZX_LABEL_DATA); }
4346
4347
4348 //==========================================================================
4349 //
4350 //  urw_declare_typed_label
4351 //
4352 //==========================================================================
4353 static void urw_declare_typed_label (UForthWord *self, int type) {
4354   UFCALL(QEXEC);
4355   ufoParseNameToTempBuf();
4356   if (ufoTempCharBuf[0] == 0) ufoFatal("label name expected");
4357   const char *name = ufoTempCharBuf;
4358   ufoZXSetLabelValue(name, type, ufoZXGetOrg());
4359 }
4360
4361 // $LABEL-DATA: name
4362 UFWORD(DLR_LABEL_DATA_IMM) { urw_declare_typed_label(self, UFO_ZX_LABEL_DATA); }
4363 // $LABEL-CODE: name
4364 UFWORD(DLR_LABEL_CODE_IMM) { urw_declare_typed_label(self, UFO_ZX_LABEL_CODE); }
4365
4366
4367 // UR-PASS@
4368 // ( -- pass )
4369 UFWORD(UR_PASSQ) {
4370   ufoPush(ufoZXGetPass());
4371 }
4372
4373 // UR-ORG@
4374 // ( -- org )
4375 UFWORD(UR_GETORG) {
4376   ufoPush(ufoZXGetOrg());
4377 }
4378
4379 // UR-DISP@
4380 // ( -- disp )
4381 UFWORD(UR_GETDISP) {
4382   ufoPush(ufoZXGetDisp());
4383 }
4384
4385 // UR-ENT@
4386 // ( -- ent )
4387 UFWORD(UR_GETENT) {
4388   ufoPush(ufoZXGetEnt());
4389 }
4390
4391 // UR-ORG!
4392 // ( org -- )
4393 // also sets disp
4394 UFWORD(UR_SETORG) {
4395   const uint32_t addr = ufoPop();
4396   ufoZXSetOrg(addr);
4397 }
4398
4399 // UR-DISP!
4400 // ( disp -- )
4401 // doesn't change ORG
4402 UFWORD(UR_SETDISP) {
4403   const uint32_t addr = ufoPop();
4404   ufoZXSetDisp(addr);
4405 }
4406
4407 // UR-ENT!
4408 // ( ent -- )
4409 UFWORD(UR_SETENT) {
4410   const uint32_t addr = ufoPop();
4411   ufoZXSetEnt(addr);
4412 }
4413
4414
4415 // ////////////////////////////////////////////////////////////////////////// //
4416 // conditional compilation
4417
4418 typedef struct UForthCondDefine_t UForthCondDefine;
4419 struct UForthCondDefine_t {
4420   char *name;
4421   UForthCondDefine *prev;
4422 };
4423
4424 static UForthCondDefine *ufoCondDefines = NULL;
4425
4426
4427 //==========================================================================
4428 //
4429 //  ufoClearCondDefines
4430 //
4431 //==========================================================================
4432 static void ufoClearCondDefines (void) {
4433   while (ufoCondDefines) {
4434     UForthCondDefine *df = ufoCondDefines;
4435     ufoCondDefines = df->prev;
4436     if (df->name) free(df->name);
4437     free(df);
4438   }
4439 }
4440
4441
4442 //==========================================================================
4443 //
4444 //  ufoHasCondDefine
4445 //
4446 //==========================================================================
4447 static int ufoHasCondDefine (const char *name) {
4448   if (!name || !name[0]) return 0;
4449   for (UForthCondDefine *dd = ufoCondDefines; dd; dd = dd->prev) {
4450     if (strcmp(dd->name, name) == 0) return 1;
4451   }
4452   return 0;
4453 }
4454
4455
4456 //==========================================================================
4457 //
4458 //  ufoAddCondDefine
4459 //
4460 //==========================================================================
4461 static void ufoAddCondDefine (const char *name) {
4462   if (!name || !name[0]) return;
4463   for (UForthCondDefine *dd = ufoCondDefines; dd; dd = dd->prev) {
4464     if (strcmp(dd->name, name) == 0) return;
4465   }
4466   UForthCondDefine *dd = malloc(sizeof(UForthCondDefine));
4467   dd->name = strdup(name);
4468   dd->prev = ufoCondDefines;
4469   ufoCondDefines = dd;
4470 }
4471
4472
4473 //==========================================================================
4474 //
4475 //  ufoRemoveCondDefine
4476 //
4477 //==========================================================================
4478 static void ufoRemoveCondDefine (const char *name) {
4479   if (!name || !name[0]) return;
4480   UForthCondDefine *pp = NULL;
4481   for (UForthCondDefine *dd = ufoCondDefines; dd; dd = dd->prev) {
4482     if (strcmp(dd->name, name) == 0) {
4483       if (pp) pp->prev = dd->prev; else ufoCondDefines = dd->prev;
4484       free(dd->name);
4485       free(dd);
4486       return;
4487     }
4488     pp = dd;
4489   }
4490 }
4491
4492
4493 //==========================================================================
4494 //
4495 //  ufoParseConditionTerm
4496 //
4497 //==========================================================================
4498 static int ufoParseConditionTerm (int doskip) {
4499   int res = 0;
4500   if (strEquCI(ufoTempCharBuf, "DEFINED")) {
4501     ufoParseNameToTempBuf();
4502     res = (doskip ? 0 : ufoHasCondDefine(ufoTempCharBuf));
4503   } else if (strEquCI(ufoTempCharBuf, "UNDEFINED")) {
4504     ufoParseNameToTempBuf();
4505     res = (doskip ? 0 : !ufoHasCondDefine(ufoTempCharBuf));
4506   } else if (strEquCI(ufoTempCharBuf, "HAS-WORD")) {
4507     ufoParseNameToTempBuf();
4508     res = (doskip ? 0 : !!ufoFindWord(ufoTempCharBuf));
4509   } else if (strEquCI(ufoTempCharBuf, "NO-WORD")) {
4510     ufoParseNameToTempBuf();
4511     res = (doskip ? 0 : !ufoFindWord(ufoTempCharBuf));
4512   } else if (strEquCI(ufoTempCharBuf, "HAS-LABEL")) {
4513     ufoParseNameToTempBuf();
4514     res = (doskip ? 0 : ufoZXGetLabelType(ufoTempCharBuf) > UFO_ZX_LABEL_UNKNOWN);
4515   } else if (strEquCI(ufoTempCharBuf, "NO-LABEL")) {
4516     ufoParseNameToTempBuf();
4517     res = (doskip ? 0 : ufoZXGetLabelType(ufoTempCharBuf) <= UFO_ZX_LABEL_UNKNOWN);
4518   } else if (strEquCI(ufoTempCharBuf, "PASS0")) {
4519     res = (doskip ? 0 : (ufoZXGetPass() == 0));
4520   } else if (strEquCI(ufoTempCharBuf, "PASS1")) {
4521     res = (doskip ? 0 : (ufoZXGetPass() == 1));
4522   } else {
4523     // label or number
4524     if (doskip) {
4525       res = 0;
4526     } else {
4527       if (ufoZXGetLabelType(ufoTempCharBuf) > UFO_ZX_LABEL_UNKNOWN) {
4528         res = ufoZXGetLabelValue(ufoTempCharBuf);
4529       } else {
4530         // try number
4531         char *e;
4532         res = !!strtol(ufoTempCharBuf, &e, 10);
4533         if (*e) ufoFatal("undefined label '%s'", ufoTempCharBuf);
4534       }
4535     }
4536   }
4537   ufoParseNameToTempBufEmptyOk();
4538   return res;
4539 }
4540
4541
4542 //==========================================================================
4543 //
4544 //  ufoParseConditionUnary
4545 //
4546 //==========================================================================
4547 static int ufoParseConditionUnary (int doskip) {
4548   int res = 0;
4549   if (strEquCI(ufoTempCharBuf, "(")) {
4550     res = ufoParseConditionExpr(doskip);
4551     if (!strEquCI(ufoTempCharBuf, ")")) ufoFatal("unbalanced parens in $IF condition");
4552   } else if (strEquCI(ufoTempCharBuf, "NOT")) {
4553     ufoParseNameToTempBuf();
4554     res = !ufoParseConditionUnary(doskip);
4555   } else {
4556     res = ufoParseConditionTerm(doskip);
4557   }
4558   return res;
4559 }
4560
4561
4562 //==========================================================================
4563 //
4564 //  ufoParseConditionAnd
4565 //
4566 //==========================================================================
4567 static int ufoParseConditionAnd (int doskip) {
4568   int res = ufoParseConditionUnary(doskip);
4569   doskip = (res == 0);
4570   while (strEquCI(ufoTempCharBuf, "AND") || strEquCI(ufoTempCharBuf, "&&")) {
4571     ufoParseNameToTempBuf();
4572     int r2 = ufoParseConditionUnary(doskip);
4573     if (!doskip) {
4574       res = (res && r2);
4575       doskip = (res == 0);
4576     }
4577   }
4578   return res;
4579 }
4580
4581
4582 //==========================================================================
4583 //
4584 //  ufoParseConditionOr
4585 //
4586 //==========================================================================
4587 static int ufoParseConditionOr (int doskip) {
4588   int res = ufoParseConditionAnd(doskip);
4589   doskip = (res != 0);
4590   while (strEquCI(ufoTempCharBuf, "OR") || strEquCI(ufoTempCharBuf, "||")) {
4591     ufoParseNameToTempBuf();
4592     int r2 = ufoParseConditionAnd(doskip);
4593     if (!doskip) {
4594       res = (res || r2);
4595       doskip = (res != 0);
4596     }
4597   }
4598   return res;
4599 }
4600
4601
4602 //==========================================================================
4603 //
4604 //  ufoParseConditionExpr
4605 //
4606 //==========================================================================
4607 static int ufoParseConditionExpr (int doskip) {
4608   return ufoParseConditionOr(doskip);
4609 }
4610
4611
4612 //==========================================================================
4613 //
4614 //  ufoSkipConditionals
4615 //
4616 //==========================================================================
4617 static void ufoSkipConditionals (int toelse) {
4618   const int oldCondStLine = ufoCondStLine;
4619   ufoCondStLine = ufoInFileLine;
4620   int iflevel = 0, done = 0;
4621   do {
4622     ufoLoadNextLine(1);
4623     ufoParseNameToTempBufEmptyOk();
4624     if (ufoTempCharBuf[0]) {
4625       // nested conditionals
4626       if (strEquCI(ufoTempCharBuf, "$IF")) {
4627         iflevel += 1;
4628       } else if (strEquCI(ufoTempCharBuf, "$ENDIF")) {
4629         // in nested ifs, look only for $ENDIF
4630         if (iflevel) {
4631           iflevel -= 1;
4632         } else {
4633           // it doesn't matter which part we're skipping, it ends here anyway
4634           done = 1;
4635         }
4636       } else if (iflevel == 0 && strEquCI(ufoTempCharBuf, "$ELSE")) {
4637         // if we're skipping "true" part, go on
4638         if (toelse) {
4639           ++ufoInCondIf;
4640         } else {
4641           // we're skipping "false" part, there should be no else
4642           ufoFatal("unexpected $ELSE, skipping from line %d", ufoCondStLine);
4643         }
4644         done = 1;
4645       } else if (iflevel == 0 && strEquCI(ufoTempCharBuf, "$ELIF")) {
4646         // if we're skipping "true" part, go on
4647         if (toelse) {
4648           // process the conditional
4649           int res = ufoParseConditionExpr(0);
4650           if (ufoTempCharBuf[0]) ufoFatal("invalid $IF condition");
4651           // either resume normal execution, or keep searching for $ELSE
4652           if (res) {
4653             ++ufoInCondIf;
4654             done = 1;
4655           }
4656         } else {
4657           // we're skipping "false" part, there should be no else
4658           ufoFatal("unexpected $ELIFxx, skipping from line %d", ufoCondStLine);
4659         }
4660       }
4661     }
4662   } while (done == 0);
4663   ufo_assert(iflevel == 0);
4664   ufoLoadNextLine(1);
4665   ufoCondStLine = oldCondStLine;
4666 }
4667
4668
4669 //==========================================================================
4670 //
4671 //  ufoProcessConditional
4672 //
4673 //==========================================================================
4674 static void ufoProcessConditional (void) {
4675   ufoParseNameToTempBuf();
4676   int res = ufoParseConditionExpr(0);
4677   if (ufoTempCharBuf[0]) ufoFatal("invalid $IF condition");
4678   if (!res) {
4679     ufoSkipConditionals(1); // skip to $ELSE
4680   } else {
4681     ++ufoInCondIf;
4682   }
4683 }
4684
4685
4686 // ASM-WARNING
4687 // ( count addr -- )
4688 UFWORD(ASM_WARNING) {
4689   ufoPopStrLitToTempBuf();
4690   if (!ufoLastEmitWasCR) { printf("\n"); ufoLastEmitWasCR = 1; }
4691   fprintf(stdout, "*** USER WARNING ");
4692   if (ufoInFile != NULL) {
4693     fprintf(stdout, "at file %s, line %d: ", ufoInFileName, ufoInFileLine);
4694   } else {
4695     fprintf(stdout, "somewhere in time: ");
4696   }
4697   fprintf(stdout, "%s\n", ufoTempCharBuf);
4698 }
4699
4700
4701 // ASM-ERROR
4702 // ( count addr -- )
4703 UFWORD(ASM_ERROR) {
4704   ufoPopStrLitToTempBuf();
4705   if (!ufoLastEmitWasCR) { printf("\n"); ufoLastEmitWasCR = 1; }
4706   fprintf(stdout, "*** USER ERROR ");
4707   if (ufoInFile != NULL) {
4708     fprintf(stdout, "at file %s, line %d: ", ufoInFileName, ufoInFileLine);
4709   } else {
4710     fprintf(stdout, "somewhere in time: ");
4711   }
4712   fprintf(stdout, "%s\n", ufoTempCharBuf);
4713   exit(1);
4714 }
4715
4716
4717 // $DEFINE word
4718 UFWORD(DLR_DEFINE) {
4719   ufoParseNameToTempBuf();
4720   if (ufoTempCharBuf[0] == 0) ufoFatal("name expected");
4721   ufoAddCondDefine(ufoTempCharBuf);
4722 }
4723
4724 // $UNDEF word
4725 UFWORD(DLR_UNDEF) {
4726   ufoParseNameToTempBuf();
4727   if (ufoTempCharBuf[0] == 0) ufoFatal("name expected");
4728   ufoRemoveCondDefine(ufoTempCharBuf);
4729 }
4730
4731 // these words can be encoundered only when we're done with some $IF, so skip to $ENDIF
4732 // $ELSE
4733 UFWORD(DLR_ELSE_IMM) { if (!ufoInCondIf) ufoFatal("$ELSE without $IF"); ufoSkipConditionals(0); }
4734 // $ELIF
4735 UFWORD(DLR_ELIF_IMM) { if (!ufoInCondIf) ufoFatal("$ELIF without $IF"); --ufoInCondIf; ufoSkipConditionals(0); }
4736 // $ENDIF
4737 UFWORD(DLR_ENDIF_IMM) { if (!ufoInCondIf) ufoFatal("$ENDIF without $IF"); --ufoInCondIf; }
4738
4739 // $IF ...
4740 UFWORD(DLR_IF_IMM) { ufoProcessConditional(); }
4741
4742
4743 // INCLUDE
4744 // ( addr count -- )
4745 UFWORD(INCLUDE) {
4746   char fname[1024];
4747   uint32_t count = ufoPop();
4748   uint32_t addr = ufoPop();
4749   uint32_t dpos = 0;
4750   int system = 0, softinclude = 0;
4751   uint32_t ch;
4752
4753   while (count != 0) {
4754     ch = ufoImgGetU8(addr);
4755     if (ch == '!') {
4756       if (system) ufoFatal("invalid file name (duplicate system mark)");
4757       system = 1;
4758     } else if (ch == '?') {
4759       if (softinclude) ufoFatal("invalid file name (duplicate soft mark)");
4760       softinclude = 1;
4761     } else {
4762       break;
4763     }
4764     do {
4765       addr += 1; count -= 1;
4766       ch = ufoImgGetU8(addr);
4767     } while (ch <= 32 && count != 0);
4768   }
4769
4770   // get filename
4771   if ((size_t)count >= sizeof(fname)) ufoFatal("include file name too long");
4772   dpos = 0;
4773   while (count != 0) {
4774     fname[dpos] = (char)ufoImgGetU8(addr); dpos += 1;
4775     addr += 1; count -= 1;
4776   }
4777   fname[dpos] = 0;
4778
4779   char *ffn = ufoCreateIncludeName(fname, system, ufoLastIncPath);
4780   FILE *fl = ufoOpenFileOrDir(&ffn);
4781   if (!fl) {
4782     if (softinclude) { free(ffn); return; }
4783     ufoFatal("INCLUDE: file '%s' not found", ffn);
4784   }
4785   ufoPushInFile();
4786   ufoInFile = fl;
4787   ufoInFileLine = 0;
4788   ufoInFileName = ffn;
4789   setLastIncPath(ufoInFileName);
4790
4791   // trigger next line loading
4792   ufoSetTIB(0); ufoSetIN(0);
4793   ufoImgPutU32(0, 0);
4794 }
4795
4796
4797 //==========================================================================
4798 //
4799 //  ufoDollarIncludeCommon
4800 //
4801 //==========================================================================
4802 static void ufoDollarIncludeCommon (const char *defname) {
4803   char fname[1024];
4804   uint32_t dpos = 0;
4805   int system = 0, softinclude = 0;
4806   uint32_t ch, qch;
4807   int skipit = (defname != NULL && ufoHasCondDefine(defname));
4808
4809   ch = ufoGetInChar();
4810   while (ch != 0 && ch != '"' && ch != '<') {
4811     ch = ufoGetInChar();
4812   }
4813
4814   if (ch == 0) ufoFatal("quoted file name expected");
4815
4816   if (ch == '<') { system = 1; qch = '>'; } else qch = '"';
4817   ch = ufoGetInChar();
4818   while (ch != qch) {
4819     if (ch == 0) ufoFatal("properly quoted file name expected");
4820     if (ch == '!') {
4821       if (system) ufoFatal("invalid file name (duplicate system mark)");
4822       system = 1;
4823     } else if (ch == '?') {
4824       if (softinclude) ufoFatal("invalid file name (duplicate soft mark)");
4825       softinclude = 1;
4826     } else {
4827       break;
4828     }
4829     // skip spaces
4830     do { ch = ufoGetInChar(); } while (ch != 0 && ch != qch);
4831   }
4832
4833   // get filename
4834   dpos = 0;
4835   while (ch != 0 && ch != qch) {
4836     if ((size_t)dpos >= sizeof(fname)) ufoFatal("include file name too long");
4837     fname[dpos] = (char)ch; dpos += 1;
4838     ch = ufoGetInChar();
4839   }
4840   fname[dpos] = 0;
4841   // final parsing checks
4842   if (ch == 0) ufoFatal("properly quoted file name expected");
4843   ch = ufoGetInChar();
4844   // skip spaces
4845   do { ch = ufoGetInChar(); } while (ch != 0 && ch <= 32);
4846   if (ch != 0) ufoFatal("unexpected extra text");
4847
4848   if (!skipit) {
4849     if (defname != NULL) ufoAddCondDefine(defname);
4850     char *ffn = ufoCreateIncludeName(fname, system, ufoLastIncPath);
4851     FILE *fl = ufoOpenFileOrDir(&ffn);
4852     if (!fl) {
4853       if (softinclude) { free(ffn); return; }
4854       ufoFatal("$INCLUDE: file '%s' not found", ffn);
4855     }
4856     ufoPushInFile();
4857     ufoInFile = fl;
4858     ufoInFileLine = 0;
4859     ufoInFileName = ffn;
4860     setLastIncPath(ufoInFileName);
4861   }
4862
4863   // trigger next line loading
4864   ufoSetTIB(0); ufoSetIN(0);
4865   ufoImgPutU32(0, 0);
4866 }
4867
4868
4869 // $INCLUDE-ONCE define-guard filename
4870 UFWORD(DLR_INCLUDE_ONCE) {
4871   ufoParseNameToTempBuf();
4872   ufoDollarIncludeCommon(ufoTempCharBuf);
4873 }
4874
4875 // $INCLUDE filename
4876 UFWORD(DLR_INCLUDE) {
4877   ufoDollarIncludeCommon(NULL);
4878 }
4879
4880
4881 // DUMP-STACK
4882 // ( -- )
4883 UFWORD(DUMP_STACK) {
4884   if (!ufoLastEmitWasCR) { printf("\n"); ufoLastEmitWasCR = 1; }
4885   printf("***UFO STACK DEPTH: %u\n", ufoSP);
4886   for (uint32_t sp = 0; sp < ufoSP; ++sp) {
4887     printf("  %4u: 0x%08x  %d\n", sp, ufoDStack[sp], (int32_t)ufoDStack[sp]);
4888   }
4889 }
4890
4891
4892 // UFO-FATAL
4893 // ( addr count )
4894 UFWORD(UFO_FATAL) {
4895   //fprintf(stderr, "***UFO STACK DEPTH: %u\n", ufoSP); for (uint32_t sp = 0; sp < ufoSP; ++sp) fprintf(stderr, "  %4u: 0x%08x  %d\n", sp, ufoDStack[sp], (int32_t)ufoDStack[sp]);
4896   ufoPopStrLitToTempBuf();
4897   if (!ufoLastEmitWasCR) { printf("\n"); ufoLastEmitWasCR = 1; }
4898   ufoFatal("%s", ufoTempCharBuf);
4899 }
4900
4901
4902 // ////////////////////////////////////////////////////////////////////////// //
4903 // main loop
4904 //
4905
4906 //==========================================================================
4907 //
4908 //  ufoSetForthOnlyDefs
4909 //
4910 //==========================================================================
4911 static void ufoSetForthOnlyDefs (void) {
4912   ufoImgPutU32(ufoAddrCurrent, ufoForthVocCFA);
4913   ufoImgPutU32(ufoAddrContext, ufoForthVocCFA);
4914 }
4915
4916
4917 //==========================================================================
4918 //
4919 //  ufoCreateVocSetOnlyDefs
4920 //
4921 //==========================================================================
4922 static UForthWord *ufoCreateVocSetOnlyDefs (const char *wname, UForthWord *parentvoc) {
4923   UForthWord *fw = ufoRegisterWord(wname, NULL, ufoDefaultVocFlags);
4924   fw->pfa = 0xffffffffU;
4925   ufoCreateVocabData(fw);
4926   // link to parent
4927   ufoLinkVocab(fw, parentvoc);
4928   // and set as active
4929   ufoImgPutU32(ufoAddrCurrent, fw->cfaidx);
4930   ufoImgPutU32(ufoAddrContext, fw->cfaidx);
4931   return fw;
4932 }
4933
4934
4935 //==========================================================================
4936 //
4937 //  ufoVocSetOnlyDefs
4938 //
4939 //==========================================================================
4940 __attribute__((unused)) static void ufoVocSetOnlyDefs (UForthWord *fw) {
4941   if (UFO_VALID_VOC_FW(fw)) {
4942     ufoImgPutU32(ufoAddrCurrent, fw->cfaidx);
4943     ufoImgPutU32(ufoAddrContext, fw->cfaidx);
4944   } else {
4945     ufoSetForthOnlyDefs();
4946   }
4947 }
4948
4949
4950 //==========================================================================
4951 //
4952 //  ufoDefine
4953 //
4954 //==========================================================================
4955 static void ufoDefine (const char *wname) {
4956   UForthWord *fw = ufoRegisterWord(wname, &ufoDoForth, ufoDefaultVocFlags);
4957   fw->pfa = ufoImageUsed;
4958   fw->pfastart = ufoImageUsed;
4959   fw->pfaend = 0;
4960   //fprintf(stderr, "***DEFINING #%u: <%s> at 0x%08x\n", ufoCFAsUsed-1u, ufoForthCFAs[ufoCFAsUsed-1u]->name, fw->pfa);
4961   ufoSetStateCompile();
4962 }
4963
4964
4965 //==========================================================================
4966 //
4967 //  ufoDefineDone
4968 //
4969 //==========================================================================
4970 static void ufoDefineDone (void) {
4971   ufoLastDefinedNativeWord = NULL;
4972   UFCALL(QCOMP);
4973   if (ufoSP) ufoFatal("UFO finishing word primary imbalance!");
4974   //if (!ufoForthDict || ufoForthDict->cfa) ufoFatal("UFO ';' without ':'");
4975   ufo_assert(ufoForthDict->pfa != 0xffffffffU);
4976   ufoForthDict->cfa = &ufoDoForth;
4977   ufoForthDict->pfaend = ufoImageUsed;
4978   ufoCompileCompilerWord("(EXIT)");
4979   //ufoDecompileForth(ufoForthDict);
4980   ufoLastDefinedNativeWord = ufoForthDict;
4981   ufoSetStateInterpret();
4982 }
4983
4984
4985 //==========================================================================
4986 //
4987 //  ufoNumber
4988 //
4989 //==========================================================================
4990 static void ufoNumber (uint32_t v) {
4991   ufoCompileCompilerWord("LIT");
4992   ufoImgEmitU32(v);
4993 }
4994
4995
4996 //==========================================================================
4997 //
4998 //  ufoCompile
4999 //
5000 //==========================================================================
5001 static void ufoCompile (const char *wname) {
5002   UForthWord *fw = ufoFindWord(wname);
5003   if (!fw) {
5004     // try a number
5005     char *end;
5006     long v = strtol(wname, &end, 0);
5007     if (end == wname || *end) ufoFatal("UFO word '%s' not found", wname);
5008     ufoNumber((uint32_t)v);
5009   } else {
5010     // compile/execute a word
5011     if (UFW_IS_IMM(fw)) {
5012       ufoExecuteNativeWordInVM(fw);
5013     } else {
5014       ufoCompileWordCFA(fw);
5015     }
5016   }
5017 }
5018
5019
5020 //==========================================================================
5021 //
5022 //  ufoString
5023 //
5024 //==========================================================================
5025 static __attribute__((unused)) void ufoString (const char *str) {
5026   ufoCompileCompilerWord("(\")");
5027   if (!str) str = "";
5028   size_t slen = strlen(str);
5029   if (slen > 65535) ufoFatal("UFO string too long");
5030   ufoImgEmitU32((uint32_t)slen);
5031   while (slen--) {
5032     ufoImgEmitU32((uint32_t)(str[0]&0xffU));
5033     ++str;
5034   }
5035 }
5036
5037
5038 //==========================================================================
5039 //
5040 //  ufoDotString
5041 //
5042 //==========================================================================
5043 static __attribute__((unused)) void ufoDotString (const char *str) {
5044   ufoCompileCompilerWord("(.\")");
5045   if (!str) str = "";
5046   size_t slen = strlen(str);
5047   if (slen > 65535) ufoFatal("UFO string too long");
5048   ufoImgEmitU32((uint32_t)slen);
5049   while (slen--) {
5050     ufoImgEmitU32((uint32_t)(str[0]&0xffU));
5051     ++str;
5052   }
5053 }
5054
5055
5056 // ////////////////////////////////////////////////////////////////////////// //
5057 // debug breakpoint
5058 #include "urforth_dbg.c"
5059
5060 // (UFO-BP)
5061 UFWORD(UFO_BP) {
5062   if (!ufoLastEmitWasCR) { printf("\n"); ufoLastEmitWasCR = 1; }
5063   #ifdef WIN32
5064   ufoFatal("there is no UFO debug breakpoint support in windoze");
5065   #else
5066   if (isatty(STDIN_FILENO) && isatty(STDOUT_FILENO)) {
5067     ufoDebugSession();
5068   } else {
5069     fprintf(stderr, "WARNING: cannot start UFO debug session, because standard streams are not on TTY!\n");
5070   }
5071   #endif
5072 }
5073
5074
5075 // ////////////////////////////////////////////////////////////////////////// //
5076 // get word list
5077
5078 // WORDS-ITER-NEW
5079 // ( vocid -- cfa / 0 )
5080 UFWORD(WORDS_ITER_NEW) {
5081   uint32_t vocid = ufoPop();
5082   UForthWord *voc = UFO_GET_CFAPROC(vocid);
5083   if (!UFO_VALID_VOC_FW(voc)) ufoFatal("WORDS-ITER-NEW expects a valid vocid");
5084   UForthWord *fw = voc->latest;
5085   while (fw != NULL && (fw->cfa == NULL || UFW_IS_HID(fw))) fw = fw->prevVoc;
5086   uint32_t cfa = (fw != NULL ? fw->cfaidx : 0);
5087   ufoPush(cfa);
5088 }
5089
5090 // WORDS-ITER-PREV
5091 // ( cfa -- cfa / 0 )
5092 // closes iterator on completion
5093 UFWORD(WORDS_ITER_PREV) {
5094   uint32_t cfa = ufoPop();
5095   UForthWord *fw = UFO_GET_CFAPROC(cfa);
5096   if (fw != NULL) fw = fw->prevVoc;
5097   while (fw != NULL && (fw->cfa == NULL || UFW_IS_HID(fw))) fw = fw->prevVoc;
5098   cfa = (fw != NULL ? fw->cfaidx : 0);
5099   ufoPush(cfa);
5100 }
5101
5102 // WORDS-ITER-NAME
5103 // ( cfa -- addr count )
5104 // somewhere at PAD; invalid CFA returns empty string
5105 UFWORD(WORDS_ITER_NAME) {
5106   uint32_t cfa = ufoPop();
5107   UForthWord *fw = UFO_GET_CFAPROC(cfa);
5108   if (fw != NULL && fw->cfa != NULL && !UFW_IS_HID(fw)) {
5109     uint32_t addr = ufoPutTempStrLiteral(fw->name);
5110     uint32_t count = ufoImgGetU32(addr++);
5111     ufoPush(addr);
5112     ufoPush(count);
5113   } else {
5114     uint32_t dest = ufoPadAddr();
5115     ufoImgPutU32(dest, 0);
5116     ufoImgPutU32(dest+1, 0);
5117     ufoPush(dest);
5118     ufoPush(0u); // count
5119   }
5120 }
5121
5122 // WORDS-ITER-PFA
5123 // ( cfa -- pfa / 0 )
5124 UFWORD(WORDS_ITER_PFA) {
5125   uint32_t cfa = ufoPop();
5126   UForthWord *fw = UFO_GET_CFAPROC(cfa);
5127   if (fw != NULL && fw->cfa != NULL && !UFW_IS_HID(fw)) {
5128     ufoPush(fw->pfa);
5129   } else {
5130     ufoPush(0);
5131   }
5132 }
5133
5134 // WORDS-ITER-IMM?
5135 // ( cfa -- bool )
5136 UFWORD(WORDS_ITER_IMMQ) {
5137   uint32_t cfa = ufoPop();
5138   UForthWord *fw = UFO_GET_CFAPROC(cfa);
5139   if (fw != NULL && fw->cfa != NULL && !UFW_IS_HID(fw)) {
5140     ufoPushBool(UFW_IS_IMM(fw));
5141   } else {
5142     ufoPushBool(0);
5143   }
5144 }
5145
5146 // WORDS-ITER-PROT?
5147 // ( cfa -- bool )
5148 UFWORD(WORDS_ITER_PROTQ) {
5149   uint32_t cfa = ufoPop();
5150   UForthWord *fw = UFO_GET_CFAPROC(cfa);
5151   if (fw != NULL && fw->cfa != NULL && !UFW_IS_HID(fw)) {
5152     ufoPushBool(UFW_IS_PROT(fw));
5153   } else {
5154     ufoPushBool(0);
5155   }
5156 }
5157
5158 // WORDS-ITER-HIDDEN?
5159 // ( cfa -- bool )
5160 UFWORD(WORDS_ITER_HIDDENQ) {
5161   uint32_t cfa = ufoPop();
5162   UForthWord *fw = UFO_GET_CFAPROC(cfa);
5163   if (fw != NULL && fw->cfa != NULL && !UFW_IS_HID(fw)) {
5164     ufoPushBool(UFW_IS_VOC_HID(fw));
5165   } else {
5166     ufoPushBool(0);
5167   }
5168 }
5169
5170 // WORDS-ITER-TYPE?
5171 // ( cfa -- wtype )
5172 //   0: none/err
5173 //   1: code
5174 //   2: forth
5175 //   3: variable
5176 //   4: value
5177 //   5: constant
5178 //   6: defer
5179 //   7: does
5180 //   8: vocabulary
5181 UFWORD(WORDS_ITER_TYPEQ) {
5182   uint32_t cfa = ufoPop();
5183   UForthWord *fw = UFO_GET_CFAPROC(cfa);
5184   if (fw != NULL && fw->cfa != NULL && !UFW_IS_HID(fw)) {
5185     if (fw->cfa == &ufoDoForth) ufoPush(fw->pfa == fw->pfastart ? 2 : 7);
5186     else if (fw->cfa == &ufoDoVariable) ufoPush(3);
5187     else if (fw->cfa == &ufoDoValue) ufoPush(4);
5188     else if (fw->cfa == &ufoDoConst) ufoPush(5);
5189     else if (fw->cfa == &ufoDoDefer) ufoPush(6);
5190     else if (fw->cfa == &ufoDoVoc) ufoPush(7);
5191     else ufoPush(1); // code
5192   } else {
5193     ufoPush(0);
5194   }
5195 }
5196
5197
5198 // FOREACH-WORD
5199 // ( vocid cfa -- res )
5200 // EXECUTEs cfa, returns final res
5201 // cfa: ( wordcfa -- stopflag )
5202 // i.e. return non-zero from cfa to stop
5203 // res is the result of the last called cfa
5204 UFWORD(UFO_FOREACH_WORD) {
5205   uint32_t cfaidx = ufoPop();
5206   uint32_t vocid = ufoPop();
5207
5208   UForthWord *fw = NULL;
5209   UForthWord *voc = UFO_GET_CFAPROC(vocid);
5210   if (!UFO_VALID_VOC_FW(voc)) ufoFatal("FOREACH-WORD expects a valid vocid");
5211   fw = voc->latest;
5212   while (fw != NULL && (fw->cfa == NULL || UFW_IS_HID(fw))) fw = fw->prevVoc;
5213
5214   uint32_t res = 0;
5215   while (res == 0 && fw != NULL) {
5216     if (fw->cfa != NULL && !UFW_IS_HID(fw)) {
5217       ufoPush(fw->cfaidx);
5218       ufoExecCFAIdxInVM(cfaidx);
5219       res = ufoPop();
5220     }
5221     fw = fw->prevVoc;
5222   }
5223
5224   ufoPush(res);
5225 }
5226
5227
5228 // ////////////////////////////////////////////////////////////////////////// //
5229 // inline stop
5230
5231 // $END_FORTH
5232 UFWORD(DLR_END_FORTH) {
5233   if (ufoMode != UFO_MODE_NATIVE) ufoFatal("$END_FORTH in non-native mode");
5234   if (ufoIsCompiling()) ufoFatal("$END_FORTH: still compiling something");
5235   longjmp(ufoInlineQuitJP, 1);
5236 }
5237
5238
5239 //==========================================================================
5240 //
5241 //  ufoDecompileForth
5242 //
5243 //==========================================================================
5244 static void ufoDecompileForthPart (uint32_t addr, uint32_t endaddr, int indent) {
5245   while (addr != 0 && addr < ufoImageUsed && addr < endaddr) {
5246     uint32_t cfaidx = ufoImgGetU32(addr);
5247     fprintf(stderr, "%8u: ", addr);
5248     for (int f = 0; f < indent; f += 1) fputc(' ', stderr);
5249     if ((cfaidx & UFO_RS_CFA_BIT) == 0) {
5250       fprintf(stderr, "<bad-cfa>");
5251       addr = ~0u;
5252     } else {
5253       cfaidx &= UFO_RS_CFA_MASK;
5254       if (cfaidx >= ufoCFAsUsed) {
5255         fprintf(stderr, "<bad-cfa>");
5256         addr = ~0u;
5257       } else {
5258         UForthWord *fw = ufoForthCFAs[cfaidx];
5259         fprintf(stderr, "%s", fw->name);
5260         addr += 1;
5261         if (fw->cfa == UFCFA(BRANCH) ||
5262             fw->cfa == UFCFA(0BRANCH) ||
5263             fw->cfa == UFCFA(TBRANCH) ||
5264             fw->cfa == UFCFA(LOOP_PAREN) ||
5265             fw->cfa == UFCFA(PLOOP_PAREN))
5266         {
5267           uint32_t jaddr = ufoImgGetU32(addr++);
5268           fprintf(stderr, " %u", jaddr);
5269         } else if (fw->cfa == UFCFA(LIT) || fw->cfa == UFCFA(PAR_LENTER)) {
5270           uint32_t n = ufoImgGetU32(addr++);
5271           fprintf(stderr, " %u", n);
5272         } else if (fw->cfa == UFCFA(STRQ_PAREN) || fw->cfa == UFCFA(STRDOTQ_PAREN)) {
5273           uint32_t count = ufoImgGetU32(addr++);
5274           fprintf(stderr, " cnt=%u; ~", count);
5275           while (count--) {
5276             uint8_t ch = ufoImgGetU32(addr++)&0xffU;
5277                  if (ch == '\r') fprintf(stderr, "\\r");
5278             else if (ch == '\n') fprintf(stderr, "\\n");
5279             else if (ch == '\t') fprintf(stderr, "\\t");
5280             else if (ch == '\\') fprintf(stderr, "\\\\");
5281             else if (ch == '"') fprintf(stderr, "\\`");
5282             else if (ch < 32 || ch == 127) fprintf(stderr, "\\x%02x", ch);
5283             else fprintf(stderr, "%c", (char)ch);
5284           }
5285           fprintf(stderr, "~");
5286         } else if (fw->cfa == UFCFA(CODEBLOCK_PAR)) {
5287           uint32_t jover = ufoImgGetU32(addr++);
5288           addr += 1; // skip cfa idx
5289           fputc('\n', stderr);
5290           ufoDecompileForthPart(addr, jover, indent + 2);
5291           addr = jover;
5292           continue;
5293         }
5294       }
5295     }
5296     fputc('\n', stderr);
5297   }
5298 }
5299
5300
5301 //==========================================================================
5302 //
5303 //  ufoDecompileForth
5304 //
5305 //==========================================================================
5306 static void ufoDecompileForth (UForthWord *fw) {
5307   // decompiler
5308   fprintf(stderr, "====: %s", fw->name);
5309   if (fw->cfa == &ufoDoForth) {
5310     if (fw->pfa != fw->pfastart) {
5311       fprintf(stderr, " -- DOES, data at %d", fw->pfastart);
5312     }
5313     fputc('\n', stderr);
5314     ufoDecompileForthPart(fw->pfa, fw->pfaend, 0);
5315   } else if (fw->cfa == ufoDoDefer) {
5316     fprintf(stderr, " -- DEFER\n");
5317   } else if (fw->cfa == ufoDoConst) {
5318     fprintf(stderr, " -- CONSTANT\n");
5319   } else if (fw->cfa == ufoDoValue) {
5320     fprintf(stderr, " -- VALUE\n");
5321   } else if (fw->cfa == ufoDoVariable) {
5322     fprintf(stderr, " -- VARIABLE\n");
5323   }
5324   fprintf(stderr, "----\n");
5325 }
5326
5327 // (UFO-DECOMPILE)
5328 // ( addr count -- )
5329 UFWORD(UFO_DECOMPILE_INTERNAL) {
5330   UForthWord *fw = ufoNTWordAddrCount();
5331   if (!ufoLastEmitWasCR) { printf("\n"); ufoLastEmitWasCR = 1; }
5332   ufoDecompileForth(fw);
5333 }
5334
5335 // (UFO-BUCKET-STATS)
5336 /*
5337 UFWORD(PAR_UFO_BUCKET_STATS) {
5338   if (!ufoLastEmitWasCR) { printf("\n"); ufoLastEmitWasCR = 1; }
5339   int used = 0, min = 0x7fffffff, max = -1;
5340   for (unsigned f = 0; f < UFO_DICT_HASH_BUCKETS; f += 1) {
5341     UForthWord *fw = ufoForthDictBuckets[f];
5342     if (fw != NULL) {
5343       used += 1;
5344       int total = 0;
5345       while (fw != NULL) { total += 1; fw = fw->hlink; }
5346       if (total < min) min = total;
5347       if (total > max) max = total;
5348     }
5349   }
5350   printf("BUCKETS USED: %d\n", used);
5351   if (used != 0) {
5352     printf("MIN BUCKET: %d\n", min);
5353     printf("MAX BUCKET: %d\n", max);
5354   }
5355 }
5356 */
5357
5358
5359 // ////////////////////////////////////////////////////////////////////////// //
5360 #undef UFWORD
5361
5362 #define UFWORD(name_) ufoRegisterWord(""#name_, ufoWord_##name_, ufoDefaultVocFlags)
5363 #define UFWORDX(strname_,name_) ufoRegisterWord(strname_, ufoWord_##name_, ufoDefaultVocFlags)
5364
5365 #define UFWORD_IMM(name_) ufoRegisterWord(""#name_, ufoWord_##name_, UFW_FLAG_IMMEDIATE | ufoDefaultVocFlags)
5366 #define UFWORDX_IMM(strname_,name_) ufoRegisterWord(strname_, ufoWord_##name_, UFW_FLAG_IMMEDIATE | ufoDefaultVocFlags)
5367
5368
5369 #define UFC(wn_)   ufoCompile(""#wn_);
5370 #define UFS(wn_)   ufoString(""#wn_);
5371 #define UFDS(wn_)  ufoDotString(""#wn_);
5372 #define UFN(wn_)   ufoNumber(wn_);
5373
5374 #define UFBEGIN  UFCALL(BEGIN);
5375 #define UFAGAIN  UFCALL(AGAIN);
5376
5377
5378 //==========================================================================
5379 //
5380 //  ufoDefineQuit
5381 //
5382 //==========================================================================
5383 static void ufoDefineQuit (void) {
5384   ufoDefine("UFO-RUN-LOOP");
5385   UFBEGIN
5386     UFC(RP0!)
5387     UFC(INTERPRET)
5388   UFAGAIN
5389   ufoDefineDone();
5390 }
5391
5392
5393 //==========================================================================
5394 //
5395 //  ufoDefineConstant
5396 //
5397 //==========================================================================
5398 static void ufoDefineConstant (const char *name, uint32_t value) {
5399   UForthWord *fw = ufoRegisterWord(name, &ufoDoConst, ufoDefaultVocFlags);
5400   fw->pfa = ufoImageUsed;
5401   fw->pfastart = ufoImageUsed;
5402   // constant value
5403   ufoImgEmitU32(value);
5404   fw->pfaend = ufoImageUsed;
5405 }
5406
5407
5408 //==========================================================================
5409 //
5410 //  ufoDefineMisc
5411 //
5412 //==========================================================================
5413 static void ufoDefineMisc (void) {
5414   ufoDefaultVocFlags |= UFW_FLAG_PROTECTED;
5415
5416   ufoDefine("NOOP");
5417   ufoDefineDone();
5418
5419   ufoDefine("HEX");
5420   ufoNumber(16); UFC(BASE); UFC(!);
5421   ufoDefineDone();
5422
5423   ufoDefine("DECIMAL");
5424   ufoNumber(10); UFC(BASE); UFC(!);
5425   ufoDefineDone();
5426
5427   ufoDefine("0!");
5428   UFC(0) UFC(SWAP) UFC(!)
5429   ufoDefineDone();
5430
5431   ufoDefine("1!");
5432   UFC(1) UFC(SWAP) UFC(!)
5433   ufoDefineDone();
5434
5435   ufoDefine("+!");
5436   UFC(DUP) UFC(@) UFC(ROT) UFC(+) UFC(SWAP) UFC(!)
5437   ufoDefineDone();
5438
5439   ufoDefine("-!");
5440   UFC(DUP) UFC(@) UFC(ROT) UFC(SWAP) UFC(-) UFC(SWAP) UFC(!)
5441   ufoDefineDone();
5442
5443   ufoDefine("1+!");
5444   UFC(DUP) UFC(@) UFC(1+) UFC(SWAP) UFC(!)
5445   ufoDefineDone();
5446
5447   ufoDefine("2+!");
5448   UFC(DUP) UFC(@) UFC(2+) UFC(SWAP) UFC(!)
5449   ufoDefineDone();
5450
5451   ufoDefine("3+!");
5452   UFC(DUP) UFC(@) UFC(3+) UFC(SWAP) UFC(!)
5453   ufoDefineDone();
5454
5455   ufoDefine("4+!");
5456   UFC(DUP) UFC(@) UFC(4+) UFC(SWAP) UFC(!)
5457   ufoDefineDone();
5458
5459   ufoDefine("1-!");
5460   UFC(DUP) UFC(@) UFC(1-) UFC(SWAP) UFC(!)
5461   ufoDefineDone();
5462
5463   ufoDefine("2-!");
5464   UFC(DUP) UFC(@) UFC(2-) UFC(SWAP) UFC(!)
5465   ufoDefineDone();
5466
5467   ufoDefine("3-!");
5468   UFC(DUP) UFC(@) UFC(3-) UFC(SWAP) UFC(!)
5469   ufoDefineDone();
5470
5471   ufoDefine("4-!");
5472   UFC(DUP) UFC(@) UFC(4-) UFC(SWAP) UFC(!)
5473   ufoDefineDone();
5474
5475   ufoDefine("0=");
5476   ufoNumber(0); UFC(=);
5477   ufoDefineDone();
5478
5479   ufoDefine("0<>");
5480   ufoNumber(0); UFC(<>);
5481   ufoDefineDone();
5482
5483   ufoDefine("0!=");
5484   ufoNumber(0); UFC(!=);
5485   ufoDefineDone();
5486
5487   ufoDefine("0<");
5488   ufoNumber(0); UFC(<);
5489   ufoDefineDone();
5490
5491   ufoDefine("0>");
5492   ufoNumber(0); UFC(>);
5493   ufoDefineDone();
5494
5495   ufoDefine("0<=");
5496   ufoNumber(0); UFC(<=);
5497   ufoDefineDone();
5498
5499   ufoDefine("0>=");
5500   ufoNumber(0); UFC(>=);
5501   ufoDefineDone();
5502
5503   ufoDefine("U0>");
5504   ufoNumber(0); UFC(U>);
5505   ufoDefineDone();
5506
5507   ufoDefine("1=");
5508   ufoNumber(1); UFC(=);
5509   ufoDefineDone();
5510
5511   ufoDefine("1<>");
5512   ufoNumber(1); UFC(<>);
5513   ufoDefineDone();
5514
5515   ufoDefine("1!=");
5516   ufoNumber(1); UFC(!=);
5517   ufoDefineDone();
5518
5519   ufoDefine("1<");
5520   ufoNumber(1); UFC(<);
5521   ufoDefineDone();
5522
5523   ufoDefine("1>");
5524   ufoNumber(1); UFC(>);
5525   ufoDefineDone();
5526
5527   ufoDefine("1<=");
5528   ufoNumber(1); UFC(<=);
5529   ufoDefineDone();
5530
5531   ufoDefine("1>=");
5532   ufoNumber(1); UFC(>=);
5533   ufoDefineDone();
5534
5535   ufoDefine("U1>");
5536   ufoNumber(1); UFC(U>);
5537   ufoDefineDone();
5538
5539   ufoDefine("U1<=");
5540   ufoNumber(1); UFC(U<=);
5541   ufoDefineDone();
5542
5543   ufoDefaultVocFlags &= ~UFW_FLAG_PROTECTED;
5544 }
5545
5546
5547 //==========================================================================
5548 //
5549 //  ufoReset
5550 //
5551 //==========================================================================
5552 static void ufoReset (void) {
5553   ufoWipeLocRecords();
5554
5555   ufoInCondIf = 0;
5556   ufoInColon = 0;
5557
5558   ufoSP = 0; ufoRP = 0;
5559   ufoLP = 0; ufoLBP = 0;
5560
5561   ufoStopVM = 0;
5562
5563   ufoSetStateInterpret();
5564
5565   ufoSetTIB(0); ufoSetIN(0);
5566   ufoImgPutU32(0, 0);
5567
5568   ufoColonWord = NULL;
5569
5570   ufoDefaultVocFlags = 0;
5571
5572   ufoSetForthOnlyDefs();
5573 }
5574
5575
5576 //==========================================================================
5577 //
5578 //  ufoInitCommon
5579 //
5580 //==========================================================================
5581 static void ufoInitCommon (void) {
5582   ufoForthDict = NULL;
5583   ufoColonWord = NULL;
5584   ufoLastVoc = ~0U; ufoDefaultVocFlags = 0;
5585   ufoVSP = 0; ufoForthVocCFA = 0; ufoCompSuppVocCFA = 0; ufoMacroVocCFA = 0;
5586
5587   ufoDStack = calloc(UFO_DSTACK_SIZE, sizeof(ufoDStack[0]));
5588   ufoRStack = calloc(UFO_RSTACK_SIZE, sizeof(ufoRStack[0]));
5589   ufoLStack = calloc(UFO_LSTACK_SIZE, sizeof(ufoLStack[0]));
5590   ufoForthCFAs = calloc(UFO_MAX_WORDS, sizeof(ufoForthCFAs[0]));
5591   // CFA 0 is reserved for FORTH vocabulary
5592   ufoCFAsUsed = 1;
5593
5594   // reserve TIB
5595   while (ufoImageUsed <= ufoTIBAreaSize) ufoImgEmitU32(0);
5596
5597   // BASE
5598   ufoBASEaddr = ufoImageUsed;
5599   ufoImgEmitU32(10);
5600
5601   // STATE
5602   ufoSTATEaddr = ufoImageUsed;
5603   ufoImgEmitU32(0);
5604
5605   // (TIB)
5606   ufoAddrTIB = ufoImageUsed;
5607   ufoImgEmitU32(0);
5608
5609   // (>IN)
5610   ufoAddrIN = ufoImageUsed;
5611   ufoImgEmitU32(0);
5612
5613   // CONTEXT
5614   ufoAddrContext = ufoImageUsed;
5615   ufoImgEmitU32(0);
5616
5617   // CURRENT
5618   ufoAddrCurrent = ufoImageUsed;
5619   ufoImgEmitU32(0);
5620
5621   ufoSetStateInterpret();
5622
5623   UForthWord *fw = calloc(1, sizeof(UForthWord));
5624   fw->name = strdup("FORTH");
5625   fw->cfa = NULL;
5626   FW_SET_CFAIDX(fw, 0); // known thing
5627   fw->flags = UFW_FLAG_PROTECTED;
5628   fw->pfa = 0xffffffffU;
5629   ufoForthVocCFA = fw->cfaidx;
5630   ufoForthCFAs[0] = fw; // for proper links
5631   ufoCreateVocabData(fw);
5632   // set CURRENT and CONTEXT
5633   ufoSetForthOnlyDefs();
5634   // and now link
5635   ufoLinkWordToDict(fw);
5636
5637   ufoDefaultVocFlags = UFW_FLAG_PROTECTED;
5638
5639   UForthWord *vcomp = ufoCreateVocSetOnlyDefs("COMPILER", NULL);
5640   ufoCompSuppVocCFA = vcomp->cfaidx;
5641   ufoSetForthOnlyDefs();
5642
5643   ufoMacroVocCFA = ufoCreateVocSetOnlyDefs("URASM-MACROS", NULL)->cfaidx;
5644   ufoSetForthOnlyDefs();
5645
5646   UForthWord *vstr = ufoCreateVocSetOnlyDefs("STRING", NULL);
5647   ufoSetForthOnlyDefs();
5648
5649
5650   // base low-level interpreter words
5651   ufoDefineConstant("FALSE", 0);
5652   ufoDefineConstant("TRUE", ufoTrueValue);
5653
5654   ufoDefineConstant("BL", 32);
5655   ufoDefineConstant("NL", 10);
5656
5657   //UFWORDX("(UFO-BUCKET-STATS)", PAR_UFO_BUCKET_STATS);
5658   UFWORDX("SP0!", SP0_PUT);
5659   UFWORDX("RP0!", RP0_PUT);
5660   UFWORD(BASE);
5661   UFWORD(STATE);
5662   UFWORDX("@", PEEK);
5663   UFWORDX("!", POKE);
5664   UFWORDX("C@", CPEEK);
5665   UFWORDX("C!", CPOKE);
5666   UFWORDX("W@", WPEEK);
5667   UFWORDX("W!", WPOKE);
5668   UFWORDX("C,", CCOMMA);
5669   UFWORDX(",", COMMA);
5670
5671   //ufoDefaultVocFlags |= UFW_FLAG_VOC_HIDDEN;
5672   ufoVocSetOnlyDefs(vcomp);
5673   UFWORD(LIT);
5674   UFWORDX("(BRANCH)", BRANCH);
5675   UFWORDX("(TBRANCH)", TBRANCH);
5676   UFWORDX("(0BRANCH)", 0BRANCH);
5677   UFWORDX("(DO)", DO_PAREN);
5678   UFWORDX("(LOOP)", LOOP_PAREN);
5679   UFWORDX("(+LOOP)", PLOOP_PAREN);
5680
5681   // low-level compiler words
5682   UFWORDX("STRLITERAL", STRLITERAL);
5683
5684   UFWORDX("(\")", STRQ_PAREN);
5685   UFWORDX("(.\")", STRDOTQ_PAREN);
5686
5687   UFWORDX("(EXIT)", PAR_EXIT);
5688   UFWORDX("(L-ENTER)", PAR_LENTER);
5689   UFWORDX("(L-LEAVE)", PAR_LLEAVE);
5690
5691   UFWORDX("?EXEC", QEXEC);
5692   UFWORDX("?COMP", QCOMP);
5693   UFWORDX("?PAIRS", QPAIRS);
5694   UFWORDX("COMP-BACK", COMP_BACK);
5695   UFWORDX("COMP-FWD", COMP_FWD);
5696
5697   UFWORDX("(LOCAL@)", LOCAL_LOAD);
5698   UFWORDX("(LOCAL!)", LOCAL_STORE);
5699
5700   UFWORDX("(LOCAL@-1)", LOCAL_LOAD_1);
5701   UFWORDX("(LOCAL@-2)", LOCAL_LOAD_2);
5702   UFWORDX("(LOCAL@-3)", LOCAL_LOAD_3);
5703   UFWORDX("(LOCAL@-4)", LOCAL_LOAD_4);
5704   UFWORDX("(LOCAL@-5)", LOCAL_LOAD_5);
5705   UFWORDX("(LOCAL@-6)", LOCAL_LOAD_6);
5706   UFWORDX("(LOCAL@-7)", LOCAL_LOAD_7);
5707   UFWORDX("(LOCAL@-8)", LOCAL_LOAD_8);
5708   UFWORDX("(LOCAL@-9)", LOCAL_LOAD_9);
5709   UFWORDX("(LOCAL@-10)", LOCAL_LOAD_10);
5710   UFWORDX("(LOCAL@-11)", LOCAL_LOAD_11);
5711   UFWORDX("(LOCAL@-12)", LOCAL_LOAD_12);
5712   UFWORDX("(LOCAL@-13)", LOCAL_LOAD_13);
5713   UFWORDX("(LOCAL@-14)", LOCAL_LOAD_14);
5714   UFWORDX("(LOCAL@-15)", LOCAL_LOAD_15);
5715   UFWORDX("(LOCAL@-16)", LOCAL_LOAD_16);
5716
5717   UFWORDX("(LOCAL!-1)", LOCAL_STORE_1);
5718   UFWORDX("(LOCAL!-2)", LOCAL_STORE_2);
5719   UFWORDX("(LOCAL!-3)", LOCAL_STORE_3);
5720   UFWORDX("(LOCAL!-4)", LOCAL_STORE_4);
5721   UFWORDX("(LOCAL!-5)", LOCAL_STORE_5);
5722   UFWORDX("(LOCAL!-6)", LOCAL_STORE_6);
5723   UFWORDX("(LOCAL!-7)", LOCAL_STORE_7);
5724   UFWORDX("(LOCAL!-8)", LOCAL_STORE_8);
5725   UFWORDX("(LOCAL!-9)", LOCAL_STORE_9);
5726   UFWORDX("(LOCAL!-10)", LOCAL_STORE_10);
5727   UFWORDX("(LOCAL!-11)", LOCAL_STORE_11);
5728   UFWORDX("(LOCAL!-12)", LOCAL_STORE_12);
5729   UFWORDX("(LOCAL!-13)", LOCAL_STORE_13);
5730   UFWORDX("(LOCAL!-14)", LOCAL_STORE_14);
5731   UFWORDX("(LOCAL!-15)", LOCAL_STORE_15);
5732   UFWORDX("(LOCAL!-16)", LOCAL_STORE_16);
5733
5734   UFWORDX("(CODEBLOCK)", CODEBLOCK_PAR);
5735   //ufoDefaultVocFlags &= ~UFW_FLAG_VOC_HIDDEN;
5736   ufoSetForthOnlyDefs();
5737
5738
5739   UFWORDX_IMM("RECURSE", RECURSE_IMM);
5740   UFWORD(EXECUTE);
5741
5742   UFWORD(DUP);
5743   UFWORDX("?DUP", QDUP);
5744   UFWORDX("2DUP", DDUP);
5745   UFWORD(DROP);
5746   UFWORDX("2DROP", DDROP);
5747   UFWORD(SWAP);
5748   UFWORDX("2SWAP", DSWAP);
5749   UFWORD(OVER);
5750   UFWORDX("2OVER", DOVER);
5751   UFWORD(ROT);
5752   UFWORD(NROT);
5753
5754   UFWORD(RDUP);
5755   UFWORD(RDROP);
5756   UFWORD(RSWAP);
5757   UFWORD(ROVER);
5758   UFWORD(RROT);
5759   UFWORD(RNROT);
5760
5761   UFWORDX(">R", DTOR);
5762   UFWORDX("R>", RTOD);
5763   UFWORDX("R@", RPEEK);
5764
5765   UFWORDX("CMOVE>", CMOVE_FWD);
5766   UFWORDX("CMOVE", CMOVE_BACK);
5767   UFWORDX("MOVE", MOVE);
5768
5769   ufoVocSetOnlyDefs(vstr);
5770   UFWORDX("=", STREQU);
5771   UFWORDX("=CI", STREQUCI);
5772   UFWORDX("CMP", STRCMP);
5773   UFWORDX("CMP-CI", STRCMPCI);
5774   UFWORDX("UNESCAPE", STR_UNESCAPE);
5775   ufoSetForthOnlyDefs();
5776
5777   // some useful words
5778   UFWORDX_IMM("(", COMMENTPAREN);
5779   UFWORDX_IMM("\\", COMMENTEOL);
5780   UFWORDX_IMM(";;", COMMENTEOL);
5781   UFWORDX_IMM("(*", COMMENTML);
5782   UFWORDX_IMM("((", COMMENTML_NESTED);
5783
5784   UFWORD(COUNT);
5785   UFWORD(EMIT);
5786   UFWORD(XEMIT);
5787   UFWORD(TYPE);
5788   UFWORD(XTYPE);
5789   UFWORD(SPACE);
5790   UFWORD(SPACES);
5791   UFWORD(CR);
5792   UFWORD(ENDCR);
5793   UFWORDX("LASTCR?", LASTCRQ);
5794   UFWORDX("LASTCR!", LASTCRSET);
5795
5796   // number printing
5797   UFWORDX(".", DOT);
5798   UFWORDX("U.", UDOT);
5799   UFWORDX(".R", DOTR);
5800   UFWORDX("U.R", UDOTR);
5801
5802   // simple math
5803   UFWORD(NEGATE);
5804   UFWORDX("+", PLUS);
5805   UFWORDX("-", MINUS);
5806   UFWORDX("*", MUL);
5807   UFWORDX("U*", UMUL);
5808   UFWORDX("/", DIV);
5809   UFWORDX("U/", UDIV);
5810   UFWORDX("MOD", MOD);
5811   UFWORDX("UMOD", UMOD);
5812   UFWORDX("/MOD", DIVMOD);
5813   UFWORDX("U/MOD", UDIVMOD);
5814
5815   // logic
5816   UFWORDX("<", LESS);
5817   UFWORDX(">", GREAT);
5818   UFWORDX("<=", LESSEQU);
5819   UFWORDX(">=", GREATEQU);
5820   UFWORDX("U<", ULESS);
5821   UFWORDX("U>", UGREAT);
5822   UFWORDX("U<=", ULESSEQU);
5823   UFWORDX("U>=", UGREATEQU);
5824   UFWORD(WITHIN);
5825   UFWORD(UWITHIN);
5826   UFWORDX("BOUNDS?", BOUNDSQ);
5827
5828   UFWORDX("=", EQU);
5829   UFWORDX("<>", NOTEQU);
5830   UFWORDX("!=", NOTEQU);
5831   UFWORD(NOT);
5832   UFWORD(NOTNOT);
5833   UFWORD(BITNOT);
5834   UFWORD(AND);
5835   UFWORDX("LOGAND", LOGAND);
5836   UFWORD(OR);
5837   UFWORDX("LOGOR", LOGOR);
5838   UFWORD(XOR);
5839
5840   UFWORDX("1+", ONEPLUS);
5841   UFWORDX("1-", ONEMINUS);
5842   UFWORDX("2+", TWOPLUS);
5843   UFWORDX("2-", TWOMINUS);
5844   UFWORDX("3+", THREEPLUS);
5845   UFWORDX("3-", THREEMINUS);
5846   UFWORDX("4+", FOURPLUS);
5847   UFWORDX("4-", FOURMINUS);
5848   UFWORDX("2U*", ONESHL);
5849   UFWORDX("2U/", ONESHR);
5850
5851   UFWORD(LSHIFT);
5852   UFWORD(RSHIFT);
5853
5854   UFWORDX_IMM("\"", STRQ);
5855   UFWORDX_IMM(".\"", STRDOTQ);
5856
5857   UFWORDX("LITERAL", LITERAL);
5858   UFWORDX_IMM("COMPILE", COMPILE_IMM);
5859   UFWORDX_IMM("[COMPILE]", XCOMPILE_IMM);
5860   UFWORDX_IMM("[']", XTICK_IMM);
5861   UFWORDX_IMM("['PFA]", XTICKPFA_IMM);
5862
5863   UFWORDX_IMM("'", TICK_IMM);
5864   UFWORDX_IMM("'PFA", TICKPFA_IMM);
5865
5866   UFWORDX_IMM("EXIT", EXIT_IMM);
5867
5868   UFWORD_IMM(IF);
5869   UFWORD_IMM(IFNOT);
5870   UFWORD_IMM(ELSE);
5871   UFWORD_IMM(ENDIF);
5872   UFWORDX_IMM("THEN", ENDIF);
5873   UFWORD_IMM(BEGIN);
5874   UFWORD_IMM(AGAIN);
5875   UFWORD_IMM(WHILE);
5876   UFWORDX_IMM("NOT-WHILE", NOT_WHILE);
5877   UFWORDX_IMM("REPEAT", AGAIN);
5878   UFWORD_IMM(UNTIL);
5879   UFWORDX_IMM("NOT-UNTIL", NOT_UNTIL);
5880   UFWORD_IMM(CASE);
5881   UFWORD_IMM(ENDCASE);
5882   UFWORD_IMM(OF);
5883   UFWORDX_IMM("&OF", AND_OF);
5884   UFWORD_IMM(ENDOF);
5885   UFWORD_IMM(OTHERWISE);
5886   UFWORD_IMM(DO);
5887   UFWORD_IMM(LOOP);
5888   UFWORDX_IMM("+LOOP", PLOOP);
5889   UFWORD(I);
5890   UFWORD(J);
5891   UFWORDX("I'", ITICK);
5892   UFWORDX("J'", JTICK);
5893
5894   UFWORDX(":", COLON);
5895   UFWORDX_IMM(";", SEMI);
5896   UFWORD(CREATE);
5897   UFWORDX("CREATE;", CREATE_SEMI);
5898   UFWORDX("DOES>", DOES);
5899
5900   UFWORD(VOCABULARY);
5901   UFWORDX_IMM("VOCID:", VOCID_IMM);
5902   UFWORD(PREVIOUS);
5903   UFWORD(ALSO);
5904   UFWORD(ONLY);
5905   UFWORD(DEFINITIONS);
5906   UFWORDX("NESTED-VOCABULARY", NESTED_VOCABULARY);
5907   UFWORDX("<PUBLIC-WORDS>", VOC_PUBLIC_MODE);
5908   UFWORDX("<HIDDEN-WORDS>", VOC_HIDDEN_MODE);
5909   UFWORDX("<PROTECTED-WORDS>", VOC_PROTECTED_MODE);
5910   UFWORDX("<UNPROTECTED-WORDS>", VOC_UNPROTECTED_MODE);
5911   UFWORD(IMMEDIATE);
5912   UFWORDX("(PROTECTED)", PAR_PROTECTED);
5913   UFWORDX("(HIDDEN)", PAR_HIDDEN);
5914
5915   UFWORDX_IMM("LOCALS:", LOCALS_IMM);
5916   UFWORDX_IMM("ARGS:", ARGS_IMM);
5917
5918   // TIB parser
5919   UFWORDX("(PARSE)", PAR_PARSE);
5920   UFWORDX("(WORD-OR-PARSE)", PAR_WORD_OR_PARSE);
5921   UFWORD(WORD);
5922   UFWORDX("PARSE-TO-HERE", PARSE_TO_HERE);
5923   UFWORDX("PARSE-NAME", PARSE_NAME);
5924   UFWORDX("PARSE", PARSE);
5925
5926   UFWORDX("TIB-ADVANCE-LINE", TIB_ADVANCE_LINE);
5927   UFWORDX("TIB-CHAR?", TIB_PEEKCH);
5928   UFWORDX("TIB-PEEKCH", TIB_PEEKCH);
5929   UFWORDX("TIB-GETCH", TIB_GETCH);
5930   UFWORDX("TIB-SKIPCH", TIB_SKIPCH);
5931
5932   UFWORDX(">IN", GET_IN_ADDR);
5933   UFWORDX("TIB", GET_TIB_ADDR);
5934   UFWORDX("TIB-SIZE", GET_TIB_SIZE);
5935
5936   // interpreter
5937   UFWORD(NFIND);
5938   UFWORDX("(NUMBER)", XNUMBER);
5939   UFWORD(INTERPRET);
5940
5941   UFWORDX("VALUE", VALUE);
5942   UFWORDX("VAR-NOALLOT", VAR_NOALLOT);
5943   UFWORDX("VARIABLE", VARIABLE);
5944   UFWORDX("CONSTANT", CONSTANT);
5945   UFWORDX("DEFER", DEFER);
5946   UFWORDX("LOAD-DATA-FILE", LOAD_DATA_FILE);
5947   UFWORDX("N-ALLOT", N_ALLOT);
5948   UFWORDX("ALLOT", ALLOT);
5949   UFWORDX("HERE", HERE);
5950   UFWORDX("PAD", PAD);
5951   UFWORDX_IMM("TO", TO_IMM);
5952   UFWORDX("NAMED-TO", NAMED_TO);
5953   UFWORDX("CFA->PFA", CFA2PFA);
5954
5955   UFWORDX_IMM("[", LSQBRACKET_IMM);
5956   UFWORDX("]", RSQBRACKET);
5957
5958   UFWORDX_IMM("[:", CODEBLOCK_START_IMM);
5959   UFWORDX_IMM(";]", CODEBLOCK_END_IMM);
5960     /* code blocks are used like this:
5961          : A  [: ( addr count -- res ) TYPE 0 ;] ASM-FOREACH-LABEL DROP ;
5962        i.e. it creates inlined code block, and returns its CFA.
5963      */
5964
5965
5966   // UrAsm API
5967   (void)ufoCreateVocSetOnlyDefs("URASM", NULL);
5968   // UrAsm label types
5969   // WARNING! keep in sync with C source!
5970   ufoDefineConstant("LBL-TYPE-UNKNOWN", UFO_ZX_LABEL_UNKNOWN);
5971   ufoDefineConstant("LBL-TYPE-VAR", UFO_ZX_LABEL_VAR);
5972   ufoDefineConstant("LBL-TYPE-EQU", UFO_ZX_LABEL_EQU);
5973   ufoDefineConstant("LBL-TYPE-CODE", UFO_ZX_LABEL_CODE);
5974   ufoDefineConstant("LBL-TYPE-STOFS", UFO_ZX_LABEL_STOFS);
5975   ufoDefineConstant("LBL-TYPE-DATA", UFO_ZX_LABEL_DATA);
5976
5977   UFWORDX("C,", ZX_CCOMMA);
5978   UFWORDX("W,", ZX_WCOMMA);
5979   UFWORDX("C@", ZX_CPEEK);
5980   UFWORDX("C!", ZX_CPOKE);
5981   UFWORDX("W@", ZX_WPEEK);
5982   UFWORDX("W!", ZX_WPOKE);
5983
5984   UFWORDX("RESERVED?", ZX_RESERVEDQ);
5985   UFWORDX("RESERVED!", ZX_RESERVEDS);
5986
5987   UFWORDX("HAS-LABEL?", UR_HAS_LABELQ);
5988   UFWORDX("LABEL-TYPE?", UR_GET_LABELQ_TYPE);
5989   UFWORDX("GET-LABEL", UR_GET_LABELQ);
5990   UFWORDX("FOREACH-LABEL", UR_FOREACH_LABEL);
5991   UFWORDX("SET-LABEL-VAR", UR_SET_LABEL_VAR);
5992   UFWORDX("SET-LABEL-EQU", UR_SET_LABEL_EQU);
5993   UFWORDX("SET-LABEL-CODE", UR_SET_LABEL_CODE);
5994   UFWORDX("SET-LABEL-STOFS", UR_SET_LABEL_STOFS);
5995   UFWORDX("SET-LABEL-DATA", UR_SET_LABEL_DATA);
5996   UFWORDX("PASS@", UR_PASSQ);
5997
5998   UFWORDX("LOAD-DATA-FILE", ZX_LOAD_DATA_FILE);
5999
6000   UFWORDX("ORG@", UR_GETORG);
6001   UFWORDX("DISP@", UR_GETDISP);
6002   UFWORDX("ENT@", UR_GETENT);
6003   UFWORDX("ORG!", UR_SETORG);
6004   UFWORDX("DISP!", UR_SETDISP);
6005   UFWORDX("ENT!", UR_SETENT);
6006
6007   UFWORDX("WARNING", ASM_WARNING);
6008   UFWORDX("ERROR", ASM_ERROR);
6009   ufoSetForthOnlyDefs();
6010
6011
6012   // conditional compilation
6013   UFWORDX_IMM("$IF", DLR_IF_IMM);
6014   UFWORDX_IMM("$ELSE", DLR_ELSE_IMM);
6015   UFWORDX_IMM("$ELIF", DLR_ELIF_IMM);
6016   UFWORDX_IMM("$ENDIF", DLR_ENDIF_IMM);
6017
6018   UFWORDX_IMM("$DEFINE", DLR_DEFINE);
6019   UFWORDX_IMM("$UNDEF", DLR_UNDEF);
6020
6021   UFWORDX_IMM("$LABEL-DATA:", DLR_LABEL_DATA_IMM);
6022   UFWORDX_IMM("$LABEL-CODE:", DLR_LABEL_CODE_IMM);
6023
6024   UFWORDX_IMM("$INCLUDE", DLR_INCLUDE);
6025   UFWORDX_IMM("$INCLUDE-ONCE", DLR_INCLUDE_ONCE);
6026
6027   UFWORDX("INCLUDE", INCLUDE);
6028
6029
6030   (void)ufoCreateVocSetOnlyDefs("UFO", NULL);
6031   UFWORDX("FATAL", UFO_FATAL);
6032
6033   // UrForth internal word types
6034   ufoDefineConstant("WTYPE-NONE", 0);
6035   ufoDefineConstant("WTYPE-CODE", 1);
6036   ufoDefineConstant("WTYPE-FORTH", 2);
6037   ufoDefineConstant("WTYPE-VARIABLE", 3);
6038   ufoDefineConstant("WTYPE-VALUE", 4);
6039   ufoDefineConstant("WTYPE-CONSTANT", 5);
6040   ufoDefineConstant("WTYPE-DEFER", 6);
6041   ufoDefineConstant("WTYPE-DOES", 7);
6042   ufoDefineConstant("WTYPE-VOCABULARY", 8);
6043
6044   UFWORDX("WORDS-ITER-NEW", WORDS_ITER_NEW);
6045   UFWORDX("WORDS-ITER-PREV", WORDS_ITER_PREV);
6046   UFWORDX("WORDS-ITER-NAME", WORDS_ITER_NAME);
6047   UFWORDX("WORDS-ITER-PFA", WORDS_ITER_PFA);
6048   UFWORDX("WORDS-ITER-IMM?", WORDS_ITER_IMMQ);
6049   UFWORDX("WORDS-ITER-PROT?", WORDS_ITER_PROTQ);
6050   UFWORDX("WORDS-ITER-HIDDEN?", WORDS_ITER_HIDDENQ);
6051   UFWORDX("WORDS-ITER-TYPE?", WORDS_ITER_TYPEQ);
6052   UFWORDX("FOREACH-WORD", UFO_FOREACH_WORD);
6053
6054   UFWORDX("<MODE@>", UFO_MODER);
6055
6056   ufoSetForthOnlyDefs();
6057
6058
6059   (void)ufoCreateVocSetOnlyDefs("DEBUG", NULL);
6060   UFWORDX("DUMP-STACK", DUMP_STACK);
6061   //ufoDefaultVocFlags |= UFW_FLAG_VOC_HIDDEN;
6062   UFWORDX("DECOMPILE", UFO_DECOMPILE_INTERNAL);
6063   UFWORDX("BP", UFO_BP);
6064   //ufoDefaultVocFlags &= ~UFW_FLAG_VOC_HIDDEN;
6065   ufoSetForthOnlyDefs();
6066
6067   ufoReset();
6068
6069   ufoDefineMisc();
6070
6071   ufoDefaultVocFlags &= ~UFW_FLAG_PROTECTED;
6072
6073
6074   ufoDefaultVocFlags |= UFW_FLAG_PROTECTED;
6075
6076   UFWORDX_IMM("$END_FORTH", DLR_END_FORTH);
6077   UFWORDX_IMM("$END-FORTH", DLR_END_FORTH);
6078   //UFWORDX("$END-FORTH", DLR_END_FORTH_NOIMM);
6079
6080   // some ZX words
6081   UFWORDX("ZXADDR?", ZXADDRQ);
6082   UFWORDX("(TOZX)", TOZX);
6083   UFWORDX_IMM("TOZX", TOZX_IMM);
6084   UFWORDX("(FROMZX)", FROMZX);
6085   UFWORDX_IMM("FROMZX", FROMZX_IMM);
6086
6087   ufoDefineQuit();
6088
6089   ufoDefaultVocFlags &= ~UFW_FLAG_PROTECTED;
6090 }
6091
6092
6093 //==========================================================================
6094 //
6095 //  ufoRunVM
6096 //
6097 //  address interpreter
6098 //
6099 //==========================================================================
6100 static void ufoRunVM (void) {
6101   ufoStopVM = 0;
6102   while (!ufoStopVM) {
6103     uint32_t cfaidx = ufoImgGetU32(ufoIP++);
6104     if (cfaidx & UFO_RS_CFA_BIT) {
6105       cfaidx &= UFO_RS_CFA_MASK;
6106       if (cfaidx >= ufoCFAsUsed) {
6107         ufoFatal("UFO tried to execute an unknown word: 0x%08x (max is 0x%08x); IP=0x%08x", cfaidx, ufoCFAsUsed, ufoIP-1);
6108       }
6109       UForthWord *fw = ufoForthCFAs[cfaidx];
6110       if (fw == NULL) ufoFatal("VM internal error: empty CFA");
6111       fw->cfa(fw);
6112     } else {
6113       ufoFatal("VM tried to execute something that is not a word");
6114     }
6115   }
6116   ufoStopVM = 0;
6117 }
6118
6119
6120 //==========================================================================
6121 //
6122 //  ufoRunIt
6123 //
6124 //==========================================================================
6125 static void ufoRunIt (const char *wname) {
6126   UForthWord *fw = ufoAlwaysWord(wname);
6127   if (fw->cfa != &ufoDoForth) {
6128     ufoFatal("UFO '%s' word is not a Forth word", wname);
6129   }
6130   ufoExecuteNativeWordInVM(fw);
6131 }
6132
6133
6134 //==========================================================================
6135 //
6136 //  ufoInlineInit
6137 //
6138 //==========================================================================
6139 void ufoInlineInit (void) {
6140   ufoMode = UFO_MODE_NATIVE;
6141   ufoTrueValue = ~0u; // -1 is better!
6142
6143   ufoInFileLine = 0; ufoCondStLine = -1;
6144   ufoInFileName = NULL;
6145   ufoInFile = NULL;
6146   ufoLastIncPath = NULL;
6147
6148   ufoInitCommon();
6149
6150   ufoSetStateInterpret();
6151
6152   ufoZXPostInit();
6153
6154   ufoReset();
6155
6156   // load ufo modules
6157   char *ufmname = ufoCreateIncludeName("init", 1, NULL);
6158   FILE *ufl = ufoOpenFileOrDir(&ufmname);
6159   if (ufl) {
6160     ufoPushInFile();
6161     ufoInFileName = ufmname;
6162     ufoInFile = ufl;
6163     setLastIncPath(ufoInFileName);
6164   } else {
6165     free(ufmname);
6166   }
6167 }
6168
6169
6170 //==========================================================================
6171 //
6172 //  ufoInlineRun
6173 //
6174 //==========================================================================
6175 void ufoInlineRun (void) {
6176   if (ufoMode == UFO_MODE_NONE) {
6177     ufoInlineInit();
6178   }
6179   ufoMode = UFO_MODE_NATIVE;
6180
6181   if (setjmp(ufoInlineQuitJP) == 0) {
6182     ufoReset();
6183     //UFCALL(INTERPRET);
6184     ufoRunIt("UFO-RUN-LOOP");
6185     ufo_assert(0); // the thing that should not be
6186   } else {
6187     while (ufoFileStackPos != 0) ufoPopInFile();
6188   }
6189 }
6190
6191
6192 //==========================================================================
6193 //
6194 //  ufoIsMacro
6195 //
6196 //==========================================================================
6197 uint32_t ufoIsMacro (const char *wname) {
6198   if (ufoMode != UFO_MODE_NONE) {
6199     UForthWord *fw = ufoFindWordMacro(wname);
6200     if (fw != NULL && fw->cfa == &ufoDoForth) return fw->cfaidx;
6201   }
6202   return 0;
6203 }
6204
6205
6206 //==========================================================================
6207 //
6208 //  ufoMacroRun
6209 //
6210 //==========================================================================
6211 void ufoMacroRun (uint32_t cfaidx, const char *line, const char *fname, int lnum) {
6212   ufo_assert(ufoMode != UFO_MODE_NONE);
6213   UForthWord *fw = UFO_GET_NATIVE_CFA(cfaidx);
6214   ufoMode = UFO_MODE_MACRO;
6215   if (fw->cfa != &ufoDoForth) {
6216     ufoFatal("UFO '%s' macro word is not a Forth word", fw->name);
6217   }
6218
6219   if (setjmp(ufoInlineQuitJP) == 0) {
6220     ufoReset();
6221     ufoLoadMacroLine(line, fname, lnum);
6222     ufoExecuteNativeWordInVM(fw);
6223     while (ufoFileStackPos != 0) ufoPopInFile();
6224   } else {
6225     while (ufoFileStackPos != 0) ufoPopInFile();
6226     ufoFatal("wtf with UFO macro?!");
6227   }
6228 }