src/urforth.c

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