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