src/liburforth/urforth.c

   1 // and now for something completely different...
   2 // UrAsm built-in Forth Engine!
   3 // GPLv3 ONLY
   4 #ifdef WIN32
   5 #include <windows.h>
   6 #endif
   7 #include <stdarg.h>
   8 #include <setjmp.h>
   9 #include <stdio.h>
  10 #include <stdlib.h>
  11 #include <string.h>
  12 #include <time.h>
  13 #include <unistd.h>
  14
  15 #include <sys/fcntl.h>
  16 #include <sys/stat.h>
  17 #include <sys/types.h>
  18
  19 #include "urforth.h"
  20
  21 #ifdef WIN32
  22 # define realpath(shit,fuck)  _fullpath(fuck, shit, 32768)
  23 #endif
  24
  25
  26 //#define UFO_DEBUG_WRITE_MAIN_IMAGE
  27 //#define UFO_DEBUG_WRITE_DEBUG_IMAGE
  28
  29
  30 #define UFO_DEBUG_STARTUP_TIMES
  31 //#define UFO_DEBUG_FATAL_ABORT
  32 #define UFO_DEBUG_DEBUG  /* ;-) */
  33 //#define UFO_TRACE_VM_DOER
  34 //#define UFO_TRACE_VM_RUN
  35 //#define UFO_DEBUG_INCLUDE
  36 //#define UFO_DEBUG_DUMP_NEW_HEADERS
  37 //#define UFO_DEBUG_FIND_WORD
  38 //#define UFO_DEBUG_FIND_WORD_IN_VOC
  39 //#define UFO_DEBUG_FIND_WORD_COLON
  40
  41 // 2/8 msecs w/o inlining
  42 // 1/5 msecs with inlining
  43 #if 1
  44 # define UFO_FORCE_INLINE static inline __attribute__((always_inline))
  45 #else
  46 # define UFO_FORCE_INLINE static __attribute__((noinline)) /*__attribute__((unused))*/
  47 #endif
  48 #define UFO_DISABLE_INLINE static __attribute__((noinline)) /*__attribute__((unused))*/
  49
  50 // detect arch, and use faster memory access code on x86
  51 #if defined(__x86_64__) || defined(_M_X64) || \
  52     defined(i386) || defined(__i386__) || defined(__i386) || defined(_M_IX86)
  53 # define UFO_FAST_MEM_ACCESS
  54 #endif
  55
  56 // should not be bigger than this!
  57 #define UFO_MAX_WORD_LENGTH  (250)
  58
  59 #define UFO_ALIGN4(v_)  (((v_) + 3u) / 4u * 4u)
  60
  61
  62 // ////////////////////////////////////////////////////////////////////////// //
  63 static void ufoFlushOutput (void);
  64
  65 UFO_DISABLE_INLINE const char *ufo_assert_failure (const char *cond, const char *fname,
  66                                                    int fline, const char *func)
  67 {
  68   for (const char *t = fname; *t; ++t) {
  69     #ifdef WIN32
  70     if (*t == '/' || *t == '\\') fname = t+1;
  71     #else
  72     if (*t == '/') fname = t+1;
  73     #endif
  74   }
  75   ufoFlushOutput();
  76   fprintf(stderr, "\n%s:%d: Assertion in `%s` failed: %s\n", fname, fline, func, cond);
  77   ufoFlushOutput();
  78   abort();
  79 }
  80
  81 #define ufo_assert(cond_)  do { if (__builtin_expect((!(cond_)), 0)) { ufo_assert_failure(#cond_, __FILE__, __LINE__, __PRETTY_FUNCTION__); } } while (0)
  82
  83
  84 static char ufoRealPathBuf[32769];
  85 static char ufoRealPathHashBuf[32769];
  86
  87
  88 //==========================================================================
  89 //
  90 //  ufoRealPath
  91 //
  92 //==========================================================================
  93 static char *ufoRealPath (const char *fname) {
  94   char *res;
  95   if (fname != NULL && fname[0] != 0) {
  96     res = realpath(fname, NULL);
  97     if (res != NULL) {
  98       const size_t slen = strlen(res);
  99       if (slen < 32768) {
 100         strcpy(ufoRealPathBuf, res);
 101         free(res);
 102         res = ufoRealPathBuf;
 103       } else {
 104         free(res);
 105         res = NULL;
 106       }
 107     }
 108   } else {
 109     res = NULL;
 110   }
 111   return res;
 112 }
 113
 114
 115 #ifndef WIN32
 116 static time_t secstart = 0;
 117 #endif
 118
 119
 120
 121 //==========================================================================
 122 //
 123 //  ufo_get_msecs
 124 //
 125 //==========================================================================
 126 static uint64_t ufo_get_msecs (void) {
 127   #ifdef WIN32
 128   return GetTickCount();
 129   #else
 130   struct timespec ts;
 131   #ifdef CLOCK_MONOTONIC
 132   ufo_assert(clock_gettime(CLOCK_MONOTONIC, &ts) == 0);
 133   #else
 134   // this should be available everywhere
 135   ufo_assert(clock_gettime(CLOCK_REALTIME, &ts) == 0);
 136   #endif
 137   // first run?
 138   if (secstart == 0) {
 139     secstart = ts.tv_sec+1;
 140     ufo_assert(secstart); // it should not be zero
 141   }
 142   return (uint64_t)(ts.tv_sec-secstart+2)*1000U+(uint32_t)ts.tv_nsec/1000000U;
 143   // nanoseconds
 144   //return (uint64_t)(ts.tv_sec-secstart+2)*1000000000U+(uint32_t)ts.tv_nsec;
 145   #endif
 146 }
 147
 148
 149 //==========================================================================
 150 //
 151 //  joaatHashBuf
 152 //
 153 //==========================================================================
 154 UFO_FORCE_INLINE uint32_t joaatHashBuf (const void *buf, size_t len, uint8_t orbyte) {
 155   uint32_t hash = 0x29a;
 156   const uint8_t *s = (const uint8_t *)buf;
 157   while (len--) {
 158     hash += (*s++)|orbyte;
 159     hash += hash<<10;
 160     hash ^= hash>>6;
 161   }
 162   // finalize
 163   hash += hash<<3;
 164   hash ^= hash>>11;
 165   hash += hash<<15;
 166   return hash;
 167 }
 168
 169
 170 // this converts ASCII capitals to locase (and destroys other, but who cares)
 171 #define joaatHashBufCI(buf_,len_)  joaatHashBuf((buf_), (len_), 0x20)
 172
 173
 174 //==========================================================================
 175 //
 176 //  toUpper
 177 //
 178 //==========================================================================
 179 UFO_FORCE_INLINE char toUpper (char ch) {
 180   return (ch >= 'a' && ch <= 'z' ? ch-'a'+'A' : ch);
 181 }
 182
 183
 184 //==========================================================================
 185 //
 186 //  toUpperU8
 187 //
 188 //==========================================================================
 189 UFO_FORCE_INLINE uint8_t toUpperU8 (uint8_t ch) {
 190   return (ch >= 'a' && ch <= 'z' ? ch-'a'+'A' : ch);
 191 }
 192
 193
 194 //==========================================================================
 195 //
 196 //  digitInBase
 197 //
 198 //==========================================================================
 199 UFO_FORCE_INLINE int digitInBase (char ch, int base) {
 200   switch (ch) {
 201     case '0' ... '9': ch = ch - '0'; break;
 202     case 'A' ... 'Z': ch = ch - 'A' + 10; break;
 203     case 'a' ... 'z': ch = ch - 'a' + 10; break;
 204     default: base = -1; break;
 205   }
 206   return (ch >= 0 && ch < base ? ch : -1);
 207 }
 208
 209
 210 /*
 211 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 212 ;; word header format:
 213 ;; note than name hash is ALWAYS calculated with ASCII-uppercased name
 214 ;; (actually, bit 5 is always reset for all bytes, because we don't need the
 215 ;; exact uppercase, only something that resembles it)
 216 ;; bfa points to next bfa or to 0 (this is "hash bucket pointer")
 217 ;; before nfa, we have such "hidden" fields:
 218 ;;   dd xfa       ; points to the previous word header SFA, regardless of vocabularies (or 0)
 219 ;;   dd yfa       ; points to the previous word header SFA, regardless of vocabularies (or 0)
 220 ;;   dd bfa       ; next word in hashtable bucket; it is always here, even if hashtable is turned off
 221 ;;                ; if there is no hashtable, this field is not used
 222 ;; lfa:
 223 ;;   dd lfa       ; previous vocabulary word LFA or 0 (lfa links points here)
 224 ;;   dd namehash  ; it is always here, and always calculated, even if hashtable is turned off
 225 ;; nfa:
 226 ;;   dd flags-and-name-len   ; see below
 227 ;;   db name      ; no terminating zero or other "termination flag" here
 228 ;;  here could be some 0 bytes to align everything to 4 bytes
 229 ;;   db namelen   ; yes, name length again, so CFA->NFA can avoid guessing
 230 ;;                ; full length, including padding, but not including this byte
 231 ;; cfa:
 232 ;;   dd cfaidx    ; our internal CFA index, or image address for DOES>
 233 ;; pfa:
 234 ;;   word data follows
 235 ;;
 236 ;; first word cell contains combined name length (low byte), argtype and flags (other bytes)
 237 ;; layout:
 238 ;;   db namelen
 239 ;;   db argtype
 240 ;;   dw flags
 241 ;; i.e. we have 16 bits for flags, and 256 possible argument types. why not.
 242 ;;
 243 ;; flags:
 244 ;;  bit 0: immediate
 245 ;;  bit 1: smudge
 246 ;;  bit 2: noreturn
 247 ;;  bit 3: hidden
 248 ;;  bit 4: codeblock
 249 ;;  bit 5: vocabulary
 250 ;;  bit 6: *UNUSED* main scattered colon word (with "...")
 251 ;;  bit 7: protected
 252 ;;
 253 ;;  argtype is the type of the argument that this word reads from the threaded code.
 254 ;;  possible argument types:
 255 ;;    0: none
 256 ;;    1: branch address
 257 ;;    2: cell-size numeric literal
 258 ;;    3: cell-counted string with terminating zero (not counted)
 259 ;;    4: cfa of another word
 260 ;;    5: cblock
 261 ;;    6: vocid
 262 ;;    7: byte-counted string with terminating zero (not counted)
 263 ;;    8: data skip: the arg is amout of bytes to skip (not including the counter itself)
 264
 265
 266 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 267 ;; wordlist structure (at PFA)
 268 ;; -4: wordlist type id (used by structs, for example)
 269 ;;   dd latest
 270 ;;   dd voclink (voclink always points here)
 271 ;;   dd parent (if not zero, all parent words are visible)
 272 ;;   dd header-nfa (can be 0 for anonymous wordlists)
 273 ;;   hashtable (if enabled), or ~0U if no hash table
 274 */
 275
 276
 277 // ////////////////////////////////////////////////////////////////////////// //
 278 #define UFO_BFA_TO_LFA(bfa_)    ((bfa_) + 1u * 4u)
 279 #define UFO_LFA_TO_XFA(lfa_)    ((lfa_) - 3u * 4u)
 280 #define UFO_LFA_TO_YFA(lfa_)    ((lfa_) - 2u * 4u)
 281 #define UFO_LFA_TO_BFA(lfa_)    ((lfa_) - 1u * 4u)
 282 #define UFO_LFA_TO_NFA(lfa_)    ((lfa_) + 2u * 4u)
 283 #define UFO_LFA_TO_CFA(lfa_)    UFO_ALIGN4((lfa_) + 3u * 4u + 1u + ufoImgGetU8((lfa_) + 2u * 4u))
 284 #define UFO_LFA_TO_NHASH(lfa_)  ((lfa_) + 1u * 4u)
 285 #define UFO_CFA_TO_NFA(cfa_)    ((cfa_) - 1u - 4u - ufoImgGetU8((cfa_) - 1u))
 286 #define UFO_CFA_TO_LFA(cfa_)    ((cfa_) - 1u - 4u * 3u - ufoImgGetU8((cfa_) - 1u))
 287 #define UFO_CFA_TO_PFA(cfa_)    ((cfa_) + 1u * 4u)
 288 #define UFO_PFA_TO_CFA(pfa_)    ((pfa_) - 1u * 4u)
 289 #define UFO_NFA_TO_CFA(nfa_)    UFO_ALIGN4((nfa_) + 4u + 1u + ufoImgGetU8((nfa_)))
 290 #define UFO_NFA_TO_LFA(nfa_)    ((nfa_) - 2u * 4u)
 291 #define UFO_XFA_TO_YFA(xfa_)    ((xfa_) + 4u)
 292 #define UFO_YFA_TO_XFA(yfa_)    ((xfa_) - 4u)
 293 #define UFO_XFA_TO_WST(xfa_)    ((xfa_) - 4u)
 294 #define UFO_YFA_TO_WST(yfa_)    ((yfa_) - 2u * 4u)
 295 #define UFO_YFA_TO_NFA(yfa_)    ((yfa_) + 4u * 4u)
 296
 297
 298 // ////////////////////////////////////////////////////////////////////////// //
 299 #define UFW_VOCAB_OFS_LATEST   (0u * 4u)
 300 #define UFW_VOCAB_OFS_VOCLINK  (1u * 4u)
 301 #define UFW_VOCAB_OFS_PARENT   (2u * 4u)
 302 #define UFW_VOCAB_OFS_HEADER   (3u * 4u)
 303 #define UFW_VOCAB_OFS_HTABLE   (4u * 4u)
 304
 305 #define UFO_HASHTABLE_SIZE  (256)
 306
 307 #define UFO_NO_HTABLE_FLAG  (~(uint32_t)0)
 308
 309 #define UFO_MAX_NATIVE_CFAS  (1024u)
 310 static ufoNativeCFA *ufoForthCFAs = NULL;
 311 static uint32_t ufoCFAsUsed = 0;
 312
 313 static uint32_t ufoDoForthCFA;
 314 static uint32_t ufoDoVariableCFA;
 315 static uint32_t ufoDoValueCFA;
 316 static uint32_t ufoDoConstCFA;
 317 static uint32_t ufoDoDeferCFA;
 318 static uint32_t ufoDoVocCFA;
 319 static uint32_t ufoDoCreateCFA;
 320 static uint32_t ufoDoUserVariableCFA;
 321
 322 static uint32_t ufoLitStr8CFA;
 323
 324 // special address types:
 325 #define UFO_ADDR_CFA_BIT   ((uint32_t)1<<31)
 326 #define UFO_ADDR_CFA_MASK  (UFO_ADDR_CFA_BIT-1u)
 327
 328 // handles are somewhat special: first 12 bits can be used as offset for "@", and are ignored
 329 #define UFO_ADDR_HANDLE_BIT       ((uint32_t)1<<30)
 330 #define UFO_ADDR_HANDLE_MASK      ((UFO_ADDR_HANDLE_BIT-1u)&~((uint32_t)0xfff))
 331 #define UFO_ADDR_HANDLE_SHIFT     (12)
 332 #define UFO_ADDR_HANDLE_OFS_MASK  ((uint32_t)((1 << UFO_ADDR_HANDLE_SHIFT) - 1))
 333
 334 // temporary area is 1MB buffer out of the main image
 335 #define UFO_ADDR_TEMP_BIT   ((uint32_t)1<<29)
 336 #define UFO_ADDR_TEMP_MASK  (UFO_ADDR_TEMP_BIT-1u)
 337
 338 #define UFO_ADDR_SPECIAL_BITS_MASK  (UFO_ADDR_CFA_BIT|UFO_ADDR_HANDLE_BIT|UFO_ADDR_TEMP_BIT)
 339
 340
 341 static uint32_t *ufoImage = NULL;
 342 static uint32_t ufoImageSize = 0;
 343
 344 static uint8_t *ufoDebugImage = NULL;
 345 static uint32_t ufoDebugImageUsed = 0; // in bytes
 346 static uint32_t ufoDebugImageSize = 0; // in bytes
 347 static uint32_t ufoDebugFileNameHash = 0; // current file name hash
 348 static uint32_t ufoDebugFileNameLen = 0; // current file name length
 349 static uint32_t ufoDebugLastLine = 0;
 350 static uint32_t ufoDebugLastLinePCOfs = 0;
 351 static uint32_t ufoDebugLastLineDP = 0;
 352 static uint32_t ufoDebugCurrDP = 0;
 353
 354 static uint32_t ufoInRunWord = 0;
 355
 356 static volatile int ufoVMAbort = 0;
 357 static volatile int ufoVMStop = 0;
 358
 359 #define ufoTrueValue  (~(uint32_t)0)
 360
 361 enum {
 362   UFO_MODE_NONE = -1,
 363   UFO_MODE_NATIVE = 0, // executing forth code
 364   UFO_MODE_MACRO = 1, // executing forth asm macro
 365 };
 366 static uint32_t ufoMode = UFO_MODE_NONE;
 367
 368 #define UFO_DSTACK_SIZE    (8192)
 369 #define UFO_RSTACK_SIZE    (4096)
 370 #define UFO_LSTACK_SIZE    (4096)
 371 #define UFO_MAX_TASK_NAME  (127)
 372 #define UFO_VOCSTACK_SIZE  (16u)
 373
 374 // to support multitasking (required for the debugger),
 375 // our virtual machine state is encapsulated in a struct.
 376 typedef struct UfoState_t {
 377   uint32_t id;
 378   uint32_t dStack[UFO_DSTACK_SIZE];
 379   uint32_t rStack[UFO_RSTACK_SIZE];
 380   uint32_t lStack[UFO_LSTACK_SIZE];
 381   uint32_t IP; // in image
 382   uint32_t SP; // points AFTER the last value pushed
 383   uint32_t RP; // points AFTER the last value pushed
 384   uint32_t RPTop; // stop when RP is this
 385   // address register
 386   uint32_t regA;
 387   // for locals
 388   uint32_t LP;
 389   uint32_t LBP;
 390   uint32_t vmRPopCFA;
 391   // vocstack
 392   uint32_t vocStack[UFO_VOCSTACK_SIZE]; // cfas
 393   uint32_t VSP;
 394   // temp image
 395   uint32_t *imageTemp;
 396   uint32_t imageTempSize;
 397   // linked list of all allocated states (tasks)
 398   char name[UFO_MAX_TASK_NAME + 1];
 399 } UfoState;
 400
 401 // 'cmon!
 402 #define UFO_MAX_STATES  (8192)
 403
 404 // this is indexed by id
 405 static UfoState *ufoStateMap[UFO_MAX_STATES] = {NULL};
 406 static uint32_t ufoStateUsedBitmap[UFO_MAX_STATES/32] = {0};
 407
 408 // currently active execution state
 409 static UfoState *ufoCurrState = NULL;
 410 // state we're yielded from
 411 static UfoState *ufoYieldedState = NULL;
 412 // if debug state is not NULL, VM will switch to it
 413 // after executing one instruction from the current state.
 414 // it will store current state in `ufoDebugeeState`.
 415 static UfoState *ufoDebuggerState = NULL;
 416 static uint32_t ufoSingleStep = 0;
 417
 418 #define ufoDStack         (ufoCurrState->dStack)
 419 #define ufoRStack         (ufoCurrState->rStack)
 420 #define ufoLStack         (ufoCurrState->lStack)
 421 #define ufoIP             (ufoCurrState->IP)
 422 #define ufoSP             (ufoCurrState->SP)
 423 #define ufoRP             (ufoCurrState->RP)
 424 #define ufoRPTop          (ufoCurrState->RPTop)
 425 #define ufoLP             (ufoCurrState->LP)
 426 #define ufoLBP            (ufoCurrState->LBP)
 427 #define ufoRegA           (ufoCurrState->regA)
 428 #define ufoImageTemp      (ufoCurrState->imageTemp)
 429 #define ufoImageTempSize  (ufoCurrState->imageTempSize)
 430 #define ufoVMRPopCFA      (ufoCurrState->vmRPopCFA)
 431 #define ufoVocStack       (ufoCurrState->vocStack)
 432 #define ufoVSP            (ufoCurrState->VSP)
 433
 434 // 256 bytes for user variables
 435 #define UFO_USER_AREA_ADDR  UFO_ADDR_TEMP_BIT
 436 #define UFO_USER_AREA_SIZE  (256u)
 437 #define UFO_NBUF_ADDR       UFO_USER_AREA_ADDR + UFO_USER_AREA_SIZE
 438 #define UFO_NBUF_SIZE       (256u)
 439 #define UFO_PAD_ADDR        (UFO_NBUF_ADDR + UFO_NBUF_SIZE)
 440 #define UFO_DEF_TIB_ADDR    (UFO_PAD_ADDR + 2048u)
 441
 442 // dynamically allocated text input buffer
 443 // always ends with zero (this is word name too)
 444 static const uint32_t ufoAddrTIBx = UFO_ADDR_TEMP_BIT + 0u * 4u; // TIB
 445 static const uint32_t ufoAddrINx = UFO_ADDR_TEMP_BIT + 1u * 4u; // >IN
 446 static const uint32_t ufoAddrDefTIB = UFO_ADDR_TEMP_BIT + 2u * 4u; // default TIB (handle); user cannot change it
 447 static const uint32_t ufoAddrBASE = UFO_ADDR_TEMP_BIT + 3u * 4u;
 448 static const uint32_t ufoAddrSTATE = UFO_ADDR_TEMP_BIT + 4u * 4u;
 449 static const uint32_t ufoAddrContext = UFO_ADDR_TEMP_BIT + 5u * 4u; // CONTEXT
 450 static const uint32_t ufoAddrCurrent = UFO_ADDR_TEMP_BIT + 6u * 4u; // CURRENT (definitions will go there)
 451 static const uint32_t ufoAddrSelf = UFO_ADDR_TEMP_BIT + 7u * 4u; // CURRENT (definitions will go there)
 452 static const uint32_t ufoAddrInterNextLine = UFO_ADDR_TEMP_BIT + 8u * 4u; // (INTERPRET-NEXT-LINE)
 453 static const uint32_t ufoAddrEP = UFO_ADDR_TEMP_BIT + 9u * 4u; // (EP) -- exception frame pointer
 454 static const uint32_t ufoAddrUserVarUsed = UFO_ADDR_TEMP_BIT + 10u * 4u;
 455
 456 static uint32_t ufoAddrVocLink;
 457 static uint32_t ufoAddrDP;
 458 static uint32_t ufoAddrDPTemp;
 459 static uint32_t ufoAddrNewWordFlags;
 460 static uint32_t ufoAddrRedefineWarning;
 461 static uint32_t ufoAddrLastXFA;
 462
 463 static uint32_t ufoForthVocId;
 464 static uint32_t ufoCompilerVocId;
 465 static uint32_t ufoInterpNextLineCFA;
 466
 467 // allows to redefine even protected words
 468 #define UFO_REDEF_WARN_DONT_CARE  (~(uint32_t)0)
 469 // do not warn about ordinary words, allow others
 470 #define UFO_REDEF_WARN_NONE    (0)
 471 // do warn (or fail on protected)
 472 #define UFO_REDEF_WARN_NORMAL  (1)
 473 // do warn (or fail on protected) for parent dicts too
 474 #define UFO_REDEF_WARN_PARENTS (2)
 475
 476 #define UFO_GET_DP()      (ufoImgGetU32(ufoAddrDPTemp) ?: ufoImgGetU32(ufoAddrDP))
 477 //#define UFO_SET_DP(val_)  ufoImgPutU32(ufoAddrDP, (val_))
 478
 479 #define UFO_MAX_NESTED_INCLUDES  (32)
 480 typedef struct {
 481   FILE *fl;
 482   char *fname;
 483   char *incpath;
 484   char *sysincpath;
 485   int fline;
 486   uint32_t id; // non-zero unique id
 487 } UFOFileStackEntry;
 488
 489 static UFOFileStackEntry ufoFileStack[UFO_MAX_NESTED_INCLUDES];
 490 static uint32_t ufoFileStackPos; // after the last used item
 491
 492 static FILE *ufoInFile = NULL;
 493 static uint32_t ufoInFileNameLen = 0;
 494 static uint32_t ufoInFileNameHash = 0;
 495 static char *ufoInFileName = NULL;
 496 static char *ufoLastIncPath = NULL;
 497 static char *ufoLastSysIncPath = NULL;
 498 static int ufoInFileLine = 0;
 499 static uint32_t ufoFileId = 0;
 500 static uint32_t ufoLastUsedFileId = 0;
 501 static int ufoLastEmitWasCR = 1;
 502 static long ufoCurrIncludeLineFileOfs = 0;
 503
 504 // dynamic memory handles
 505 typedef struct UHandleInfo_t {
 506   uint32_t ufoHandle;
 507   uint32_t typeid;
 508   uint8_t *data;
 509   uint32_t size;
 510   uint32_t used;
 511   // in free list
 512   struct UHandleInfo_t *next;
 513 } UfoHandle;
 514
 515 static UfoHandle *ufoHandleFreeList = NULL;
 516 static UfoHandle **ufoHandles = NULL;
 517 static uint32_t ufoHandlesUsed = 0;
 518 static uint32_t ufoHandlesAlloted = 0;
 519
 520 #define UFO_HANDLE_FREE  (~(uint32_t)0)
 521
 522 static char ufoCurrFileLine[520];
 523
 524 // for `ufoFatal()`
 525 static uint32_t ufoInBacktrace = 0;
 526
 527
 528 // ////////////////////////////////////////////////////////////////////////// //
 529 static void ufoClearCondDefines (void);
 530
 531 static void ufoRunVMCFA (uint32_t cfa);
 532
 533 static void ufoBacktrace (uint32_t ip, int showDataStack);
 534
 535 static void ufoClearCondDefines (void);
 536
 537 static UfoState *ufoNewState (void);
 538 static void ufoInitStateUserVars (UfoState *st, uint32_t cfa);
 539 static void ufoFreeState (UfoState *st);
 540 static UfoState *ufoFindState (uint32_t stid);
 541 static void ufoSwitchToState (UfoState *newst);
 542
 543 __attribute__((unused)) static void ufoDumpWordHeader (const uint32_t lfa);
 544
 545 #ifndef WIN32
 546 static void ufoDisableRaw (void);
 547 #endif
 548 static void ufoTTYRawFlush (void);
 549 static int ufoIsGoodTTY (void);
 550
 551 #ifdef UFO_DEBUG_DEBUG
 552 static void ufoDumpDebugImage (void);
 553 #endif
 554
 555
 556 // ////////////////////////////////////////////////////////////////////////// //
 557 #define UFWORD(name_) \
 558 static void ufoWord_##name_ (uint32_t mypfa)
 559
 560 #define UFCALL(name_)  ufoWord_##name_(0)
 561 #define UFCFA(name_)   (&ufoWord_##name_)
 562
 563 // for TIB words
 564 UFWORD(CPOKE_REGA_IDX);
 565
 566 // for peek and poke
 567 UFWORD(PAR_HANDLE_LOAD_BYTE);
 568 UFWORD(PAR_HANDLE_LOAD_WORD);
 569 UFWORD(PAR_HANDLE_LOAD_CELL);
 570 UFWORD(PAR_HANDLE_STORE_BYTE);
 571 UFWORD(PAR_HANDLE_STORE_WORD);
 572 UFWORD(PAR_HANDLE_STORE_CELL);
 573
 574
 575 //==========================================================================
 576 //
 577 //  ufoFlushOutput
 578 //
 579 //==========================================================================
 580 static void ufoFlushOutput (void) {
 581   ufoTTYRawFlush();
 582   fflush(NULL);
 583 }
 584
 585
 586 //==========================================================================
 587 //
 588 //  ufoSetInFileName
 589 //
 590 //  if `reuse` is not 0, reuse/free `fname`
 591 //
 592 //==========================================================================
 593 static void ufoSetInFileNameEx (const char *fname, int reuse) {
 594   ufo_assert(fname == NULL || (fname != ufoInFileName));
 595   if (fname == NULL || fname[0] == 0) {
 596     if (ufoInFileName) { free(ufoInFileName); ufoInFileName = NULL; }
 597     ufoInFileNameLen = 0;
 598     ufoInFileNameHash = 0;
 599     if (reuse && fname != NULL) free((void *)fname);
 600   } else {
 601     const uint32_t fnlen = (uint32_t)strlen(fname);
 602     const uint32_t fnhash = joaatHashBuf(fname, fnlen, 0);
 603     if (ufoInFileNameLen != fnlen || ufoInFileNameHash != fnhash) {
 604       if (ufoInFileName) { free(ufoInFileName); ufoInFileName = NULL; }
 605       if (reuse) {
 606         ufoInFileName = (char *)fname;
 607       } else {
 608         ufoInFileName = strdup(fname);
 609         if (ufoInFileName == NULL) ufoFatal("out of memory for filename info");
 610       }
 611       ufoInFileNameLen = fnlen;
 612       ufoInFileNameHash = fnhash;
 613     } else {
 614       if (reuse && fname != NULL) free((void *)fname);
 615     }
 616   }
 617 }
 618
 619
 620 //==========================================================================
 621 //
 622 //  ufoSetInFileName
 623 //
 624 //==========================================================================
 625 UFO_FORCE_INLINE void ufoSetInFileName (const char *fname) {
 626   ufoSetInFileNameEx(fname, 0);
 627 }
 628
 629
 630 //==========================================================================
 631 //
 632 //  ufoSetInFileNameReuse
 633 //
 634 //==========================================================================
 635 UFO_FORCE_INLINE void ufoSetInFileNameReuse (const char *fname) {
 636   ufoSetInFileNameEx(fname, 1);
 637 }
 638
 639
 640 //==========================================================================
 641 //
 642 //  ufoSetUserAbort
 643 //
 644 //==========================================================================
 645 void ufoSetUserAbort (void) {
 646   ufoVMAbort = 1;
 647 }
 648
 649
 650 //==========================================================================
 651 //
 652 //  ufoAllocHandle
 653 //
 654 //==========================================================================
 655 static UfoHandle *ufoAllocHandle (uint32_t typeid) {
 656   ufo_assert(typeid != UFO_HANDLE_FREE);
 657   UfoHandle *newh = ufoHandleFreeList;
 658   if (newh == NULL) {
 659     if (ufoHandlesUsed == ufoHandlesAlloted) {
 660       uint32_t newsz = ufoHandlesAlloted + 16384;
 661       // due to offsets, this is the maximum number of handles we can have
 662       if (newsz > 0x1ffffU) {
 663         if (ufoHandlesAlloted > 0x1ffffU) ufoFatal("too many dynamic handles");
 664         newsz = 0x1ffffU + 1U;
 665         ufo_assert(newsz > ufoHandlesAlloted);
 666       }
 667       UfoHandle **nh = realloc(ufoHandles, sizeof(ufoHandles[0]) * newsz);
 668       if (nh == NULL) ufoFatal("out of memory for handle table");
 669       ufoHandles = nh;
 670       ufoHandlesAlloted = newsz;
 671     }
 672     newh = calloc(1, sizeof(UfoHandle));
 673     if (newh == NULL) ufoFatal("out of memory for handle info");
 674     ufoHandles[ufoHandlesUsed] = newh;
 675     // setup new handle info
 676     newh->ufoHandle = (ufoHandlesUsed << UFO_ADDR_HANDLE_SHIFT) | UFO_ADDR_HANDLE_BIT;
 677     ufoHandlesUsed += 1;
 678   } else {
 679     ufo_assert(newh->typeid == UFO_HANDLE_FREE);
 680     ufoHandleFreeList = newh->next;
 681   }
 682   // setup new handle info
 683   newh->typeid = typeid;
 684   newh->data = NULL;
 685   newh->size = 0;
 686   newh->used = 0;
 687   newh->next = NULL;
 688   return newh;
 689 }
 690
 691
 692 //==========================================================================
 693 //
 694 //  ufoFreeHandle
 695 //
 696 //==========================================================================
 697 static void ufoFreeHandle (UfoHandle *hh) {
 698   if (hh != NULL) {
 699     ufo_assert(hh->typeid != UFO_HANDLE_FREE);
 700     if (hh->data) free(hh->data);
 701     hh->typeid = UFO_HANDLE_FREE;
 702     hh->data = NULL;
 703     hh->size = 0;
 704     hh->used = 0;
 705     hh->next = ufoHandleFreeList;
 706     ufoHandleFreeList = hh;
 707   }
 708 }
 709
 710
 711 //==========================================================================
 712 //
 713 //  ufoGetHandle
 714 //
 715 //==========================================================================
 716 static UfoHandle *ufoGetHandle (uint32_t hh) {
 717   UfoHandle *res;
 718   if (hh != 0 && (hh & UFO_ADDR_HANDLE_BIT) != 0) {
 719     hh = (hh & UFO_ADDR_HANDLE_MASK) >> UFO_ADDR_HANDLE_SHIFT;
 720     if (hh < ufoHandlesUsed) {
 721       res = ufoHandles[hh];
 722       if (res->typeid == UFO_HANDLE_FREE) res = NULL;
 723     } else {
 724       res = NULL;
 725     }
 726   } else {
 727     res = NULL;
 728   }
 729   return res;
 730 }
 731
 732
 733 //==========================================================================
 734 //
 735 //  setLastIncPath
 736 //
 737 //==========================================================================
 738 static void setLastIncPath (const char *fname, int system) {
 739   if (fname == NULL || fname[0] == 0) {
 740     if (system) {
 741       if (ufoLastSysIncPath) free(ufoLastIncPath);
 742       ufoLastSysIncPath = NULL;
 743     } else {
 744       if (ufoLastIncPath) free(ufoLastIncPath);
 745       ufoLastIncPath = strdup(".");
 746     }
 747   } else {
 748     char *lslash;
 749     char *cpos;
 750     if (system) {
 751       if (ufoLastSysIncPath) free(ufoLastSysIncPath);
 752       ufoLastSysIncPath = strdup(fname);
 753       lslash = ufoLastSysIncPath;
 754       cpos = ufoLastSysIncPath;
 755     } else {
 756       if (ufoLastIncPath) free(ufoLastIncPath);
 757       ufoLastIncPath = strdup(fname);
 758       lslash = ufoLastIncPath;
 759       cpos = ufoLastIncPath;
 760     }
 761     while (*cpos) {
 762       #ifdef WIN32
 763       if (*cpos == '/' || *cpos == '\\') lslash = cpos;
 764       #else
 765       if (*cpos == '/') lslash = cpos;
 766       #endif
 767       cpos += 1;
 768     }
 769     *lslash = 0;
 770   }
 771 }
 772
 773
 774 //==========================================================================
 775 //
 776 //  ufoClearIncludePath
 777 //
 778 //  required for UrAsm
 779 //
 780 //==========================================================================
 781 void ufoClearIncludePath (void) {
 782   if (ufoLastIncPath != NULL) {
 783     free(ufoLastIncPath);
 784     ufoLastIncPath = NULL;
 785   }
 786   if (ufoLastSysIncPath != NULL) {
 787     free(ufoLastSysIncPath);
 788     ufoLastSysIncPath = NULL;
 789   }
 790 }
 791
 792
 793 //==========================================================================
 794 //
 795 //  ufoErrorPrintFile
 796 //
 797 //==========================================================================
 798 static void ufoErrorPrintFile (FILE *fo, const char *errwarn) {
 799   if (ufoInFileName != NULL) {
 800     fprintf(fo, "UFO %s at file %s, line %d: ", errwarn, ufoInFileName, ufoInFileLine);
 801   } else {
 802     fprintf(fo, "UFO %s somewhere in time: ", errwarn);
 803   }
 804 }
 805
 806
 807 //==========================================================================
 808 //
 809 //  ufoErrorMsgV
 810 //
 811 //==========================================================================
 812 static void ufoErrorMsgV (const char *errwarn, const char *fmt, va_list ap) {
 813   ufoFlushOutput();
 814   if (!ufoLastEmitWasCR) { printf("\n"); ufoLastEmitWasCR = 1; }
 815   ufoErrorPrintFile(stderr, errwarn);
 816   vfprintf(stderr, fmt, ap);
 817   va_end(ap);
 818   fputc('\n', stderr);
 819   ufoFlushOutput();
 820 }
 821
 822
 823 //==========================================================================
 824 //
 825 //  ufoWarning
 826 //
 827 //==========================================================================
 828 __attribute__((format(printf, 1, 2)))
 829 void ufoWarning (const char *fmt, ...) {
 830   va_list ap;
 831   va_start(ap, fmt);
 832   ufoErrorMsgV("WARNING", fmt, ap);
 833 }
 834
 835
 836 //==========================================================================
 837 //
 838 //  ufoFatal
 839 //
 840 //==========================================================================
 841 __attribute__((noreturn)) __attribute__((format(printf, 1, 2)))
 842 void ufoFatal (const char *fmt, ...) {
 843   va_list ap;
 844   #ifndef WIN32
 845   ufoDisableRaw();
 846   #endif
 847   va_start(ap, fmt);
 848   ufoErrorMsgV("ERROR", fmt, ap);
 849   if (!ufoInBacktrace) {
 850     ufoInBacktrace = 1;
 851     ufoBacktrace(ufoIP, 1);
 852     ufoInBacktrace = 0;
 853   } else {
 854     fprintf(stderr, "DOUBLE FATAL: error in backtrace!\n");
 855     abort();
 856   }
 857   #ifdef UFO_DEBUG_FATAL_ABORT
 858   abort();
 859   #endif
 860   // allow restart
 861   ufoInRunWord = 0;
 862   ufoVMAbort = 0;
 863   ufoVMStop = 0;
 864   ufoFatalError();
 865 }
 866
 867
 868 // ////////////////////////////////////////////////////////////////////////// //
 869 // working with the stacks
 870 UFO_FORCE_INLINE void ufoPush (uint32_t v) { if (ufoSP >= UFO_DSTACK_SIZE) ufoFatal("data stack overflow"); ufoDStack[ufoSP++] = v; }
 871 UFO_FORCE_INLINE void ufoDrop (void) { if (ufoSP == 0) ufoFatal("data stack underflow"); --ufoSP; }
 872 UFO_FORCE_INLINE uint32_t ufoPop (void) { if (ufoSP == 0) { ufoFatal("data stack underflow"); } return ufoDStack[--ufoSP]; }
 873 UFO_FORCE_INLINE uint32_t ufoPeek (void) { if (ufoSP == 0) ufoFatal("data stack underflow"); return ufoDStack[ufoSP-1u]; }
 874 UFO_FORCE_INLINE void ufoDup (void) { if (ufoSP == 0) ufoFatal("data stack underflow"); ufoPush(ufoDStack[ufoSP-1u]); }
 875 UFO_FORCE_INLINE void ufoOver (void) { if (ufoSP < 2u) ufoFatal("data stack underflow"); ufoPush(ufoDStack[ufoSP-2u]); }
 876 UFO_FORCE_INLINE void ufoSwap (void) { if (ufoSP < 2u) ufoFatal("data stack underflow"); const uint32_t t = ufoDStack[ufoSP-1u]; ufoDStack[ufoSP-1u] = ufoDStack[ufoSP-2u]; ufoDStack[ufoSP-2u] = t; }
 877 UFO_FORCE_INLINE void ufoRot (void) { if (ufoSP < 3u) ufoFatal("data stack underflow"); const uint32_t t = ufoDStack[ufoSP-3u]; ufoDStack[ufoSP-3u] = ufoDStack[ufoSP-2u]; ufoDStack[ufoSP-2u] = ufoDStack[ufoSP-1u]; ufoDStack[ufoSP-1u] = t; }
 878 UFO_FORCE_INLINE void ufoNRot (void) { if (ufoSP < 3u) ufoFatal("data stack underflow"); const uint32_t t = ufoDStack[ufoSP-1u]; ufoDStack[ufoSP-1u] = ufoDStack[ufoSP-2u]; ufoDStack[ufoSP-2u] = ufoDStack[ufoSP-3u]; ufoDStack[ufoSP-3u] = t; }
 879
 880 UFO_FORCE_INLINE void ufo2Dup (void) { ufoOver(); ufoOver(); }
 881 UFO_FORCE_INLINE void ufo2Drop (void) { ufoDrop(); ufoDrop(); }
 882 UFO_FORCE_INLINE void ufo2Over (void) { if (ufoSP < 4u) ufoFatal("data stack underflow"); const uint32_t n0 = ufoDStack[ufoSP-4u]; const uint32_t n1 = ufoDStack[ufoSP-3u]; ufoPush(n0); ufoPush(n1); }
 883 UFO_FORCE_INLINE void ufo2Swap (void) { if (ufoSP < 4u) ufoFatal("data stack underflow"); const uint32_t n0 = ufoDStack[ufoSP-4u]; const uint32_t n1 = ufoDStack[ufoSP-3u]; ufoDStack[ufoSP-4u] = ufoDStack[ufoSP-2u]; ufoDStack[ufoSP-3u] = ufoDStack[ufoSP-1u]; ufoDStack[ufoSP-2u] = n0; ufoDStack[ufoSP-1u] = n1; }
 884
 885 UFO_FORCE_INLINE void ufoRPush (uint32_t v) { if (ufoRP >= UFO_RSTACK_SIZE) ufoFatal("return stack overflow"); ufoRStack[ufoRP++] = v; }
 886 UFO_FORCE_INLINE void ufoRDrop (void) { if (ufoRP == 0 || ufoRP == ufoRPTop) ufoFatal("return stack underflow"); --ufoRP; }
 887 UFO_FORCE_INLINE uint32_t ufoRPop (void) { if (ufoRP == 0 || ufoRP == ufoRPTop) ufoFatal("return stack underflow"); return ufoRStack[--ufoRP]; }
 888 UFO_FORCE_INLINE uint32_t ufoRPeek (void) { if (ufoRP == 0 || ufoRP == ufoRPTop) ufoFatal("return stack underflow"); return ufoRStack[ufoRP-1u]; }
 889 UFO_FORCE_INLINE void ufoRDup (void) { if (ufoRP == 0 || ufoRP == ufoRPTop) ufoFatal("return stack underflow"); ufoPush(ufoRStack[ufoRP-1u]); }
 890
 891 UFO_FORCE_INLINE void ufoPushBool (int v) { ufoPush(v ? ufoTrueValue : 0u); }
 892
 893
 894 //==========================================================================
 895 //
 896 //  ufoImgEnsureSize
 897 //
 898 //==========================================================================
 899 static void ufoImgEnsureSize (uint32_t addr) {
 900   if ((addr & UFO_ADDR_SPECIAL_BITS_MASK) != 0) ufoFatal("ufoImgEnsureSize: internal error");
 901   if (addr >= ufoImageSize) {
 902     // 64MB should be enough for everyone!
 903     if (addr >= 0x04000000U) {
 904       ufoFatal("image grown too big (addr=0%08XH)", addr);
 905     }
 906     const uint32_t osz = ufoImageSize;
 907     // grow by 1MB steps
 908     const uint32_t nsz = (addr|0x000fffffU) + 1U;
 909     ufo_assert(nsz > addr);
 910     uint32_t *nimg = realloc(ufoImage, nsz);
 911     if (nimg == NULL) {
 912       ufoFatal("out of memory for UFO image (%u -> %u MBs)",
 913                ufoImageSize / 1024u / 1024u,
 914                nsz / 1024u / 1024u);
 915     }
 916     ufoImage = nimg;
 917     ufoImageSize = nsz;
 918     memset((char *)ufoImage + osz, 0, (nsz - osz));
 919   }
 920 }
 921
 922
 923 //==========================================================================
 924 //
 925 //  ufoImgEnsureTemp
 926 //
 927 //==========================================================================
 928 static void ufoImgEnsureTemp (uint32_t addr) {
 929   if ((addr & UFO_ADDR_SPECIAL_BITS_MASK) != 0) ufoFatal("ufoImgEnsureTemp: internal error");
 930   if (addr >= ufoImageTempSize) {
 931     if (addr >= 1024u * 1024u) {
 932       ufoFatal("Forth segmentation fault at address 0x%08X", addr | UFO_ADDR_TEMP_BIT);
 933     }
 934     const uint32_t osz = ufoImageTempSize;
 935     // grow by 8KB steps
 936     const uint32_t nsz = (addr|0x00001fffU) + 1U;
 937     uint32_t *nimg = realloc(ufoImageTemp, nsz);
 938     if (nimg == NULL) {
 939       ufoFatal("out of memory for temp UFO image (%u -> %u KBs)",
 940                ufoImageTempSize / 1024u,
 941                nsz / 1024u);
 942     }
 943     ufoImageTemp = nimg;
 944     ufoImageTempSize = nsz;
 945     memset((char *)ufoImageTemp + osz, 0, (nsz - osz));
 946   }
 947 }
 948
 949
 950 #ifdef UFO_FAST_MEM_ACCESS
 951 //==========================================================================
 952 //
 953 //  ufoImgPutU8
 954 //
 955 //  fast
 956 //
 957 //==========================================================================
 958 UFO_FORCE_INLINE void ufoImgPutU8 (uint32_t addr, const uint32_t value) {
 959   if ((addr & UFO_ADDR_SPECIAL_BITS_MASK) == 0) {
 960     if (addr >= ufoImageSize) ufoImgEnsureSize(addr);
 961     *((uint8_t *)ufoImage + addr) = (uint8_t)value;
 962   } else if (addr & UFO_ADDR_TEMP_BIT) {
 963     addr &= UFO_ADDR_TEMP_MASK;
 964     if (addr >= ufoImageTempSize) ufoImgEnsureTemp(addr);
 965     *((uint8_t *)ufoImageTemp + addr) = (uint8_t)value;
 966   } else {
 967     ufoFatal("Forth segmentation fault at address 0x%08X", addr);
 968   }
 969 }
 970
 971
 972 //==========================================================================
 973 //
 974 //  ufoImgPutU16
 975 //
 976 //  fast
 977 //
 978 //==========================================================================
 979 UFO_FORCE_INLINE void ufoImgPutU16 (uint32_t addr, const uint32_t value) {
 980   if ((addr & UFO_ADDR_SPECIAL_BITS_MASK) == 0) {
 981     if (addr + 1u >= ufoImageSize) ufoImgEnsureSize(addr + 1u);
 982     *(uint16_t *)((uint8_t *)ufoImage + addr) = (uint16_t)value;
 983   } else if (addr & UFO_ADDR_TEMP_BIT) {
 984     addr &= UFO_ADDR_TEMP_MASK;
 985     if (addr + 1u >= ufoImageTempSize) ufoImgEnsureTemp(addr + 1u);
 986     *(uint16_t *)((uint8_t *)ufoImageTemp + addr) = (uint16_t)value;
 987   } else {
 988     ufoFatal("Forth segmentation fault at address 0x%08X", addr);
 989   }
 990 }
 991
 992
 993 //==========================================================================
 994 //
 995 //  ufoImgPutU32
 996 //
 997 //  fast
 998 //
 999 //==========================================================================
1000 UFO_FORCE_INLINE void ufoImgPutU32 (uint32_t addr, const uint32_t value) {
1001   if ((addr & UFO_ADDR_SPECIAL_BITS_MASK) == 0) {
1002     if (addr + 3u >= ufoImageSize) ufoImgEnsureSize(addr + 3u);
1003     *(uint32_t *)((uint8_t *)ufoImage + addr) = value;
1004   } else if (addr & UFO_ADDR_TEMP_BIT) {
1005     addr &= UFO_ADDR_TEMP_MASK;
1006     if (addr + 3u >= ufoImageTempSize) ufoImgEnsureTemp(addr + 3u);
1007     *(uint32_t *)((uint8_t *)ufoImageTemp + addr) = value;
1008   } else {
1009     ufoFatal("Forth segmentation fault at address 0x%08X", addr);
1010   }
1011 }
1012
1013
1014 //==========================================================================
1015 //
1016 //  ufoImgGetU8
1017 //
1018 //  false
1019 //
1020 //==========================================================================
1021 UFO_FORCE_INLINE uint32_t ufoImgGetU8 (uint32_t addr) {
1022   if ((addr & UFO_ADDR_SPECIAL_BITS_MASK) == 0) {
1023     if (addr >= ufoImageSize) {
1024       // accessing unallocated image area is segmentation fault
1025       ufoFatal("Forth segmentation fault (unallocated access) at address 0x%08X", addr);
1026     }
1027     return *((const uint8_t *)ufoImage + addr);
1028   } else if (addr & UFO_ADDR_TEMP_BIT) {
1029     addr &= UFO_ADDR_TEMP_MASK;
1030     if (addr >= ufoImageTempSize) {
1031       // accessing unallocated image area is segmentation fault
1032       ufoFatal("Forth segmentation fault (unallocated access) at address 0x%08X", addr | UFO_ADDR_TEMP_BIT);
1033     }
1034     return *((const uint8_t *)ufoImageTemp + addr);
1035   } else {
1036     ufoFatal("Forth segmentation fault at address 0x%08X", addr);
1037   }
1038 }
1039
1040
1041 //==========================================================================
1042 //
1043 //  ufoImgGetU16
1044 //
1045 //  fast
1046 //
1047 //==========================================================================
1048 UFO_FORCE_INLINE uint32_t ufoImgGetU16 (uint32_t addr) {
1049   if ((addr & UFO_ADDR_SPECIAL_BITS_MASK) == 0) {
1050     if (addr + 1u >= ufoImageSize) {
1051       // accessing unallocated image area is segmentation fault
1052       ufoFatal("Forth segmentation fault (unallocated access) at address 0x%08X", addr);
1053     }
1054     return *(const uint16_t *)((const uint8_t *)ufoImage + addr);
1055   } else if (addr & UFO_ADDR_TEMP_BIT) {
1056     addr &= UFO_ADDR_TEMP_MASK;
1057     if (addr + 1u >= ufoImageTempSize) {
1058       // accessing unallocated image area is segmentation fault
1059       ufoFatal("Forth segmentation fault (unallocated access) at address 0x%08X", addr | UFO_ADDR_TEMP_BIT);
1060     }
1061     return *(const uint16_t *)((const uint8_t *)ufoImageTemp + addr);
1062   } else {
1063     ufoFatal("Forth segmentation fault at address 0x%08X", addr);
1064   }
1065 }
1066
1067
1068 //==========================================================================
1069 //
1070 //  ufoImgGetU32
1071 //
1072 //  fast
1073 //
1074 //==========================================================================
1075 UFO_FORCE_INLINE uint32_t ufoImgGetU32 (uint32_t addr) {
1076   if ((addr & UFO_ADDR_SPECIAL_BITS_MASK) == 0) {
1077     if (addr + 3u >= ufoImageSize) {
1078       // accessing unallocated image area is segmentation fault
1079       ufoFatal("Forth segmentation fault (unallocated access) at address 0x%08X", addr);
1080     }
1081     return *(const uint32_t *)((const uint8_t *)ufoImage + addr);
1082   } else if (addr & UFO_ADDR_TEMP_BIT) {
1083     addr &= UFO_ADDR_TEMP_MASK;
1084     if (addr + 3u >= ufoImageTempSize) {
1085       // accessing unallocated image area is segmentation fault
1086       ufoFatal("Forth segmentation fault (unallocated access) at address 0x%08X", addr | UFO_ADDR_TEMP_BIT);
1087     }
1088     return *(const uint32_t *)((const uint8_t *)ufoImageTemp + addr);
1089   } else {
1090     ufoFatal("Forth segmentation fault at address 0x%08X", addr);
1091   }
1092 }
1093
1094 #else
1095
1096 //==========================================================================
1097 //
1098 //  ufoImgPutU8
1099 //
1100 //  general
1101 //
1102 //==========================================================================
1103 UFO_FORCE_INLINE void ufoImgPutU8 (uint32_t addr, const uint32_t value) {
1104   uint32_t *imgptr;
1105   if ((addr & UFO_ADDR_SPECIAL_BITS_MASK) == 0) {
1106     if (addr >= ufoImageSize) ufoImgEnsureSize(addr);
1107     imgptr = &ufoImage[addr/4u];
1108   } else if (addr & UFO_ADDR_TEMP_BIT) {
1109     addr &= UFO_ADDR_TEMP_MASK;
1110     if (addr >= ufoImageTempSize) ufoImgEnsureTemp(addr);
1111     imgptr = &ufoImageTemp[addr/4u];
1112   } else {
1113     ufoFatal("Forth segmentation fault at address 0x%08X", addr);
1114   }
1115   const uint8_t val = (uint8_t)value;
1116   memcpy((uint8_t *)imgptr + (addr&3), &val, 1);
1117 }
1118
1119
1120 //==========================================================================
1121 //
1122 //  ufoImgPutU16
1123 //
1124 //  general
1125 //
1126 //==========================================================================
1127 UFO_FORCE_INLINE void ufoImgPutU16 (uint32_t addr, const uint32_t value) {
1128   ufoImgPutU8(addr, value&0xffU);
1129   ufoImgPutU8(addr + 1u, (value>>8)&0xffU);
1130 }
1131
1132
1133 //==========================================================================
1134 //
1135 //  ufoImgPutU32
1136 //
1137 //  general
1138 //
1139 //==========================================================================
1140 UFO_FORCE_INLINE void ufoImgPutU32 (uint32_t addr, const uint32_t value) {
1141   ufoImgPutU16(addr, value&0xffffU);
1142   ufoImgPutU16(addr + 2u, (value>>16)&0xffffU);
1143 }
1144
1145
1146 //==========================================================================
1147 //
1148 //  ufoImgGetU8
1149 //
1150 //  general
1151 //
1152 //==========================================================================
1153 UFO_FORCE_INLINE uint32_t ufoImgGetU8 (uint32_t addr) {
1154   uint32_t *imgptr;
1155   if ((addr & UFO_ADDR_SPECIAL_BITS_MASK) == 0) {
1156     if (addr >= ufoImageSize) return 0;
1157     imgptr = &ufoImage[addr/4u];
1158   } else if (addr & UFO_ADDR_TEMP_BIT) {
1159     addr &= UFO_ADDR_TEMP_MASK;
1160     if (addr >= ufoImageTempSize) return 0;
1161     imgptr = &ufoImageTemp[addr/4u];
1162   } else {
1163     ufoFatal("Forth segmentation fault at address 0x%08X", addr);
1164   }
1165   uint8_t val;
1166   memcpy(&val, (uint8_t *)imgptr + (addr&3), 1);
1167   return (uint32_t)val;
1168 }
1169
1170
1171 //==========================================================================
1172 //
1173 //  ufoImgGetU16
1174 //
1175 //  general
1176 //
1177 //==========================================================================
1178 UFO_FORCE_INLINE uint32_t ufoImgGetU16 (uint32_t addr) {
1179   return ufoImgGetU8(addr) | (ufoImgGetU8(addr + 1u) << 8);
1180 }
1181
1182
1183 //==========================================================================
1184 //
1185 //  ufoImgGetU32
1186 //
1187 //  general
1188 //
1189 //==========================================================================
1190 UFO_FORCE_INLINE uint32_t ufoImgGetU32 (uint32_t addr) {
1191   return ufoImgGetU16(addr) | (ufoImgGetU16(addr + 2u) << 16);
1192 }
1193 #endif
1194
1195
1196 //==========================================================================
1197 //
1198 //  ufoEnsureDebugSize
1199 //
1200 //==========================================================================
1201 UFO_DISABLE_INLINE void ufoEnsureDebugSize (uint32_t sdelta) {
1202   ufo_assert(sdelta != 0);
1203   if (ufoDebugImageSize != 0) {
1204     if (ufoDebugImageUsed + sdelta >= 0x40000000U) ufoFatal("debug info too big");
1205     if (ufoDebugImageUsed + sdelta > ufoDebugImageSize) {
1206       // grow by 32KB, this should be more than enough
1207       const uint32_t newsz = ((ufoDebugImageUsed + sdelta) | 0x7fffU) + 1u;
1208       uint8_t *ndb = realloc(ufoDebugImage, newsz);
1209       if (ndb == NULL) ufoFatal("out of memory for debug info");
1210       ufoDebugImage = ndb;
1211       ufoDebugImageSize = newsz;
1212     }
1213   } else {
1214     // initial allocation: 32KB, quite a lot
1215     ufo_assert(ufoDebugImage == NULL);
1216     ufo_assert(ufoDebugImageUsed == 0);
1217     ufoDebugImageSize = 1024 * 32;
1218     ufoDebugImage = malloc(ufoDebugImageSize);
1219     if (ufoDebugImage == NULL) ufoFatal("out of memory for debug info");
1220   }
1221 }
1222
1223
1224 #define UFO_DBG_PUT_U4(val_)  do { \
1225   const uint32_t vv_ = (val_); \
1226   *((uint32_t *)(ufoDebugImage + ufoDebugImageUsed)) = vv_; \
1227   ufoDebugImageUsed += 4u; \
1228 } while (0)
1229
1230
1231 /*
1232   debug info header:
1233     dd lastFileInfoOfs
1234     ...first line info header...
1235   line info header (or reset):
1236     db 0   ; zero line delta
1237     dw followFileInfoSize  ; either it, or 0 if reused
1238     dd fileInfoOfs         ; present only if reused
1239   lines:
1240     dv lineDelta
1241     dv pcBytes
1242
1243   file info record:
1244     dd prevFileInfoOfs
1245     dd fileNameHash
1246     dd nameLen  ; without terminating 0
1247     ...name... (0-terminated)
1248
1249   we will never compare file names: length and hash should provide
1250   good enough unique identifier.
1251
1252 static uint8_t *ufoDebugImage = NULL;
1253 static uint32_t ufoDebugImageUsed = 0; // in bytes
1254 static uint32_t ufoDebugImageSize = 0; // in bytes
1255 static uint32_t ufoDebugFileNameHash = 0; // current file name hash
1256 static uint32_t ufoDebugFileNameLen = 0; // current file name length
1257 static uint32_t ufoDebugCurrDP = 0;
1258 */
1259
1260
1261 //==========================================================================
1262 //
1263 //  ufoSkipDebugVarInt
1264 //
1265 //==========================================================================
1266 static __attribute__((unused)) uint32_t ufoSkipDebugVarInt (uint32_t ofs) {
1267   uint8_t byte;
1268   do {
1269     if (ofs >= ufoDebugImageUsed) ufoFatal("invalid debug data");
1270     byte = ufoDebugImage[ofs]; ofs += 1u;
1271   } while (byte >= 0x80);
1272   return ofs;
1273 }
1274
1275
1276 //==========================================================================
1277 //
1278 //  ufoCalcDebugVarIntSize
1279 //
1280 //==========================================================================
1281 UFO_FORCE_INLINE uint8_t ufoCalcDebugVarIntSize (uint32_t v) {
1282   uint8_t count = 0;
1283   do {
1284     count += 1u;
1285     v >>= 7;
1286   } while (v != 0);
1287   return count;
1288 }
1289
1290
1291 //==========================================================================
1292 //
1293 //  ufoGetDebugVarInt
1294 //
1295 //==========================================================================
1296 static __attribute__((unused)) uint32_t ufoGetDebugVarInt (uint32_t ofs) {
1297   uint32_t v = 0;
1298   uint8_t shift = 0;
1299   uint8_t byte;
1300   do {
1301     if (ofs >= ufoDebugImageUsed) ufoFatal("invalid debug data");
1302     byte = ufoDebugImage[ofs];
1303     v |= (uint32_t)(byte & 0x7f) << shift;
1304     if (byte >= 0x80) {
1305       shift += 7;
1306       ofs += 1u;
1307     }
1308   } while (byte >= 0x80);
1309   return v;
1310 }
1311
1312
1313 //==========================================================================
1314 //
1315 //  ufoPutDebugVarInt
1316 //
1317 //==========================================================================
1318 UFO_FORCE_INLINE void ufoPutDebugVarInt (uint32_t v) {
1319   ufoEnsureDebugSize(5u); // maximum size
1320   do {
1321     if (v >= 0x80) {
1322       ufoDebugImage[ufoDebugImageUsed] = (uint8_t)(v | 0x80u);
1323     } else {
1324       ufoDebugImage[ufoDebugImageUsed] = (uint8_t)v;
1325     }
1326     ufoDebugImageUsed += 1;
1327     v >>= 7;
1328   } while (v != 0);
1329 }
1330
1331
1332 #ifdef UFO_DEBUG_DEBUG
1333 //==========================================================================
1334 //
1335 //  ufoDumpDebugInfo
1336 //
1337 //==========================================================================
1338 static void ufoDumpDebugImage (void) {
1339   #if 0
1340   uint32_t dbgpos = 4u; // first line header info
1341   uint32_t lastline = 0;
1342   uint32_t lastdp = 0;
1343   while (dbgpos < ufoDebugImageUsed) {
1344     if (ufoDebugImage[dbgpos] == 0) {
1345       // new file info
1346       dbgpos += 1u; // skip flag
1347       const uint32_t fhdrSize = *(const uint16_t *)(ufoDebugImage + dbgpos); dbgpos += 2u;
1348       lastdp = ufoGetDebugVarInt(dbgpos);
1349       dbgpos = ufoSkipDebugVarInt(dbgpos);
1350       if (fhdrSize == 0) {
1351         // reused
1352         const uint32_t infoOfs = *(const uint32_t *)(ufoDebugImage + dbgpos); dbgpos += 4u;
1353         fprintf(stderr, "*** OLD FILE: %s\n", (const char *)(ufoDebugImage + infoOfs + 3u * 4u));
1354         fprintf(stderr, "FILE NAME LEN: %u\n", ((const uint32_t *)(ufoDebugImage + infoOfs))[2]);
1355         fprintf(stderr, "FILE NAME HASH: 0x%08x\n", ((const uint32_t *)(ufoDebugImage + infoOfs))[1]);
1356       } else {
1357         // new
1358         fprintf(stderr, "*** NEW FILE: %s\n", (const char *)(ufoDebugImage + dbgpos + 3u * 4u));
1359         fprintf(stderr, "FILE NAME LEN: %u\n", ((const uint32_t *)(ufoDebugImage + dbgpos))[2]);
1360         fprintf(stderr, "FILE NAME HASH: 0x%08x\n", ((const uint32_t *)(ufoDebugImage + dbgpos))[1]);
1361       }
1362       dbgpos += fhdrSize;
1363       fprintf(stderr, "LINES-OFS: 0x%08x (hsz: %u -- 0x%08x)\n", dbgpos, fhdrSize, fhdrSize);
1364       lastline = ~(uint32_t)0;
1365     } else {
1366       const uint32_t ln = ufoGetDebugVarInt(dbgpos);
1367       dbgpos = ufoSkipDebugVarInt(dbgpos);
1368       ufo_assert(ln != 0);
1369       lastline += ln;
1370       const uint32_t edp = ufoGetDebugVarInt(dbgpos);
1371       dbgpos = ufoSkipDebugVarInt(dbgpos);
1372       lastdp += edp;
1373       fprintf(stderr, "  line %6u: edp=%u\n", lastline, lastdp);
1374     }
1375   }
1376   #endif
1377 }
1378 #endif
1379
1380
1381 //==========================================================================
1382 //
1383 //  ufoRecordDebugCheckFile
1384 //
1385 //  if we moved to the new file:
1386 //    put "line info header"
1387 //    put new file info (or reuse old)
1388 //
1389 //==========================================================================
1390 UFO_FORCE_INLINE void ufoRecordDebugCheckFile (void) {
1391   if (ufoDebugImageUsed == 0 ||
1392       ufoDebugFileNameLen != ufoInFileNameLen ||
1393       ufoDebugFileNameHash != ufoInFileNameHash)
1394   {
1395     // new file record (or reuse old one)
1396     const int initial = (ufoDebugImageUsed == 0);
1397     uint32_t fileRec = 0;
1398     // try to find and old one
1399     if (!initial) {
1400       fileRec = *(const uint32_t *)ufoDebugImage;
1401       #if 0
1402       fprintf(stderr, "*** NEW-FILE(%u): 0x%08x: <%s> (frec=0x%08x)\n", ufoInFileNameLen,
1403               ufoInFileNameHash, ufoInFileName, fileRec);
1404       #endif
1405       while (fileRec != 0 &&
1406              (ufoInFileNameLen != ((const uint32_t *)(ufoDebugImage + fileRec))[1] ||
1407               ufoInFileNameHash != ((const uint32_t *)(ufoDebugImage + fileRec))[2]))
1408       {
1409         #if 0
1410         fprintf(stderr, "*** FRCHECK: 0x%08x\n", fileRec);
1411         fprintf(stderr, "  FILE NAME: %s\n", (const char *)(ufoDebugImage + fileRec + 3u * 4u));
1412         fprintf(stderr, "  FILE NAME LEN: %u\n", ((const uint32_t *)(ufoDebugImage + fileRec))[2]);
1413         fprintf(stderr, "  FILE NAME HASH: 0x%08x\n", ((const uint32_t *)(ufoDebugImage + fileRec))[1]);
1414         fprintf(stderr, "  FILE PREV: 0x%08x\n", *(const uint32_t *)(ufoDebugImage + fileRec));
1415         #endif
1416         fileRec = *(const uint32_t *)(ufoDebugImage + fileRec);
1417       }
1418       #if 0
1419       fprintf(stderr, "*** FRCHECK-DONE: 0x%08x\n", fileRec);
1420       if (fileRec != 0) {
1421         fprintf(stderr, "    FILE NAME: %s\n", (const char *)(ufoDebugImage + fileRec + 3u * 4u));
1422         fprintf(stderr, "    FILE NAME LEN: %u\n", ((const uint32_t *)(ufoDebugImage + fileRec))[2]);
1423         fprintf(stderr, "    FILE NAME HASH: 0x%08x\n", ((const uint32_t *)(ufoDebugImage + fileRec))[1]);
1424         fprintf(stderr, "    FILE PREV: 0x%08x\n", *(const uint32_t *)(ufoDebugImage + fileRec));
1425       }
1426       #endif
1427     } else {
1428       ufoEnsureDebugSize(8u);
1429       *(uint32_t *)ufoDebugImage = 0;
1430     }
1431     // write "line info header"
1432     if (fileRec != 0) {
1433       ufoEnsureDebugSize(32u);
1434       ufoDebugImage[ufoDebugImageUsed] = 0; ufoDebugImageUsed += 1u; // header flag (0 delta)
1435       // file record size: 0 (reused)
1436       *((uint16_t *)(ufoDebugImage + ufoDebugImageUsed)) = 0; ufoDebugImageUsed += 2u;
1437       // put last DP
1438       ufoPutDebugVarInt(ufoDebugCurrDP);
1439       // file info offset
1440       UFO_DBG_PUT_U4(fileRec);
1441     } else {
1442       // name, trailing 0 byte, 3 dword fields
1443       const uint32_t finfoSize = ufoInFileNameLen + 1u + 3u * 4u;
1444       ufo_assert(finfoSize < 65536u);
1445       ufoEnsureDebugSize(finfoSize + 32u);
1446       if (initial) {
1447         *(uint32_t *)ufoDebugImage = 0;
1448         ufoDebugImageUsed = 4;
1449       }
1450       ufoDebugImage[ufoDebugImageUsed] = 0; ufoDebugImageUsed += 1u; // header flag (0 delta)
1451       // file record size
1452       *((uint16_t *)(ufoDebugImage + ufoDebugImageUsed)) = (uint16_t)finfoSize; ufoDebugImageUsed += 2u;
1453       // put last DP
1454       ufoPutDebugVarInt(ufoDebugCurrDP);
1455       // file record follows
1456       // fix file info offsets
1457       uint32_t lastOfs = *(const uint32_t *)ufoDebugImage;
1458       *(uint32_t *)ufoDebugImage = ufoDebugImageUsed;
1459       UFO_DBG_PUT_U4(lastOfs);
1460       // save file info hash
1461       UFO_DBG_PUT_U4(ufoInFileNameHash);
1462       // save file info length
1463       UFO_DBG_PUT_U4(ufoInFileNameLen);
1464       // save file name
1465       if (ufoInFileNameLen != 0) {
1466         memcpy(ufoDebugImage + ufoDebugImageUsed, ufoInFileName, ufoInFileNameLen + 1u);
1467         ufoDebugImageUsed += ufoInFileNameLen + 1u;
1468       } else {
1469         ufoDebugImage[ufoDebugImageUsed] = 0; ufoDebugImageUsed += 1u;
1470       }
1471     }
1472     ufoDebugFileNameLen = ufoInFileNameLen;
1473     ufoDebugFileNameHash = ufoInFileNameHash;
1474     ufoDebugLastLine = ~(uint32_t)0;
1475     ufoDebugLastLinePCOfs = 0;
1476     ufoDebugLastLineDP = ufoDebugCurrDP;
1477   }
1478 }
1479
1480
1481 //==========================================================================
1482 //
1483 //  ufoRecordDebugRecordLine
1484 //
1485 //==========================================================================
1486 UFO_FORCE_INLINE void ufoRecordDebugRecordLine (uint32_t line, uint32_t newhere) {
1487   if (line == ufoDebugLastLine) {
1488     ufo_assert(ufoDebugLastLinePCOfs != 0);
1489     ufoDebugImageUsed = ufoDebugLastLinePCOfs;
1490   } else {
1491     #if 0
1492     fprintf(stderr, "FL-NEW-LINE(0x%08x): <%s>; new line: %u (old: %u)\n",
1493             ufoDebugImageUsed,
1494             ufoInFileName, line, ufoDebugLastLine);
1495     #endif
1496     ufoPutDebugVarInt(line - ufoDebugLastLine);
1497     ufoDebugLastLinePCOfs = ufoDebugImageUsed;
1498     ufoDebugLastLine = line;
1499     ufoDebugLastLineDP = ufoDebugCurrDP;
1500   }
1501   ufoPutDebugVarInt(newhere - ufoDebugLastLineDP);
1502   ufoDebugCurrDP = newhere;
1503 }
1504
1505
1506 //==========================================================================
1507 //
1508 //  ufoRecordDebug
1509 //
1510 //==========================================================================
1511 UFO_DISABLE_INLINE void ufoRecordDebug (uint32_t newhere) {
1512   if (newhere > ufoDebugCurrDP) {
1513     uint32_t ln = (uint32_t)ufoInFileLine;
1514     if (ln == ~(uint32_t)0) ln = 0;
1515     #if 0
1516     fprintf(stderr, "FL: <%s>; line: %d\n", ufoInFileName, ufoInFileLine);
1517     #endif
1518     ufoRecordDebugCheckFile();
1519     ufoRecordDebugRecordLine(ln, newhere);
1520   }
1521 }
1522
1523
1524 //==========================================================================
1525 //
1526 //  ufoGetWordEndAddrYFA
1527 //
1528 //==========================================================================
1529 static uint32_t ufoGetWordEndAddrYFA (uint32_t yfa) {
1530   if (yfa > 8u) {
1531     const uint32_t oyfa = yfa;
1532     yfa = ufoImgGetU32(yfa);
1533     if (yfa == 0) {
1534       if ((oyfa & UFO_ADDR_TEMP_BIT) == 0) {
1535         yfa = UFO_GET_DP();
1536         if ((yfa & UFO_ADDR_TEMP_BIT) != 0) {
1537           yfa = UFO_CFA_TO_PFA(UFO_NFA_TO_CFA(UFO_YFA_TO_NFA(oyfa)));
1538         }
1539       } else {
1540         yfa = UFO_CFA_TO_PFA(UFO_NFA_TO_CFA(UFO_YFA_TO_NFA(oyfa)));
1541       }
1542     } else {
1543       yfa = UFO_YFA_TO_WST(yfa);
1544     }
1545   } else {
1546     yfa = 0;
1547   }
1548   return yfa;
1549 }
1550
1551
1552 //==========================================================================
1553 //
1554 //  ufoGetWordEndAddr
1555 //
1556 //==========================================================================
1557 static uint32_t ufoGetWordEndAddr (const uint32_t cfa) {
1558   if (cfa != 0) {
1559     return ufoGetWordEndAddrYFA(UFO_LFA_TO_YFA(UFO_CFA_TO_LFA(cfa)));
1560   } else {
1561     return 0;
1562   }
1563 }
1564
1565
1566 //==========================================================================
1567 //
1568 //  ufoFindWordForIP
1569 //
1570 //  return NFA or 0
1571 //
1572 //  WARNING: this is SLOW!
1573 //
1574 //==========================================================================
1575 static uint32_t ufoFindWordForIP (const uint32_t ip) {
1576   uint32_t res = 0;
1577   if (ip != 0) {
1578     //fprintf(stderr, "ufoFindWordForIP:000: ip=0x%08x\n", ip);
1579     // iterate over all words
1580     uint32_t xfa = ufoImgGetU32(ufoAddrLastXFA);
1581     //fprintf(stderr, "ufoFindWordForIP:001: xfa=0x%08x\n", xfa);
1582     if (xfa != 0) {
1583       while (res == 0 && xfa != 0) {
1584         const uint32_t yfa = UFO_XFA_TO_YFA(xfa);
1585         const uint32_t wst = UFO_YFA_TO_WST(yfa);
1586         //fprintf(stderr, "ufoFindWordForIP:002:   yfa=0x%08x; wst=0x%08x\n", yfa, wst);
1587         const uint32_t wend = ufoGetWordEndAddrYFA(yfa);
1588         if (ip >= wst && ip < wend) {
1589           res = UFO_YFA_TO_NFA(yfa);
1590         } else {
1591           xfa = ufoImgGetU32(xfa);
1592         }
1593       }
1594     }
1595   }
1596   return res;
1597 }
1598
1599
1600 //==========================================================================
1601 //
1602 //  ufoFindFileForIP
1603 //
1604 //  return file name or `NULL`
1605 //
1606 //  WARNING: this is SLOW!
1607 //
1608 //==========================================================================
1609 static const char *ufoFindFileForIP (uint32_t ip, uint32_t *line,
1610                                      uint32_t *nlen, uint32_t *nhash)
1611 {
1612   if (ip != 0 && ufoDebugImageUsed != 0) {
1613     const char *filename = NULL;
1614     uint32_t dbgpos = 4u; // first line header info
1615     uint32_t lastline = 0;
1616     uint32_t lastdp = 0;
1617     uint32_t namelen = 0;
1618     uint32_t namehash = 0;
1619     while (dbgpos < ufoDebugImageUsed) {
1620       if (ufoDebugImage[dbgpos] == 0) {
1621         // new file info
1622         dbgpos += 1u; // skip flag
1623         const uint32_t fhdrSize = *(const uint16_t *)(ufoDebugImage + dbgpos); dbgpos += 2u;
1624         lastdp = ufoGetDebugVarInt(dbgpos);
1625         dbgpos = ufoSkipDebugVarInt(dbgpos);
1626         uint32_t infoOfs;
1627         if (fhdrSize == 0) {
1628           // reused
1629           infoOfs = *(const uint32_t *)(ufoDebugImage + dbgpos); dbgpos += 4u;
1630         } else {
1631           // new
1632           infoOfs = dbgpos;
1633         }
1634         filename = (const char *)(ufoDebugImage + infoOfs + 3u * 4u);
1635         namelen = ((const uint32_t *)(ufoDebugImage + infoOfs))[2];
1636         namehash = ((const uint32_t *)(ufoDebugImage + infoOfs))[1];
1637         if (filename[0] == 0) filename = NULL;
1638         dbgpos += fhdrSize;
1639         lastline = ~(uint32_t)0;
1640       } else {
1641         const uint32_t ln = ufoGetDebugVarInt(dbgpos);
1642         dbgpos = ufoSkipDebugVarInt(dbgpos);
1643         ufo_assert(ln != 0);
1644         lastline += ln;
1645         const uint32_t edp = ufoGetDebugVarInt(dbgpos);
1646         dbgpos = ufoSkipDebugVarInt(dbgpos);
1647         if (ip >= lastdp && ip < lastdp + edp) {
1648           if (line) *line = lastline;
1649           if (nlen) *nlen = namelen;
1650           if (nhash) *nhash = namehash;
1651           return filename;
1652         }
1653         lastdp += edp;
1654       }
1655     }
1656   }
1657   if (line) *line = 0;
1658   if (nlen) *nlen = 0;
1659   if (nhash) *nlen = 0;
1660   return NULL;
1661 }
1662
1663
1664 //==========================================================================
1665 //
1666 //  ufoBumpDP
1667 //
1668 //==========================================================================
1669 UFO_FORCE_INLINE void ufoBumpDP (uint32_t delta) {
1670   uint32_t dp = ufoImgGetU32(ufoAddrDPTemp);
1671   if (dp == 0) {
1672     dp = ufoImgGetU32(ufoAddrDP);
1673     if ((dp & UFO_ADDR_SPECIAL_BITS_MASK) == 0) ufoRecordDebug(dp + delta);
1674     dp += delta;
1675     ufoImgPutU32(ufoAddrDP, dp);
1676   } else {
1677     dp = ufoImgGetU32(ufoAddrDPTemp);
1678     if ((dp & UFO_ADDR_SPECIAL_BITS_MASK) == 0) ufoRecordDebug(dp + delta);
1679     dp += delta;
1680     ufoImgPutU32(ufoAddrDPTemp, dp);
1681   }
1682 }
1683
1684
1685 //==========================================================================
1686 //
1687 //  ufoImgEmitU8
1688 //
1689 //==========================================================================
1690 UFO_FORCE_INLINE void ufoImgEmitU8 (uint32_t value) {
1691   ufoImgPutU8(UFO_GET_DP(), value);
1692   ufoBumpDP(1);
1693 }
1694
1695
1696 //==========================================================================
1697 //
1698 //  ufoImgEmitU32
1699 //
1700 //==========================================================================
1701 UFO_FORCE_INLINE void ufoImgEmitU32 (uint32_t value) {
1702   ufoImgPutU32(UFO_GET_DP(), value);
1703   ufoBumpDP(4);
1704 }
1705
1706
1707 #ifdef UFO_FAST_MEM_ACCESS
1708
1709 //==========================================================================
1710 //
1711 //  ufoImgEmitU32_NoInline
1712 //
1713 //  false
1714 //
1715 //==========================================================================
1716 UFO_FORCE_INLINE void ufoImgEmitU32_NoInline (uint32_t value) {
1717   ufoImgPutU32(UFO_GET_DP(), value);
1718   ufoBumpDP(4);
1719 }
1720
1721 #else
1722
1723 //==========================================================================
1724 //
1725 //  ufoImgEmitU32_NoInline
1726 //
1727 //  general
1728 //
1729 //==========================================================================
1730 UFO_DISABLE_INLINE void ufoImgEmitU32_NoInline (uint32_t value) {
1731   ufoImgPutU32(UFO_GET_DP(), value);
1732   ufoBumpDP(4);
1733 }
1734
1735 #endif
1736
1737
1738 //==========================================================================
1739 //
1740 //  ufoImgGetU8Ext
1741 //
1742 //  this understands handle addresses
1743 //
1744 //==========================================================================
1745 UFO_FORCE_INLINE uint32_t ufoImgGetU8Ext (uint32_t addr) {
1746   if ((addr & UFO_ADDR_HANDLE_BIT) == 0) {
1747     return ufoImgGetU8(addr);
1748   } else {
1749     ufoPush(0);
1750     ufoPush(addr);
1751     UFCALL(PAR_HANDLE_LOAD_BYTE);
1752     return ufoPop();
1753   }
1754 }
1755
1756
1757 //==========================================================================
1758 //
1759 //  ufoImgPutU8Ext
1760 //
1761 //  this understands handle addresses
1762 //
1763 //==========================================================================
1764 UFO_FORCE_INLINE void ufoImgPutU8Ext (uint32_t addr, uint32_t value) {
1765   if ((addr & UFO_ADDR_HANDLE_BIT) == 0) {
1766     ufoImgPutU8(addr, value);
1767   } else {
1768     ufoPush(value);
1769     ufoPush(0);
1770     ufoPush(addr);
1771     UFCALL(PAR_HANDLE_STORE_BYTE);
1772   }
1773 }
1774
1775
1776 //==========================================================================
1777 //
1778 //  ufoImgEmitAlign
1779 //
1780 //==========================================================================
1781 UFO_FORCE_INLINE void ufoImgEmitAlign (void) {
1782   while ((UFO_GET_DP() & 3) != 0) ufoImgEmitU8(0);
1783 }
1784
1785
1786 //==========================================================================
1787 //
1788 //  ufoResetTib
1789 //
1790 //==========================================================================
1791 UFO_FORCE_INLINE void ufoResetTib (void) {
1792   uint32_t defTIB = ufoImgGetU32(ufoAddrDefTIB);
1793   //fprintf(stderr, "ufoResetTib(%p): defTIB=0x%08x\n", ufoCurrState, defTIB);
1794   if (defTIB == 0) {
1795     // create new TIB handle
1796     UfoHandle *tibh = ufoAllocHandle(0x69a029a6); // arbitrary number
1797     defTIB = tibh->ufoHandle;
1798     ufoImgPutU32(ufoAddrDefTIB, defTIB);
1799   }
1800   if ((defTIB & UFO_ADDR_HANDLE_BIT) != 0) {
1801     UfoHandle *hh = ufoGetHandle(defTIB);
1802     if (hh == NULL) ufoFatal("default TIB is not allocated");
1803     if (hh->size == 0) {
1804       ufo_assert(hh->data == NULL);
1805       hh->data = calloc(1, UFO_ADDR_HANDLE_OFS_MASK + 1);
1806       if (hh->data == NULL) ufoFatal("out of memory for default TIB");
1807       hh->size = UFO_ADDR_HANDLE_OFS_MASK + 1;
1808     }
1809   }
1810   const uint32_t oldA = ufoRegA;
1811   ufoImgPutU32(ufoAddrTIBx, defTIB);
1812   ufoImgPutU32(ufoAddrINx, 0);
1813   ufoRegA = defTIB;
1814   ufoPush(0); // value
1815   ufoPush(0); // offset
1816   UFCALL(CPOKE_REGA_IDX);
1817   ufoRegA = oldA;
1818 }
1819
1820
1821 //==========================================================================
1822 //
1823 //  ufoTibEnsureSize
1824 //
1825 //==========================================================================
1826 UFO_DISABLE_INLINE void ufoTibEnsureSize (uint32_t size) {
1827   if (size > 1024u * 1024u * 256u) ufoFatal("TIB size too big");
1828   const uint32_t tib = ufoImgGetU32(ufoAddrTIBx);
1829   //fprintf(stderr, "ufoTibEnsureSize: TIB=0x%08x; size=%u\n", tib, size);
1830   if ((tib & UFO_ADDR_HANDLE_BIT) != 0) {
1831     UfoHandle *hh = ufoGetHandle(tib);
1832     if (hh == NULL) {
1833       ufoFatal("cannot resize TIB, TIB is not a handle");
1834     }
1835     if (hh->size < size) {
1836       const uint32_t newsz = (size | 0xfffU) + 1u;
1837       uint8_t *nx = realloc(hh->data, newsz);
1838       if (nx == NULL) ufoFatal("out of memory for restored TIB");
1839       hh->data = nx;
1840       hh->size = newsz;
1841     }
1842   }
1843   #if 0
1844   else {
1845     ufoFatal("cannot resize TIB, TIB is not a handle (0x%08x)", tib);
1846   }
1847   #endif
1848 }
1849
1850
1851 //==========================================================================
1852 //
1853 //  ufoTibGetSize
1854 //
1855 //==========================================================================
1856 /*
1857 UFO_DISABLE_INLINE uint32_t ufoTibGetSize (void) {
1858   const uint32_t tib = ufoImgGetU32(ufoAddrTIBx);
1859   if ((tib & UFO_ADDR_HANDLE_BIT) == 0) {
1860     ufoFatal("cannot query TIB, TIB is not a handle");
1861   }
1862   UfoHandle *hh = ufoGetHandle(tib);
1863   if (hh == NULL) {
1864     ufoFatal("cannot query TIB, TIB is not a handle");
1865   }
1866   return hh->size;
1867 }
1868 */
1869
1870
1871 //==========================================================================
1872 //
1873 //  ufoTibPeekCh
1874 //
1875 //==========================================================================
1876 UFO_FORCE_INLINE uint8_t ufoTibPeekCh (void) {
1877   return (uint8_t)ufoImgGetU8Ext(ufoImgGetU32(ufoAddrTIBx) + ufoImgGetU32(ufoAddrINx));
1878 }
1879
1880
1881 //==========================================================================
1882 //
1883 //  ufoTibPeekChOfs
1884 //
1885 //==========================================================================
1886 UFO_FORCE_INLINE uint8_t ufoTibPeekChOfs (uint32_t ofs) {
1887   const uint32_t tib = ufoImgGetU32(ufoAddrTIBx);
1888   if (ofs <= UFO_ADDR_HANDLE_OFS_MASK || (tib & UFO_ADDR_HANDLE_BIT) == 0) {
1889     return (uint8_t)ufoImgGetU8Ext(tib + ufoImgGetU32(ufoAddrINx) + ofs);
1890   } else {
1891     return 0;
1892   }
1893 }
1894
1895
1896 //==========================================================================
1897 //
1898 //  ufoTibPokeChOfs
1899 //
1900 //==========================================================================
1901 UFO_DISABLE_INLINE void ufoTibPokeChOfs (uint8_t ch, uint32_t ofs) {
1902   const uint32_t oldA = ufoRegA;
1903   ufoRegA = ufoImgGetU32(ufoAddrTIBx);
1904   ufoPush(ch);
1905   ufoPush(ufoImgGetU32(ufoAddrINx) + ofs);
1906   UFCALL(CPOKE_REGA_IDX);
1907   ufoRegA = oldA;
1908 }
1909
1910
1911 //==========================================================================
1912 //
1913 //  ufoTibGetCh
1914 //
1915 //==========================================================================
1916 UFO_FORCE_INLINE uint8_t ufoTibGetCh (void) {
1917   const uint8_t ch = ufoTibPeekCh();
1918   if (ch) ufoImgPutU32(ufoAddrINx, ufoImgGetU32(ufoAddrINx) + 1u);
1919   return ch;
1920 }
1921
1922
1923 //==========================================================================
1924 //
1925 //  ufoTibSkipCh
1926 //
1927 //==========================================================================
1928 UFO_FORCE_INLINE void ufoTibSkipCh (void) {
1929   (void)ufoTibGetCh();
1930 }
1931
1932
1933 // ////////////////////////////////////////////////////////////////////////// //
1934 // native CFA implementations
1935 //
1936
1937 //==========================================================================
1938 //
1939 //  ufoDoForth
1940 //
1941 //==========================================================================
1942 static void ufoDoForth (uint32_t pfa) {
1943   ufoRPush(ufoIP);
1944   ufoIP = pfa;
1945 }
1946
1947
1948 //==========================================================================
1949 //
1950 //  ufoDoVariable
1951 //
1952 //==========================================================================
1953 static void ufoDoVariable (uint32_t pfa) {
1954   ufoPush(pfa);
1955 }
1956
1957
1958 //==========================================================================
1959 //
1960 //  ufoDoUserVariable
1961 //
1962 //==========================================================================
1963 static void ufoDoUserVariable (uint32_t pfa) {
1964   ufoPush(ufoImgGetU32(pfa));
1965 }
1966
1967
1968 //==========================================================================
1969 //
1970 //  ufoDoValue
1971 //
1972 //==========================================================================
1973 static void ufoDoValue (uint32_t pfa) {
1974   ufoPush(ufoImgGetU32(pfa));
1975 }
1976
1977
1978 //==========================================================================
1979 //
1980 //  ufoDoConst
1981 //
1982 //==========================================================================
1983 static void ufoDoConst (uint32_t pfa) {
1984   ufoPush(ufoImgGetU32(pfa));
1985 }
1986
1987
1988 //==========================================================================
1989 //
1990 //  ufoDoDefer
1991 //
1992 //==========================================================================
1993 static void ufoDoDefer (uint32_t pfa) {
1994   const uint32_t cfa = ufoImgGetU32(pfa);
1995   if (cfa != 0) {
1996     ufoRPush(cfa);
1997     ufoVMRPopCFA = 1;
1998   }
1999 }
2000
2001
2002 //==========================================================================
2003 //
2004 //  ufoDoVoc
2005 //
2006 //==========================================================================
2007 static void ufoDoVoc (uint32_t pfa) {
2008   ufoImgPutU32(ufoAddrContext, ufoImgGetU32(pfa));
2009 }
2010
2011
2012 //==========================================================================
2013 //
2014 //  ufoDoCreate
2015 //
2016 //==========================================================================
2017 static void ufoDoCreate (uint32_t pfa) {
2018   ufoPush(pfa);
2019 }
2020
2021
2022 //==========================================================================
2023 //
2024 //  ufoPushInFile
2025 //
2026 //  this also increments last used file id
2027 //
2028 //==========================================================================
2029 static void ufoPushInFile (void) {
2030   if (ufoFileStackPos >= UFO_MAX_NESTED_INCLUDES) ufoFatal("too many includes");
2031   UFOFileStackEntry *stk = &ufoFileStack[ufoFileStackPos];
2032   stk->fl = ufoInFile;
2033   stk->fname = ufoInFileName;
2034   stk->fline = ufoInFileLine;
2035   stk->id = ufoFileId;
2036   stk->incpath = (ufoLastIncPath ? strdup(ufoLastIncPath) : NULL);
2037   stk->sysincpath = (ufoLastSysIncPath ? strdup(ufoLastSysIncPath) : NULL);
2038   ufoFileStackPos += 1;
2039   ufoInFile = NULL;
2040   ufoInFileName = NULL; ufoInFileNameLen = 0; ufoInFileNameHash = 0;
2041   ufoInFileLine = 0;
2042   ufoLastUsedFileId += 1;
2043   ufo_assert(ufoLastUsedFileId != 0); // just in case ;-)
2044   //ufoLastIncPath = NULL;
2045 }
2046
2047
2048 //==========================================================================
2049 //
2050 //  ufoWipeIncludeStack
2051 //
2052 //==========================================================================
2053 static void ufoWipeIncludeStack (void) {
2054   if (ufoInFileName) { free(ufoInFileName); ufoInFileName = NULL; }
2055   if (ufoInFile) { fclose(ufoInFile); ufoInFile = NULL; }
2056   if (ufoLastIncPath) { free(ufoLastIncPath); ufoLastIncPath = NULL; }
2057   if (ufoLastSysIncPath) { free(ufoLastSysIncPath); ufoLastSysIncPath = NULL; }
2058   while (ufoFileStackPos != 0) {
2059     ufoFileStackPos -= 1;
2060     UFOFileStackEntry *stk = &ufoFileStack[ufoFileStackPos];
2061     if (stk->fl) fclose(stk->fl);
2062     if (stk->fname) free(stk->fname);
2063     if (stk->incpath) free(stk->incpath);
2064   }
2065 }
2066
2067
2068 //==========================================================================
2069 //
2070 //  ufoPopInFile
2071 //
2072 //==========================================================================
2073 static void ufoPopInFile (void) {
2074   if (ufoFileStackPos == 0) ufoFatal("trying to pop include from empty stack");
2075   if (ufoInFileName) { free(ufoInFileName); ufoInFileName = NULL; }
2076   if (ufoInFile) { fclose(ufoInFile); ufoInFile = NULL; }
2077   if (ufoLastIncPath) { free(ufoLastIncPath); ufoLastIncPath = NULL; }
2078   if (ufoLastSysIncPath) { free(ufoLastSysIncPath); ufoLastSysIncPath = NULL; }
2079   ufoFileStackPos -= 1;
2080   UFOFileStackEntry *stk = &ufoFileStack[ufoFileStackPos];
2081   ufoInFile = stk->fl;
2082   ufoSetInFileNameReuse(stk->fname);
2083   ufoInFileLine = stk->fline;
2084   ufoLastIncPath = stk->incpath;
2085   ufoLastSysIncPath = stk->sysincpath;
2086   ufoFileId = stk->id;
2087   ufoResetTib();
2088   #ifdef UFO_DEBUG_INCLUDE
2089   if (ufoInFileName == NULL) {
2090     fprintf(stderr, "INC-POP: no more files.\n");
2091   } else {
2092     fprintf(stderr, "INC-POP: fname: %s\n", ufoInFileName);
2093   }
2094   #endif
2095 }
2096
2097
2098 //==========================================================================
2099 //
2100 //  ufoDeinit
2101 //
2102 //==========================================================================
2103 void ufoDeinit (void) {
2104   #ifdef UFO_DEBUG_WRITE_MAIN_IMAGE
2105   {
2106     FILE *fo = fopen("zufo_main.img", "w");
2107     uint32_t dpTemp = ufoImgGetU32(ufoAddrDPTemp);
2108     uint32_t dpMain = ufoImgGetU32(ufoAddrDP);
2109     if ((dpMain & UFO_ADDR_SPECIAL_BITS_MASK) != 0) dpMain = ufoImageSize;
2110     if (dpTemp != 0 && (dpTemp & UFO_ADDR_SPECIAL_BITS_MASK) == 0) {
2111       if (dpTemp > dpMain) dpMain = dpTemp;
2112     }
2113     fwrite(ufoImage, dpMain, 1, fo);
2114     fclose(fo);
2115   }
2116   #endif
2117
2118   #ifdef UFO_DEBUG_WRITE_DEBUG_IMAGE
2119   {
2120     FILE *fo = fopen("zufo_debug.img", "w");
2121     fwrite(ufoDebugImage, ufoDebugImageUsed, 1, fo);
2122     fclose(fo);
2123   }
2124   #endif
2125
2126   #ifdef UFO_DEBUG_DEBUG
2127   {
2128     uint32_t dpTemp = ufoImgGetU32(ufoAddrDPTemp);
2129     uint32_t dpMain = ufoImgGetU32(ufoAddrDP);
2130     if ((dpMain & UFO_ADDR_SPECIAL_BITS_MASK) != 0) dpMain = ufoImageSize;
2131     if (dpTemp != 0 && (dpTemp & UFO_ADDR_SPECIAL_BITS_MASK) == 0) {
2132       if (dpTemp > dpMain) dpMain = dpTemp;
2133     }
2134     fprintf(stderr, "UFO: image used: %u; size: %u\n",
2135             dpMain, ufoImageSize);
2136     fprintf(stderr, "UFO: debug image used: %u; size: %u\n",
2137             ufoDebugImageUsed, ufoDebugImageSize);
2138     ufoDumpDebugImage();
2139   }
2140   #endif
2141
2142   // free all states
2143   ufoCurrState = NULL;
2144   ufoYieldedState = NULL;
2145   ufoDebuggerState = NULL;
2146   for (uint32_t fidx = 0; fidx < (uint32_t)(UFO_MAX_STATES/32); fidx += 1u) {
2147     uint32_t bmp = ufoStateUsedBitmap[fidx];
2148     if (bmp != 0) {
2149       uint32_t stid = fidx * 32u;
2150       while (bmp != 0) {
2151         if ((bmp & 0x01) != 0) ufoFreeState(ufoStateMap[stid]);
2152         stid += 1u; bmp >>= 1;
2153       }
2154     }
2155   }
2156
2157   free(ufoDebugImage);
2158   ufoDebugImage = NULL;
2159   ufoDebugImageUsed = 0;
2160   ufoDebugImageSize = 0;
2161   ufoDebugFileNameHash = 0;
2162   ufoDebugFileNameLen = 0;
2163   ufoDebugLastLine = 0;
2164   ufoDebugLastLinePCOfs = 0;
2165   ufoDebugLastLineDP = 0;
2166   ufoDebugCurrDP = 0;
2167
2168   ufoInBacktrace = 0;
2169   ufoClearCondDefines();
2170   ufoWipeIncludeStack();
2171
2172   // release all includes
2173   ufoInFile = NULL;
2174   if (ufoInFileName) free(ufoInFileName);
2175   if (ufoLastIncPath) free(ufoLastIncPath);
2176   if (ufoLastSysIncPath) free(ufoLastSysIncPath);
2177   ufoInFileName = NULL; ufoLastIncPath = NULL; ufoLastSysIncPath = NULL;
2178   ufoInFileNameHash = 0; ufoInFileNameLen = 0;
2179   ufoInFileLine = 0;
2180
2181   free(ufoForthCFAs);
2182   ufoForthCFAs = NULL;
2183   ufoCFAsUsed = 0;
2184
2185   free(ufoImage);
2186   ufoImage = NULL;
2187   ufoImageSize = 0;
2188
2189   ufoMode = UFO_MODE_NATIVE;
2190   ufoForthVocId = 0; ufoCompilerVocId = 0;
2191   ufoSingleStep = 0;
2192
2193   // free all handles
2194   for (uint32_t f = 0; f < ufoHandlesUsed; f += 1) {
2195     UfoHandle *hh = ufoHandles[f];
2196     if (hh != NULL) {
2197       if (hh->data != NULL) free(hh->data);
2198       free(hh);
2199     }
2200   }
2201   if (ufoHandles != NULL) free(ufoHandles);
2202   ufoHandles = NULL; ufoHandlesUsed = 0; ufoHandlesAlloted = 0;
2203   ufoHandleFreeList = NULL;
2204
2205   ufoLastEmitWasCR = 1;
2206
2207   ufoClearCondDefines();
2208 }
2209
2210
2211 //==========================================================================
2212 //
2213 //  ufoDumpWordHeader
2214 //
2215 //==========================================================================
2216 __attribute__((unused)) static void ufoDumpWordHeader (const uint32_t lfa) {
2217   fprintf(stderr, "=== WORD: LFA: 0x%08x ===\n", lfa);
2218   if (lfa != 0) {
2219     fprintf(stderr, "  (XFA): 0x%08x\n", ufoImgGetU32(UFO_LFA_TO_XFA(lfa)));
2220     fprintf(stderr, "  (YFA): 0x%08x\n", ufoImgGetU32(UFO_LFA_TO_YFA(lfa)));
2221     fprintf(stderr, "  (BFA): 0x%08x\n", ufoImgGetU32(UFO_LFA_TO_BFA(lfa)));
2222     fprintf(stderr, "  (LFA): 0x%08x\n", ufoImgGetU32(lfa));
2223     fprintf(stderr, "  (NHH): 0x%08x\n", ufoImgGetU32(UFO_LFA_TO_NHASH(lfa)));
2224     const uint32_t cfa = UFO_LFA_TO_CFA(lfa);
2225     fprintf(stderr, "    CFA: 0x%08x\n", cfa);
2226     fprintf(stderr, "    PFA: 0x%08x\n", UFO_CFA_TO_PFA(cfa));
2227     fprintf(stderr, "  (CFA): 0x%08x\n", ufoImgGetU32(cfa));
2228     const uint32_t nfa = UFO_LFA_TO_NFA(lfa);
2229     const uint32_t nlen = ufoImgGetU8(nfa);
2230     fprintf(stderr, "    NFA: 0x%08x  (nlen: %u)\n", nfa, nlen);
2231     const uint32_t flags = ufoImgGetU32(nfa);
2232     fprintf(stderr, "  FLAGS: 0x%08x\n", flags);
2233     if ((flags & 0xffff0000U) != 0) {
2234       fprintf(stderr, "  FLAGS:");
2235       if (flags & UFW_FLAG_IMMEDIATE) fprintf(stderr, " IMM");
2236       if (flags & UFW_FLAG_SMUDGE) fprintf(stderr, " SMUDGE");
2237       if (flags & UFW_FLAG_NORETURN) fprintf(stderr, " NORET");
2238       if (flags & UFW_FLAG_HIDDEN) fprintf(stderr, " HIDDEN");
2239       if (flags & UFW_FLAG_CBLOCK) fprintf(stderr, " CBLOCK");
2240       if (flags & UFW_FLAG_VOCAB) fprintf(stderr, " VOCAB");
2241       if (flags & UFW_FLAG_SCOLON) fprintf(stderr, " SCOLON");
2242       if (flags & UFW_FLAG_PROTECTED) fprintf(stderr, " PROTECTED");
2243       fputc('\n', stderr);
2244     }
2245     if ((flags & 0xff00U) != 0) {
2246       fprintf(stderr, "   ARGS: ");
2247       switch (flags & UFW_WARG_MASK) {
2248         case UFW_WARG_NONE: fprintf(stderr, "NONE"); break;
2249         case UFW_WARG_BRANCH: fprintf(stderr, "BRANCH"); break;
2250         case UFW_WARG_LIT: fprintf(stderr, "LIT"); break;
2251         case UFW_WARG_C4STRZ: fprintf(stderr, "C4STRZ"); break;
2252         case UFW_WARG_CFA: fprintf(stderr, "CFA"); break;
2253         case UFW_WARG_CBLOCK: fprintf(stderr, "CBLOCK"); break;
2254         case UFW_WARG_VOCID: fprintf(stderr, "VOCID"); break;
2255         case UFW_WARG_C1STRZ: fprintf(stderr, "C1STRZ"); break;
2256         case UFW_WARG_DATASKIP: fprintf(stderr, "DATA"); break;
2257         default: fprintf(stderr, "wtf?!"); break;
2258       }
2259       fputc('\n', stderr);
2260     }
2261     fprintf(stderr, "  BACKLEN: %u (nfa at 0x%08x)\n", ufoImgGetU8(cfa - 1u), UFO_CFA_TO_NFA(cfa));
2262     fprintf(stderr, "  NAME(%u): ", nlen);
2263     for (uint32_t f = 0; f < nlen; f += 1) {
2264       const uint8_t ch = ufoImgGetU8(nfa + 4u + f);
2265       if (ch <= 32 || ch >= 127) {
2266         fprintf(stderr, "\\x%02x", ch);
2267       } else {
2268         fprintf(stderr, "%c", (char)ch);
2269       }
2270     }
2271     fprintf(stderr, "\n");
2272     ufo_assert(UFO_CFA_TO_LFA(cfa) == lfa);
2273   }
2274 }
2275
2276
2277 //==========================================================================
2278 //
2279 //  ufoVocCheckName
2280 //
2281 //  return 0 or CFA
2282 //
2283 //==========================================================================
2284 static uint32_t ufoVocCheckName (uint32_t lfa, const void *wname, uint32_t wnlen, uint32_t hash,
2285                                  int allowvochid)
2286 {
2287   uint32_t res = 0;
2288   #ifdef UFO_DEBUG_FIND_WORD
2289   fprintf(stderr, "CHECK-NAME: %.*s; LFA: 0x%08x; hash: 0x%08x (wname: 0x%08x)\n",
2290           (unsigned) wnlen, (const char *)wname,
2291           lfa, (lfa != 0 ? ufoImgGetU32(UFO_LFA_TO_NHASH(lfa)) : 0), hash);
2292   ufoDumpWordHeader(lfa);
2293   #endif
2294   if (lfa != 0 && ufoImgGetU32(UFO_LFA_TO_NHASH(lfa)) == hash) {
2295     const uint32_t lenflags = ufoImgGetU32(UFO_LFA_TO_NFA(lfa));
2296     if ((lenflags & UFW_FLAG_SMUDGE) == 0 &&
2297         (allowvochid || (lenflags & UFW_FLAG_HIDDEN) == 0))
2298     {
2299       const uint32_t nlen = lenflags&0xffU;
2300       if (nlen == wnlen) {
2301         uint32_t naddr = UFO_LFA_TO_NFA(lfa) + 4u;
2302         uint32_t pos = 0;
2303         while (pos < nlen) {
2304           uint8_t c0 = ((const unsigned char *)wname)[pos];
2305           if (c0 >= 'a' && c0 <= 'z') c0 = c0 - 'a' + 'A';
2306           uint8_t c1 = ufoImgGetU8(naddr + pos);
2307           if (c1 >= 'a' && c1 <= 'z') c1 = c1 - 'a' + 'A';
2308           if (c0 != c1) break;
2309           pos += 1u;
2310         }
2311         if (pos == nlen) {
2312           // i found her!
2313           naddr += pos + 1u;
2314           res = UFO_ALIGN4(naddr);
2315         }
2316       }
2317     }
2318   }
2319   return res;
2320 }
2321
2322
2323 //==========================================================================
2324 //
2325 //  ufoFindWordInVoc
2326 //
2327 //  return 0 or CFA
2328 //
2329 //==========================================================================
2330 static uint32_t ufoFindWordInVoc (const void *wname, uint32_t wnlen, uint32_t hash,
2331                                   uint32_t vocid, int allowvochid)
2332 {
2333   uint32_t res = 0;
2334   if (wname == NULL) ufo_assert(wnlen == 0);
2335   if (wnlen != 0 && vocid != 0) {
2336     if (hash == 0) hash = joaatHashBufCI(wname, wnlen);
2337     #if defined(UFO_DEBUG_FIND_WORD) || defined(UFO_DEBUG_FIND_WORD_IN_VOC)
2338     fprintf(stderr, "IN-VOC: %.*s; VOCID: 0x%08x; whash: 0x%08x; htbl[0]: 0x%08x\n",
2339             (unsigned) wnlen, (const char *)wname,
2340             vocid, hash, ufoImgGetU32(vocid + UFW_VOCAB_OFS_HTABLE));
2341     #endif
2342     const uint32_t htbl = vocid + UFW_VOCAB_OFS_HTABLE;
2343     if (ufoImgGetU32(htbl) != UFO_NO_HTABLE_FLAG) {
2344       // hash table present, use it
2345       uint32_t bfa = htbl + (hash % (uint32_t)UFO_HASHTABLE_SIZE) * 4u;
2346       bfa = ufoImgGetU32(bfa);
2347       while (res == 0 && bfa != 0) {
2348         #if defined(UFO_DEBUG_FIND_WORD) || defined(UFO_DEBUG_FIND_WORD_IN_VOC)
2349         fprintf(stderr, "IN-VOC:   bfa: 0x%08x\n", bfa);
2350         #endif
2351         res = ufoVocCheckName(UFO_BFA_TO_LFA(bfa), wname, wnlen, hash, allowvochid);
2352         bfa = ufoImgGetU32(bfa);
2353       }
2354     } else {
2355       // no hash table, use linear search
2356       uint32_t lfa = vocid + UFW_VOCAB_OFS_LATEST;
2357       lfa = ufoImgGetU32(lfa);
2358       while (res == 0 && lfa != 0) {
2359         res = ufoVocCheckName(lfa, wname, wnlen, hash, allowvochid);
2360         lfa = ufoImgGetU32(lfa);
2361       }
2362     }
2363   }
2364   return res;
2365 }
2366
2367
2368 //==========================================================================
2369 //
2370 //  ufoFindColon
2371 //
2372 //  return part after the colon, or `NULL`
2373 //
2374 //==========================================================================
2375 static const void *ufoFindColon (const void *wname, uint32_t wnlen) {
2376   const void *res = NULL;
2377   if (wnlen != 0) {
2378     ufo_assert(wname != NULL);
2379     const char *str = (const char *)wname;
2380     while (wnlen != 0 && str[0] != ':') {
2381       str += 1; wnlen -= 1;
2382     }
2383     if (wnlen != 0) {
2384       res = (const void *)(str + 1); // skip colon
2385     }
2386   }
2387   return res;
2388 }
2389
2390
2391 //==========================================================================
2392 //
2393 //  ufoFindWordInVocAndParents
2394 //
2395 //==========================================================================
2396 static uint32_t ufoFindWordInVocAndParents (const void *wname, uint32_t wnlen, uint32_t hash,
2397                                             uint32_t vocid, int allowvochid)
2398 {
2399   uint32_t res = 0;
2400   if (hash == 0) hash = joaatHashBufCI(wname, wnlen);
2401   while (res == 0 && vocid != 0) {
2402     res = ufoFindWordInVoc(wname, wnlen, hash, vocid, allowvochid);
2403     vocid = ufoImgGetU32(vocid + UFW_VOCAB_OFS_PARENT);
2404   }
2405   return res;
2406 }
2407
2408
2409 //==========================================================================
2410 //
2411 //  ufoFindWordNameRes
2412 //
2413 //  find with name resolution
2414 //
2415 //  return 0 or CFA
2416 //
2417 //==========================================================================
2418 static uint32_t ufoFindWordNameRes (const void *wname, uint32_t wnlen) {
2419   uint32_t res = 0;
2420   if (wnlen != 0 && *(const char *)wname != ':') {
2421     ufo_assert(wname != NULL);
2422
2423     const void *stx = wname;
2424     wname = ufoFindColon(wname, wnlen);
2425     if (wname != NULL) {
2426       // look in all vocabs (excluding hidden ones)
2427       uint32_t xlen = (uint32_t)(ptrdiff_t)(wname - stx) - 1u;
2428       ufo_assert(xlen > 0 && xlen < 255);
2429       uint32_t xhash = joaatHashBufCI(stx, xlen);
2430       uint32_t voclink = ufoImgGetU32(ufoAddrVocLink);
2431       #ifdef UFO_DEBUG_FIND_WORD_COLON
2432       fprintf(stderr, "COLON-FIND: first voc: {%.*s}; xhash=0x%08x; voc-link: 0x%08x\n",
2433               (unsigned)xlen, (const char *)stx, xhash, voclink);
2434       #endif
2435       while (res == 0 && voclink != 0) {
2436         const uint32_t vhdraddr = voclink - UFW_VOCAB_OFS_VOCLINK + UFW_VOCAB_OFS_HEADER;
2437         const uint32_t vhdr = ufoImgGetU32(vhdraddr);
2438         if (vhdr != 0) {
2439           res = ufoVocCheckName(UFO_NFA_TO_LFA(vhdr), stx, xlen, xhash, 0);
2440         }
2441         if (res == 0) voclink = ufoImgGetU32(voclink);
2442       }
2443       if (res != 0) {
2444         uint32_t vocid = voclink - UFW_VOCAB_OFS_VOCLINK;
2445         ufo_assert(voclink != 0);
2446         wnlen -= xlen + 1;
2447         #ifdef UFO_DEBUG_FIND_WORD_COLON
2448         fprintf(stderr, "searching {%.*s}(%u) in {%.*s}\n",
2449                 (unsigned)wnlen, wname, wnlen, (unsigned)xlen, stx);
2450         #endif
2451         while (res != 0 && wname != NULL) {
2452           // first, the whole rest
2453           res = ufoFindWordInVocAndParents(wname, wnlen, 0, vocid, 1);
2454           if (res != 0) {
2455             wname = NULL;
2456           } else {
2457             stx = wname;
2458             wname = ufoFindColon(wname, wnlen);
2459             if (wname == NULL) xlen = wnlen; else xlen = (uint32_t)(ptrdiff_t)(wname - stx) - 1u;
2460             ufo_assert(xlen > 0 && xlen < 255);
2461             res = ufoFindWordInVocAndParents(stx, xlen, 0, vocid, 1);
2462             if (res != 0) {
2463               wnlen -= xlen + 1;
2464               if (wname != NULL) {
2465                 // it should be a vocabulary
2466                 const uint32_t nfa = UFO_CFA_TO_NFA(res);
2467                 if ((ufoImgGetU32(nfa) & UFW_FLAG_VOCAB) != 0) {
2468                   vocid = ufoImgGetU32(UFO_CFA_TO_PFA(res)); // pfa points to vocabulary
2469                 } else {
2470                   res = 0;
2471                 }
2472               }
2473             }
2474           }
2475         }
2476       }
2477     }
2478   }
2479
2480   return res;
2481 }
2482
2483
2484 //==========================================================================
2485 //
2486 //  ufoFindWord
2487 //
2488 //  doesn't look in CURRENT, does name resolution ("a:b" is word "b" in "a")
2489 //
2490 //  return 0 or CFA
2491 //
2492 //==========================================================================
2493 static uint32_t ufoFindWord (const char *wname) {
2494   uint32_t res = 0;
2495   if (wname && wname[0] != 0) {
2496     const size_t wnlen = strlen(wname);
2497     ufo_assert(wnlen < 8192);
2498     uint32_t ctx = ufoImgGetU32(ufoAddrContext);
2499     const uint32_t hash = joaatHashBufCI(wname, (uint32_t)wnlen);
2500
2501     //fprintf(stderr, "FIND-WORD: whash: 0x%08x; name:{%s}\n", hash, wname);
2502
2503     // first search in context
2504     res = ufoFindWordInVocAndParents(wname, (uint32_t)wnlen, hash, ctx, (ctx == ufoImgGetU32(ufoAddrCurrent)));
2505
2506     // now try vocabulary stack
2507     uint32_t vstp = ufoVSP;
2508     while (res == 0 && vstp != 0) {
2509       vstp -= 1;
2510       ctx = ufoVocStack[vstp];
2511       res = ufoFindWordInVocAndParents(wname, (uint32_t)wnlen, hash, ctx, (ctx == ufoImgGetU32(ufoAddrCurrent)));
2512     }
2513
2514     // if not found, try name resolution
2515     if (res == 0) res = ufoFindWordNameRes(wname, (uint32_t)wnlen);
2516   }
2517
2518   return res;
2519 }
2520
2521
2522 //==========================================================================
2523 //
2524 //  ufoCreateWordHeader
2525 //
2526 //  create word header up to CFA, link to the current dictionary
2527 //
2528 //==========================================================================
2529 static void ufoCreateWordHeader (const char *wname, uint32_t flags) {
2530   if (wname == NULL) wname = "";
2531   const size_t wnlen = strlen(wname);
2532   ufo_assert(wnlen < UFO_MAX_WORD_LENGTH);
2533   const uint32_t hash = joaatHashBufCI(wname, (uint32_t)wnlen);
2534   const uint32_t curr = ufoImgGetU32(ufoAddrCurrent);
2535   ufo_assert(curr != 0);
2536   // redefine check
2537   const uint32_t warn = ufoImgGetU32(ufoAddrRedefineWarning);
2538   if (wnlen != 0 && warn != UFO_REDEF_WARN_DONT_CARE) {
2539     uint32_t cfa;
2540     if (warn != UFO_REDEF_WARN_PARENTS) {
2541       cfa = ufoFindWordInVoc(wname, wnlen, hash, curr, 1);
2542     } else {
2543       cfa = ufoFindWordInVocAndParents(wname, wnlen, hash, curr, 1);
2544     }
2545     if (cfa != 0) {
2546       const uint32_t nfa = UFO_CFA_TO_NFA(cfa);
2547       const uint32_t flags = ufoImgGetU32(nfa);
2548       if ((flags & UFW_FLAG_PROTECTED) != 0) {
2549         ufoFatal("trying to redefine protected word '%s'", wname);
2550       } else if (warn != UFO_REDEF_WARN_NONE) {
2551         ufoWarning("redefining word '%s'", wname);
2552       }
2553     }
2554   }
2555   //fprintf(stderr, "000: HERE: 0x%08x\n", UFO_GET_DP());
2556   const uint32_t bkt = (hash % (uint32_t)UFO_HASHTABLE_SIZE) * 4u;
2557   const uint32_t htbl = curr + UFW_VOCAB_OFS_HTABLE;
2558   ufoImgEmitAlign();
2559   const uint32_t xfaAddr = UFO_GET_DP();
2560   if ((xfaAddr & UFO_ADDR_TEMP_BIT) == 0) {
2561     // link previous yfa here
2562     const uint32_t lastxfa = ufoImgGetU32(ufoAddrLastXFA);
2563     // fix YFA of the previous word
2564     if (lastxfa != 0) {
2565       ufoImgPutU32(UFO_XFA_TO_YFA(lastxfa), UFO_XFA_TO_YFA(xfaAddr));
2566     }
2567     // our XFA points to the previous XFA
2568     ufoImgEmitU32(lastxfa); // xfa
2569     // update last XFA
2570     ufoImgPutU32(ufoAddrLastXFA, xfaAddr);
2571   } else {
2572     ufoImgEmitU32(0); // xfa
2573   }
2574   ufoImgEmitU32(0); // yfa
2575   // bucket link (bfa)
2576   if (wnlen == 0 || ufoImgGetU32(htbl) == UFO_NO_HTABLE_FLAG) {
2577     ufoImgEmitU32(0);
2578   } else {
2579     #ifdef UFO_DEBUG_DUMP_NEW_HEADERS
2580     fprintf(stderr, "NEW HEADER: %s; curr: 0x%08x; htbl: 0x%08x; bkt: 0x%08x\n",
2581             wname, curr, htbl, bkt);
2582     fprintf(stderr, "  [bkt]: 0x%08x; nbk: 0x%08x\n", ufoImgGetU32(htbl + bkt), UFO_GET_DP());
2583     #endif
2584     // bfa points to bfa
2585     const uint32_t bfa = UFO_GET_DP();
2586     ufoImgEmitU32(ufoImgGetU32(htbl + bkt));
2587     ufoImgPutU32(htbl + bkt, bfa);
2588   }
2589   // lfa
2590   const uint32_t lfa = UFO_GET_DP();
2591   ufoImgEmitU32(ufoImgGetU32(curr + UFW_VOCAB_OFS_LATEST));
2592   // fix voc latest
2593   ufoImgPutU32(curr + UFW_VOCAB_OFS_LATEST, lfa);
2594   // name hash
2595   ufoImgEmitU32(hash);
2596   // name length
2597   const uint32_t nfa = UFO_GET_DP();
2598   ufoImgEmitU32(((uint32_t)wnlen&0xffU) | (flags & 0xffffff00U));
2599   const uint32_t nstart = UFO_GET_DP();
2600   // put name
2601   for (size_t f = 0; f < wnlen; f += 1) {
2602     ufoImgEmitU8(((const unsigned char *)wname)[f]);
2603   }
2604   while ((UFO_GET_DP() & 3) != 3) ufoImgEmitU8(0);
2605   const uint32_t nend = UFO_GET_DP(); // length byte itself is not included
2606   // name length, again
2607   ufo_assert(nend - nstart <= 255);
2608   ufoImgEmitU8((uint8_t)(nend - nstart));
2609   ufo_assert((UFO_GET_DP() & 3) == 0);
2610   ufo_assert(UFO_CFA_TO_NFA(UFO_GET_DP()) == nfa);
2611   if ((nend & UFO_ADDR_SPECIAL_BITS_MASK) == 0) ufoRecordDebug(nend);
2612   #ifdef UFO_DEBUG_DUMP_NEW_HEADERS
2613   fprintf(stderr, "*** NEW HEADER ***\n");
2614   fprintf(stderr, "CFA: 0x%08x\n", UFO_GET_DP());
2615   fprintf(stderr, "NSTART: 0x%08x\n", nstart);
2616   fprintf(stderr, "NEND: 0x%08x\n", nend);
2617   fprintf(stderr, "NLEN: %u (%u)\n", nend - nstart, ufoImgGetU8(UFO_GET_DP() - 1u));
2618   ufoDumpWordHeader(lfa);
2619   #endif
2620   #if 0
2621   fprintf(stderr, "NEW WORD CFA 0x%08x: %s\n", UFO_GET_DP(), wname);
2622   #endif
2623 }
2624
2625
2626 //==========================================================================
2627 //
2628 //  ufoDecompilePart
2629 //
2630 //==========================================================================
2631 static void ufoDecompilePart (uint32_t addr, uint32_t eaddr, int indent) {
2632   uint32_t count;
2633   FILE *fo = stdout;
2634   while (addr < eaddr) {
2635     uint32_t cfa = ufoImgGetU32(addr);
2636     for (int n = 0; n < indent; n += 1) fputc(' ', fo);
2637     fprintf(fo, "%6u: 0x%08x: ", addr, cfa);
2638     uint32_t nfa = UFO_CFA_TO_NFA(cfa);
2639     uint32_t flags = ufoImgGetU32(nfa);
2640     //fprintf(fo, "[0x%08x] ", flags & UFW_WARG_MASK);
2641     uint32_t nlen = flags & 0xffU;
2642     for (uint32_t f = 0; f < nlen; f += 1) {
2643       const uint8_t ch = ufoImgGetU8(nfa + 4u + f);
2644       if (ch <= 32 || ch >= 127) {
2645         fprintf(fo, "\\x%02x", ch);
2646       } else {
2647         fprintf(fo, "%c", (char)ch);
2648       }
2649     }
2650     addr += 4u;
2651     switch (flags & UFW_WARG_MASK) {
2652       case UFW_WARG_NONE:
2653         break;
2654       case UFW_WARG_BRANCH:
2655         fprintf(fo, "  @%u", ufoImgGetU32(addr)); addr += 4u;
2656         break;
2657       case UFW_WARG_LIT:
2658         fprintf(fo, "  %u : %d : 0x%08x", ufoImgGetU32(addr),
2659                 (int32_t)ufoImgGetU32(addr), ufoImgGetU32(addr)); addr += 4u;
2660         break;
2661       case UFW_WARG_C4STRZ:
2662         count = ufoImgGetU32(addr); addr += 4;
2663        print_str:
2664         fprintf(fo, "  str:");
2665         for (int f = 0; f < count; f += 1) {
2666           const uint8_t ch = ufoImgGetU8(addr); addr += 1u;
2667           if (ch <= 32 || ch >= 127) {
2668             fprintf(fo, "\\x%02x", ch);
2669           } else {
2670             fprintf(fo, "%c", (char)ch);
2671           }
2672         }
2673         addr += 1u; // skip zero byte
2674         addr = UFO_ALIGN4(addr);
2675         break;
2676       case UFW_WARG_CFA:
2677         cfa = ufoImgGetU32(addr); addr += 4u;
2678         fprintf(fo, "  CFA:%u: ", cfa);
2679         nfa = UFO_CFA_TO_NFA(cfa);
2680         nlen = ufoImgGetU8(nfa);
2681         for (uint32_t f = 0; f < nlen; f += 1) {
2682           const uint8_t ch = ufoImgGetU8(nfa + 4u + f);
2683           if (ch <= 32 || ch >= 127) {
2684             fprintf(fo, "\\x%02x", ch);
2685           } else {
2686             fprintf(fo, "%c", (char)ch);
2687           }
2688         }
2689         break;
2690       case UFW_WARG_CBLOCK:
2691         fprintf(fo, "  CBLOCK:%u", ufoImgGetU32(addr)); addr += 4u;
2692         break;
2693       case UFW_WARG_VOCID:
2694         fprintf(fo, "  VOCID:%u", ufoImgGetU32(addr)); addr += 4u;
2695         break;
2696       case UFW_WARG_C1STRZ:
2697         count = ufoImgGetU8(addr); addr += 1;
2698         goto print_str;
2699       case UFW_WARG_DATASKIP:
2700         fprintf(fo, "  DATA:%u", ufoImgGetU32(addr));
2701         addr += ufoImgGetU32(addr) + 4u;
2702         break;
2703       default:
2704         fprintf(fo, " -- WTF?!\n");
2705         abort();
2706     }
2707     fputc('\n', fo);
2708   }
2709 }
2710
2711
2712 //==========================================================================
2713 //
2714 //  ufoDecompileWord
2715 //
2716 //==========================================================================
2717 static void ufoDecompileWord (const uint32_t cfa) {
2718   if (cfa != 0) {
2719     const uint32_t lfa = UFO_CFA_TO_LFA(cfa);
2720     fprintf(stdout, "#### DECOMPILING CFA %u ###\n", cfa);
2721     ufoDumpWordHeader(lfa);
2722     const uint32_t yfa = ufoGetWordEndAddr(cfa);
2723     if (ufoImgGetU32(cfa) == ufoDoForthCFA) {
2724       fprintf(stdout, "--- DECOMPILED CODE ---\n");
2725       ufoDecompilePart(UFO_CFA_TO_PFA(cfa), yfa, 0);
2726       fprintf(stdout, "=======================\n");
2727     }
2728   }
2729 }
2730
2731
2732 //==========================================================================
2733 //
2734 //  ufoBTShowWordName
2735 //
2736 //==========================================================================
2737 static void ufoBTShowWordName (uint32_t nfa) {
2738   if (nfa != 0) {
2739     uint32_t len = ufoImgGetU8(nfa); nfa += 4u;
2740     //fprintf(stderr, "(0x%08x)", ufoImgGetU32(nfa - 4u));
2741     while (len != 0) {
2742       uint8_t ch = ufoImgGetU8(nfa); nfa += 1u; len -= 1u;
2743       if (ch <= 32 || ch >= 127) {
2744         fprintf(stderr, "\\x%02x", ch);
2745       } else {
2746         fprintf(stderr, "%c", (char)ch);
2747       }
2748     }
2749   }
2750 }
2751
2752
2753 //==========================================================================
2754 //
2755 //  ufoBacktrace
2756 //
2757 //==========================================================================
2758 static void ufoBacktrace (uint32_t ip, int showDataStack) {
2759   // dump data stack (top 16)
2760   ufoFlushOutput();
2761   if (!ufoLastEmitWasCR) { printf("\n"); ufoLastEmitWasCR = 1; }
2762
2763   if (showDataStack) {
2764     fprintf(stderr, "***UFO STACK DEPTH: %u\n", ufoSP);
2765     uint32_t xsp = ufoSP;
2766     if (xsp > 16) xsp = 16;
2767     for (uint32_t sp = 0; sp < xsp; ++sp) {
2768       fprintf(stderr, "  %2u: 0x%08x  %d%s\n",
2769               sp, ufoDStack[xsp - sp - 1], (int32_t)ufoDStack[xsp - sp - 1],
2770               (sp == 0 ? " -- TOS" : ""));
2771     }
2772     if (ufoSP > 16) fprintf(stderr, "    ...more...\n");
2773   }
2774
2775   // dump return stack (top 32)
2776   uint32_t nfa;
2777   uint32_t fline;
2778   const char *fname;
2779
2780   fprintf(stderr, "***UFO RETURN STACK DEPTH: %u\n", ufoRP);
2781   if (ip != 0) {
2782     nfa = ufoFindWordForIP(ip);
2783     if (nfa != 0) {
2784       fprintf(stderr, "  **: %8u -- ", ip);
2785       ufoBTShowWordName(nfa);
2786       fname = ufoFindFileForIP(ip, &fline, NULL, NULL);
2787       if (fname != NULL) { fprintf(stderr, " (at %s:%u)", fname, fline); }
2788       fputc('\n', stderr);
2789     }
2790   }
2791   uint32_t rp = ufoRP;
2792   uint32_t rscount = 0;
2793   if (rp > UFO_RSTACK_SIZE) rp = UFO_RSTACK_SIZE;
2794   while (rscount != 32 && rp != 0) {
2795     rp -= 1;
2796     const uint32_t val = ufoRStack[rp];
2797     nfa = ufoFindWordForIP(val - 4u);
2798     if (nfa != 0) {
2799       fprintf(stderr, "  %2u: %8u -- ", ufoRP - rp - 1u, val);
2800       ufoBTShowWordName(nfa);
2801       fname = ufoFindFileForIP(val - 4u, &fline, NULL, NULL);
2802       if (fname != NULL) { fprintf(stderr, " (at %s:%u)", fname, fline); }
2803       fputc('\n', stderr);
2804     } else {
2805       fprintf(stderr, "  %2u: 0x%08x  %d\n", ufoRP - rp - 1u, val, (int32_t)val);
2806     }
2807     rscount += 1;
2808   }
2809   if (ufoRP > 32) fprintf(stderr, "    ...more...\n");
2810
2811   ufoFlushOutput();
2812 }
2813
2814
2815 //==========================================================================
2816 //
2817 //  ufoDumpVocab
2818 //
2819 //==========================================================================
2820 /*
2821 static void ufoDumpVocab (uint32_t vocid) {
2822   if (vocid != 0) {
2823     fprintf(stderr, "*** VOCID: 0x%08x ***\n", vocid);
2824     uint32_t vochdr = vocid + UFW_VOCAB_OFS_HEADER;
2825     vochdr = ufoImgGetU32(vochdr);
2826     if (vochdr != 0) {
2827       fprintf(stderr, "--- HEADER ---\n");
2828       ufoDumpWordHeader(UFO_NFA_TO_LFA(vochdr));
2829       fprintf(stderr, "========\n");
2830       uint32_t htbl = vocid + UFW_VOCAB_OFS_HTABLE;
2831       if (ufoImgGetU32(htbl) != UFO_NO_HTABLE_FLAG) {
2832         fprintf(stderr, "--- HASH TABLE ---\n");
2833         for (int f = 0; f < UFO_HASHTABLE_SIZE; f += 1) {
2834           uint32_t bfa = ufoImgGetU32(htbl);
2835           if (bfa != 0) {
2836             fprintf(stderr, "**** %2d: 0x%08x\n", f, bfa);
2837             do {
2838               ufoDumpWordHeader(UFO_BFA_TO_LFA(bfa));
2839               bfa = ufoImgGetU32(bfa);
2840             } while (bfa != 0);
2841           }
2842           htbl += 4u;
2843         }
2844       }
2845     }
2846   }
2847 }
2848 */
2849
2850
2851 // if set, this will be used when we are out of include files. intended for UrAsm.
2852 // return 0 if there is no more lines, otherwise the string should be copied
2853 // to buffer, `*fname` and `*fline` should be properly set.
2854 int (*ufoFileReadLine) (void *buf, size_t bufsize, const char **fname, int *fline) = NULL;
2855
2856
2857 //==========================================================================
2858 //
2859 //  ufoLoadNextUserLine
2860 //
2861 //==========================================================================
2862 static int ufoLoadNextUserLine (void) {
2863   uint32_t tibPos = 0;
2864   const char *fname = NULL;
2865   int fline = 0;
2866   ufoResetTib();
2867   if (ufoFileReadLine != NULL && ufoFileReadLine(ufoCurrFileLine, 510, &fname, &fline) != 0) {
2868     ufoCurrFileLine[510] = 0;
2869     uint32_t slen = (uint32_t)strlen(ufoCurrFileLine);
2870     while (slen != 0 && (ufoCurrFileLine[slen - 1u] == 10 || ufoCurrFileLine[slen - 1u] == 13)) {
2871       slen -= 1u;
2872     }
2873     if (tibPos + slen + 1u > UFO_ADDR_HANDLE_OFS_MASK) {
2874       ufoFatal("input text line too long (at least %u bytes)", tibPos + slen);
2875     }
2876     ufoTibEnsureSize(tibPos + slen + 1u);
2877     for (uint32_t f = 0; f < slen; f += 1) {
2878       ufoTibPokeChOfs(((const unsigned char *)ufoCurrFileLine)[f], tibPos + f);
2879     }
2880     ufoTibPokeChOfs(0, tibPos + slen);
2881     tibPos += slen;
2882     if (fname == NULL) fname = "<user>";
2883     ufoSetInFileName(fname);
2884     ufoInFileLine = fline;
2885     return 1;
2886   } else {
2887     return 0;
2888   }
2889 }
2890
2891
2892 //==========================================================================
2893 //
2894 //  ufoLoadNextLine_NativeMode
2895 //
2896 //  load next file line into TIB
2897 //  always strips final '\n'
2898 //
2899 //  return 0 on EOF, 1 on success
2900 //
2901 //==========================================================================
2902 static int ufoLoadNextLine (int crossInclude) {
2903   int done = 0;
2904   uint32_t tibPos = 0;
2905   ufoResetTib();
2906
2907   if (ufoMode == UFO_MODE_MACRO) {
2908     //fprintf(stderr, "***MAC!\n");
2909     return 0;
2910   }
2911
2912   while (ufoInFile != NULL && !done) {
2913     ufoCurrIncludeLineFileOfs = ftell(ufoInFile);
2914     if (fgets(ufoCurrFileLine, 510, ufoInFile) != NULL) {
2915       // check for a newline
2916       // if there is no newline char at the end, the string was truncated
2917       ufoCurrFileLine[510] = 0;
2918       const uint32_t slen = (uint32_t)strlen(ufoCurrFileLine);
2919       if (tibPos + slen + 1u > UFO_ADDR_HANDLE_OFS_MASK) {
2920         ufoFatal("input text line too long (at least %u bytes)", tibPos + slen);
2921       }
2922       ufoTibEnsureSize(tibPos + slen + 1u);
2923       for (uint32_t f = 0; f < slen; f += 1) {
2924         ufoTibPokeChOfs(((const unsigned char *)ufoCurrFileLine)[f], tibPos + f);
2925       }
2926       ufoTibPokeChOfs(0, tibPos + slen);
2927       tibPos += slen;
2928       if (slen != 0 && (ufoCurrFileLine[slen - 1u] == 13 || ufoCurrFileLine[slen - 1u] == 10)) {
2929         ++ufoInFileLine;
2930         done = 1;
2931       } else {
2932         // continuation, nothing to do
2933       }
2934     } else {
2935       // if we read nothing, this is EOF
2936       if (tibPos == 0 && crossInclude) {
2937         // we read nothing, and allowed to cross include boundaries
2938         ufoPopInFile();
2939       } else {
2940         done = 1;
2941       }
2942     }
2943   }
2944
2945   if (tibPos == 0) {
2946     // eof, try user-supplied input
2947     if (ufoFileStackPos == 0) {
2948       return ufoLoadNextUserLine();
2949     } else {
2950       return 0;
2951     }
2952   } else {
2953     // if we read at least something, this is not EOF
2954     return 1;
2955   }
2956 }
2957
2958
2959 // ////////////////////////////////////////////////////////////////////////// //
2960 // debug
2961
2962 // DUMP-STACK
2963 // ( -- )
2964 UFWORD(DUMP_STACK) {
2965   if (!ufoLastEmitWasCR) { printf("\n"); ufoLastEmitWasCR = 1; }
2966   printf("***UFO STACK DEPTH: %u\n", ufoSP);
2967   uint32_t xsp = ufoSP;
2968   if (xsp > 16) xsp = 16;
2969   for (uint32_t sp = 0; sp < xsp; ++sp) {
2970     printf("  %2u: 0x%08x  %d%s\n",
2971            sp, ufoDStack[xsp - sp - 1], (int32_t)ufoDStack[xsp - sp - 1],
2972            (sp == 0 ? " -- TOS" : ""));
2973   }
2974   if (ufoSP > 16) printf("    ...more...\n");
2975   ufoLastEmitWasCR = 1;
2976 }
2977
2978 // BACKTRACE
2979 // ( -- )
2980 UFWORD(UFO_BACKTRACE) {
2981   ufoFlushOutput();
2982   if (!ufoLastEmitWasCR) { printf("\n"); ufoLastEmitWasCR = 1; }
2983   if (ufoInFile != NULL) {
2984     fprintf(stderr, "*** at file %s, line %d ***\n", ufoInFileName, ufoInFileLine);
2985   } else {
2986     fprintf(stderr, "*** somewhere in time ***\n");
2987   }
2988   ufoBacktrace(ufoIP, 1);
2989 }
2990
2991 // DUMP-STACK-TASK
2992 // ( stid -- )
2993 UFWORD(DUMP_STACK_TASK) {
2994   UfoState *st = ufoFindState(ufoPop());
2995   if (st == NULL) ufoFatal("invalid state id");
2996   // temporarily switch the task
2997   UfoState *oldst = ufoCurrState; ufoCurrState = st;
2998   // dump
2999   if (!ufoLastEmitWasCR) { printf("\n"); ufoLastEmitWasCR = 1; }
3000   printf("***UFO STACK DEPTH: %u\n", ufoSP);
3001   uint32_t xsp = ufoSP;
3002   if (xsp > 16) xsp = 16;
3003   for (uint32_t sp = 0; sp < xsp; ++sp) {
3004     printf("  %2u: 0x%08x  %d%s\n",
3005            sp, ufoDStack[xsp - sp - 1], (int32_t)ufoDStack[xsp - sp - 1],
3006            (sp == 0 ? " -- TOS" : ""));
3007   }
3008   if (ufoSP > 16) printf("    ...more...\n");
3009   ufoLastEmitWasCR = 1;
3010   // restore state
3011   ufoCurrState = oldst;
3012 }
3013
3014 // DUMP-RSTACK-TASK
3015 // ( stid -- )
3016 UFWORD(DUMP_RSTACK_TASK) {
3017   UfoState *st = ufoFindState(ufoPop());
3018   if (st == NULL) ufoFatal("invalid state id");
3019   // temporarily switch the task
3020   UfoState *oldst = ufoCurrState; ufoCurrState = st;
3021   // dump
3022   ufoFlushOutput();
3023   if (!ufoLastEmitWasCR) { printf("\n"); ufoLastEmitWasCR = 1; }
3024   if (ufoInFile != NULL) {
3025     fprintf(stderr, "*** at file %s, line %d ***\n", ufoInFileName, ufoInFileLine);
3026   } else {
3027     fprintf(stderr, "*** somewhere in time ***\n");
3028   }
3029   ufoBacktrace(ufoIP, 0);
3030   // restore state
3031   ufoCurrState = oldst;
3032 }
3033
3034 // BACKTRACE-TASK
3035 // ( stid -- )
3036 UFWORD(UFO_BACKTRACE_TASK) {
3037   UfoState *st = ufoFindState(ufoPop());
3038   if (st == NULL) ufoFatal("invalid state id");
3039   // temporarily switch the task
3040   UfoState *oldst = ufoCurrState; ufoCurrState = st;
3041   // dump
3042   ufoFlushOutput();
3043   if (!ufoLastEmitWasCR) { printf("\n"); ufoLastEmitWasCR = 1; }
3044   if (ufoInFile != NULL) {
3045     fprintf(stderr, "*** at file %s, line %d ***\n", ufoInFileName, ufoInFileLine);
3046   } else {
3047     fprintf(stderr, "*** somewhere in time ***\n");
3048   }
3049   ufoBacktrace(ufoIP, 1);
3050   // restore state
3051   ufoCurrState = oldst;
3052 }
3053
3054
3055 // ////////////////////////////////////////////////////////////////////////// //
3056 // some init words, and PAD
3057 //
3058
3059 // SP0!
3060 // ( -- )
3061 UFWORD(SP0_STORE) { ufoSP = 0; }
3062
3063 // RP0!
3064 // ( -- )
3065 UFWORD(RP0_STORE) {
3066   if (ufoRP != ufoRPTop) {
3067     ufoRP = ufoRPTop;
3068     // we need to push a dummy value
3069     ufoRPush(0xdeadf00d);
3070   }
3071 }
3072
3073 // PAD
3074 // ( -- pad )
3075 // PAD is at the beginning of temp area
3076 UFWORD(PAD) {
3077   ufoPush(UFO_PAD_ADDR);
3078 }
3079
3080
3081 // ////////////////////////////////////////////////////////////////////////// //
3082 // peeks and pokes with address register
3083 //
3084
3085 // A>
3086 // ( -- regA )
3087 UFWORD(REGA_LOAD) {
3088   ufoPush(ufoRegA);
3089 }
3090
3091 // >A
3092 // ( regA -- )
3093 UFWORD(REGA_STORE) {
3094   ufoRegA = ufoPop();
3095 }
3096
3097 // A-SWAP
3098 // ( regA -- oldA )
3099 // swap TOS and A
3100 UFWORD(REGA_SWAP) {
3101   const uint32_t newa = ufoPop();
3102   ufoPush(ufoRegA);
3103   ufoRegA = newa;
3104 }
3105
3106 // +1>A
3107 // ( -- )
3108 UFWORD(REGA_INC) {
3109   ufoRegA += 1u;
3110 }
3111
3112 // +4>A
3113 // ( -- )
3114 UFWORD(REGA_INC_CELL) {
3115   ufoRegA += 4u;
3116 }
3117
3118 // A>R
3119 // ( -- | rega )
3120 UFWORD(REGA_TO_R) {
3121   ufoRPush(ufoRegA);
3122 }
3123
3124 // R>A
3125 // ( | rega -- )
3126 UFWORD(R_TO_REGA) {
3127   ufoRegA = ufoRPop();
3128 }
3129
3130
3131 // ////////////////////////////////////////////////////////////////////////// //
3132 // useful to work with handles and normal addreses uniformly
3133 //
3134
3135 // C@A+
3136 // ( idx -- byte )
3137 UFWORD(CPEEK_REGA_IDX) {
3138   if ((ufoRegA & UFO_ADDR_HANDLE_BIT) == 0) {
3139     const uint32_t idx = ufoPop();
3140     const uint32_t newaddr = ufoRegA + idx;
3141     if ((ufoRegA & UFO_ADDR_SPECIAL_BITS_MASK) == (newaddr & UFO_ADDR_SPECIAL_BITS_MASK)) {
3142       ufoPush(ufoImgGetU8Ext(newaddr));
3143     } else {
3144       ufoFatal("address offset out of range; addr=0x%08x; offset=%u; res=0x%08x",
3145                ufoRegA, idx, newaddr);
3146     }
3147   } else {
3148     ufoPush(ufoRegA);
3149     UFCALL(PAR_HANDLE_LOAD_BYTE);
3150   }
3151 }
3152
3153 // W@A+
3154 // ( idx -- word )
3155 UFWORD(WPEEK_REGA_IDX) {
3156   if ((ufoRegA & UFO_ADDR_HANDLE_BIT) == 0) {
3157     const uint32_t idx = ufoPop();
3158     const uint32_t newaddr = ufoRegA + idx;
3159     if ((ufoRegA & UFO_ADDR_SPECIAL_BITS_MASK) == (newaddr & UFO_ADDR_SPECIAL_BITS_MASK) &&
3160         (ufoRegA & UFO_ADDR_SPECIAL_BITS_MASK) == ((newaddr + 1u) & UFO_ADDR_SPECIAL_BITS_MASK))
3161     {
3162       ufoPush(ufoImgGetU16(newaddr));
3163     } else {
3164       ufoFatal("address offset out of range; addr=0x%08x; offset=%u; res=0x%08x",
3165                ufoRegA, idx, newaddr);
3166     }
3167   } else {
3168     ufoPush(ufoRegA);
3169     UFCALL(PAR_HANDLE_LOAD_WORD);
3170   }
3171 }
3172
3173 // @A+
3174 // ( idx -- value )
3175 UFWORD(PEEK_REGA_IDX) {
3176   if ((ufoRegA & UFO_ADDR_HANDLE_BIT) == 0) {
3177     const uint32_t idx = ufoPop();
3178     const uint32_t newaddr = ufoRegA + idx;
3179     if ((ufoRegA & UFO_ADDR_SPECIAL_BITS_MASK) == (newaddr & UFO_ADDR_SPECIAL_BITS_MASK) &&
3180         (ufoRegA & UFO_ADDR_SPECIAL_BITS_MASK) == ((newaddr + 3u) & UFO_ADDR_SPECIAL_BITS_MASK))
3181     {
3182       ufoPush(ufoImgGetU32(newaddr));
3183     } else {
3184       ufoFatal("address offset out of range; addr=0x%08x; offset=%u; res=0x%08x",
3185                ufoRegA, idx, newaddr);
3186     }
3187   } else {
3188     ufoPush(ufoRegA);
3189     UFCALL(PAR_HANDLE_LOAD_CELL);
3190   }
3191 }
3192
3193 // C!A+
3194 // ( byte idx -- )
3195 UFWORD(CPOKE_REGA_IDX) {
3196   if ((ufoRegA & UFO_ADDR_HANDLE_BIT) == 0) {
3197     const uint32_t idx = ufoPop();
3198     const uint32_t newaddr = ufoRegA + idx;
3199     if ((ufoRegA & UFO_ADDR_SPECIAL_BITS_MASK) == (newaddr & UFO_ADDR_SPECIAL_BITS_MASK)) {
3200       const uint32_t value = ufoPop();
3201       ufoImgPutU8(newaddr, value);
3202     } else {
3203       ufoFatal("address offset out of range; addr=0x%08x; offset=%u; res=0x%08x",
3204                ufoRegA, idx, newaddr);
3205     }
3206   } else {
3207     ufoPush(ufoRegA);
3208     UFCALL(PAR_HANDLE_STORE_BYTE);
3209   }
3210 }
3211
3212 // W!A+
3213 // ( word idx -- )
3214 UFWORD(WPOKE_REGA_IDX) {
3215   if ((ufoRegA & UFO_ADDR_HANDLE_BIT) == 0) {
3216     const uint32_t idx = ufoPop();
3217     const uint32_t newaddr = ufoRegA + idx;
3218     if ((ufoRegA & UFO_ADDR_SPECIAL_BITS_MASK) == (newaddr & UFO_ADDR_SPECIAL_BITS_MASK) &&
3219         (ufoRegA & UFO_ADDR_SPECIAL_BITS_MASK) == ((newaddr + 1u) & UFO_ADDR_SPECIAL_BITS_MASK))
3220     {
3221       const uint32_t value = ufoPop();
3222       ufoImgPutU16(newaddr, value);
3223     } else {
3224       ufoFatal("address offset out of range; addr=0x%08x; offset=%u; res=0x%08x",
3225                ufoRegA, idx, newaddr);
3226     }
3227   } else {
3228     ufoPush(ufoRegA);
3229     UFCALL(PAR_HANDLE_STORE_WORD);
3230   }
3231 }
3232
3233 // !A+
3234 // ( value idx -- )
3235 UFWORD(POKE_REGA_IDX) {
3236   if ((ufoRegA & UFO_ADDR_HANDLE_BIT) == 0) {
3237     const uint32_t idx = ufoPop();
3238     const uint32_t newaddr = ufoRegA + idx;
3239     if ((ufoRegA & UFO_ADDR_SPECIAL_BITS_MASK) == (newaddr & UFO_ADDR_SPECIAL_BITS_MASK) &&
3240         (ufoRegA & UFO_ADDR_SPECIAL_BITS_MASK) == ((newaddr + 3u) & UFO_ADDR_SPECIAL_BITS_MASK))
3241     {
3242       const uint32_t value = ufoPop();
3243       ufoImgPutU32(newaddr, value);
3244     } else {
3245       ufoFatal("address offset out of range; addr=0x%08x; offset=%u; res=0x%08x",
3246                ufoRegA, idx, newaddr);
3247     }
3248   } else {
3249     ufoPush(ufoRegA);
3250     UFCALL(PAR_HANDLE_STORE_CELL);
3251   }
3252 }
3253
3254
3255 // ////////////////////////////////////////////////////////////////////////// //
3256 // peeks and pokes
3257 //
3258
3259 // C@
3260 // ( addr -- value8 )
3261 UFWORD(CPEEK) {
3262   ufoPush(ufoImgGetU8Ext(ufoPop()));
3263 }
3264
3265 // W@
3266 // ( addr -- value16 )
3267 UFWORD(WPEEK) {
3268   const uint32_t addr = ufoPop();
3269   if ((addr & UFO_ADDR_HANDLE_BIT) == 0) {
3270     ufoPush(ufoImgGetU16(addr));
3271   } else {
3272     ufoPush(0);
3273     ufoPush(addr);
3274     UFCALL(PAR_HANDLE_LOAD_WORD);
3275   }
3276 }
3277
3278 // @
3279 // ( addr -- value32 )
3280 UFWORD(PEEK) {
3281   const uint32_t addr = ufoPop();
3282   if ((addr & UFO_ADDR_HANDLE_BIT) == 0) {
3283     ufoPush(ufoImgGetU32(addr));
3284   } else {
3285     ufoPush(0);
3286     ufoPush(addr);
3287     UFCALL(PAR_HANDLE_LOAD_CELL);
3288   }
3289 }
3290
3291 // C!
3292 // ( val8 addr -- )
3293 UFWORD(CPOKE) {
3294   const uint32_t addr = ufoPop();
3295   const uint32_t val = ufoPop();
3296   ufoImgPutU8Ext(addr, val);
3297 }
3298
3299 // W!
3300 // ( val16 addr -- )
3301 UFWORD(WPOKE) {
3302   const uint32_t addr = ufoPop();
3303   const uint32_t val = ufoPop();
3304   if ((addr & UFO_ADDR_HANDLE_BIT) == 0) {
3305     ufoImgPutU16(addr, val);
3306   } else {
3307     ufoPush(val);
3308     ufoPush(0);
3309     ufoPush(addr);
3310     UFCALL(PAR_HANDLE_STORE_WORD);
3311   }
3312 }
3313
3314 // !
3315 // ( val32 addr -- )
3316 UFWORD(POKE) {
3317   const uint32_t addr = ufoPop();
3318   const uint32_t val = ufoPop();
3319   if ((addr & UFO_ADDR_HANDLE_BIT) == 0) {
3320     ufoImgPutU32(addr, val);
3321   } else {
3322     ufoPush(val);
3323     ufoPush(0);
3324     ufoPush(addr);
3325     UFCALL(PAR_HANDLE_STORE_CELL);
3326   }
3327 }
3328
3329
3330 // ////////////////////////////////////////////////////////////////////////// //
3331 // dictionary emitters
3332 //
3333
3334 // C,
3335 // ( val8 -- )
3336 UFWORD(CCOMMA) { const uint32_t val = ufoPop(); ufoImgEmitU8(val); }
3337
3338 // W,
3339 // ( val16 -- )
3340 UFWORD(WCOMMA) { const uint32_t val = ufoPop(); ufoImgEmitU8(val&0xffU); ufoImgEmitU8((val >> 8)&0xffU); }
3341
3342 // ,
3343 // ( val -- )
3344 UFWORD(COMMA) { const uint32_t val = ufoPop(); ufoImgEmitU32(val); }
3345
3346
3347 // ////////////////////////////////////////////////////////////////////////// //
3348 // literal pushers
3349 //
3350
3351 // (LIT) ( -- n )
3352 UFWORD(PAR_LIT) {
3353   const uint32_t v = ufoImgGetU32(ufoIP); ufoIP += 4;
3354   ufoPush(v);
3355 }
3356
3357 // (LITCFA) ( -- n )
3358 UFWORD(PAR_LITCFA) {
3359   const uint32_t v = ufoImgGetU32(ufoIP); ufoIP += 4;
3360   ufoPush(v);
3361 }
3362
3363 // (LITVOCID) ( -- n )
3364 UFWORD(PAR_LITVOCID) {
3365   const uint32_t v = ufoImgGetU32(ufoIP); ufoIP += 4;
3366   ufoPush(v);
3367 }
3368
3369 // (LITSTR8)
3370 UFWORD(PAR_LITSTR8) {
3371   const uint32_t count = ufoImgGetU8(ufoIP); ufoIP += 1;
3372   ufoPush(ufoIP);
3373   ufoPush(count);
3374   ufoIP += count + 1; // 1 for terminating 0
3375   // align
3376   ufoIP = UFO_ALIGN4(ufoIP);
3377 }
3378
3379
3380 // ////////////////////////////////////////////////////////////////////////// //
3381 // jumps, etc.
3382 //
3383
3384 // (BRANCH) ( -- )
3385 UFWORD(PAR_BRANCH) {
3386   ufoIP = ufoImgGetU32(ufoIP);
3387 }
3388
3389 // (TBRANCH) ( flag )
3390 UFWORD(PAR_TBRANCH) {
3391   if (ufoPop()) {
3392     ufoIP = ufoImgGetU32(ufoIP);
3393   } else {
3394     ufoIP += 4;
3395   }
3396 }
3397
3398 // (0BRANCH) ( flag )
3399 UFWORD(PAR_0BRANCH) {
3400   if (!ufoPop()) {
3401     ufoIP = ufoImgGetU32(ufoIP);
3402   } else {
3403     ufoIP += 4;
3404   }
3405 }
3406
3407 // (+0BRANCH) ( flag )
3408 UFWORD(PAR_P0BRANCH) {
3409   if ((ufoPop() & 0x80000000u) == 0) {
3410     ufoIP = ufoImgGetU32(ufoIP);
3411   } else {
3412     ufoIP += 4;
3413   }
3414 }
3415
3416 // (+BRANCH) ( flag )
3417 UFWORD(PAR_PBRANCH) {
3418   const uint32_t v = ufoPop();
3419   if (v > 0 && v < 0x80000000u) {
3420     ufoIP = ufoImgGetU32(ufoIP);
3421   } else {
3422     ufoIP += 4;
3423   }
3424 }
3425
3426 // (-0BRANCH) ( flag )
3427 UFWORD(PAR_M0BRANCH) {
3428   const uint32_t v = ufoPop();
3429   if (v == 0 || v >= 0x80000000u) {
3430     ufoIP = ufoImgGetU32(ufoIP);
3431   } else {
3432     ufoIP += 4;
3433   }
3434 }
3435
3436 // (-BRANCH) ( flag )
3437 UFWORD(PAR_MBRANCH) {
3438   if ((ufoPop() & 0x80000000u) != 0) {
3439     ufoIP = ufoImgGetU32(ufoIP);
3440   } else {
3441     ufoIP += 4;
3442   }
3443 }
3444
3445 // (DATASKIP) ( -- )
3446 UFWORD(PAR_DATASKIP) {
3447   ufoIP += ufoImgGetU32(ufoIP) + 4u;
3448 }
3449
3450
3451 // ////////////////////////////////////////////////////////////////////////// //
3452 // execute words by CFA
3453 //
3454
3455 // EXECUTE ( cfa )
3456 UFWORD(EXECUTE) {
3457   ufoRPush(ufoPop());
3458   ufoVMRPopCFA = 1;
3459 }
3460
3461 // EXECUTE-TAIL ( cfa )
3462 UFWORD(EXECUTE_TAIL) {
3463   ufoIP = ufoRPop();
3464   ufoRPush(ufoPop());
3465   ufoVMRPopCFA = 1;
3466 }
3467
3468
3469 // ////////////////////////////////////////////////////////////////////////// //
3470 // word termination, locals support
3471 //
3472
3473 // (EXIT)
3474 UFWORD(PAR_EXIT) {
3475   ufoIP = ufoRPop();
3476 }
3477
3478 // (L-ENTER)
3479 // ( loccount -- )
3480 UFWORD(PAR_LENTER) {
3481   // low byte of loccount is total number of locals
3482   // high byte is the number of args
3483   uint32_t lcount = ufoImgGetU32(ufoIP); ufoIP += 4u;
3484   uint32_t acount = (lcount >> 8) & 0xff;
3485   lcount &= 0xff;
3486   if (lcount == 0 || lcount < acount) ufoFatal("invalid call to (L-ENTER)");
3487   if ((ufoLBP != 0 && ufoLBP >= ufoLP) || UFO_LSTACK_SIZE - ufoLP <= lcount + 2) {
3488     ufoFatal("out of locals stack");
3489   }
3490   uint32_t newbp;
3491   if (ufoLP == 0) { ufoLP = 1; newbp = 1; } else newbp = ufoLP;
3492   //fprintf(stderr, "LP: %u; LBP: %u; locs: %u; word: %s\n", ufoLP, ufoLBP, fw->locs, fw->name);
3493   ufoLStack[ufoLP] = ufoLBP; ufoLP += 1;
3494   ufoLBP = newbp; ufoLP += lcount;
3495   // and copy args
3496   newbp += acount;
3497   while (newbp != ufoLBP) {
3498     ufoLStack[newbp] = ufoPop();
3499     newbp -= 1;
3500   }
3501 }
3502
3503 // (L-LEAVE)
3504 UFWORD(PAR_LLEAVE) {
3505   if (ufoLBP == 0) ufoFatal("(L-LEAVE) with empty locals stack");
3506   if (ufoLBP >= ufoLP) ufoFatal("(L-LEAVE) broken locals stack");
3507   ufoLP = ufoLBP;
3508   ufoLBP = ufoLStack[ufoLBP];
3509 }
3510
3511 //==========================================================================
3512 //
3513 //  ufoLoadLocal
3514 //
3515 //==========================================================================
3516 UFO_FORCE_INLINE void ufoLoadLocal (const uint32_t lidx) {
3517   if (lidx == 0 || lidx >= UFO_LSTACK_SIZE) ufoFatal("invalid local index");
3518   if (ufoLBP == 0 || ufoLBP >= ufoLP || ufoLP - ufoLBP <= lidx) ufoFatal("invalid local index");
3519   ufoPush(ufoLStack[ufoLBP + lidx]);
3520 }
3521
3522 //==========================================================================
3523 //
3524 //  ufoStoreLocal
3525 //
3526 //==========================================================================
3527 UFO_FORCE_INLINE void ufoStoreLocal (const uint32_t lidx) {
3528   const uint32_t value = ufoPop();
3529   if (lidx == 0 || lidx >= UFO_LSTACK_SIZE) ufoFatal("invalid local index");
3530   if (ufoLBP == 0 || ufoLBP >= ufoLP || ufoLP - ufoLBP <= lidx) ufoFatal("invalid local index");
3531   ufoLStack[ufoLBP + lidx] = value;
3532 }
3533
3534 // (LOCAL@)
3535 // ( idx -- value )
3536 UFWORD(PAR_LOCAL_LOAD) { ufoLoadLocal(ufoPop()); }
3537
3538 // (LOCAL!)
3539 // ( value idx -- )
3540 UFWORD(PAR_LOCAL_STORE) { ufoStoreLocal(ufoPop()); }
3541
3542
3543 // ////////////////////////////////////////////////////////////////////////// //
3544 // stack manipulation
3545 //
3546
3547 // DUP
3548 // ( n -- n n )
3549 UFWORD(DUP) { ufoDup(); }
3550 // ?DUP
3551 // ( n -- n n ) | ( 0 -- 0 )
3552 UFWORD(QDUP) { if (ufoPeek()) ufoDup(); }
3553 // 2DUP
3554 // ( n0 n1 -- n0 n1 n0 n1 )
3555 UFWORD(DDUP) { ufo2Dup(); }
3556 // DROP
3557 // ( n -- )
3558 UFWORD(DROP) { ufoDrop(); }
3559 // 2DROP
3560 // ( n0 n1 -- )
3561 UFWORD(DDROP) { ufo2Drop(); }
3562 // SWAP
3563 // ( n0 n1 -- n1 n0 )
3564 UFWORD(SWAP) { ufoSwap(); }
3565 // 2SWAP
3566 // ( n0 n1 -- n1 n0 )
3567 UFWORD(DSWAP) { ufo2Swap(); }
3568 // OVER
3569 // ( n0 n1 -- n0 n1 n0 )
3570 UFWORD(OVER) { ufoOver(); }
3571 // 2OVER
3572 // ( n0 n1 -- n0 n1 n0 )
3573 UFWORD(DOVER) { ufo2Over(); }
3574 // ROT
3575 // ( n0 n1 n2 -- n1 n2 n0 )
3576 UFWORD(ROT) { ufoRot(); }
3577 // NROT
3578 // ( n0 n1 n2 -- n2 n0 n1 )
3579 UFWORD(NROT) { ufoNRot(); }
3580
3581 // RDUP
3582 // ( n -- n n )
3583 UFWORD(RDUP) { ufoRDup(); }
3584 // RDROP
3585 // ( n -- )
3586 UFWORD(RDROP) { ufoRDrop(); }
3587
3588 // >R
3589 // ( n -- | n )
3590 UFWORD(DTOR) { ufoRPush(ufoPop()); }
3591 // R>
3592 // ( | n -- n )
3593 UFWORD(RTOD) { ufoPush(ufoRPop()); }
3594 // R@
3595 // ( | n -- n | n)
3596 UFWORD(RPEEK) { ufoPush(ufoRPeek()); }
3597
3598 // PICK
3599 // ( idx -- n )
3600 UFWORD(PICK) {
3601   const uint32_t n = ufoPop();
3602   if (n >= ufoSP) ufoFatal("invalid PICK index %u", n);
3603   ufoPush(ufoDStack[ufoSP - n - 1u]);
3604 }
3605
3606 // RPICK
3607 // ( idx -- n )
3608 UFWORD(RPICK) {
3609   const uint32_t n = ufoPop();
3610   if (n >= ufoRP - ufoRPTop) ufoFatal("invalid RPICK index %u", n);
3611   const uint32_t rp = ufoRP - n - 1u;
3612   ufoPush(ufoRStack[rp]);
3613 }
3614
3615 // ROLL
3616 // ( idx -- n )
3617 UFWORD(ROLL) {
3618   const uint32_t n = ufoPop();
3619   if (n >= ufoSP) ufoFatal("invalid ROLL index %u", n);
3620   switch (n) {
3621     case 0: break; // do nothing
3622     case 1: ufoSwap(); break;
3623     case 2: ufoRot(); break;
3624     default:
3625       {
3626         const uint32_t val = ufoDStack[ufoSP - n - 1u];
3627         for (uint32_t f = ufoSP - n; f < ufoSP; f += 1) ufoDStack[f - 1] = ufoDStack[f];
3628         ufoDStack[ufoSP - 1u] = val;
3629       }
3630       break;
3631   }
3632 }
3633
3634 // RROLL
3635 // ( idx -- n )
3636 UFWORD(RROLL) {
3637   const uint32_t n = ufoPop();
3638   if (n >= ufoRP - ufoRPTop) ufoFatal("invalid RROLL index %u", n);
3639   if (n != 0) {
3640     const uint32_t rp = ufoRP - n - 1u;
3641     const uint32_t val = ufoRStack[rp];
3642     for (uint32_t f = rp + 1u; f < ufoRP; f += 1u) ufoRStack[f - 1u] = ufoRStack[f];
3643     ufoRStack[ufoRP - 1u] = val;
3644   }
3645 }
3646
3647 // RSWAP
3648 // ( | a b -- | b a )
3649 UFWORD(RSWAP) {
3650   const uint32_t b = ufoRPop();
3651   const uint32_t a = ufoRPop();
3652   ufoRPush(b); ufoRPush(a);
3653 }
3654
3655 // ROVER
3656 // ( | a b -- | a b a )
3657 UFWORD(ROVER) {
3658   const uint32_t b = ufoRPop();
3659   const uint32_t a = ufoRPop();
3660   ufoRPush(a); ufoRPush(b); ufoRPush(a);
3661 }
3662
3663 // RROT
3664 // ( | a b c -- | b c a )
3665 UFWORD(RROT) {
3666   const uint32_t c = ufoRPop();
3667   const uint32_t b = ufoRPop();
3668   const uint32_t a = ufoRPop();
3669   ufoRPush(b); ufoRPush(c); ufoRPush(a);
3670 }
3671
3672 // RNROT
3673 // ( | a b c -- | c a b )
3674 UFWORD(RNROT) {
3675   const uint32_t c = ufoRPop();
3676   const uint32_t b = ufoRPop();
3677   const uint32_t a = ufoRPop();
3678   ufoRPush(c); ufoRPush(a); ufoRPush(b);
3679 }
3680
3681
3682 // ////////////////////////////////////////////////////////////////////////// //
3683 // TIB API
3684 //
3685
3686 // REFILL
3687 // ( -- eofflag )
3688 UFWORD(REFILL) {
3689   ufoPushBool(ufoLoadNextLine(1));
3690 }
3691
3692 // REFILL-NOCROSS
3693 // ( -- eofflag )
3694 UFWORD(REFILL_NOCROSS) {
3695   ufoPushBool(ufoLoadNextLine(0));
3696 }
3697
3698 // (TIB-IN)
3699 // ( -- addr )
3700 UFWORD(TIB_IN) {
3701   ufoPush(ufoImgGetU32(ufoAddrTIBx) + ufoImgGetU32(ufoAddrINx));
3702 }
3703
3704 // TIB-PEEKCH
3705 // ( -- char )
3706 UFWORD(TIB_PEEKCH) {
3707   ufoPush(ufoTibPeekCh());
3708 }
3709
3710 // TIB-PEEKCH-OFS
3711 // ( ofs -- char )
3712 UFWORD(TIB_PEEKCH_OFS) {
3713   const uint32_t ofs = ufoPop();
3714   ufoPush(ufoTibPeekChOfs(ofs));
3715 }
3716
3717 // TIB-GETCH
3718 // ( -- char )
3719 UFWORD(TIB_GETCH) {
3720   ufoPush(ufoTibGetCh());
3721 }
3722
3723 // TIB-SKIPCH
3724 // ( -- )
3725 UFWORD(TIB_SKIPCH) {
3726   ufoTibSkipCh();
3727 }
3728
3729
3730 // ////////////////////////////////////////////////////////////////////////// //
3731 // TIB parsing
3732 //
3733
3734 //==========================================================================
3735 //
3736 //  ufoIsDelim
3737 //
3738 //==========================================================================
3739 UFO_FORCE_INLINE int ufoIsDelim (uint8_t ch, uint8_t delim) {
3740   return (delim == 32 ? (ch <= 32) : (ch == delim));
3741 }
3742
3743 // (PARSE)
3744 // ( delim skip-leading-delim? -- addr count TRUE / FALSE )
3745 // does base TIB parsing; never copies anything.
3746 // as our reader is line-based, returns FALSE on EOL.
3747 // EOL is detected after skipping leading delimiters.
3748 // passing -1 as delimiter skips the whole line, and always returns FALSE.
3749 // trailing delimiter is always skipped.
3750 UFWORD(PAR_PARSE) {
3751   const uint32_t skipDelim = ufoPop();
3752   const uint32_t delim = ufoPop();
3753   uint8_t ch;
3754
3755   if (delim == 0 || delim > 0xffU) {
3756     // skip everything
3757     while (ufoTibGetCh() != 0) {}
3758     ufoPushBool(0);
3759   } else {
3760     ch = ufoTibPeekCh();
3761     // skip initial delimiters
3762     if (skipDelim) {
3763       while (ch != 0 && ufoIsDelim(ch, delim)) {
3764         ufoTibSkipCh();
3765         ch = ufoTibPeekCh();
3766       }
3767     }
3768     if (ch == 0) {
3769       ufoPushBool(0);
3770     } else {
3771       // parse
3772       const uint32_t staddr = ufoImgGetU32(ufoAddrTIBx) + ufoImgGetU32(ufoAddrINx);
3773       uint32_t count = 0;
3774       while (ch != 0 && !ufoIsDelim(ch, delim)) {
3775         count += 1u;
3776         ufoTibSkipCh();
3777         ch = ufoTibPeekCh();
3778       }
3779       // skip delimiter
3780       if (ch != 0) ufoTibSkipCh();
3781       ufoPush(staddr);
3782       ufoPush(count);
3783       ufoPushBool(1);
3784     }
3785   }
3786 }
3787
3788 // PARSE-SKIP-BLANKS
3789 // ( -- )
3790 UFWORD(PARSE_SKIP_BLANKS) {
3791   uint8_t ch = ufoTibPeekCh();
3792   while (ch != 0 && ch <= 32) {
3793     ufoTibSkipCh();
3794     ch = ufoTibPeekCh();
3795   }
3796 }
3797
3798 //==========================================================================
3799 //
3800 //  ufoParseMLComment
3801 //
3802 //  initial two chars are skipped
3803 //
3804 //==========================================================================
3805 static void ufoParseMLComment (uint32_t allowMulti, int nested) {
3806   uint32_t level = 1;
3807   uint8_t ch, ch1;
3808   while (level != 0) {
3809     ch = ufoTibGetCh();
3810     if (ch == 0) {
3811       if (allowMulti) {
3812         UFCALL(REFILL_NOCROSS);
3813         if (ufoPop() == 0) ufoFatal("unexpected end of file in comment");
3814       } else {
3815         ufoFatal("unexpected end of line in comment");
3816       }
3817     } else {
3818       ch1 = ufoTibPeekCh();
3819       if (nested && ch == '(' && ch1 == '(') { ufoTibSkipCh(); level += 1; }
3820       else if (nested && ch == ')' && ch1 == ')') { ufoTibSkipCh(); level -= 1; }
3821       else if (!nested && ch == '*' && ch1 == ')') { ufo_assert(level == 1); ufoTibSkipCh(); level = 0; }
3822     }
3823   }
3824 }
3825
3826 // (PARSE-SKIP-COMMENTS)
3827 // ( allow-multiline? -- )
3828 // skip all blanks and comments
3829 UFWORD(PAR_PARSE_SKIP_COMMENTS) {
3830   const uint32_t allowMulti = ufoPop();
3831   uint8_t ch, ch1;
3832   ch = ufoTibPeekCh();
3833   #if 0
3834   fprintf(stderr, "(PARSE-SKIP-COMMENTS): first-ch:'%c'\n", (char)ch);
3835   #endif
3836   while (ch != 0) {
3837     if (ch <= 32) {
3838       ufoTibSkipCh();
3839       ch = ufoTibPeekCh();
3840       #if 0
3841       fprintf(stderr, "(PARSE-SKIP-COMMENTS): blank-ch:'%c'\n", (char)ch);
3842       #endif
3843     } else if (ch == '(') {
3844       #if 0
3845       fprintf(stderr, "(PARSE-SKIP-COMMENTS): ch:'%c'; ch1:'%c' ('%c')\n", (char)ch, (char)ch1,
3846               ufoTibPeekChOfs(0));
3847       #endif
3848       ch1 = ufoTibPeekChOfs(1);
3849       if (ch1 <= 32) {
3850         // single-line comment
3851         do { ch = ufoTibGetCh(); } while (ch != 0 && ch != ')');
3852         ch = ufoTibPeekCh();
3853       } else if ((ch1 == '*' || ch1 == '(') && ufoTibPeekChOfs(2) <= 32) {
3854         // possibly multiline
3855         ufoTibSkipCh(); ufoTibSkipCh(); // skip opening
3856         ufoParseMLComment(allowMulti, (ch1 == '('));
3857         ch = ufoTibPeekCh();
3858       } else {
3859         ch = 0;
3860       }
3861     } else if (ch == '\\' && ufoTibPeekChOfs(1) <= 32) {
3862       // single-line comment
3863       while (ch != 0) ch = ufoTibGetCh();
3864     } else if (ch == '-' && ufoTibPeekChOfs(1) == ch && ufoTibPeekChOfs(2) <= 32) {
3865       // skip to EOL
3866       while (ch != 0) ch = ufoTibGetCh();
3867     } else if ((ch == ';' || ch == '/') && ufoTibPeekChOfs(1) == ch) {
3868       // skip to EOL
3869       while (ch != 0) ch = ufoTibGetCh();
3870     } else {
3871       ch = 0;
3872     }
3873   }
3874   #if 0
3875   fprintf(stderr, "(PARSE-SKIP-COMMENTS): end-ch:'%c'\n", ufoTibPeekCh());
3876   #endif
3877 }
3878
3879 // PARSE-SKIP-LINE
3880 // ( -- )
3881 UFWORD(PARSE_SKIP_LINE) {
3882   ufoPush(0); ufoPushBool(0); UFCALL(PAR_PARSE);
3883   if (ufoPop() != 0) {
3884     ufo2Drop();
3885   }
3886 }
3887
3888 // PARSE-NAME
3889 // ( -- addr count )
3890 // parse with leading blanks skipping. doesn't copy anything.
3891 // return empty string on EOL.
3892 UFWORD(PARSE_NAME) {
3893   ufoPush(32); ufoPushBool(1); UFCALL(PAR_PARSE);
3894   if (ufoPop() == 0) {
3895     ufoPush(0);
3896     ufoPush(0);
3897   }
3898 }
3899
3900 // PARSE
3901 // ( delim -- addr count TRUE / FALSE )
3902 // parse without skipping delimiters; never copies anything.
3903 // as our reader is line-based, returns FALSE on EOL.
3904 // passing 0 as delimiter skips the whole line, and always returns FALSE.
3905 // trailing delimiter is always skipped.
3906 UFWORD(PARSE) {
3907   ufoPushBool(0); UFCALL(PAR_PARSE);
3908 }
3909
3910
3911 // ////////////////////////////////////////////////////////////////////////// //
3912 // char output
3913 //
3914
3915 // (NORM-EMIT-CHAR)
3916 // ( ch -- )
3917 UFWORD(PAR_NORM_EMIT_CHAR) {
3918   uint32_t ch = ufoPop()&0xffU;
3919   if (ch < 32 || ch == 127) {
3920     if (ch != 9 && ch != 10 && ch != 13) ch = '?';
3921   }
3922   ufoPush(ch);
3923 }
3924
3925 // (NORM-XEMIT-CHAR)
3926 // ( ch -- )
3927 UFWORD(PAR_NORM_XEMIT_CHAR) {
3928   uint32_t ch = ufoPop()&0xffU;
3929   if (ch < 32 || ch == 127) ch = '?';
3930   ufoPush(ch);
3931 }
3932
3933 // (EMIT)
3934 // ( n -- )
3935 UFWORD(PAR_EMIT) {
3936   uint32_t ch = ufoPop()&0xffU;
3937   ufoLastEmitWasCR = (ch == 10);
3938   putchar((char)ch);
3939 }
3940
3941 // LASTCR?
3942 // ( -- bool )
3943 UFWORD(LASTCRQ) {
3944   ufoPushBool(ufoLastEmitWasCR);
3945 }
3946
3947 // LASTCR!
3948 // ( bool -- )
3949 UFWORD(LASTCRSET) {
3950   ufoLastEmitWasCR = !!ufoPop();
3951 }
3952
3953 // FLUSH-EMIT
3954 // ( -- )
3955 UFWORD(FLUSH_EMIT) {
3956   ufoFlushOutput();
3957 }
3958
3959
3960 // ////////////////////////////////////////////////////////////////////////// //
3961 // simple math
3962 //
3963
3964 #define UF_UMATH(name_,op_)  \
3965 UFWORD(name_) { \
3966   const uint32_t a = ufoPop(); \
3967   ufoPush(op_); \
3968 }
3969
3970 #define UF_BMATH(name_,op_)  \
3971 UFWORD(name_) { \
3972   const uint32_t b = ufoPop(); \
3973   const uint32_t a = ufoPop(); \
3974   ufoPush(op_); \
3975 }
3976
3977 #define UF_BDIV(name_,op_)  \
3978 UFWORD(name_) { \
3979   const uint32_t b = ufoPop(); \
3980   const uint32_t a = ufoPop(); \
3981   if (b == 0) ufoFatal("division by zero"); \
3982   ufoPush(op_); \
3983 }
3984
3985 #define UFO_POP_U64()  ({ \
3986   const uint32_t hi_ = ufoPop(); \
3987   const uint32_t lo_ = ufoPop(); \
3988   (((uint64_t)hi_ << 32) | lo_); \
3989 })
3990
3991 // this is UB by the idiotic C standard. i don't care.
3992 #define UFO_POP_I64()  ((int64_t)UFO_POP_U64())
3993
3994 #define UFO_PUSH_U64(vn_)  do { \
3995   ufoPush((uint32_t)(vn_)); \
3996   ufoPush((uint32_t)((vn_) >> 32)); \
3997 } while (0)
3998
3999 // this is UB by the idiotic C standard. i don't care.
4000 #define UFO_PUSH_I64(vn_)  UFO_PUSH_U64((uint64_t)(vn_))
4001
4002 // +
4003 // ( a b -- a+b )
4004 UF_BMATH(PLUS, a + b);
4005
4006 // -
4007 // ( a b -- a-b )
4008 UF_BMATH(MINUS, a - b);
4009
4010 // *
4011 // ( a b -- a*b )
4012 UF_BMATH(MUL, (uint32_t)((int32_t)a * (int32_t)b));
4013
4014 // U*
4015 // ( a b -- a*b )
4016 UF_BMATH(UMUL, a * b);
4017
4018 // /
4019 // ( a b -- a/b )
4020 UF_BDIV(DIV, (uint32_t)((int32_t)a / (int32_t)b));
4021
4022 // U/
4023 // ( a b -- a/b )
4024 UF_BDIV(UDIV, a / b);
4025
4026 // MOD
4027 // ( a b -- a%b )
4028 UF_BDIV(MOD, (uint32_t)((int32_t)a % (int32_t)b));
4029
4030 // UMOD
4031 // ( a b -- a%b )
4032 UF_BDIV(UMOD, a % b);
4033
4034 // /MOD
4035 // ( a b -- a/b, a%b )
4036 UFWORD(DIVMOD) {
4037   const int32_t b = (int32_t)ufoPop();
4038   const int32_t a = (int32_t)ufoPop();
4039   if (b == 0) ufoFatal("division by zero");
4040   ufoPush((uint32_t)(a/b));
4041   ufoPush((uint32_t)(a%b));
4042 }
4043
4044 // U/MOD
4045 // ( a b -- a/b, a%b )
4046 UFWORD(UDIVMOD) {
4047   const uint32_t b = ufoPop();
4048   const uint32_t a = ufoPop();
4049   if (b == 0) ufoFatal("division by zero");
4050   ufoPush((uint32_t)(a/b));
4051   ufoPush((uint32_t)(a%b));
4052 }
4053
4054 // */
4055 // ( a b c -- a*b/c )
4056 // this uses 64-bit intermediate value
4057 UFWORD(MULDIV) {
4058   const int32_t c = (int32_t)ufoPop();
4059   const int32_t b = (int32_t)ufoPop();
4060   const int32_t a = (int32_t)ufoPop();
4061   if (c == 0) ufoFatal("division by zero");
4062   int64_t xval = a; xval *= b; xval /= c;
4063   ufoPush((uint32_t)(int32_t)xval);
4064 }
4065
4066 // U*/
4067 // ( a b c -- a*b/c )
4068 // this uses 64-bit intermediate value
4069 UFWORD(UMULDIV) {
4070   const uint32_t c = ufoPop();
4071   const uint32_t b = ufoPop();
4072   const uint32_t a = ufoPop();
4073   if (c == 0) ufoFatal("division by zero");
4074   uint64_t xval = a; xval *= b; xval /= c;
4075   ufoPush((uint32_t)xval);
4076 }
4077
4078 // */MOD
4079 // ( a b c -- a*b/c a*b%c )
4080 // this uses 64-bit intermediate value
4081 UFWORD(MULDIVMOD) {
4082   const int32_t c = (int32_t)ufoPop();
4083   const int32_t b = (int32_t)ufoPop();
4084   const int32_t a = (int32_t)ufoPop();
4085   if (c == 0) ufoFatal("division by zero");
4086   int64_t xval = a; xval *= b;
4087   ufoPush((uint32_t)(int32_t)(xval / c));
4088   ufoPush((uint32_t)(int32_t)(xval % c));
4089 }
4090
4091 // U*/
4092 // ( a b c -- a*b/c )
4093 // this uses 64-bit intermediate value
4094 UFWORD(UMULDIVMOD) {
4095   const uint32_t c = ufoPop();
4096   const uint32_t b = ufoPop();
4097   const uint32_t a = ufoPop();
4098   if (c == 0) ufoFatal("division by zero");
4099   uint64_t xval = a; xval *= b;
4100   ufoPush((uint32_t)(xval / c));
4101   ufoPush((uint32_t)(xval % c));
4102 }
4103
4104 // M*
4105 // ( a b -- lo(a*b) hi(a*b) )
4106 // this leaves 64-bit result
4107 UFWORD(MMUL) {
4108   const int32_t b = (int32_t)ufoPop();
4109   const int32_t a = (int32_t)ufoPop();
4110   int64_t xval = a; xval *= b;
4111   UFO_PUSH_I64(xval);
4112 }
4113
4114 // UM*
4115 // ( a b -- lo(a*b) hi(a*b) )
4116 // this leaves 64-bit result
4117 UFWORD(UMMUL) {
4118   const uint32_t b = ufoPop();
4119   const uint32_t a = ufoPop();
4120   uint64_t xval = a; xval *= b;
4121   UFO_PUSH_U64(xval);
4122 }
4123
4124 // M/MOD
4125 // ( alo ahi b -- a/b a%b )
4126 UFWORD(MDIVMOD) {
4127   const int32_t b = (int32_t)ufoPop();
4128   if (b == 0) ufoFatal("division by zero");
4129   int64_t a = UFO_POP_I64();
4130   int32_t adiv = (int32_t)(a / b);
4131   int32_t amod = (int32_t)(a % b);
4132   ufoPush((uint32_t)adiv);
4133   ufoPush((uint32_t)amod);
4134 }
4135
4136 // UM/MOD
4137 // ( alo ahi b -- a/b a%b )
4138 UFWORD(UMDIVMOD) {
4139   const uint32_t b = ufoPop();
4140   if (b == 0) ufoFatal("division by zero");
4141   uint64_t a = UFO_POP_U64();
4142   uint32_t adiv = (uint32_t)(a / b);
4143   uint32_t amod = (uint32_t)(a % b);
4144   ufoPush(adiv);
4145   ufoPush(amod);
4146 }
4147
4148 // UDS*
4149 // ( alo ahi u -- lo hi )
4150 UFWORD(UDSMUL) {
4151   const uint32_t b = ufoPop();
4152   uint64_t a = UFO_POP_U64();
4153   a *= b;
4154   UFO_PUSH_U64(a);
4155 }
4156
4157 // D-
4158 // ( lo0 hi0 lo1 hi1 -- lo hi )
4159 UFWORD(DMINUS) {
4160   uint64_t n1 = UFO_POP_U64();
4161   uint64_t n0 = UFO_POP_U64();
4162   n0 -= n1;
4163   UFO_PUSH_U64(n0);
4164 }
4165
4166 // D+
4167 // ( lo0 hi0 lo1 hi1 -- lo hi )
4168 UFWORD(DPLUS) {
4169   uint64_t n1 = UFO_POP_U64();
4170   uint64_t n0 = UFO_POP_U64();
4171   n0 += n1;
4172   UFO_PUSH_U64(n0);
4173 }
4174
4175 // D=
4176 // ( lo0 hi0 lo1 hi1 -- bool )
4177 UFWORD(DEQU) {
4178   uint64_t n1 = UFO_POP_U64();
4179   uint64_t n0 = UFO_POP_U64();
4180   ufoPushBool(n0 == n1);
4181 }
4182
4183 // D<
4184 // ( lo0 hi0 lo1 hi1 -- bool )
4185 UFWORD(DLESS) {
4186   int64_t n1 = UFO_POP_I64();
4187   int64_t n0 = UFO_POP_I64();
4188   ufoPushBool(n0 < n1);
4189 }
4190
4191 // D<=
4192 // ( lo0 hi0 lo1 hi1 -- bool )
4193 UFWORD(DLESSEQU) {
4194   int64_t n1 = UFO_POP_I64();
4195   int64_t n0 = UFO_POP_I64();
4196   ufoPushBool(n0 <= n1);
4197 }
4198
4199 // DU<
4200 // ( lo0 hi0 lo1 hi1 -- bool )
4201 UFWORD(DULESS) {
4202   uint64_t n1 = UFO_POP_U64();
4203   uint64_t n0 = UFO_POP_U64();
4204   ufoPushBool(n0 < n1);
4205 }
4206
4207 // DU<=
4208 // ( lo0 hi0 lo1 hi1 -- bool )
4209 UFWORD(DULESSEQU) {
4210   uint64_t n1 = UFO_POP_U64();
4211   uint64_t n0 = UFO_POP_U64();
4212   ufoPushBool(n0 <= n1);
4213 }
4214
4215 // SM/REM
4216 // ( dlo dhi n -- nmod ndiv )
4217 // rounds toward zero
4218 UFWORD(SMREM) {
4219   const int32_t n = (int32_t)ufoPop();
4220   if (n == 0) ufoFatal("division by zero");
4221   int64_t d = UFO_POP_I64();
4222   int32_t ndiv = (int32_t)(d / n);
4223   int32_t nmod = (int32_t)(d % n);
4224   ufoPush(nmod);
4225   ufoPush(ndiv);
4226 }
4227
4228 // FM/MOD
4229 // ( dlo dhi n -- nmod ndiv )
4230 // rounds toward negative infinity
4231 UFWORD(FMMOD) {
4232   const int32_t n = (int32_t)ufoPop();
4233   if (n == 0) ufoFatal("division by zero");
4234   int64_t d = UFO_POP_I64();
4235   int32_t ndiv = (int32_t)(d / n);
4236   int32_t nmod = (int32_t)(d % n);
4237   if (nmod != 0 && ((uint32_t)n ^ (uint32_t)(d >> 32)) >= 0x80000000u) {
4238     ndiv -= 1;
4239     nmod += n;
4240   }
4241   ufoPush(nmod);
4242   ufoPush(ndiv);
4243 }
4244
4245
4246 // ////////////////////////////////////////////////////////////////////////// //
4247 // simple logic and bit manipulation
4248 //
4249
4250 #define UF_CMP(name_,op_)  \
4251 UFWORD(name_) { \
4252   const uint32_t b = ufoPop(); \
4253   const uint32_t a = ufoPop(); \
4254   ufoPushBool(op_); \
4255 }
4256
4257 // <
4258 // ( a b -- a<b )
4259 UF_CMP(LESS, (int32_t)a < (int32_t)b);
4260
4261 // U<
4262 // ( a b -- a<b )
4263 UF_CMP(ULESS, a < b);
4264
4265 // >
4266 // ( a b -- a>b )
4267 UF_CMP(GREAT, (int32_t)a > (int32_t)b);
4268
4269 // U>
4270 // ( a b -- a>b )
4271 UF_CMP(UGREAT, a > b);
4272
4273 // <=
4274 // ( a b -- a<=b )
4275 UF_CMP(LESSEQU, (int32_t)a <= (int32_t)b);
4276
4277 // U<=
4278 // ( a b -- a<=b )
4279 UF_CMP(ULESSEQU, a <= b);
4280
4281 // >=
4282 // ( a b -- a>=b )
4283 UF_CMP(GREATEQU, (int32_t)a >= (int32_t)b);
4284
4285 // U>=
4286 // ( a b -- a>=b )
4287 UF_CMP(UGREATEQU, a >= b);
4288
4289 // =
4290 // ( a b -- a=b )
4291 UF_CMP(EQU, a == b);
4292
4293 // <>
4294 // ( a b -- a<>b )
4295 UF_CMP(NOTEQU, a != b);
4296
4297 // 0=
4298 // ( a -- a==0 )
4299 UFWORD(ZERO_EQU) {
4300   const uint32_t a = ufoPop();
4301   ufoPushBool(a == 0);
4302 }
4303
4304 // 0<>
4305 // ( a -- a<>0 )
4306 UFWORD(ZERO_NOTEQU) {
4307   const uint32_t a = ufoPop();
4308   ufoPushBool(a != 0);
4309 }
4310
4311 // LAND
4312 // ( a b -- a&&b )
4313 UF_CMP(LOGAND, a && b);
4314
4315 // LOR
4316 // ( a b -- a||b )
4317 UF_CMP(LOGOR, a || b);
4318
4319 // AND
4320 // ( a b -- a&b )
4321 UFWORD(AND) {
4322   const uint32_t b = ufoPop();
4323   const uint32_t a = ufoPop();
4324   ufoPush(a&b);
4325 }
4326
4327 // OR
4328 // ( a b -- a|b )
4329 UFWORD(OR) {
4330   const uint32_t b = ufoPop();
4331   const uint32_t a = ufoPop();
4332   ufoPush(a|b);
4333 }
4334
4335 // XOR
4336 // ( a b -- a^b )
4337 UFWORD(XOR) {
4338   const uint32_t b = ufoPop();
4339   const uint32_t a = ufoPop();
4340   ufoPush(a^b);
4341 }
4342
4343 // BITNOT
4344 // ( a -- ~a )
4345 UFWORD(BITNOT) {
4346   const uint32_t a = ufoPop();
4347   ufoPush(~a);
4348 }
4349
4350 // ASH
4351 // ( n count -- )
4352 // arithmetic shift; positive `n` shifts to the left
4353 UFWORD(ASH) {
4354   int32_t c = (int32_t)ufoPop();
4355   if (c < 0) {
4356     // right
4357     int32_t n = (int32_t)ufoPop();
4358     if (c < -30) {
4359       if (n < 0) n = -1; else n = 0;
4360     } else {
4361       n >>= (uint8_t)(-c);
4362     }
4363     ufoPush((uint32_t)n);
4364   } else if (c > 0) {
4365     // left
4366     uint32_t u = ufoPop();
4367     if (c > 31) {
4368       u = 0;
4369     } else {
4370       u <<= (uint8_t)c;
4371     }
4372     ufoPush(u);
4373   }
4374 }
4375
4376 // LSH
4377 // ( n count -- )
4378 // logical shift; positive `n` shifts to the left
4379 UFWORD(LSH) {
4380   int32_t c = (int32_t) ufoPop();
4381   uint32_t u = ufoPop();
4382   if (c < 0) {
4383     // right
4384     if (c < -31) {
4385       u = 0;
4386     } else {
4387       u >>= (uint8_t)(-c);
4388     }
4389   } else if (c > 0) {
4390     // left
4391     if (c > 31) {
4392       u = 0;
4393     } else {
4394       u <<= (uint8_t)c;
4395     }
4396   }
4397   ufoPush(u);
4398 }
4399
4400
4401 // ////////////////////////////////////////////////////////////////////////// //
4402 // string unescaping
4403 //
4404
4405 // (UNESCAPE)
4406 // ( addr count -- addr count )
4407 UFWORD(PAR_UNESCAPE) {
4408   const uint32_t count = ufoPop();
4409   const uint32_t addr = ufoPeek();
4410   if ((count & ((uint32_t)1<<31)) == 0) {
4411     const uint32_t eaddr = addr + count;
4412     uint32_t caddr = addr;
4413     uint32_t daddr = addr;
4414     while (caddr != eaddr) {
4415       uint8_t ch = ufoImgGetU8Ext(caddr); caddr += 1u;
4416       if (ch == '\\' && caddr != eaddr) {
4417         ch = ufoImgGetU8Ext(caddr); caddr += 1u;
4418         switch (ch) {
4419           case 'r': ch = '\r'; break;
4420           case 'n': ch = '\n'; break;
4421           case 't': ch = '\t'; break;
4422           case 'e': ch = '\x1b'; break;
4423           case '`': ch = '"'; break; // special escape to insert double-quote
4424           case '"': ch = '"'; break;
4425           case '\\': ch = '\\'; break;
4426           case 'x': case 'X':
4427             if (eaddr - daddr >= 1) {
4428               const int dg0 = digitInBase((char)(ufoImgGetU8Ext(caddr)), 16);
4429               if (dg0 < 0) ufoFatal("invalid hex string escape");
4430               if (eaddr - daddr >= 2) {
4431                 const int dg1 = digitInBase((char)(ufoImgGetU8Ext(caddr + 1u)), 16);
4432                 if (dg1 < 0) ufoFatal("invalid hex string escape");
4433                 ch = (uint8_t)(dg0 * 16 + dg1);
4434                 caddr += 2u;
4435               } else {
4436                 ch = (uint8_t)dg0;
4437                 caddr += 1u;
4438               }
4439             } else {
4440               ufoFatal("invalid hex string escape");
4441             }
4442             break;
4443           default: ufoFatal("invalid string escape");
4444         }
4445       }
4446       ufoImgPutU8Ext(daddr, ch); daddr += 1u;
4447     }
4448     ufoPush(daddr - addr);
4449   } else {
4450     ufoPush(count);
4451   }
4452 }
4453
4454
4455 // ////////////////////////////////////////////////////////////////////////// //
4456 // numeric conversions
4457 //
4458
4459 // (BASED-NUMBER) ( addr count allowsign? base -- num TRUE / FALSE )
4460 UFWORD(PAR_BASED_NUMBER) {
4461   const uint32_t xbase = ufoPop();
4462   const uint32_t allowSign = ufoPop();
4463   int32_t count = (int32_t)ufoPop();
4464   uint32_t addr = ufoPop();
4465   uint32_t n = 0;
4466   int base = 0;
4467   int neg = 0;
4468   uint8_t ch;
4469
4470   if (allowSign && count > 1) {
4471     ch = ufoImgGetU8Ext(addr);
4472     if (ch == '-') { neg = 1; addr += 1u; count -= 1; }
4473     else if (ch == '+') { neg = 0; addr += 1u; count -= 1; }
4474   }
4475
4476   // special-based numbers
4477   ch = ufoImgGetU8Ext(addr);
4478   if (count >= 3 && ch == '0') {
4479     switch (ufoImgGetU8Ext(addr + 1u)) {
4480       case 'x': case 'X': base = 16; break;
4481       case 'o': case 'O': base = 8; break;
4482       case 'b': case 'B': base = 2; break;
4483       case 'd': case 'D': base = 10; break;
4484       default: break;
4485     }
4486     if (base && digitInBase((char)ufoImgGetU8Ext(addr + (uint32_t)count - 1u), base) >= 0) {
4487       addr += 2; count -= 2;
4488     } else {
4489       base = 0;
4490     }
4491   } else if (count >= 2 && ch == '$') {
4492     base = 16;
4493     addr += 1u; count -= 1;
4494   } else if (count >= 2 && ch == '#') {
4495     base = 16;
4496     addr += 1u; count -= 1;
4497   } else if (count >= 2 && ch == '%') {
4498     base = 2;
4499     addr += 1u; count -= 1;
4500   } else if (count >= 3 && ch == '&') {
4501     switch (ufoImgGetU8Ext(addr + 1u)) {
4502       case 'h': case 'H': base = 16; break;
4503       case 'o': case 'O': base = 8; break;
4504       case 'b': case 'B': base = 2; break;
4505       case 'd': case 'D': base = 10; break;
4506       default: break;
4507     }
4508     if (base) { addr += 2u; count -= 2; }
4509   }
4510   if (!base && count > 2 && ch >= '0' && ch <= '9') {
4511     ch = ufoImgGetU8Ext(addr + (uint32_t)count - 1u);
4512     switch (ch) {
4513       case 'b': case 'B': if (xbase < 12) base = 2; break;
4514       case 'o': case 'O': if (xbase < 25) base = 8; break;
4515       case 'h': case 'H': if (xbase < 18) base = 16; break;
4516     }
4517     if (base) count -= 1;
4518   }
4519
4520   // in current base?
4521   if (!base && xbase < 255) base = xbase;
4522
4523   if (count <= 0 || base < 1 || base > 36) {
4524     ufoPushBool(0);
4525   } else {
4526     uint32_t nc;
4527     int wasDig = 0, wasUnder = 1, error = 0, dig;
4528     while (!error && count != 0) {
4529       ch = ufoImgGetU8Ext(addr); addr += 1u; count -= 1;
4530       if (ch != '_') {
4531         error = 1; wasUnder = 0; wasDig = 1;
4532         dig = digitInBase((char)ch, (int)base);
4533         if (dig >= 0) {
4534           nc = n * (uint32_t)base;
4535           if (nc >= n) {
4536             nc += (uint32_t)dig;
4537             if (nc >= n) {
4538               n = nc;
4539               error = 0;
4540             }
4541           }
4542         }
4543       } else {
4544         error = wasUnder;
4545         wasUnder = 1;
4546       }
4547     }
4548
4549     if (!error && wasDig && !wasUnder) {
4550       if (allowSign && neg) n = ~n + 1u;
4551       ufoPush(n);
4552       ufoPushBool(1);
4553     } else {
4554       ufoPushBool(0);
4555     }
4556   }
4557 }
4558
4559
4560 // ////////////////////////////////////////////////////////////////////////// //
4561 // compiler-related, dictionary-related
4562 //
4563
4564 static char ufoWNameBuf[256];
4565
4566 // (CREATE-WORD-HEADER)
4567 // ( addr count word-flags -- )
4568 UFWORD(PAR_CREATE_WORD_HEADER) {
4569   const uint32_t flags = ufoPop();
4570   const uint32_t wlen = ufoPop();
4571   const uint32_t waddr = ufoPop();
4572   if (wlen == 0) ufoFatal("word name expected");
4573   if (wlen >= UFO_MAX_WORD_LENGTH) ufoFatal("word name too long");
4574   // copy to separate buffer
4575   for (uint32_t f = 0; f < wlen; f += 1) {
4576     ufoWNameBuf[f] = (char)ufoImgGetU8Ext(waddr + f);
4577   }
4578   ufoWNameBuf[wlen] = 0;
4579   ufoCreateWordHeader(ufoWNameBuf, flags);
4580 }
4581
4582 // (CREATE-NAMELESS-WORD-HEADER)
4583 // ( word-flags -- )
4584 UFWORD(PAR_CREATE_NAMELESS_WORD_HEADER) {
4585   const uint32_t flags = ufoPop();
4586   ufoCreateWordHeader("", flags);
4587 }
4588
4589 // FIND-WORD
4590 // ( addr count -- cfa TRUE / FALSE)
4591 UFWORD(FIND_WORD) {
4592   const uint32_t wlen = ufoPop();
4593   const uint32_t waddr = ufoPop();
4594   if (wlen > 0 && wlen < UFO_MAX_WORD_LENGTH) {
4595     // copy to separate buffer
4596     for (uint32_t f = 0; f < wlen; f += 1) {
4597       ufoWNameBuf[f] = (char)ufoImgGetU8Ext(waddr + f);
4598     }
4599     ufoWNameBuf[wlen] = 0;
4600     const uint32_t cfa = ufoFindWord(ufoWNameBuf);
4601     if (cfa != 0) {
4602       ufoPush(cfa);
4603       ufoPushBool(1);
4604     } else {
4605       ufoPushBool(0);
4606     }
4607   } else {
4608     ufoPushBool(0);
4609   }
4610 }
4611
4612 // (FIND-WORD-IN-VOC)
4613 // ( addr count vocid allowhidden -- cfa TRUE / FALSE)
4614 // find only in the given voc; no name resolution
4615 UFWORD(FIND_WORD_IN_VOC) {
4616   const uint32_t allowHidden = ufoPop();
4617   const uint32_t vocid = ufoPop();
4618   const uint32_t wlen = ufoPop();
4619   const uint32_t waddr = ufoPop();
4620   if (wlen > 0 && wlen < UFO_MAX_WORD_LENGTH) {
4621     // copy to separate buffer
4622     for (uint32_t f = 0; f < wlen; f += 1) {
4623       ufoWNameBuf[f] = (char)ufoImgGetU8Ext(waddr + f);
4624     }
4625     ufoWNameBuf[wlen] = 0;
4626     const uint32_t cfa = ufoFindWordInVoc(ufoWNameBuf, wlen, 0, vocid, (allowHidden ? 1 : 0));
4627     if (cfa != 0) {
4628       ufoPush(cfa);
4629       ufoPushBool(1);
4630     } else {
4631       ufoPushBool(0);
4632     }
4633   } else {
4634     ufoPushBool(0);
4635   }
4636 }
4637
4638 // (FIND-WORD-IN-VOC-AND-PARENTS)
4639 // ( addr count vocid allowhidden -- cfa TRUE / FALSE)
4640 // find only in the given voc; no name resolution
4641 UFWORD(FIND_WORD_IN_VOC_AND_PARENTS) {
4642   const uint32_t allowHidden = ufoPop();
4643   const uint32_t vocid = ufoPop();
4644   const uint32_t wlen = ufoPop();
4645   const uint32_t waddr = ufoPop();
4646   if (wlen > 0 && wlen < UFO_MAX_WORD_LENGTH) {
4647     // copy to separate buffer
4648     for (uint32_t f = 0; f < wlen; f += 1) {
4649       ufoWNameBuf[f] = (char)ufoImgGetU8Ext(waddr + f);
4650     }
4651     ufoWNameBuf[wlen] = 0;
4652     const uint32_t cfa = ufoFindWordInVocAndParents(ufoWNameBuf, wlen, 0, vocid, (allowHidden ? 1 : 0));
4653     if (cfa != 0) {
4654       ufoPush(cfa);
4655       ufoPushBool(1);
4656     } else {
4657       ufoPushBool(0);
4658     }
4659   } else {
4660     ufoPushBool(0);
4661   }
4662 }
4663
4664
4665 // ////////////////////////////////////////////////////////////////////////// //
4666 // more compiler words
4667 //
4668
4669 // ////////////////////////////////////////////////////////////////////////// //
4670 // vocabulary and wordlist utilities
4671 //
4672
4673 // (VSP@)
4674 // ( -- vsp )
4675 UFWORD(PAR_GET_VSP) {
4676   ufoPush(ufoVSP);
4677 }
4678
4679 // (VSP!)
4680 // ( vsp -- )
4681 UFWORD(PAR_SET_VSP) {
4682   const uint32_t vsp = ufoPop();
4683   if (vsp > UFO_VOCSTACK_SIZE) ufoFatal("VSP %u out of range (%u)", vsp, UFO_VOCSTACK_SIZE);
4684   ufoVSP = vsp;
4685 }
4686
4687 // (VSP-AT@)
4688 // ( idx -- value )
4689 UFWORD(PAR_VSP_LOAD) {
4690   const uint32_t vsp = ufoPop();
4691   if (vsp >= UFO_VOCSTACK_SIZE) ufoFatal("VSP %u out of range (%u)", vsp, UFO_VOCSTACK_SIZE);
4692   ufoPush(ufoVocStack[vsp]);
4693 }
4694
4695 // (VSP-AT!)
4696 // ( value idx -- )
4697 UFWORD(PAR_VSP_STORE) {
4698   const uint32_t vsp = ufoPop();
4699   const uint32_t value = ufoPop();
4700   if (vsp >= UFO_VOCSTACK_SIZE) ufoFatal("VSP %u out of range (%u)", vsp, UFO_VOCSTACK_SIZE);
4701   ufoVocStack[vsp] = value;
4702 }
4703
4704
4705 // ////////////////////////////////////////////////////////////////////////// //
4706 // word field address conversion
4707 //
4708
4709 // CFA->PFA
4710 // ( cfa -- pfa )
4711 UFWORD(CFA2PFA) {
4712   const uint32_t cfa = ufoPop();
4713   ufoPush(UFO_CFA_TO_PFA(cfa));
4714 }
4715
4716 // CFA->NFA
4717 // ( cfa -- nfa )
4718 UFWORD(CFA2NFA) {
4719   const uint32_t cfa = ufoPop();
4720   ufoPush(UFO_CFA_TO_NFA(cfa));
4721 }
4722
4723 // CFA->LFA
4724 // ( cfa -- lfa )
4725 UFWORD(CFA2LFA) {
4726   const uint32_t cfa = ufoPop();
4727   ufoPush(UFO_CFA_TO_LFA(cfa));
4728 }
4729
4730 // CFA->WEND
4731 // ( cfa -- wend-addr )
4732 UFWORD(CFA2WEND) {
4733   const uint32_t cfa = ufoPop();
4734   ufoPush(ufoGetWordEndAddr(cfa));
4735 }
4736
4737 // PFA->CFA
4738 // ( pfa -- cfa )
4739 UFWORD(PFA2CFA) {
4740   const uint32_t pfa = ufoPop();
4741   ufoPush(UFO_PFA_TO_CFA(pfa));
4742 }
4743
4744 // PFA->NFA
4745 // ( pfa -- nfa )
4746 UFWORD(PFA2NFA) {
4747   const uint32_t pfa = ufoPop();
4748   const uint32_t cfa = UFO_PFA_TO_CFA(pfa);
4749   ufoPush(UFO_CFA_TO_NFA(cfa));
4750 }
4751
4752 // NFA->CFA
4753 // ( nfa -- cfa )
4754 UFWORD(NFA2CFA) {
4755   const uint32_t nfa = ufoPop();
4756   ufoPush(UFO_NFA_TO_CFA(nfa));
4757 }
4758
4759 // NFA->PFA
4760 // ( nfa -- pfa )
4761 UFWORD(NFA2PFA) {
4762   const uint32_t nfa = ufoPop();
4763   const uint32_t cfa = UFO_NFA_TO_CFA(nfa);
4764   ufoPush(UFO_CFA_TO_PFA(cfa));
4765 }
4766
4767 // NFA->LFA
4768 // ( nfa -- lfa )
4769 UFWORD(NFA2LFA) {
4770   const uint32_t nfa = ufoPop();
4771   ufoPush(UFO_NFA_TO_LFA(nfa));
4772 }
4773
4774 // LFA->CFA
4775 // ( lfa -- cfa )
4776 UFWORD(LFA2CFA) {
4777   const uint32_t lfa = ufoPop();
4778   ufoPush(UFO_LFA_TO_CFA(lfa));
4779 }
4780
4781 // LFA->PFA
4782 // ( lfa -- pfa )
4783 UFWORD(LFA2PFA) {
4784   const uint32_t lfa = ufoPop();
4785   const uint32_t cfa = UFO_LFA_TO_CFA(lfa);
4786   ufoPush(UFO_CFA_TO_PFA(cfa));
4787 }
4788
4789 // LFA->BFA
4790 // ( lfa -- bfa )
4791 UFWORD(LFA2BFA) {
4792   const uint32_t lfa = ufoPop();
4793   ufoPush(UFO_LFA_TO_BFA(lfa));
4794 }
4795
4796 // LFA->XFA
4797 // ( lfa -- xfa )
4798 UFWORD(LFA2XFA) {
4799   const uint32_t lfa = ufoPop();
4800   ufoPush(UFO_LFA_TO_XFA(lfa));
4801 }
4802
4803 // LFA->YFA
4804 // ( lfa -- yfa )
4805 UFWORD(LFA2YFA) {
4806   const uint32_t lfa = ufoPop();
4807   ufoPush(UFO_LFA_TO_YFA(lfa));
4808 }
4809
4810 // LFA->NFA
4811 // ( lfa -- nfa )
4812 UFWORD(LFA2NFA) {
4813   const uint32_t lfa = ufoPop();
4814   ufoPush(UFO_LFA_TO_NFA(lfa));
4815 }
4816
4817 // IP->NFA
4818 // ( ip -- nfa / 0 )
4819 UFWORD(IP2NFA) {
4820   const uint32_t ip = ufoPop();
4821   ufoPush(ufoFindWordForIP(ip));
4822 }
4823
4824 // IP->FILE/LINE
4825 // ( ip -- addr count line TRUE / FALSE )
4826 // name is at PAD; it is safe to use PAD, because each task has its own temp image
4827 UFWORD(IP2FILELINE) {
4828   const uint32_t ip = ufoPop();
4829   uint32_t fline;
4830   const char *fname = ufoFindFileForIP(ip, &fline, NULL, NULL);
4831   if (fname != NULL) {
4832     UFCALL(PAD);
4833     uint32_t addr = ufoPeek();
4834     uint32_t count = 0;
4835     while (*fname != 0) {
4836       ufoImgPutU8(addr, *(const unsigned char *)fname);
4837       fname += 1u; addr += 1u; count += 1u;
4838     }
4839     ufoImgPutU8(addr, 0); // just in case
4840     ufoPush(count);
4841     ufoPush(fline);
4842     ufoPushBool(1);
4843   } else {
4844     ufoPushBool(0);
4845   }
4846 }
4847
4848
4849 // IP->FILE-HASH/LINE
4850 // ( ip -- len hash line TRUE / FALSE )
4851 UFWORD(IP2FILEHASHLINE) {
4852   const uint32_t ip = ufoPop();
4853   uint32_t fline, fhash, flen;
4854   const char *fname = ufoFindFileForIP(ip, &fline, &flen, &fhash);
4855   if (fname != NULL) {
4856     ufoPush(flen);
4857     ufoPush(fhash);
4858     ufoPush(fline);
4859     ufoPushBool(1);
4860   } else {
4861     ufoPushBool(0);
4862   }
4863 }
4864
4865
4866 // ////////////////////////////////////////////////////////////////////////// //
4867 // string operations
4868 //
4869
4870 UFO_FORCE_INLINE uint32_t ufoHashBuf (uint32_t addr, uint32_t size, uint8_t orbyte) {
4871   uint32_t hash = 0x29a;
4872   if ((size & ((uint32_t)1<<31)) == 0) {
4873     while (size != 0) {
4874       hash += ufoImgGetU8Ext(addr) | orbyte;
4875       hash += hash<<10;
4876       hash ^= hash>>6;
4877       addr += 1u; size -= 1u;
4878     }
4879   }
4880   // finalize
4881   hash += hash<<3;
4882   hash ^= hash>>11;
4883   hash += hash<<15;
4884   return hash;
4885 }
4886
4887 //==========================================================================
4888 //
4889 //  ufoBufEqu
4890 //
4891 //==========================================================================
4892 UFO_FORCE_INLINE int ufoBufEqu (uint32_t addr0, uint32_t addr1, uint32_t count) {
4893   int res;
4894   if ((count & ((uint32_t)1<<31)) == 0) {
4895     res = 1;
4896     while (res != 0 && count != 0) {
4897       res = (toUpperU8(ufoImgGetU8Ext(addr0)) == toUpperU8(ufoImgGetU8Ext(addr1)));
4898       addr0 += 1u; addr1 += 1u; count -= 1u;
4899     }
4900   } else {
4901     res = 0;
4902   }
4903   return res;
4904 }
4905
4906 // STRING:=
4907 // ( a0 c0 a1 c1 -- bool )
4908 UFWORD(STREQU) {
4909   int32_t c1 = (int32_t)ufoPop();
4910   uint32_t a1 = ufoPop();
4911   int32_t c0 = (int32_t)ufoPop();
4912   uint32_t a0 = ufoPop();
4913   if (c0 < 0) c0 = 0;
4914   if (c1 < 0) c1 = 0;
4915   if (c0 == c1) {
4916     int res = 1;
4917     while (res != 0 && c0 != 0) {
4918       res = (ufoImgGetU8Ext(a0) == ufoImgGetU8Ext(a1));
4919       a0 += 1; a1 += 1; c0 -= 1;
4920     }
4921     ufoPushBool(res);
4922   } else {
4923     ufoPushBool(0);
4924   }
4925 }
4926
4927 // STRING:=CI
4928 // ( a0 c0 a1 c1 -- bool )
4929 UFWORD(STREQUCI) {
4930   int32_t c1 = (int32_t)ufoPop();
4931   uint32_t a1 = ufoPop();
4932   int32_t c0 = (int32_t)ufoPop();
4933   uint32_t a0 = ufoPop();
4934   if (c0 < 0) c0 = 0;
4935   if (c1 < 0) c1 = 0;
4936   if (c0 == c1) {
4937     int res = 1;
4938     while (res != 0 && c0 != 0) {
4939       res = (toUpperU8(ufoImgGetU8Ext(a0)) == toUpperU8(ufoImgGetU8Ext(a1)));
4940       a0 += 1; a1 += 1; c0 -= 1;
4941     }
4942     ufoPushBool(res);
4943   } else {
4944     ufoPushBool(0);
4945   }
4946 }
4947
4948 // search the string specified by c-addr1 u1 for the string specified by c-addr2 u2.
4949 // if flag is true, a match was found at c-addr3 with u3 characters remaining.
4950 // if flag is false there was no match and c-addr3 is c-addr1 and u3 is u1.
4951 // ( c-addr1 u1 c-addr2 u2 -- c-addr3 u3 flag )
4952 UFWORD(SEARCH) {
4953   const uint32_t pcount = ufoPop();
4954   const uint32_t paddr = ufoPop();
4955   const uint32_t tcount = ufoPop();
4956   const uint32_t taddr = ufoPop();
4957   if ((pcount & ((uint32_t)1 << 31)) == 0 && (tcount & ((uint32_t)1 << 31)) == 0) {
4958     for (uint32_t f = 0; tcount - f >= pcount; f += 1) {
4959       if (ufoBufEqu(taddr + f, paddr, pcount)) {
4960         ufoPush(taddr + f);
4961         ufoPush(tcount - f);
4962         ufoPushBool(1);
4963         return;
4964       }
4965     }
4966   }
4967   ufoPush(taddr);
4968   ufoPush(tcount);
4969   ufoPushBool(0);
4970 }
4971
4972 // STRING:HASH
4973 // ( addr count -- hash )
4974 UFWORD(STRHASH) {
4975   uint32_t count = ufoPop();
4976   uint32_t addr = ufoPop();
4977   ufoPush(ufoHashBuf(addr, count, 0));
4978 }
4979
4980 // STRING:HASH-CI
4981 // ( addr count -- hash )
4982 UFWORD(STRHASHCI) {
4983   uint32_t count = ufoPop();
4984   uint32_t addr = ufoPop();
4985   ufoPush(ufoHashBuf(addr, count, 0x20));
4986 }
4987
4988
4989 // ////////////////////////////////////////////////////////////////////////// //
4990 // conditional defines
4991 //
4992
4993 typedef struct UForthCondDefine_t UForthCondDefine;
4994 struct UForthCondDefine_t {
4995   char *name;
4996   uint32_t namelen;
4997   uint32_t hash;
4998   UForthCondDefine *next;
4999 };
5000
5001 static UForthCondDefine *ufoCondDefines = NULL;
5002 static char ufoErrMsgBuf[4096];
5003
5004
5005 //==========================================================================
5006 //
5007 //  ufoStrEquCI
5008 //
5009 //==========================================================================
5010 UFO_DISABLE_INLINE int ufoStrEquCI (const void *str0, const void *str1) {
5011   const unsigned char *s0 = (const unsigned char *)str0;
5012   const unsigned char *s1 = (const unsigned char *)str1;
5013   while (*s0 && *s1) {
5014     if (toUpperU8(*s0) != toUpperU8(*s1)) return 0;
5015     s0 += 1; s1 += 1;
5016   }
5017   return (*s0 == 0 && *s1 == 0);
5018 }
5019
5020
5021 //==========================================================================
5022 //
5023 //  ufoBufEquCI
5024 //
5025 //==========================================================================
5026 UFO_FORCE_INLINE int ufoBufEquCI (uint32_t addr, uint32_t count, const void *buf) {
5027   int res;
5028   if ((count & ((uint32_t)1<<31)) == 0) {
5029     const unsigned char *src = (const unsigned char *)buf;
5030     res = 1;
5031     while (res != 0 && count != 0) {
5032       res = (toUpperU8(*src) == toUpperU8(ufoImgGetU8Ext(addr)));
5033       src += 1; addr += 1u; count -= 1u;
5034     }
5035   } else {
5036     res = 0;
5037   }
5038   return res;
5039 }
5040
5041
5042 //==========================================================================
5043 //
5044 //  ufoClearCondDefines
5045 //
5046 //==========================================================================
5047 static void ufoClearCondDefines (void) {
5048   while (ufoCondDefines) {
5049     UForthCondDefine *df = ufoCondDefines;
5050     ufoCondDefines = df->next;
5051     if (df->name) free(df->name);
5052     free(df);
5053   }
5054 }
5055
5056
5057 //==========================================================================
5058 //
5059 //  ufoHasCondDefine
5060 //
5061 //==========================================================================
5062 int ufoHasCondDefine (const char *name) {
5063   int res = 0;
5064   if (name != NULL && name[0] != 0) {
5065     const size_t nlen = strlen(name);
5066     if (nlen <= 255) {
5067       const uint32_t hash = joaatHashBufCI(name, nlen);
5068       UForthCondDefine *dd = ufoCondDefines;
5069       while (res == 0 && dd != NULL) {
5070         if (dd->hash == hash && dd->namelen == (uint32_t)nlen) {
5071           res = ufoStrEquCI(name, dd->name);
5072         }
5073         dd = dd->next;
5074       }
5075     }
5076   }
5077   return res;
5078 }
5079
5080
5081 //==========================================================================
5082 //
5083 //  ufoCondDefine
5084 //
5085 //==========================================================================
5086 void ufoCondDefine (const char *name) {
5087   if (name != NULL && name[0] != 0) {
5088     const size_t nlen = strlen(name);
5089     if (nlen > 255) ufoFatal("conditional define name too long");
5090     const uint32_t hash = joaatHashBufCI(name, nlen);
5091     UForthCondDefine *dd = ufoCondDefines;
5092     int res = 0;
5093     while (res == 0 && dd != NULL) {
5094       if (dd->hash == hash && dd->namelen == (uint32_t)nlen) {
5095         res = ufoStrEquCI(name, dd->name);
5096       }
5097       dd = dd->next;
5098     }
5099     if (res == 0) {
5100       // new define
5101       dd = calloc(1, sizeof(UForthCondDefine));
5102       if (dd == NULL) ufoFatal("out of memory for defines");
5103       dd->name = strdup(name);
5104       if (dd->name == NULL) { free(dd); ufoFatal("out of memory for defines"); }
5105       dd->namelen = (uint32_t)nlen;
5106       dd->hash = hash;
5107       dd->next = ufoCondDefines;
5108       ufoCondDefines = dd;
5109     }
5110   }
5111 }
5112
5113
5114 //==========================================================================
5115 //
5116 //  ufoCondUndef
5117 //
5118 //==========================================================================
5119 void ufoCondUndef (const char *name) {
5120   if (name != NULL && name[0] != 0) {
5121     const size_t nlen = strlen(name);
5122     if (nlen <= 255) {
5123       const uint32_t hash = joaatHashBufCI(name, nlen);
5124       UForthCondDefine *dd = ufoCondDefines;
5125       UForthCondDefine *prev = NULL;
5126       while (dd != NULL) {
5127         if (dd->hash == hash && dd->namelen == (uint32_t)nlen) {
5128           if (ufoStrEquCI(name, dd->name)) {
5129             if (prev != NULL) prev->next = dd->next; else ufoCondDefines = dd->next;
5130             free(dd->name);
5131             free(dd);
5132             dd = NULL;
5133           }
5134         }
5135         if (dd != NULL) { prev = dd; dd = dd->next; }
5136       }
5137     }
5138   }
5139 }
5140
5141
5142 // ($DEFINE)
5143 // ( addr count -- )
5144 UFWORD(PAR_DLR_DEFINE) {
5145   uint32_t count = ufoPop();
5146   uint32_t addr = ufoPop();
5147   if (count == 0) ufoFatal("empty define");
5148   if (count >= UFO_MAX_WORD_LENGTH) ufoFatal("define too long");
5149   const uint32_t hash = ufoHashBuf(addr, count, 0x20);
5150   UForthCondDefine *dd;
5151   for (dd = ufoCondDefines; dd != NULL; dd = dd->next) {
5152     if (dd->hash == hash && dd->namelen == count) {
5153       if (ufoBufEquCI(addr, count, dd->name)) return;
5154     }
5155   }
5156   // new define
5157   dd = calloc(1, sizeof(UForthCondDefine));
5158   if (dd == NULL) ufoFatal("out of memory for defines");
5159   dd->name = calloc(1, count + 1u);
5160   if (dd->name == NULL) { free(dd); ufoFatal("out of memory for defines"); }
5161   for (uint32_t f = 0; f < count; f += 1) {
5162     ((unsigned char *)dd->name)[f] = ufoImgGetU8Ext(addr + f);
5163   }
5164   dd->namelen = count;
5165   dd->hash = hash;
5166   dd->next = ufoCondDefines;
5167   ufoCondDefines = dd;
5168 }
5169
5170 // ($UNDEF)
5171 // ( addr count -- )
5172 UFWORD(PAR_DLR_UNDEF) {
5173   uint32_t count = ufoPop();
5174   uint32_t addr = ufoPop();
5175   if (count == 0) ufoFatal("empty define");
5176   if (count >= UFO_MAX_WORD_LENGTH) ufoFatal("define too long");
5177   const uint32_t hash = ufoHashBuf(addr, count, 0x20);
5178   UForthCondDefine *prev = NULL;
5179   UForthCondDefine *dd;
5180   for (dd = ufoCondDefines; dd != NULL; prev = dd, dd = dd->next) {
5181     if (dd->hash == hash && dd->namelen == count) {
5182       if (ufoBufEquCI(addr, count, dd->name)) {
5183         if (prev == NULL) ufoCondDefines = dd->next; else prev->next = dd->next;
5184         free(dd->name);
5185         free(dd);
5186         return;
5187       }
5188     }
5189   }
5190 }
5191
5192 // ($DEFINED?)
5193 // ( addr count -- bool )
5194 UFWORD(PAR_DLR_DEFINEDQ) {
5195   uint32_t count = ufoPop();
5196   uint32_t addr = ufoPop();
5197   if (count == 0) ufoFatal("empty define");
5198   if (count >= UFO_MAX_WORD_LENGTH) ufoFatal("define too long");
5199   const uint32_t hash = ufoHashBuf(addr, count, 0x20);
5200   int found = 0;
5201   UForthCondDefine *dd = ufoCondDefines;
5202   while (!found && dd != NULL) {
5203     if (dd->hash == hash && dd->namelen == count) {
5204       found = ufoBufEquCI(addr, count, dd->name);
5205     }
5206     dd = dd->next;
5207   }
5208   ufoPushBool(found);
5209 }
5210
5211
5212 // ////////////////////////////////////////////////////////////////////////// //
5213 // error reporting
5214 //
5215
5216 // ERROR
5217 // ( addr count -- )
5218 UFWORD(ERROR) {
5219   uint32_t count = ufoPop();
5220   uint32_t addr = ufoPop();
5221   if (count & (1u<<31)) ufoFatal("invalid error message");
5222   if (count == 0) ufoFatal("some error");
5223   if (count > (uint32_t)sizeof(ufoErrMsgBuf) - 1u) count = (uint32_t)sizeof(ufoErrMsgBuf) - 1u;
5224   for (uint32_t f = 0; f < count; f += 1) {
5225     ufoErrMsgBuf[f] = (char)ufoImgGetU8Ext(addr + f);
5226   }
5227   ufoErrMsgBuf[count] = 0;
5228   ufoFatal("%s", ufoErrMsgBuf);
5229 }
5230
5231 // ////////////////////////////////////////////////////////////////////////// //
5232 // includes
5233 //
5234
5235 static char ufoFNameBuf[4096];
5236
5237
5238 //==========================================================================
5239 //
5240 //  ufoScanIncludeFileName
5241 //
5242 //  `*psys` and `*psoft` must be initialised!
5243 //
5244 //==========================================================================
5245 static void ufoScanIncludeFileName (uint32_t addr, uint32_t count, char *dest, size_t destsz,
5246                                     uint32_t *psys, uint32_t *psoft)
5247 {
5248   uint8_t ch;
5249   uint32_t dpos;
5250   ufo_assert(dest != NULL);
5251   ufo_assert(destsz > 0);
5252
5253   while (count != 0) {
5254     ch = ufoImgGetU8Ext(addr);
5255     if (ch == '!') {
5256       //if (system) ufoFatal("invalid file name (duplicate system mark)");
5257       *psys = 1;
5258     } else if (ch == '?') {
5259       //if (softinclude) ufoFatal("invalid file name (duplicate soft mark)");
5260       *psoft = 1;
5261     } else {
5262       break;
5263     }
5264     do {
5265       addr += 1; count -= 1;
5266       ch = ufoImgGetU8Ext(addr);
5267     } while (ch <= 32 && count != 0);
5268   }
5269
5270   if (count == 0) ufoFatal("empty include file name");
5271   if (count >= destsz) ufoFatal("include file name too long");
5272
5273   dpos = 0;
5274   while (count != 0) {
5275     dest[dpos] = (char)ufoImgGetU8Ext(addr); dpos += 1;
5276     addr += 1; count -= 1;
5277   }
5278   dest[dpos] = 0;
5279 }
5280
5281
5282 // (INCLUDE-LINE-FOFS)
5283 // ( -- fofs )
5284 UFWORD(PAR_INCLUDE_LINE_FOFS) {
5285   ufoPush((uint32_t)(int32_t)ufoCurrIncludeLineFileOfs);
5286 }
5287
5288 // (INCLUDE-LINE-SEEK)
5289 // ( lidx fofs -- )
5290 UFWORD(PAR_INCLUDE_LINE_SEEK) {
5291   uint32_t fofs = ufoPop();
5292   uint32_t lidx = ufoPop();
5293   if (lidx >= 0x0fffffffU) lidx = 0;
5294   if (ufoInFile == NULL) ufoFatal("cannot seek without opened include file");
5295   if (fseek(ufoInFile, (long)fofs, SEEK_SET) != 0) {
5296     ufoFatal("error seeking in include file");
5297   }
5298   ufoInFileLine = lidx;
5299 }
5300
5301 // (INCLUDE-DEPTH)
5302 // ( -- depth )
5303 // return number of items in include stack
5304 UFWORD(PAR_INCLUDE_DEPTH) {
5305   ufoPush(ufoFileStackPos);
5306 }
5307
5308 // (INCLUDE-FILE-ID)
5309 // ( isp -- id ) -- isp 0 is current, then 1, etc.
5310 // each include file has unique non-zero id.
5311 UFWORD(PAR_INCLUDE_FILE_ID) {
5312   const uint32_t isp = ufoPop();
5313   if (isp == 0) {
5314     ufoPush(ufoFileId);
5315   } else if (isp <= ufoFileStackPos) {
5316     UFOFileStackEntry *stk = &ufoFileStack[ufoFileStackPos - isp];
5317     ufoPush(stk->id);
5318   } else {
5319     ufoFatal("invalid include stack index");
5320   }
5321 }
5322
5323 // (INCLUDE-FILE-LINE)
5324 // ( isp -- line )
5325 UFWORD(PAR_INCLUDE_FILE_LINE) {
5326   const uint32_t isp = ufoPop();
5327   if (isp == 0) {
5328     ufoPush(ufoInFileLine);
5329   } else if (isp <= ufoFileStackPos) {
5330     UFOFileStackEntry *stk = &ufoFileStack[ufoFileStackPos - isp];
5331     ufoPush(stk->fline);
5332   } else {
5333     ufoFatal("invalid include stack index");
5334   }
5335 }
5336
5337 // (INCLUDE-FILE-NAME)
5338 // ( isp -- addr count )
5339 // current file name; at PAD
5340 UFWORD(PAR_INCLUDE_FILE_NAME) {
5341   const uint32_t isp = ufoPop();
5342   const char *fname = NULL;
5343   if (isp == 0) {
5344     fname = ufoInFileName;
5345   } else if (isp <= ufoFileStackPos) {
5346     UFOFileStackEntry *stk = &ufoFileStack[ufoFileStackPos - isp];
5347     fname = stk->fname;
5348   } else {
5349     ufoFatal("invalid include stack index");
5350   }
5351   UFCALL(PAD);
5352   uint32_t addr = ufoPop();
5353   uint32_t count = 0;
5354   if (fname != NULL) {
5355     while (fname[count] != 0) {
5356       ufoImgPutU8Ext(addr + count, ((const unsigned char *)fname)[count]);
5357       count += 1;
5358     }
5359   }
5360   ufoImgPutU8Ext(addr + count, 0);
5361   ufoPush(addr);
5362   ufoPush(count);
5363 }
5364
5365
5366 // (INCLUDE-BUILD-NAME)
5367 // ( addr count soft? system? -- addr count )
5368 // to PAD
5369 UFWORD(PAR_INCLUDE_BUILD_NAME) {
5370   uint32_t system = ufoPop();
5371   uint32_t softinclude = ufoPop();
5372   uint32_t count = ufoPop();
5373   uint32_t addr = ufoPop();
5374
5375   if ((count & ((uint32_t)1<<31)) != 0) ufoFatal("invalid include name");
5376
5377   ufoScanIncludeFileName(addr, count, ufoFNameBuf, sizeof(ufoFNameBuf),
5378                          &system, &softinclude);
5379
5380   char *ffn = ufoCreateIncludeName(ufoFNameBuf, system, (system ? ufoLastSysIncPath : ufoLastIncPath));
5381   addr = UFO_PAD_ADDR + 4u;
5382   count = 0;
5383   while (ffn[count] != 0) {
5384     ufoImgPutU8Ext(addr + count, ((const unsigned char *)ffn)[count]);
5385     count += 1u;
5386   }
5387   free(ffn);
5388   ufoImgPutU8Ext(addr + count, 0);
5389   ufoImgPutU32(addr - 4u, count);
5390   ufoPush(addr);
5391   ufoPush(count);
5392 }
5393
5394 // (INCLUDE-NO-REFILL)
5395 // ( addr count soft? system? -- )
5396 UFWORD(PAR_INCLUDE_NO_REFILL) {
5397   uint32_t system = ufoPop();
5398   uint32_t softinclude = ufoPop();
5399   uint32_t count = ufoPop();
5400   uint32_t addr = ufoPop();
5401
5402   if (ufoMode == UFO_MODE_MACRO) ufoFatal("macros cannot include files");
5403
5404   if ((count & ((uint32_t)1<<31)) != 0) ufoFatal("invalid include name");
5405
5406   ufoScanIncludeFileName(addr, count, ufoFNameBuf, sizeof(ufoFNameBuf),
5407                          &system, &softinclude);
5408
5409   char *ffn = ufoCreateIncludeName(ufoFNameBuf, system, (system ? ufoLastSysIncPath : ufoLastIncPath));
5410   #ifdef WIN32
5411   FILE *fl = fopen(ffn, "rb");
5412   #else
5413   FILE *fl = fopen(ffn, "r");
5414   #endif
5415   if (!fl) {
5416     if (softinclude) { free(ffn); return; }
5417     ufoFatal("include file '%s' not found", ffn);
5418   }
5419   #ifdef UFO_DEBUG_INCLUDE
5420   fprintf(stderr, "INC-PUSH: new fname: %s\n", ffn);
5421   #endif
5422   ufoPushInFile();
5423   ufoInFile = fl;
5424   ufoInFileLine = 0;
5425   ufoSetInFileNameReuse(ffn);
5426   ufoFileId = ufoLastUsedFileId;
5427   setLastIncPath(ufoInFileName, system);
5428 }
5429
5430 // (INCLUDE)
5431 // ( addr count soft? system? -- )
5432 UFWORD(PAR_INCLUDE) {
5433   UFCALL(PAR_INCLUDE_NO_REFILL);
5434   // trigger next line loading
5435   UFCALL(REFILL);
5436   if (!ufoPop()) ufoFatal("(INCLUDE) internal error");
5437 }
5438
5439 // $INCLUDE "str"
5440 UFWORD(DLR_INCLUDE_IMM) {
5441   int soft = 0, system = 0;
5442   // parse include filename
5443   ufoPushBool(0); UFCALL(PAR_PARSE_SKIP_COMMENTS);
5444   uint8_t ch = ufoTibPeekCh();
5445   if (ch == '"') {
5446     ufoTibSkipCh(); // skip quote
5447     ufoPush(34);
5448   } else if (ch == '<') {
5449     ufoTibSkipCh(); // skip quote
5450     ufoPush(62);
5451     system = 1;
5452   } else {
5453     ufoFatal("expected quoted string");
5454   }
5455   UFCALL(PARSE);
5456   if (!ufoPop()) ufoFatal("file name expected");
5457   ufoPushBool(0); UFCALL(PAR_PARSE_SKIP_COMMENTS);
5458   if (ufoTibPeekCh() != 0) {
5459     ufoFatal("$INCLUDE doesn't accept extra args yet");
5460   }
5461   // ( addr count soft? system? -- )
5462   ufoPushBool(soft); ufoPushBool(system); UFCALL(PAR_INCLUDE);
5463 }
5464
5465
5466 //==========================================================================
5467 //
5468 //  ufoCreateFileGuard
5469 //
5470 //==========================================================================
5471 static const char *ufoCreateFileGuard (const char *fname) {
5472   if (fname == NULL || fname[0] == 0) return NULL;
5473   char *rp = ufoRealPath(fname);
5474   if (rp == NULL) return NULL;
5475   #ifdef WIN32
5476   for (char *s = rp; *s; s += 1) if (*s == '\\') *s = '/';
5477   #endif
5478   // hash the buffer; extract file name; create string with path len, file name, and hash
5479   const size_t orgplen = strlen(rp);
5480   const uint32_t phash = joaatHashBuf(rp, orgplen, 0);
5481   size_t plen = orgplen;
5482   while (plen != 0 && rp[plen - 1u] != '/') plen -= 1;
5483   snprintf(ufoRealPathHashBuf, sizeof(ufoRealPathHashBuf),
5484            "__INCLUDE_GUARD_%08X_%08X_%s__", phash, (uint32_t)orgplen, rp + plen);
5485   return ufoRealPathHashBuf;
5486 }
5487
5488
5489 // $INCLUDE-ONCE "str"
5490 // includes file only once; unreliable on shitdoze, i believe
5491 UFWORD(DLR_INCLUDE_ONCE_IMM) {
5492   uint32_t softinclude = 0, system = 0;
5493   // parse include filename
5494   ufoPushBool(0); UFCALL(PAR_PARSE_SKIP_COMMENTS);
5495   uint8_t ch = ufoTibPeekCh();
5496   if (ch == '"') {
5497     ufoTibSkipCh(); // skip quote
5498     ufoPush(34);
5499   } else if (ch == '<') {
5500     ufoTibSkipCh(); // skip quote
5501     ufoPush(62);
5502     system = 1;
5503   } else {
5504     ufoFatal("expected quoted string");
5505   }
5506   UFCALL(PARSE);
5507   if (!ufoPop()) ufoFatal("file name expected");
5508   const uint32_t count = ufoPop();
5509   const uint32_t addr = ufoPop();
5510   ufoPushBool(0); UFCALL(PAR_PARSE_SKIP_COMMENTS);
5511   if (ufoTibPeekCh() != 0) {
5512     ufoFatal("$REQUIRE doesn't accept extra args yet");
5513   }
5514   ufoScanIncludeFileName(addr, count, ufoRealPathHashBuf, sizeof(ufoRealPathHashBuf),
5515                          &system, &softinclude);
5516   char *incfname = ufoCreateIncludeName(ufoRealPathHashBuf, system, (system ? ufoLastSysIncPath : ufoLastIncPath));
5517   if (incfname == NULL) ufoFatal("cannot resolve include file '%s'", ufoRealPathHashBuf);
5518   //fprintf(stderr, "?:%d;!:%d;%s|%s\n", softinclude, system, ufoRealPathHashBuf, incfname);
5519   // this will overwrite `ufoRealPathHashBuf`
5520   const char *guard = ufoCreateFileGuard(incfname);
5521   free(incfname);
5522   if (guard == NULL) {
5523     if (!softinclude) ufoFatal("cannot include file '%s'", ufoRealPathHashBuf);
5524     return;
5525   }
5526   #if 0
5527   fprintf(stderr, "GUARD: <%s>\n", guard);
5528   #endif
5529   // now check for the guard
5530   const uint32_t glen = (uint32_t)strlen(guard);
5531   const uint32_t ghash = joaatHashBuf(guard, glen, 0);
5532   UForthCondDefine *dd;
5533   for (dd = ufoCondDefines; dd != NULL; dd = dd->next) {
5534     if (dd->hash == ghash && dd->namelen == glen && strcmp(guard, dd->name) == 0) {
5535       // nothing to do: already included
5536       return;
5537     }
5538   }
5539   // add guard
5540   dd = calloc(1, sizeof(UForthCondDefine));
5541   if (dd == NULL) ufoFatal("out of memory for defines");
5542   dd->name = calloc(1, glen + 1u);
5543   if (dd->name == NULL) { free(dd); ufoFatal("out of memory for defines"); }
5544   strcpy(dd->name, guard);
5545   dd->namelen = glen;
5546   dd->hash = ghash;
5547   dd->next = ufoCondDefines;
5548   ufoCondDefines = dd;
5549   // ( addr count soft? system? -- )
5550   ufoPush(addr); ufoPush(count); ufoPushBool(softinclude); ufoPushBool(system);
5551   UFCALL(PAR_INCLUDE);
5552 }
5553
5554
5555 // ////////////////////////////////////////////////////////////////////////// //
5556 // handles
5557 //
5558
5559 // HANDLE:NEW
5560 // ( typeid -- hx )
5561 UFWORD(PAR_NEW_HANDLE) {
5562   const uint32_t typeid = ufoPop();
5563   if (typeid == UFO_HANDLE_FREE) ufoFatal("invalid handle typeid");
5564   UfoHandle *hh = ufoAllocHandle(typeid);
5565   ufoPush(hh->ufoHandle);
5566 }
5567
5568 // HANDLE:FREE
5569 // ( hx -- )
5570 UFWORD(PAR_FREE_HANDLE) {
5571   const uint32_t hx = ufoPop();
5572   if (hx != 0) {
5573     if ((hx & UFO_ADDR_HANDLE_BIT) == 0) ufoFatal("trying to free something that is not a handle");
5574     UfoHandle *hh = ufoGetHandle(hx);
5575     if (hh == NULL) ufoFatal("trying to free invalid handle");
5576     ufoFreeHandle(hh);
5577   }
5578 }
5579
5580 // HANDLE:TYPEID@
5581 // ( hx -- typeid )
5582 UFWORD(PAR_HANDLE_GET_TYPEID) {
5583   const uint32_t hx = ufoPop();
5584   if ((hx & UFO_ADDR_HANDLE_BIT) == 0) ufoFatal("not a handle");
5585   UfoHandle *hh = ufoGetHandle(hx);
5586   if (hh == NULL) ufoFatal("invalid handle");
5587   ufoPush(hh->typeid);
5588 }
5589
5590 // HANDLE:TYPEID!
5591 // ( typeid hx -- )
5592 UFWORD(PAR_HANDLE_SET_TYPEID) {
5593   const uint32_t hx = ufoPop();
5594   const uint32_t typeid = ufoPop();
5595   if ((hx & UFO_ADDR_HANDLE_BIT) == 0) ufoFatal("not a handle");
5596   if (typeid == UFO_HANDLE_FREE) ufoFatal("invalid handle typeid");
5597   UfoHandle *hh = ufoGetHandle(hx);
5598   if (hh == NULL) ufoFatal("invalid handle");
5599   hh->typeid = typeid;
5600 }
5601
5602 // HANDLE:SIZE@
5603 // ( hx -- size )
5604 UFWORD(PAR_HANDLE_GET_SIZE) {
5605   const uint32_t hx = ufoPop();
5606   if (hx != 0) {
5607     if ((hx & UFO_ADDR_HANDLE_BIT) == 0) ufoFatal("not a handle");
5608     UfoHandle *hh = ufoGetHandle(hx);
5609     if (hh == NULL) ufoFatal("invalid handle");
5610     ufoPush(hh->size);
5611   } else {
5612     ufoPush(0);
5613   }
5614 }
5615
5616 // HANDLE:SIZE!
5617 // ( size hx -- )
5618 UFWORD(PAR_HANDLE_SET_SIZE) {
5619   const uint32_t hx = ufoPop();
5620   const uint32_t size = ufoPop();
5621   if (size > 0x04000000) ufoFatal("invalid handle size");
5622   if ((hx & UFO_ADDR_HANDLE_BIT) == 0) ufoFatal("not a handle");
5623   UfoHandle *hh = ufoGetHandle(hx);
5624   if (hh == NULL) ufoFatal("invalid handle");
5625   if (hh->size != size) {
5626     if (size == 0) {
5627       free(hh->data);
5628       hh->data = NULL;
5629     } else {
5630       uint8_t *nx = realloc(hh->data, size * sizeof(hh->data[0]));
5631       if (nx == NULL) ufoFatal("out of memory for handle of size %u", size);
5632       hh->data = nx;
5633       if (size > hh->size) memset(hh->data, 0, size - hh->size);
5634     }
5635     hh->size = size;
5636     if (hh->used > size) hh->used = size;
5637   }
5638 }
5639
5640 // HANDLE:USED@
5641 // ( hx -- used )
5642 UFWORD(PAR_HANDLE_GET_USED) {
5643   const uint32_t hx = ufoPop();
5644   if (hx != 0) {
5645     if ((hx & UFO_ADDR_HANDLE_BIT) == 0) ufoFatal("not a handle");
5646     UfoHandle *hh = ufoGetHandle(hx);
5647     if (hh == NULL) ufoFatal("invalid handle");
5648     ufoPush(hh->used);
5649   } else {
5650     ufoPush(0);
5651   }
5652 }
5653
5654 // HANDLE:USED!
5655 // ( size hx -- )
5656 UFWORD(PAR_HANDLE_SET_USED) {
5657   const uint32_t hx = ufoPop();
5658   const uint32_t used = ufoPop();
5659   if (used > 0x04000000) ufoFatal("invalid handle used");
5660   if ((hx & UFO_ADDR_HANDLE_BIT) == 0) ufoFatal("not a handle");
5661   UfoHandle *hh = ufoGetHandle(hx);
5662   if (hh == NULL) ufoFatal("invalid handle");
5663   if (used > hh->size) ufoFatal("handle used %u out of range (%u)", used, hh->size);
5664   hh->used = used;
5665 }
5666
5667 #define POP_PREPARE_HANDLE() \
5668   const uint32_t hx = ufoPop(); \
5669   uint32_t idx = ufoPop(); \
5670   if ((hx & UFO_ADDR_HANDLE_BIT) == 0) ufoFatal("not a handle"); \
5671   if (idx > 0x1fffffffU - UFO_ADDR_HANDLE_OFS_MASK) ufoFatal("handle index %u out of range", idx); \
5672   idx += (hx & UFO_ADDR_HANDLE_OFS_MASK); \
5673   UfoHandle *hh = ufoGetHandle(hx); \
5674   if (hh == NULL) ufoFatal("invalid handle")
5675
5676 // HANDLE:C@
5677 // ( idx hx -- value )
5678 UFWORD(PAR_HANDLE_LOAD_BYTE) {
5679   POP_PREPARE_HANDLE();
5680   if (idx >= hh->size) ufoFatal("handle index %u out of range (%u)", idx, hh->size);
5681   ufoPush(hh->data[idx]);
5682 }
5683
5684 // HANDLE:W@
5685 // ( idx hx -- value )
5686 UFWORD(PAR_HANDLE_LOAD_WORD) {
5687   POP_PREPARE_HANDLE();
5688   if (idx >= hh->size || hh->size - idx < 2u) {
5689     ufoFatal("handle index %u out of range (%u)", idx, hh->size);
5690   }
5691   #ifdef UFO_FAST_MEM_ACCESS
5692   ufoPush(*(const uint16_t *)(hh->data + idx));
5693   #else
5694   uint32_t res = hh->data[idx];
5695   res |= hh->data[idx + 1u] << 8;
5696   ufoPush(res);
5697   #endif
5698 }
5699
5700 // HANDLE:@
5701 // ( idx hx -- value )
5702 UFWORD(PAR_HANDLE_LOAD_CELL) {
5703   POP_PREPARE_HANDLE();
5704   if (idx >= hh->size || hh->size - idx < 4u) {
5705     ufoFatal("handle index %u out of range (%u)", idx, hh->size);
5706   }
5707   #ifdef UFO_FAST_MEM_ACCESS
5708   ufoPush(*(const uint32_t *)(hh->data + idx));
5709   #else
5710   uint32_t res = hh->data[idx];
5711   res |= hh->data[idx + 1u] << 8;
5712   res |= hh->data[idx + 2u] << 16;
5713   res |= hh->data[idx + 3u] << 24;
5714   ufoPush(res);
5715   #endif
5716 }
5717
5718 // HANDLE:C!
5719 // ( value idx hx -- value )
5720 UFWORD(PAR_HANDLE_STORE_BYTE) {
5721   POP_PREPARE_HANDLE();
5722   const uint32_t value = ufoPop();
5723   if (idx >= hh->size) ufoFatal("handle index %u out of range (%u)", idx, hh->size);
5724   hh->data[idx] = value;
5725 }
5726
5727 // HANDLE:W!
5728 // ( value idx hx -- )
5729 UFWORD(PAR_HANDLE_STORE_WORD) {
5730   POP_PREPARE_HANDLE();
5731   const uint32_t value = ufoPop();
5732   if (idx >= hh->size || hh->size - idx < 2u) {
5733     ufoFatal("handle index %u out of range (%u)", idx, hh->size);
5734   }
5735   #ifdef UFO_FAST_MEM_ACCESS
5736   *(uint16_t *)(hh->data + idx) = (uint16_t)value;
5737   #else
5738   hh->data[idx] = (uint8_t)value;
5739   hh->data[idx + 1u] = (uint8_t)(value >> 8);
5740   #endif
5741 }
5742
5743 // HANDLE:!
5744 // ( value idx hx -- )
5745 UFWORD(PAR_HANDLE_STORE_CELL) {
5746   POP_PREPARE_HANDLE();
5747   const uint32_t value = ufoPop();
5748   if (idx >= hh->size || hh->size - idx < 4u) {
5749     ufoFatal("handle index %u out of range (%u)", idx, hh->size);
5750   }
5751   #ifdef UFO_FAST_MEM_ACCESS
5752   *(uint32_t *)(hh->data + idx) = value;
5753   #else
5754   hh->data[idx] = (uint8_t)value;
5755   hh->data[idx + 1u] = (uint8_t)(value >> 8);
5756   hh->data[idx + 2u] = (uint8_t)(value >> 16);
5757   hh->data[idx + 3u] = (uint8_t)(value >> 24);
5758   #endif
5759 }
5760
5761
5762 // HANDLE:LOAD-FILE
5763 // ( addr count -- stx / FALSE )
5764 UFWORD(PAR_HANDLE_LOAD_FILE) {
5765   uint32_t count = ufoPop();
5766   uint32_t addr = ufoPop();
5767
5768   if ((count & ((uint32_t)1<<31)) != 0) ufoFatal("invalid file name");
5769
5770   uint8_t *dest = (uint8_t *)ufoFNameBuf;
5771   while (count != 0 && dest < (uint8_t *)ufoFNameBuf + sizeof(ufoFNameBuf)) {
5772     uint8_t ch = ufoImgGetU8Ext(addr);
5773     *dest = ch;
5774     dest += 1u; addr += 1u; count -= 1u;
5775   }
5776   if (dest == (uint8_t *)ufoFNameBuf + sizeof(ufoFNameBuf)) ufoFatal("file name too long");
5777   *dest = 0;
5778
5779   if (*ufoFNameBuf == 0) ufoFatal("empty file name");
5780
5781   char *ffn = ufoCreateIncludeName(ufoFNameBuf, 0/*system*/, ufoLastIncPath);
5782   #ifdef WIN32
5783   FILE *fl = fopen(ffn, "rb");
5784   #else
5785   FILE *fl = fopen(ffn, "r");
5786   #endif
5787   if (!fl) {
5788     free(ffn);
5789     ufoPush(0);
5790     return;
5791   }
5792
5793   if (fseek(fl, 0, SEEK_END) != 0) {
5794     fclose(fl);
5795     ufoFatal("seek error in file '%s'", ffn);
5796   }
5797
5798   long sz = ftell(fl);
5799   if (sz < 0 || sz >= 1024 * 1024 * 64) {
5800     fclose(fl);
5801     ufoFatal("tell error in file '%s' (or too big)", ffn);
5802   }
5803
5804   if (fseek(fl, 0, SEEK_SET) != 0) {
5805     fclose(fl);
5806     ufoFatal("seek error in file '%s'", ffn);
5807   }
5808
5809   UfoHandle *hh = ufoAllocHandle(0);
5810   if (sz != 0) {
5811     hh->data = malloc((uint32_t)sz);
5812     if (hh->data == NULL) {
5813       fclose(fl);
5814       ufoFatal("out of memory for file '%s'", ffn);
5815     }
5816     hh->size = (uint32_t)sz;
5817     if (fread(hh->data, (uint32_t)sz, 1, fl) != 1) {
5818       fclose(fl);
5819       ufoFatal("error reading file '%s'", ffn);
5820     }
5821     fclose(fl);
5822   }
5823
5824   free(ffn);
5825   ufoPush(hh->ufoHandle);
5826 }
5827
5828
5829 // ////////////////////////////////////////////////////////////////////////// //
5830 // utils
5831 //
5832
5833 // DEBUG:(DECOMPILE-CFA)
5834 // ( cfa -- )
5835 UFWORD(DEBUG_DECOMPILE_CFA) {
5836   const uint32_t cfa = ufoPop();
5837   ufoFlushOutput();
5838   ufoDecompileWord(cfa);
5839 }
5840
5841 // DEBUG:(DECOMPILE-MEM)
5842 // ( addr-start addr-end -- )
5843 UFWORD(DEBUG_DECOMPILE_MEM) {
5844   const uint32_t end = ufoPop();
5845   const uint32_t start = ufoPop();
5846   ufoFlushOutput();
5847   ufoDecompilePart(start, end, 0);
5848 }
5849
5850 // GET-MSECS
5851 // ( -- u32 )
5852 UFWORD(GET_MSECS) {
5853   ufoPush((uint32_t)ufo_get_msecs());
5854 }
5855
5856 // this is called by INTERPRET when it is out of input stream
5857 UFWORD(UFO_INTERPRET_FINISHED_ACTION) {
5858   ufoVMStop = 1;
5859 }
5860
5861 // MTASK:NEW-STATE
5862 // ( cfa -- stid )
5863 UFWORD(MT_NEW_STATE) {
5864   UfoState *st = ufoNewState();
5865   ufoInitStateUserVars(st, ufoPop());
5866   ufoPush(st->id);
5867 }
5868
5869 // MTASK:FREE-STATE
5870 // ( stid -- )
5871 UFWORD(MT_FREE_STATE) {
5872   UfoState *st = ufoFindState(ufoPop());
5873   if (st == NULL) ufoFatal("cannot free unknown state");
5874   if (st == ufoCurrState) ufoFatal("cannot free current state");
5875   ufoFreeState(st);
5876 }
5877
5878 // MTASK:STATE-NAME@
5879 // ( stid -- addr count )
5880 // to PAD
5881 UFWORD(MT_GET_STATE_NAME) {
5882   UfoState *st = ufoFindState(ufoPop());
5883   if (st == NULL) ufoFatal("unknown state");
5884   UFCALL(PAD);
5885   uint32_t addr = ufoPop();
5886   uint32_t count = 0;
5887   while (st->name[count] != 0) {
5888     ufoImgPutU8Ext(addr + count, ((const unsigned char *)st->name)[count]);
5889     count += 1u;
5890   }
5891   ufoImgPutU8Ext(addr + count, 0);
5892   ufoPush(addr);
5893   ufoPush(count);
5894 }
5895
5896 // MTASK:STATE-NAME!
5897 // ( addr count stid -- )
5898 UFWORD(MT_SET_STATE_NAME) {
5899   UfoState *st = ufoFindState(ufoPop());
5900   if (st == NULL) ufoFatal("unknown state");
5901   uint32_t count = ufoPop();
5902   uint32_t addr = ufoPop();
5903   if ((count & ((uint32_t)1 << 31)) == 0) {
5904     if (count > UFO_MAX_TASK_NAME) ufoFatal("task name too long");
5905     for (uint32_t f = 0; f < count; f += 1u) {
5906       ((unsigned char *)st->name)[f] = ufoImgGetU8Ext(addr + f);
5907     }
5908     st->name[count] = 0;
5909   }
5910 }
5911
5912 // MTASK:STATE-FIRST
5913 // ( -- stid )
5914 UFWORD(MT_STATE_FIRST) {
5915   uint32_t fidx = 0;
5916   while (fidx != (uint32_t)(UFO_MAX_STATES/32) && ufoStateUsedBitmap[fidx] == 0) fidx += 1u;
5917   // there should be at least one allocated state
5918   ufo_assert(fidx != (uint32_t)(UFO_MAX_STATES/32));
5919   uint32_t bmp = ufoStateUsedBitmap[fidx];
5920   fidx *= 32u;
5921   while ((bmp & 0x01) == 0) { fidx += 1u; bmp >>= 1; }
5922   ufoPush(fidx + 1u);
5923 }
5924
5925 // MTASK:STATE-NEXT
5926 // ( stid -- stid / 0 )
5927 UFWORD(MT_STATE_NEXT) {
5928   uint32_t stid = ufoPop();
5929   if (stid != 0 && stid < (uint32_t)(UFO_MAX_STATES/32)) {
5930     // it is already incremented for us, yay!
5931     uint32_t fidx = stid / 32u;
5932     uint8_t fofs = stid & 0x1f;
5933     while (fidx < (uint32_t)(UFO_MAX_STATES/32)) {
5934       const uint32_t bmp = ufoStateUsedBitmap[fidx];
5935       if (bmp != 0) {
5936         while (fofs != 32u) {
5937           if ((bmp & ((uint32_t)1 << (fofs & 0x1f))) == 0) fofs += 1u;
5938         }
5939         if (fofs != 32u) {
5940           ufoPush(fidx * 32u + fofs + 1u);
5941           return; // sorry!
5942         }
5943       }
5944       fidx += 1u; fofs = 0;
5945     }
5946   }
5947   ufoPush(0);
5948 }
5949
5950
5951 // MTASK:YIELD-TO
5952 // ( ... argc stid -- )
5953 UFWORD(MT_YIELD_TO) {
5954   UfoState *st = ufoFindState(ufoPop());
5955   if (st == NULL) ufoFatal("cannot yield to unknown state");
5956   //if (st == ufoDebuggerState) ufoFatal("cannot yield to debugger"); // why not?
5957   const uint32_t argc = ufoPop();
5958   if (argc > 256) ufoFatal("too many YIELD-TO arguments");
5959   UfoState *curst = ufoCurrState;
5960   if (st != ufoCurrState) {
5961     for (uint32_t f = 0; f < argc; f += 1) {
5962       ufoCurrState = curst;
5963       const uint32_t n = ufoPop();
5964       ufoCurrState = st;
5965       ufoPush(n);
5966     }
5967     ufoCurrState = curst; // we need to use API call to switch states
5968   }
5969   ufoSwitchToState(st); // always use API call for this!
5970   ufoPush(argc);
5971   ufoPush(curst->id);
5972 }
5973
5974 // MTASK:SET-SELF-AS-DEBUGGER
5975 // ( -- )
5976 UFWORD(MT_SET_SELF_AS_DEBUGGER) {
5977   ufoDebuggerState = ufoCurrState;
5978 }
5979
5980 // DEBUG:(BP)
5981 // ( -- )
5982 // debugger task receives debugge stid on the data stack, and -1 as argc.
5983 // i.e. debugger stask is: ( -1 old-stid )
5984 UFWORD(MT_DEBUGGER_BP) {
5985   if (ufoDebuggerState != NULL && ufoCurrState != ufoDebuggerState && ufoIsGoodTTY()) {
5986     UfoState *st = ufoCurrState;
5987     ufoSwitchToState(ufoDebuggerState); // always use API call for this!
5988     ufoPush(-1);
5989     ufoPush(st->id);
5990     ufoSingleStep = 0;
5991   } else {
5992     UFCALL(UFO_BACKTRACE);
5993   }
5994 }
5995
5996 // MTASK:DEBUGGER-RESUME
5997 // ( stid -- )
5998 UFWORD(MT_RESUME_DEBUGEE) {
5999   if (ufoCurrState != ufoDebuggerState) ufoFatal("cannot resume from non-debugger");
6000   UfoState *st = ufoFindState(ufoPop());
6001   if (st == NULL) ufoFatal("cannot yield to unknown state");
6002   if (st == ufoCurrState) ufoFatal("cannot resume into debugger itself");
6003   ufoSwitchToState(st); // always use API call for this!
6004   ufoSingleStep = 0;
6005 }
6006
6007 // MTASK:DEBUGGER-SINGLE-STEP
6008 // ( stid -- )
6009 UFWORD(MT_SINGLE_STEP_DEBUGEE) {
6010   if (ufoCurrState != ufoDebuggerState) ufoFatal("cannot resume from non-debugger");
6011   UfoState *st = ufoFindState(ufoPop());
6012   if (st == NULL) ufoFatal("cannot yield to unknown state");
6013   if (st == ufoCurrState) ufoFatal("cannot resume into debugger itself");
6014   ufoSwitchToState(st); // always use API call for this!
6015   ufoSingleStep = 2; // it will be decremented after returning from this word
6016 }
6017
6018 // MTASK:STATE-IP@
6019 // ( stid -- ip )
6020 UFWORD(MT_STATE_IP_GET) {
6021   UfoState *st = ufoFindState(ufoPop());
6022   if (st == NULL) ufoFatal("unknown state");
6023   ufoPush(st->IP);
6024 }
6025
6026 // MTASK:STATE-IP!
6027 // ( ip stid -- )
6028 UFWORD(MT_STATE_IP_SET) {
6029   UfoState *st = ufoFindState(ufoPop());
6030   if (st == NULL) ufoFatal("unknown state");
6031   st->IP = ufoPop();
6032 }
6033
6034 // MTASK:STATE-A>
6035 // ( stid -- ip )
6036 UFWORD(MT_STATE_REGA_GET) {
6037   UfoState *st = ufoFindState(ufoPop());
6038   if (st == NULL) ufoFatal("unknown state");
6039   ufoPush(st->regA);
6040 }
6041
6042 // MTASK:STATE->A
6043 // ( ip stid -- )
6044 UFWORD(MT_STATE_REGA_SET) {
6045   UfoState *st = ufoFindState(ufoPop());
6046   if (st == NULL) ufoFatal("unknown state");
6047   st->regA = ufoPop();
6048 }
6049
6050 // MTASK:STATE-USER@
6051 // ( addr stid -- value )
6052 UFWORD(MT_STATE_USER_GET) {
6053   UfoState *st = ufoFindState(ufoPop());
6054   if (st == NULL) ufoFatal("unknown state");
6055   const uint32_t addr = ufoPop();
6056   if ((addr & UFO_ADDR_TEMP_BIT) != 0 && (addr & UFO_ADDR_TEMP_MASK) + 3u < st->imageTempSize) {
6057     uint32_t v = *(const uint32_t *)((const uint8_t *)st->imageTemp + (addr & UFO_ADDR_TEMP_MASK));
6058     ufoPush(v);
6059   } else {
6060     ufoFatal("invalid user area address");
6061   }
6062 }
6063
6064 // MTASK:STATE-USER!
6065 // ( value addr stid -- )
6066 UFWORD(MT_STATE_USER_SET) {
6067   UfoState *st = ufoFindState(ufoPop());
6068   if (st == NULL) ufoFatal("unknown state");
6069   const uint32_t addr = ufoPop();
6070   const uint32_t value = ufoPop();
6071   if ((addr & UFO_ADDR_TEMP_BIT) != 0 && (addr & UFO_ADDR_TEMP_MASK) + 3u < st->imageTempSize) {
6072     *(uint32_t *)((const uint8_t *)st->imageTemp + (addr & UFO_ADDR_TEMP_MASK)) = value;
6073   } else {
6074     ufoFatal("invalid user area address");
6075   }
6076 }
6077
6078 // MTASK:STATE-RPOPCFA@
6079 // ( -- flag )
6080 UFWORD(MT_STATE_RPOPCFA_GET) {
6081   UfoState *st = ufoFindState(ufoPop());
6082   if (st == NULL) ufoFatal("unknown state");
6083   ufoPush(st->vmRPopCFA);
6084 }
6085
6086 // MTASK:STATE-RPOPCFA!
6087 // ( flag -- )
6088 UFWORD(MT_STATE_RPOPCFA_SET) {
6089   UfoState *st = ufoFindState(ufoPop());
6090   if (st == NULL) ufoFatal("unknown state");
6091   st->vmRPopCFA = ufoPop();
6092 }
6093
6094 // MTASK:ACTIVE-STATE
6095 // ( -- stid )
6096 UFWORD(MT_ACTIVE_STATE) {
6097   ufoPush(ufoCurrState->id);
6098 }
6099
6100 // MTASK:YIELDED-FROM
6101 // ( -- stid / 0 )
6102 UFWORD(MT_YIELDED_FROM) {
6103   if (ufoYieldedState != NULL) {
6104     ufoPush(ufoYieldedState->id);
6105   } else {
6106     ufoPush(0);
6107   }
6108 }
6109
6110 // MTASK:STATE-SP@
6111 // ( stid -- depth )
6112 UFWORD(MT_DSTACK_DEPTH_GET) {
6113   UfoState *st = ufoFindState(ufoPop());
6114   if (st == NULL) ufoFatal("unknown state");
6115   ufoPush(st->SP);
6116 }
6117
6118 // MTASK:STATE-RP@
6119 // ( stid -- depth )
6120 UFWORD(MT_RSTACK_DEPTH_GET) {
6121   UfoState *st = ufoFindState(ufoPop());
6122   if (st == NULL) ufoFatal("unknown state");
6123   ufoPush(st->RP - st->RPTop);
6124 }
6125
6126 // MTASK:STATE-LP@
6127 // ( stid -- lp )
6128 UFWORD(MT_LP_GET) {
6129   UfoState *st = ufoFindState(ufoPop());
6130   if (st == NULL) ufoFatal("unknown state");
6131   ufoPush(st->LP);
6132 }
6133
6134 // MTASK:STATE-LBP@
6135 // ( stid -- lbp )
6136 UFWORD(MT_LBP_GET) {
6137   UfoState *st = ufoFindState(ufoPop());
6138   if (st == NULL) ufoFatal("unknown state");
6139   ufoPush(st->LBP);
6140 }
6141
6142 // MTASK:STATE-SP!
6143 // ( depth stid -- )
6144 UFWORD(MT_DSTACK_DEPTH_SET) {
6145   UfoState *st = ufoFindState(ufoPop());
6146   if (st == NULL) ufoFatal("unknown state");
6147   const uint32_t idx = ufoPop();
6148   if (idx >= UFO_DSTACK_SIZE) ufoFatal("invalid stack index %u (%u)", idx, UFO_DSTACK_SIZE);
6149   st->SP = idx;
6150 }
6151
6152 // MTASK:STATE-RP!
6153 // ( depth stid -- )
6154 UFWORD(MT_RSTACK_DEPTH_SET) {
6155   UfoState *st = ufoFindState(ufoPop());
6156   if (st == NULL) ufoFatal("unknown state");
6157   const uint32_t idx = ufoPop();
6158   const uint32_t left = UFO_RSTACK_SIZE - st->RPTop;
6159   if (idx >= left) ufoFatal("invalid rstack index %u (%u)", idx, left);
6160   st->RP = st->RPTop + idx;
6161 }
6162
6163 // MTASK:STATE-LP!
6164 // ( lp stid -- )
6165 UFWORD(MT_LP_SET) {
6166   UfoState *st = ufoFindState(ufoPop());
6167   if (st == NULL) ufoFatal("unknown state");
6168   st->LP = ufoPop();
6169 }
6170
6171 // MTASK:STATE-LBP!
6172 // ( lbp stid -- )
6173 UFWORD(MT_LBP_SET) {
6174   UfoState *st = ufoFindState(ufoPop());
6175   if (st == NULL) ufoFatal("unknown state");
6176   st->LBP = ufoPop();
6177 }
6178
6179 // MTASK:STATE-DS@
6180 // ( idx stid -- value )
6181 UFWORD(MT_DSTACK_LOAD) {
6182   UfoState *st = ufoFindState(ufoPop());
6183   if (st == NULL) ufoFatal("unknown state");
6184   const uint32_t idx = ufoPop();
6185   if (idx >= st->SP) ufoFatal("invalid stack index %u (%u)", idx, st->SP);
6186   ufoPush(st->dStack[st->SP - idx - 1u]);
6187 }
6188
6189 // MTASK:STATE-RS@
6190 // ( idx stid -- value )
6191 UFWORD(MT_RSTACK_LOAD) {
6192   UfoState *st = ufoFindState(ufoPop());
6193   if (st == NULL) ufoFatal("unknown state");
6194   const uint32_t idx = ufoPop();
6195   if (idx >= st->RP - st->RPTop) ufoFatal("invalid stack index %u (%u)", idx, st->RP - st->RPTop);
6196   ufoPush(st->dStack[st->RP - idx - 1u]);
6197 }
6198
6199 // MTASK:STATE-LS@
6200 // ( idx stid -- value )
6201 UFWORD(MT_LSTACK_LOAD) {
6202   UfoState *st = ufoFindState(ufoPop());
6203   if (st == NULL) ufoFatal("unknown state");
6204   const uint32_t idx = ufoPop();
6205   if (idx >= st->LP) ufoFatal("invalid lstack index %u (%u)", idx, st->LP);
6206   ufoPush(st->lStack[st->LP - idx - 1u]);
6207 }
6208
6209 // MTASK:STATE-DS!
6210 // ( value idx stid -- )
6211 UFWORD(MT_DSTACK_STORE) {
6212   UfoState *st = ufoFindState(ufoPop());
6213   if (st == NULL) ufoFatal("unknown state");
6214   const uint32_t idx = ufoPop();
6215   const uint32_t value = ufoPop();
6216   if (idx >= st->SP) ufoFatal("invalid stack index %u (%u)", idx, st->SP);
6217   st->dStack[st->SP - idx - 1u] = value;
6218 }
6219
6220 // MTASK:STATE-RS!
6221 // ( value idx stid -- )
6222 UFWORD(MT_RSTACK_STORE) {
6223   UfoState *st = ufoFindState(ufoPop());
6224   if (st == NULL) ufoFatal("unknown state");
6225   const uint32_t idx = ufoPop();
6226   const uint32_t value = ufoPop();
6227   if (idx >= st->RP - st->RPTop) ufoFatal("invalid stack index %u (%u)", idx, st->RP - st->RPTop);
6228   st->dStack[st->RP - idx - 1u] = value;
6229 }
6230
6231 // MTASK:STATE-LS!
6232 // ( value idx stid -- )
6233 UFWORD(MT_LSTACK_STORE) {
6234   UfoState *st = ufoFindState(ufoPop());
6235   if (st == NULL) ufoFatal("unknown state");
6236   const uint32_t idx = ufoPop();
6237   const uint32_t value = ufoPop();
6238   if (idx >= st->LP) ufoFatal("invalid stack index %u (%u)", idx, st->LP);
6239   st->dStack[st->LP - idx - 1u] = value;
6240 }
6241
6242 // MTASK:STATE-VSP@
6243 // ( stid -- vsp )
6244 UFWORD(MT_VSP_GET) {
6245   UfoState *st = ufoFindState(ufoPop());
6246   if (st == NULL) ufoFatal("unknown state");
6247   ufoPush(st->VSP);
6248 }
6249
6250 // MTASK:STATE-VSP!
6251 // ( vsp stid -- )
6252 UFWORD(MT_VSP_SET) {
6253   UfoState *st = ufoFindState(ufoPop());
6254   if (st == NULL) ufoFatal("unknown state");
6255   const uint32_t vsp = ufoPop();
6256   if (vsp > UFO_VOCSTACK_SIZE) ufoFatal("VSP %u out of range (%u)", vsp, UFO_VOCSTACK_SIZE);
6257   st->VSP = vsp;
6258 }
6259
6260 // MTASK:STATE-VSP-AT@
6261 // ( idx stidf -- value )
6262 UFWORD(MT_VSP_LOAD) {
6263   UfoState *st = ufoFindState(ufoPop());
6264   if (st == NULL) ufoFatal("unknown state");
6265   const uint32_t vsp = ufoPop();
6266   if (vsp >= UFO_VOCSTACK_SIZE) ufoFatal("VSP %u out of range (%u)", vsp, UFO_VOCSTACK_SIZE);
6267   ufoPush(st->vocStack[vsp]);
6268 }
6269
6270 // MTASK:STATE-VSP-AT!
6271 // ( value idx stid -- )
6272 UFWORD(MT_VSP_STORE) {
6273   UfoState *st = ufoFindState(ufoPop());
6274   if (st == NULL) ufoFatal("unknown state");
6275   const uint32_t vsp = ufoPop();
6276   const uint32_t value = ufoPop();
6277   if (vsp > UFO_VOCSTACK_SIZE) ufoFatal("VSP %u out of range (%u)", vsp, UFO_VOCSTACK_SIZE);
6278   st->vocStack[vsp] = value;
6279 }
6280
6281
6282 #include "urforth_tty.c"
6283
6284
6285 // ////////////////////////////////////////////////////////////////////////// //
6286 // "FILES" words
6287 //
6288
6289 static unsigned char ufoFileIOBuffer[4096];
6290
6291
6292 //==========================================================================
6293 //
6294 //  ufoPopFileName
6295 //
6296 //==========================================================================
6297 static char *ufoPopFileName (void) {
6298   uint32_t count = ufoPop();
6299   uint32_t addr = ufoPop();
6300
6301   if ((count & 0x80000000U) != 0) ufoFatal("invalid file name");
6302   if (count == 0) ufoFatal("empty file name");
6303   if (count > (uint32_t)sizeof(ufoFNameBuf) - 1u) ufoFatal("file name too long");
6304
6305   unsigned char *dest = (unsigned char *)ufoFNameBuf;
6306   while (count != 0) {
6307     *dest = ufoImgGetU8Ext(addr);
6308     dest += 1u; addr += 1u; count -= 1u;
6309   }
6310   *dest = 0;
6311
6312   return ufoFNameBuf;
6313 }
6314
6315 // FILES:ERRNO
6316 // ( -- errno )
6317 UFWORD(FILES_ERRNO) {
6318   ufoPush((uint32_t)errno);
6319 }
6320
6321 // FILES:UNLINK
6322 // ( addr count -- success? )
6323 UFWORD(FILES_UNLINK) {
6324   const char *fname = ufoPopFileName();
6325   ufoPushBool(unlink(fname) == 0);
6326 }
6327
6328 // FILES:OPEN-R/O
6329 // ( addr count -- handle TRUE / FALSE )
6330 UFWORD(FILES_OPEN_RO) {
6331   const char *fname = ufoPopFileName();
6332   const int fd = open(fname, O_RDONLY);
6333   if (fd >= 0) {
6334     ufoPush((uint32_t)fd);
6335     ufoPushBool(1);
6336   } else {
6337     ufoPushBool(0);
6338   }
6339 }
6340
6341 // FILES:OPEN-R/W
6342 // ( addr count -- handle TRUE / FALSE )
6343 UFWORD(FILES_OPEN_RW) {
6344   const char *fname = ufoPopFileName();
6345   const int fd = open(fname, O_RDWR);
6346   if (fd >= 0) {
6347     ufoPush((uint32_t)fd);
6348     ufoPushBool(1);
6349   } else {
6350     ufoPushBool(0);
6351   }
6352 }
6353
6354 // FILES:CREATE
6355 // ( addr count -- handle TRUE / FALSE )
6356 UFWORD(FILES_CREATE) {
6357   const char *fname = ufoPopFileName();
6358   //FIXME: add variable with default flags
6359   const int fd = open(fname, O_RDWR|O_CREAT|O_TRUNC, 0644);
6360   if (fd >= 0) {
6361     ufoPush((uint32_t)fd);
6362     ufoPushBool(1);
6363   } else {
6364     ufoPushBool(0);
6365   }
6366 }
6367
6368 // FILES:CLOSE
6369 // ( handle -- success? )
6370 UFWORD(FILES_CLOSE) {
6371   const int32_t fd = (int32_t)ufoPop();
6372   if (fd < 0) ufoFatal("invalid file handle in 'CLOSE'");
6373   ufoPushBool(close(fd) == 0);
6374 }
6375
6376 // FILES:TELL
6377 // ( handle -- ofs TRUE / FALSE )
6378 // `handle` cannot be 0.
6379 UFWORD(FILES_TELL) {
6380   const int32_t fd = (int32_t)ufoPop();
6381   if (fd < 0) ufoFatal("invalid file handle in 'TELL'");
6382   const off_t pos = lseek(fd, 0, SEEK_CUR);
6383   if (pos != (off_t)-1) {
6384     ufoPush((uint32_t)pos);
6385     ufoPushBool(1);
6386   } else {
6387     ufoPushBool(0);
6388   }
6389 }
6390
6391 // FILES:SEEK-EX
6392 // ( ofs whence handle -- TRUE / FALSE )
6393 // `handle` cannot be 0.
6394 UFWORD(FILES_SEEK_EX) {
6395   const int32_t fd = (int32_t)ufoPop();
6396   const uint32_t whence = ufoPop();
6397   const uint32_t ofs = ufoPop();
6398   if (fd < 0) ufoFatal("invalid file handle in 'SEEK-EX'");
6399   if (whence != (uint32_t)SEEK_SET &&
6400       whence != (uint32_t)SEEK_CUR &&
6401       whence != (uint32_t)SEEK_END) ufoFatal("invalid `whence` in 'SEEK-EX'");
6402   const off_t pos = lseek(fd, (off_t)ofs, (int)whence);
6403   ufoPushBool(pos != (off_t)-1);
6404 }
6405
6406 // FILES:SIZE
6407 // ( handle -- size TRUE / FALSE )
6408 // `handle` cannot be 0.
6409 UFWORD(FILES_SIZE) {
6410   const int32_t fd = (int32_t)ufoPop();
6411   if (fd < 0) ufoFatal("invalid file handle in 'SIZE'");
6412   const off_t origpos = lseek(fd, 0, SEEK_CUR);
6413   if (origpos == (off_t)-1) {
6414     ufoPushBool(0);
6415   } else {
6416     const off_t size = lseek(fd, 0, SEEK_END);
6417     if (size == (off_t)-1) {
6418       (void)lseek(origpos, 0, SEEK_SET);
6419       ufoPushBool(0);
6420     } else if (lseek(origpos, 0, SEEK_SET) == origpos) {
6421       ufoPush((uint32_t)size);
6422       ufoPushBool(1);
6423     } else {
6424       ufoPushBool(0);
6425     }
6426   }
6427 }
6428
6429 // FILES:READ
6430 // ( addr count handle -- rdsize TRUE / FALSE )
6431 // `handle` cannot be 0.
6432 UFWORD(FILES_READ) {
6433   const int32_t fd = (int32_t)ufoPop();
6434   if (fd < 0) ufoFatal("invalid file handle in 'READ'");
6435   uint32_t count = ufoPop();
6436   uint32_t addr = ufoPop();
6437   uint32_t done = 0;
6438   if (count != 0) {
6439     if ((count & 0x80000000U) != 0) ufoFatal("invalid number of bytes to read from file");
6440     while (count != done) {
6441       uint32_t rd = (uint32_t)sizeof(ufoFileIOBuffer);
6442       if (rd > count) rd = count;
6443       for (;;) {
6444         const ssize_t xres = read(fd, ufoFileIOBuffer, rd);
6445         if (xres >= 0) { rd = (uint32_t)xres; break; }
6446         if (errno == EINTR) continue;
6447         if (errno == EAGAIN || errno == EWOULDBLOCK) { rd = 0; break; }
6448         // error
6449         ufoPushBool(0);
6450         return;
6451       }
6452       if (rd == 0) break;
6453       done += rd;
6454       for (uint32_t f = 0; f != rd; f += 1u) {
6455         ufoImgPutU8Ext(addr, ufoFileIOBuffer[f]);
6456         addr += 1u;
6457       }
6458     }
6459   }
6460   ufoPush(done);
6461   ufoPushBool(1);
6462 }
6463
6464 // FILES:READ-EXACT
6465 // ( addr count handle -- TRUE / FALSE )
6466 // `handle` cannot be 0.
6467 UFWORD(FILES_READ_EXACT) {
6468   const int32_t fd = (int32_t)ufoPop();
6469   if (fd < 0) ufoFatal("invalid file handle in 'READ-EXACT'");
6470   uint32_t count = ufoPop();
6471   uint32_t addr = ufoPop();
6472   if (count != 0) {
6473     if ((count & 0x80000000U) != 0) ufoFatal("invalid number of bytes to read from file");
6474     while (count != 0) {
6475       uint32_t rd = (uint32_t)sizeof(ufoFileIOBuffer);
6476       if (rd > count) rd = count;
6477       for (;;) {
6478         const ssize_t xres = read(fd, ufoFileIOBuffer, rd);
6479         if (xres >= 0) { rd = (uint32_t)xres; break; }
6480         if (errno == EINTR) continue;
6481         if (errno == EAGAIN || errno == EWOULDBLOCK) { rd = 0; break; }
6482         // error
6483         ufoPushBool(0);
6484         return;
6485       }
6486       if (rd == 0) { ufoPushBool(0); return; } // still error
6487       count -= rd;
6488       for (uint32_t f = 0; f != rd; f += 1u) {
6489         ufoImgPutU8Ext(addr, ufoFileIOBuffer[f]);
6490         addr += 1u;
6491       }
6492     }
6493   }
6494   ufoPushBool(1);
6495 }
6496
6497 // FILES:WRITE
6498 // ( addr count handle -- TRUE / FALSE )
6499 // `handle` cannot be 0.
6500 UFWORD(FILES_WRITE) {
6501   const int32_t fd = (int32_t)ufoPop();
6502   if (fd < 0) ufoFatal("invalid file handle in 'WRITE'");
6503   uint32_t count = ufoPop();
6504   uint32_t addr = ufoPop();
6505   if (count != 0) {
6506     if ((count & 0x80000000U) != 0) ufoFatal("invalid number of bytes to write to file");
6507     while (count != 0) {
6508       uint32_t wr = (uint32_t)sizeof(ufoFileIOBuffer);
6509       if (wr > count) wr = count;
6510       for (uint32_t f = 0; f != wr; f += 1u) {
6511         ufoFileIOBuffer[f] = ufoImgGetU8Ext(addr + f);
6512       }
6513       for (;;) {
6514         const ssize_t xres = write(fd, ufoFileIOBuffer, wr);
6515         if (xres >= 0) { wr = (uint32_t)xres; break; }
6516         if (errno == EINTR) continue;
6517         fprintf(stderr, "ERRNO: %d (fd=%d)\n", errno, fd);
6518         //if (errno == EAGAIN || errno == EWOULDBLOCK) { wr = 0; break; }
6519         // error
6520         ufoPushBool(0);
6521         return;
6522       }
6523       if (wr == 0) { ufoPushBool(1); return; } // still error
6524       count -= wr; addr += wr;
6525     }
6526   }
6527   ufoPushBool(1);
6528 }
6529
6530
6531 // ////////////////////////////////////////////////////////////////////////// //
6532 // states
6533 //
6534
6535 //==========================================================================
6536 //
6537 //  ufoNewState
6538 //
6539 //  create a new state, its execution will start from the given CFA.
6540 //  state is not automatically activated.
6541 //
6542 //==========================================================================
6543 static UfoState *ufoNewState (void) {
6544   // find free state id
6545   uint32_t fidx = 0;
6546   uint32_t bmp = ufoStateUsedBitmap[0];
6547   while (fidx != (uint32_t)(UFO_MAX_STATES/32) && bmp == ~(uint32_t)0) {
6548     fidx += 1u;
6549     bmp = ufoStateUsedBitmap[fidx];
6550   }
6551   if (fidx == (uint32_t)(UFO_MAX_STATES/32)) ufoFatal("too many execution states");
6552   //fprintf(stderr, "NST:000: fidx=%u; bmp=0x%08x\n", fidx, bmp);
6553   fidx *= 32u;
6554   while ((bmp & 0x01) != 0) { fidx += 1u; bmp >>= 1; }
6555   ufo_assert(fidx < UFO_MAX_STATES);
6556   ufo_assert((ufoStateUsedBitmap[fidx / 32u] & ((uint32_t)1 << (fidx & 0x1f))) == 0);
6557   ufo_assert(ufoStateMap[fidx] == NULL);
6558   UfoState *st = calloc(1, sizeof(UfoState));
6559   if (st == NULL) ufoFatal("out of memory for states");
6560   st->id = fidx + 1u;
6561   ufoStateMap[fidx] = st;
6562   ufoStateUsedBitmap[fidx / 32u] |= ((uint32_t)1 << (fidx & 0x1f));
6563   //fprintf(stderr, "NST: fidx=%u; 0x%08x\n", fidx, ufoStateUsedBitmap[fidx / 32u]);
6564   return st;
6565 }
6566
6567
6568 //==========================================================================
6569 //
6570 //  ufoFreeState
6571 //
6572 //  free all memory used for the state, remove it from state list.
6573 //  WARNING! never free current state!
6574 //
6575 //==========================================================================
6576 static void ufoFreeState (UfoState *st) {
6577   if (st != NULL) {
6578     if (st == ufoCurrState) ufoFatal("cannot free active state");
6579     if (ufoYieldedState == st) ufoYieldedState = NULL;
6580     if (ufoDebuggerState == st) ufoDebuggerState = NULL;
6581     const uint32_t fidx = st->id - 1u;
6582     //fprintf(stderr, "FST: fidx=%u; 0x%08x\n", fidx, ufoStateUsedBitmap[fidx / 32u]);
6583     ufo_assert(fidx < UFO_MAX_STATES);
6584     ufo_assert((ufoStateUsedBitmap[fidx / 32u] & (1u << (fidx & 0x1f))) != 0);
6585     ufo_assert(ufoStateMap[fidx] == st);
6586     // free default TIB handle
6587     UfoState *oldst = ufoCurrState;
6588     ufoCurrState = st;
6589     const uint32_t tib = ufoImgGetU32(ufoAddrDefTIB);
6590     if ((tib & UFO_ADDR_TEMP_BIT) != 0) {
6591       UfoHandle *tibh = ufoGetHandle(tib);
6592       if (tibh != NULL) ufoFreeHandle(tibh);
6593     }
6594     ufoCurrState = oldst;
6595     // free temp buffer
6596     if (st->imageTemp != NULL) free(st->imageTemp);
6597     free(st);
6598     ufoStateMap[fidx] = NULL;
6599     ufoStateUsedBitmap[fidx / 32u] &= ~((uint32_t)1 << (fidx & 0x1f));
6600   }
6601 }
6602
6603
6604 //==========================================================================
6605 //
6606 //  ufoFindState
6607 //
6608 //==========================================================================
6609 static UfoState *ufoFindState (uint32_t stid) {
6610   UfoState *res = NULL;
6611   if (stid >= 0 && stid <= UFO_MAX_STATES) {
6612     if (stid == 0) {
6613       // current
6614       ufo_assert(ufoCurrState != NULL);
6615       stid = ufoCurrState->id - 1u;
6616     } else {
6617       stid -= 1u;
6618     }
6619     res = ufoStateMap[stid];
6620     if (res != NULL) {
6621       ufo_assert((ufoStateUsedBitmap[stid / 32u] & (1u << (stid & 0x1f))) != 0);
6622       ufo_assert(res->id == stid + 1u);
6623     } else {
6624       ufo_assert((ufoStateUsedBitmap[stid / 32u] & (1u << (stid & 0x1f))) == 0);
6625     }
6626   }
6627   return res;
6628 }
6629
6630
6631 //==========================================================================
6632 //
6633 //  ufoSwitchToState
6634 //
6635 //==========================================================================
6636 static void ufoSwitchToState (UfoState *newst) {
6637   ufo_assert(newst != NULL);
6638   if (newst != ufoCurrState) {
6639     ufoCurrState = newst;
6640   }
6641 }
6642
6643
6644 // ////////////////////////////////////////////////////////////////////////// //
6645 // initial dictionary definitions
6646 //
6647
6648 #undef UFWORD
6649
6650 #define UFWORD(name_)  do { \
6651   const uint32_t xcfa_ = ufoCFAsUsed; \
6652   ufo_assert(xcfa_ < UFO_MAX_NATIVE_CFAS); \
6653   ufoForthCFAs[xcfa_] = &ufoWord_##name_; \
6654   ufoCFAsUsed += 1; \
6655   ufoDefineNative(""#name_, xcfa_, 0); \
6656 } while (0)
6657
6658 #define UFWORDX(strname_,name_)  do { \
6659   const uint32_t xcfa_ = ufoCFAsUsed; \
6660   ufo_assert(xcfa_ < UFO_MAX_NATIVE_CFAS); \
6661   ufoForthCFAs[xcfa_] = &ufoWord_##name_; \
6662   ufoCFAsUsed += 1; \
6663   ufoDefineNative(strname_, xcfa_, 0); \
6664 } while (0)
6665
6666 #define UFWORD_IMM(name_)  do { \
6667   const uint32_t xcfa_ = ufoCFAsUsed; \
6668   ufo_assert(xcfa_ < UFO_MAX_NATIVE_CFAS); \
6669   ufoForthCFAs[xcfa_] = &ufoWord_##name_; \
6670   ufoCFAsUsed += 1; \
6671   ufoDefineNative(""#name_, xcfa_, 1); \
6672 } while (0)
6673
6674 #define UFWORDX_IMM(strname_,name_)  do { \
6675   const uint32_t xcfa_ = ufoCFAsUsed; \
6676   ufo_assert(xcfa_ < UFO_MAX_NATIVE_CFAS); \
6677   ufoForthCFAs[xcfa_] = &ufoWord_##name_; \
6678   ufoCFAsUsed += 1; \
6679   ufoDefineNative(strname_, xcfa_, 1); \
6680 } while (0)
6681
6682 #define UFC(name_)  ufoImgEmitU32_NoInline(ufoFindWordChecked(name_))
6683
6684
6685 //==========================================================================
6686 //
6687 //  ufoFindWordChecked
6688 //
6689 //==========================================================================
6690 UFO_DISABLE_INLINE uint32_t ufoFindWordChecked (const char *wname) {
6691   const uint32_t cfa = ufoFindWord(wname);
6692   if (cfa == 0) ufoFatal("word '%s' not found", wname);
6693   return cfa;
6694 }
6695
6696
6697 //==========================================================================
6698 //
6699 //  ufoGetForthVocId
6700 //
6701 //  get "FORTH" vocid
6702 //
6703 //==========================================================================
6704 uint32_t ufoGetForthVocId (void) {
6705   return ufoForthVocId;
6706 }
6707
6708
6709 //==========================================================================
6710 //
6711 //  ufoVocSetOnlyDefs
6712 //
6713 //==========================================================================
6714 void ufoVocSetOnlyDefs (uint32_t vocid) {
6715   ufoImgPutU32(ufoAddrCurrent, vocid);
6716   ufoImgPutU32(ufoAddrContext, vocid);
6717 }
6718
6719
6720 //==========================================================================
6721 //
6722 //  ufoCreateVoc
6723 //
6724 //  return voc PFA (vocid)
6725 //
6726 //==========================================================================
6727 uint32_t ufoCreateVoc (const char *wname, uint32_t parentvocid, uint32_t flags) {
6728   // create wordlist struct
6729   // typeid, used by Forth code (structs and such)
6730   ufoImgEmitU32(0); // typeid
6731   // vocid points here, to "LATEST-LFA"
6732   const uint32_t vocid = UFO_GET_DP();
6733   //fprintf(stderr, "NEW VOCID (%s): 0x%08x\n", wname, vocid);
6734   ufoImgEmitU32(0); // latest
6735   const uint32_t vlink = UFO_GET_DP();
6736   if ((vocid & UFO_ADDR_TEMP_BIT) == 0) {
6737     ufoImgEmitU32(ufoImgGetU32(ufoAddrVocLink)); // voclink
6738     ufoImgPutU32(ufoAddrVocLink, vlink); // update voclink
6739   } else {
6740     abort();
6741     ufoImgEmitU32(0);
6742   }
6743   ufoImgEmitU32(parentvocid); // parent
6744   const uint32_t hdraddr = UFO_GET_DP();
6745   ufoImgEmitU32(0); // word header
6746   // create empty hash table
6747   for (int f = 0; f < UFO_HASHTABLE_SIZE; f += 1) ufoImgEmitU32(0);
6748   // update CONTEXT and CURRENT if this is the first wordlist ever
6749   if (ufoImgGetU32(ufoAddrContext) == 0) {
6750     ufoImgPutU32(ufoAddrContext, vocid);
6751   }
6752   if (ufoImgGetU32(ufoAddrCurrent) == 0) {
6753     ufoImgPutU32(ufoAddrCurrent, vocid);
6754   }
6755   // create word header
6756   if (wname != NULL && wname[0] != 0) {
6757     /*
6758     uint32_t flags = ufoImgGetU32(ufoAddrNewWordFlags);
6759     flags &=
6760       //UFW_FLAG_IMMEDIATE|
6761       //UFW_FLAG_SMUDGE|
6762       //UFW_FLAG_NORETURN|
6763       UFW_FLAG_HIDDEN|
6764       //UFW_FLAG_CBLOCK|
6765       //UFW_FLAG_VOCAB|
6766       //UFW_FLAG_SCOLON|
6767       UFW_FLAG_PROTECTED;
6768     flags |= UFW_FLAG_VOCAB;
6769     */
6770     flags &= 0xffffff00u;
6771     flags |= UFW_FLAG_VOCAB;
6772     ufoCreateWordHeader(wname, flags);
6773     const uint32_t cfa = UFO_GET_DP();
6774     ufoImgEmitU32(ufoDoVocCFA); // cfa
6775     ufoImgEmitU32(vocid); // pfa
6776     // update vocab header pointer
6777     const uint32_t lfa = UFO_CFA_TO_LFA(cfa);
6778     ufoImgPutU32(hdraddr, UFO_LFA_TO_NFA(lfa));
6779     #ifdef UFO_DEBUG_DUMP_NEW_HEADERS
6780     ufoDumpWordHeader(lfa);
6781     #endif
6782   }
6783   return vocid;
6784 }
6785
6786
6787 //==========================================================================
6788 //
6789 //  ufoSetLatestArgs
6790 //
6791 //==========================================================================
6792 static void ufoSetLatestArgs (uint32_t warg) {
6793   const uint32_t curr = ufoImgGetU32(ufoAddrCurrent);
6794   const uint32_t lfa = ufoImgGetU32(curr);
6795   const uint32_t nfa = UFO_LFA_TO_NFA(lfa);
6796   uint32_t flags = ufoImgGetU32(nfa);
6797   //fprintf(stderr, "OLD FLAGS: 0x%08x\n", flags);
6798   flags &= ~UFW_WARG_MASK;
6799   flags |= warg & UFW_WARG_MASK;
6800   //fprintf(stderr, "NEW FLAGS: 0x%08x\n", flags);
6801   ufoImgPutU32(nfa, flags);
6802   #ifdef UFO_DEBUG_DUMP_NEW_HEADERS
6803   ufoDumpWordHeader(lfa);
6804   #endif
6805 }
6806
6807
6808 //==========================================================================
6809 //
6810 //  ufoDefine
6811 //
6812 //==========================================================================
6813 static void ufoDefineNative (const char *wname, uint32_t cfaidx, int immed) {
6814   cfaidx |= UFO_ADDR_CFA_BIT;
6815   uint32_t flags = ufoImgGetU32(ufoAddrNewWordFlags);
6816   flags &=
6817       //UFW_FLAG_IMMEDIATE|
6818       //UFW_FLAG_SMUDGE|
6819       //UFW_FLAG_NORETURN|
6820       UFW_FLAG_HIDDEN|
6821       //UFW_FLAG_CBLOCK|
6822       //UFW_FLAG_VOCAB|
6823       //UFW_FLAG_SCOLON|
6824       UFW_FLAG_PROTECTED;
6825   if (immed) flags |= UFW_FLAG_IMMEDIATE;
6826   ufoCreateWordHeader(wname, flags);
6827   ufoImgEmitU32(cfaidx);
6828 }
6829
6830
6831 //==========================================================================
6832 //
6833 //  ufoDefineConstant
6834 //
6835 //==========================================================================
6836 static void ufoDefineConstant (const char *name, uint32_t value) {
6837   ufoDefineNative(name, ufoDoConstCFA, 0);
6838   ufoImgEmitU32(value);
6839 }
6840
6841
6842 //==========================================================================
6843 //
6844 //  ufoDefineUserVar
6845 //
6846 //==========================================================================
6847 static void ufoDefineUserVar (const char *name, uint32_t addr) {
6848   ufoDefineNative(name, ufoDoUserVariableCFA, 0);
6849   ufoImgEmitU32(addr);
6850 }
6851
6852
6853 //==========================================================================
6854 //
6855 //  ufoDefineVar
6856 //
6857 //==========================================================================
6858 /*
6859 static void ufoDefineVar (const char *name, uint32_t value) {
6860   ufoDefineNative(name, ufoDoVarCFA, 0);
6861   ufoImgEmitU32(value);
6862 }
6863 */
6864
6865
6866 //==========================================================================
6867 //
6868 //  ufoDefineDefer
6869 //
6870 //==========================================================================
6871 /*
6872 static void ufoDefineDefer (const char *name, uint32_t value) {
6873   ufoDefineNative(name, ufoDoDeferCFA, 0);
6874   ufoImgEmitU32(value);
6875 }
6876 */
6877
6878
6879 //==========================================================================
6880 //
6881 //  ufoHiddenWords
6882 //
6883 //==========================================================================
6884 static void ufoHiddenWords (void) {
6885   const uint32_t flags = ufoImgGetU32(ufoAddrNewWordFlags);
6886   ufoImgPutU32(ufoAddrNewWordFlags, flags | UFW_FLAG_HIDDEN);
6887 }
6888
6889
6890 //==========================================================================
6891 //
6892 //  ufoPublicWords
6893 //
6894 //==========================================================================
6895 static void ufoPublicWords (void) {
6896   const uint32_t flags = ufoImgGetU32(ufoAddrNewWordFlags);
6897   ufoImgPutU32(ufoAddrNewWordFlags, flags & ~UFW_FLAG_HIDDEN);
6898 }
6899
6900
6901 //==========================================================================
6902 //
6903 //  ufoDefineForth
6904 //
6905 //==========================================================================
6906 /*
6907 static void ufoDefineForth (const char *name) {
6908   ufoDefineNative(name, ufoDoForthCFA, 0);
6909 }
6910 */
6911
6912
6913 //==========================================================================
6914 //
6915 //  ufoDefineForthImm
6916 //
6917 //==========================================================================
6918 /*
6919 static void ufoDefineForthImm (const char *name) {
6920   ufoDefineNative(name, ufoDoForthCFA, 1);
6921 }
6922 */
6923
6924
6925 //==========================================================================
6926 //
6927 //  ufoDefineForthHidden
6928 //
6929 //==========================================================================
6930 /*
6931 static void ufoDefineForthHidden (const char *name) {
6932   const uint32_t flags = ufoImgGetU32(ufoAddrNewWordFlags);
6933   ufoImgPutU32(ufoAddrNewWordFlags, flags | UFW_FLAG_HIDDEN);
6934   ufoDefineNative(name, ufoDoForthCFA, 0);
6935   ufoImgPutU32(ufoAddrNewWordFlags, flags);
6936 }
6937 */
6938
6939
6940 //==========================================================================
6941 //
6942 //  ufoDefineSColonForth
6943 //
6944 //  create word suitable for scattered colon extension
6945 //
6946 //==========================================================================
6947 static void ufoDefineSColonForth (const char *name) {
6948   ufoDefineNative(name, ufoDoForthCFA, 0);
6949   // placeholder for scattered colon
6950   // it will compile two branches:
6951   // the first branch will jump to the first "..:" word (or over the two branches)
6952   // the second branch is never taken, and works as a pointer to the latest branch addr in the list
6953   // this way, each extension word will simply fix the last branch address, and update list tail
6954   // at the creation time, second branch points to the first branch
6955   UFC("FORTH:(BRANCH)");
6956   const uint32_t xjmp = UFO_GET_DP();
6957   ufoImgEmitU32(0);
6958   UFC("FORTH:(BRANCH)"); ufoImgEmitU32(xjmp);
6959   ufoImgPutU32(xjmp, UFO_GET_DP());
6960 }
6961
6962
6963 //==========================================================================
6964 //
6965 //  ufoDoneForth
6966 //
6967 //==========================================================================
6968 UFO_FORCE_INLINE void ufoDoneForth (void) {
6969   UFC("FORTH:(EXIT)");
6970 }
6971
6972
6973 //==========================================================================
6974 //
6975 //  ufoCompileStrLit
6976 //
6977 //  compile string literal, the same as QUOTE_IMM
6978 //
6979 //==========================================================================
6980 static void ufoCompileStrLitEx (const char *str, const uint32_t slen) {
6981   if (str == NULL) str = "";
6982   if (slen > 255) ufoFatal("string literal too long");
6983   UFC("FORTH:(LITSTR8)");
6984   ufoImgEmitU8((uint8_t)slen);
6985   for (size_t f = 0; f < slen; f += 1) {
6986     ufoImgEmitU8(((const unsigned char *)str)[f]);
6987   }
6988   ufoImgEmitU8(0);
6989   ufoImgEmitAlign();
6990 }
6991
6992
6993 //==========================================================================
6994 //
6995 //  ufoCompileStrLit
6996 //
6997 //==========================================================================
6998 /*
6999 static void ufoCompileStrLit (const char *str) {
7000   ufoCompileStrLitEx(str, (uint32_t)strlen(str));
7001 }
7002 */
7003
7004
7005 //==========================================================================
7006 //
7007 //  ufoCompileLit
7008 //
7009 //==========================================================================
7010 static void ufoCompileLit (uint32_t value) {
7011   UFC("FORTH:(LIT)");
7012   ufoImgEmitU32(value);
7013 }
7014
7015
7016 //==========================================================================
7017 //
7018 //  ufoCompileCFALit
7019 //
7020 //==========================================================================
7021 /*
7022 static void ufoCompileCFALit (const char *wname) {
7023   UFC("FORTH:(LITCFA)");
7024   const uint32_t cfa = ufoFindWordChecked(wname);
7025   ufoImgEmitU32(cfa);
7026 }
7027 */
7028
7029
7030 //==========================================================================
7031 //
7032 //  ufoXStrEquCI
7033 //
7034 //==========================================================================
7035 static int ufoXStrEquCI (const char *word, const char *text, uint32_t tlen) {
7036   while (tlen != 0 && *word) {
7037     if (toUpper(*word) != toUpper(*text)) return 0;
7038     word += 1u; text += 1u; tlen -= 1u;
7039   }
7040   return (tlen == 0 && *word == 0);
7041 }
7042
7043
7044 #define UFO_MAX_LABEL_NAME  (63)
7045 typedef struct UfoLabel_t {
7046   uint32_t hash;
7047   uint32_t namelen;
7048   char name[UFO_MAX_LABEL_NAME];
7049   uint32_t addr; // jump chain tail, or address
7050   uint32_t defined;
7051   uint32_t word; // is this a forward word definition?
7052   struct UfoLabel_t *next;
7053 } UfoLabel;
7054
7055 static UfoLabel *ufoLabels = NULL;
7056
7057
7058 //==========================================================================
7059 //
7060 //  ufoFindAddLabelEx
7061 //
7062 //==========================================================================
7063 static UfoLabel *ufoFindAddLabelEx (const char *name, uint32_t namelen, int allowAdd) {
7064   if (namelen == 0 || namelen > UFO_MAX_LABEL_NAME) ufoFatal("invalid label name");
7065   const uint32_t hash = joaatHashBufCI(name, namelen);
7066   UfoLabel *lbl = ufoLabels;
7067   while (lbl != NULL) {
7068     if (lbl->hash == hash && lbl->namelen == namelen) {
7069       int ok = 1;
7070       uint32_t sidx = 0;
7071       while (ok && sidx != namelen) {
7072         ok = (toUpper(name[sidx]) == toUpper(lbl->name[sidx]));
7073         sidx += 1;
7074       }
7075       if (ok) return lbl;
7076     }
7077     lbl = lbl->next;
7078   }
7079   if (allowAdd) {
7080     // create new label
7081     lbl = calloc(1, sizeof(UfoLabel));
7082     lbl->hash = hash;
7083     lbl->namelen = namelen;
7084     memcpy(lbl->name, name, namelen);
7085     lbl->name[namelen] = 0;
7086     lbl->next = ufoLabels;
7087     ufoLabels = lbl;
7088     return lbl;
7089   } else {
7090     return NULL;
7091   }
7092 }
7093
7094
7095 //==========================================================================
7096 //
7097 //  ufoFindAddLabel
7098 //
7099 //==========================================================================
7100 static UfoLabel *ufoFindAddLabel (const char *name, uint32_t namelen) {
7101   return ufoFindAddLabelEx(name, namelen, 1);
7102 }
7103
7104
7105 //==========================================================================
7106 //
7107 //  ufoFindLabel
7108 //
7109 //==========================================================================
7110 static UfoLabel *ufoFindLabel (const char *name, uint32_t namelen) {
7111   return ufoFindAddLabelEx(name, namelen, 0);
7112 }
7113
7114
7115 //==========================================================================
7116 //
7117 //  ufoTrySimpleNumber
7118 //
7119 //  only decimal and C-like hexes; with an optional sign
7120 //
7121 //==========================================================================
7122 static int ufoTrySimpleNumber (const char *text, uint32_t tlen, uint32_t *num) {
7123   int neg = 0;
7124
7125   if (tlen != 0 && *text == '+') { text += 1u; tlen -= 1u; }
7126   else if (tlen != 0 && *text == '-') { neg = 1; text += 1u; tlen -= 1u; }
7127
7128   int base = 10; // default base
7129   if (tlen > 2 && text[0] == '0' && toUpper(text[1]) == 'X') {
7130     // hex
7131     base = 16;
7132     text += 2u; tlen -= 2u;
7133   }
7134
7135   if (tlen == 0 || digitInBase(*text, base) < 0) return 0;
7136
7137   int wasDigit = 0;
7138   uint32_t n = 0;
7139   int dig;
7140   while (tlen != 0) {
7141     if (*text == '_') {
7142       if (!wasDigit) return 0;
7143       wasDigit = 0;
7144     } else {
7145       dig = digitInBase(*text, base);
7146       if (dig < 0) return 0;
7147       wasDigit = 1;
7148       n = n * (uint32_t)base + (uint32_t)dig;
7149     }
7150     text += 1u; tlen -= 1u;
7151   }
7152
7153   if (!wasDigit) return 0;
7154   if (neg) n = ~n + 1u;
7155   *num = n;
7156   return 1;
7157 }
7158
7159
7160 //==========================================================================
7161 //
7162 //  ufoEmitLabelChain
7163 //
7164 //==========================================================================
7165 static void ufoEmitLabelChain (UfoLabel *lbl) {
7166   ufo_assert(lbl != NULL);
7167   ufo_assert(lbl->defined == 0);
7168   const uint32_t here = UFO_GET_DP();
7169   ufoImgEmitU32(lbl->addr);
7170   lbl->addr = here;
7171 }
7172
7173
7174 //==========================================================================
7175 //
7176 //  ufoFixLabelChainHere
7177 //
7178 //==========================================================================
7179 static void ufoFixLabelChainHere (UfoLabel *lbl) {
7180   ufo_assert(lbl != NULL);
7181   ufo_assert(lbl->defined == 0);
7182   const uint32_t here = UFO_GET_DP();
7183   while (lbl->addr != 0) {
7184     const uint32_t aprev = ufoImgGetU32(lbl->addr);
7185     ufoImgPutU32(lbl->addr, here);
7186     lbl->addr = aprev;
7187   }
7188   lbl->addr = here;
7189   lbl->defined = 1;
7190 }
7191
7192
7193 #define UFO_MII_WORD_COMPILE_IMM (-4)
7194 #define UFO_MII_WORD_CFA_LIT     (-3)
7195 #define UFO_MII_WORD_COMPILE     (-2)
7196 #define UFO_MII_IN_WORD          (-1)
7197 #define UFO_MII_NO_WORD          (0)
7198 #define UFO_MII_WORD_NAME        (1)
7199 #define UFO_MII_WORD_NAME_IMM    (2)
7200 #define UFO_MII_WORD_NAME_HIDDEN (3)
7201
7202 static int ufoMinInterpState = UFO_MII_NO_WORD;
7203
7204
7205 //==========================================================================
7206 //
7207 //  ufoFinalLabelCheck
7208 //
7209 //==========================================================================
7210 static void ufoFinalLabelCheck (void) {
7211   int errorCount = 0;
7212   if (ufoMinInterpState != UFO_MII_NO_WORD) {
7213     ufoFatal("missing semicolon");
7214   }
7215   while (ufoLabels != NULL) {
7216     UfoLabel *lbl = ufoLabels; ufoLabels = lbl->next;
7217     if (!lbl->defined) {
7218       fprintf(stderr, "UFO ERROR: label '%s' is not defined!\n", lbl->name);
7219       errorCount += 1;
7220     }
7221     free(lbl);
7222   }
7223   if (errorCount != 0) {
7224     ufoFatal("%d undefined label%s", errorCount, (errorCount != 1 ? "s" : ""));
7225   }
7226 }
7227
7228
7229 //==========================================================================
7230 //
7231 //  ufoInterpretLine
7232 //
7233 //  this is so i could write Forth definitions more easily
7234 //
7235 //  labels:
7236 //    $name -- reference
7237 //    $name: -- definition
7238 //
7239 //==========================================================================
7240 UFO_DISABLE_INLINE void ufoInterpretLine (const char *line) {
7241   char wname[UFO_MAX_WORD_LENGTH];
7242   uint32_t wlen, num, cfa;
7243   UfoLabel *lbl;
7244   while (*line) {
7245     if (*(const unsigned char *)line <= 32) {
7246       line += 1;
7247     } else if (ufoMinInterpState == UFO_MII_WORD_CFA_LIT ||
7248                ufoMinInterpState == UFO_MII_WORD_COMPILE ||
7249                ufoMinInterpState == UFO_MII_WORD_COMPILE_IMM)
7250     {
7251       // "[']"/"COMPILE"/"[COMPILE]" argument
7252       wlen = 1;
7253       while (((const unsigned char *)line)[wlen] > 32) wlen += 1;
7254       if (wlen >= UFO_MAX_WORD_LENGTH) ufoFatal("word name too long");
7255       memcpy(wname, line, wlen);
7256       wname[wlen] = 0;
7257       switch (ufoMinInterpState) {
7258         case UFO_MII_WORD_CFA_LIT: UFC("FORTH:(LITCFA)"); break;
7259         case UFO_MII_WORD_COMPILE: UFC("FORTH:(LITCFA)"); break;
7260         case UFO_MII_WORD_COMPILE_IMM: break;
7261         default: ufo_assert(0);
7262       }
7263       cfa = ufoFindWord(wname);
7264       if (cfa != 0) {
7265         ufoImgEmitU32(cfa);
7266       } else {
7267         // forward reference
7268         lbl = ufoFindAddLabel(line, wlen);
7269         if (lbl->defined || (lbl->word == 0 && lbl->addr)) {
7270           ufoFatal("unknown word: '%s'", wname);
7271         }
7272         lbl->word = 1;
7273         ufoEmitLabelChain(lbl);
7274       }
7275       switch (ufoMinInterpState) {
7276         case UFO_MII_WORD_CFA_LIT: break;
7277         case UFO_MII_WORD_COMPILE: UFC("FORTH:COMPILE,"); break;
7278         case UFO_MII_WORD_COMPILE_IMM: break;
7279         default: ufo_assert(0);
7280       }
7281       ufoMinInterpState = UFO_MII_IN_WORD;
7282       line += wlen;
7283     } else if (ufoMinInterpState > UFO_MII_NO_WORD) {
7284       // new word
7285       wlen = 1;
7286       while (((const unsigned char *)line)[wlen] > 32) wlen += 1;
7287       if (wlen >= UFO_MAX_WORD_LENGTH) ufoFatal("word name too long");
7288       if (wlen > 2 && line[0] == ':' && line[wlen - 1u] == ':') ufoFatal("invalid word name");
7289       memcpy(wname, line, wlen);
7290       wname[wlen] = 0;
7291       const uint32_t oldFlags = ufoImgGetU32(ufoAddrNewWordFlags);
7292       if (ufoMinInterpState == UFO_MII_WORD_NAME_HIDDEN) {
7293         ufoImgPutU32(ufoAddrNewWordFlags, oldFlags | UFW_FLAG_HIDDEN);
7294       }
7295       ufoDefineNative(wname, ufoDoForthCFA, (ufoMinInterpState == UFO_MII_WORD_NAME_IMM));
7296       ufoImgPutU32(ufoAddrNewWordFlags, oldFlags);
7297       ufoMinInterpState = UFO_MII_IN_WORD;
7298       // check for forward references
7299       lbl = ufoFindLabel(line, wlen);
7300       if (lbl != NULL) {
7301         if (lbl->defined || !lbl->word) {
7302           ufoFatal("label/word conflict for '%.*s'", (unsigned)wlen, line);
7303         }
7304         ufoFixLabelChainHere(lbl);
7305       }
7306       line += wlen;
7307     } else if ((line[0] == ';' && line[1] == ';') ||
7308                (line[0] == '-' && line[1] == '-') ||
7309                (line[0] == '/' && line[1] == '/') ||
7310                (line[0] == '\\' && ((const unsigned char *)line)[1] <= 32))
7311     {
7312       ufoFatal("do not use single-line comments");
7313     } else if (line[0] == '(' && ((const unsigned char *)line)[1] <= 32) {
7314       while (*line && *line != ')') line += 1;
7315       if (*line == ')') line += 1;
7316     } else {
7317       // word
7318       wlen = 1;
7319       while (((const unsigned char *)line)[wlen] > 32) wlen += 1;
7320       if (wlen == 1 && (line[0] == '"' || line[0] == '`')) {
7321         // string literal
7322         const char qch = line[0];
7323         if (!line[1]) ufoFatal("unterminated string literal");
7324         // skip quote and space
7325         if (((const unsigned char *)line)[1] <= 32) line += 2u; else line += 1u;
7326         wlen = 0;
7327         while (line[wlen] && line[wlen] != qch) wlen += 1u;
7328         if (line[wlen] != qch) ufoFatal("unterminated string literal");
7329         ufoCompileStrLitEx(line, wlen);
7330         line += wlen + 1u; // skip final quote
7331       } else if (wlen == 1 && line[0] == ':') {
7332         // new word
7333         if (ufoMinInterpState != UFO_MII_NO_WORD) ufoFatal("unexpected colon");
7334         ufoMinInterpState = UFO_MII_WORD_NAME;
7335         line += wlen;
7336       } else if (wlen == 1 && line[0] == ';') {
7337         // end word
7338         if (ufoMinInterpState != UFO_MII_IN_WORD) ufoFatal("unexpected semicolon");
7339         ufoImgEmitU32(ufoFindWordChecked("FORTH:(EXIT)"));
7340         ufoMinInterpState = UFO_MII_NO_WORD;
7341         line += wlen;
7342       } else if (wlen == 2 && line[0] == '!' && line[1] == ':') {
7343         // new immediate word
7344         if (ufoMinInterpState != UFO_MII_NO_WORD) ufoFatal("unexpected colon");
7345         ufoMinInterpState = UFO_MII_WORD_NAME_IMM;
7346         line += wlen;
7347       } else if (wlen == 2 && line[0] == '*' && line[1] == ':') {
7348         // new hidden word
7349         if (ufoMinInterpState != UFO_MII_NO_WORD) ufoFatal("unexpected colon");
7350         ufoMinInterpState = UFO_MII_WORD_NAME_HIDDEN;
7351         line += wlen;
7352       } else if (wlen == 3 && memcmp(line, "[']", 3) == 0) {
7353         // cfa literal
7354         if (ufoMinInterpState != UFO_MII_IN_WORD) ufoFatal("unexpected immediate tick");
7355         ufoMinInterpState = UFO_MII_WORD_CFA_LIT;
7356         line += wlen;
7357       } else if (wlen == 7 && ufoXStrEquCI("COMPILE", line, wlen)) {
7358         // "COMPILE"
7359         if (ufoMinInterpState != UFO_MII_IN_WORD) ufoFatal("unexpected immediate tick");
7360         ufoMinInterpState = UFO_MII_WORD_COMPILE;
7361         line += wlen;
7362       } else if (wlen == 9 && ufoXStrEquCI("[COMPILE]", line, wlen)) {
7363         // "[COMPILE]"
7364         if (ufoMinInterpState != UFO_MII_IN_WORD) ufoFatal("unexpected immediate tick");
7365         ufoMinInterpState = UFO_MII_WORD_COMPILE_IMM;
7366         line += wlen;
7367       } else {
7368         // look for a word
7369         if (wlen >= UFO_MAX_WORD_LENGTH) ufoFatal("word name too long");
7370         memcpy(wname, line, wlen);
7371         wname[wlen] = 0;
7372         cfa = ufoFindWord(wname);
7373         if (cfa != 0) {
7374           // compile word
7375           ufoImgEmitU32(cfa);
7376         } else if (ufoTrySimpleNumber(line, wlen, &num)) {
7377           // compile numeric literal
7378           ufoCompileLit(num);
7379         } else {
7380           // unknown word, this may be a forward reference, or a label definition
7381           // label defintion starts with "$"
7382           // (there are no words starting with "$" in the initial image)
7383           if (line[0] == '$') {
7384             if (wlen == 1) ufoFatal("dollar what?");
7385             if (wlen > 2 && line[wlen - 1u] == ':') {
7386               // label definition
7387               lbl = ufoFindAddLabel(line, wlen - 1u);
7388               if (lbl->defined) ufoFatal("double label '%s' definition", lbl->name);
7389               ufoFixLabelChainHere(lbl);
7390             } else {
7391               // label reference
7392               lbl = ufoFindAddLabel(line, wlen);
7393               if (lbl->defined) {
7394                 ufoImgEmitU32(lbl->addr);
7395               } else {
7396                 ufoEmitLabelChain(lbl);
7397               }
7398             }
7399           } else {
7400             // forward reference
7401             lbl = ufoFindAddLabel(line, wlen);
7402             if (lbl->defined || (lbl->word == 0 && lbl->addr)) {
7403               ufoFatal("unknown word: '%s'", wname);
7404             }
7405             lbl->word = 1;
7406             ufoEmitLabelChain(lbl);
7407           }
7408         }
7409         line += wlen;
7410       }
7411     }
7412   }
7413 }
7414
7415
7416 //==========================================================================
7417 //
7418 //  ufoReset
7419 //
7420 //==========================================================================
7421 UFO_DISABLE_INLINE void ufoReset (void) {
7422   if (ufoCurrState == NULL) ufoFatal("no active execution state");
7423
7424   ufoSP = 0; ufoRP = 0;
7425   ufoLP = 0; ufoLBP = 0;
7426
7427   ufoInRunWord = 0;
7428   ufoVMStop = 0; ufoVMAbort = 0;
7429
7430   ufoInBacktrace = 0;
7431
7432   // save TIB
7433   const uint32_t tib = ufoImgGetU32(ufoAddrTIBx);
7434   const uint32_t tibDef = ufoImgGetU32(ufoAddrDefTIB);
7435   ufoInitStateUserVars(ufoCurrState, 0);
7436   // restore TIB
7437   ufoImgPutU32(ufoAddrTIBx, tib);
7438   ufoImgPutU32(ufoAddrDefTIB, tibDef);
7439   ufoImgPutU32(ufoAddrRedefineWarning, UFO_REDEF_WARN_NORMAL);
7440   ufoResetTib();
7441
7442   ufoImgPutU32(ufoAddrDPTemp, 0);
7443
7444   ufoImgPutU32(ufoAddrNewWordFlags, 0);
7445   ufoVocSetOnlyDefs(ufoForthVocId);
7446 }
7447
7448
7449 //==========================================================================
7450 //
7451 //  ufoDefineEmitType
7452 //
7453 //==========================================================================
7454 UFO_DISABLE_INLINE void ufoDefineEmitType (void) {
7455   // EMIT
7456   // ( ch -- )
7457   ufoInterpretLine(": EMIT  ( ch -- )  (NORM-EMIT-CHAR) (EMIT) ;");
7458
7459   // XEMIT
7460   // ( ch -- )
7461   ufoInterpretLine(": XEMIT  ( ch -- )  (NORM-XEMIT-CHAR) (EMIT) ;");
7462
7463   // CR
7464   // ( -- )
7465   ufoInterpretLine(": CR  ( -- )  NL (EMIT) ;");
7466
7467   // ENDCR
7468   // ( -- )
7469   ufoInterpretLine(
7470     ": ENDCR  ( -- ) "
7471     "  LASTCR? FORTH:(TBRANCH) $endcr-exit CR "
7472     "$endcr-exit: "
7473     ";");
7474   //ufoDecompileWord(ufoFindWordChecked("ENDCR"));
7475
7476   // SPACE
7477   // ( -- )
7478   ufoInterpretLine(": SPACE  ( -- )  BL (EMIT) ;");
7479
7480   // SPACES
7481   // ( count -- )
7482   ufoInterpretLine(
7483     ": SPACES  ( count -- ) "
7484     "$spaces-again: "
7485     "    DUP 0> FORTH:(0BRANCH) $spaces-exit "
7486     "    SPACE 1- "
7487     "    FORTH:(BRANCH) $spaces-again "
7488     "$spaces-exit: "
7489     "  DROP "
7490     ";");
7491
7492   // TYPE
7493   // ( addr count -- )
7494   ufoInterpretLine(
7495     ": TYPE  ( addr count -- ) "
7496     "  A>R SWAP >A "
7497     "$type-again: "
7498     "    DUP 0> FORTH:(0BRANCH) $type-exit "
7499     "    C@A EMIT +1>A "
7500     "    1- "
7501     "    FORTH:(BRANCH) $type-again "
7502     "$type-exit: "
7503     "  DROP R>A "
7504     ";");
7505
7506   // XTYPE
7507   // ( addr count -- )
7508   ufoInterpretLine(
7509     ": XTYPE  ( addr count -- ) "
7510     "  A>R SWAP >A "
7511     "$xtype-again: "
7512     "    DUP 0> FORTH:(0BRANCH) $xtype-exit "
7513     "    C@A XEMIT +1>A "
7514     "    1- "
7515     "    FORTH:(BRANCH) $xtype-again "
7516     "$xtype-exit: "
7517     "  DROP R>A "
7518     ";");
7519
7520   // HERE
7521   // ( -- here )
7522   ufoInterpretLine(
7523     ": HERE  ( -- here ) "
7524     "  FORTH:(DP-TEMP) @ ?DUP "
7525     "  FORTH:(TBRANCH) $here-exit "
7526     "  FORTH:(DP) @ "
7527     "$here-exit: "
7528     ";");
7529
7530   // ALIGN-HERE
7531   // ( -- )
7532   ufoInterpretLine(
7533     ": ALIGN-HERE  ( -- ) "
7534     "$align-here-loop: "
7535     "  HERE 3 AND "
7536     "  FORTH:(0BRANCH) $align-here-exit "
7537     "  0 C, "
7538     "  FORTH:(BRANCH) $align-here-loop "
7539     "$align-here-exit: "
7540     ";");
7541
7542   // STRLITERAL
7543   // ( C:addr count -- )  ( E: -- addr count )
7544   ufoInterpretLine(
7545     ": STRLITERAL  ( C:addr count -- )  ( E: -- addr count ) "
7546     "  DUP 255 U> ` string literal too long` ?ERROR "
7547     "  STATE @ FORTH:(0BRANCH) $strlit-exit "
7548     "  ( addr count ) "
7549     "  ['] FORTH:(LITSTR8) COMPILE, "
7550     "  A>R SWAP >A "
7551     "  ( compile length ) "
7552     "  DUP C, "
7553     "  ( compile chars ) "
7554     "$strlit-loop: "
7555     "    DUP 0<> FORTH:(0BRANCH) $strlit-loop-exit "
7556     "    C@A C, +1>A  1- "
7557     "  FORTH:(BRANCH) $strlit-loop "
7558     "$strlit-loop-exit: "
7559     "  R>A "
7560     "  ( final 0: our counter is 0 here, so use it ) "
7561     "  C, ALIGN-HERE "
7562     "$strlit-exit: "
7563     ";");
7564
7565   // quote
7566   // ( -- addr count )
7567   ufoInterpretLine(
7568     "!: \"  ( -- addr count ) "
7569     "  34 PARSE ` string literal expected` ?NOT-ERROR "
7570     "  COMPILER:(UNESCAPE) STRLITERAL "
7571     ";");
7572 }
7573
7574
7575 //==========================================================================
7576 //
7577 //  ufoDefineInterpret
7578 //
7579 //  define "INTERPRET" in Forth
7580 //
7581 //==========================================================================
7582 UFO_DISABLE_INLINE void ufoDefineInterpret (void) {
7583   UFWORDX("(UFO-INTERPRET-FINISHED-ACTION)", UFO_INTERPRET_FINISHED_ACTION);
7584
7585   // return "stop flag"
7586   ufoInterpretLine(
7587     "*: (UFO-INTERPRET-NEXT-LINE)  ( -- continue? ) "
7588     "  STATE @ FORTH:(TBRANCH) $ipn_incomp "
7589     "    ( interpreter allowed to cross include boundary ) "
7590     "    REFILL FORTH:(BRANCH) $ipn_done "
7591     "$ipn_incomp: "
7592     "    ( compiler is not allowed to cross include boundary ) "
7593     "    REFILL-NOCROSS ` compiler cannot cross file boundaries` ?NOT-ERROR "
7594     "    TRUE "
7595     "$ipn_done: "
7596     ";");
7597
7598   ufoInterpNextLineCFA = ufoFindWordChecked("FORTH:(UFO-INTERPRET-NEXT-LINE)");
7599   ufoInterpretLine("*: (INTERPRET-NEXT-LINE)  (USER-INTERPRET-NEXT-LINE) @ EXECUTE-TAIL ;");
7600
7601   // skip comments, parse name, refilling lines if necessary
7602   // returning FALSE as counter means: "no addr, exit INTERPRET"
7603   ufoInterpretLine(
7604     "*: (INTERPRET-PARSE-NAME)  ( -- addr count / FALSE ) "
7605     "$label_ipn_again: "
7606     "  TRUE (PARSE-SKIP-COMMENTS) PARSE-NAME "
7607     "  DUP FORTH:(TBRANCH) $label_ipn_exit_fwd "
7608     "  2DROP (INTERPRET-NEXT-LINE) "
7609     "  FORTH:(TBRANCH) $label_ipn_again "
7610     "  FALSE "
7611     "$label_ipn_exit_fwd: "
7612     ";");
7613   //ufoDecompileWord(ufoFindWordChecked("(INTERPRET-PARSE-NAME)"));
7614
7615   ufoInterpretLine(
7616     ": INTERPRET "
7617     "$interp-again: "
7618     "  FORTH:(INTERPRET-PARSE-NAME) ( addr count / FALSE )"
7619     "  ?DUP FORTH:(0BRANCH) $interp-done "
7620     "  ( try defered checker ) "
7621     "  ( addr count FALSE -- addr count FALSE / TRUE ) "
7622     "  FALSE (INTERPRET-CHECK-WORD) FORTH:(TBRANCH) $interp-again "
7623     "  2DUP FIND-WORD  ( addr count cfa TRUE / addr count FALSE ) "
7624     "  FORTH:(0BRANCH) $interp-try-number "
7625     "  ( word found ) "
7626     "  NROT 2DROP  ( drop word string ) "
7627     "  STATE @ FORTH:(0BRANCH) $interp-exec "
7628     "  ( compiling; check immediate bit ) "
7629     "  DUP CFA->NFA @ COMPILER:(WFLAG-IMMEDIATE) AND FORTH:(TBRANCH) $interp-exec "
7630     "  ( compile it ) "
7631     "  FORTH:COMPILE, FORTH:(BRANCH) $interp-again "
7632     "  ( execute it ) "
7633     "$interp-exec: "
7634     "  EXECUTE FORTH:(BRANCH) $interp-again "
7635     "  ( not a word, try a number ) "
7636     "$interp-try-number: "
7637     "  2DUP TRUE BASE @ (BASED-NUMBER)  ( addr count allowsign? base -- num TRUE / FALSE ) "
7638     "  FORTH:(0BRANCH) $interp-number-error "
7639     "  ( number ) "
7640     "  NROT 2DROP  ( drop word string ) "
7641     "  ( do we need to compile it? ) "
7642     "  STATE @ FORTH:(0BRANCH) $interp-again "
7643     "  COMPILE FORTH:(LIT) FORTH:, "
7644     "  FORTH:(BRANCH) $interp-again "
7645     "  ( error ) "
7646     "$interp-number-error: "
7647     "  ( addr count FALSE -- addr count FALSE / TRUE ) "
7648     "  FALSE (INTERPRET-WORD-NOT-FOUND) FORTH:(TBRANCH) $interp-again "
7649     "  ENDCR SPACE XTYPE `  -- wut?` TYPE CR "
7650     "  ` unknown word` ERROR "
7651     "$interp-done: "
7652     ";");
7653   //ufoDecompileWord(ufoFindWordChecked("INTERPRET"));
7654 }
7655
7656
7657 //==========================================================================
7658 //
7659 //  ufoInitBaseDict
7660 //
7661 //==========================================================================
7662 UFO_DISABLE_INLINE void ufoInitBaseDict (void) {
7663   uint32_t imgAddr = 0;
7664
7665   // reserve 32 bytes for nothing
7666   for (uint32_t f = 0; f < 32; f += 1) {
7667     ufoImgPutU8(imgAddr, 0);
7668     imgAddr += 1;
7669   }
7670   // align
7671   while ((imgAddr & 3) != 0) {
7672     ufoImgPutU8(imgAddr, 0);
7673     imgAddr += 1;
7674   }
7675
7676   // DP
7677   ufoAddrDP = imgAddr;
7678   ufoImgPutU32(imgAddr, 0); imgAddr += 4u;
7679
7680   // DP-TEMP
7681   ufoAddrDPTemp = imgAddr;
7682   ufoImgPutU32(imgAddr, 0); imgAddr += 4u;
7683
7684   // (LATEST-XFA)
7685   ufoAddrLastXFA = imgAddr;
7686   ufoImgPutU32(imgAddr, 0); imgAddr += 4u;
7687
7688   // (VOC-LINK)
7689   ufoAddrVocLink = imgAddr;
7690   ufoImgPutU32(imgAddr, 0); imgAddr += 4u;
7691
7692   // (NEW-WORD-FLAGS)
7693   ufoAddrNewWordFlags = imgAddr;
7694   ufoImgPutU32(imgAddr, UFW_FLAG_PROTECTED); imgAddr += 4u;
7695
7696   // WORD-REDEFINE-WARN-MODE
7697   ufoAddrRedefineWarning = imgAddr;
7698   ufoImgPutU32(imgAddr, UFO_REDEF_WARN_NORMAL); imgAddr += 4u;
7699
7700   // setup (DP) and (DP-TEMP)
7701   ufoImgPutU32(ufoAddrDP, imgAddr);
7702   ufoImgPutU32(ufoAddrDPTemp, 0);
7703
7704   #if 0
7705   fprintf(stderr, "INITIAL HERE: 0x%08x (0x%08x)\n", imgAddr, UFO_GET_DP());
7706   #endif
7707 }
7708
7709
7710 //==========================================================================
7711 //
7712 //  ufoInitStateUserVars
7713 //
7714 //==========================================================================
7715 static void ufoInitStateUserVars (UfoState *st, uint32_t cfa) {
7716   ufo_assert(st != NULL);
7717   if (st->imageTempSize < 8192u) {
7718     uint32_t *itmp = realloc(st->imageTemp, 8192);
7719     if (itmp == NULL) ufoFatal("out of memory for state user area");
7720     st->imageTemp = itmp;
7721     memset((uint8_t *)st->imageTemp + st->imageTempSize, 0, 8192u - st->imageTempSize);
7722     st->imageTempSize = 8192;
7723   }
7724   st->imageTemp[(ufoAddrBASE & UFO_ADDR_TEMP_MASK) / 4u] = 10;
7725   st->imageTemp[(ufoAddrSTATE & UFO_ADDR_TEMP_MASK) / 4u] = 0;
7726   st->imageTemp[(ufoAddrUserVarUsed & UFO_ADDR_TEMP_MASK) / 4u] = ufoAddrUserVarUsed;
7727   st->imageTemp[(ufoAddrDefTIB & UFO_ADDR_TEMP_MASK) / 4u] = UFO_DEF_TIB_ADDR;
7728   st->imageTemp[(ufoAddrTIBx & UFO_ADDR_TEMP_MASK) / 4u] = UFO_DEF_TIB_ADDR;
7729   st->imageTemp[(ufoAddrINx & UFO_ADDR_TEMP_MASK) / 4u] = 0;
7730   st->imageTemp[(ufoAddrContext & UFO_ADDR_TEMP_MASK) / 4u] = ufoForthVocId;
7731   st->imageTemp[(ufoAddrCurrent & UFO_ADDR_TEMP_MASK) / 4u] = ufoForthVocId;
7732   st->imageTemp[(ufoAddrSelf & UFO_ADDR_TEMP_MASK) / 4u] = 0;
7733   st->imageTemp[(ufoAddrInterNextLine & UFO_ADDR_TEMP_MASK) / 4u] = ufoInterpNextLineCFA;
7734   st->imageTemp[(ufoAddrEP & UFO_ADDR_TEMP_MASK) / 4u] = 0;
7735   // init other things, because this procedure is used in `ufoReset()` too
7736   st->SP = 0; st->RP = 0; st->RPTop = 0; st->regA = 0;
7737   st->LP = 0; st->LBP = 0; st->vmRPopCFA = 0;
7738   st->VSP = 0;
7739   // init it
7740   if (cfa != 0) {
7741     st->vmRPopCFA = 1;
7742     st->rStack[0] = 0xdeadf00d; // dummy value
7743     st->rStack[1] = cfa;
7744     st->RP = 2;
7745   }
7746 }
7747
7748
7749 //==========================================================================
7750 //
7751 //  ufoInitBasicWords
7752 //
7753 //==========================================================================
7754 UFO_DISABLE_INLINE void ufoInitBasicWords (void) {
7755   ufoDefineConstant("FALSE", 0);
7756   ufoDefineConstant("TRUE", ufoTrueValue);
7757
7758   ufoDefineConstant("BL", 32);
7759   ufoDefineConstant("NL", 10);
7760
7761   // user variables
7762   ufoDefineUserVar("BASE", ufoAddrBASE);
7763   ufoDefineUserVar("TIB", ufoAddrTIBx);
7764   ufoDefineUserVar(">IN", ufoAddrINx);
7765   ufoDefineUserVar("(STD-TIB-ADDR)", ufoAddrDefTIB);
7766   ufoDefineUserVar("(USER-VAR-USED)", ufoAddrUserVarUsed);
7767   ufoDefineConstant("(USER-VAR-ADDR)", UFO_ADDR_TEMP_BIT);
7768   ufoDefineConstant("(USER-VAR-SIZE)", UFO_USER_AREA_SIZE);
7769   ufoDefineConstant("(USER-TIB)", UFO_DEF_TIB_ADDR);
7770   ufoDefineConstant("(USER-TIB-SIZE)", UFO_ADDR_HANDLE_OFS_MASK);
7771
7772   ufoDefineUserVar("STATE", ufoAddrSTATE);
7773   ufoDefineConstant("CONTEXT", ufoAddrContext);
7774   ufoDefineConstant("CURRENT", ufoAddrCurrent);
7775   ufoDefineConstant("(SELF)", ufoAddrSelf); // used in OOP implementations
7776   ufoDefineConstant("(USER-INTERPRET-NEXT-LINE)", ufoAddrInterNextLine);
7777   ufoDefineConstant("(EXC-FRAME-PTR)", ufoAddrEP);
7778
7779   ufoHiddenWords();
7780   ufoDefineConstant("(LATEST-XFA)", ufoAddrLastXFA);
7781   ufoDefineConstant("(VOC-LINK)", ufoAddrVocLink);
7782   ufoDefineConstant("(NEW-WORD-FLAGS)", ufoAddrNewWordFlags);
7783   ufoDefineConstant("(ADDR-TEMP-BIT)", UFO_ADDR_TEMP_BIT);
7784   ufoDefineConstant("(ADDR-CFA-BIT)", UFO_ADDR_CFA_BIT);
7785   ufoDefineConstant("(ADDR-HANDLE-BIT)", UFO_ADDR_HANDLE_BIT);
7786   ufoDefineConstant("(MAX-HANDLE-OFS)", UFO_ADDR_HANDLE_OFS_MASK);
7787
7788   ufoDefineConstant("(PAD-ADDR)", UFO_PAD_ADDR);
7789   ufoDefineConstant("(#BUF)", UFO_NBUF_ADDR + 4u); // reserve room for counter
7790   ufoDefineConstant("(#BUF-SIZE)", UFO_NBUF_SIZE - 8u);
7791
7792   ufoDefineConstant("(DP)", ufoAddrDP);
7793   ufoDefineConstant("(DP-TEMP)", ufoAddrDPTemp);
7794   ufoPublicWords();
7795
7796   //UFWORDX("(UFO-BUCKET-STATS)", PAR_UFO_BUCKET_STATS);
7797   UFWORDX("SP0!", SP0_STORE);
7798   UFWORDX("RP0!", RP0_STORE);
7799
7800   UFWORDX("PAD", PAD);
7801
7802   UFWORDX("@", PEEK);
7803   UFWORDX("C@", CPEEK);
7804   UFWORDX("W@", WPEEK);
7805
7806   UFWORDX("!", POKE);
7807   UFWORDX("C!", CPOKE);
7808   UFWORDX("W!", WPOKE);
7809
7810   UFWORDX(",", COMMA);
7811   UFWORDX("C,", CCOMMA);
7812   UFWORDX("W,", WCOMMA);
7813
7814   UFWORDX("A>", REGA_LOAD);
7815   UFWORDX(">A", REGA_STORE);
7816   UFWORDX("A-SWAP", REGA_SWAP);
7817   UFWORDX("+1>A", REGA_INC);
7818   UFWORDX("+4>A", REGA_INC_CELL);
7819   UFWORDX("A>R", REGA_TO_R);
7820   UFWORDX("R>A", R_TO_REGA);
7821
7822   UFWORDX("@A+", PEEK_REGA_IDX);
7823   UFWORDX("C@A+", CPEEK_REGA_IDX);
7824   UFWORDX("W@A+", WPEEK_REGA_IDX);
7825
7826   UFWORDX("!A+", POKE_REGA_IDX);
7827   UFWORDX("C!A+", CPOKE_REGA_IDX);
7828   UFWORDX("W!A+", WPOKE_REGA_IDX);
7829
7830   ufoHiddenWords();
7831   UFWORDX("(LIT)", PAR_LIT); ufoSetLatestArgs(UFW_WARG_LIT);
7832   UFWORDX("(LITCFA)", PAR_LITCFA); ufoSetLatestArgs(UFW_WARG_CFA);
7833   UFWORDX("(LITVOCID)", PAR_LITVOCID); ufoSetLatestArgs(UFW_WARG_VOCID);
7834   UFWORDX("(LITSTR8)", PAR_LITSTR8); ufoSetLatestArgs(UFW_WARG_C1STRZ);
7835   UFWORDX("(EXIT)", PAR_EXIT);
7836
7837   ufoLitStr8CFA = ufoFindWordChecked("FORTH:(LITSTR8)");
7838
7839   UFWORDX("(L-ENTER)", PAR_LENTER); ufoSetLatestArgs(UFW_WARG_LIT);
7840   UFWORDX("(L-LEAVE)", PAR_LLEAVE);
7841   UFWORDX("(LOCAL@)", PAR_LOCAL_LOAD);
7842   UFWORDX("(LOCAL!)", PAR_LOCAL_STORE);
7843
7844   UFWORDX("(BRANCH)", PAR_BRANCH); ufoSetLatestArgs(UFW_WARG_BRANCH);
7845   UFWORDX("(TBRANCH)", PAR_TBRANCH); ufoSetLatestArgs(UFW_WARG_BRANCH);
7846   UFWORDX("(0BRANCH)", PAR_0BRANCH); ufoSetLatestArgs(UFW_WARG_BRANCH);
7847   UFWORDX("(+0BRANCH)", PAR_P0BRANCH); ufoSetLatestArgs(UFW_WARG_BRANCH);
7848   UFWORDX("(+BRANCH)", PAR_PBRANCH); ufoSetLatestArgs(UFW_WARG_BRANCH);
7849   UFWORDX("(-0BRANCH)", PAR_M0BRANCH); ufoSetLatestArgs(UFW_WARG_BRANCH);
7850   UFWORDX("(-BRANCH)", PAR_MBRANCH); ufoSetLatestArgs(UFW_WARG_BRANCH);
7851   UFWORDX("(DATASKIP)", PAR_DATASKIP); ufoSetLatestArgs(UFW_WARG_DATASKIP);
7852   ufoPublicWords();
7853 }
7854
7855
7856 //==========================================================================
7857 //
7858 //  ufoInitBasicCompilerWords
7859 //
7860 //==========================================================================
7861 UFO_DISABLE_INLINE void ufoInitBasicCompilerWords (void) {
7862   // create "COMPILER" vocabulary
7863   ufoCompilerVocId = ufoCreateVoc("COMPILER", 0, UFW_FLAG_PROTECTED);
7864   ufoVocSetOnlyDefs(ufoCompilerVocId);
7865
7866   ufoDefineConstant("(CFAIDX-DO-FORTH)", ufoDoForthCFA);
7867   ufoDefineConstant("(CFAIDX-DO-VAR)", ufoDoVariableCFA);
7868   ufoDefineConstant("(CFAIDX-DO-VALUE)", ufoDoValueCFA);
7869   ufoDefineConstant("(CFAIDX-DO-CONST)", ufoDoConstCFA);
7870   ufoDefineConstant("(CFAIDX-DO-DEFER)", ufoDoDeferCFA);
7871   ufoDefineConstant("(CFAIDX-DO-VOC)", ufoDoVocCFA);
7872   ufoDefineConstant("(CFAIDX-DO-CREATE)", ufoDoCreateCFA);
7873   ufoDefineConstant("(CFAIDX-DO-USER-VAR)", ufoDoUserVariableCFA);
7874
7875   ufoDefineConstant("(WFLAG-IMMEDIATE)", UFW_FLAG_IMMEDIATE);
7876   ufoDefineConstant("(WFLAG-SMUDGE)", UFW_FLAG_SMUDGE);
7877   ufoDefineConstant("(WFLAG-NORETURN)", UFW_FLAG_NORETURN);
7878   ufoDefineConstant("(WFLAG-HIDDEN)", UFW_FLAG_HIDDEN);
7879   ufoDefineConstant("(WFLAG-CBLOCK)", UFW_FLAG_CBLOCK);
7880   ufoDefineConstant("(WFLAG-VOCAB)", UFW_FLAG_VOCAB);
7881   ufoDefineConstant("(WFLAG-SCOLON)", UFW_FLAG_SCOLON);
7882   ufoDefineConstant("(WFLAG-PROTECTED)", UFW_FLAG_PROTECTED);
7883
7884   ufoDefineConstant("(WARG-MASK)", UFW_WARG_MASK);
7885   ufoDefineConstant("(WARG-NONE)", UFW_WARG_NONE);
7886   ufoDefineConstant("(WARG-BRANCH)", UFW_WARG_BRANCH);
7887   ufoDefineConstant("(WARG-LIT)", UFW_WARG_LIT);
7888   ufoDefineConstant("(WARG-C4STRZ)", UFW_WARG_C4STRZ);
7889   ufoDefineConstant("(WARG-CFA)", UFW_WARG_CFA);
7890   ufoDefineConstant("(WARG-CBLOCK)", UFW_WARG_CBLOCK);
7891   ufoDefineConstant("(WARG-VOCID)", UFW_WARG_VOCID);
7892   ufoDefineConstant("(WARG-C1STRZ)", UFW_WARG_C1STRZ);
7893
7894   ufoDefineConstant("(VOCOFS-LATEST)", UFW_VOCAB_OFS_LATEST);
7895   ufoDefineConstant("(VOCOFS-VOCLINK)", UFW_VOCAB_OFS_VOCLINK);
7896   ufoDefineConstant("(VOCOFS-PARENT)", UFW_VOCAB_OFS_PARENT);
7897   ufoDefineConstant("(VOCOFS-HEADER)", UFW_VOCAB_OFS_HEADER);
7898   ufoDefineConstant("(VOCOFS-HTABLE)", UFW_VOCAB_OFS_HTABLE);
7899   ufoDefineConstant("(VOC-HTABLE-SIZE)", UFO_HASHTABLE_SIZE);
7900   ufoDefineConstant("(VOC-HTABLE-NOFLAG)", UFO_NO_HTABLE_FLAG);
7901
7902   ufoDefineConstant("(REDEFINE-WARN-DON'T-CARE)", UFO_REDEF_WARN_DONT_CARE);
7903   ufoDefineConstant("(REDEFINE-WARN-NONE)", UFO_REDEF_WARN_NONE);
7904   ufoDefineConstant("(REDEFINE-WARN-NORMAL)", UFO_REDEF_WARN_NORMAL);
7905   ufoDefineConstant("(REDEFINE-WARN-PARENTS)", UFO_REDEF_WARN_PARENTS);
7906
7907   ufoDefineConstant("WORD-REDEFINE-WARN-MODE", ufoAddrRedefineWarning);
7908
7909   UFWORDX("(UNESCAPE)", PAR_UNESCAPE);
7910
7911   ufoInterpretLine(
7912     ": ?EXEC  ( -- ) "
7913     "  FORTH:STATE FORTH:@ ` expecting interpretation mode` FORTH:?ERROR "
7914     ";");
7915
7916   ufoInterpretLine(
7917     ": ?COMP  ( -- ) "
7918     "  FORTH:STATE FORTH:@ ` expecting compilation mode` FORTH:?NOT-ERROR "
7919     ";");
7920
7921   UFWORDX("(CREATE-WORD-HEADER)", PAR_CREATE_WORD_HEADER);
7922   UFWORDX("(CREATE-NAMELESS-WORD-HEADER)", PAR_CREATE_NAMELESS_WORD_HEADER);
7923
7924   ufoVocSetOnlyDefs(ufoForthVocId);
7925
7926   // [
7927   ufoInterpretLine("!: [  COMPILER:?COMP 0 STATE ! ;");
7928   // ]
7929   ufoInterpretLine(": ]  COMPILER:?EXEC 1 STATE ! ;");
7930 }
7931
7932
7933 //==========================================================================
7934 //
7935 //  ufoInitMoreWords
7936 //
7937 //==========================================================================
7938 UFO_DISABLE_INLINE void ufoInitMoreWords (void) {
7939   UFWORDX("COMPILE,", COMMA); // just an alias, for clarity
7940
7941   UFWORDX("CFA->PFA", CFA2PFA);
7942   UFWORDX("CFA->NFA", CFA2NFA);
7943   UFWORDX("CFA->LFA", CFA2LFA);
7944   UFWORDX("CFA->WEND", CFA2WEND);
7945
7946   UFWORDX("PFA->CFA", PFA2CFA);
7947   UFWORDX("PFA->NFA", PFA2NFA);
7948
7949   UFWORDX("NFA->CFA", NFA2CFA);
7950   UFWORDX("NFA->PFA", NFA2PFA);
7951   UFWORDX("NFA->LFA", NFA2LFA);
7952
7953   UFWORDX("LFA->CFA", LFA2CFA);
7954   UFWORDX("LFA->PFA", LFA2PFA);
7955   UFWORDX("LFA->BFA", LFA2BFA);
7956   UFWORDX("LFA->XFA", LFA2XFA);
7957   UFWORDX("LFA->YFA", LFA2YFA);
7958   UFWORDX("LFA->NFA", LFA2NFA);
7959
7960   UFWORDX("(BASED-NUMBER)", PAR_BASED_NUMBER);
7961   UFWORDX("FIND-WORD", FIND_WORD);
7962   UFWORDX("(FIND-WORD-IN-VOC)", FIND_WORD_IN_VOC);
7963   UFWORDX("(FIND-WORD-IN-VOC-AND-PARENTS)", FIND_WORD_IN_VOC_AND_PARENTS);
7964
7965   UFWORD(EXECUTE);
7966   UFWORDX("EXECUTE-TAIL", EXECUTE_TAIL);
7967
7968   UFWORD(DUP);
7969   UFWORDX("?DUP", QDUP);
7970   UFWORDX("2DUP", DDUP);
7971   UFWORD(DROP);
7972   UFWORDX("2DROP", DDROP);
7973   UFWORD(SWAP);
7974   UFWORDX("2SWAP", DSWAP);
7975   UFWORD(OVER);
7976   UFWORDX("2OVER", DOVER);
7977   UFWORD(ROT);
7978   UFWORD(NROT);
7979   UFWORDX("PICK", PICK);
7980   UFWORDX("ROLL", ROLL);
7981
7982   UFWORD(RDUP);
7983   UFWORD(RDROP);
7984   UFWORDX(">R", DTOR);
7985   UFWORDX("R>", RTOD);
7986   UFWORDX("R@", RPEEK);
7987   UFWORDX("RPICK", RPICK);
7988   UFWORDX("RROLL", RROLL);
7989   UFWORDX("RSWAP", RSWAP);
7990   UFWORDX("ROVER", ROVER);
7991   UFWORDX("RROT", RROT);
7992   UFWORDX("RNROT", RNROT);
7993
7994   UFWORDX("FLUSH-EMIT", FLUSH_EMIT);
7995   UFWORDX("(EMIT)", PAR_EMIT);
7996   UFWORDX("(NORM-EMIT-CHAR)", PAR_NORM_EMIT_CHAR);
7997   UFWORDX("(NORM-XEMIT-CHAR)", PAR_NORM_XEMIT_CHAR);
7998   UFWORDX("LASTCR?", LASTCRQ);
7999   UFWORDX("LASTCR!", LASTCRSET);
8000
8001   // simple math
8002   UFWORDX("+", PLUS);
8003   UFWORDX("-", MINUS);
8004   UFWORDX("*", MUL);
8005   UFWORDX("U*", UMUL);
8006   UFWORDX("/", DIV);
8007   UFWORDX("U/", UDIV);
8008   UFWORDX("MOD", MOD);
8009   UFWORDX("UMOD", UMOD);
8010   UFWORDX("/MOD", DIVMOD);
8011   UFWORDX("U/MOD", UDIVMOD);
8012   UFWORDX("*/", MULDIV);
8013   UFWORDX("U*/", UMULDIV);
8014   UFWORDX("*/MOD", MULDIVMOD);
8015   UFWORDX("U*/MOD", UMULDIVMOD);
8016   UFWORDX("M*", MMUL);
8017   UFWORDX("UM*", UMMUL);
8018   UFWORDX("M/MOD", MDIVMOD);
8019   UFWORDX("UM/MOD", UMDIVMOD);
8020   UFWORDX("UDS*", UDSMUL);
8021
8022   UFWORDX("SM/REM", SMREM);
8023   UFWORDX("FM/MOD", FMMOD);
8024
8025   UFWORDX("D-", DMINUS);
8026   UFWORDX("D+", DPLUS);
8027   UFWORDX("D=", DEQU);
8028   UFWORDX("D<", DLESS);
8029   UFWORDX("D<=", DLESSEQU);
8030   UFWORDX("DU<", DULESS);
8031   UFWORDX("DU<=", DULESSEQU);
8032
8033   UFWORD(ASH);
8034   UFWORD(LSH);
8035
8036   // logic
8037   UFWORDX("<", LESS);
8038   UFWORDX(">", GREAT);
8039   UFWORDX("<=", LESSEQU);
8040   UFWORDX(">=", GREATEQU);
8041   UFWORDX("U<", ULESS);
8042   UFWORDX("U>", UGREAT);
8043   UFWORDX("U<=", ULESSEQU);
8044   UFWORDX("U>=", UGREATEQU);
8045   UFWORDX("=", EQU);
8046   UFWORDX("<>", NOTEQU);
8047
8048   UFWORDX("0=", ZERO_EQU);
8049   UFWORDX("0<>", ZERO_NOTEQU);
8050
8051   UFWORDX("NOT", ZERO_EQU);
8052   UFWORDX("NOTNOT", ZERO_NOTEQU);
8053
8054   UFWORD(BITNOT);
8055   UFWORD(AND);
8056   UFWORD(OR);
8057   UFWORD(XOR);
8058   UFWORDX("LOGAND", LOGAND);
8059   UFWORDX("LOGOR", LOGOR);
8060
8061   // TIB and parser
8062   UFWORDX("(TIB-IN)", TIB_IN);
8063   UFWORDX("TIB-PEEKCH", TIB_PEEKCH);
8064   UFWORDX("TIB-PEEKCH-OFS", TIB_PEEKCH_OFS);
8065   UFWORDX("TIB-GETCH", TIB_GETCH);
8066   UFWORDX("TIB-SKIPCH", TIB_SKIPCH);
8067
8068   UFWORDX("REFILL", REFILL);
8069   UFWORDX("REFILL-NOCROSS", REFILL_NOCROSS);
8070
8071   ufoHiddenWords();
8072   UFWORDX("(PARSE)", PAR_PARSE);
8073   UFWORDX("(PARSE-SKIP-COMMENTS)", PAR_PARSE_SKIP_COMMENTS);
8074   ufoPublicWords();
8075   UFWORDX("PARSE-SKIP-BLANKS", PARSE_SKIP_BLANKS);
8076   UFWORDX("PARSE-NAME", PARSE_NAME);
8077   UFWORDX("PARSE-SKIP-LINE", PARSE_SKIP_LINE);
8078   UFWORDX("PARSE", PARSE);
8079
8080   ufoHiddenWords();
8081   UFWORDX("(VSP@)", PAR_GET_VSP);
8082   UFWORDX("(VSP!)", PAR_SET_VSP);
8083   UFWORDX("(VSP-AT@)", PAR_VSP_LOAD);
8084   UFWORDX("(VSP-AT!)", PAR_VSP_STORE);
8085   ufoDefineConstant("(VSP-SIZE)", UFO_VOCSTACK_SIZE);
8086
8087   ufoDefineConstant("(SP-SIZE)", UFO_DSTACK_SIZE);
8088   ufoDefineConstant("(RP-SIZE)", UFO_RSTACK_SIZE);
8089   ufoDefineConstant("(LP-SIZE)", UFO_LSTACK_SIZE);
8090   ufoPublicWords();
8091
8092   UFWORDX("ERROR", ERROR);
8093   UFWORDX("FATAL-ERROR", ERROR);
8094
8095   ufoInterpretLine(": 1+  ( n -- n+1 )  1 + ;");
8096   ufoInterpretLine(": 1-  ( n -- n-1 )  1 - ;");
8097   ufoInterpretLine(": 2+  ( n -- n+2 )  2 + ;");
8098   ufoInterpretLine(": 2-  ( n -- n-2 )  2 - ;");
8099   ufoInterpretLine(": 4+  ( n -- n+4 )  4 + ;");
8100   ufoInterpretLine(": 4-  ( n -- n-4 )  4 - ;");
8101
8102   ufoInterpretLine(": 2*  ( n -- n*2 )  1 ASH ;");
8103   ufoInterpretLine(": 2/  ( n -- n/2 )  -1 ASH ;");
8104   ufoInterpretLine(": 4*  ( n -- n*4 )  2 ASH ;");
8105   ufoInterpretLine(": 4/  ( n -- n/4 )  -2 ASH ;");
8106
8107   ufoInterpretLine(": 2U*  ( u -- u*2 )  1 LSH ;");
8108   ufoInterpretLine(": 2U/  ( u -- u/2 )  -1 LSH ;");
8109   ufoInterpretLine(": 4U*  ( u -- u*4 )  2 LSH ;");
8110   ufoInterpretLine(": 4U/  ( u -- u/4 )  -2 LSH ;");
8111
8112   ufoInterpretLine(": 0<  ( n -- n<0 )  0 < ;");
8113   ufoInterpretLine(": 0>  ( n -- n>0 )  0 > ;");
8114   ufoInterpretLine(": 0<=  ( n -- n<0 )  0 <= ;");
8115   ufoInterpretLine(": 0>=  ( n -- n>0 )  0 >= ;");
8116
8117   ufoInterpretLine(": @A  ( idx -- v )  0 @A+ ;");
8118   ufoInterpretLine(": C@A  ( idx -- v )  0 C@A+ ;");
8119   ufoInterpretLine(": W@A  ( idx -- v )  0 W@A+ ;");
8120
8121   ufoInterpretLine(": !A  ( idx -- v )  0 !A+ ;");
8122   ufoInterpretLine(": C!A  ( idx -- v )  0 C!A+ ;");
8123   ufoInterpretLine(": W!A  ( idx -- v )  0 W!A+ ;");
8124
8125   // ABORT
8126   // ( -- )
8127   ufoInterpretLine(": ABORT  ` \"ABORT\" called` ERROR ;");
8128
8129   // ?ERROR
8130   // ( errflag addr count -- )
8131   ufoInterpretLine(
8132     ": ?ERROR  ( errflag addr count -- ) "
8133     "  ROT FORTH:(0BRANCH) $qerr_skip ERROR "
8134     "$qerr_skip: "
8135     "  2DROP "
8136     ";");
8137
8138   // ?NOT-ERROR
8139   // ( errflag addr count -- )
8140   ufoInterpretLine(
8141     ": ?NOT-ERROR  ( errflag addr count -- ) "
8142     "  ROT FORTH:(TBRANCH) $qnoterr_skip ERROR "
8143     "$qnoterr_skip: "
8144     "  2DROP "
8145     ";");
8146
8147   ufoInterpretLine(
8148     ": FIND-WORD-IN-VOC  ( vocid addr count -- cfa TRUE / FALSE ) "
8149     "  0 (FIND-WORD-IN-VOC) ;");
8150
8151   ufoInterpretLine(
8152     ": FIND-WORD-IN-VOC-AND-PARENTS ( vocid addr count -- cfa TRUE / FALSE ) "
8153     "  0 (FIND-WORD-IN-VOC-AND-PARENTS) ;");
8154
8155   UFWORDX("GET-MSECS", GET_MSECS);
8156 }
8157
8158
8159 //==========================================================================
8160 //
8161 //  ufoInitHandleWords
8162 //
8163 //==========================================================================
8164 UFO_DISABLE_INLINE void ufoInitHandleWords (void) {
8165   // create "HANDLE" vocabulary
8166   const uint32_t handleVocId = ufoCreateVoc("HANDLE", 0, UFW_FLAG_PROTECTED);
8167   ufoVocSetOnlyDefs(handleVocId);
8168   UFWORDX("NEW", PAR_NEW_HANDLE);
8169   UFWORDX("FREE", PAR_FREE_HANDLE);
8170   UFWORDX("TYPEID@", PAR_HANDLE_GET_TYPEID);
8171   UFWORDX("TYPEID!", PAR_HANDLE_SET_TYPEID);
8172   UFWORDX("SIZE@", PAR_HANDLE_GET_SIZE);
8173   UFWORDX("SIZE!", PAR_HANDLE_SET_SIZE);
8174   UFWORDX("USED@", PAR_HANDLE_GET_USED);
8175   UFWORDX("USED!", PAR_HANDLE_SET_USED);
8176   UFWORDX("C@", PAR_HANDLE_LOAD_BYTE);
8177   UFWORDX("W@", PAR_HANDLE_LOAD_WORD);
8178   UFWORDX("@", PAR_HANDLE_LOAD_CELL);
8179   UFWORDX("C!", PAR_HANDLE_STORE_BYTE);
8180   UFWORDX("W!", PAR_HANDLE_STORE_WORD);
8181   UFWORDX("!", PAR_HANDLE_STORE_CELL);
8182   UFWORDX("LOAD-FILE", PAR_HANDLE_LOAD_FILE);
8183   ufoVocSetOnlyDefs(ufoForthVocId);
8184 }
8185
8186
8187 //==========================================================================
8188 //
8189 //  ufoInitHigherWords
8190 //
8191 //==========================================================================
8192 UFO_DISABLE_INLINE void ufoInitHigherWords (void) {
8193   UFWORDX("(INCLUDE)", PAR_INCLUDE);
8194   UFWORDX("(INCLUDE-BUILD-NAME)", PAR_INCLUDE_BUILD_NAME);
8195   UFWORDX("(INCLUDE-NO-REFILL)", PAR_INCLUDE_NO_REFILL);
8196   UFWORDX("(INCLUDE-LINE-SEEK)", PAR_INCLUDE_LINE_SEEK);
8197
8198   UFWORDX("(INCLUDE-LINE-FOFS)", PAR_INCLUDE_LINE_FOFS);
8199   UFWORDX("(INCLUDE-DEPTH)", PAR_INCLUDE_DEPTH);
8200   UFWORDX("(INCLUDE-FILE-ID)", PAR_INCLUDE_FILE_ID);
8201   UFWORDX("(INCLUDE-FILE-LINE)", PAR_INCLUDE_FILE_LINE);
8202   UFWORDX("(INCLUDE-FILE-NAME)", PAR_INCLUDE_FILE_NAME);
8203
8204   UFWORDX("($DEFINED?)", PAR_DLR_DEFINEDQ);
8205   UFWORDX("($DEFINE)", PAR_DLR_DEFINE);
8206   UFWORDX("($UNDEF)", PAR_DLR_UNDEF);
8207
8208   UFWORDX_IMM("$INCLUDE", DLR_INCLUDE_IMM);
8209   UFWORDX_IMM("$INCLUDE-ONCE", DLR_INCLUDE_ONCE_IMM);
8210 }
8211
8212
8213 //==========================================================================
8214 //
8215 //  ufoInitStringWords
8216 //
8217 //==========================================================================
8218 UFO_DISABLE_INLINE void ufoInitStringWords (void) {
8219   // create "STRING" vocabulary
8220   const uint32_t stringVocId = ufoCreateVoc("STRING", 0, UFW_FLAG_PROTECTED);
8221   ufoVocSetOnlyDefs(stringVocId);
8222   UFWORDX("=", STREQU);
8223   UFWORDX("=CI", STREQUCI);
8224   UFWORDX("SEARCH", SEARCH);
8225   UFWORDX("HASH", STRHASH);
8226   UFWORDX("HASH-CI", STRHASHCI);
8227   ufoVocSetOnlyDefs(ufoForthVocId);
8228 }
8229
8230
8231 //==========================================================================
8232 //
8233 //  ufoInitDebugWords
8234 //
8235 //==========================================================================
8236 UFO_DISABLE_INLINE void ufoInitDebugWords (void) {
8237   // create "DEBUG" vocabulary
8238   const uint32_t debugVocId = ufoCreateVoc("DEBUG", 0, UFW_FLAG_PROTECTED);
8239   ufoVocSetOnlyDefs(debugVocId);
8240   UFWORDX("(DECOMPILE-CFA)", DEBUG_DECOMPILE_CFA);
8241   UFWORDX("(DECOMPILE-MEM)", DEBUG_DECOMPILE_MEM);
8242   UFWORDX("BACKTRACE", UFO_BACKTRACE);
8243   UFWORDX("DUMP-STACK", DUMP_STACK);
8244   UFWORDX("BACKTRACE-TASK", UFO_BACKTRACE_TASK);
8245   UFWORDX("DUMP-STACK-TASK", DUMP_STACK_TASK);
8246   UFWORDX("DUMP-RSTACK-TASK", DUMP_RSTACK_TASK);
8247   UFWORDX("(BP)", MT_DEBUGGER_BP);
8248   UFWORDX("IP->NFA", IP2NFA);
8249   UFWORDX("IP->FILE/LINE", IP2FILELINE);
8250   UFWORDX("IP->FILE-HASH/LINE", IP2FILEHASHLINE);
8251   ufoVocSetOnlyDefs(ufoForthVocId);
8252 }
8253
8254
8255 //==========================================================================
8256 //
8257 //  ufoInitMTWords
8258 //
8259 //==========================================================================
8260 UFO_DISABLE_INLINE void ufoInitMTWords (void) {
8261   // create "MTASK" vocabulary
8262   const uint32_t mtVocId = ufoCreateVoc("MTASK", 0, UFW_FLAG_PROTECTED);
8263   ufoVocSetOnlyDefs(mtVocId);
8264   UFWORDX("NEW-STATE", MT_NEW_STATE);
8265   UFWORDX("FREE-STATE", MT_FREE_STATE);
8266   UFWORDX("STATE-NAME@", MT_GET_STATE_NAME);
8267   UFWORDX("STATE-NAME!", MT_SET_STATE_NAME);
8268   UFWORDX("STATE-FIRST", MT_STATE_FIRST);
8269   UFWORDX("STATE-NEXT", MT_STATE_NEXT);
8270   UFWORDX("YIELD-TO", MT_YIELD_TO);
8271   UFWORDX("SET-SELF-AS-DEBUGGER", MT_SET_SELF_AS_DEBUGGER);
8272   UFWORDX("DEBUGGER-RESUME", MT_RESUME_DEBUGEE);
8273   UFWORDX("DEBUGGER-SINGLE-STEP", MT_SINGLE_STEP_DEBUGEE);
8274   UFWORDX("ACTIVE-STATE", MT_ACTIVE_STATE);
8275   UFWORDX("STATE-IP@", MT_STATE_IP_GET);
8276   UFWORDX("STATE-IP!", MT_STATE_IP_SET);
8277   UFWORDX("STATE-A>", MT_STATE_REGA_GET);
8278   UFWORDX("STATE->A", MT_STATE_REGA_SET);
8279   UFWORDX("STATE-USER@", MT_STATE_USER_GET);
8280   UFWORDX("STATE-USER!", MT_STATE_USER_SET);
8281   UFWORDX("STATE-RPOPCFA@", MT_STATE_RPOPCFA_GET);
8282   UFWORDX("STATE-RPOPCFA!", MT_STATE_RPOPCFA_SET);
8283   UFWORDX("YIELDED-FROM", MT_YIELDED_FROM);
8284   UFWORDX("STATE-SP@", MT_DSTACK_DEPTH_GET);
8285   UFWORDX("STATE-RP@", MT_RSTACK_DEPTH_GET);
8286   UFWORDX("STATE-LP@", MT_LP_GET);
8287   UFWORDX("STATE-LBP@", MT_LBP_GET);
8288   UFWORDX("STATE-SP!", MT_DSTACK_DEPTH_SET);
8289   UFWORDX("STATE-RP!", MT_RSTACK_DEPTH_SET);
8290   UFWORDX("STATE-LP!", MT_LP_SET);
8291   UFWORDX("STATE-LBP!", MT_LBP_SET);
8292   UFWORDX("STATE-DS@", MT_DSTACK_LOAD);
8293   UFWORDX("STATE-RS@", MT_RSTACK_LOAD);
8294   UFWORDX("STATE-LS@", MT_LSTACK_LOAD);
8295   UFWORDX("STATE-DS!", MT_DSTACK_STORE);
8296   UFWORDX("STATE-RS!", MT_RSTACK_STORE);
8297   UFWORDX("STATE-LS!", MT_LSTACK_STORE);
8298   UFWORDX("STATE-VSP@", MT_VSP_GET);
8299   UFWORDX("STATE-VSP!", MT_VSP_SET);
8300   UFWORDX("STATE-VSP-AT@", MT_VSP_LOAD);
8301   UFWORDX("STATE-VSP-AT!", MT_VSP_STORE);
8302   ufoVocSetOnlyDefs(ufoForthVocId);
8303 }
8304
8305
8306 //==========================================================================
8307 //
8308 //  ufoInitTTYWords
8309 //
8310 //==========================================================================
8311 UFO_DISABLE_INLINE void ufoInitTTYWords (void) {
8312   // create "TTY" vocabulary
8313   const uint32_t ttyVocId = ufoCreateVoc("TTY", 0, UFW_FLAG_PROTECTED);
8314   ufoVocSetOnlyDefs(ttyVocId);
8315   UFWORDX("TTY?", TTY_TTYQ);
8316   UFWORDX("RAW?", TTY_RAWQ);
8317   UFWORDX("SIZE", TTY_SIZE);
8318   UFWORDX("SET-RAW", TTY_SET_RAW);
8319   UFWORDX("SET-COOKED", TTY_SET_COOKED);
8320   UFWORDX("RAW-EMIT", TTY_RAW_EMIT);
8321   UFWORDX("RAW-TYPE", TTY_RAW_TYPE);
8322   UFWORDX("RAW-FLUSH", TTY_RAW_FLUSH);
8323   UFWORDX("RAW-READCH", TTY_RAW_READCH);
8324   UFWORDX("RAW-READY?", TTY_RAW_READYQ);
8325   ufoVocSetOnlyDefs(ufoForthVocId);
8326 }
8327
8328
8329 //==========================================================================
8330 //
8331 //  ufoInitFilesWords
8332 //
8333 //==========================================================================
8334 UFO_DISABLE_INLINE void ufoInitFilesWords (void) {
8335   // create "FILES" vocabulary
8336   const uint32_t filesVocId = ufoCreateVoc("FILES", 0, UFW_FLAG_PROTECTED);
8337   ufoVocSetOnlyDefs(filesVocId);
8338   ufoDefineConstant("SEEK-SET", SEEK_SET);
8339   ufoDefineConstant("SEEK-CUR", SEEK_CUR);
8340   ufoDefineConstant("SEEK-END", SEEK_END);
8341
8342   UFWORDX("OPEN-R/O", FILES_OPEN_RO);
8343   UFWORDX("OPEN-R/W", FILES_OPEN_RW);
8344   UFWORDX("CREATE", FILES_CREATE);
8345   UFWORDX("CLOSE", FILES_CLOSE);
8346   UFWORDX("TELL", FILES_TELL);
8347   UFWORDX("SEEK-EX", FILES_SEEK_EX);
8348   UFWORDX("SIZE", FILES_SIZE);
8349   UFWORDX("READ", FILES_READ);
8350   UFWORDX("READ-EXACT", FILES_READ_EXACT);
8351   UFWORDX("WRITE", FILES_WRITE);
8352
8353   UFWORDX("UNLINK", FILES_UNLINK);
8354
8355   UFWORDX("ERRNO", FILES_ERRNO);
8356
8357   ufoInterpretLine(
8358     ": SEEK  ( ofs handle -- success? ) "
8359     "  SEEK-SET FORTH:SWAP SEEK-EX "
8360     ";");
8361
8362   /*
8363   ufoInterpretLine(
8364     ": READ-EXACT  ( addr count handle -- success? ) "
8365     "  FORTH:OVER FORTH:>R ( save count ) "
8366     "  READ FORTH:DUP FORTH:(0BRANCH) $files-read-exact-error "
8367     "  FORTH:DROP ( drop TRUE ) FORTH:R@ = "
8368     "$files-read-exact-error: "
8369     "  RDROP "
8370     ";");
8371   */
8372
8373   ufoVocSetOnlyDefs(ufoForthVocId);
8374 }
8375
8376
8377 //==========================================================================
8378 //
8379 //  ufoInitVeryVeryHighWords
8380 //
8381 //==========================================================================
8382 UFO_DISABLE_INLINE void ufoInitVeryVeryHighWords (void) {
8383   // interpret defer
8384   //ufoDefineDefer("INTERPRET", idumbCFA);
8385
8386   ufoDefineEmitType();
8387
8388   // ( addr count FALSE -- addr count FALSE / TRUE )
8389   ufoDefineSColonForth("(INTERPRET-CHECK-WORD)");
8390   ufoDoneForth();
8391   // ( addr count FALSE -- addr count FALSE / TRUE )
8392   ufoDefineSColonForth("(INTERPRET-WORD-NOT-FOUND)");
8393   ufoDoneForth();
8394   // ( -- ) -- called in "EXIT", before compiling "FORTH:(EXIT)"
8395   ufoDefineSColonForth("(EXIT-EXTENDER)");
8396   ufoDoneForth();
8397
8398   // EXIT  ( -- )
8399   ufoInterpretLine("!: EXIT  ( -- )  COMPILER:?COMP (EXIT-EXTENDER) COMPILE FORTH:(EXIT) ;");
8400
8401   ufoDefineInterpret();
8402
8403   //ufoDumpVocab(ufoCompilerVocId);
8404
8405   ufoInterpretLine(
8406     ": RUN-INTERPRET-LOOP "
8407     "$run-interp-loop-again: "
8408     "  RP0! INTERPRET (UFO-INTERPRET-FINISHED-ACTION) "
8409     "  FORTH:(BRANCH) $run-interp-loop-again "
8410     ";");
8411 }
8412
8413 #define UFO_ADD_DO_CFA(cfx_)  do { \
8414   ufoDo##cfx_##CFA = ufoCFAsUsed | UFO_ADDR_CFA_BIT; \
8415   ufoForthCFAs[ufoCFAsUsed] = &ufoDo##cfx_; \
8416   ufoCFAsUsed += 1; \
8417 } while (0)
8418
8419
8420 //==========================================================================
8421 //
8422 //  ufoInitCommon
8423 //
8424 //==========================================================================
8425 UFO_DISABLE_INLINE void ufoInitCommon (void) {
8426   ufoVSP = 0;
8427   ufoForthVocId = 0; ufoCompilerVocId = 0;
8428
8429   ufoForthCFAs = calloc(UFO_MAX_NATIVE_CFAS, sizeof(ufoForthCFAs[0]));
8430
8431   // allocate default TIB handle
8432   //UfoHandle *tibh = ufoAllocHandle(0x69a029a6); // arbitrary number
8433   //ufoDefTIB = tibh->ufoHandle;
8434
8435   ufoForthCFAs[0] = NULL; ufoCFAsUsed = 1u;
8436   UFO_ADD_DO_CFA(Forth);
8437   UFO_ADD_DO_CFA(Variable);
8438   UFO_ADD_DO_CFA(Value);
8439   UFO_ADD_DO_CFA(Const);
8440   UFO_ADD_DO_CFA(Defer);
8441   UFO_ADD_DO_CFA(Voc);
8442   UFO_ADD_DO_CFA(Create);
8443   UFO_ADD_DO_CFA(UserVariable);
8444
8445   //fprintf(stderr, "DO-FORTH-CFA: 0x%08x\n", ufoDoForthCFA);
8446
8447   ufoInitBaseDict();
8448
8449   // create "FORTH" vocabulary (it should be the first one)
8450   ufoForthVocId = ufoCreateVoc("FORTH", 0, UFW_FLAG_PROTECTED);
8451   ufoVocSetOnlyDefs(ufoForthVocId);
8452
8453   // base low-level interpreter words
8454   ufoInitBasicWords();
8455
8456   // more FORTH words
8457   ufoInitMoreWords();
8458
8459   // some COMPILER words
8460   ufoInitBasicCompilerWords();
8461
8462   // STRING vocabulary
8463   ufoInitStringWords();
8464
8465   // DEBUG vocabulary
8466   ufoInitDebugWords();
8467
8468   // MTASK vocabulary
8469   ufoInitMTWords();
8470
8471   // HANDLE vocabulary
8472   ufoInitHandleWords();
8473
8474   // TTY vocabulary
8475   ufoInitTTYWords();
8476
8477   // FILES vocabulary
8478   ufoInitFilesWords();
8479
8480   // some higher-level FORTH words (includes, etc.)
8481   ufoInitHigherWords();
8482
8483   // very-very high-level FORTH words
8484   ufoInitVeryVeryHighWords();
8485
8486   ufoFinalLabelCheck();
8487
8488   #if 0
8489   ufoDecompileWord(ufoFindWordChecked("RUN-INTERPRET-LOOP"));
8490   #endif
8491
8492   ufoReset();
8493 }
8494
8495 #undef UFC
8496
8497
8498 // ////////////////////////////////////////////////////////////////////////// //
8499 // virtual machine executor
8500 //
8501
8502
8503 //==========================================================================
8504 //
8505 //  ufoRunVM
8506 //
8507 //  address interpreter
8508 //
8509 //==========================================================================
8510 static void ufoRunVMCFA (uint32_t cfa) {
8511   const uint32_t oldRPTop = ufoRPTop;
8512   ufoRPTop = ufoRP;
8513   #ifdef UFO_TRACE_VM_RUN
8514   fprintf(stderr, "**VM-INITIAL**: cfa=%u\n", cfa);
8515   UFCALL(DUMP_STACK);
8516   #endif
8517   ufoRPush(cfa);
8518   ufoVMRPopCFA = 1;
8519   ufoVMStop = 0;
8520   // VM execution loop
8521   do {
8522     if (ufoVMAbort) ufoFatal("user abort");
8523     if (ufoVMStop) { ufoRP = oldRPTop; break; }
8524     if (ufoCurrState == NULL) ufoFatal("execution state is lost");
8525     if (ufoVMRPopCFA == 0) {
8526       // check IP
8527       if (ufoIP == 0) ufoFatal("IP is NULL");
8528       if (ufoIP & UFO_ADDR_HANDLE_BIT) ufoFatal("IP is a handle");
8529       cfa = ufoImgGetU32(ufoIP); ufoIP += 4u;
8530     } else {
8531       cfa = ufoRPop(); ufoVMRPopCFA = 0;
8532     }
8533     // check CFA sanity
8534     if (cfa == 0) ufoFatal("EXECUTE: NULL CFA");
8535     if (cfa & UFO_ADDR_HANDLE_BIT) ufoFatal("cannot execute handle");
8536     // get next word CFAIDX, and check it
8537     uint32_t cfaidx = ufoImgGetU32(cfa);
8538     if (cfaidx & UFO_ADDR_HANDLE_BIT) ufoFatal("cannot execute CFAIDX-handle");
8539     #ifdef UFO_TRACE_VM_RUN
8540     fprintf(stderr, "**VM**: IP=%u; cfa=%u; cfaidx=0x%08x\n", ufoIP - 4u, cfa, cfaidx);
8541     UFCALL(DUMP_STACK);
8542     ufoDumpWordHeader(UFO_CFA_TO_LFA(cfa));
8543     fprintf(stderr, "######################################\n");
8544     #endif
8545     if (cfaidx & UFO_ADDR_CFA_BIT) {
8546       cfaidx &= UFO_ADDR_CFA_MASK;
8547       if (cfaidx >= ufoCFAsUsed || ufoForthCFAs[cfaidx] == NULL) {
8548         ufoFatal("tried to execute an unknown word: %u (max is %u); IP=%u",
8549                  cfaidx, ufoCFAsUsed, ufoIP - 4u);
8550       }
8551       #ifdef UFO_TRACE_VM_RUN
8552       fprintf(stderr, "**VM-NATIVE**: cfaidx=%u (doForth=%u)\n", cfaidx,
8553               (ufoDoForthCFA & UFO_ADDR_CFA_MASK));
8554       #endif
8555       ufoForthCFAs[cfaidx](UFO_CFA_TO_PFA(cfa));
8556     } else {
8557       // if CFA points somewhere inside a dict, this is "DOES>" word
8558       // IP points to PFA we need to push
8559       // CFA points to Forth word we need to jump to
8560       #ifdef UFO_TRACE_VM_DOER
8561       fprintf(stderr, "*** DOER! IP=%u; cfa=%u; cfaidx=%u ***\n", ufoIP, cfa, cfaidx);
8562       UFCALL(UFO_BACKTRACE);
8563       #endif
8564       ufoPush(UFO_CFA_TO_PFA(cfa)); // push PFA
8565       ufoRPush(ufoIP); // push IP
8566       ufoIP = cfaidx; // fix IP
8567     }
8568     // that's all we need to activate the debugger
8569     if (ufoSingleStep) {
8570       ufoSingleStep -= 1;
8571       if (ufoSingleStep == 0 && ufoDebuggerState != NULL) {
8572         if (ufoCurrState == ufoDebuggerState) ufoFatal("debugger cannot debug itself");
8573         UfoState *ost = ufoCurrState;
8574         ufoSwitchToState(ufoDebuggerState); // always use API call for this!
8575         ufoPush(-2);
8576         ufoPush(ost->id);
8577       }
8578     }
8579   } while (ufoRP != oldRPTop);
8580   //ufoVMStop = 0;
8581 }
8582
8583
8584 // ////////////////////////////////////////////////////////////////////////// //
8585 // high-level API
8586 //
8587
8588 //==========================================================================
8589 //
8590 //  ufoRegisterWord
8591 //
8592 //  register new word
8593 //
8594 //==========================================================================
8595 uint32_t ufoRegisterWord (const char *wname, ufoNativeCFA cfa, uint32_t flags) {
8596   ufo_assert(cfa != NULL);
8597   ufo_assert(wname != NULL && wname[0] != 0);
8598   uint32_t cfaidx = ufoCFAsUsed;
8599   if (cfaidx >= UFO_MAX_NATIVE_CFAS) ufoFatal("too many native words");
8600   ufoForthCFAs[cfaidx] = cfa;
8601   ufoCFAsUsed += 1;
8602   //ufoDefineNative(wname, xcfa, 0);
8603   cfaidx |= UFO_ADDR_CFA_BIT;
8604   flags &= 0xffffff00u;
8605   ufoCreateWordHeader(wname, flags);
8606   const uint32_t res = UFO_GET_DP();
8607   ufoImgEmitU32(cfaidx);
8608   return res;
8609 }
8610
8611
8612 //==========================================================================
8613 //
8614 //  ufoRegisterDataWord
8615 //
8616 //==========================================================================
8617 static uint32_t ufoRegisterDataWord (const char *wname, uint32_t cfaidx, uint32_t value,
8618                                      uint32_t flags)
8619 {
8620   ufo_assert(wname != NULL && wname[0] != 0);
8621   flags &= 0xffffff00u;
8622   ufoCreateWordHeader(wname, flags);
8623   ufoImgEmitU32(cfaidx);
8624   const uint32_t res = UFO_GET_DP();
8625   ufoImgEmitU32(value);
8626   return res;
8627 }
8628
8629
8630 //==========================================================================
8631 //
8632 //  ufoRegisterConstant
8633 //
8634 //==========================================================================
8635 void ufoRegisterConstant (const char *wname, uint32_t value, uint32_t flags) {
8636   (void)ufoRegisterDataWord(wname, ufoDoConstCFA, value, flags);
8637 }
8638
8639
8640 //==========================================================================
8641 //
8642 //  ufoRegisterVariable
8643 //
8644 //==========================================================================
8645 uint32_t ufoRegisterVariable (const char *wname, uint32_t value, uint32_t flags) {
8646   return ufoRegisterDataWord(wname, ufoDoVariableCFA, value, flags);
8647 }
8648
8649
8650 //==========================================================================
8651 //
8652 //  ufoRegisterValue
8653 //
8654 //==========================================================================
8655 uint32_t ufoRegisterValue (const char *wname, uint32_t value, uint32_t flags) {
8656   return ufoRegisterDataWord(wname, ufoDoValueCFA, value, flags);
8657 }
8658
8659
8660 //==========================================================================
8661 //
8662 //  ufoRegisterDefer
8663 //
8664 //==========================================================================
8665 uint32_t ufoRegisterDefer (const char *wname, uint32_t value, uint32_t flags) {
8666   return ufoRegisterDataWord(wname, ufoDoDeferCFA, value, flags);
8667 }
8668
8669
8670 //==========================================================================
8671 //
8672 //  ufoFindWordInVocabulary
8673 //
8674 //  check if we have the corresponding word.
8675 //  return CFA suitable for executing, or 0.
8676 //
8677 //==========================================================================
8678 uint32_t ufoFindWordInVocabulary (const char *wname, uint32_t vocid) {
8679   if (wname == NULL || wname[0] == 0) return 0;
8680   size_t wlen = strlen(wname);
8681   if (wlen >= UFO_MAX_WORD_LENGTH) return 0;
8682   return ufoFindWordInVocAndParents(wname, (uint32_t)wlen, 0, vocid, 0);
8683 }
8684
8685
8686 //==========================================================================
8687 //
8688 //  ufoGetIP
8689 //
8690 //==========================================================================
8691 uint32_t ufoGetIP (void) {
8692   return ufoIP;
8693 }
8694
8695
8696 //==========================================================================
8697 //
8698 //  ufoSetIP
8699 //
8700 //==========================================================================
8701 void ufoSetIP (uint32_t newip) {
8702   ufoIP = newip;
8703 }
8704
8705
8706 //==========================================================================
8707 //
8708 //  ufoIsExecuting
8709 //
8710 //==========================================================================
8711 int ufoIsExecuting (void) {
8712   return (ufoImgGetU32(ufoAddrSTATE) == 0);
8713 }
8714
8715
8716 //==========================================================================
8717 //
8718 //  ufoIsCompiling
8719 //
8720 //==========================================================================
8721 int ufoIsCompiling (void) {
8722   return (ufoImgGetU32(ufoAddrSTATE) != 0);
8723 }
8724
8725
8726 //==========================================================================
8727 //
8728 //  ufoSetExecuting
8729 //
8730 //==========================================================================
8731 void ufoSetExecuting (void) {
8732   ufoImgPutU32(ufoAddrSTATE, 0);
8733 }
8734
8735
8736 //==========================================================================
8737 //
8738 //  ufoSetCompiling
8739 //
8740 //==========================================================================
8741 void ufoSetCompiling (void) {
8742   ufoImgPutU32(ufoAddrSTATE, 1);
8743 }
8744
8745
8746 //==========================================================================
8747 //
8748 //  ufoGetHere
8749 //
8750 //==========================================================================
8751 uint32_t ufoGetHere () {
8752   return UFO_GET_DP();
8753 }
8754
8755
8756 //==========================================================================
8757 //
8758 //  ufoGetPad
8759 //
8760 //==========================================================================
8761 uint32_t ufoGetPad () {
8762   UFCALL(PAD);
8763   return ufoPop();
8764 }
8765
8766
8767 //==========================================================================
8768 //
8769 //  ufoTIBPeekCh
8770 //
8771 //==========================================================================
8772 uint8_t ufoTIBPeekCh (uint32_t ofs) {
8773   return ufoTibPeekChOfs(ofs);
8774 }
8775
8776
8777 //==========================================================================
8778 //
8779 //  ufoTIBGetCh
8780 //
8781 //==========================================================================
8782 uint8_t ufoTIBGetCh (void) {
8783   return ufoTibGetCh();
8784 }
8785
8786
8787 //==========================================================================
8788 //
8789 //  ufoTIBSkipCh
8790 //
8791 //==========================================================================
8792 void ufoTIBSkipCh (void) {
8793   ufoTibSkipCh();
8794 }
8795
8796
8797 //==========================================================================
8798 //
8799 //  ufoTIBSRefill
8800 //
8801 //  returns 0 on EOF
8802 //
8803 //==========================================================================
8804 int ufoTIBSRefill (int allowCrossIncludes) {
8805   return ufoLoadNextLine(allowCrossIncludes);
8806 }
8807
8808
8809 //==========================================================================
8810 //
8811 //  ufoPeekData
8812 //
8813 //==========================================================================
8814 uint32_t ufoPeekData (void) {
8815   return ufoPeek();
8816 }
8817
8818
8819 //==========================================================================
8820 //
8821 //  ufoPopData
8822 //
8823 //==========================================================================
8824 uint32_t ufoPopData (void) {
8825   return ufoPop();
8826 }
8827
8828
8829 //==========================================================================
8830 //
8831 //  ufoPushData
8832 //
8833 //==========================================================================
8834 void ufoPushData (uint32_t value) {
8835   return ufoPush(value);
8836 }
8837
8838
8839 //==========================================================================
8840 //
8841 //  ufoPushBoolData
8842 //
8843 //==========================================================================
8844 void ufoPushBoolData (int val) {
8845   ufoPushBool(val);
8846 }
8847
8848
8849 //==========================================================================
8850 //
8851 //  ufoPeekRet
8852 //
8853 //==========================================================================
8854 uint32_t ufoPeekRet (void) {
8855   return ufoRPeek();
8856 }
8857
8858
8859 //==========================================================================
8860 //
8861 //  ufoPopRet
8862 //
8863 //==========================================================================
8864 uint32_t ufoPopRet (void) {
8865   return ufoRPop();
8866 }
8867
8868
8869 //==========================================================================
8870 //
8871 //  ufoPushRet
8872 //
8873 //==========================================================================
8874 void ufoPushRet (uint32_t value) {
8875   return ufoRPush(value);
8876 }
8877
8878
8879 //==========================================================================
8880 //
8881 //  ufoPushBoolRet
8882 //
8883 //==========================================================================
8884 void ufoPushBoolRet (int val) {
8885   ufoRPush(val ? ufoTrueValue : 0);
8886 }
8887
8888
8889 //==========================================================================
8890 //
8891 //  ufoPeekByte
8892 //
8893 //==========================================================================
8894 uint8_t ufoPeekByte (uint32_t addr) {
8895   return ufoImgGetU8Ext(addr);
8896 }
8897
8898
8899 //==========================================================================
8900 //
8901 //  ufoPeekWord
8902 //
8903 //==========================================================================
8904 uint16_t ufoPeekWord (uint32_t addr) {
8905   ufoPush(addr);
8906   UFCALL(WPEEK);
8907   return ufoPop();
8908 }
8909
8910
8911 //==========================================================================
8912 //
8913 //  ufoPeekCell
8914 //
8915 //==========================================================================
8916 uint32_t ufoPeekCell (uint32_t addr) {
8917   ufoPush(addr);
8918   UFCALL(PEEK);
8919   return ufoPop();
8920 }
8921
8922
8923 //==========================================================================
8924 //
8925 //  ufoPokeByte
8926 //
8927 //==========================================================================
8928 void ufoPokeByte (uint32_t addr, uint32_t value) {
8929   ufoImgPutU8(addr, value);
8930 }
8931
8932
8933 //==========================================================================
8934 //
8935 //  ufoPokeWord
8936 //
8937 //==========================================================================
8938 void ufoPokeWord (uint32_t addr, uint32_t value) {
8939   ufoPush(value);
8940   ufoPush(addr);
8941   UFCALL(WPOKE);
8942 }
8943
8944
8945 //==========================================================================
8946 //
8947 //  ufoPokeCell
8948 //
8949 //==========================================================================
8950 void ufoPokeCell (uint32_t addr, uint32_t value) {
8951   ufoPush(value);
8952   ufoPush(addr);
8953   UFCALL(POKE);
8954 }
8955
8956
8957 //==========================================================================
8958 //
8959 //  ufoGetPAD
8960 //
8961 //==========================================================================
8962 uint32_t ufoGetPAD (void) {
8963   return UFO_PAD_ADDR;
8964 }
8965
8966
8967 //==========================================================================
8968 //
8969 //  ufoEmitByte
8970 //
8971 //==========================================================================
8972 void ufoEmitByte (uint32_t value) {
8973   ufoImgEmitU8(value);
8974 }
8975
8976
8977 //==========================================================================
8978 //
8979 //  ufoEmitWord
8980 //
8981 //==========================================================================
8982 void ufoEmitWord (uint32_t value) {
8983   ufoImgEmitU8(value & 0xff);
8984   ufoImgEmitU8((value >> 8) & 0xff);
8985 }
8986
8987
8988 //==========================================================================
8989 //
8990 //  ufoEmitCell
8991 //
8992 //==========================================================================
8993 void ufoEmitCell (uint32_t value) {
8994   ufoImgEmitU32(value);
8995 }
8996
8997
8998 //==========================================================================
8999 //
9000 //  ufoIsInited
9001 //
9002 //==========================================================================
9003 int ufoIsInited (void) {
9004   return (ufoMode != UFO_MODE_NONE);
9005 }
9006
9007
9008 static void (*ufoUserPostInitCB) (void);
9009
9010
9011 //==========================================================================
9012 //
9013 //  ufoSetUserPostInit
9014 //
9015 //  called after main initialisation
9016 //
9017 //==========================================================================
9018 void ufoSetUserPostInit (void (*cb) (void)) {
9019   ufoUserPostInitCB = cb;
9020 }
9021
9022
9023 //==========================================================================
9024 //
9025 //  ufoInit
9026 //
9027 //==========================================================================
9028 void ufoInit (void) {
9029   if (ufoMode != UFO_MODE_NONE) return;
9030   ufoMode = UFO_MODE_NATIVE;
9031
9032   ufoInFileLine = 0;
9033   ufoInFileName = NULL; ufoInFileNameLen = 0; ufoInFileNameHash = 0;
9034   ufoInFile = NULL;
9035   ufoLastIncPath = NULL; ufoLastSysIncPath = NULL;
9036
9037   for (uint32_t f = 0; f < UFO_MAX_STATES; f += 1u) ufoStateMap[f] = NULL;
9038   memset(ufoStateUsedBitmap, 0, sizeof(ufoStateUsedBitmap));
9039
9040   ufoCurrState = ufoNewState();
9041   strcpy(ufoCurrState->name, "MAIN");
9042   ufoInitStateUserVars(ufoCurrState, 0);
9043   ufoImgPutU32(ufoAddrDefTIB, 0); // create TIB handle
9044   ufoImgPutU32(ufoAddrTIBx, 0); // create TIB handle
9045
9046   ufoYieldedState = NULL;
9047   ufoDebuggerState = NULL;
9048   ufoSingleStep = 0;
9049
9050   #ifdef UFO_DEBUG_STARTUP_TIMES
9051   uint32_t stt = ufo_get_msecs();
9052   ufoCondDefine("UFO-DEBUG-STARTUP-TIMES");
9053   #endif
9054   ufoInitCommon();
9055   #ifdef UFO_DEBUG_STARTUP_TIMES
9056   uint32_t ett = ufo_get_msecs();
9057   fprintf(stderr, "UrForth init time: %u msecs\n", (unsigned)(ett - stt));
9058   #endif
9059
9060   ufoReset();
9061
9062   if (ufoUserPostInitCB) {
9063     ufoUserPostInitCB();
9064     ufoReset();
9065   }
9066
9067   // load ufo modules
9068   char *ufmname = ufoCreateIncludeName("init", 1, NULL);
9069   #ifdef WIN32
9070   FILE *ufl = fopen(ufmname, "rb");
9071   #else
9072   FILE *ufl = fopen(ufmname, "r");
9073   #endif
9074   if (ufl) {
9075     ufoPushInFile();
9076     ufoSetInFileNameReuse(ufmname);
9077     ufoInFile = ufl;
9078     ufoFileId = ufoLastUsedFileId;
9079     setLastIncPath(ufoInFileName, 1);
9080   } else {
9081     free(ufmname);
9082     ufoFatal("cannot load init code");
9083   }
9084
9085   if (ufoInFile != NULL) {
9086     ufoRunInterpretLoop();
9087   }
9088 }
9089
9090
9091 //==========================================================================
9092 //
9093 //  ufoFinishVM
9094 //
9095 //==========================================================================
9096 void ufoFinishVM (void) {
9097   ufoVMStop = 1;
9098 }
9099
9100
9101 //==========================================================================
9102 //
9103 //  ufoWasVMFinished
9104 //
9105 //  check if VM was exited due to `ufoFinishVM()`
9106 //
9107 //==========================================================================
9108 int ufoWasVMFinished (void) {
9109   return (ufoVMStop != 0);
9110 }
9111
9112
9113 //==========================================================================
9114 //
9115 //  ufoCallParseIntr
9116 //
9117 //  ( -- addr count TRUE / FALSE )
9118 //  does base TIB parsing; never copies anything.
9119 //  as our reader is line-based, returns FALSE on EOL.
9120 //  EOL is detected after skipping leading delimiters.
9121 //  passing -1 as delimiter skips the whole line, and always returns FALSE.
9122 //  trailing delimiter is always skipped.
9123 //  result is on the data stack.
9124 //
9125 //==========================================================================
9126 void ufoCallParseIntr (uint32_t delim, int skipLeading) {
9127   ufoPush(delim); ufoPushBool(skipLeading);
9128   UFCALL(PAR_PARSE);
9129 }
9130
9131 //==========================================================================
9132 //
9133 //  ufoCallParseName
9134 //
9135 //  ( -- addr count )
9136 //  parse with leading blanks skipping. doesn't copy anything.
9137 //  return empty string on EOL.
9138 //
9139 //==========================================================================
9140 void ufoCallParseName (void) {
9141   UFCALL(PARSE_NAME);
9142 }
9143
9144
9145 //==========================================================================
9146 //
9147 //  ufoCallParse
9148 //
9149 //  ( -- addr count TRUE / FALSE )
9150 //  parse without skipping delimiters; never copies anything.
9151 //  as our reader is line-based, returns FALSE on EOL.
9152 //  passing 0 as delimiter skips the whole line, and always returns FALSE.
9153 //  trailing delimiter is always skipped.
9154 //
9155 //==========================================================================
9156 void ufoCallParse (uint32_t delim) {
9157   ufoPush(delim);
9158   UFCALL(PARSE);
9159 }
9160
9161
9162 //==========================================================================
9163 //
9164 //  ufoCallParseSkipBlanks
9165 //
9166 //==========================================================================
9167 void ufoCallParseSkipBlanks (void) {
9168   UFCALL(PARSE_SKIP_BLANKS);
9169 }
9170
9171
9172 //==========================================================================
9173 //
9174 //  ufoCallParseSkipComments
9175 //
9176 //==========================================================================
9177 void ufoCallParseSkipComments (void) {
9178   ufoPushBool(1); UFCALL(PAR_PARSE_SKIP_COMMENTS);
9179 }
9180
9181
9182 //==========================================================================
9183 //
9184 //  ufoCallParseSkipLineComments
9185 //
9186 //==========================================================================
9187 void ufoCallParseSkipLineComments (void) {
9188   ufoPushBool(0); UFCALL(PAR_PARSE_SKIP_COMMENTS);
9189 }
9190
9191
9192 //==========================================================================
9193 //
9194 //  ufoCallParseSkipLine
9195 //
9196 //  to the end of line; doesn't refill
9197 //
9198 //==========================================================================
9199 void ufoCallParseSkipLine (void) {
9200   UFCALL(PARSE_SKIP_LINE);
9201 }
9202
9203
9204 //==========================================================================
9205 //
9206 //  ufoCallBasedNumber
9207 //
9208 //  convert number from addrl+1
9209 //  returns address of the first inconvertible char
9210 //  (BASED-NUMBER) ( addr count allowsign? base -- num TRUE / FALSE )
9211 //
9212 //==========================================================================
9213 void ufoCallBasedNumber (uint32_t addr, uint32_t count, int allowSign, int base) {
9214   ufoPush(addr); ufoPush(count); ufoPushBool(allowSign);
9215   if (base < 0) ufoPush(0); else ufoPush((uint32_t)base);
9216   UFCALL(PAR_BASED_NUMBER);
9217 }
9218
9219
9220 //==========================================================================
9221 //
9222 //  ufoRunWord
9223 //
9224 //==========================================================================
9225 void ufoRunWord (uint32_t cfa) {
9226   if (cfa != 0) {
9227     if (ufoMode == UFO_MODE_NONE) ufoFatal("UrForth is not properly inited");
9228     if (ufoInRunWord) ufoFatal("`ufoRunWord` cannot be called recursively");
9229     ufoMode = UFO_MODE_NATIVE;
9230     ufoInRunWord = 1;
9231     ufoRunVMCFA(cfa);
9232     ufoInRunWord = 0;
9233   }
9234 }
9235
9236
9237 //==========================================================================
9238 //
9239 //  ufoRunMacroWord
9240 //
9241 //==========================================================================
9242 void ufoRunMacroWord (uint32_t cfa) {
9243   if (cfa != 0) {
9244     if (ufoMode == UFO_MODE_NONE) ufoFatal("UrForth is not properly inited");
9245     if (ufoInRunWord) ufoFatal("`ufoRunWord` cannot be called recursively");
9246     ufoMode = UFO_MODE_MACRO;
9247     const uint32_t oisp = ufoFileStackPos;
9248     ufoPushInFile();
9249     ufoFileId = 0;
9250     (void)ufoLoadNextUserLine();
9251     ufoInRunWord = 1;
9252     ufoRunVMCFA(cfa);
9253     ufoInRunWord = 0;
9254     ufoPopInFile();
9255     ufo_assert(ufoFileStackPos == oisp); // sanity check
9256   }
9257 }
9258
9259
9260 //==========================================================================
9261 //
9262 //  ufoIsInMacroMode
9263 //
9264 //  check if we are currently in "MACRO" mode.
9265 //  should be called from registered words.
9266 //
9267 //==========================================================================
9268 int ufoIsInMacroMode (void) {
9269   return (ufoMode == UFO_MODE_MACRO);
9270 }
9271
9272
9273 //==========================================================================
9274 //
9275 //  ufoRunInterpretLoop
9276 //
9277 //  run default interpret loop.
9278 //
9279 //==========================================================================
9280 void ufoRunInterpretLoop (void) {
9281   if (ufoMode == UFO_MODE_NONE) {
9282     ufoInit();
9283   }
9284   const uint32_t cfa = ufoFindWord("RUN-INTERPRET-LOOP");
9285   if (cfa == 0) ufoFatal("'RUN-INTERPRET-LOOP' word not found");
9286   ufoReset();
9287   ufoMode = UFO_MODE_NATIVE;
9288   ufoInRunWord = 1;
9289   ufoRunVMCFA(cfa);
9290   ufoInRunWord = 0;
9291   while (ufoFileStackPos != 0) ufoPopInFile();
9292 }
9293
9294
9295 //==========================================================================
9296 //
9297 //  ufoRunFile
9298 //
9299 //==========================================================================
9300 void ufoRunFile (const char *fname) {
9301   if (ufoMode == UFO_MODE_NONE) {
9302     ufoInit();
9303   }
9304   if (ufoInRunWord) ufoFatal("`ufoRunFile` cannot be called recursively");
9305   ufoMode = UFO_MODE_NATIVE;
9306
9307   ufoReset();
9308   char *ufmname = ufoCreateIncludeName(fname, 0, ".");
9309   #ifdef WIN32
9310   FILE *ufl = fopen(ufmname, "rb");
9311   #else
9312   FILE *ufl = fopen(ufmname, "r");
9313   #endif
9314   if (ufl) {
9315     ufoPushInFile();
9316     ufoSetInFileNameReuse(ufmname);
9317     ufoInFile = ufl;
9318     ufoFileId = ufoLastUsedFileId;
9319     setLastIncPath(ufoInFileName, 0);
9320   } else {
9321     free(ufmname);
9322     ufoFatal("cannot load source file '%s'", fname);
9323   }
9324   ufoRunInterpretLoop();
9325 }