src/urforth.c

   1 // and now for something completely different...
   2 // UrAsm built-in Forth Engine!
   3 // GPLv3 ONLY
   4 #ifdef WIN32
   5 #include <windows.h>
   6 #endif
   7 #include <stdarg.h>
   8 #include <setjmp.h>
   9 #include <stdio.h>
  10 #include <stdlib.h>
  11 #include <string.h>
  12 #include <time.h>
  13 #include <unistd.h>
  14
  15 #include <sys/stat.h>
  16 #include <sys/types.h>
  17
  18 #include "urforth.h"
  19
  20
  21 //#define UFO_DEBUG_STARTUP_TIMES
  22 //#define UFO_DEBUG_FATAL_ABORT
  23 //#define UFO_TRACE_VM_DOER
  24 //#define UFO_TRACE_VM_RUN
  25 //#define UFO_DEBUG_INCLUDE
  26 //#define UFO_DEBUG_DUMP_NEW_HEADERS
  27 //#define UFO_DEBUG_FIND_WORD
  28 //#define UFO_DEBUG_FIND_WORD_IN_VOC
  29 //#define UFO_DEBUG_FIND_WORD_COLON
  30
  31 // 2/8 msecs w/o inlining
  32 // 1/5 msecs with inlining
  33 #if 1
  34 # define UFO_FORCE_INLINE static inline __attribute__((always_inline))
  35 #else
  36 # define UFO_FORCE_INLINE static __attribute__((noinline)) __attribute__((unused))
  37 #endif
  38
  39
  40 // should not be bigger than this!
  41 #define UFO_MAX_WORD_LENGTH  (250)
  42
  43 #define UFO_ALIGN4(v_)  (((v_) + 3u) / 4u * 4u)
  44
  45
  46 static const char *ufo_assert_failure (const char *cond, const char *fname, int fline,
  47                                        const char *func)
  48 {
  49   for (const char *t = fname; *t; ++t) {
  50     #ifdef WIN32
  51     if (*t == '/' || *t == '\\') fname = t+1;
  52     #else
  53     if (*t == '/') fname = t+1;
  54     #endif
  55   }
  56   fflush(stdout);
  57   fprintf(stderr, "\n%s:%d: Assertion in `%s` failed: %s\n", fname, fline, func, cond);
  58   fflush(stderr);
  59   abort();
  60 }
  61
  62 #define ufo_assert(cond_)  do { if (__builtin_expect((!(cond_)), 0)) { ufo_assert_failure(#cond_, __FILE__, __LINE__, __PRETTY_FUNCTION__); } } while (0)
  63
  64
  65 #ifndef WIN32
  66 static time_t secstart = 0;
  67 #endif
  68
  69
  70 //==========================================================================
  71 //
  72 //  ufo_get_msecs
  73 //
  74 //==========================================================================
  75 static uint64_t ufo_get_msecs (void) {
  76   #ifdef WIN32
  77   return GetTickCount();
  78   #else
  79   struct timespec ts;
  80   #ifdef CLOCK_MONOTONIC
  81   ufo_assert(clock_gettime(CLOCK_MONOTONIC, &ts) == 0);
  82   #else
  83   // this should be available everywhere
  84   ufo_assert(clock_gettime(CLOCK_REALTIME, &ts) == 0);
  85   #endif
  86   // first run?
  87   if (secstart == 0) {
  88     secstart = ts.tv_sec+1;
  89     ufo_assert(secstart); // it should not be zero
  90   }
  91   return (uint64_t)(ts.tv_sec-secstart+2)*1000U+(uint32_t)ts.tv_nsec/1000000U;
  92   // nanoseconds
  93   //return (uint64_t)(ts.tv_sec-secstart+2)*1000000000U+(uint32_t)ts.tv_nsec;
  94   #endif
  95 }
  96
  97
  98 //==========================================================================
  99 //
 100 //  joaatHashBufCI
 101 //
 102 //==========================================================================
 103 UFO_FORCE_INLINE uint32_t joaatHashBufCI (const void *buf, size_t len) {
 104   uint32_t hash = 0x29a;
 105   const uint8_t *s = (const uint8_t *)buf;
 106   while (len--) {
 107     //hash += (uint8_t)locase1251(*s++);
 108     hash += (*s++)|0x20; // this converts ASCII capitals to locase (and destroys other, but who cares)
 109     hash += hash<<10;
 110     hash ^= hash>>6;
 111   }
 112   // finalize
 113   hash += hash<<3;
 114   hash ^= hash>>11;
 115   hash += hash<<15;
 116   return hash;
 117 }
 118
 119
 120 //==========================================================================
 121 //
 122 //  toUpper
 123 //
 124 //==========================================================================
 125 UFO_FORCE_INLINE char toUpper (char ch) {
 126   return (ch >= 'a' && ch <= 'z' ? ch-'a'+'A' : ch);
 127 }
 128
 129
 130 //==========================================================================
 131 //
 132 //  toUpperU8
 133 //
 134 //==========================================================================
 135 UFO_FORCE_INLINE uint8_t toUpperU8 (uint8_t ch) {
 136   return (ch >= 'a' && ch <= 'z' ? ch-'a'+'A' : ch);
 137 }
 138
 139
 140 //==========================================================================
 141 //
 142 //  digitInBase
 143 //
 144 //==========================================================================
 145 UFO_FORCE_INLINE int digitInBase (char ch, int base) {
 146   switch (ch) {
 147     case '0' ... '9': ch = ch - '0'; break;
 148     case 'A' ... 'Z': ch = ch - 'A' + 10; break;
 149     case 'a' ... 'z': ch = ch - 'a' + 10; break;
 150     default: base = -1; break;
 151   }
 152   return (ch >= 0 && ch < base ? ch : -1);
 153 }
 154
 155
 156 /*
 157 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 158 ;; word header format:
 159 ;; note than name hash is ALWAYS calculated with ASCII-uppercased name
 160 ;; (actually, bit 5 is always reset for all bytes, because we don't need the
 161 ;; exact uppercase, only something that resembles it)
 162 ;; bfa points to next bfa or to 0 (this is "hash bucket pointer")
 163 ;; before nfa, we have such "hidden" fields:
 164 ;;   dd dfa       ; pointer to the debug data; can be 0 if debug info is missing
 165 ;;   dd sfa       ; points *after* the last word byte
 166 ;;   dd bfa       ; next word in hashtable bucket; it is always here, even if hashtable is turned off
 167 ;;                ; if there is no hashtable, this field is not used
 168 ;; lfa:
 169 ;;   dd lfa       ; previous word LFA or 0 (lfa links points here)
 170 ;;   dd namehash  ; it is always here, and always calculated, even if hashtable is turned off
 171 ;; nfa:
 172 ;;   dd flags-and-name-len   ; see below
 173 ;;   db name      ; no terminating zero or other "termination flag" here
 174 ;;  here could be some 0 bytes to align everything to 4 bytes
 175 ;;   db namelen   ; yes, name length again, so CFA->NFA can avoid guessing
 176 ;;                ; full length, including padding, but not including this byte
 177 ;; cfa:
 178 ;;   dd cfaidx    ; our internal CFA index, or image address for DOES>
 179 ;; pfa:
 180 ;;   word data follows
 181 ;;
 182 ;; first word cell contains combined name length (low byte), argtype and flags (other bytes)
 183 ;; layout:
 184 ;;   db namelen
 185 ;;   db argtype
 186 ;;   dw flags
 187 ;; i.e. we have 16 bits for flags, and 256 possible argument types. why not.
 188 ;;
 189 ;; flags:
 190 ;;  bit 0: immediate
 191 ;;  bit 1: smudge
 192 ;;  bit 2: noreturn
 193 ;;  bit 3: hidden
 194 ;;  bit 4: codeblock
 195 ;;  bit 5: vocabulary
 196 ;;  bit 6: main scattered colon word (with "...")
 197 ;;  bit 7: protected
 198 ;;
 199 ;;  argtype is the type of the argument that this word reads from the threaded code.
 200 ;;  possible argument types:
 201 ;;    0: none
 202 ;;    1: branch address
 203 ;;    2: cell-size numeric literal
 204 ;;    3: cell-counted string with terminating zero (not counted)
 205 ;;    4: cfa of another word
 206 ;;    5: cblock
 207 ;;    6: vocid
 208 ;;    7: *UNUSED* byte-counted string with terminating zero (not counted)
 209 ;;    8: unsigned byte
 210 ;;    9: signed byte
 211 ;;   10: unsigned word
 212 ;;   11: signed word
 213
 214
 215 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 216 ;; wordlist structure (at PFA)
 217 ;;   dd latest
 218 ;;   dd voclink (voclink always points here)
 219 ;;   dd parent (if not zero, all parent words are visible)
 220 ;;   dd header-nfa (can be 0 for anonymous wordlists)
 221 ;;   hashtable (if enabled), or ~0U if no hash table
 222 */
 223
 224
 225 // ////////////////////////////////////////////////////////////////////////// //
 226 #define UFO_BFA_TO_LFA(bfa_)    ((bfa_) + 1u * 4u)
 227 #define UFO_LFA_TO_DFA(lfa_)    ((lfa_) - 3u * 4u)
 228 #define UFO_LFA_TO_SFA(lfa_)    ((lfa_) - 2u * 4u)
 229 #define UFO_LFA_TO_BFA(lfa_)    ((lfa_) - 1u * 4u)
 230 #define UFO_LFA_TO_NFA(lfa_)    ((lfa_) + 2u * 4u)
 231 #define UFO_LFA_TO_CFA(lfa_)    UFO_ALIGN4((lfa_) + 3u * 4u + 1u + ufoImgGetU8((lfa_) + 2u * 4u))
 232 #define UFO_LFA_TO_NHASH(lfa_)  ((lfa_) + 1u * 4u)
 233 #define UFO_CFA_TO_NFA(cfa_)    ((cfa_) - 1u - 4u - ufoImgGetU8((cfa_) - 1u))
 234 #define UFO_CFA_TO_LFA(cfa_)    ((cfa_) - 1u - 4u * 3u - ufoImgGetU8((cfa_) - 1u))
 235 #define UFO_CFA_TO_PFA(cfa_)    ((cfa_) + 1u * 4u)
 236 #define UFO_PFA_TO_CFA(pfa_)    ((pfa_) - 1u * 4u)
 237 #define UFO_NFA_TO_CFA(nfa_)    UFO_ALIGN4((nfa_) + 4u + 1u + ufoImgGetU8((nfa_)))
 238 #define UFO_NFA_TO_LFA(nfa_)    ((nfa_) - 2u * 4u)
 239
 240
 241 // ////////////////////////////////////////////////////////////////////////// //
 242 #define UFW_FLAG_IMMEDIATE  (1u<<16)
 243 #define UFW_FLAG_SMUDGE     (1u<<17)
 244 #define UFW_FLAG_NORETURN   (1u<<18)
 245 #define UFW_FLAG_HIDDEN     (1u<<19)
 246 #define UFW_FLAG_CBLOCK     (1u<<20)
 247 #define UFW_FLAG_VOCAB      (1u<<21)
 248 #define UFW_FLAG_SCOLON     (1u<<22)
 249 #define UFW_FLAG_PROTECTED  (1u<<23)
 250 #define UFW_FLAG_TRACE      (1u<<31)
 251
 252 #define UFW_WARG_MASK    ((uint32_t)0xff00U)
 253
 254 #define UFW_WARG_NONE    (0u<<8)
 255 #define UFW_WARG_BRANCH  (1u<<8)
 256 #define UFW_WARG_LIT     (2u<<8)
 257 #define UFW_WARG_C4STRZ  (3u<<8)
 258 #define UFW_WARG_CFA     (4u<<8)
 259 #define UFW_WARG_CBLOCK  (5u<<8)
 260 #define UFW_WARG_VOCID   (6u<<8)
 261 #define UFW_WARG_C1STRZ  (7u<<8)
 262 //#define UFW_WARG_U8      (8u<<8)
 263 //#define UFW_WARG_S8      (9u<<8)
 264 //#define UFW_WARG_U16     (10u<<8)
 265 //#define UFW_WARG_S16     (11u<<8)
 266
 267 #define UFW_VOCAB_OFS_LATEST   (0u * 4u)
 268 #define UFW_VOCAB_OFS_VOCLINK  (1u * 4u)
 269 #define UFW_VOCAB_OFS_PARENT   (2u * 4u)
 270 #define UFW_VOCAB_OFS_HEADER   (3u * 4u)
 271 #define UFW_VOCAB_OFS_HTABLE   (4u * 4u)
 272
 273 #define UFO_HASHTABLE_SIZE  (256)
 274
 275 #define UFO_NO_HTABLE_FLAG  (~(uint32_t)0)
 276
 277 static jmp_buf ufoInlineQuitJP;
 278
 279 typedef void (*ufoNativeCFA) (uint32_t pfa);
 280 #define UFO_MAX_NATIVE_CFAS  (1024u)
 281 static ufoNativeCFA *ufoForthCFAs = NULL;
 282 static uint32_t ufoCFAsUsed = 0;
 283
 284 static uint32_t ufoDoForthCFA;
 285 static uint32_t ufoDoVarCFA;
 286 static uint32_t ufoDoValueCFA;
 287 static uint32_t ufoDoConstCFA;
 288 static uint32_t ufoDoDeferCFA;
 289 static uint32_t ufoDoVocCFA;
 290 static uint32_t ufoMaxDoCFA;
 291
 292 static uint32_t ufoStrLit8CFA;
 293
 294 // special address types:
 295 #define UFO_ADDR_CFA_BIT   ((uint32_t)1<<31)
 296 #define UFO_ADDR_CFA_MASK  (UFO_ADDR_CFA_BIT-1u)
 297
 298 #define UFO_ADDR_HANDLE_BIT   ((uint32_t)1<<30)
 299 #define UFO_ADDR_HANDLE_MASK  (UFO_ADDR_HANDLE_BIT-1u)
 300
 301 // temporary area is 1MB buffer out of the main image
 302 #define UFO_ADDR_TEMP_BIT   ((uint32_t)1<<29)
 303 #define UFO_ADDR_TEMP_MASK  (UFO_ADDR_TEMP_BIT-1u)
 304
 305 #define UFO_ADDR_SPECIAL_BITS_MASK  (UFO_ADDR_CFA_BIT|UFO_ADDR_HANDLE_BIT|UFO_ADDR_TEMP_BIT)
 306
 307
 308 static uint32_t *ufoImage = NULL;
 309 static uint32_t ufoImageSize = 0;
 310
 311 static uint32_t *ufoImageTemp = NULL;
 312 static uint32_t ufoImageTempSize = 0;
 313
 314 static uint32_t ufoIP = 0; // in image
 315 static uint32_t ufoSP = 0; // points AFTER the last value pushed
 316 static uint32_t ufoRP = 0; // points AFTER the last value pushed
 317 static uint32_t ufoRPTop = 0; // stop when RP is this, and we're doing EXIT
 318
 319 static uint32_t ufoTrueValue = ~0u;
 320
 321 enum {
 322   UFO_MODE_NONE = -1,
 323   UFO_MODE_NATIVE = 0, // executing forth code
 324   UFO_MODE_MACRO = 1, // executing forth asm macro
 325 };
 326 static uint32_t ufoMode = UFO_MODE_NONE;
 327
 328 #define UFO_DSTACK_SIZE  (8192)
 329 #define UFO_RSTACK_SIZE  (8192)
 330 #define UFO_LSTACK_SIZE  (8192)
 331 static uint32_t *ufoDStack;
 332 static uint32_t *ufoRStack;
 333 static uint32_t *ufoLStack;
 334 static uint32_t ufoLP = 0;
 335 static uint32_t ufoLBP = 0;
 336
 337 // dynamically allocated text input buffer
 338 // always ends with zero (this is word name too)
 339 // first 512 bytes of image is TIB
 340 #define ufoTIBAreaSize  (512)
 341 #define ufoNUMAreaSize  (128)
 342 static uint32_t ufoAddrTIB = 0; // TIB; 0 means "in TIB area", otherwise in the dictionary
 343 static uint32_t ufoAddrIN = 0; // >IN
 344
 345 static uint32_t ufoAddrContext; // CONTEXT
 346 static uint32_t ufoAddrCurrent; // CURRENT (definitions will go there)
 347 static uint32_t ufoAddrVocLink;
 348 static uint32_t ufoAddrDP;
 349 static uint32_t ufoAddrDPTemp;
 350 static uint32_t ufoAddrSTATE;
 351 static uint32_t ufoAddrBASE;
 352 static uint32_t ufoAddrNewWordFlags;
 353
 354 #define UFO_GET_DP()      (ufoImgGetU32(ufoAddrDPTemp) ?: ufoImgGetU32(ufoAddrDP))
 355 //#define UFO_SET_DP(val_)  ufoImgPutU32(ufoAddrDP, (val_))
 356
 357 #define UFO_MAX_NESTED_INCLUDES  (32)
 358 typedef struct {
 359   FILE *fl;
 360   char *fname;
 361   char *incpath;
 362   int fline;
 363   uint8_t *savedTIB;
 364   uint32_t savedTIBSize;
 365 } UFOFileStackEntry;
 366
 367 static UFOFileStackEntry ufoFileStack[UFO_MAX_NESTED_INCLUDES];
 368 static uint32_t ufoFileStackPos; // after the last used item
 369
 370 static FILE *ufoInFile = NULL;
 371 static char *ufoInFileName = NULL;
 372 static char *ufoLastIncPath = NULL;
 373 static int ufoInFileLine = 0;
 374 static int ufoCondStLine = -1;
 375
 376 static int ufoLastEmitWasCR = 1;
 377 static uint32_t ufoCSP = 0;
 378 static int ufoInCondIf = 0;
 379
 380 #define UFO_VOCSTACK_SIZE  (16u)
 381 static uint32_t ufoVocStack[UFO_VOCSTACK_SIZE]; // cfas
 382 static uint32_t ufoVSP;
 383 static uint32_t ufoForthVocId;
 384 static uint32_t ufoCompilerVocId;
 385 static uint32_t ufoMacroVocId;
 386
 387 // dynamic handles
 388 typedef struct UHandleInfo_t {
 389   uint32_t ufoHandle;
 390   uint32_t typecfa;
 391   uint32_t *mem;
 392   uint32_t size; // in `uint32_t`
 393   uint32_t used; // in `uint32_t`; for dynamic arrays
 394   // in free list
 395   struct UHandleInfo_t *next;
 396 } UHandleInfo;
 397
 398 static UHandleInfo *ufoHandleFreeList = NULL;
 399 static UHandleInfo **ufoHandles = NULL;
 400 static uint32_t ufoHandlesUsed = 0;
 401 static uint32_t ufoHandlesAlloted = 0;
 402
 403 #define UFO_HANDLE_FREE  (0)
 404
 405 #define UFO_GET_NATIVE_HANDLE(adr_)  ({ \
 406   uint32_t aa = (uint32_t)(adr_); \
 407   if ((aa & UFO_ADDR_HANDLE_BIT) == 0) ufoFatal("expected handle"); \
 408   aa &= UFO_HANDLE_MASK; \
 409   if (aa >= ufoHandlesUsed || ufoHandles[aa] == NULL || ufoHandles[aa]->typecfa == UFO_HANDLE_FREE) ufoFatal("invalid handle"); \
 410   ufoHandles[aa]; \
 411 })
 412
 413
 414 static char ufoCurrFileLine[520];
 415 // used to extract strings from the image
 416 static char ufoTempCharBuf[1024];
 417
 418 // for `ufoFatal()`
 419 static uint32_t ufoInBacktrace = 0;
 420
 421
 422 // ////////////////////////////////////////////////////////////////////////// //
 423 #ifndef WIN32
 424 static void ufoDbgDeinit (void);
 425 #endif
 426 static void ufoClearCondDefines (void);
 427
 428 static uint32_t ufoVMPopCFA = 0;
 429 static void ufoRunVMCFA (uint32_t cfa);
 430
 431 static void ufoBacktrace (uint32_t ip);
 432
 433 static void ufoFixLatestSFA (void);
 434 static void ufoClearCondDefines (void);
 435
 436 __attribute__((unused)) static void ufoDumpWordHeader (const uint32_t lfa);
 437
 438
 439 //==========================================================================
 440 //
 441 //  ufoAllocHandle
 442 //
 443 //==========================================================================
 444 static UHandleInfo *ufoAllocHandle (uint32_t typecfa) {
 445   ufo_assert(typecfa != UFO_HANDLE_FREE);
 446   UHandleInfo *newh = ufoHandleFreeList;
 447   if (newh == NULL) {
 448     if (ufoHandlesUsed == ufoHandlesAlloted) {
 449       uint32_t newsz = ufoHandlesAlloted + 16384;
 450       if (newsz > 0x1000000U) {
 451         if (ufoHandlesAlloted >= 0x1000000U) ufoFatal("too many dynamic handles");
 452       }
 453       UHandleInfo **nh = realloc(ufoHandles, sizeof(ufoHandles[0]) * newsz);
 454       if (nh == NULL) ufoFatal("out of memory for handle table");
 455       ufoHandles = nh;
 456       ufoHandlesAlloted = newsz;
 457     }
 458     newh = calloc(1, sizeof(UHandleInfo));
 459     if (newh == NULL) ufoFatal("out of memory for handle info");
 460     ufoHandles[ufoHandlesUsed] = newh;
 461     // setup new handle info
 462     newh->ufoHandle = ufoHandlesUsed | UFO_ADDR_HANDLE_BIT;
 463     ufoHandlesUsed += 1;
 464   } else {
 465     ufoHandleFreeList = newh->next;
 466   }
 467   // setup new handle info
 468   newh->typecfa = typecfa;
 469   newh->mem = NULL;
 470   newh->size = 0;
 471   newh->next = NULL;
 472   return newh;
 473 }
 474
 475
 476 //==========================================================================
 477 //
 478 //  ufoFreeHandle
 479 //
 480 //==========================================================================
 481 static void ufoFreeHandle (UHandleInfo *hh) {
 482   if (hh != NULL) {
 483     ufo_assert(hh->typecfa != UFO_HANDLE_FREE);
 484     if (hh->mem) free(hh->mem);
 485     hh->typecfa = UFO_HANDLE_FREE;
 486     hh->mem = NULL;
 487     hh->size = 0;
 488     hh->next = ufoHandleFreeList;
 489     ufoHandleFreeList = hh;
 490   }
 491 }
 492
 493
 494 //==========================================================================
 495 //
 496 //  ufoGetHandle
 497 //
 498 //==========================================================================
 499 static UHandleInfo *ufoGetHandle (uint32_t hh) {
 500   UHandleInfo *res;
 501   if (hh != 0 && (hh & UFO_ADDR_HANDLE_BIT) != 0) {
 502     hh &= UFO_ADDR_HANDLE_MASK;
 503     if (hh < ufoHandlesUsed) {
 504       res = ufoHandles[hh];
 505       if (res->typecfa == UFO_HANDLE_FREE) res = NULL;
 506     } else {
 507       res = NULL;
 508     }
 509   } else {
 510     res = NULL;
 511   }
 512   return res;
 513 }
 514
 515
 516 //==========================================================================
 517 //
 518 //  setLastIncPath
 519 //
 520 //==========================================================================
 521 static void setLastIncPath (const char *fname) {
 522   if (fname == NULL || fname[0] == 0) {
 523     if (ufoLastIncPath) free(ufoLastIncPath);
 524     ufoLastIncPath = strdup(".");
 525   } else {
 526     if (ufoLastIncPath) free(ufoLastIncPath);
 527     ufoLastIncPath = strdup(fname);
 528     char *lslash = ufoLastIncPath;
 529     char *cpos = ufoLastIncPath;
 530     while (*cpos) {
 531       #ifdef WIN32
 532       if (*cpos == '/' || *cpos == '\\') lslash = cpos;
 533       #else
 534       if (*cpos == '/') lslash = cpos;
 535       #endif
 536       cpos += 1;
 537     }
 538     *lslash = 0;
 539   }
 540 }
 541
 542
 543 //==========================================================================
 544 //
 545 //  ufoErrorPrintFile
 546 //
 547 //==========================================================================
 548 static void ufoErrorPrintFile (FILE *fo) {
 549   if (ufoInFileName) {
 550     fprintf(fo, "UFO ERROR at file %s, line %d: ", ufoInFileName, ufoInFileLine);
 551   } else {
 552     fprintf(fo, "UFO ERROR somewhere in time: ");
 553   }
 554 }
 555
 556
 557 //==========================================================================
 558 //
 559 //  ufoErrorMsgV
 560 //
 561 //==========================================================================
 562 static void ufoErrorMsgV (const char *fmt, va_list ap) {
 563   if (!ufoLastEmitWasCR) { printf("\n"); ufoLastEmitWasCR = 1; }
 564   fflush(stdout);
 565   ufoErrorPrintFile(stderr);
 566   vfprintf(stderr, fmt, ap);
 567   va_end(ap);
 568   fputc('\n', stderr);
 569   fflush(NULL);
 570 }
 571
 572
 573 //==========================================================================
 574 //
 575 //  ufoWarning
 576 //
 577 //==========================================================================
 578 __attribute__((format(printf, 1, 2)))
 579 void ufoWarning (const char *fmt, ...) {
 580   va_list ap;
 581   va_start(ap, fmt);
 582   ufoErrorMsgV(fmt, ap);
 583 }
 584
 585
 586 //==========================================================================
 587 //
 588 //  ufoFatal
 589 //
 590 //==========================================================================
 591 __attribute__((noreturn)) __attribute__((format(printf, 1, 2)))
 592 void ufoFatal (const char *fmt, ...) {
 593   va_list ap;
 594   va_start(ap, fmt);
 595   ufoErrorMsgV(fmt, ap);
 596   if (!ufoInBacktrace) {
 597     ufoInBacktrace = 1;
 598     ufoBacktrace(ufoIP);
 599     ufoInBacktrace = 0;
 600   } else {
 601     fprintf(stderr, "DOUBLE FATAL: error in backtrace!\n");
 602   }
 603   #ifdef UFO_DEBUG_FATAL_ABORT
 604   abort();
 605   #endif
 606   ufoFatalError();
 607 }
 608
 609
 610 // ////////////////////////////////////////////////////////////////////////// //
 611 // working with the stacks
 612 UFO_FORCE_INLINE void ufoPush (uint32_t v) { if (ufoSP >= UFO_DSTACK_SIZE) ufoFatal("UFO data stack overflow"); ufoDStack[ufoSP++] = v; }
 613 UFO_FORCE_INLINE void ufoDrop (void) { if (ufoSP == 0) ufoFatal("UFO data stack underflow"); --ufoSP; }
 614 UFO_FORCE_INLINE uint32_t ufoPop (void) { if (ufoSP == 0) { ufoFatal("UFO data stack underflow"); } return ufoDStack[--ufoSP]; }
 615 UFO_FORCE_INLINE uint32_t ufoPeek (void) { if (ufoSP == 0) ufoFatal("UFO data stack underflow"); return ufoDStack[ufoSP-1u]; }
 616 UFO_FORCE_INLINE void ufoDup (void) { if (ufoSP == 0) ufoFatal("UFO data stack underflow"); ufoPush(ufoDStack[ufoSP-1u]); }
 617 UFO_FORCE_INLINE void ufoOver (void) { if (ufoSP < 2u) ufoFatal("UFO data stack underflow"); ufoPush(ufoDStack[ufoSP-2u]); }
 618 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; }
 619 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; }
 620 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; }
 621
 622 UFO_FORCE_INLINE void ufo2Dup (void) { ufoOver(); ufoOver(); }
 623 UFO_FORCE_INLINE void ufo2Drop (void) { ufoDrop(); ufoDrop(); }
 624 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); }
 625 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; }
 626
 627 UFO_FORCE_INLINE void ufoRPush (uint32_t v) { if (ufoRP >= UFO_RSTACK_SIZE) ufoFatal("UFO return stack overflow"); ufoRStack[ufoRP++] = v; }
 628 UFO_FORCE_INLINE void ufoRDrop (void) { if (ufoRP == 0 || ufoRP == ufoRPTop) ufoFatal("UFO return stack underflow"); --ufoRP; }
 629 UFO_FORCE_INLINE uint32_t ufoRPop (void) { if (ufoRP == 0 || ufoRP == ufoRPTop) ufoFatal("UFO return stack underflow"); return ufoRStack[--ufoRP]; }
 630 UFO_FORCE_INLINE uint32_t ufoRPeek (void) { if (ufoRP == 0 || ufoRP == ufoRPTop) ufoFatal("UFO return stack underflow"); return ufoRStack[ufoRP-1u]; }
 631 UFO_FORCE_INLINE void ufoRDup (void) { if (ufoRP == 0 || ufoRP == ufoRPTop) ufoFatal("UFO return stack underflow"); ufoPush(ufoRStack[ufoRP-1u]); }
 632
 633 UFO_FORCE_INLINE void ufoPushBool (int v) { ufoPush(v ? ufoTrueValue : 0u); }
 634
 635
 636 //==========================================================================
 637 //
 638 //  ufoImgEnsureSize
 639 //
 640 //==========================================================================
 641 static void ufoImgEnsureSize (uint32_t addr) {
 642   if ((addr & UFO_ADDR_SPECIAL_BITS_MASK) != 0) ufoFatal("ufoImgEnsureSize: internal error");
 643   if (addr >= ufoImageSize) {
 644     // 64MB should be enough for everyone!
 645     if (addr >= 0x04000000U) {
 646       ufoFatal("UFO image grown too big (addr=0%08XH)", addr);
 647     }
 648     const uint32_t osz = ufoImageSize;
 649     // grow by 1MB steps
 650     uint32_t nsz = (addr|0x000fffffU) + 1U;
 651     ufo_assert(nsz > addr);
 652     uint32_t *nimg = realloc(ufoImage, nsz);
 653     if (nimg == NULL) {
 654       ufoFatal("out of memory for UFO image (%u -> %u MBs)",
 655                ufoImageSize / 1024u / 1024u,
 656                nsz / 1024u / 1024u);
 657     }
 658     ufoImage = nimg;
 659     ufoImageSize = nsz;
 660     memset((char *)ufoImage + osz, 0, (nsz - osz));
 661   }
 662 }
 663
 664
 665 //==========================================================================
 666 //
 667 //  ufoImgEnsureTemp
 668 //
 669 //==========================================================================
 670 static void ufoImgEnsureTemp (uint32_t addr) {
 671   if ((addr & UFO_ADDR_SPECIAL_BITS_MASK) != 0) ufoFatal("ufoImgEnsureTemp: internal error");
 672   if (addr >= ufoImageTempSize) {
 673     if (addr >= 1024u * 1024u) {
 674       ufoFatal("Forth segmentation fault at address 0x%08X", addr|UFO_ADDR_TEMP_BIT);
 675     }
 676     const uint32_t osz = ufoImageTempSize;
 677     // grow by 256KB steps
 678     uint32_t nsz = (addr|0x0003ffffU) + 1U;
 679     uint32_t *nimg = realloc(ufoImageTemp, nsz);
 680     if (nimg == NULL) {
 681       ufoFatal("out of memory for temp UFO image (%u -> %u KBs)",
 682                ufoImageTempSize / 1024u,
 683                nsz / 1024u);
 684     }
 685     ufoImageTemp = nimg;
 686     ufoImageTempSize = nsz;
 687     memset(ufoImageTemp + osz, 0, (nsz - osz));
 688   }
 689 }
 690
 691
 692 //==========================================================================
 693 //
 694 //  ufoImgPutU8
 695 //
 696 //==========================================================================
 697 UFO_FORCE_INLINE void ufoImgPutU8 (uint32_t addr, uint32_t value) {
 698   uint32_t *imgptr;
 699   if ((addr & UFO_ADDR_SPECIAL_BITS_MASK) == 0) {
 700     if (addr >= ufoImageSize) ufoImgEnsureSize(addr);
 701     imgptr = &ufoImage[addr/4u];
 702   } else if (addr & UFO_ADDR_TEMP_BIT) {
 703     addr &= UFO_ADDR_TEMP_MASK;
 704     if (addr >= ufoImageTempSize) ufoImgEnsureTemp(addr);
 705     imgptr = &ufoImageTemp[addr/4u];
 706   } else {
 707     ufoFatal("Forth segmentation fault at address 0x%08X", addr);
 708   }
 709   const uint8_t val = (uint8_t)value;
 710   memcpy((uint8_t *)imgptr + (addr&3), &val, 1);
 711 }
 712
 713
 714 //==========================================================================
 715 //
 716 //  ufoImgPutU16
 717 //
 718 //==========================================================================
 719 UFO_FORCE_INLINE void ufoImgPutU16 (uint32_t addr, uint32_t value) {
 720   ufoImgPutU8(addr, value&0xffU);
 721   ufoImgPutU8(addr + 1u, (value>>8)&0xffU);
 722 }
 723
 724
 725 //==========================================================================
 726 //
 727 //  ufoImgPutU32
 728 //
 729 //==========================================================================
 730 UFO_FORCE_INLINE void ufoImgPutU32 (uint32_t addr, uint32_t value) {
 731   ufoImgPutU16(addr, value&0xffffU);
 732   ufoImgPutU16(addr + 2u, (value>>16)&0xffffU);
 733 }
 734
 735
 736 //==========================================================================
 737 //
 738 //  ufoImgGetU8
 739 //
 740 //==========================================================================
 741 UFO_FORCE_INLINE uint32_t ufoImgGetU8 (uint32_t addr) {
 742   uint32_t *imgptr;
 743   if ((addr & UFO_ADDR_SPECIAL_BITS_MASK) == 0) {
 744     if (addr >= ufoImageSize) return 0;
 745     imgptr = &ufoImage[addr/4u];
 746   } else if (addr & UFO_ADDR_TEMP_BIT) {
 747     addr &= UFO_ADDR_TEMP_MASK;
 748     if (addr >= ufoImageTempSize) return 0;
 749     imgptr = &ufoImageTemp[addr/4u];
 750   } else {
 751     ufoFatal("Forth segmentation fault at address 0x%08X", addr);
 752   }
 753   uint8_t val;
 754   memcpy(&val, (uint8_t *)imgptr + (addr&3), 1);
 755   return (uint32_t)val;
 756 }
 757
 758
 759 //==========================================================================
 760 //
 761 //  ufoImgGetU16
 762 //
 763 //==========================================================================
 764 UFO_FORCE_INLINE uint32_t ufoImgGetU16 (uint32_t addr) {
 765   return ufoImgGetU8(addr) | (ufoImgGetU8(addr + 1u) << 8);
 766 }
 767
 768
 769 //==========================================================================
 770 //
 771 //  ufoImgGetU32
 772 //
 773 //==========================================================================
 774 UFO_FORCE_INLINE uint32_t ufoImgGetU32 (uint32_t addr) {
 775   return ufoImgGetU16(addr) | (ufoImgGetU16(addr + 2u) << 16);
 776 }
 777
 778
 779 //==========================================================================
 780 //
 781 //  ufoBumpDP
 782 //
 783 //==========================================================================
 784 UFO_FORCE_INLINE void ufoBumpDP (uint32_t delta) {
 785   uint32_t dp = ufoImgGetU32(ufoAddrDPTemp);
 786   if (dp == 0) {
 787     dp = ufoImgGetU32(ufoAddrDP);
 788     dp += delta;
 789     ufoImgPutU32(ufoAddrDP, dp);
 790   } else {
 791     dp = ufoImgGetU32(ufoAddrDPTemp);
 792     dp += delta;
 793     ufoImgPutU32(ufoAddrDPTemp, dp);
 794   }
 795 }
 796
 797
 798 //==========================================================================
 799 //
 800 //  ufoImgEmitU8
 801 //
 802 //==========================================================================
 803 UFO_FORCE_INLINE void ufoImgEmitU8 (uint32_t value) {
 804   ufoImgPutU8(UFO_GET_DP(), value);
 805   ufoBumpDP(1);
 806 }
 807
 808
 809 //==========================================================================
 810 //
 811 //  ufoImgEmitU32
 812 //
 813 //==========================================================================
 814 UFO_FORCE_INLINE void ufoImgEmitU32 (uint32_t value) {
 815   ufoImgPutU32(UFO_GET_DP(), value);
 816   ufoBumpDP(4);
 817 }
 818
 819
 820 //==========================================================================
 821 //
 822 //  ufoImgEmitU32_NoInline
 823 //
 824 //==========================================================================
 825 static __attribute__((noinline)) void ufoImgEmitU32_NoInline (uint32_t value) {
 826   ufoImgPutU32(UFO_GET_DP(), value);
 827   ufoBumpDP(4);
 828 }
 829
 830
 831 //==========================================================================
 832 //
 833 //  ufoImgEmitAlign
 834 //
 835 //==========================================================================
 836 UFO_FORCE_INLINE void ufoImgEmitAlign (void) {
 837   while ((UFO_GET_DP() & 3) != 0) ufoImgEmitU8(0);
 838 }
 839
 840
 841 //==========================================================================
 842 //
 843 //  ufoDoForth
 844 //
 845 //==========================================================================
 846 static void ufoDoForth (uint32_t pfa) {
 847   ufoRPush(ufoIP);
 848   ufoIP = pfa;
 849 }
 850
 851
 852 //==========================================================================
 853 //
 854 //  ufoDoVariable
 855 //
 856 //==========================================================================
 857 static void ufoDoVariable (uint32_t pfa) {
 858   ufoPush(pfa);
 859 }
 860
 861
 862 //==========================================================================
 863 //
 864 //  ufoDoValue
 865 //
 866 //==========================================================================
 867 static void ufoDoValue (uint32_t pfa) {
 868   ufoPush(ufoImgGetU32(pfa));
 869 }
 870
 871
 872 //==========================================================================
 873 //
 874 //  ufoDoConst
 875 //
 876 //==========================================================================
 877 static void ufoDoConst (uint32_t pfa) {
 878   ufoPush(ufoImgGetU32(pfa));
 879 }
 880
 881
 882 //==========================================================================
 883 //
 884 //  ufoDoDefer
 885 //
 886 //==========================================================================
 887 static void ufoDoDefer (uint32_t pfa) {
 888   const uint32_t cfa = ufoImgGetU32(pfa);
 889   if (cfa != 0) {
 890     ufoPush(cfa);
 891     ufoVMPopCFA = 1;
 892   }
 893 }
 894
 895
 896 //==========================================================================
 897 //
 898 //  ufoDoVoc
 899 //
 900 //==========================================================================
 901 static void ufoDoVoc (uint32_t pfa) {
 902   ufoImgPutU32(ufoAddrContext, ufoImgGetU32(pfa));
 903 }
 904
 905
 906 //==========================================================================
 907 //
 908 //  ufoOpenFileOrDir
 909 //
 910 //==========================================================================
 911 static FILE *ufoOpenFileOrDir (char **fnameptr) {
 912   struct stat st;
 913   char *tmp;
 914   char *fname;
 915
 916   if (fnameptr == NULL) return NULL;
 917   fname = *fnameptr;
 918   #if 0
 919   fprintf(stderr, "***:fname=<%s>\n", fname);
 920   #endif
 921
 922   if (fname == NULL || fname[0] == 0 || stat(fname, &st) != 0) return NULL;
 923
 924   if (S_ISDIR(st.st_mode)) {
 925     tmp = calloc(1, strlen(fname) + 128);
 926     ufo_assert(tmp != NULL);
 927     sprintf(tmp, "%s/%s", fname, "zzmain.f");
 928     free(fname); fname = tmp; *fnameptr = tmp;
 929     #if 0
 930     fprintf(stderr, "***:  <%s>\n", fname);
 931     #endif
 932   }
 933
 934   return fopen(fname, "rb");
 935 }
 936
 937
 938 //==========================================================================
 939 //
 940 //  ufoPushInFile
 941 //
 942 //==========================================================================
 943 static void ufoPushInFile (void) {
 944   if (ufoFileStackPos >= UFO_MAX_NESTED_INCLUDES) ufoFatal("too many includes");
 945   UFOFileStackEntry *stk = &ufoFileStack[ufoFileStackPos];
 946   stk->fl = ufoInFile;
 947   stk->fname = ufoInFileName;
 948   stk->fline = ufoInFileLine;
 949   stk->incpath = ufoLastIncPath;
 950   // save TIB (if it is the default)
 951   uint32_t tib = ufoImgGetU32(ufoAddrTIB);
 952   uint32_t in = ufoImgGetU32(ufoAddrIN);
 953   stk->savedTIBSize = 0;
 954   stk->savedTIB = NULL;
 955   if (tib == 0 && in < ufoTIBAreaSize) {
 956     while (ufoImgGetU8(tib + in + stk->savedTIBSize) != 0) stk->savedTIBSize += 1;
 957     if (stk->savedTIBSize != 0) {
 958       stk->savedTIB = malloc(stk->savedTIBSize);
 959       if (stk->savedTIB == NULL) ufoFatal("out of memory for include stack");
 960       for (uint32_t f = 0; f < stk->savedTIBSize; f += 1) {
 961         stk->savedTIB[f] = ufoImgGetU8(tib + in + f);
 962       }
 963     }
 964   }
 965   ufoFileStackPos += 1;
 966   ufoInFile = NULL;
 967   ufoInFileName = NULL;
 968   ufoInFileLine = 0;
 969   ufoLastIncPath = NULL;
 970 }
 971
 972
 973 //==========================================================================
 974 //
 975 //  ufoPopInFile
 976 //
 977 //==========================================================================
 978 static void ufoPopInFile (void) {
 979   if (ufoFileStackPos == 0) ufoFatal("trying to pop include from empty stack");
 980   if (ufoInFileName) free(ufoInFileName);
 981   if (ufoInFile) fclose(ufoInFile);
 982   if (ufoLastIncPath) free(ufoLastIncPath);
 983   ufoFileStackPos -= 1;
 984   UFOFileStackEntry *stk = &ufoFileStack[ufoFileStackPos];
 985   ufoInFile = stk->fl;
 986   ufoInFileName = stk->fname;
 987   ufoInFileLine = stk->fline;
 988   ufoLastIncPath = stk->incpath;
 989   // restore TIB
 990   // also, restore current line, because some code may need it
 991   if (stk->savedTIBSize >= ufoTIBAreaSize) ufoFatal("restored TIB too big");
 992   ufoImgPutU32(ufoAddrTIB, 0);
 993   ufoImgPutU32(ufoAddrIN, 0);
 994   if (stk->savedTIBSize != 0) {
 995     for (uint32_t f = 0; f < stk->savedTIBSize; f += 1) {
 996       ufoImgPutU8(f, stk->savedTIB[f]);
 997     }
 998     free(stk->savedTIB);
 999   }
1000   ufoImgPutU8(stk->savedTIBSize, 0);
1001   #ifdef UFO_DEBUG_INCLUDE
1002   fprintf(stderr, "INC-POP: <%s>\n", ufoCurrFileLine);
1003   #endif
1004 }
1005
1006
1007 //==========================================================================
1008 //
1009 //  ufoDeinit
1010 //
1011 //==========================================================================
1012 void ufoDeinit (void) {
1013   ufoInBacktrace = 0;
1014   ufoClearCondDefines();
1015
1016   // free all handles
1017   for (uint32_t f = 0; f < ufoHandlesUsed; f += 1) {
1018     UHandleInfo *hh = ufoHandles[f];
1019     if (hh != NULL) {
1020       if (hh->mem != NULL) free(hh->mem);
1021       free(hh);
1022     }
1023   }
1024   if (ufoHandles != NULL) free(ufoHandles);
1025   ufoHandles = NULL; ufoHandlesUsed = 0; ufoHandlesAlloted = 0;
1026   ufoHandleFreeList = NULL;
1027
1028   // release all includes
1029   ufoInFile = NULL;
1030   if (ufoInFileName) free(ufoInFileName);
1031   if (ufoLastIncPath) free(ufoLastIncPath);
1032   ufoInFileName = NULL; ufoLastIncPath = NULL;
1033   ufoInFileLine = 0;
1034
1035   free(ufoForthCFAs);
1036   ufoForthCFAs = NULL;
1037   ufoCFAsUsed = 0;
1038
1039   free(ufoImage);
1040   ufoImage = NULL;
1041   ufoImageSize = 0;
1042
1043   free(ufoImageTemp);
1044   ufoImageTemp = NULL;
1045   ufoImageTempSize = 0;
1046
1047   ufoIP = 0;
1048   ufoSP = 0; ufoRP = 0; ufoRPTop = 0;
1049   ufoLP = 0; ufoLBP = 0;
1050   ufoMode = UFO_MODE_NATIVE;
1051   ufoVSP = 0;
1052   ufoForthVocId = 0; ufoCompilerVocId = 0; ufoMacroVocId = 0;
1053
1054   free(ufoDStack);
1055   ufoDStack = NULL;
1056   free(ufoRStack);
1057   ufoRStack = NULL;
1058   free(ufoLStack);
1059   ufoLStack = NULL;
1060
1061   ufoAddrTIB = 0; ufoAddrIN = 0;
1062
1063   ufoLastEmitWasCR = 1;
1064   ufoCSP = 0;
1065   ufoInCondIf = 0;
1066
1067   ufoClearCondDefines();
1068
1069   #ifndef WIN32
1070   ufoDbgDeinit();
1071   #endif
1072 }
1073
1074
1075 //==========================================================================
1076 //
1077 //  ufoDumpWordHeader
1078 //
1079 //==========================================================================
1080 __attribute__((unused)) static void ufoDumpWordHeader (const uint32_t lfa) {
1081   fprintf(stderr, "=== WORD: LFA: 0x%08x ===\n", lfa);
1082   if (lfa != 0) {
1083     fprintf(stderr, "  (DFA): 0x%08x\n", ufoImgGetU32(UFO_LFA_TO_DFA(lfa)));
1084     fprintf(stderr, "  (SFA): 0x%08x\n", ufoImgGetU32(UFO_LFA_TO_SFA(lfa)));
1085     fprintf(stderr, "  (BFA): 0x%08x\n", ufoImgGetU32(UFO_LFA_TO_BFA(lfa)));
1086     fprintf(stderr, "  (LFA): 0x%08x\n", ufoImgGetU32(lfa));
1087     fprintf(stderr, "  (NHH): 0x%08x\n", ufoImgGetU32(UFO_LFA_TO_NHASH(lfa)));
1088     const uint32_t cfa = UFO_LFA_TO_CFA(lfa);
1089     fprintf(stderr, "    CFA: 0x%08x\n", cfa);
1090     fprintf(stderr, "    PFA: 0x%08x\n", UFO_CFA_TO_PFA(cfa));
1091     fprintf(stderr, "  (CFA): 0x%08x\n", ufoImgGetU32(cfa));
1092     const uint32_t nfa = UFO_LFA_TO_NFA(lfa);
1093     const uint32_t nlen = ufoImgGetU8(nfa);
1094     fprintf(stderr, "    NFA: 0x%08x  (nlen: %u)\n", nfa, nlen);
1095     const uint32_t flags = ufoImgGetU32(nfa);
1096     fprintf(stderr, "  FLAGS: 0x%08x\n", flags);
1097     if ((flags & 0xffff0000U) != 0) {
1098       fprintf(stderr, "  FLAGS:");
1099       if (flags & UFW_FLAG_IMMEDIATE) fprintf(stderr, " IMM");
1100       if (flags & UFW_FLAG_SMUDGE) fprintf(stderr, " SMUDGE");
1101       if (flags & UFW_FLAG_NORETURN) fprintf(stderr, " NORET");
1102       if (flags & UFW_FLAG_HIDDEN) fprintf(stderr, " HIDDEN");
1103       if (flags & UFW_FLAG_CBLOCK) fprintf(stderr, " CBLOCK");
1104       if (flags & UFW_FLAG_VOCAB) fprintf(stderr, " VOCAB");
1105       if (flags & UFW_FLAG_SCOLON) fprintf(stderr, " SCOLON");
1106       if (flags & UFW_FLAG_PROTECTED) fprintf(stderr, " PROTECTED");
1107       fputc('\n', stderr);
1108     }
1109     if ((flags & 0xff00U) != 0) {
1110       fprintf(stderr, "   ARGS: ");
1111       switch (flags & UFW_WARG_MASK) {
1112         case UFW_WARG_NONE: fprintf(stderr, "NONE"); break;
1113         case UFW_WARG_BRANCH: fprintf(stderr, "BRANCH"); break;
1114         case UFW_WARG_LIT: fprintf(stderr, "LIT"); break;
1115         case UFW_WARG_C4STRZ: fprintf(stderr, "C4STRZ"); break;
1116         case UFW_WARG_CFA: fprintf(stderr, "CFA"); break;
1117         case UFW_WARG_CBLOCK: fprintf(stderr, "CBLOCK"); break;
1118         case UFW_WARG_VOCID: fprintf(stderr, "VOCID"); break;
1119         case UFW_WARG_C1STRZ: fprintf(stderr, "C1STRZ"); break;
1120         default: fprintf(stderr, "wtf?!"); break;
1121       }
1122       fputc('\n', stderr);
1123     }
1124     fprintf(stderr, "  BACKLEN: %u (nfa at 0x%08x)\n", ufoImgGetU8(cfa - 1u), UFO_CFA_TO_NFA(cfa));
1125     fprintf(stderr, "  NAME(%u): ", nlen);
1126     for (uint32_t f = 0; f < nlen; f += 1) {
1127       const uint8_t ch = ufoImgGetU8(nfa + 4u + f);
1128       if (ch <= 32 || ch >= 127) {
1129         fprintf(stderr, "\\x%02x", ch);
1130       } else {
1131         fprintf(stderr, "%c", (char)ch);
1132       }
1133     }
1134     fprintf(stderr, "\n");
1135     ufo_assert(UFO_CFA_TO_LFA(cfa) == lfa);
1136   }
1137 }
1138
1139
1140 //==========================================================================
1141 //
1142 //  ufoVocCheckName
1143 //
1144 //  return 0 or CFA
1145 //
1146 //==========================================================================
1147 static uint32_t ufoVocCheckName (uint32_t lfa, const void *wname, uint32_t wnlen, uint32_t hash,
1148                                  int allowvochid)
1149 {
1150   uint32_t res = 0;
1151   #ifdef UFO_DEBUG_FIND_WORD
1152   fprintf(stderr, "CHECK-NAME: %.*s; LFA: 0x%08x; hash: 0x%08x (wname: 0x%08x)\n",
1153           (unsigned) wnlen, (const char *)wname,
1154           lfa, (lfa != 0 ? ufoImgGetU32(UFO_LFA_TO_NHASH(lfa)) : 0), hash);
1155   ufoDumpWordHeader(lfa);
1156   #endif
1157   if (lfa != 0 && ufoImgGetU32(UFO_LFA_TO_NHASH(lfa)) == hash) {
1158     const uint32_t lenflags = ufoImgGetU32(UFO_LFA_TO_NFA(lfa));
1159     if ((lenflags & UFW_FLAG_SMUDGE) == 0 &&
1160         (allowvochid || (lenflags & UFW_FLAG_HIDDEN) == 0))
1161     {
1162       const uint32_t nlen = lenflags&0xffU;
1163       if (nlen == wnlen) {
1164         uint32_t naddr = UFO_LFA_TO_NFA(lfa) + 4u;
1165         uint32_t pos = 0;
1166         while (pos < nlen) {
1167           uint8_t c0 = ((const unsigned char *)wname)[pos];
1168           if (c0 >= 'a' && c0 <= 'z') c0 = c0 - 'a' + 'A';
1169           uint8_t c1 = ufoImgGetU8(naddr + pos);
1170           if (c1 >= 'a' && c1 <= 'z') c1 = c1 - 'a' + 'A';
1171           if (c0 != c1) break;
1172           pos += 1u;
1173         }
1174         if (pos == nlen) {
1175           // i found her!
1176           naddr += pos + 1u;
1177           res = UFO_ALIGN4(naddr);
1178         }
1179       }
1180     }
1181   }
1182   return res;
1183 }
1184
1185
1186 //==========================================================================
1187 //
1188 //  ufoFindWordInVoc
1189 //
1190 //  return 0 or CFA
1191 //
1192 //==========================================================================
1193 static uint32_t ufoFindWordInVoc (const void *wname, uint32_t wnlen, uint32_t hash,
1194                                   uint32_t vocid, int allowvochid)
1195 {
1196   uint32_t res = 0;
1197   if (wname == NULL) ufo_assert(wnlen == 0);
1198   if (wnlen != 0) {
1199     if (hash == 0) hash = joaatHashBufCI(wname, wnlen);
1200     #if defined(UFO_DEBUG_FIND_WORD) || defined(UFO_DEBUG_FIND_WORD_IN_VOC)
1201     fprintf(stderr, "IN-VOC: %.*s; VOCID: 0x%08x; whash: 0x%08x; htbl[0]: 0x%08x\n",
1202             (unsigned) wnlen, (const char *)wname,
1203             vocid, hash, ufoImgGetU32(vocid + UFW_VOCAB_OFS_HTABLE));
1204     #endif
1205     const uint32_t htbl = vocid + UFW_VOCAB_OFS_HTABLE;
1206     if (ufoImgGetU32(htbl) != UFO_NO_HTABLE_FLAG) {
1207       // hash table present, use it
1208       uint32_t bfa = htbl + (hash % (uint32_t)UFO_HASHTABLE_SIZE) * 4u;
1209       bfa = ufoImgGetU32(bfa);
1210       while (res == 0 && bfa != 0) {
1211         #if defined(UFO_DEBUG_FIND_WORD) || defined(UFO_DEBUG_FIND_WORD_IN_VOC)
1212         fprintf(stderr, "IN-VOC:   bfa: 0x%08x\n", bfa);
1213         #endif
1214         res = ufoVocCheckName(UFO_BFA_TO_LFA(bfa), wname, wnlen, hash, allowvochid);
1215         bfa = ufoImgGetU32(bfa);
1216       }
1217     } else {
1218       // no hash table, use linear search
1219       uint32_t lfa = vocid + UFW_VOCAB_OFS_LATEST;
1220       lfa = ufoImgGetU32(lfa);
1221       while (res == 0 && lfa != 0) {
1222         res = ufoVocCheckName(lfa, wname, wnlen, hash, allowvochid);
1223         lfa = ufoImgGetU32(lfa);
1224       }
1225     }
1226   }
1227   return res;
1228 }
1229
1230
1231 //==========================================================================
1232 //
1233 //  ufoFindColon
1234 //
1235 //  return part after the colon, or `NULL`
1236 //
1237 //==========================================================================
1238 static const void *ufoFindColon (const void *wname, uint32_t wnlen) {
1239   const void *res = NULL;
1240   if (wnlen != 0) {
1241     ufo_assert(wname != NULL);
1242     const char *str = (const char *)wname;
1243     while (wnlen != 0 && str[0] != ':') {
1244       str += 1; wnlen -= 1;
1245     }
1246     if (wnlen != 0) {
1247       res = (const void *)(str + 1); // skip colon
1248     }
1249   }
1250   return res;
1251 }
1252
1253
1254 //==========================================================================
1255 //
1256 //  ufoFindWordNameRes
1257 //
1258 //  find with name resolution
1259 //
1260 //  return 0 or CFA
1261 //
1262 //==========================================================================
1263 static uint32_t ufoFindWordNameRes (const void *wname, uint32_t wnlen) {
1264   uint32_t res = 0;
1265   if (wnlen != 0 && *(const char *)wname != ':') {
1266     ufo_assert(wname != NULL);
1267
1268     const void *stx = wname;
1269     wname = ufoFindColon(wname, wnlen);
1270     if (wname != NULL) {
1271       // look in all vocabs (excluding hidden ones)
1272       uint32_t xlen = (uint32_t)(ptrdiff_t)(wname - stx) - 1u;
1273       ufo_assert(xlen > 0 && xlen < 255);
1274       uint32_t xhash = joaatHashBufCI(stx, xlen);
1275       uint32_t voclink = ufoImgGetU32(ufoAddrVocLink);
1276       #ifdef UFO_DEBUG_FIND_WORD_COLON
1277       fprintf(stderr, "COLON-FIND: first voc: {%.*s}; xhash=0x%08x; voc-link: 0x%08x\n",
1278               (unsigned)xlen, (const char *)stx, xhash, voclink);
1279       #endif
1280       while (res == 0 && voclink != 0) {
1281         const uint32_t vhdraddr = voclink - UFW_VOCAB_OFS_VOCLINK + UFW_VOCAB_OFS_HEADER;
1282         const uint32_t vhdr = ufoImgGetU32(vhdraddr);
1283         if (vhdr != 0) {
1284           res = ufoVocCheckName(UFO_NFA_TO_LFA(vhdr), stx, xlen, xhash, 0);
1285         }
1286         if (res == 0) voclink = ufoImgGetU32(voclink);
1287       }
1288       if (res != 0) {
1289         uint32_t vocid = voclink - UFW_VOCAB_OFS_VOCLINK;
1290         ufo_assert(voclink != 0);
1291         wnlen -= xlen + 1;
1292         #ifdef UFO_DEBUG_FIND_WORD_COLON
1293         fprintf(stderr, "searching {%.*s}(%u) in {%.*s}\n",
1294                 (unsigned)wnlen, wname, wnlen, (unsigned)xlen, stx);
1295         #endif
1296         while (res != 0 && wname != NULL) {
1297           stx = wname;
1298           wname = ufoFindColon(wname, wnlen);
1299           if (wname == NULL) xlen = wnlen; else xlen = (uint32_t)(ptrdiff_t)(wname - stx) - 1u;
1300           ufo_assert(xlen > 0 && xlen < 255);
1301           res = ufoFindWordInVoc(stx, xlen, 0, vocid, 1);
1302           if (res != 0) {
1303             wnlen -= xlen + 1;
1304             if (wname != NULL) {
1305               // it should be a vocabulary
1306               const uint32_t nfa = UFO_CFA_TO_NFA(res);
1307               if ((ufoImgGetU32(nfa) & UFW_FLAG_VOCAB) != 0) {
1308                 vocid = ufoImgGetU32(UFO_CFA_TO_PFA(res)); // pfa points to vocabulary
1309               } else {
1310                 res = 0;
1311               }
1312             }
1313           }
1314         }
1315       }
1316     }
1317   }
1318
1319   return res;
1320 }
1321
1322
1323 //==========================================================================
1324 //
1325 //  ufoFindWord
1326 //
1327 //  doesn't look in CURRENT, does name resolution ("a:b" is word "b" in "a")
1328 //
1329 //  return 0 or CFA
1330 //
1331 //==========================================================================
1332 static uint32_t ufoFindWord (const char *wname) {
1333   uint32_t res = 0;
1334   if (wname && wname[0] != 0) {
1335     const size_t wnlen = strlen(wname);
1336     ufo_assert(wnlen < 8192);
1337     uint32_t ctx = ufoImgGetU32(ufoAddrContext);
1338     const uint32_t hash = joaatHashBufCI(wname, (uint32_t)wnlen);
1339
1340     //fprintf(stderr, "FIND-WORD: whash: 0x%08x; name:{%s}\n", hash, wname);
1341
1342     // first search in context
1343     res = ufoFindWordInVoc(wname, (uint32_t)wnlen, hash, ctx, (ctx == ufoImgGetU32(ufoAddrCurrent)));
1344
1345     // try linked vocs
1346     if (res == 0 && ctx != 0) {
1347       ctx = ufoImgGetU32(ctx + UFW_VOCAB_OFS_PARENT);
1348       while (res != 0 && ctx != 0) {
1349         res = ufoFindWordInVoc(wname, (uint32_t)wnlen, hash, ctx, (ctx == ufoImgGetU32(ufoAddrCurrent)));
1350         ctx = ufoImgGetU32(ctx + UFW_VOCAB_OFS_PARENT);
1351       }
1352     }
1353
1354     // now try vocabulary stack
1355     uint32_t vstp = ufoVSP;
1356     while (res == 0 && vstp != 0) {
1357       vstp -= 1;
1358       ctx = ufoVocStack[vstp];
1359       res = ufoFindWordInVoc(wname, (uint32_t)wnlen, hash, ctx, (ctx == ufoImgGetU32(ufoAddrCurrent)));
1360     }
1361
1362     // if not found, try name resolution
1363     if (res == 0) res = ufoFindWordNameRes(wname, (uint32_t)wnlen);
1364   }
1365
1366   return res;
1367 }
1368
1369
1370 //==========================================================================
1371 //
1372 //  ufoFindWordMacro
1373 //
1374 //==========================================================================
1375 static uint32_t ufoFindWordMacro (const char *wname) {
1376   if (!wname || wname[0] == 0) return 0;
1377   const size_t wnlen = strlen(wname);
1378   ufo_assert(wnlen < 8192);
1379   return ufoFindWordInVoc(wname, (uint32_t)wnlen, 0, ufoMacroVocId, 0);
1380 }
1381
1382
1383 //==========================================================================
1384 //
1385 //  ufoCreateWordHeader
1386 //
1387 //  create word header up to CFA, link to the current dictionary
1388 //
1389 //==========================================================================
1390 static void ufoCreateWordHeader (const char *wname, uint32_t flags) {
1391   if (wname == NULL) wname = "";
1392   const size_t wnlen = strlen(wname);
1393   ufo_assert(wnlen < UFO_MAX_WORD_LENGTH);
1394   const uint32_t hash = joaatHashBufCI(wname, (uint32_t)wnlen);
1395   const uint32_t curr = ufoImgGetU32(ufoAddrCurrent);
1396   ufo_assert(curr != 0);
1397   if (wnlen != 0) {
1398     const uint32_t cfa = ufoFindWordInVoc(wname, wnlen, hash, curr, 1);
1399     if (cfa) {
1400       const uint32_t nfa = UFO_CFA_TO_NFA(cfa);
1401       const uint32_t flags = ufoImgGetU32(nfa);
1402       if ((flags & UFW_FLAG_PROTECTED) != 0) {
1403         ufoFatal("trying to redefine protected word '%s'", wname);
1404       } else {
1405         ufoWarning("redefining word '%s'", wname);
1406       }
1407     }
1408   }
1409   //fprintf(stderr, "000: HERE: 0x%08x\n", UFO_GET_DP());
1410   const uint32_t bkt = (hash % (uint32_t)UFO_HASHTABLE_SIZE) * 4u;
1411   const uint32_t htbl = curr + UFW_VOCAB_OFS_HTABLE;
1412   ufoImgEmitAlign();
1413   ufoImgEmitU32(0); // dfa
1414   ufoImgEmitU32(0); // sfa
1415   // bucket link (bfa)
1416   if (wnlen == 0 || ufoImgGetU32(htbl) == UFO_NO_HTABLE_FLAG) {
1417     ufoImgEmitU32(0);
1418   } else {
1419     #ifdef UFO_DEBUG_DUMP_NEW_HEADERS
1420     fprintf(stderr, "NEW HEADER: %s; curr: 0x%08x; htbl: 0x%08x; bkt: 0x%08x\n",
1421             wname, curr, htbl, bkt);
1422     fprintf(stderr, "  [bkt]: 0x%08x; nbk: 0x%08x\n", ufoImgGetU32(htbl + bkt), UFO_GET_DP());
1423     #endif
1424     // bfa points to bfa
1425     const uint32_t bfa = UFO_GET_DP();
1426     ufoImgEmitU32(ufoImgGetU32(htbl + bkt));
1427     ufoImgPutU32(htbl + bkt, bfa);
1428   }
1429   // lfa
1430   const uint32_t lfa = UFO_GET_DP();
1431   ufoImgEmitU32(ufoImgGetU32(curr + UFW_VOCAB_OFS_LATEST));
1432   // fix voc latest
1433   ufoImgPutU32(curr + UFW_VOCAB_OFS_LATEST, lfa);
1434   // name hash
1435   ufoImgEmitU32(hash);
1436   // name length
1437   const uint32_t nfa = UFO_GET_DP();
1438   ufoImgEmitU32(((uint32_t)wnlen&0xffU) | (flags & 0xffffff00U));
1439   const uint32_t nstart = UFO_GET_DP();
1440   // put name
1441   for (size_t f = 0; f < wnlen; f += 1) {
1442     ufoImgEmitU8(((const unsigned char *)wname)[f]);
1443   }
1444   while ((UFO_GET_DP() & 3) != 3) ufoImgEmitU8(0);
1445   const uint32_t nend = UFO_GET_DP(); // length byte itself is not included
1446   // name length, again
1447   ufo_assert(nend - nstart <= 255);
1448   ufoImgEmitU8((uint8_t)(nend - nstart));
1449   ufo_assert((UFO_GET_DP() & 3) == 0);
1450   ufo_assert(UFO_CFA_TO_NFA(UFO_GET_DP()) == nfa);
1451   #ifdef UFO_DEBUG_DUMP_NEW_HEADERS
1452   fprintf(stderr, "*** NEW HEADER ***\n");
1453   fprintf(stderr, "CFA: 0x%08x\n", UFO_GET_DP());
1454   fprintf(stderr, "NSTART: 0x%08x\n", nstart);
1455   fprintf(stderr, "NEND: 0x%08x\n", nend);
1456   fprintf(stderr, "NLEN: %u (%u)\n", nend - nstart, ufoImgGetU8(UFO_GET_DP() - 1u));
1457   ufoDumpWordHeader(lfa);
1458   #endif
1459   #if 0
1460   fprintf(stderr, "NEW WORD CFA 0x%08x: %s\n", UFO_GET_DP(), wname);
1461   #endif
1462 }
1463
1464
1465 //==========================================================================
1466 //
1467 //  ufoDecompilePart
1468 //
1469 //==========================================================================
1470 static void ufoDecompilePart (uint32_t addr, uint32_t eaddr, int indent) {
1471   uint32_t count;
1472   FILE *fo = stdout;
1473   while (addr < eaddr) {
1474     uint32_t cfa = ufoImgGetU32(addr);
1475     for (int n = 0; n < indent; n += 1) fputc(' ', fo);
1476     fprintf(fo, "%6u: 0x%08x: ", addr, cfa);
1477     uint32_t nfa = UFO_CFA_TO_NFA(cfa);
1478     uint32_t flags = ufoImgGetU32(nfa);
1479     //fprintf(fo, "[0x%08x] ", flags & UFW_WARG_MASK);
1480     uint32_t nlen = flags & 0xffU;
1481     for (uint32_t f = 0; f < nlen; f += 1) {
1482       const uint8_t ch = ufoImgGetU8(nfa + 4u + f);
1483       if (ch <= 32 || ch >= 127) {
1484         fprintf(fo, "\\x%02x", ch);
1485       } else {
1486         fprintf(fo, "%c", (char)ch);
1487       }
1488     }
1489     addr += 4u;
1490     switch (flags & UFW_WARG_MASK) {
1491       case UFW_WARG_NONE:
1492         break;
1493       case UFW_WARG_BRANCH:
1494         fprintf(fo, "  @%u", ufoImgGetU32(addr)); addr += 4u;
1495         break;
1496       case UFW_WARG_LIT:
1497         fprintf(fo, "  %u : %d : 0x%08x", ufoImgGetU32(addr),
1498                 (int32_t)ufoImgGetU32(addr), ufoImgGetU32(addr)); addr += 4u;
1499         break;
1500       case UFW_WARG_C4STRZ:
1501         count = ufoImgGetU32(addr); addr += 4;
1502        print_str:
1503         fprintf(fo, "  str:");
1504         for (int f = 0; f < count; f += 1) {
1505           const uint8_t ch = ufoImgGetU8(addr); addr += 1u;
1506           if (ch <= 32 || ch >= 127) {
1507             fprintf(fo, "\\x%02x", ch);
1508           } else {
1509             fprintf(fo, "%c", (char)ch);
1510           }
1511         }
1512         addr += 1u; // skip zero byte
1513         addr = UFO_ALIGN4(addr);
1514         break;
1515       case UFW_WARG_CFA:
1516         cfa = ufoImgGetU32(addr); addr += 4u;
1517         fprintf(fo, "  CFA:%u: ", cfa);
1518         nfa = UFO_CFA_TO_NFA(cfa);
1519         nlen = ufoImgGetU8(nfa);
1520         for (uint32_t f = 0; f < nlen; f += 1) {
1521           const uint8_t ch = ufoImgGetU8(nfa + 4u + f);
1522           if (ch <= 32 || ch >= 127) {
1523             fprintf(fo, "\\x%02x", ch);
1524           } else {
1525             fprintf(fo, "%c", (char)ch);
1526           }
1527         }
1528         break;
1529       case UFW_WARG_CBLOCK:
1530         fprintf(fo, "  CBLOCK:%u", ufoImgGetU32(addr)); addr += 4u;
1531         break;
1532       case UFW_WARG_VOCID:
1533         fprintf(fo, "  VOCID:%u", ufoImgGetU32(addr)); addr += 4u;
1534         break;
1535       case UFW_WARG_C1STRZ:
1536         count = ufoImgGetU8(addr); addr += 1;
1537         goto print_str;
1538       /*
1539       case UFW_WARG_U8:
1540         fprintf(fo, "  ubyte:%u", ufoImgGetU8(addr)); addr += 1u;
1541         break;
1542       case UFW_WARG_S8:
1543         fprintf(fo, "  sbyte:%u", ufoImgGetU8(addr)); addr += 1u;
1544         break;
1545       case UFW_WARG_U16:
1546         fprintf(fo, "  uword:%u", ufoImgGetU16(addr)); addr += 2u;
1547         break;
1548       case UFW_WARG_S16:
1549         fprintf(fo, "  sword:%u", ufoImgGetU16(addr)); addr += 2u;
1550         break;
1551       */
1552       default:
1553         fprintf(fo, " -- WTF?!\n");
1554         abort();
1555     }
1556     fputc('\n', fo);
1557   }
1558 }
1559
1560
1561 //==========================================================================
1562 //
1563 //  ufoDecompileWord
1564 //
1565 //==========================================================================
1566 static void ufoDecompileWord (const uint32_t cfa) {
1567   if (cfa != 0) {
1568     const uint32_t lfa = UFO_CFA_TO_LFA(cfa);
1569     fprintf(stdout, "#### DECOMPILING CFA %u ###\n", cfa);
1570     ufoDumpWordHeader(lfa);
1571     const uint32_t sfa = ufoImgGetU32(UFO_LFA_TO_SFA(lfa));
1572     if (ufoImgGetU32(cfa) == ufoDoForthCFA) {
1573       fprintf(stdout, "--- DECOMPILED CODE ---\n");
1574       ufoDecompilePart(UFO_CFA_TO_PFA(cfa), sfa, 0);
1575       fprintf(stdout, "=======================\n");
1576     }
1577   }
1578 }
1579
1580
1581 //==========================================================================
1582 //
1583 //  ufoFindWordForIP
1584 //
1585 //  return NFA or 0
1586 //
1587 //  WARNING: this is SLOW!
1588 //
1589 //==========================================================================
1590 static uint32_t ufoFindWordForIP (const uint32_t ip) {
1591   uint32_t res = 0;
1592   if (ip != 0) {
1593     // iterate over all vocabs
1594     uint32_t voclink = ufoImgGetU32(ufoAddrVocLink);
1595     while (res == 0 && voclink != 0) {
1596       // iterate over all words
1597       const uint32_t vocid = voclink - UFW_VOCAB_OFS_VOCLINK;
1598       uint32_t lfa = ufoImgGetU32(vocid + UFW_VOCAB_OFS_LATEST);
1599       while (res == 0 && lfa != 0) {
1600         const uint32_t cfa = UFO_LFA_TO_CFA(lfa);
1601         const uint32_t pfa = UFO_CFA_TO_PFA(cfa);
1602         const uint32_t sfa = ufoImgGetU32(UFO_LFA_TO_SFA(lfa));
1603         //fprintf(stderr, "IP: 0x%08x; lfa:0x%08x; cfa:0x%08x; sfa:0x%08x\n", ip, lfa, cfa, sfa);
1604         if (ip >= pfa && ip < sfa) {
1605           res = UFO_LFA_TO_NFA(lfa);
1606         } else {
1607           lfa = ufoImgGetU32(lfa);
1608         }
1609       }
1610       if (res == 0) voclink = ufoImgGetU32(vocid + UFW_VOCAB_OFS_VOCLINK);
1611     }
1612   }
1613   return res;
1614 }
1615
1616
1617 //==========================================================================
1618 //
1619 //  ufoBTShowWordName
1620 //
1621 //==========================================================================
1622 static void ufoBTShowWordName (uint32_t nfa) {
1623   if (nfa != 0) {
1624     uint32_t len = ufoImgGetU8(nfa); nfa += 4u;
1625     //fprintf(stderr, "(0x%08x)", ufoImgGetU32(nfa - 4u));
1626     while (len != 0) {
1627       uint8_t ch = ufoImgGetU8(nfa); nfa += 1u; len -= 1u;
1628       if (ch <= 32 || ch >= 127) {
1629         fprintf(stderr, "\\x%02x", ch);
1630       } else {
1631         fprintf(stderr, "%c", (char)ch);
1632       }
1633     }
1634   }
1635 }
1636
1637
1638 //==========================================================================
1639 //
1640 //  ufoBacktrace
1641 //
1642 //==========================================================================
1643 static void ufoBacktrace (uint32_t ip) {
1644   // dump data stack (top 16)
1645   if (!ufoLastEmitWasCR) { printf("\n"); ufoLastEmitWasCR = 1; }
1646   fflush(NULL);
1647
1648   fprintf(stderr, "***UFO STACK DEPTH: %u\n", ufoSP);
1649   uint32_t xsp = ufoSP;
1650   if (xsp > 16) xsp = 16;
1651   for (uint32_t sp = 0; sp < xsp; ++sp) {
1652     fprintf(stderr, "  %2u: 0x%08x  %d\n", sp,
1653             ufoDStack[xsp - sp - 1], (int32_t)ufoDStack[xsp - sp - 1]);
1654   }
1655   if (ufoSP > 16) fprintf(stderr, "    ...more...\n");
1656
1657   // dump return stack (top 32)
1658   uint32_t nfa;
1659   fprintf(stderr, "***UFO RETURN STACK DEPTH: %u\n", ufoRP);
1660   if (ip != 0) {
1661     nfa = ufoFindWordForIP(ip);
1662     if (nfa != 0) {
1663       fprintf(stderr, "  **: %8u -- ", ip);
1664       ufoBTShowWordName(nfa);
1665       fputc('\n', stderr);
1666     }
1667   }
1668   uint32_t rp = ufoRP;
1669   uint32_t rscount = 0;
1670   if (rp > UFO_RSTACK_SIZE) rp = UFO_RSTACK_SIZE;
1671   while (rscount != 32 && rp != 0) {
1672     rp -= 1;
1673     const uint32_t val = ufoRStack[rp];
1674     nfa = ufoFindWordForIP(val);
1675     if (nfa != 0) {
1676       fprintf(stderr, "  %2u: %8u -- ", ufoRP - rp - 1u, val);
1677       ufoBTShowWordName(nfa);
1678       fputc('\n', stderr);
1679     } else {
1680       fprintf(stderr, "  %2u: 0x%08x  %d\n", ufoRP - rp - 1u, val, (int32_t)val);
1681     }
1682     rscount += 1;
1683   }
1684   if (ufoRP > 32) fprintf(stderr, "    ...more...\n");
1685
1686   fflush(NULL);
1687 }
1688
1689
1690 //==========================================================================
1691 //
1692 //  ufoDumpVocab
1693 //
1694 //==========================================================================
1695 /*
1696 static void ufoDumpVocab (uint32_t vocid) {
1697   if (vocid != 0) {
1698     fprintf(stderr, "*** VOCID: 0x%08x ***\n", vocid);
1699     uint32_t vochdr = vocid + UFW_VOCAB_OFS_HEADER;
1700     vochdr = ufoImgGetU32(vochdr);
1701     if (vochdr != 0) {
1702       fprintf(stderr, "--- HEADER ---\n");
1703       ufoDumpWordHeader(UFO_NFA_TO_LFA(vochdr));
1704       fprintf(stderr, "========\n");
1705       uint32_t htbl = vocid + UFW_VOCAB_OFS_HTABLE;
1706       if (ufoImgGetU32(htbl) != UFO_NO_HTABLE_FLAG) {
1707         fprintf(stderr, "--- HASH TABLE ---\n");
1708         for (int f = 0; f < UFO_HASHTABLE_SIZE; f += 1) {
1709           uint32_t bfa = ufoImgGetU32(htbl);
1710           if (bfa != 0) {
1711             fprintf(stderr, "**** %2d: 0x%08x\n", f, bfa);
1712             do {
1713               ufoDumpWordHeader(UFO_BFA_TO_LFA(bfa));
1714               bfa = ufoImgGetU32(bfa);
1715             } while (bfa != 0);
1716           }
1717           htbl += 4u;
1718         }
1719       }
1720     }
1721   }
1722 }
1723 */
1724
1725
1726 //==========================================================================
1727 //
1728 //  ufoSetNextLine
1729 //
1730 //==========================================================================
1731 static void ufoSetNextLine (const char *text) {
1732   if (text == NULL) text = "";
1733
1734   ufoImgPutU32(ufoAddrTIB, 0);
1735   ufoImgPutU32(ufoAddrIN, 0);
1736   ufoImgPutU32(0, 0);
1737
1738   size_t sslen = strlen(text);
1739   while (sslen != 0 && (text[sslen - 1u] == 13 || text[sslen - 1u] == 10)) sslen -= 1;
1740   if (sslen > 510) ufoFatal("input line too long");
1741   if (sslen >= ufoTIBAreaSize) ufoFatal("input line too long");
1742
1743   #ifdef UFO_DEBUG_INCLUDE
1744   fprintf(stderr, "NEXT-LINE: <%.*s>\n", (unsigned)sslen, (const char *)text);
1745   #endif
1746
1747   uint32_t dpos = 0;
1748   while (dpos != (uint32_t)sslen) {
1749     uint8_t ch = ((const unsigned char *)text)[dpos];
1750     // replace bad chars, because why not
1751     if (ch == 0 || ch == 13 || ch == 10) ch = 32;
1752     ufoImgPutU8(dpos, ch); dpos += 1;
1753   }
1754   ufoImgPutU8(dpos, 0);
1755 }
1756
1757
1758 //==========================================================================
1759 //
1760 //  ufoLoadNextLine_NativeMode
1761 //
1762 //  load next file line into TIB
1763 //  always strips final '\n'
1764 //
1765 //==========================================================================
1766 static void ufoLoadNextLine_NativeMode (int crossInclude) {
1767   const char *text = NULL;
1768
1769   int done = 0;
1770
1771   while (ufoInFile && done == 0) {
1772     if (fgets(ufoCurrFileLine, 510, ufoInFile) != NULL) {
1773       // check for a newline
1774       // if there is no newline char at the end, the string was truncated
1775       ufoCurrFileLine[510] = 0;
1776       uint32_t slen = (uint32_t)strlen(ufoCurrFileLine);
1777       if (slen == 0 || (ufoCurrFileLine[slen - 1u] != 13 && ufoCurrFileLine[slen - 1u] != 10)) {
1778         ufoFatal("input line too long");
1779       }
1780       ++ufoInFileLine;
1781       text = ufoCurrFileLine;
1782       done = 1;
1783       #if defined(UFO_DEBUG_INCLUDE) && 0
1784       fprintf(stderr, "READ LINE: %s", text);
1785       #endif
1786     } else {
1787       if (!crossInclude) {
1788         if (ufoCondStLine >= 0) {
1789           ufoFatal("unfinished conditional from line %d", ufoCondStLine);
1790         }
1791         ufoFatal("unexpected end of text");
1792       }
1793       ufoPopInFile();
1794     }
1795   }
1796
1797   if (done == 0) {
1798     int lnum;
1799     const char *fname;
1800     text = ufoGetSrcLine(&fname, &lnum);
1801     if (text == NULL) {
1802       if (ufoCondStLine >= 0) {
1803         ufoFatal("unfinished conditional from line %d", ufoCondStLine);
1804       }
1805       ufoFatal("unexpected end of text");
1806     }
1807     ufoInFileLine = lnum;
1808     if (ufoInFileName == NULL || strcmp(ufoInFileName, fname) != 0) {
1809       if (ufoInFileName != NULL) free(ufoInFileName);
1810       ufoInFileName = strdup(fname);
1811       setLastIncPath(ufoInFileName);
1812     }
1813   }
1814
1815   ufoSetNextLine(text);
1816 }
1817
1818
1819 //==========================================================================
1820 //
1821 //  ufoLoadMacroLine
1822 //
1823 //==========================================================================
1824 static void ufoLoadMacroLine (const char *line, const char *fname, int lnum) {
1825   const char *text = line;
1826   if (text == NULL) text = "";
1827   if (fname == NULL) fname = "";
1828
1829   ufoInFileLine = lnum;
1830   if (ufoInFileName == NULL || strcmp(ufoInFileName, fname) != 0) {
1831     if (ufoInFileName != NULL) free(ufoInFileName);
1832     ufoInFileName = strdup(fname);
1833     setLastIncPath(ufoInFileName);
1834   }
1835
1836   ufoSetNextLine(text);
1837 }
1838
1839
1840 //==========================================================================
1841 //
1842 //  ufoLoadNextLine
1843 //
1844 //  load next file line into TIB
1845 //  return zero on success, -1 on EOF, -2 on error
1846 //
1847 //==========================================================================
1848 static void ufoLoadNextLine (int crossInclude) {
1849   switch (ufoMode) {
1850     case UFO_MODE_NATIVE:
1851       ufoLoadNextLine_NativeMode(crossInclude);
1852       break;
1853     case UFO_MODE_MACRO:
1854       if (ufoCondStLine >= 0) {
1855         ufoFatal("unfinished conditional from line %d", ufoCondStLine);
1856       }
1857       ufoFatal("unexpected end of input for FORTH asm macro");
1858       break;
1859     default: ufoFatal("wtf?! not properly inited!");
1860   }
1861 }
1862
1863
1864 // ////////////////////////////////////////////////////////////////////////// //
1865 #define UFWORD(name_) \
1866 static void ufoWord_##name_ (uint32_t mypfa)
1867
1868 #define UFCALL(name_)  ufoWord_##name_(0)
1869 #define UFCFA(name_)   (&ufoWord_##name_)
1870
1871
1872 // ////////////////////////////////////////////////////////////////////////// //
1873 // debug
1874
1875 // DUMP-STACK
1876 // ( -- )
1877 UFWORD(DUMP_STACK) {
1878   if (!ufoLastEmitWasCR) { printf("\n"); ufoLastEmitWasCR = 1; }
1879   printf("***UFO STACK DEPTH: %u\n", ufoSP);
1880   uint32_t left = 32;
1881   uint32_t sp = ufoSP;
1882   while (sp != 0 && left != 0) {
1883     sp -= 1; left -= 1;
1884     printf("  %4u: 0x%08x  %d\n", sp, ufoDStack[sp], (int32_t)ufoDStack[sp]);
1885   }
1886   if (sp != 0) printf("...more...\n");
1887   ufoLastEmitWasCR = 1;
1888 }
1889
1890 // BACKTRACE
1891 UFWORD(UFO_BACKTRACE) {
1892   if (!ufoLastEmitWasCR) { printf("\n"); ufoLastEmitWasCR = 1; }
1893   fflush(NULL);
1894   if (ufoInFile != NULL) {
1895     fprintf(stderr, "*** at file %s, line %d ***\n", ufoInFileName, ufoInFileLine);
1896   } else {
1897     fprintf(stderr, "*** somewhere in time ***\n");
1898   }
1899   ufoBacktrace(ufoIP);
1900 }
1901
1902 #include "urforth_dbg.c"
1903
1904 // (UFO-BP)
1905 // debug breakpoint
1906 UFWORD(UFO_BP) {
1907   if (!ufoLastEmitWasCR) { printf("\n"); ufoLastEmitWasCR = 1; }
1908   #ifdef WIN32
1909   ufoFatal("there is no UFO debug breakpoint support in windoze");
1910   #else
1911   if (isatty(STDIN_FILENO) && isatty(STDOUT_FILENO)) {
1912     ufoDebugSession();
1913   } else {
1914     fprintf(stderr, "WARNING: cannot start UFO debug session, because standard streams are not on TTY!\n");
1915   }
1916   #endif
1917 }
1918
1919
1920 // ////////////////////////////////////////////////////////////////////////// //
1921 // SP0!
1922 // ( -- )
1923 UFWORD(SP0_STORE) { ufoSP = 0; }
1924
1925 // RP0!
1926 // ( -- )
1927 UFWORD(RP0_STORE) {
1928   if (ufoRP != ufoRPTop) {
1929     ufoRP = ufoRPTop;
1930     // we need to push a dummy value
1931     ufoRPush(0xdeadf00d);
1932   }
1933 }
1934
1935 // PAD
1936 // ( -- )
1937 // PAD is at the beginning of temp area
1938 UFWORD(PAD) {
1939   ufoPush(UFO_ADDR_TEMP_BIT);
1940 }
1941
1942 // @
1943 // ( addr -- value32 )
1944 UFWORD(PEEK) { const uint32_t addr = ufoPop(); ufoPush(ufoImgGetU32(addr)); }
1945
1946 // C@
1947 // ( addr -- value8 )
1948 UFWORD(CPEEK) { const uint32_t addr = ufoPop(); ufoPush(ufoImgGetU8(addr)); }
1949
1950 // W@
1951 // ( addr -- value32 )
1952 UFWORD(WPEEK) { const uint32_t addr = ufoPop(); ufoPush(ufoImgGetU16(addr)); }
1953
1954 // !
1955 // ( val32 addr -- )
1956 UFWORD(POKE) { const uint32_t addr = ufoPop(); const uint32_t val = ufoPop(); ufoImgPutU32(addr, val); }
1957
1958 // C!
1959 // ( val8 addr -- )
1960 UFWORD(CPOKE) { const uint32_t addr = ufoPop(); const uint32_t val = ufoPop(); ufoImgPutU8(addr, val&0xffU); }
1961
1962 // W!
1963 // ( val32 addr -- )
1964 UFWORD(WPOKE) { const uint32_t addr = ufoPop(); const uint32_t val = ufoPop(); ufoImgPutU16(addr, val&0xffffU); }
1965
1966 // C,
1967 // ( val8 -- )
1968 UFWORD(CCOMMA) { const uint32_t val = ufoPop(); ufoImgEmitU8(val); }
1969
1970 // W,
1971 // ( val16 -- )
1972 UFWORD(WCOMMA) { const uint32_t val = ufoPop(); ufoImgEmitU8(val&0xffU); ufoImgEmitU8((val >> 8)&0xffU); }
1973
1974 // ,
1975 // ( val -- )
1976 UFWORD(COMMA) { const uint32_t val = ufoPop(); ufoImgEmitU32(val); }
1977
1978
1979 // ZX-C,
1980 // ( val8 -- )
1981 // puts byte to zx dictionary
1982 UFWORD(ZX_CCOMMA) {
1983   const uint32_t val = ufoPop()&0xffU;
1984   ufoZXEmitU8(val);
1985 }
1986
1987 // ZX-W,
1988 // ( val -- )
1989 // puts word to zx dictionary
1990 UFWORD(ZX_WCOMMA) {
1991   const uint32_t val = ufoPop();
1992   ufoZXEmitU16(val&0xffffU);
1993 }
1994
1995 // ZX-C@
1996 // ( addr -- value8 )
1997 UFWORD(ZX_CPEEK) { const uint32_t addr = ufoPop(); ufoPush(ufoZXGetU8(addr)); }
1998
1999 // ZX-C!
2000 // ( val8 addr -- )
2001 UFWORD(ZX_CPOKE) { const uint32_t addr = ufoPop(); const uint32_t val = ufoPop(); ufoZXPutU8(addr, val); }
2002
2003 // ZX-W@
2004 // ( addr -- value16 )
2005 UFWORD(ZX_WPEEK) { const uint32_t addr = ufoPop(); ufoPush(ufoZXGetU16(addr)); }
2006
2007 // ZX-W!
2008 // ( val16 addr -- )
2009 UFWORD(ZX_WPOKE) { const uint32_t addr = ufoPop(); const uint32_t val = ufoPop(); ufoZXPutU16(addr, val); }
2010
2011 // ZX-RESERVED?
2012 // ( addr -- bool )
2013 UFWORD(ZX_RESERVEDQ) {
2014   const uint32_t addr = ufoPop();
2015   ufoPushBool(ufoZXGetReserved(addr));
2016 }
2017
2018 // ZX-RESERVED!
2019 // ( bool addr -- )
2020 UFWORD(ZX_RESERVEDS) {
2021   const uint32_t addr = ufoPop();
2022   const uint32_t flag = ufoPop();
2023   ufoZXSetReserved(addr, (flag ? 1 : 0));
2024 }
2025
2026
2027 // (LIT) ( -- n )
2028 UFWORD(PAR_LIT) {
2029   const uint32_t v = ufoImgGetU32(ufoIP); ufoIP += 4;
2030   ufoPush(v);
2031 }
2032
2033 // (LITCFA) ( -- n )
2034 UFWORD(PAR_LITCFA) {
2035   const uint32_t v = ufoImgGetU32(ufoIP); ufoIP += 4;
2036   ufoPush(v);
2037 }
2038
2039 // (LITVOCID) ( -- n )
2040 UFWORD(PAR_LITVOCID) {
2041   const uint32_t v = ufoImgGetU32(ufoIP); ufoIP += 4;
2042   ufoPush(v);
2043 }
2044
2045 // (STRLIT8)
2046 UFWORD(PAR_STRLIT8) {
2047   const uint32_t count = ufoImgGetU8(ufoIP); ufoIP += 1;
2048   ufoPush(ufoIP);
2049   ufoPush(count);
2050   ufoIP += count + 1; // 1 for terminating 0
2051   // align
2052   ufoIP = UFO_ALIGN4(ufoIP);
2053 }
2054
2055 // (BRANCH) ( -- )
2056 UFWORD(PAR_BRANCH) {
2057   ufoIP = ufoImgGetU32(ufoIP);
2058 }
2059
2060 // (TBRANCH) ( flag )
2061 UFWORD(PAR_TBRANCH) {
2062   if (ufoPop()) {
2063     ufoIP = ufoImgGetU32(ufoIP);
2064   } else {
2065     ufoIP += 4;
2066   }
2067 }
2068
2069 // (0BRANCH) ( flag )
2070 UFWORD(PAR_0BRANCH) {
2071   if (!ufoPop()) {
2072     ufoIP = ufoImgGetU32(ufoIP);
2073   } else {
2074     ufoIP += 4;
2075   }
2076 }
2077
2078 // EXECUTE ( cfa )
2079 UFWORD(EXECUTE) {
2080   ufoVMPopCFA = 1;
2081 }
2082
2083 // EXECUTE-TAIL ( cfa )
2084 UFWORD(EXECUTE_TAIL) {
2085   ufoIP = ufoRPop();
2086   ufoVMPopCFA = 1;
2087 }
2088
2089 // (EXIT)
2090 UFWORD(PAR_EXIT) {
2091   ufoIP = ufoRPop();
2092 }
2093
2094 // (L-ENTER)
2095 // ( loccount -- )
2096 UFWORD(PAR_LENTER) {
2097   // low byte of loccount is total number of locals
2098   // high byte is the number of args
2099   uint32_t lcount = ufoImgGetU32(ufoIP); ufoIP += 4u;
2100   uint32_t acount = (lcount >> 8) & 0xff;
2101   lcount &= 0xff;
2102   if (lcount == 0 || lcount < acount) ufoFatal("invalid call to (L-ENTER)");
2103   if ((ufoLBP != 0 && ufoLBP >= ufoLP) || UFO_LSTACK_SIZE - ufoLP <= lcount + 2) {
2104     ufoFatal("out of locals stack");
2105   }
2106   uint32_t newbp;
2107   if (ufoLP == 0) { ufoLP = 1; newbp = 1; } else newbp = ufoLP;
2108   //fprintf(stderr, "LP: %u; LBP: %u; locs: %u; word: %s\n", ufoLP, ufoLBP, fw->locs, fw->name);
2109   ufoLStack[ufoLP] = ufoLBP; ufoLP += 1;
2110   ufoLBP = newbp; ufoLP += lcount;
2111   // and copy args
2112   newbp += acount;
2113   while (newbp != ufoLBP) {
2114     ufoLStack[newbp] = ufoPop();
2115     newbp -= 1;
2116   }
2117 }
2118
2119 // (L-LEAVE)
2120 UFWORD(PAR_LLEAVE) {
2121   if (ufoLBP == 0) ufoFatal("(L-LEAVE) with empty locals stack");
2122   if (ufoLBP >= ufoLP) ufoFatal("(L-LEAVE) broken locals stack");
2123   ufoLP = ufoLBP;
2124   ufoLBP = ufoLStack[ufoLBP];
2125 }
2126
2127
2128 //==========================================================================
2129 //
2130 //  ufoLoadLocal
2131 //
2132 //==========================================================================
2133 UFO_FORCE_INLINE void ufoLoadLocal (const uint32_t lidx) {
2134   if (lidx == 0 || lidx >= UFO_LSTACK_SIZE) ufoFatal("invalid local index");
2135   if (ufoLBP == 0 || ufoLBP >= ufoLP || ufoLP - ufoLBP <= lidx) ufoFatal("invalid local index");
2136   ufoPush(ufoLStack[ufoLBP + lidx]);
2137 }
2138
2139
2140 //==========================================================================
2141 //
2142 //  ufoStoreLocal
2143 //
2144 //==========================================================================
2145 UFO_FORCE_INLINE void ufoStoreLocal (const uint32_t lidx) {
2146   const uint32_t value = ufoPop();
2147   if (lidx == 0 || lidx >= UFO_LSTACK_SIZE) ufoFatal("invalid local index");
2148   if (ufoLBP == 0 || ufoLBP >= ufoLP || ufoLP - ufoLBP <= lidx) ufoFatal("invalid local index");
2149   ufoLStack[ufoLBP + lidx] = value;
2150 }
2151
2152
2153 // (LOCAL@)
2154 // ( idx -- value )
2155 UFWORD(PAR_LOCAL_LOAD) { ufoLoadLocal(ufoPop()); }
2156
2157 // (LOCAL!)
2158 // ( value idx -- )
2159 UFWORD(PAR_LOCAL_STORE) { ufoStoreLocal(ufoPop()); }
2160
2161
2162 // DUP ( n -- n n )
2163 UFWORD(DUP) { ufoDup(); }
2164 // ?DUP ( n -- n n ) | ( 0 -- 0 )
2165 UFWORD(QDUP) { if (ufoPeek()) ufoDup(); }
2166 // 2DUP ( n0 n1 -- n0 n1 n0 n1 ) | ( 0 -- 0 )
2167 UFWORD(DDUP) { ufo2Dup(); }
2168 // DROP ( n -- )
2169 UFWORD(DROP) { ufoDrop(); }
2170 // 2DROP ( n -- )
2171 UFWORD(DDROP) { ufo2Drop(); }
2172 // SWAP ( n0 n1 -- n1 n0 )
2173 UFWORD(SWAP) { ufoSwap(); }
2174 // 2SWAP ( n0 n1 -- n1 n0 )
2175 UFWORD(DSWAP) { ufo2Swap(); }
2176 // OVER ( n0 n1 -- n0 n1 n0 )
2177 UFWORD(OVER) { ufoOver(); }
2178 // 2OVER ( n0 n1 -- n0 n1 n0 )
2179 UFWORD(DOVER) { ufo2Over(); }
2180 // ROT ( n0 n1 n2 -- n1 n2 n0 )
2181 UFWORD(ROT) { ufoRot(); }
2182 // NROT ( n0 n1 n2 -- n2 n0 n1 )
2183 UFWORD(NROT) { ufoNRot(); }
2184
2185 // RDUP ( n -- n n )
2186 UFWORD(RDUP) { ufoRDup(); }
2187 // RDROP ( n -- )
2188 UFWORD(RDROP) { ufoRDrop(); }
2189
2190 // >R ( n -- | n)
2191 UFWORD(DTOR) { ufoRPush(ufoPop()); }
2192 // R> ( -- n | n-removed )
2193 UFWORD(RTOD) { ufoPush(ufoRPop()); }
2194 // R@ ( -- n | n-removed )
2195 UFWORD(RPEEK) { ufoPush(ufoRPeek()); }
2196
2197
2198 // PICK ( idx -- n )
2199 UFWORD(PICK) {
2200   const uint32_t n = ufoPop();
2201   if (n >= ufoSP) ufoFatal("invalid PICK index %u", n);
2202   ufoPush(ufoDStack[ufoSP - n - 1u]);
2203 }
2204
2205 // RPICK ( idx -- n )
2206 UFWORD(RPICK) {
2207   const uint32_t n = ufoPop();
2208   if (n >= ufoRP) ufoFatal("invalid RPICK index %u", n);
2209   const uint32_t rp = ufoRP - n - 1u;
2210   if (rp <= ufoRPTop) ufoFatal("invalid RPICK index %u", n);
2211   ufoPush(ufoRStack[rp]);
2212 }
2213
2214 // ROLL ( idx -- n )
2215 UFWORD(ROLL) {
2216   const uint32_t n = ufoPop();
2217   if (n >= ufoSP) ufoFatal("invalid ROLL index %u", n);
2218   switch (n) {
2219     case 0: break; // do nothing
2220     case 1: ufoSwap(); break;
2221     case 2: ufoRot(); break;
2222     default:
2223       {
2224         const uint32_t val = ufoDStack[ufoSP - n - 1u];
2225         for (uint32_t f = ufoSP - n; f < ufoSP; f += 1) ufoDStack[f - 1] = ufoDStack[f];
2226         ufoDStack[ufoSP - 1u] = val;
2227       }
2228       break;
2229   }
2230 }
2231
2232 // RROLL ( idx -- n )
2233 UFWORD(RROLL) {
2234   const uint32_t n = ufoPop();
2235   if (n >= ufoRP) ufoFatal("invalid RROLL index %u", n);
2236   if (n != 0) {
2237     const uint32_t rp = ufoRP - n - 1u;
2238     if (rp <= ufoRPTop) ufoFatal("invalid RROLL index %u", n);
2239     const uint32_t val = ufoRStack[rp];
2240     for (uint32_t f = rp + 1u; f < ufoRP; f += 1u) ufoRStack[f - 1u] = ufoRStack[f];
2241     ufoRStack[ufoRP - 1u] = val;
2242   }
2243 }
2244
2245
2246 // REFILL
2247 // ( -- eofflag )
2248 UFWORD(REFILL) {
2249   ufoLoadNextLine(1);
2250   ufoPushBool(1);
2251 }
2252
2253 // REFILL-NOCROSS
2254 // ( -- eofflag )
2255 UFWORD(REFILL_NOCROSS) {
2256   ufoLoadNextLine(0);
2257   ufoPushBool(1);
2258 }
2259
2260
2261 //==========================================================================
2262 //
2263 //  ufoIsDelim
2264 //
2265 //==========================================================================
2266 UFO_FORCE_INLINE int ufoIsDelim (uint8_t ch, uint8_t delim) {
2267   return (delim == 32 ? (ch <= 32) : (ch == delim));
2268 }
2269
2270
2271 // (PARSE)
2272 // ( delim skip-leading-delim? -- addr count TRUE / FALSE )
2273 // does base TIB parsing; never copies anything.
2274 // as our reader is line-based, returns FALSE on EOL.
2275 // EOL is detected after skipping leading delimiters.
2276 // passing -1 as delimiter skips the whole line, and always returns FALSE.
2277 // trailing delimiter is always skipped.
2278 UFWORD(PAR_PARSE) {
2279   const uint32_t skipDelim = ufoPop();
2280   const uint32_t delim = ufoPop();
2281   const uint32_t tib = ufoImgGetU32(ufoAddrTIB);
2282   uint32_t in = ufoImgGetU32(ufoAddrIN);
2283
2284   #if 0
2285   fprintf(stderr, "PARSE-IN: in=%u; delim=%u; skip=%u\n",
2286           in, delim, skipDelim);
2287   #endif
2288
2289   if (delim == 0 || delim > 0xffU) {
2290     // skip everything
2291     while (ufoImgGetU8(tib + in) != 0) in += 1;
2292     ufoImgPutU32(ufoAddrIN, in);
2293     ufoPushBool(0);
2294   } else {
2295     uint8_t ch;
2296     ch = ufoImgGetU8(tib + in);
2297     // skip initial delimiters
2298     if (skipDelim) {
2299       while (ch != 0 && ufoIsDelim(ch, delim)) {
2300         in += 1;
2301         ch = ufoImgGetU8(tib + in);
2302       }
2303     }
2304     // parse
2305     if (ch == 0) {
2306       ufoImgPutU32(ufoAddrIN, in);
2307       ufoPushBool(0);
2308     } else {
2309       const uint32_t stin = in;
2310       while (ch != 0 && !ufoIsDelim(ch, delim)) {
2311         in += 1;
2312         ch = ufoImgGetU8(tib + in);
2313       }
2314       ufoPush(tib + stin);
2315       ufoPush(in - stin);
2316       if (ch != 0) {
2317         // skip delimiter
2318         ufo_assert(ufoIsDelim(ch, delim));
2319         in += 1;
2320       }
2321       ufoImgPutU32(ufoAddrIN, in);
2322       ufoPushBool(1);
2323       #if 0
2324       fprintf(stderr, "PARSE-OUT: len=%u\n", in - stin);
2325       #endif
2326     }
2327   }
2328 }
2329
2330 // PARSE-SKIP-BLANKS
2331 // ( -- )
2332 UFWORD(PARSE_SKIP_BLANKS) {
2333   const uint32_t tib = ufoImgGetU32(ufoAddrTIB);
2334   uint32_t in = ufoImgGetU32(ufoAddrIN);
2335   uint8_t ch;
2336   ch = ufoImgGetU8(tib + in);
2337   while (ch != 0 && ch <= 32) {
2338     in += 1;
2339     ch = ufoImgGetU8(tib + in);
2340   }
2341   ufoImgPutU32(ufoAddrIN, in);
2342 }
2343
2344
2345 //==========================================================================
2346 //
2347 //  ufoParseMLComment
2348 //
2349 //  initial two chars are skipped
2350 //
2351 //==========================================================================
2352 static void ufoParseMLComment (int nested) {
2353   uint32_t tib = ufoImgGetU32(ufoAddrTIB);
2354   uint32_t in = ufoImgGetU32(ufoAddrIN);
2355   uint32_t level = 1;
2356   uint8_t ch, ch1;
2357   while (level != 0) {
2358     ch = ufoImgGetU8(tib + in); in += 1;
2359     if (ch == 0) {
2360       UFCALL(REFILL_NOCROSS);
2361       if (ufoPop() == 0) ufoFatal("unexpected end of file in comment");
2362       tib = ufoImgGetU32(ufoAddrTIB);
2363       in = ufoImgGetU32(ufoAddrIN);
2364     } else {
2365       ch1 = ufoImgGetU8(tib + in);
2366       if (nested && ch == '(' && ch1 == '(') { in += 1; level += 1; }
2367       else if (nested && ch == ')' && ch1 == ')') { in += 1; level -= 1; }
2368       else if (!nested && ch == '*' && ch1 == ')') { ufo_assert(level == 1); in += 1; level = 0; }
2369     }
2370   }
2371   ufoImgPutU32(ufoAddrIN, in);
2372 }
2373
2374
2375 // (PARSE-SKIP-COMMENTS)
2376 // ( allow-multiline? -- )
2377 // skip all blanks and comments
2378 UFWORD(PAR_PARSE_SKIP_COMMENTS) {
2379   const uint32_t allowMulti = ufoPop();
2380   uint32_t tib = ufoImgGetU32(ufoAddrTIB);
2381   uint32_t in = ufoImgGetU32(ufoAddrIN);
2382   uint8_t ch, ch1, ech;
2383   ch = ufoImgGetU8(tib + in);
2384   while (ch != 0) {
2385     if (ch <= 32) {
2386       in += 1;
2387       ch = ufoImgGetU8(tib + in);
2388     } else {
2389       ch1 = ufoImgGetU8(tib + in + 1u);
2390       if ((ch == '(' || ch == '\\') && ch1 <= 32) {
2391         // single-line comment
2392         ech = (ch == '(' ? ')' : 0);
2393         while (ch != 0 && ch != ech) {
2394           in += 1;
2395           ch = ufoImgGetU8(tib + in);
2396         }
2397         if (ch != 0) {
2398           in += 1;
2399           ch = ufoImgGetU8(tib + in);
2400         }
2401       } else if (ch == ';' && ch1 == ';') {
2402         while (ch != 0) {
2403           in += 1;
2404           ch = ufoImgGetU8(tib + in);
2405         }
2406       } else if (allowMulti && (ch == '(' && (ch1 == '*' || ch1 == '('))) {
2407         // multiline
2408         ufoImgPutU32(ufoAddrIN, in + 2);
2409         ufoParseMLComment((ch1 == '('));
2410         tib = ufoImgGetU32(ufoAddrTIB);
2411         in = ufoImgGetU32(ufoAddrIN);
2412         ch = ufoImgGetU8(tib + in);
2413       } else {
2414         ch = 0;
2415       }
2416     }
2417   }
2418   ufoImgPutU32(ufoAddrIN, in);
2419 }
2420
2421 // PARSE-SKIP-LINE
2422 // ( -- )
2423 UFWORD(PARSE_SKIP_LINE) {
2424   ufoPush(0); ufoPushBool(0); UFCALL(PAR_PARSE);
2425   if (ufoPop() != 0) {
2426     ufo2Drop();
2427   }
2428 }
2429
2430 // PARSE-NAME
2431 // ( -- addr count )
2432 // parse with leading blanks skipping. doesn't copy anything.
2433 // return empty string on EOL.
2434 UFWORD(PARSE_NAME) {
2435   ufoPush(32); ufoPushBool(1); UFCALL(PAR_PARSE);
2436   if (ufoPop() == 0) {
2437     const uint32_t tib = ufoImgGetU32(ufoAddrTIB);
2438     const uint32_t in = ufoImgGetU32(ufoAddrIN);
2439     ufoPush(tib + in);
2440     ufoPush(0);
2441   }
2442 }
2443
2444 // PARSE
2445 // ( delim -- addr count TRUE / FALSE )
2446 // parse without skipping delimiters; never copies anything.
2447 // as our reader is line-based, returns FALSE on EOL.
2448 // passing 0 as delimiter skips the whole line, and always returns FALSE.
2449 // trailing delimiter is always skipped.
2450 UFWORD(PARSE) {
2451   ufoPushBool(0); UFCALL(PAR_PARSE);
2452 }
2453
2454 // (WORD-OR-PARSE)
2455 // ( delim skip-leading-delim? -- here TRUE / FALSE )
2456 // parse word, copy it to HERE as counted string.
2457 // adds trailing zero after the string, but doesn't include it in count.
2458 // doesn't advance line.
2459
2460 // WORD
2461 // ( delim -- here )
2462 // parse word, copy it to HERE as counted string.
2463 // adds trailing zero after the string, but doesn't include it in count.
2464 // doesn't advance line.
2465 // return empty string on EOL.
2466
2467 // PARSE-TO-HERE
2468 // ( delim -- addr count TRUE / FALSE )
2469 // parse word w/o skipping delimiters, copy it to HERE as counted string.
2470 // adds trailing zero after the string, but doesn't include it in count.
2471 // doesn't advance line.
2472
2473
2474 // ////////////////////////////////////////////////////////////////////////// //
2475 // char output
2476
2477 // EMIT
2478 // ( n -- )
2479 UFWORD(EMIT) {
2480   uint32_t ch = ufoPop()&0xffU;
2481   if (ch < 32 || ch == 127) {
2482     if (ch != 9 && ch != 10 && ch != 13) ch = '?';
2483   }
2484   ufoLastEmitWasCR = (ch == 10);
2485   putchar((char)ch);
2486 }
2487
2488 // XEMIT
2489 // ( n -- )
2490 UFWORD(XEMIT) {
2491   uint32_t ch = ufoPop()&0xffU;
2492   putchar(ch < 32 || ch == 127 ? '?' : (char)ch);
2493   ufoLastEmitWasCR = 0;
2494 }
2495
2496 // LASTCR?
2497 // ( -- bool )
2498 UFWORD(LASTCRQ) {
2499   ufoPushBool(ufoLastEmitWasCR);
2500 }
2501
2502 // LASTCR!
2503 // ( bool -- )
2504 UFWORD(LASTCRSET) {
2505   ufoLastEmitWasCR = !!ufoPop();
2506 }
2507
2508 // CR
2509 // ( -- )
2510 UFWORD(CR) {
2511   putchar('\n');
2512   ufoLastEmitWasCR = 1;
2513 }
2514
2515 // SPACE
2516 // ( -- )
2517 UFWORD(SPACE) {
2518   putchar(' ');
2519   ufoLastEmitWasCR = 0;
2520 }
2521
2522 // SPACES
2523 // ( n -- )
2524 UFWORD(SPACES) {
2525   char tmpbuf[64];
2526   int32_t n = (int32_t)ufoPop();
2527   if (n > 0) {
2528     memset(tmpbuf, 32, sizeof(tmpbuf));
2529     while (n > 0) {
2530       int32_t xwr = n;
2531       if (xwr > (int32_t)sizeof(tmpbuf) - 1) xwr = (int32_t)sizeof(tmpbuf) - 1;
2532       tmpbuf[xwr] = 0;
2533       printf("%s", tmpbuf);
2534       n -= xwr;
2535     }
2536     ufoLastEmitWasCR = 0;
2537   }
2538 }
2539
2540 // ENDCR
2541 // ( -- )
2542 UFWORD(ENDCR) {
2543   if (ufoLastEmitWasCR == 0) {
2544     putchar('\n');
2545     ufoLastEmitWasCR = 1;
2546   }
2547 }
2548
2549 // TYPE
2550 // ( addr count -- )
2551 UFWORD(TYPE) {
2552   int32_t count = (int32_t)ufoPop();
2553   uint32_t addr = ufoPop();
2554   while (count > 0) {
2555     const uint8_t ch = ufoImgGetU8(addr);
2556     ufoPush(ch);
2557     UFCALL(EMIT);
2558     addr += 1; count -= 1;
2559   }
2560 }
2561
2562 // XTYPE
2563 // ( addr count -- )
2564 UFWORD(XTYPE) {
2565   int32_t count = (int32_t)ufoPop();
2566   uint32_t addr = ufoPop();
2567   while (count > 0) {
2568     const uint8_t ch = ufoImgGetU8(addr);
2569     ufoPush(ch);
2570     UFCALL(XEMIT);
2571     addr += 1; count -= 1;
2572   }
2573 }
2574
2575
2576 // ////////////////////////////////////////////////////////////////////////// //
2577 // simple math
2578
2579 #define UF_UMATH(name_,op_)  \
2580 UFWORD(name_) { \
2581   const uint32_t a = ufoPop(); \
2582   ufoPush(op_); \
2583 }
2584
2585 #define UF_BMATH(name_,op_)  \
2586 UFWORD(name_) { \
2587   const uint32_t b = ufoPop(); \
2588   const uint32_t a = ufoPop(); \
2589   ufoPush(op_); \
2590 }
2591
2592 #define UF_BDIV(name_,op_)  \
2593 UFWORD(name_) { \
2594   const uint32_t b = ufoPop(); \
2595   const uint32_t a = ufoPop(); \
2596   if (b == 0) ufoFatal("UFO division by zero"); \
2597   ufoPush(op_); \
2598 }
2599
2600
2601 // +
2602 // ( a b -- a+b )
2603 UF_BMATH(PLUS, a + b);
2604
2605 // -
2606 // ( a b -- a-b )
2607 UF_BMATH(MINUS, a - b);
2608
2609 // *
2610 // ( a b -- a*b )
2611 UF_BMATH(MUL, (uint32_t)((int32_t)a * (int32_t)b));
2612
2613 // U*
2614 // ( a b -- a*b )
2615 UF_BMATH(UMUL, a * b);
2616
2617 // /
2618 // ( a b -- a/b )
2619 UF_BDIV(DIV, (uint32_t)((int32_t)a / (int32_t)b));
2620
2621 // U/
2622 // ( a b -- a/b )
2623 UF_BDIV(UDIV, a / b);
2624
2625 // MOD
2626 // ( a b -- a%b )
2627 UF_BDIV(MOD, (uint32_t)((int32_t)a % (int32_t)b));
2628
2629 // UMOD
2630 // ( a b -- a%b )
2631 UF_BDIV(UMOD, a % b);
2632
2633 // /MOD
2634 // ( a b -- a/b, a%b )
2635 UFWORD(DIVMOD) {
2636   const int32_t b = (int32_t)ufoPop();
2637   const int32_t a = (int32_t)ufoPop();
2638   if (b == 0) ufoFatal("UFO division by zero");
2639   ufoPush((uint32_t)(a/b));
2640   ufoPush((uint32_t)(a%b));
2641 }
2642
2643 // U/MOD
2644 // ( a b -- a/b, a%b )
2645 UFWORD(UDIVMOD) {
2646   const uint32_t b = ufoPop();
2647   const uint32_t a = ufoPop();
2648   if (b == 0) ufoFatal("UFO division by zero");
2649   ufoPush((uint32_t)(a/b));
2650   ufoPush((uint32_t)(a%b));
2651 }
2652
2653
2654 // ////////////////////////////////////////////////////////////////////////// //
2655 // simple logic
2656
2657 #define UF_CMP(name_,op_)  \
2658 UFWORD(name_) { \
2659   const uint32_t b = ufoPop(); \
2660   const uint32_t a = ufoPop(); \
2661   ufoPushBool(op_); \
2662 }
2663
2664 // <
2665 // ( a b -- a<b )
2666 UF_CMP(LESS, (int32_t)a < (int32_t)b);
2667
2668 // U<
2669 // ( a b -- a<b )
2670 UF_CMP(ULESS, a < b);
2671
2672 // >
2673 // ( a b -- a>b )
2674 UF_CMP(GREAT, (int32_t)a > (int32_t)b);
2675
2676 // U>
2677 // ( a b -- a>b )
2678 UF_CMP(UGREAT, a > b);
2679
2680 // <=
2681 // ( a b -- a<=b )
2682 UF_CMP(LESSEQU, (int32_t)a <= (int32_t)b);
2683
2684 // U<=
2685 // ( a b -- a<=b )
2686 UF_CMP(ULESSEQU, a <= b);
2687
2688 // >=
2689 // ( a b -- a>=b )
2690 UF_CMP(GREATEQU, (int32_t)a >= (int32_t)b);
2691
2692 // U>=
2693 // ( a b -- a>=b )
2694 UF_CMP(UGREATEQU, a >= b);
2695
2696 // =
2697 // ( a b -- a=b )
2698 UF_CMP(EQU, a == b);
2699
2700 // <>
2701 // ( a b -- a<>b )
2702 UF_CMP(NOTEQU, a != b);
2703
2704 // NOT
2705 // ( a -- !a )
2706 UFWORD(NOT) {
2707   const uint32_t a = ufoPop();
2708   ufoPushBool(!a);
2709 }
2710
2711 // LAND
2712 // ( a b -- a&&b )
2713 UF_CMP(LOGAND, a && b);
2714
2715 // LOR
2716 // ( a b -- a||b )
2717 UF_CMP(LOGOR, a || b);
2718
2719 // AND
2720 // ( a b -- a&b )
2721 UFWORD(AND) {
2722   const uint32_t b = ufoPop();
2723   const uint32_t a = ufoPop();
2724   ufoPush(a&b);
2725 }
2726
2727 // OR
2728 // ( a b -- a|b )
2729 UFWORD(OR) {
2730   const uint32_t b = ufoPop();
2731   const uint32_t a = ufoPop();
2732   ufoPush(a|b);
2733 }
2734
2735 // XOR
2736 // ( a b -- a^b )
2737 UFWORD(XOR) {
2738   const uint32_t b = ufoPop();
2739   const uint32_t a = ufoPop();
2740   ufoPush(a^b);
2741 }
2742
2743 // BITNOT
2744 // ( a -- ~a )
2745 UFWORD(BITNOT) {
2746   const uint32_t a = ufoPop();
2747   ufoPush(~a);
2748 }
2749
2750 UFWORD(ONESHL) { uint32_t n = ufoPop(); ufoPush(n << 1); }
2751 UFWORD(ONESHR) { uint32_t n = ufoPop(); ufoPush(n >> 1); }
2752 UFWORD(TWOSHL) { uint32_t n = ufoPop(); ufoPush(n << 2); }
2753 UFWORD(TWOSHR) { uint32_t n = ufoPop(); ufoPush(n >> 2); }
2754
2755 // ASH
2756 // ( n count -- )
2757 // arithmetic shift; positive `n` shifts to the left
2758 UFWORD(ASH) {
2759   int32_t c = (int32_t)ufoPop();
2760   if (c < 0) {
2761     // right
2762     int32_t n = (int32_t)ufoPop();
2763     if (c < -30) {
2764       if (n < 0) n = -1; else n = 0;
2765     } else {
2766       n >>= (uint8_t)(-c);
2767     }
2768     ufoPush((uint32_t)n);
2769   } else if (c > 0) {
2770     // left
2771     uint32_t u = ufoPop();
2772     if (c > 31) {
2773       u = 0;
2774     } else {
2775       u <<= (uint8_t)c;
2776     }
2777     ufoPush(u);
2778   }
2779 }
2780
2781 // LSH
2782 // ( n count -- )
2783 // logical shift; positive `n` shifts to the left
2784 UFWORD(LSH) {
2785   int32_t c = (int32_t) ufoPop();
2786   uint32_t u = ufoPop();
2787   if (c < 0) {
2788     // right
2789     if (c < -31) {
2790       u = 0;
2791     } else {
2792       u >>= (uint8_t)(-c);
2793     }
2794   } else if (c > 0) {
2795     // left
2796     if (c > 31) {
2797       u = 0;
2798     } else {
2799       u <<= (uint8_t)c;
2800     }
2801   }
2802   ufoPush(u);
2803 }
2804
2805
2806 // (UNESCAPE)
2807 // ( addr count -- addr count )
2808 UFWORD(PAR_UNESCAPE) {
2809   const uint32_t count = ufoPop();
2810   const uint32_t addr = ufoPeek();
2811   if ((count & ((uint32_t)1<<31)) == 0) {
2812     const uint32_t eaddr = addr + count;
2813     uint32_t caddr = addr;
2814     uint32_t daddr = addr;
2815     while (caddr != eaddr) {
2816       uint8_t ch = ufoImgGetU8(caddr); caddr += 1u;
2817       if (ch == '\\' && caddr != eaddr) {
2818         ch = ufoImgGetU8(caddr); caddr += 1u;
2819         switch (ch) {
2820           case 'r': ch = '\r'; break;
2821           case 'n': ch = '\n'; break;
2822           case 't': ch = '\t'; break;
2823           case 'e': ch = '\x1b'; break;
2824           case '`': ch = '"'; break; // special escape to insert double-quote
2825           case '"': ch = '"'; break;
2826           case '\\': ch = '\\'; break;
2827           case 'x': case 'X':
2828             if (eaddr - daddr >= 1) {
2829               const int dg0 = digitInBase((char)(ufoImgGetU8(caddr + 1)), 16);
2830               if (dg0 < 0) ufoFatal("invalid hex string escape");
2831               if (eaddr - daddr >= 2) {
2832                 const int dg1 = digitInBase((char)(ufoImgGetU8(caddr + 2)), 16);
2833                 if (dg1 < 0) ufoFatal("invalid hex string escape");
2834                 ch = (uint8_t)(dg0 * 16 + dg1);
2835                 caddr += 2;
2836               } else {
2837                 ch = (uint8_t)dg0;
2838                 caddr += 1;
2839               }
2840             } else {
2841               ufoFatal("invalid hex string escape");
2842             }
2843             break;
2844           default: ufoFatal("invalid string escape");
2845         }
2846       }
2847       ufoImgPutU8(daddr, ch); daddr += 1u;
2848     }
2849     ufoPush(daddr - addr);
2850   } else {
2851     ufoPush(count);
2852   }
2853 }
2854
2855
2856 // convert number from addrl+1
2857 // returns address of the first inconvertible char
2858 // (XNUMBER) ( addr count allowsign? -- num TRUE / FALSE )
2859 UFWORD(PAR_XNUMBER) {
2860   const uint32_t allowSign = ufoPop();
2861   int32_t count = (int32_t)ufoPop();
2862   uint32_t addr = ufoPop();
2863   uint32_t n = 0;
2864   int base = 0;
2865   int xbase = (int32_t)ufoImgGetU32(ufoAddrBASE);
2866   int neg = 0;
2867   uint8_t ch;
2868
2869   if (allowSign && count > 1) {
2870     ch = ufoImgGetU8(addr);
2871     if (ch == '-') { neg = 1; addr += 1u; count -= 1; }
2872     else if (ch == '+') { neg = 0; addr += 1u; count -= 1; }
2873   }
2874
2875   // special-based numbers
2876   if (count >= 3 && ufoImgGetU8(addr) == '0') {
2877     switch (ufoImgGetU8(addr + 1)) {
2878       case 'x': case 'X': base = 16; break;
2879       case 'o': case 'O': base = 8; break;
2880       case 'b': case 'B': base = 2; break;
2881       case 'd': case 'D': base = 10; break;
2882       default: break;
2883     }
2884     if (base) { addr += 2; count -= 2; }
2885   } else if (count >= 2 && ufoImgGetU8(addr) == '$') {
2886     base = 16;
2887     addr += 1; count -= 1;
2888   } else if (count >= 2 && ufoImgGetU8(addr) == '#') {
2889     base = 16;
2890     addr += 1; count -= 1;
2891   } else if (count >= 2 && ufoImgGetU8(addr) == '%') {
2892     base = 2;
2893     addr += 1; count -= 1;
2894   } else if (count >= 3 && ufoImgGetU8(addr) == '&') {
2895     switch (ufoImgGetU8(addr + 1)) {
2896       case 'h': case 'H': base = 16; break;
2897       case 'o': case 'O': base = 8; break;
2898       case 'b': case 'B': base = 2; break;
2899       case 'd': case 'D': base = 10; break;
2900       default: break;
2901     }
2902     if (base) { addr += 2; count -= 2; }
2903   } else if (xbase < 12 && count > 2 && toUpperU8(ufoImgGetU8(addr + count - 1)) == 'B') {
2904     base = 2;
2905     count -= 1;
2906   } else if (xbase < 18 && count > 2 && toUpperU8(ufoImgGetU8(addr + count - 1)) == 'H') {
2907     base = 16;
2908     count -= 1;
2909   } else if (xbase < 25 && count > 2 && toUpperU8(ufoImgGetU8(addr + count - 1)) == 'O') {
2910     base = 8;
2911     count -= 1;
2912   }
2913
2914   // in current base?
2915   if (!base) base = xbase;
2916
2917   if (count <= 0 || base < 1 || base > 36) {
2918     ufoPushBool(0);
2919   } else {
2920     uint32_t nc;
2921     int wasDig = 0, wasUnder = 1, error = 0, dig;
2922     while (!error && count != 0) {
2923       ch = ufoImgGetU8(addr); addr += 1; count -= 1;
2924       if (ch != '_') {
2925         error = 1; wasUnder = 0; wasDig = 1;
2926         dig = digitInBase((char)ch, (int)base);
2927         if (dig >= 0) {
2928           nc = n * (uint32_t)base;
2929           if (nc >= n) {
2930             nc += (uint32_t)dig;
2931             if (nc >= n) {
2932               n = nc;
2933               error = 0;
2934             }
2935           }
2936         }
2937       } else {
2938         error = wasUnder;
2939         wasUnder = 1;
2940       }
2941     }
2942
2943     if (!error && wasDig && !wasUnder) {
2944       if (allowSign && neg) n = ~n + 1u;
2945       ufoPush(n);
2946       ufoPushBool(1);
2947     } else {
2948       ufoPushBool(0);
2949     }
2950   }
2951 }
2952
2953
2954 // ////////////////////////////////////////////////////////////////////////// //
2955 // compiler-related, dictionary-related
2956
2957 static char ufoWNameBuf[256];
2958
2959
2960 // [
2961 UFWORD(LBRACKET_IMM) {
2962   if (ufoImgGetU32(ufoAddrSTATE) == 0) ufoFatal("expects compiling mode");
2963   ufoImgPutU32(ufoAddrSTATE, 0);
2964 }
2965
2966 // ]
2967 UFWORD(RBRACKET) {
2968   if (ufoImgGetU32(ufoAddrSTATE) != 0) ufoFatal("expects interpreting mode");
2969   ufoImgPutU32(ufoAddrSTATE, 1);
2970 }
2971
2972 // (CREATE-WORD-HEADER)
2973 // ( addr count word-flags -- )
2974 UFWORD(PAR_CREATE_WORD_HEADER) {
2975   const uint32_t flags = ufoPop();
2976   const uint32_t wlen = ufoPop();
2977   const uint32_t waddr = ufoPop();
2978   if (wlen == 0) ufoFatal("word name expected");
2979   if (wlen >= UFO_MAX_WORD_LENGTH) ufoFatal("word name too long");
2980   // copy to separate buffer
2981   for (uint32_t f = 0; f < wlen; f += 1) {
2982     ufoWNameBuf[f] = (char)ufoImgGetU8(waddr + f);
2983   }
2984   ufoWNameBuf[wlen] = 0;
2985   ufoCreateWordHeader(ufoWNameBuf, flags);
2986 }
2987
2988 // (CREATE-NAMELESS-WORD-HEADER)
2989 // ( word-flags -- )
2990 UFWORD(PAR_CREATE_NAMELESS_WORD_HEADER) {
2991   const uint32_t flags = ufoPop();
2992   ufoCreateWordHeader("", flags);
2993 }
2994
2995 // FIND-WORD
2996 // ( addr count -- cfa TRUE / FALSE)
2997 UFWORD(FIND_WORD) {
2998   const uint32_t wlen = ufoPop();
2999   const uint32_t waddr = ufoPop();
3000   if (wlen > 0 && wlen < UFO_MAX_WORD_LENGTH) {
3001     // copy to separate buffer
3002     for (uint32_t f = 0; f < wlen; f += 1) {
3003       ufoWNameBuf[f] = (char)ufoImgGetU8(waddr + f);
3004     }
3005     ufoWNameBuf[wlen] = 0;
3006     const uint32_t cfa = ufoFindWord(ufoWNameBuf);
3007     if (cfa != 0) {
3008       ufoPush(cfa);
3009       ufoPushBool(1);
3010     } else {
3011       ufoPushBool(0);
3012     }
3013   } else {
3014     ufoPushBool(0);
3015   }
3016 }
3017
3018 // FIND-WORD-IN-VOC
3019 // ( addr count vocid allowhidden -- cfa TRUE / FALSE)
3020 // find only in the given voc; no name resolution
3021 UFWORD(FIND_WORD_IN_VOC) {
3022   const uint32_t allowHidden = ufoPop();
3023   const uint32_t vocid = ufoPop();
3024   const uint32_t wlen = ufoPop();
3025   const uint32_t waddr = ufoPop();
3026   if (wlen > 0 && wlen < UFO_MAX_WORD_LENGTH) {
3027     // copy to separate buffer
3028     for (uint32_t f = 0; f < wlen; f += 1) {
3029       ufoWNameBuf[f] = (char)ufoImgGetU8(waddr + f);
3030     }
3031     ufoWNameBuf[wlen] = 0;
3032     const uint32_t cfa = ufoFindWordInVoc(ufoWNameBuf, wlen, 0, vocid, (allowHidden ? 1 : 0));
3033     if (cfa != 0) {
3034       ufoPush(cfa);
3035       ufoPushBool(1);
3036     } else {
3037       ufoPushBool(0);
3038     }
3039   } else {
3040     ufoPushBool(0);
3041   }
3042 }
3043
3044
3045 // ////////////////////////////////////////////////////////////////////////// //
3046 // more compiler words
3047
3048 // ?EXEC
3049 UFWORD(QEXEC) {
3050   if (ufoImgGetU32(ufoAddrSTATE) != 0) ufoFatal("expecting execution mode");
3051 }
3052
3053 // ?COMP
3054 UFWORD(QCOMP) {
3055   if (ufoImgGetU32(ufoAddrSTATE) == 0) ufoFatal("expecting compilation mode");
3056 }
3057
3058 // "
3059 // string literal
3060 UFWORD(QUOTE_IMM) {
3061   ufoPush(34); UFCALL(PARSE);
3062   if (ufoPop() == 0) ufoFatal("string literal expected");
3063   UFCALL(PAR_UNESCAPE);
3064   if (ufoImgGetU32(ufoAddrSTATE) != 0) {
3065     // compiling
3066     const uint32_t wlen = ufoPop();
3067     const uint32_t waddr = ufoPop();
3068     if (wlen > 255) ufoFatal("string literal too long");
3069     ufoImgEmitU32(ufoStrLit8CFA);
3070     ufoImgEmitU8(wlen);
3071     for (uint32_t f = 0; f < wlen; f += 1) {
3072       ufoImgEmitU8(ufoImgGetU8(waddr + f));
3073     }
3074     ufoImgEmitU8(0);
3075     ufoImgEmitAlign();
3076   }
3077 }
3078
3079
3080 // ////////////////////////////////////////////////////////////////////////// //
3081 // vocabulary utilities
3082
3083 // (VSP@)
3084 // ( -- vsp )
3085 UFWORD(PAR_GET_VSP) {
3086   ufoPush(ufoVSP);
3087 }
3088
3089 // (VSP!)
3090 // ( vsp -- )
3091 UFWORD(PAR_SET_VSP) {
3092   const uint32_t vsp = ufoPop();
3093   if (vsp >= UFO_VOCSTACK_SIZE) ufoFatal("VSP %u out of range (%u)", vsp, UFO_VOCSTACK_SIZE);
3094   ufoVSP = vsp;
3095 }
3096
3097 // (VSP-AT@)
3098 // ( idx -- value )
3099 UFWORD(PAR_VSP_LOAD) {
3100   const uint32_t vsp = ufoPop();
3101   if (vsp >= UFO_VOCSTACK_SIZE) ufoFatal("VSP %u out of range (%u)", vsp, UFO_VOCSTACK_SIZE);
3102   ufoPush(ufoVocStack[vsp]);
3103 }
3104
3105 // (VSP-AT!)
3106 // ( value idx -- )
3107 UFWORD(PAR_VSP_STORE) {
3108   const uint32_t vsp = ufoPop();
3109   const uint32_t value = ufoPop();
3110   if (vsp > UFO_VOCSTACK_SIZE) ufoFatal("VSP %u out of range (%u)", vsp, UFO_VOCSTACK_SIZE);
3111   ufoVocStack[vsp] = value;
3112 }
3113
3114 // (HIDDEN)
3115 UFWORD(PAR_HIDDEN) {
3116   uint32_t curr = ufoImgGetU32(ufoAddrCurrent);
3117   uint32_t latest = ufoImgGetU32(curr);
3118   if (latest == 0) ufoFatal("wtf in `IMMEDIATE`");
3119   uint32_t nfa = latest + 8u;
3120   uint32_t flags = ufoImgGetU32(nfa);
3121   flags |= UFW_FLAG_HIDDEN;
3122   ufoImgPutU32(nfa, flags);
3123 }
3124
3125
3126 // ////////////////////////////////////////////////////////////////////////// //
3127 // word field address conversion
3128
3129 // CFA->PFA
3130 // ( cfa -- pfa )
3131 UFWORD(CFA2PFA) {
3132   const uint32_t cfa = ufoPop();
3133   ufoPush(UFO_CFA_TO_PFA(cfa));
3134 }
3135
3136 // PFA->CFA
3137 // ( pfa -- cfa )
3138 UFWORD(PFA2CFA) {
3139   const uint32_t pfa = ufoPop();
3140   ufoPush(UFO_PFA_TO_CFA(pfa));
3141 }
3142
3143 // CFA->NFA
3144 // ( cfa -- nfa )
3145 UFWORD(CFA2NFA) {
3146   const uint32_t cfa = ufoPop();
3147   ufoPush(UFO_CFA_TO_NFA(cfa));
3148 }
3149
3150 // NFA->CFA
3151 // ( nfa -- cfa )
3152 UFWORD(NFA2CFA) {
3153   const uint32_t nfa = ufoPop();
3154   ufoPush(UFO_NFA_TO_CFA(nfa));
3155 }
3156
3157 // CFA->LFA
3158 // ( cfa -- lfa )
3159 UFWORD(CFA2LFA) {
3160   const uint32_t cfa = ufoPop();
3161   ufoPush(UFO_CFA_TO_LFA(cfa));
3162 }
3163
3164 // LFA->CFA
3165 // ( lfa -- cfa )
3166 UFWORD(LFA2CFA) {
3167   const uint32_t lfa = ufoPop();
3168   ufoPush(UFO_LFA_TO_CFA(lfa));
3169 }
3170
3171 // LFA->PFA
3172 // ( lfa -- cfa )
3173 UFWORD(LFA2PFA) {
3174   uint32_t lfa = ufoPop();
3175   lfa = UFO_LFA_TO_CFA(lfa);
3176   ufoPush(UFO_CFA_TO_PFA(lfa));
3177 }
3178
3179 // LFA->BFA
3180 // ( lfa -- bfa )
3181 UFWORD(LFA2BFA) {
3182   const uint32_t lfa = ufoPop();
3183   ufoPush(UFO_LFA_TO_BFA(lfa));
3184 }
3185
3186 // LFA->SFA
3187 // ( lfa -- sfa )
3188 UFWORD(LFA2SFA) {
3189   const uint32_t lfa = ufoPop();
3190   ufoPush(UFO_LFA_TO_SFA(lfa));
3191 }
3192
3193 // LFA->NFA
3194 // ( lfa -- nfa )
3195 UFWORD(LFA2NFA) {
3196   const uint32_t lfa = ufoPop();
3197   ufoPush(UFO_LFA_TO_NFA(lfa));
3198 }
3199
3200 // NFA->LFA
3201 // ( nfa -- lfa )
3202 UFWORD(NFA2LFA) {
3203   const uint32_t nfa = ufoPop();
3204   ufoPush(UFO_NFA_TO_LFA(nfa));
3205 }
3206
3207
3208 // ////////////////////////////////////////////////////////////////////////// //
3209 // UrAsm API
3210
3211
3212 //==========================================================================
3213 //
3214 //  ufoPopStrLitToTempBuf
3215 //
3216 //==========================================================================
3217 static void ufoPopStrLitToTempBuf (void) {
3218   uint32_t count = ufoPop();
3219   uint32_t addr = ufoPop();
3220   if ((count & (1u<<31)) != 0) ufoFatal("invalid string length");
3221   if ((size_t)count >= sizeof(ufoTempCharBuf)) ufoFatal("string too long");
3222   for (uint32_t f = 0; f < count; f += 1) {
3223     ufoTempCharBuf[f] = (char)ufoImgGetU8(addr + f);
3224   }
3225   ufoTempCharBuf[count] = 0;
3226 }
3227
3228
3229 // UR-HAS-LABEL?
3230 // ( addr count -- flag )
3231 UFWORD(UR_HAS_LABELQ) {
3232   ufoPopStrLitToTempBuf();
3233   ufoPushBool(ufoZXGetLabelType(ufoTempCharBuf) > UFO_ZX_LABEL_UNKNOWN);
3234 }
3235
3236 // UR-LABEL-TYPE?
3237 // ( addr count -- type )
3238 // 0: unknown
3239 UFWORD(UR_GET_LABELQ_TYPE) {
3240   ufoPopStrLitToTempBuf();
3241   ufoPush(ufoZXGetLabelType(ufoTempCharBuf));
3242 }
3243
3244 // UR-GET-LABEL
3245 // ( addr count -- value )
3246 // fatals when the label is not found
3247 UFWORD(UR_GET_LABEL) {
3248   ufoPopStrLitToTempBuf();
3249   ufoPush((uint32_t)ufoZXGetLabelValue(ufoTempCharBuf));
3250 }
3251
3252 // UR-NEW-LABEL-ITER
3253 // ( -- iterid | 0 )
3254 UFWORD(UR_NEW_LABEL_ITER) {
3255   ufoPush(ufoZXNewLabelIter());
3256 }
3257
3258 // UR-CLOSE-LABEL-ITER
3259 // ( iterid -- )
3260 UFWORD(UR_CLOSE_LABEL_ITER) {
3261   uint32_t id = ufoPop();
3262   ufoZXLabelIterClose(id);
3263 }
3264
3265 // UR-LABEL-ITER-NEXT
3266 // ( iterid -- not-done? )
3267 UFWORD(UR_LABEL_ITER_NEXT) {
3268   uint32_t id = ufoPop();
3269   ufoPushBool(ufoZXLabelIterNext(id));
3270 }
3271
3272 // UR-LABEL-ITER-GET-NAME
3273 // ( iterid -- addr count )
3274 // to PAD
3275 UFWORD(UR_LABEL_ITER_GET_NAME) {
3276   uint32_t id = ufoPop();
3277   const char *name = ufoZXLabelIterGetName(id);
3278   if (name == NULL) name = "";
3279   uint32_t count = 0;
3280   UFCALL(PAD);
3281   uint32_t pad = ufoPop() + 4u;
3282   while (count != 1024 && *name != 0) {
3283     ufoImgPutU8(pad + count, ((const unsigned char *)name)[count]);
3284     count += 1u; name += 1u;
3285   }
3286   if (count == 1024) ufoFatal("label name too long");
3287   ufoImgPutU8(pad + count, 0); // just in case
3288   ufoPush(pad); ufoPush(count);
3289 }
3290
3291 // UR-LABEL-ITER-GET-VALUE
3292 // ( iterid -- value )
3293 UFWORD(UR_LABEL_ITER_GET_VALUE) {
3294   uint32_t id = ufoPop();
3295   ufoPush((uint32_t)ufoZXIterGetValue(id));
3296 }
3297
3298 // UR-LABEL-ITER-GET-TYPE
3299 // ( iterid -- type )
3300 UFWORD(UR_LABEL_ITER_GET_TYPE) {
3301   uint32_t id = ufoPop();
3302   ufoPush((uint32_t)ufoZXIterGetType(id));
3303 }
3304
3305
3306 //==========================================================================
3307 //
3308 //  urw_set_typed_label
3309 //
3310 // ( value addr count -- )
3311 //
3312 //==========================================================================
3313 static void urw_set_typed_label (int type) {
3314   ufoPopStrLitToTempBuf();
3315   const char *name = ufoTempCharBuf;
3316   int32_t val = (int32_t)ufoPop();
3317   ufoZXSetLabelValue(name, type, val);
3318 }
3319
3320
3321 // UR-SET-LABEL-VAR
3322 // ( value addr count -- )
3323 // create/overwrite an "assign" label
3324 UFWORD(UR_SET_LABEL_VAR) { urw_set_typed_label(UFO_ZX_LABEL_VAR); }
3325
3326 // UR-SET-LABEL-EQU
3327 // ( value addr count -- )
3328 UFWORD(UR_SET_LABEL_EQU) { urw_set_typed_label(UFO_ZX_LABEL_EQU); }
3329
3330 // UR-SET-LABEL-CODE
3331 // ( value addr count -- )
3332 UFWORD(UR_SET_LABEL_CODE) { urw_set_typed_label(UFO_ZX_LABEL_CODE); }
3333
3334 // UR-SET-LABEL-STOFS
3335 // ( value addr count -- )
3336 UFWORD(UR_SET_LABEL_STOFS) { urw_set_typed_label(UFO_ZX_LABEL_STOFS); }
3337
3338 // UR-SET-LABEL-DATA
3339 // ( value addr count -- )
3340 UFWORD(UR_SET_LABEL_DATA) { urw_set_typed_label(UFO_ZX_LABEL_DATA); }
3341
3342
3343 //==========================================================================
3344 //
3345 //  urw_declare_typed_label
3346 //
3347 //==========================================================================
3348 static void urw_declare_typed_label (int type) {
3349   UFCALL(QEXEC);
3350   UFCALL(PARSE_NAME);
3351   ufoPopStrLitToTempBuf();
3352   if (ufoTempCharBuf[0] == 0) ufoFatal("label name expected");
3353   const char *name = ufoTempCharBuf;
3354   ufoZXSetLabelValue(name, type, ufoZXGetOrg());
3355 }
3356
3357 // $LABEL-DATA: name
3358 UFWORD(DLR_LABEL_DATA_IMM) { urw_declare_typed_label(UFO_ZX_LABEL_DATA); }
3359 // $LABEL-CODE: name
3360 UFWORD(DLR_LABEL_CODE_IMM) { urw_declare_typed_label(UFO_ZX_LABEL_CODE); }
3361
3362
3363 // UR-PASS@
3364 // ( -- pass )
3365 UFWORD(UR_PASSQ) {
3366   ufoPush(ufoZXGetPass());
3367 }
3368
3369 // UR-ORG@
3370 // ( -- org )
3371 UFWORD(UR_GETORG) {
3372   ufoPush(ufoZXGetOrg());
3373 }
3374
3375 // UR-DISP@
3376 // ( -- disp )
3377 UFWORD(UR_GETDISP) {
3378   ufoPush(ufoZXGetDisp());
3379 }
3380
3381 // UR-ENT@
3382 // ( -- ent )
3383 UFWORD(UR_GETENT) {
3384   ufoPush(ufoZXGetEnt());
3385 }
3386
3387 // UR-ORG!
3388 // ( org -- )
3389 // also sets disp
3390 UFWORD(UR_SETORG) {
3391   const uint32_t addr = ufoPop();
3392   ufoZXSetOrg(addr);
3393 }
3394
3395 // UR-DISP!
3396 // ( disp -- )
3397 // doesn't change ORG
3398 UFWORD(UR_SETDISP) {
3399   const uint32_t addr = ufoPop();
3400   ufoZXSetDisp(addr);
3401 }
3402
3403 // UR-ENT!
3404 // ( ent -- )
3405 UFWORD(UR_SETENT) {
3406   const uint32_t addr = ufoPop();
3407   ufoZXSetEnt(addr);
3408 }
3409
3410
3411 // ////////////////////////////////////////////////////////////////////////// //
3412 // string
3413
3414 UFO_FORCE_INLINE uint32_t ufoHashBuf (uint32_t addr, uint32_t size, uint8_t orbyte) {
3415   uint32_t hash = 0x29a;
3416   if ((size & ((uint32_t)1<<31)) == 0) {
3417     while (size != 0) {
3418       hash += ufoImgGetU8(addr) | orbyte;
3419       hash += hash<<10;
3420       hash ^= hash>>6;
3421       addr += 1u; size -= 1u;
3422     }
3423   }
3424   // finalize
3425   hash += hash<<3;
3426   hash ^= hash>>11;
3427   hash += hash<<15;
3428   return hash;
3429 }
3430
3431 // STRING:=
3432 // ( a0 c0 a1 c1 -- bool )
3433 UFWORD(STREQU) {
3434   int32_t c1 = (int32_t)ufoPop();
3435   uint32_t a1 = ufoPop();
3436   int32_t c0 = (int32_t)ufoPop();
3437   uint32_t a0 = ufoPop();
3438   if (c0 < 0) c0 = 0;
3439   if (c1 < 0) c1 = 0;
3440   if (c0 == c1) {
3441     int res = 1;
3442     while (res != 0 && c0 != 0) {
3443       res = (ufoImgGetU8(a0) == ufoImgGetU8(a1));
3444       a0 += 1; a1 += 1; c0 -= 1;
3445     }
3446     ufoPushBool(res);
3447   } else {
3448     ufoPushBool(0);
3449   }
3450 }
3451
3452 // STRING:=CI
3453 // ( a0 c0 a1 c1 -- bool )
3454 UFWORD(STREQUCI) {
3455   int32_t c1 = (int32_t)ufoPop();
3456   uint32_t a1 = ufoPop();
3457   int32_t c0 = (int32_t)ufoPop();
3458   uint32_t a0 = ufoPop();
3459   if (c0 < 0) c0 = 0;
3460   if (c1 < 0) c1 = 0;
3461   if (c0 == c1) {
3462     int res = 1;
3463     while (res != 0 && c0 != 0) {
3464       res = (toUpperU8(ufoImgGetU8(a0)) == toUpperU8(ufoImgGetU8(a1)));
3465       a0 += 1; a1 += 1; c0 -= 1;
3466     }
3467     ufoPushBool(res);
3468   } else {
3469     ufoPushBool(0);
3470   }
3471 }
3472
3473 // STRING:HASH
3474 // ( addr count -- hash )
3475 UFWORD(STRHASH) {
3476   uint32_t count = ufoPop();
3477   uint32_t addr = ufoPop();
3478   ufoPush(ufoHashBuf(addr, count, 0));
3479 }
3480
3481 // STRING:HASH-CI
3482 // ( addr count -- hash )
3483 UFWORD(STRHASHCI) {
3484   uint32_t count = ufoPop();
3485   uint32_t addr = ufoPop();
3486   ufoPush(ufoHashBuf(addr, count, 0x20));
3487 }
3488
3489
3490 // ////////////////////////////////////////////////////////////////////////// //
3491 // conditional defines
3492 typedef struct UForthCondDefine_t UForthCondDefine;
3493 struct UForthCondDefine_t {
3494   char *name;
3495   uint32_t namelen;
3496   uint32_t hash;
3497   UForthCondDefine *next;
3498 };
3499
3500 static UForthCondDefine *ufoCondDefines = NULL;
3501 static char ufoErrMsgBuf[4096];
3502
3503
3504 //==========================================================================
3505 //
3506 //  ufoBufEquCI
3507 //
3508 //==========================================================================
3509 UFO_FORCE_INLINE int ufoBufEquCI (uint32_t addr, uint32_t count, const void *buf) {
3510   int res;
3511   if ((count & ((uint32_t)1<<31)) == 0) {
3512     const unsigned char *src = (const unsigned char *)buf;
3513     res = 1;
3514     while (res != 0 && count != 0) {
3515       res = (toUpperU8(*src) == toUpperU8(ufoImgGetU8(addr)));
3516       src += 1; addr += 1u; count -= 1u;
3517     }
3518   } else {
3519     res = 0;
3520   }
3521   return res;
3522 }
3523
3524
3525 //==========================================================================
3526 //
3527 //  ufoClearCondDefines
3528 //
3529 //==========================================================================
3530 static void ufoClearCondDefines (void) {
3531   while (ufoCondDefines) {
3532     UForthCondDefine *df = ufoCondDefines;
3533     ufoCondDefines = df->next;
3534     if (df->name) free(df->name);
3535     free(df);
3536   }
3537 }
3538
3539
3540 // ($DEFINE)
3541 // ( addr count -- )
3542 UFWORD(PAR_DLR_DEFINE) {
3543   uint32_t count = ufoPop();
3544   uint32_t addr = ufoPop();
3545   if (count == 0) ufoFatal("empty define");
3546   if (count >= UFO_MAX_WORD_LENGTH) ufoFatal("define too long");
3547   const uint32_t hash = ufoHashBuf(addr, count, 0x20);
3548   UForthCondDefine *dd;
3549   for (dd = ufoCondDefines; dd != NULL; dd = dd->next) {
3550     if (dd->hash == hash && dd->namelen == count) {
3551       if (ufoBufEquCI(addr, count, dd->name)) return;
3552     }
3553   }
3554   // new define
3555   dd = calloc(1, sizeof(UForthCondDefine));
3556   if (dd == NULL) ufoFatal("out of memory for defines");
3557   dd->name = calloc(1, count + 1u);
3558   if (dd->name == NULL) { free(dd); ufoFatal("out of memory for defines"); }
3559   for (uint32_t f = 0; f < count; f += 1) {
3560     ((unsigned char *)dd->name)[f] = ufoImgGetU8(addr + f);
3561   }
3562   dd->namelen = count;
3563   dd->hash = hash;
3564   dd->next = ufoCondDefines;
3565   ufoCondDefines = dd;
3566 }
3567
3568 // ($UNDEF)
3569 // ( addr count -- )
3570 UFWORD(PAR_DLR_UNDEF) {
3571   uint32_t count = ufoPop();
3572   uint32_t addr = ufoPop();
3573   if (count == 0) ufoFatal("empty define");
3574   if (count >= UFO_MAX_WORD_LENGTH) ufoFatal("define too long");
3575   const uint32_t hash = ufoHashBuf(addr, count, 0x20);
3576   UForthCondDefine *prev = NULL;
3577   UForthCondDefine *dd;
3578   for (dd = ufoCondDefines; dd != NULL; prev = dd, dd = dd->next) {
3579     if (dd->hash == hash && dd->namelen == count) {
3580       if (ufoBufEquCI(addr, count, dd->name)) {
3581         if (prev == NULL) ufoCondDefines = dd->next; else prev->next = dd->next;
3582         free(dd->name);
3583         free(dd);
3584         return;
3585       }
3586     }
3587   }
3588 }
3589
3590 // ($DEFINED?)
3591 // ( addr count -- bool )
3592 UFWORD(PAR_DLR_DEFINEDQ) {
3593   uint32_t count = ufoPop();
3594   uint32_t addr = ufoPop();
3595   if (count == 0) ufoFatal("empty define");
3596   if (count >= UFO_MAX_WORD_LENGTH) ufoFatal("define too long");
3597   const uint32_t hash = ufoHashBuf(addr, count, 0x20);
3598   int found = 0;
3599   UForthCondDefine *dd = ufoCondDefines;
3600   while (!found && dd != NULL) {
3601     if (dd->hash == hash && dd->namelen == count) {
3602       found = ufoBufEquCI(addr, count, dd->name);
3603     }
3604     dd = dd->next;
3605   }
3606   ufoPushBool(found);
3607 }
3608
3609 // (TYPE-CURR-FILE)
3610 // ( -- )
3611 UFWORD(PAR_TYPE_CURR_FILE) {
3612   if (ufoInFile != NULL) {
3613     fprintf(stdout, "at file %s, line %d: ", ufoInFileName, ufoInFileLine);
3614   } else {
3615     fprintf(stdout, "somewhere in time: ");
3616   }
3617 }
3618
3619 // ERROR
3620 // ( addr count -- )
3621 UFWORD(ERROR) {
3622   uint32_t count = ufoPop();
3623   uint32_t addr = ufoPop();
3624   if (count & (1u<<31)) ufoFatal("invalid error message");
3625   if (count == 0) ufoFatal("some error");
3626   if (count > (uint32_t)sizeof(ufoErrMsgBuf) - 1u) count = (uint32_t)sizeof(ufoErrMsgBuf) - 1u;
3627   for (uint32_t f = 0; f < count; f += 1) {
3628     ufoErrMsgBuf[f] = (char)ufoImgGetU8(addr + f);
3629   }
3630   ufoErrMsgBuf[count] = 0;
3631   ufoFatal("%s", ufoErrMsgBuf);
3632 }
3633
3634 // ?ERROR
3635 // ( errflag addr count -- )
3636 UFWORD(QERROR) {
3637   const uint32_t count = ufoPop();
3638   const uint32_t addr = ufoPop();
3639   if (ufoPop()) {
3640     ufoPush(addr);
3641     ufoPush(count);
3642     UFCALL(ERROR);
3643   }
3644 }
3645
3646
3647 // ////////////////////////////////////////////////////////////////////////// //
3648 // includes
3649
3650 static char ufoFNameBuf[4096];
3651
3652 // (INCLUDE)
3653 // ( addr count soft? system? -- )
3654 UFWORD(PAR_INCLUDE) {
3655   uint32_t system = ufoPop();
3656   uint32_t softinclude = ufoPop();
3657   uint32_t count = ufoPop();
3658   uint32_t addr = ufoPop();
3659
3660   if ((count & ((uint32_t)1<<31)) != 0) ufoFatal("invalid include name");
3661   //if (count == 0) ufoFatal("empty define");
3662   //if (count > (uint32_t)sizeof(ufoErrMsgBuf) - 1u) ufoFatal("define too long");
3663
3664   uint32_t dpos;
3665   uint8_t ch;
3666
3667   while (count != 0) {
3668     ch = ufoImgGetU8(addr);
3669     if (ch == '!') {
3670       //if (system) ufoFatal("invalid file name (duplicate system mark)");
3671       system = 1;
3672     } else if (ch == '?') {
3673       //if (softinclude) ufoFatal("invalid file name (duplicate soft mark)");
3674       softinclude = 1;
3675     } else {
3676       break;
3677     }
3678     do {
3679       addr += 1; count -= 1;
3680       ch = ufoImgGetU8(addr);
3681     } while (ch <= 32 && count != 0);
3682   }
3683
3684   if (count == 0) {
3685     if (!softinclude) ufoFatal("empty include file name");
3686     return;
3687   }
3688   if (count > (uint32_t)sizeof(ufoFNameBuf) - 1u) ufoFatal("include file name too long");
3689
3690   // get filename
3691   if ((size_t)count >= sizeof(ufoFNameBuf)) ufoFatal("include file name too long");
3692   dpos = 0;
3693   while (count != 0) {
3694     ufoFNameBuf[dpos] = (char)ufoImgGetU8(addr); dpos += 1;
3695     addr += 1; count -= 1;
3696   }
3697   ufoFNameBuf[dpos] = 0;
3698
3699   char *ffn = ufoCreateIncludeName(ufoFNameBuf, system, ufoLastIncPath);
3700   FILE *fl = ufoOpenFileOrDir(&ffn);
3701   if (!fl) {
3702     if (softinclude) { free(ffn); return; }
3703     ufoFatal("include file '%s' not found", ffn);
3704   }
3705   ufoPushInFile();
3706   ufoInFile = fl;
3707   ufoInFileLine = 0;
3708   ufoInFileName = ffn;
3709   setLastIncPath(ufoInFileName);
3710
3711   // trigger next line loading
3712   UFCALL(REFILL);
3713   if (!ufoPop()) ufoFatal("(INCLUDE) internal error");
3714 }
3715
3716 // $INCLUDE "str"
3717 UFWORD(DLR_INCLUDE_IMM) {
3718   int soft = 0, system = 0;
3719   // parse include filename
3720   UFCALL(PARSE_SKIP_BLANKS);
3721   uint8_t ch = ufoImgGetU8(ufoImgGetU32(ufoAddrTIB) + ufoImgGetU32(ufoAddrIN));
3722   if (ch == '"') {
3723     ufoImgPutU32(ufoAddrIN, ufoImgGetU32(ufoAddrIN) + 1u); // skip quote
3724     ufoPush(34); UFCALL(PARSE);
3725   } else if (ch == '<') {
3726     ufoImgPutU32(ufoAddrIN, ufoImgGetU32(ufoAddrIN) + 1u); // skip quote
3727     ufoPush(62); UFCALL(PARSE);
3728     system = 1;
3729   } else {
3730     ufoFatal("expected quoted string");
3731   }
3732   if (!ufoPop()) ufoFatal("file name expected");
3733   ufoPushBool(0); UFCALL(PAR_PARSE_SKIP_COMMENTS);
3734   if (ufoImgGetU8(ufoImgGetU32(ufoAddrTIB) + ufoImgGetU32(ufoAddrIN)) != 0) {
3735     ufoFatal("$INCLUDE doesn't accept extra args yet");
3736   }
3737   // ( addr count soft? system? -- )
3738   ufoPushBool(soft); ufoPushBool(system); UFCALL(PAR_INCLUDE);
3739 }
3740
3741 // $INCLUDE-ONCE defname "str"
3742 UFWORD(DLR_INCLUDE_ONCE_IMM) {
3743   UFCALL(PARSE_NAME);
3744   if (ufoPeek() == 0) ufoFatal("guard name expected");
3745   ufo2Dup(); UFCALL(PAR_DLR_DEFINEDQ);
3746   if (ufoPop() == 0) {
3747     // define guard
3748     UFCALL(PAR_DLR_DEFINE);
3749     // parse include filename
3750     UFCALL(DLR_INCLUDE_IMM);
3751   } else {
3752     // already included
3753     ufo2Drop();
3754     //UFCALL(PARSE_SKIP_LINE);
3755     if (ufoImgGetU8(ufoImgGetU32(ufoAddrTIB) + ufoImgGetU32(ufoAddrIN)) != 34) {
3756       ufoFatal("expected quoted string");
3757     }
3758     ufoImgPutU32(ufoAddrIN, ufoImgGetU32(ufoAddrIN) + 1u); // skip quote
3759     ufoPush(34); UFCALL(PARSE);
3760     ufoPushBool(0); UFCALL(PAR_PARSE_SKIP_COMMENTS);
3761     if (ufoImgGetU8(ufoImgGetU32(ufoAddrTIB) + ufoImgGetU32(ufoAddrIN)) != 0) {
3762       ufoFatal("$INCLUDE doesn't accept extra args yet");
3763     }
3764   }
3765 }
3766
3767
3768 // ////////////////////////////////////////////////////////////////////////// //
3769 // handles
3770
3771 // HANDLE:NEW
3772 // ( typecfa -- hx )
3773 UFWORD(PAR_NEW_HANDLE) {
3774   const uint32_t typecfa = ufoPop();
3775   if (typecfa == UFO_HANDLE_FREE) ufoFatal("invalid handle typecfa");
3776   UHandleInfo *hh = ufoAllocHandle(typecfa);
3777   ufoPush(hh->ufoHandle);
3778 }
3779
3780 // HANDLE:FREE
3781 // ( hx -- )
3782 UFWORD(PAR_FREE_HANDLE) {
3783   const uint32_t hx = ufoPop();
3784   if (hx != 0) {
3785     if ((hx & UFO_ADDR_HANDLE_BIT) == 0) ufoFatal("trying to free something that is not a handle");
3786     UHandleInfo *hh = ufoGetHandle(hx);
3787     if (hh == NULL) ufoFatal("trying to free invalid handle");
3788     ufoFreeHandle(hh);
3789   }
3790 }
3791
3792 // HANDLE:GET-SIZE
3793 // ( hx -- size )
3794 UFWORD(PAR_HANDLE_GET_SIZE) {
3795   const uint32_t hx = ufoPop();
3796   if (hx != 0) {
3797     if ((hx & UFO_ADDR_HANDLE_BIT) == 0) ufoFatal("not a handle");
3798     UHandleInfo *hh = ufoGetHandle(hx);
3799     if (hh == NULL) ufoFatal("invalid handle");
3800     ufoPush(hh->size);
3801   } else {
3802     ufoPush(0);
3803   }
3804 }
3805
3806 // HANDLE:SET-SIZE
3807 // ( size hx -- )
3808 UFWORD(PAR_HANDLE_SET_SIZE) {
3809   const uint32_t hx = ufoPop();
3810   const uint32_t size = ufoPop();
3811   if (size > 0x04000000) ufoFatal("invalid handle size");
3812   if ((hx & UFO_ADDR_HANDLE_BIT) == 0) ufoFatal("not a handle");
3813   UHandleInfo *hh = ufoGetHandle(hx);
3814   if (hh == NULL) ufoFatal("invalid handle");
3815   if (hh->size != size) {
3816     if (size == 0) {
3817       free(hh->mem);
3818       hh->mem = NULL;
3819     } else {
3820       uint32_t *nx = realloc(hh->mem, size * sizeof(hh->mem[0]));
3821       if (nx == NULL) ufoFatal("out of memory for handle of size %u", size);
3822       hh->mem = nx;
3823     }
3824     hh->size = size;
3825     if (hh->used > size) hh->used = size;
3826   }
3827 }
3828
3829 // HANDLE:GET-USED
3830 // ( hx -- used )
3831 UFWORD(PAR_HANDLE_GET_USED) {
3832   const uint32_t hx = ufoPop();
3833   if (hx != 0) {
3834     if ((hx & UFO_ADDR_HANDLE_BIT) == 0) ufoFatal("not a handle");
3835     UHandleInfo *hh = ufoGetHandle(hx);
3836     if (hh == NULL) ufoFatal("invalid handle");
3837     ufoPush(hh->used);
3838   } else {
3839     ufoPush(0);
3840   }
3841 }
3842
3843 // HANDLE:SET-USED
3844 // ( size hx -- )
3845 UFWORD(PAR_HANDLE_SET_USED) {
3846   const uint32_t hx = ufoPop();
3847   const uint32_t used = ufoPop();
3848   if (used > 0x04000000) ufoFatal("invalid handle used");
3849   if ((hx & UFO_ADDR_HANDLE_BIT) == 0) ufoFatal("not a handle");
3850   UHandleInfo *hh = ufoGetHandle(hx);
3851   if (hh == NULL) ufoFatal("invalid handle");
3852   if (used > hh->size) ufoFatal("handle used %u out of range (%u)", used, hh->size);
3853   hh->used = used;
3854 }
3855
3856 // HANDLE:@
3857 // ( idx hx -- value )
3858 UFWORD(PAR_HANDLE_LOAD) {
3859   const uint32_t hx = ufoPop();
3860   const uint32_t idx = ufoPop();
3861   if ((hx & UFO_ADDR_HANDLE_BIT) == 0) ufoFatal("not a handle");
3862   UHandleInfo *hh = ufoGetHandle(hx);
3863   if (hh == NULL) ufoFatal("invalid handle");
3864   if (idx >= hh->size) ufoFatal("handle index %u out of range (%u)", idx, hh->size);
3865   ufoPush(hh->mem[idx]);
3866 }
3867
3868 // HANDLE:!
3869 // ( value idx hx -- value )
3870 UFWORD(PAR_HANDLE_STORE) {
3871   const uint32_t hx = ufoPop();
3872   const uint32_t idx = ufoPop();
3873   const uint32_t value = ufoPop();
3874   if ((hx & UFO_ADDR_HANDLE_BIT) == 0) ufoFatal("not a handle");
3875   UHandleInfo *hh = ufoGetHandle(hx);
3876   if (hh == NULL) ufoFatal("invalid handle");
3877   if (idx >= hh->size) ufoFatal("handle index %u out of range (%u)", idx, hh->size);
3878   hh->mem[idx] = value;
3879 }
3880
3881 // DEBUG:(DECOMPILE-CFA)
3882 // ( cfa -- )
3883 UFWORD(DEBUG_DECOMPILE_CFA) {
3884   const uint32_t cfa = ufoPop();
3885   ufoDecompileWord(cfa);
3886 }
3887
3888 // GET-MSECS
3889 // ( -- u32 )
3890 UFWORD(GET_MSECS) {
3891   ufoPush((uint32_t)ufo_get_msecs());
3892 }
3893
3894
3895 // ////////////////////////////////////////////////////////////////////////// //
3896 // inline stop
3897
3898 // $END_FORTH
3899 UFWORD(DLR_END_FORTH_IMM) {
3900   if (ufoMode != UFO_MODE_NATIVE) ufoFatal("$END_FORTH in non-native mode");
3901   if (ufoImgGetU32(ufoAddrSTATE) != 0) ufoFatal("$END_FORTH: still compiling something");
3902   longjmp(ufoInlineQuitJP, 1);
3903 }
3904
3905
3906 // ////////////////////////////////////////////////////////////////////////// //
3907 #undef UFWORD
3908
3909 #define UFWORD(name_)  do { \
3910   const uint32_t xcfa_ = ufoCFAsUsed; \
3911   ufo_assert(xcfa_ < UFO_MAX_NATIVE_CFAS); \
3912   ufoForthCFAs[xcfa_] = &ufoWord_##name_; \
3913   ufoCFAsUsed += 1; \
3914   ufoDefineNative(""#name_, xcfa_, 0); \
3915 } while (0)
3916
3917 #define UFWORDX(strname_,name_)  do { \
3918   const uint32_t xcfa_ = ufoCFAsUsed; \
3919   ufo_assert(xcfa_ < UFO_MAX_NATIVE_CFAS); \
3920   ufoForthCFAs[xcfa_] = &ufoWord_##name_; \
3921   ufoCFAsUsed += 1; \
3922   ufoDefineNative(strname_, xcfa_, 0); \
3923 } while (0)
3924
3925 #define UFWORD_IMM(name_)  do { \
3926   const uint32_t xcfa_ = ufoCFAsUsed; \
3927   ufo_assert(xcfa_ < UFO_MAX_NATIVE_CFAS); \
3928   ufoForthCFAs[xcfa_] = &ufoWord_##name_; \
3929   ufoCFAsUsed += 1; \
3930   ufoDefineNative(""#name_, xcfa_, 1); \
3931 } while (0)
3932
3933 #define UFWORDX_IMM(strname_,name_)  do { \
3934   const uint32_t xcfa_ = ufoCFAsUsed; \
3935   ufo_assert(xcfa_ < UFO_MAX_NATIVE_CFAS); \
3936   ufoForthCFAs[xcfa_] = &ufoWord_##name_; \
3937   ufoCFAsUsed += 1; \
3938   ufoDefineNative(strname_, xcfa_, 1); \
3939 } while (0)
3940
3941 #define UFC(name_)  ufoImgEmitU32_NoInline(ufoFindWordChecked(name_))
3942
3943
3944 //==========================================================================
3945 //
3946 //  ufoFindWordChecked
3947 //
3948 //==========================================================================
3949 static __attribute__((noinline)) uint32_t ufoFindWordChecked (const char *wname) {
3950   const uint32_t cfa = ufoFindWord(wname);
3951   if (cfa == 0) ufoFatal("word '%s' not found", wname);
3952   return cfa;
3953 }
3954
3955
3956 //==========================================================================
3957 //
3958 //  ufoVocSetOnlyDefs
3959 //
3960 //==========================================================================
3961 static void ufoVocSetOnlyDefs (uint32_t vocid) {
3962   ufoImgPutU32(ufoAddrCurrent, vocid);
3963   ufoImgPutU32(ufoAddrContext, vocid);
3964 }
3965
3966
3967 //==========================================================================
3968 //
3969 //  ufoCreateVoc
3970 //
3971 //  return voc PFA (vocid)
3972 //
3973 //==========================================================================
3974 static uint32_t ufoCreateVoc (const char *wname, uint32_t parentvocid) {
3975   // create wordlist struct
3976   const uint32_t vocid = UFO_GET_DP();
3977   //fprintf(stderr, "NEW VOCID (%s): 0x%08x\n", wname, vocid);
3978   ufoImgEmitU32(0); // latest
3979   const uint32_t vlink = UFO_GET_DP();
3980   if ((vocid & UFO_ADDR_TEMP_BIT) == 0) {
3981     ufoImgEmitU32(ufoImgGetU32(ufoAddrVocLink)); // voclink
3982     ufoImgPutU32(ufoAddrVocLink, vlink); // update voclink
3983   } else {
3984     abort();
3985     ufoImgEmitU32(0);
3986   }
3987   ufoImgEmitU32(parentvocid); // parent
3988   const uint32_t hdraddr = UFO_GET_DP();
3989   ufoImgEmitU32(0); // word header
3990   // create empty hash table
3991   for (int f = 0; f < UFO_HASHTABLE_SIZE; f += 1) ufoImgEmitU32(0);
3992   // update CONTEXT and CURRENT if this is the first wordlist ever
3993   if (ufoImgGetU32(ufoAddrContext) == 0) {
3994     ufoImgPutU32(ufoAddrContext, vocid);
3995   }
3996   if (ufoImgGetU32(ufoAddrCurrent) == 0) {
3997     ufoImgPutU32(ufoAddrCurrent, vocid);
3998   }
3999   // create word header
4000   if (wname != NULL && wname[0] != 0) {
4001     uint32_t flags = ufoImgGetU32(ufoAddrNewWordFlags);
4002     flags &=
4003       //UFW_FLAG_IMMEDIATE|
4004       //UFW_FLAG_SMUDGE|
4005       //UFW_FLAG_NORETURN|
4006       UFW_FLAG_HIDDEN|
4007       //UFW_FLAG_CBLOCK|
4008       //UFW_FLAG_VOCAB|
4009       //UFW_FLAG_SCOLON|
4010       UFW_FLAG_PROTECTED;
4011     flags |= UFW_FLAG_VOCAB;
4012     ufoCreateWordHeader(wname, flags);
4013     const uint32_t cfa = UFO_GET_DP();
4014     ufoImgEmitU32(ufoDoVocCFA); // cfa
4015     ufoImgEmitU32(vocid); // pfa
4016     // update sfa
4017     const uint32_t lfa = UFO_CFA_TO_LFA(cfa);
4018     const uint32_t sfa = UFO_LFA_TO_SFA(lfa);
4019     ufoImgPutU32(sfa, UFO_GET_DP());
4020     // update vocab header pointer
4021     ufoImgPutU32(hdraddr, UFO_LFA_TO_NFA(lfa));
4022     #ifdef UFO_DEBUG_DUMP_NEW_HEADERS
4023     ufoDumpWordHeader(lfa);
4024     #endif
4025   }
4026   return vocid;
4027 }
4028
4029
4030 //==========================================================================
4031 //
4032 //  ufoFixLatestSFA
4033 //
4034 //==========================================================================
4035 static void ufoFixLatestSFA (void) {
4036   const uint32_t curr = ufoImgGetU32(ufoAddrCurrent);
4037   const uint32_t lfa = ufoImgGetU32(curr);
4038   const uint32_t sfa = UFO_LFA_TO_SFA(lfa);
4039   ufoImgPutU32(sfa, UFO_GET_DP()); // update sfa
4040   #ifdef UFO_DEBUG_DUMP_NEW_HEADERS
4041   ufoDumpWordHeader(lfa);
4042   #endif
4043 }
4044
4045
4046 //==========================================================================
4047 //
4048 //  ufoSetLatestArgs
4049 //
4050 //==========================================================================
4051 static void ufoSetLatestArgs (uint32_t warg) {
4052   const uint32_t curr = ufoImgGetU32(ufoAddrCurrent);
4053   const uint32_t lfa = ufoImgGetU32(curr);
4054   const uint32_t nfa = UFO_LFA_TO_NFA(lfa);
4055   uint32_t flags = ufoImgGetU32(nfa);
4056   //fprintf(stderr, "OLD FLAGS: 0x%08x\n", flags);
4057   flags &= ~UFW_WARG_MASK;
4058   flags |= warg & UFW_WARG_MASK;
4059   //fprintf(stderr, "NEW FLAGS: 0x%08x\n", flags);
4060   ufoImgPutU32(nfa, flags);
4061   #ifdef UFO_DEBUG_DUMP_NEW_HEADERS
4062   ufoDumpWordHeader(lfa);
4063   #endif
4064 }
4065
4066
4067 //==========================================================================
4068 //
4069 //  ufoDefine
4070 //
4071 //==========================================================================
4072 static void ufoDefineNative (const char *wname, uint32_t cfaidx, int immed) {
4073   cfaidx |= UFO_ADDR_CFA_BIT;
4074   uint32_t flags = ufoImgGetU32(ufoAddrNewWordFlags);
4075   flags &=
4076       //UFW_FLAG_IMMEDIATE|
4077       //UFW_FLAG_SMUDGE|
4078       //UFW_FLAG_NORETURN|
4079       UFW_FLAG_HIDDEN|
4080       //UFW_FLAG_CBLOCK|
4081       //UFW_FLAG_VOCAB|
4082       //UFW_FLAG_SCOLON|
4083       UFW_FLAG_PROTECTED;
4084   if (immed) flags |= UFW_FLAG_IMMEDIATE;
4085   ufoCreateWordHeader(wname, flags);
4086   ufoImgEmitU32(cfaidx);
4087   ufoFixLatestSFA();
4088 }
4089
4090
4091 //==========================================================================
4092 //
4093 //  ufoDefineConstant
4094 //
4095 //==========================================================================
4096 static void ufoDefineConstant (const char *name, uint32_t value) {
4097   ufoDefineNative(name, ufoDoConstCFA, 0);
4098   ufoImgEmitU32(value);
4099   ufoFixLatestSFA();
4100 }
4101
4102
4103 //==========================================================================
4104 //
4105 //  ufoDefineVar
4106 //
4107 //==========================================================================
4108 /*
4109 static void ufoDefineVar (const char *name, uint32_t value) {
4110   ufoDefineNative(name, ufoDoVarCFA, 0);
4111   ufoImgEmitU32(value);
4112   ufoFixLatestSFA();
4113 }
4114 */
4115
4116
4117 //==========================================================================
4118 //
4119 //  ufoDefineDefer
4120 //
4121 //==========================================================================
4122 /*
4123 static void ufoDefineDefer (const char *name, uint32_t value) {
4124   ufoDefineNative(name, ufoDoDeferCFA, 0);
4125   ufoImgEmitU32(value);
4126   ufoFixLatestSFA();
4127 }
4128 */
4129
4130
4131 //==========================================================================
4132 //
4133 //  ufoDefineForth
4134 //
4135 //==========================================================================
4136 static void ufoDefineForth (const char *name) {
4137   ufoDefineNative(name, ufoDoForthCFA, 0);
4138 }
4139
4140
4141 //==========================================================================
4142 //
4143 //  ufoDefineForthImm
4144 //
4145 //==========================================================================
4146 static void ufoDefineForthImm (const char *name) {
4147   ufoDefineNative(name, ufoDoForthCFA, 1);
4148 }
4149
4150
4151 //==========================================================================
4152 //
4153 //  ufoDefineSColonForth
4154 //
4155 //  create word suitable for scattered colon extension
4156 //
4157 //==========================================================================
4158 static void ufoDefineSColonForth (const char *name) {
4159   ufoDefineNative(name, ufoDoForthCFA, 0);
4160   // placeholder for scattered colon
4161   // it will compile two branches:
4162   // the first branch will jump to the first "..:" word (or over the two branches)
4163   // the second branch is never taken, and works as a pointer to the latest branch addr in the list
4164   // this way, each extension word will simply fix the last branch address, and update list tail
4165   // at the creation time, second branch points to the first branch
4166   UFC("FORTH:(BRANCH)");
4167   const uint32_t xjmp = UFO_GET_DP();
4168   ufoImgEmitU32(0);
4169   UFC("FORTH:(BRANCH)"); ufoImgEmitU32(xjmp);
4170   ufoImgPutU32(xjmp, UFO_GET_DP());
4171 }
4172
4173
4174 //==========================================================================
4175 //
4176 //  ufoDoneForth
4177 //
4178 //==========================================================================
4179 UFO_FORCE_INLINE void ufoDoneForth (void) {
4180   ufoFixLatestSFA();
4181 }
4182
4183
4184 //==========================================================================
4185 //
4186 //  ufoReset
4187 //
4188 //==========================================================================
4189 static __attribute__((noinline)) void ufoReset (void) {
4190   ufoSP = 0; ufoRP = 0;
4191   ufoLP = 0; ufoLBP = 0;
4192
4193   ufoInBacktrace = 0;
4194
4195   ufoImgPutU32(ufoAddrSTATE, 0);
4196   ufoImgPutU32(ufoAddrBASE, 10);
4197   ufoImgPutU32(ufoAddrTIB, 0);
4198   ufoImgPutU32(ufoAddrIN, 0);
4199   ufoImgPutU32(0, 0);
4200
4201   ufoImgPutU32(ufoAddrDPTemp, 0);
4202
4203   ufoImgPutU32(ufoAddrNewWordFlags, 0);
4204   ufoVocSetOnlyDefs(ufoForthVocId);
4205 }
4206
4207
4208 //==========================================================================
4209 //
4210 //  ufoCompileStrLit
4211 //
4212 //  compile string literal, the same as QUOTE_IMM
4213 //
4214 //==========================================================================
4215 static void ufoCompileStrLit (const char *str) {
4216   if (str == NULL) str = "";
4217   const size_t slen = strlen(str);
4218   if (slen > 255) ufoFatal("string literal too long");
4219   UFC("FORTH:(STRLIT8)");
4220   ufoImgEmitU8((uint8_t)slen);
4221   for (size_t f = 0; f < slen; f += 1) {
4222     ufoImgEmitU8(((const unsigned char *)str)[f]);
4223   }
4224   ufoImgEmitU8(0);
4225   ufoImgEmitAlign();
4226 }
4227
4228
4229 //==========================================================================
4230 //
4231 //  ufoCompileLit
4232 //
4233 //==========================================================================
4234 static __attribute__((unused)) void ufoCompileLit (uint32_t value) {
4235   UFC("FORTH:(LIT)");
4236   ufoImgEmitU32(value);
4237 }
4238
4239
4240 //==========================================================================
4241 //
4242 //  ufoMarkFwd
4243 //
4244 //==========================================================================
4245 UFO_FORCE_INLINE uint32_t ufoMarkFwd (void) {
4246   const uint32_t res = UFO_GET_DP();
4247   ufoImgEmitU32(0);
4248   return res;
4249 }
4250
4251
4252 //==========================================================================
4253 //
4254 //  ufoResolveFwd
4255 //
4256 //==========================================================================
4257 UFO_FORCE_INLINE void ufoResolveFwd (uint32_t jaddr) {
4258   ufoImgPutU32(jaddr, UFO_GET_DP());
4259 }
4260
4261
4262 //==========================================================================
4263 //
4264 //  ufoMarkBwd
4265 //
4266 //==========================================================================
4267 UFO_FORCE_INLINE uint32_t ufoMarkBwd (void) {
4268   return UFO_GET_DP();
4269 }
4270
4271
4272 //==========================================================================
4273 //
4274 //  ufoResolveBwd
4275 //
4276 //==========================================================================
4277 UFO_FORCE_INLINE void ufoResolveBwd (uint32_t jaddr) {
4278   ufoImgEmitU32(jaddr);
4279 }
4280
4281
4282 //==========================================================================
4283 //
4284 //  ufoDefineInterpret
4285 //
4286 //  define "INTERPRET" in Forth
4287 //
4288 //==========================================================================
4289 static __attribute__((noinline)) void ufoDefineInterpret (void) {
4290   // skip comments, parse name, refilling lines if necessary
4291   ufoDefineForth("(INTERPRET-PARSE-NAME)");
4292     const uint32_t label_ipn_again = ufoMarkBwd();
4293     UFC("TRUE"); UFC("(PARSE-SKIP-COMMENTS)");
4294     UFC("PARSE-NAME");
4295     UFC("DUP");
4296     UFC("FORTH:(TBRANCH)"); const uint32_t label_ipn_exit_fwd = ufoMarkFwd();
4297     UFC("2DROP");
4298     UFC("REFILL"); UFC("NOT");
4299     ufoCompileStrLit("unexpected end of file");
4300     UFC("?ERROR");
4301     UFC("FORTH:(BRANCH)"); ufoResolveBwd(label_ipn_again);
4302     // patch the jump above
4303     ufoResolveFwd(label_ipn_exit_fwd);
4304     UFC("FORTH:(EXIT)");
4305   ufoDoneForth(); UFCALL(PAR_HIDDEN);
4306   //ufoDecompileWord(ufoFindWordChecked("(INTERPRET-PARSE-NAME)"));
4307
4308   ufoDefineForth("INTERPRET");
4309     const uint32_t label_it_again = ufoMarkBwd();
4310     UFC("FORTH:(INTERPRET-PARSE-NAME)");
4311     // try defered checker
4312     // ( addr count FALSE -- addr count FALSE / TRUE )
4313     UFC("FALSE"); UFC("(INTERPRET-CHECK-WORD)");
4314     UFC("FORTH:(TBRANCH)"); ufoResolveBwd(label_it_again);
4315     UFC("2DUP"); UFC("FIND-WORD");  // ( addr count cfa TRUE / addr count FALSE )
4316     UFC("FORTH:(0BRANCH)"); const uint32_t label_it_try_num = ufoMarkFwd();
4317       UFC("NROT"); UFC("2DROP"); // drop word string
4318       UFC("STATE"); UFC("@");
4319       UFC("FORTH:(0BRANCH)"); const uint32_t label_it_exec_fwd = ufoMarkFwd();
4320         // compiling; check immediate bit
4321         UFC("DUP"); UFC("CFA->NFA"); UFC("@");
4322         UFC("COMPILER:(WFLAG-IMMEDIATE)"); UFC("AND");
4323         UFC("FORTH:(TBRANCH)"); const uint32_t label_it_exec_imm = ufoMarkFwd();
4324           // compile it
4325           UFC("FORTH:COMPILE,");
4326           UFC("FORTH:(BRANCH)"); ufoResolveBwd(label_it_again);
4327         // execute it
4328         ufoResolveFwd(label_it_exec_imm);
4329         ufoResolveFwd(label_it_exec_fwd);
4330           UFC("EXECUTE");
4331           UFC("FORTH:(BRANCH)"); ufoResolveBwd(label_it_again);
4332     // not a word, try a number
4333     ufoResolveFwd(label_it_try_num);
4334     UFC("2DUP"); UFC("TRUE"); UFC("FORTH:(XNUMBER)");
4335     // (XNUMBER) ( addr count allowsign? -- num TRUE / FALSE )
4336     UFC("FORTH:(0BRANCH)"); const uint32_t label_it_num_error = ufoMarkFwd();
4337       // number
4338       UFC("NROT"); UFC("2DROP"); // drop word string
4339       // do we need to compile it?
4340       UFC("STATE"); UFC("@");
4341       UFC("FORTH:(0BRANCH)"); ufoResolveBwd(label_it_again);
4342       // compile "(LITERAL)" (do it properly, with "LITCFA")
4343       UFC("FORTH:(LITCFA)"); UFC("FORTH:(LIT)");
4344       UFC("FORTH:COMPILE,"); // compile "(LIT)" CFA
4345       UFC("FORTH:,"); // compile number
4346       UFC("FORTH:(BRANCH)"); ufoResolveBwd(label_it_again);
4347     // error
4348     ufoResolveFwd(label_it_num_error);
4349       // ( addr count FALSE -- addr count FALSE / TRUE )
4350       UFC("FALSE"); UFC("(INTERPRET-WORD-NOT-FOUND)");
4351       UFC("FORTH:(TBRANCH)"); ufoResolveBwd(label_it_again);
4352       UFC("ENDCR"); UFC("SPACE"); UFC("XTYPE");
4353       ufoCompileStrLit(" -- wut?\n"); UFC("TYPE");
4354       ufoCompileStrLit("unknown word");
4355       UFC("ERROR");
4356   ufoDoneForth();
4357   //ufoDecompileWord(ufoFindWordChecked("INTERPRET"));
4358 }
4359
4360
4361 //==========================================================================
4362 //
4363 //  ufoInitBaseDict
4364 //
4365 //==========================================================================
4366 static __attribute__((noinline)) void ufoInitBaseDict (void) {
4367   uint32_t imgAddr = 0;
4368
4369   // reserve TIB
4370   for (uint32_t f = 0; f < ufoTIBAreaSize; f += 1) {
4371     ufoImgPutU8(imgAddr, 0);
4372     imgAddr += 1;
4373   }
4374   // align
4375   while ((imgAddr & 3) != 0) {
4376     ufoImgPutU8(imgAddr, 0);
4377     imgAddr += 1;
4378   }
4379
4380   // reserve numeric buffer
4381   for (uint32_t f = 0; f < ufoNUMAreaSize; f += 1) {
4382     ufoImgPutU8(imgAddr, 0);
4383     imgAddr += 1;
4384   }
4385   // align
4386   while ((imgAddr & 3) != 0) {
4387     ufoImgPutU8(imgAddr, 0);
4388     imgAddr += 1;
4389   }
4390
4391   // BASE
4392   ufoAddrBASE = imgAddr;
4393   ufoImgPutU32(imgAddr, 10); imgAddr += 4u;
4394
4395   // STATE
4396   ufoAddrSTATE = imgAddr;
4397   ufoImgPutU32(imgAddr, 0); imgAddr += 4u;
4398
4399   // DP
4400   ufoAddrDP = imgAddr;
4401   ufoImgPutU32(imgAddr, 0); imgAddr += 4u;
4402
4403   // DP-TEMP
4404   ufoAddrDPTemp = imgAddr;
4405   ufoImgPutU32(imgAddr, 0); imgAddr += 4u;
4406
4407   // TIB
4408   ufoAddrTIB = imgAddr;
4409   ufoImgPutU32(imgAddr, 0); imgAddr += 4u;
4410
4411   // >IN
4412   ufoAddrIN = imgAddr;
4413   ufoImgPutU32(imgAddr, 0); imgAddr += 4u;
4414
4415   // CONTEXT
4416   ufoAddrContext = imgAddr;
4417   ufoImgPutU32(imgAddr, 0); imgAddr += 4u;
4418
4419   // CURRENT
4420   ufoAddrCurrent = imgAddr;
4421   ufoImgPutU32(imgAddr, 0); imgAddr += 4u;
4422
4423   // (VOC-LINK)
4424   ufoAddrVocLink = imgAddr;
4425   ufoImgPutU32(imgAddr, 0); imgAddr += 4u;
4426
4427   // (NEW-WORD-FLAGS)
4428   ufoAddrNewWordFlags = imgAddr;
4429   ufoImgPutU32(imgAddr, UFW_FLAG_PROTECTED); imgAddr += 4u;
4430
4431   ufoImgPutU32(ufoAddrDP, imgAddr);
4432   ufoImgPutU32(ufoAddrDPTemp, 0);
4433
4434   #if 0
4435   fprintf(stderr, "INITIAL HERE: 0x%08x (0x%08x)\n", imgAddr, UFO_GET_DP());
4436   #endif
4437 }
4438
4439
4440 //==========================================================================
4441 //
4442 //  ufoInitBasicWords
4443 //
4444 //==========================================================================
4445 static __attribute__((noinline)) void ufoInitBasicWords (void) {
4446   ufoDefineConstant("FALSE", 0);
4447   ufoDefineConstant("TRUE", ufoTrueValue);
4448
4449   ufoDefineConstant("BL", 32);
4450   ufoDefineConstant("NL", 10);
4451
4452   // basic vars
4453   ufoDefineConstant("BASE", ufoAddrBASE);
4454   ufoDefineConstant("STATE", ufoAddrSTATE);
4455   ufoDefineConstant("TIB", ufoAddrTIB);
4456   ufoDefineConstant(">IN", ufoAddrIN);
4457   ufoDefineConstant("STD-TIB-ADDR", 0);
4458   ufoDefineConstant("STD-TIB-SIZE", ufoTIBAreaSize);
4459   ufoDefineConstant("(#BUF-START)", ufoTIBAreaSize + 4u); UFCALL(PAR_HIDDEN);
4460   ufoDefineConstant("(#BUF-END)", ufoTIBAreaSize + ufoNUMAreaSize); UFCALL(PAR_HIDDEN);
4461   ufoDefineConstant("(#BUF-SIZE)", ufoNUMAreaSize - 4u); UFCALL(PAR_HIDDEN);
4462   ufoDefineConstant("(#BUF-OFS)", ufoTIBAreaSize); UFCALL(PAR_HIDDEN);
4463   ufoDefineConstant("CONTEXT", ufoAddrContext);
4464   ufoDefineConstant("CURRENT", ufoAddrCurrent);
4465   ufoDefineConstant("(VOC-LINK)", ufoAddrVocLink); UFCALL(PAR_HIDDEN);
4466   ufoDefineConstant("(NEW-WORD-FLAGS)", ufoAddrNewWordFlags); UFCALL(PAR_HIDDEN);
4467   ufoDefineConstant("(ADDR-TEMP-BIT)", UFO_ADDR_TEMP_BIT); UFCALL(PAR_HIDDEN);
4468   ufoDefineConstant("(ADDR-CFA-BIT)", UFO_ADDR_CFA_BIT); UFCALL(PAR_HIDDEN);
4469   ufoDefineConstant("(ADDR-HANDLE-BIT)", UFO_ADDR_HANDLE_BIT); UFCALL(PAR_HIDDEN);
4470
4471   ufoDefineConstant("(DP)", ufoAddrDP); UFCALL(PAR_HIDDEN);
4472   ufoDefineConstant("(DP-TEMP)", ufoAddrDPTemp); UFCALL(PAR_HIDDEN);
4473
4474   //UFWORDX("(UFO-BUCKET-STATS)", PAR_UFO_BUCKET_STATS);
4475   UFWORDX("SP0!", SP0_STORE);
4476   UFWORDX("RP0!", RP0_STORE);
4477
4478   UFWORDX("PAD", PAD);
4479
4480   UFWORDX("@", PEEK);
4481   UFWORDX("C@", CPEEK);
4482   UFWORDX("W@", WPEEK);
4483
4484   UFWORDX("!", POKE);
4485   UFWORDX("C!", CPOKE);
4486   UFWORDX("W!", WPOKE);
4487
4488   UFWORDX(",", COMMA);
4489   UFWORDX("C,", CCOMMA);
4490   UFWORDX("W,", WCOMMA);
4491
4492   UFWORDX("(LIT)", PAR_LIT); ufoSetLatestArgs(UFW_WARG_LIT); UFCALL(PAR_HIDDEN);
4493   UFWORDX("(LITCFA)", PAR_LITCFA); ufoSetLatestArgs(UFW_WARG_CFA); UFCALL(PAR_HIDDEN);
4494   UFWORDX("(LITVOCID)", PAR_LITVOCID); ufoSetLatestArgs(UFW_WARG_VOCID); UFCALL(PAR_HIDDEN);
4495   UFWORDX("(STRLIT8)", PAR_STRLIT8); ufoSetLatestArgs(UFW_WARG_C1STRZ); UFCALL(PAR_HIDDEN);
4496   UFWORDX("(EXIT)", PAR_EXIT); UFCALL(PAR_HIDDEN);
4497
4498   ufoStrLit8CFA = ufoFindWordChecked("FORTH:(STRLIT8)");
4499
4500   UFWORDX("(L-ENTER)", PAR_LENTER); ufoSetLatestArgs(UFW_WARG_LIT); UFCALL(PAR_HIDDEN);
4501   UFWORDX("(L-LEAVE)", PAR_LLEAVE); UFCALL(PAR_HIDDEN);
4502   UFWORDX("(LOCAL@)", PAR_LOCAL_LOAD); UFCALL(PAR_HIDDEN);
4503   UFWORDX("(LOCAL!)", PAR_LOCAL_STORE); UFCALL(PAR_HIDDEN);
4504
4505   UFWORDX("(BRANCH)", PAR_BRANCH); ufoSetLatestArgs(UFW_WARG_BRANCH); UFCALL(PAR_HIDDEN);
4506   UFWORDX("(TBRANCH)", PAR_TBRANCH); ufoSetLatestArgs(UFW_WARG_BRANCH); UFCALL(PAR_HIDDEN);
4507   UFWORDX("(0BRANCH)", PAR_0BRANCH); ufoSetLatestArgs(UFW_WARG_BRANCH); UFCALL(PAR_HIDDEN);
4508
4509   UFWORDX("(HIDDEN)", PAR_HIDDEN);
4510
4511   UFWORDX("GET-MSECS", GET_MSECS);
4512 }
4513
4514
4515 //==========================================================================
4516 //
4517 //  ufoInitBasicCompilerWords
4518 //
4519 //==========================================================================
4520 static __attribute__((noinline)) void ufoInitBasicCompilerWords (void) {
4521   ufoVocSetOnlyDefs(ufoCompilerVocId);
4522
4523   ufoDefineConstant("(CFAIDX-DO-FORTH)", ufoDoForthCFA);
4524   ufoDefineConstant("(CFAIDX-DO-VAR)", ufoDoVarCFA);
4525   ufoDefineConstant("(CFAIDX-DO-VALUE)", ufoDoValueCFA);
4526   ufoDefineConstant("(CFAIDX-DO-CONST)", ufoDoConstCFA);
4527   ufoDefineConstant("(CFAIDX-DO-DEFER)", ufoDoDeferCFA);
4528   ufoDefineConstant("(CFAIDX-DO-VOC)", ufoDoVocCFA);
4529
4530   ufoDefineConstant("(WFLAG-IMMEDIATE)", UFW_FLAG_IMMEDIATE);
4531   ufoDefineConstant("(WFLAG-SMUDGE)", UFW_FLAG_SMUDGE);
4532   ufoDefineConstant("(WFLAG-NORETURN)", UFW_FLAG_NORETURN);
4533   ufoDefineConstant("(WFLAG-HIDDEN)", UFW_FLAG_HIDDEN);
4534   ufoDefineConstant("(WFLAG-CBLOCK)", UFW_FLAG_CBLOCK);
4535   ufoDefineConstant("(WFLAG-VOCAB)", UFW_FLAG_VOCAB);
4536   ufoDefineConstant("(WFLAG-SCOLON)", UFW_FLAG_SCOLON);
4537   ufoDefineConstant("(WFLAG-PROTECTED)", UFW_FLAG_PROTECTED);
4538
4539   ufoDefineConstant("(WARG-MASK)", UFW_WARG_MASK);
4540   ufoDefineConstant("(WARG-NONE)", UFW_WARG_NONE);
4541   ufoDefineConstant("(WARG-BRANCH)", UFW_WARG_BRANCH);
4542   ufoDefineConstant("(WARG-LIT)", UFW_WARG_LIT);
4543   ufoDefineConstant("(WARG-C4STRZ)", UFW_WARG_C4STRZ);
4544   ufoDefineConstant("(WARG-CFA)", UFW_WARG_CFA);
4545   ufoDefineConstant("(WARG-CBLOCK)", UFW_WARG_CBLOCK);
4546   ufoDefineConstant("(WARG-VOCID)", UFW_WARG_VOCID);
4547   ufoDefineConstant("(WARG-C1STRZ)", UFW_WARG_C1STRZ);
4548
4549   ufoDefineConstant("(VOCOFS-LATEST)", UFW_VOCAB_OFS_LATEST);
4550   ufoDefineConstant("(VOCOFS-VOCLINK)", UFW_VOCAB_OFS_VOCLINK);
4551   ufoDefineConstant("(VOCOFS-PARENT)", UFW_VOCAB_OFS_PARENT);
4552   ufoDefineConstant("(VOCOFS-HEADER)", UFW_VOCAB_OFS_HEADER);
4553   ufoDefineConstant("(VOCOFS-HTABLE)", UFW_VOCAB_OFS_HTABLE);
4554   ufoDefineConstant("(VOC-HTABLE-SIZE)", UFO_HASHTABLE_SIZE);
4555   ufoDefineConstant("(VOC-HTABLE-NOFLAG)", UFO_NO_HTABLE_FLAG);
4556
4557   UFWORDX("(UNESCAPE)", PAR_UNESCAPE);
4558
4559   UFWORDX("?EXEC", QEXEC);
4560   UFWORDX("?COMP", QCOMP);
4561
4562   // interpreter
4563   /*
4564   UFWORDX("(INTERPRET-DUMB)", PAR_INTERPRET_DUMB); UFCALL(PAR_HIDDEN);
4565   const uint32_t idumbCFA = UFO_LFA_TO_CFA(ufoImgGetU32(ufoImgGetU32(ufoAddrCurrent)));
4566   ufo_assert(idumbCFA == UFO_PFA_TO_CFA(UFO_GET_DP()));
4567   */
4568
4569   UFWORDX("(CREATE-WORD-HEADER)", PAR_CREATE_WORD_HEADER);
4570   UFWORDX("(CREATE-NAMELESS-WORD-HEADER)", PAR_CREATE_NAMELESS_WORD_HEADER);
4571
4572
4573   // more FORTH words
4574   ufoVocSetOnlyDefs(ufoForthVocId);
4575 }
4576
4577
4578 //==========================================================================
4579 //
4580 //  ufoInitMoreWords
4581 //
4582 //==========================================================================
4583 static __attribute__((noinline)) void ufoInitMoreWords (void) {
4584   UFWORDX("COMPILE,", COMMA); // just an alias, for clarity
4585
4586   UFWORDX("CFA->PFA", CFA2PFA);
4587   UFWORDX("PFA->CFA", PFA2CFA);
4588   UFWORDX("CFA->NFA", CFA2NFA);
4589   UFWORDX("NFA->CFA", NFA2CFA);
4590   UFWORDX("CFA->LFA", CFA2LFA);
4591   UFWORDX("LFA->CFA", LFA2CFA);
4592   UFWORDX("LFA->PFA", LFA2PFA);
4593   UFWORDX("LFA->BFA", LFA2BFA);
4594   UFWORDX("LFA->SFA", LFA2SFA);
4595   UFWORDX("LFA->NFA", LFA2NFA);
4596   UFWORDX("NFA->LFA", NFA2LFA);
4597
4598   UFWORDX("ERROR", ERROR);
4599   UFWORDX("?ERROR", QERROR);
4600
4601   UFWORDX("(XNUMBER)", PAR_XNUMBER);
4602   UFWORDX("FIND-WORD", FIND_WORD);
4603   UFWORDX("FIND-WORD-IN-VOC", FIND_WORD_IN_VOC);
4604
4605   UFWORDX_IMM("\"", QUOTE_IMM);
4606
4607   UFWORD(EXECUTE);
4608   UFWORDX("EXECUTE-TAIL", EXECUTE_TAIL);
4609
4610   UFWORD(DUP);
4611   UFWORDX("?DUP", QDUP);
4612   UFWORDX("2DUP", DDUP);
4613   UFWORD(DROP);
4614   UFWORDX("2DROP", DDROP);
4615   UFWORD(SWAP);
4616   UFWORDX("2SWAP", DSWAP);
4617   UFWORD(OVER);
4618   UFWORDX("2OVER", DOVER);
4619   UFWORD(ROT);
4620   UFWORD(NROT);
4621   UFWORDX("PICK", PICK);
4622   UFWORDX("ROLL", ROLL);
4623
4624   UFWORD(RDUP);
4625   UFWORD(RDROP);
4626   UFWORDX(">R", DTOR);
4627   UFWORDX("R>", RTOD);
4628   UFWORDX("R@", RPEEK);
4629   UFWORDX("RPICK", RPICK);
4630   UFWORDX("RROLL", RROLL);
4631
4632   UFWORD(EMIT);
4633   UFWORD(XEMIT);
4634   UFWORD(TYPE);
4635   UFWORD(XTYPE);
4636   UFWORD(SPACE);
4637   UFWORD(SPACES);
4638   UFWORD(CR);
4639   UFWORD(ENDCR);
4640   UFWORDX("LASTCR?", LASTCRQ);
4641   UFWORDX("LASTCR!", LASTCRSET);
4642
4643   // simple math
4644   UFWORDX("+", PLUS);
4645   UFWORDX("-", MINUS);
4646   UFWORDX("*", MUL);
4647   UFWORDX("U*", UMUL);
4648   UFWORDX("/", DIV);
4649   UFWORDX("U/", UDIV);
4650   UFWORDX("MOD", MOD);
4651   UFWORDX("UMOD", UMOD);
4652   UFWORDX("/MOD", DIVMOD);
4653   UFWORDX("U/MOD", UDIVMOD);
4654
4655   UFWORDX("2U*", ONESHL);
4656   UFWORDX("2U/", ONESHR);
4657   UFWORDX("4U*", TWOSHL);
4658   UFWORDX("4U/", TWOSHR);
4659
4660   UFWORD(ASH);
4661   UFWORD(LSH);
4662
4663   // logic
4664   UFWORDX("<", LESS);
4665   UFWORDX(">", GREAT);
4666   UFWORDX("<=", LESSEQU);
4667   UFWORDX(">=", GREATEQU);
4668   UFWORDX("U<", ULESS);
4669   UFWORDX("U>", UGREAT);
4670   UFWORDX("U<=", ULESSEQU);
4671   UFWORDX("U>=", UGREATEQU);
4672   UFWORDX("=", EQU);
4673   UFWORDX("<>", NOTEQU);
4674
4675   UFWORD(NOT);
4676   UFWORD(BITNOT);
4677   UFWORD(AND);
4678   UFWORD(OR);
4679   UFWORD(XOR);
4680   UFWORDX("LOGAND", LOGAND);
4681   UFWORDX("LOGOR", LOGOR);
4682
4683   // TIB parser
4684   UFWORDX("(PARSE)", PAR_PARSE); UFCALL(PAR_HIDDEN);
4685   UFWORDX("(PARSE-SKIP-COMMENTS)", PAR_PARSE_SKIP_COMMENTS);
4686   UFWORDX("PARSE-SKIP-BLANKS", PARSE_SKIP_BLANKS);
4687   UFWORDX("PARSE-NAME", PARSE_NAME);
4688   UFWORDX("PARSE-SKIP-LINE", PARSE_SKIP_LINE);
4689   UFWORDX("PARSE", PARSE);
4690   UFWORDX("REFILL", REFILL);
4691   UFWORDX("REFILL-NOCROSS", REFILL_NOCROSS);
4692
4693   UFWORDX_IMM("[", LBRACKET_IMM);
4694   UFWORDX("]", RBRACKET);
4695
4696   UFWORDX("(VSP@)", PAR_GET_VSP); UFCALL(PAR_HIDDEN);
4697   UFWORDX("(VSP!)", PAR_SET_VSP); UFCALL(PAR_HIDDEN);
4698   UFWORDX("(VSP-AT@)", PAR_VSP_LOAD); UFCALL(PAR_HIDDEN);
4699   UFWORDX("(VSP-AT!)", PAR_VSP_STORE); UFCALL(PAR_HIDDEN);
4700   ufoDefineConstant("(VSP-SIZE)", UFO_VOCSTACK_SIZE); UFCALL(PAR_HIDDEN);
4701
4702   ufoDefineConstant("(SP-SIZE)", UFO_DSTACK_SIZE); UFCALL(PAR_HIDDEN);
4703   ufoDefineConstant("(RP-SIZE)", UFO_RSTACK_SIZE); UFCALL(PAR_HIDDEN);
4704   ufoDefineConstant("(LP-SIZE)", UFO_LSTACK_SIZE); UFCALL(PAR_HIDDEN);
4705 }
4706
4707
4708 //==========================================================================
4709 //
4710 //  ufoInitHandleWords
4711 //
4712 //==========================================================================
4713 static __attribute__((noinline)) void ufoInitHandleWords (uint32_t handleVocId) {
4714   ufoVocSetOnlyDefs(handleVocId);
4715   UFWORDX("NEW", PAR_NEW_HANDLE);
4716   UFWORDX("FREE", PAR_FREE_HANDLE);
4717   UFWORDX("GET-SIZE", PAR_HANDLE_GET_SIZE);
4718   UFWORDX("SET-SIZE", PAR_HANDLE_SET_SIZE);
4719   UFWORDX("GET-USED", PAR_HANDLE_GET_USED);
4720   UFWORDX("SET-USED", PAR_HANDLE_SET_USED);
4721   UFWORDX("@", PAR_HANDLE_LOAD);
4722   UFWORDX("!", PAR_HANDLE_STORE);
4723   ufoVocSetOnlyDefs(ufoForthVocId);
4724 }
4725
4726
4727 //==========================================================================
4728 //
4729 //  ufoInitHigherWords
4730 //
4731 //==========================================================================
4732 static __attribute__((noinline)) void ufoInitHigherWords (void) {
4733   UFWORDX("(INCLUDE)", PAR_INCLUDE); UFCALL(PAR_HIDDEN);
4734
4735   UFWORDX("($DEFINED?)", PAR_DLR_DEFINEDQ); UFCALL(PAR_HIDDEN);
4736   UFWORDX("($DEFINE)", PAR_DLR_DEFINE); UFCALL(PAR_HIDDEN);
4737   UFWORDX("($UNDEF)", PAR_DLR_UNDEF); UFCALL(PAR_HIDDEN);
4738   UFWORDX("(TYPE-CURR-FILE)", PAR_TYPE_CURR_FILE); UFCALL(PAR_HIDDEN);
4739
4740   UFWORDX_IMM("$INCLUDE", DLR_INCLUDE_IMM);
4741   UFWORDX_IMM("$INCLUDE-ONCE", DLR_INCLUDE_ONCE_IMM);
4742 }
4743
4744
4745 //==========================================================================
4746 //
4747 //  ufoInitStringWords
4748 //
4749 //==========================================================================
4750 static __attribute__((noinline)) void ufoInitStringWords (uint32_t stringVocId) {
4751   ufoVocSetOnlyDefs(stringVocId);
4752   UFWORDX("=", STREQU);
4753   UFWORDX("=CI", STREQUCI);
4754   UFWORDX("HASH", STRHASH);
4755   UFWORDX("HASH-CI", STRHASHCI);
4756   ufoVocSetOnlyDefs(ufoForthVocId);
4757 }
4758
4759
4760 //==========================================================================
4761 //
4762 //  ufoInitVeryHighWords
4763 //
4764 //==========================================================================
4765 static __attribute__((noinline)) void ufoInitVeryHighWords (void) {
4766   UFWORDX("$LABEL-CODE:", DLR_LABEL_CODE_IMM);
4767   UFWORDX("$LABEL-DATA:", DLR_LABEL_DATA_IMM);
4768
4769   UFWORDX_IMM("$END_FORTH", DLR_END_FORTH_IMM);
4770   UFWORDX_IMM("$END-FORTH", DLR_END_FORTH_IMM);
4771 }
4772
4773
4774 //==========================================================================
4775 //
4776 //  ufoInitDebugWords
4777 //
4778 //==========================================================================
4779 static __attribute__((noinline)) void ufoInitDebugWords (uint32_t debugVocId) {
4780   ufoVocSetOnlyDefs(debugVocId);
4781   UFWORDX("BP", UFO_BP);
4782   UFWORDX("(DECOMPILE-CFA)", DEBUG_DECOMPILE_CFA);
4783   UFWORDX("BACKTRACE", UFO_BACKTRACE);
4784   UFWORDX("DUMP-STACK", DUMP_STACK);
4785   ufoVocSetOnlyDefs(ufoForthVocId);
4786 }
4787
4788
4789 //==========================================================================
4790 //
4791 //  ufoInitUrAsmWords
4792 //
4793 //==========================================================================
4794 static __attribute__((noinline)) void ufoInitUrAsmWords (uint32_t urasmVocId) {
4795   ufoVocSetOnlyDefs(urasmVocId);
4796   // UrAsm label types
4797   // WARNING! keep in sync with C source!
4798   ufoDefineConstant("LBL-TYPE-UNKNOWN", UFO_ZX_LABEL_UNKNOWN);
4799   ufoDefineConstant("LBL-TYPE-VAR", UFO_ZX_LABEL_VAR);
4800   ufoDefineConstant("LBL-TYPE-EQU", UFO_ZX_LABEL_EQU);
4801   ufoDefineConstant("LBL-TYPE-CODE", UFO_ZX_LABEL_CODE);
4802   ufoDefineConstant("LBL-TYPE-STOFS", UFO_ZX_LABEL_STOFS);
4803   ufoDefineConstant("LBL-TYPE-DATA", UFO_ZX_LABEL_DATA);
4804
4805   UFWORDX("C,", ZX_CCOMMA);
4806   UFWORDX("W,", ZX_WCOMMA);
4807   UFWORDX("C@", ZX_CPEEK);
4808   UFWORDX("C!", ZX_CPOKE);
4809   UFWORDX("W@", ZX_WPEEK);
4810   UFWORDX("W!", ZX_WPOKE);
4811
4812   UFWORDX("RESERVED?", ZX_RESERVEDQ);
4813   UFWORDX("RESERVED!", ZX_RESERVEDS);
4814
4815   UFWORDX("HAS-LABEL?", UR_HAS_LABELQ);
4816   UFWORDX("LABEL-TYPE?", UR_GET_LABELQ_TYPE);
4817   UFWORDX("GET-LABEL", UR_GET_LABEL);
4818   UFWORDX("SET-LABEL-VAR", UR_SET_LABEL_VAR);
4819   UFWORDX("SET-LABEL-EQU", UR_SET_LABEL_EQU);
4820   UFWORDX("SET-LABEL-CODE", UR_SET_LABEL_CODE);
4821   UFWORDX("SET-LABEL-STOFS", UR_SET_LABEL_STOFS);
4822   UFWORDX("SET-LABEL-DATA", UR_SET_LABEL_DATA);
4823   UFWORDX("NEW-LABEL-ITER", UR_NEW_LABEL_ITER);
4824   UFWORDX("CLOSE-LABEL-ITER", UR_CLOSE_LABEL_ITER);
4825   UFWORDX("LABEL-ITER-NEXT", UR_LABEL_ITER_NEXT);
4826   UFWORDX("LABEL-ITER-GET-NAME", UR_LABEL_ITER_GET_NAME);
4827   UFWORDX("LABEL-ITER-GET-VALUE", UR_LABEL_ITER_GET_VALUE);
4828   UFWORDX("LABEL-ITER-GET-TYPE", UR_LABEL_ITER_GET_TYPE);
4829
4830   UFWORDX("PASS@", UR_PASSQ);
4831
4832   //UFWORDX("LOAD-DATA-FILE", ZX_LOAD_DATA_FILE);
4833
4834   UFWORDX("ORG@", UR_GETORG);
4835   UFWORDX("DISP@", UR_GETDISP);
4836   UFWORDX("ENT@", UR_GETENT);
4837   UFWORDX("ORG!", UR_SETORG);
4838   UFWORDX("DISP!", UR_SETDISP);
4839   UFWORDX("ENT!", UR_SETENT);
4840   ufoVocSetOnlyDefs(ufoForthVocId);
4841 }
4842
4843
4844 //==========================================================================
4845 //
4846 //  ufoInitVeryVeryHighWords
4847 //
4848 //==========================================================================
4849 static __attribute__((noinline)) void ufoInitVeryVeryHighWords (void) {
4850   // interpret defer
4851   //ufoDefineDefer("INTERPRET", idumbCFA);
4852
4853   // ( addr count FALSE -- addr count FALSE / TRUE )
4854   ufoDefineSColonForth("(INTERPRET-CHECK-WORD)");
4855     UFC("FORTH:(EXIT)");
4856   ufoDoneForth();
4857   // ( addr count FALSE -- addr count FALSE / TRUE )
4858   ufoDefineSColonForth("(INTERPRET-WORD-NOT-FOUND)");
4859     UFC("FORTH:(EXIT)");
4860   ufoDoneForth();
4861   // ( FALSE -- FALSE / TRUE ) -- called in "EXIT", before compiling "FORTH:(EXIT)"
4862   // return TRUE to stop calling other chained words, and omit default exit
4863   ufoDefineSColonForth("(EXIT-EXTENDER)");
4864     UFC("FORTH:(EXIT)");
4865   ufoDoneForth();
4866
4867   // create "FORTH:EXIT"
4868   // : EXIT  ?COMP COMPILE FORTH:(EXIT) ;
4869   ufoDefineForthImm("EXIT");
4870     UFC("COMPILER:?COMP");
4871     UFC("FALSE"); UFC("(EXIT-EXTENDER)");
4872     UFC("FORTH:(TBRANCH)"); const uint32_t exit_branch_end = ufoMarkFwd();
4873     UFC("FORTH:(LITCFA)"); UFC("FORTH:(EXIT)");
4874     UFC("FORTH:COMPILE,");
4875     ufoResolveFwd(exit_branch_end);
4876     UFC("FORTH:(EXIT)");
4877   ufoDoneForth();
4878
4879   ufoDefineInterpret();
4880
4881   //ufoDumpVocab(ufoCompilerVocId);
4882
4883   ufoDefineForth("RUN-INTERPRET-LOOP");
4884     const uint32_t addrAgain = UFO_GET_DP();
4885     UFC("RP0!");
4886     UFC("INTERPRET");
4887     UFC("FORTH:(BRANCH)");
4888     ufoImgEmitU32(addrAgain);
4889   ufoDoneForth();
4890 }
4891
4892
4893 //==========================================================================
4894 //
4895 //  ufoInitCommon
4896 //
4897 //==========================================================================
4898 static __attribute__((noinline)) void ufoInitCommon (void) {
4899   ufoVSP = 0;
4900   ufoForthVocId = 0; ufoCompilerVocId = 0; ufoMacroVocId = 0;
4901
4902   ufoDStack = calloc(UFO_DSTACK_SIZE, sizeof(ufoDStack[0]));
4903   ufoRStack = calloc(UFO_RSTACK_SIZE, sizeof(ufoRStack[0]));
4904   ufoLStack = calloc(UFO_LSTACK_SIZE, sizeof(ufoLStack[0]));
4905   ufoForthCFAs = calloc(UFO_MAX_NATIVE_CFAS, sizeof(ufoForthCFAs[0]));
4906
4907   ufoForthCFAs[0] = NULL;
4908   ufoDoForthCFA = 1u | UFO_ADDR_CFA_BIT; ufoForthCFAs[ufoDoForthCFA & UFO_ADDR_CFA_MASK] = &ufoDoForth;
4909   ufoDoVarCFA = 2u | UFO_ADDR_CFA_BIT; ufoForthCFAs[ufoDoVarCFA & UFO_ADDR_CFA_MASK] = &ufoDoVariable;
4910   ufoDoValueCFA = 3u | UFO_ADDR_CFA_BIT; ufoForthCFAs[ufoDoValueCFA & UFO_ADDR_CFA_MASK] = &ufoDoValue;
4911   ufoDoConstCFA = 4u | UFO_ADDR_CFA_BIT; ufoForthCFAs[ufoDoConstCFA & UFO_ADDR_CFA_MASK] = &ufoDoConst;
4912   ufoDoDeferCFA = 5u | UFO_ADDR_CFA_BIT; ufoForthCFAs[ufoDoDeferCFA & UFO_ADDR_CFA_MASK] = &ufoDoDefer;
4913   ufoDoVocCFA = 6u | UFO_ADDR_CFA_BIT; ufoForthCFAs[ufoDoVocCFA & UFO_ADDR_CFA_MASK] = &ufoDoVoc;
4914   ufoCFAsUsed = 7;
4915   ufoMaxDoCFA = ufoCFAsUsed;
4916
4917   //fprintf(stderr, "DO-FORTH-CFA: 0x%08x\n", ufoDoForthCFA);
4918
4919   ufoInitBaseDict();
4920
4921   // create "FORTH" vocabulary
4922   ufoForthVocId = ufoCreateVoc("FORTH", 0);
4923   ufoVocSetOnlyDefs(ufoForthVocId);
4924
4925   // create "COMPILER" vocabulary
4926   ufoCompilerVocId = ufoCreateVoc("COMPILER", 0);
4927
4928   // create "STRING" vocabulary
4929   uint32_t stringVocId = ufoCreateVoc("STRING", 0);
4930
4931   // create "HANDLE" vocabulary
4932   uint32_t handleVocId = ufoCreateVoc("HANDLE", 0);
4933
4934   // create "URASM-MACROS" vocabulary
4935   ufoMacroVocId = ufoCreateVoc("URASM-MACROS", 0);
4936
4937   // create "URASM" vocabulary
4938   uint32_t urasmVocId = ufoCreateVoc("URASM", 0);
4939
4940   // create "DEBUG" vocabulary
4941   uint32_t debugVocId = ufoCreateVoc("DEBUG", 0);
4942
4943   // base low-level interpreter words
4944   ufoInitBasicWords();
4945
4946   // some COMPILER words
4947   ufoInitBasicCompilerWords();
4948
4949   // more FORTH words
4950   ufoInitMoreWords();
4951
4952   // HANDLE vocabulary
4953   ufoInitHandleWords(handleVocId);
4954
4955   // some higher-level FORTH words (includes, etc.)
4956   ufoInitHigherWords();
4957
4958   // STRING vocabulary
4959   ufoInitStringWords(stringVocId);
4960
4961   // very high-level FORTH words
4962   ufoInitVeryHighWords();
4963
4964   // DEBUG vocabulary
4965   ufoInitDebugWords(debugVocId);
4966
4967   // UrAsm API
4968   ufoInitUrAsmWords(urasmVocId);
4969
4970   // very-very high-level FORTH words
4971   ufoInitVeryVeryHighWords();
4972
4973   #if 0
4974   ufoDecompileWord(ufoFindWordChecked("RUN-INTERPRET-LOOP"));
4975   #endif
4976
4977   ufoReset();
4978 }
4979
4980 #undef UFC
4981
4982
4983 //==========================================================================
4984 //
4985 //  ufoRunVM
4986 //
4987 //  address interpreter
4988 //
4989 //==========================================================================
4990 static void ufoRunVMCFA (uint32_t cfa) {
4991   const uint32_t oldRPTop = ufoRPTop;
4992   ufoRPTop = ufoRP;
4993   #ifdef UFO_TRACE_VM_RUN
4994   fprintf(stderr, "**VM-INITIAL**: cfa=%u\n", cfa);
4995   UFCALL(DUMP_STACK);
4996   #endif
4997   ufoPush(cfa);
4998   ufoVMPopCFA = 1;
4999   // VM execution loop
5000   do {
5001     if (ufoVMPopCFA == 0) {
5002       // check IP
5003       if (ufoIP == 0) ufoFatal("IP is NULL");
5004       if (ufoIP & UFO_ADDR_HANDLE_BIT) ufoFatal("IP is a handle");
5005       cfa = ufoImgGetU32(ufoIP); ufoIP += 4u;
5006     } else {
5007       cfa = ufoPop(); ufoVMPopCFA = 0;
5008     }
5009     // check CFA sanity
5010     if (cfa == 0) ufoFatal("EXECUTE: NULL CFA");
5011     if (cfa & UFO_ADDR_HANDLE_BIT) ufoFatal("cannot execute handle");
5012     // get next word CFAIDX, and check it
5013     uint32_t cfaidx = ufoImgGetU32(cfa);
5014     if (cfaidx & UFO_ADDR_HANDLE_BIT) ufoFatal("cannot execute CFAIDX-handle");
5015     #ifdef UFO_TRACE_VM_RUN
5016     fprintf(stderr, "**VM**: IP=%u; cfa=%u; cfaidx=0x%08x\n", ufoIP - 4u, cfa, cfaidx);
5017     UFCALL(DUMP_STACK);
5018     ufoDumpWordHeader(UFO_CFA_TO_LFA(cfa));
5019     fprintf(stderr, "######################################\n");
5020     #endif
5021     if (cfaidx & UFO_ADDR_CFA_BIT) {
5022       cfaidx &= UFO_ADDR_CFA_MASK;
5023       if (cfaidx >= ufoCFAsUsed || ufoForthCFAs[cfaidx] == NULL) {
5024         ufoFatal("UFO tried to execute an unknown word: %u (max is %u); IP=%u",
5025                  cfaidx, ufoCFAsUsed, ufoIP - 4u);
5026       }
5027       #ifdef UFO_TRACE_VM_RUN
5028       fprintf(stderr, "**VM-NATIVE**: cfaidx=%u (doForth=%u)\n", cfaidx,
5029               (ufoDoForthCFA & UFO_ADDR_CFA_MASK));
5030       #endif
5031       ufoForthCFAs[cfaidx](UFO_CFA_TO_PFA(cfa));
5032     } else {
5033       // if CFA points somewhere inside a dict, this is "DOES>" word
5034       // IP points to PFA we need to push
5035       // CFA points to Forth word we need to jump to
5036       #ifdef UFO_TRACE_VM_DOER
5037       fprintf(stderr, "*** DOER! IP=%u; cfa=%u; cfaidx=%u ***\n", ufoIP, cfa, cfaidx);
5038       UFCALL(UFO_BACKTRACE);
5039       #endif
5040       ufoPush(UFO_CFA_TO_PFA(cfa)); // push PFA
5041       ufoRPush(ufoIP); // push IP
5042       ufoIP = cfaidx; // fix IP
5043     }
5044   } while (ufoRP != oldRPTop);
5045 }
5046
5047
5048 //==========================================================================
5049 //
5050 //  ufoRunIt
5051 //
5052 //==========================================================================
5053 static void ufoRunIt (const char *wname) {
5054   uint32_t cfa = ufoFindWord(wname);
5055   if (cfa == 0) ufoFatal("UFO '%s' word not found", wname);
5056   ufoRunVMCFA(cfa);
5057 }
5058
5059
5060 //==========================================================================
5061 //
5062 //  ufoInlineInit
5063 //
5064 //==========================================================================
5065 void ufoInlineInit (void) {
5066   ufoMode = UFO_MODE_NATIVE;
5067   ufoTrueValue = ~0u; // -1 is better!
5068
5069   ufoInFileLine = 0; ufoCondStLine = -1;
5070   ufoInFileName = NULL;
5071   ufoInFile = NULL;
5072   ufoLastIncPath = NULL;
5073
5074   #ifdef UFO_DEBUG_STARTUP_TIMES
5075   uint32_t stt = ufo_get_msecs();
5076   // new define
5077   UForthCondDefine *dd = calloc(1, sizeof(UForthCondDefine));
5078   if (dd == NULL) ufoFatal("out of memory for defines");
5079   dd->name = strdup("UFO-DEBUG-STARTUP-TIMES");
5080   if (dd->name == NULL) { free(dd); ufoFatal("out of memory for defines"); }
5081   dd->namelen = (uint32_t)strlen(dd->name);
5082   dd->hash = joaatHashBufCI(dd->name, dd->namelen);;
5083   dd->next = ufoCondDefines;
5084   ufoCondDefines = dd;
5085   #endif
5086   ufoInitCommon();
5087   #ifdef UFO_DEBUG_STARTUP_TIMES
5088   uint32_t ett = ufo_get_msecs();
5089   fprintf(stderr, "UrForth init time: %u msecs\n", (unsigned)(ett - stt));
5090   #endif
5091
5092   ufoZXPostInit();
5093
5094   ufoReset();
5095
5096   // load ufo modules
5097   char *ufmname = ufoCreateIncludeName("init", 1, NULL);
5098   FILE *ufl = ufoOpenFileOrDir(&ufmname);
5099   if (ufl) {
5100     ufoPushInFile();
5101     ufoInFileName = ufmname;
5102     ufoInFile = ufl;
5103     setLastIncPath(ufoInFileName);
5104   } else {
5105     free(ufmname);
5106   }
5107 }
5108
5109
5110 //==========================================================================
5111 //
5112 //  ufoInlineRun
5113 //
5114 //==========================================================================
5115 void ufoInlineRun (void) {
5116   if (ufoMode == UFO_MODE_NONE) {
5117     ufoInlineInit();
5118   }
5119   ufoMode = UFO_MODE_NATIVE;
5120
5121   if (setjmp(ufoInlineQuitJP) == 0) {
5122     ufoReset();
5123     ufoRunIt("RUN-INTERPRET-LOOP");
5124     ufo_assert(0); // the thing that should not be
5125   } else {
5126     while (ufoFileStackPos != 0) ufoPopInFile();
5127   }
5128 }
5129
5130
5131 //==========================================================================
5132 //
5133 //  ufoIsMacro
5134 //
5135 //==========================================================================
5136 uint32_t ufoIsMacro (const char *wname) {
5137   if (ufoMode != UFO_MODE_NONE && wname != NULL && wname[0] != 0) {
5138     return ufoFindWordMacro(wname);
5139   } else {
5140     return 0;
5141   }
5142 }
5143
5144
5145 //==========================================================================
5146 //
5147 //  ufoMacroRun
5148 //
5149 //==========================================================================
5150 void ufoMacroRun (uint32_t cfa, const char *line, const char *fname, int lnum) {
5151   ufo_assert(ufoMode != UFO_MODE_NONE);
5152   if (cfa != 0) {
5153     if (setjmp(ufoInlineQuitJP) == 0) {
5154       ufoReset();
5155       ufoLoadMacroLine(line, fname, lnum);
5156       const uint32_t oldIP = ufoIP;
5157       ufoRunVMCFA(cfa);
5158       ufoIP = oldIP;
5159       while (ufoFileStackPos != 0) ufoPopInFile();
5160     } else {
5161       while (ufoFileStackPos != 0) ufoPopInFile();
5162       ufoFatal("wtf with UFO macro?!");
5163     }
5164   } else {
5165     ufoFatal("wtf with UFO macro?!");
5166   }
5167 }